C C BULLETIN1.FOR, Version 4/8/98 C Purpose: Contains subroutines for the BULLETIN utility program. C Environment: VAX/VMS C Programmer: Mark R. London C C Copyright (c) 1990 C Property of Massachusetts Institute of Technology, Cambridge MA 02139. C This program cannot be copied or distributed in any form for non-MIT C use without specific written approval of MIT Plasma Fusion Center C Management. C SUBROUTINE MAIL C C SUBROUTINE MAIL C C FUNCTION: Sends message which you have read to user via DEC mail. C IMPLICIT INTEGER (A - Z) COMMON /POINT/ BULL_POINT COMMON /SENDTO/ SENDTO CHARACTER*256 SENDTO COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE CHARACTER*256 FROM_LINE,SUBJECT_LINE CHARACTER*12 MSGNUM INCLUDE 'BULLDIR.INC' EXTERNAL CLI$_ABSENT IF (BTEST(CAPTIVE(-1),1)) THEN WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')') RETURN END IF IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read WRITE(6,'('' ERROR: You have not read any message.'')') RETURN ! And return END IF CALL OPEN_BULLDIR_SHARED CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found? WRITE(6,'('' ERROR: Specified message was not found.'')') CALL CLOSE_BULLDIR ! If not, then error out RETURN END IF CALL CLOSE_BULLDIR IF (CLI$PRESENT('EDIT')) THEN CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') END IF OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') IF (IER.NE.0) THEN WRITE(6,'('' ERROR: Error in opening scratch file.'')') RETURN END IF IF (CLI$PRESENT('HEADER')) THEN ! Printout header? IF (EXDATE(8:11).LT.'1995') THEN IF (REMOTE_SET.NE.3) THEN INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) & //' (DELETED)' ELSE INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) END IF ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) & //' Expires on shutdown' ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) & //' Permanent' ELSE INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// & ' Expires: '//EXDATE//' '//EXTIME(:5) END IF IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? INPUT = INPUT(:TRIM(INPUT))//' / System' END IF WRITE (3,'(A)') INPUT(:TRIM(INPUT)) END IF HEAD = CLI$PRESENT('HEADER') CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file ILEN = LINE_LENGTH + 1 CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN IF (HEAD) WRITE(3,1060) INPUT(7:ILEN) CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) ELSE IF (HEAD) THEN WRITE(3,1060) FROM END IF IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN IF (HEAD) WRITE(3,1050) INPUT(7:ILEN) SUBJECT_LINE = INPUT(7:ILEN) ELSE IF (HEAD) WRITE(3,1050) DESCRIP IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) SUBJECT_LINE = DESCRIP END IF IF (CLI$PRESENT('SUBJECT')) THEN IER = CLI$GET_VALUE('SUBJECT',SUBJECT_LINE,LEN_D) END IF DO WHILE (ILEN.GT.0) ! Copy bulletin into file CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) END DO CLOSE (UNIT=3) ! Message copy completed CALL CLOSE_BULLFIL LEN_D = TRIM(SUBJECT_LINE) IF (LEN_D.EQ.0) THEN SUBJECT_LINE = 'BULLETIN message.' LEN_D = TRIM(SUBJECT_LINE) END IF I = 1 DO WHILE (I.LE.LEN_D) IF (SUBJECT_LINE(I:I).EQ.'"') THEN IF (LEN_D.EQ.64) THEN SUBJECT_LINE(I:I) = '`' ELSE SUBJECT_LINE = SUBJECT_LINE(:I)//'"'//SUBJECT_LINE(I+1:) I = I + 1 LEN_D = LEN_D + 1 END IF END IF I = I + 1 END DO LEN_S = 0 DO WHILE (CLI$GET_VALUE('RECIPIENTS',SENDTO(LEN_S+1:),I) & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames LEN_S = LEN_S + I + 1 SENDTO(LEN_S:LEN_S) = ',' END DO LEN_S = LEN_S - 1 I = 1 ! Must change all " to """ in MAIL recipients DO WHILE (I.LE.LEN_S) IF (SENDTO(I:I).EQ.'"') THEN SENDTO = SENDTO(:I)//'""'//SENDTO(I+1:) I = I + 2 LEN_S = LEN_S + 2 END IF I = I + 1 END DO IF (CLI$PRESENT('EDIT')) THEN CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') CONTEXT = 0 IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT) VERSION = INDEX(INPUT,';') + 1 IF (INPUT(VERSION:VERSION).EQ.'1') THEN CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') WRITE (6,'('' ERROR: No message mailed.'')') RETURN END IF END IF CALL DISABLE_PRIVS CALL SENDMAIL('SYS$LOGIN:BULL.SCR',SENDTO(:LEN_S) & ,SUBJECT_LINE,STATUS) C CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//SENDTO(:LEN_S) C & //'/SUBJECT="'//SUBJECT_LINE(:LEN_D)//'"',,,,,,STATUS) C IF (.NOT.STATUS) CALL SYS_GETMSG(STATUS) CALL ENABLE_PRIVS CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') RETURN 1050 FORMAT('Description: ',A,/) 1060 FORMAT('From: ',A) END SUBROUTINE MODIFY_FOLDER C C SUBROUTINE MODIFY_FOLDER C C FUNCTION: Modifies a folder's information. C IMPLICIT INTEGER (A - Z) COMMON /BULLPAR/ BULL_PARAMETER,LEN_P CHARACTER*64 BULL_PARAMETER INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFILES.INC' INCLUDE '($SSDEF)' COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT CHARACTER RESPONSE*32 IF (.NOT.FOLDER_ACCESS & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN WRITE (6,'('' ERROR: No privileges to modify folder.'')') RETURN END IF IF (CLI$PRESENT('NAME')) THEN IF (REMOTE_SET) THEN WRITE (6,'('' ERROR: Cannot change name of'', & '' remote folder.'')') RETURN ELSE CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P) IF (LEN_P.GT.44) THEN WRITE (6,'('' ERROR: Folder name cannot be larger & than 44 characters.'')') RETURN END IF END IF ELSE FOLDER1 = FOLDER END IF INIT_NEWSFEED = .FALSE. NEWSGROUP = .FALSE. MAILTO = 0 IF (CLI$PRESENT('DESCRIPTION')) THEN WRITE (6,'('' Enter one line description of folder.'')') LENF = 81 DO WHILE (LENF.GT.80) CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line IF (LENF.LE.0) THEN WRITE (6,'('' ERROR: Folder modification aborted.'')') RETURN ELSE IF (LENF.GT.80) THEN ! If too many characters WRITE (6,'('' ERROR: Description must be < 80 characters.'')') RETURN ELSE FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces END IF END DO I = INDEX(FOLDER1_DESCRIP,'<') J = INDEX(FOLDER1_DESCRIP,'>') IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'@').LT.1 & .OR.INDEX(FOLDER1_DESCRIP(I:),'@').GT.J-I+1).AND. & (INDEX(FOLDER1_DESCRIP(I:),'.') & .LE.J-I+1.AND.INDEX(FOLDER1_DESCRIP(I:),'.').GT.0)) THEN NEWSGROUP = .TRUE. WRITE (6,'('' Init news feed counter to feed '', & ''all messages in news group (Y),'')') CALL GET_INPUT_PROMPT(RESPONSE,RLEN, & 'or set to feed only new messages (N,default) ? ') INIT_NEWSFEED = RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y' I = INDEX(FOLDER1_DESCRIP,'[') J = INDEX(FOLDER1_DESCRIP,']') END IF IF (I.GT.0.AND.J.GT.I.AND. & (INDEX(FOLDER1_DESCRIP(I:),'@').GT.1.AND. & INDEX(FOLDER1_DESCRIP(I:),'@').LT.J-I+1)) THEN MAILTO = 1 END IF IF (I.GT.0.AND.J.GT.I.AND.(INDEX(FOLDER1_DESCRIP(I:),'.') & .GT.J-I+1.OR.INDEX(FOLDER1_DESCRIP(I:),'.').EQ.0) & .AND.MAILTO.EQ.0.AND..NOT.BTEST(FOLDER_FLAG,11) & .AND..NOT.BTEST(FOLDER_FLAG,10)) THEN CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Have you specified '// & 'an email address in the description? (default=N) ') IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') MAILTO = 1 END IF IF (MAILTO.EQ.1.AND..NOT.BTEST(FOLDER_FLAG,11).AND. & .NOT.BTEST(FOLDER_FLAG,10)) THEN WRITE (6,'('' A mailing address has been specified.'')') CALL GET_INPUT_PROMPT(RESPONSE,RLEN,'Will messages be '// & 'sent to and received from this address? (default=N) ') IF (RESPONSE(:1).EQ.'y'.OR.RESPONSE(:1).EQ.'Y') THEN MAILTO = 2 WRITE (6,'('' SET POST_ONLY will be issued.'')') ELSE MAILTO = 3 WRITE (6,'('' SET ADD_ONLY will be issued.'')') END IF END IF ELSE FOLDER1_DESCRIP = FOLDER_DESCRIP END IF IF (CLI$PRESENT('OWNER')) THEN CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P) IF (LEN_P.GT.12) THEN WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')') RETURN ELSE IF (CLI$PRESENT('ID')) THEN IER = CHKPRO(FOLDER1_OWNER) ELSE CALL GET_UAF & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER) END IF IF (.NOT.IER) THEN WRITE (6,'('' ERROR: Owner name is not valid username.'')') RETURN ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN WRITE (6,'('' ERROR: Folder owner name too long.'')') RETURN ELSE IF (.NOT.SETPRV_PRIV()) THEN WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10) CALL GET_INPUT_NOECHO(RESPONSE) IF (TRIM(RESPONSE).EQ.0) THEN WRITE (6,'('' ERROR: No password entered.'')') RETURN END IF WRITE (6,'('' Attempting to verify password name...'')') OPEN (UNIT=10,NAME='SYS$NODE"'// & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER)) & //' '//RESPONSE(:TRIM(RESPONSE))//'"::', & TYPE='SCRATCH',IOSTAT=IER) CLOSE (UNIT=10) IF (IER.NE.0) THEN WRITE (6,'('' ERROR: Password is invalid.'')') RETURN ELSE WRITE (6,'('' Password was verified.'')') END IF ELSE FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P) END IF ELSE FOLDER1_OWNER = FOLDER_OWNER END IF CALL OPEN_BULLFOLDER ! Open folder file IF (CLI$PRESENT('NAME')) THEN READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0) ! See if folder exists IF (IER.EQ.0) THEN WRITE (6,'('' ERROR: Folder name already exists.'')') CALL CLOSE_BULLFOLDER RETURN END IF END IF CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN LEN_F = TRIM(FOLDER_DIRECTORY) IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)// & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)// & FOLDER1(:TRIM(FOLDER1))//'.*') IF (.NOT.IER) THEN I = 0 IER1 = LIB$FIND_FILE(FOLDER_DIRECTORY(:LEN_F)// & FOLDER(:TRIM(FOLDER))//'.*',INPUT,I) END IF IF (IER.OR..NOT.IER1) THEN FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1 FOLDER_NAME = FOLDER1 IER = 0 END IF END IF IF (IER.EQ.0) THEN IF (CLI$PRESENT('OWNER')) THEN CALL CHKACL & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER) IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER) CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER) END IF END IF FOLDER = FOLDER1 FOLDER_OWNER = FOLDER1_OWNER FOLDER_DESCRIP = FOLDER1_DESCRIP DELETE (7) IF (CLI$PRESENT('ID')) THEN FOLDER_FLAG = IBSET(FOLDER_FLAG,6) ELSE FOLDER_FLAG = IBCLR(FOLDER_FLAG,6) END IF IF (NEWSGROUP) FOLDER_FLAG = IBSET(FOLDER_FLAG,4) IF (MAILTO.EQ.2) FOLDER_FLAG = IBSET(FOLDER_FLAG,10) IF (MAILTO.EQ.3) FOLDER_FLAG = IBSET(FOLDER_FLAG,11) IF (INIT_NEWSFEED) THEN F_LAST = 0 ELSE IF (NEWSGROUP) THEN CALL CLOSE_BULLFOLDER CALL OPEN_BULLNEWS_SHARED I = INDEX(FOLDER_DESCRIP,'<') + 1 J = INDEX(FOLDER_DESCRIP,'>') - 1 CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER_DESCRIP(I:J),IER) CALL CLOSE_BULLNEWS CALL OPEN_BULLFOLDER F_LAST = F1_NBULL END IF CALL WRITE_FOLDER_FILE(IER) IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')') END IF IF (IER.NE.0) THEN WRITE (6,'('' ERROR: Folder modification aborted.'')') END IF CALL CLOSE_BULLFOLDER RETURN END FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER) IMPLICIT INTEGER (A-Z) CHARACTER*(*) USERNAME,FOLDER_OWNER IF (SETPRV_PRIV()) THEN FOLDER_ACCESS = .TRUE. ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID FOLDER_ACCESS = CHKPRO(FOLDER_OWNER) ELSE FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER END IF RETURN END SUBROUTINE MOVE(DELETE_ORIGINAL) C C SUBROUTINE MOVE C C FUNCTION: Moves message from one folder to another. C IMPLICIT INTEGER (A - Z) INCLUDE 'BULLDIR.INC' INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLFILES.INC' COMMON /POINT/ BULL_POINT COMMON /BULLPAR/ BULL_PARAMETER,LEN_P CHARACTER*64 BULL_PARAMETER COMMON /ACCESS/ READ_ONLY LOGICAL READ_ONLY COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 DATA SCRATCH_R1 /0/ COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD COMMON /HEADER/ HEADER COMMON /NEXT/ NEXT COMMON /NEWGROUP/ NEWGROUP COMMON /NEWS2BULL/ NEWS2BULL COMMON /FEED/ FEED COMMON /MAIL_INFO/ USE_INFROM COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP COMMON /MAIN_HEADER_INFO/ INEXDATE CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP COMMON /BULLCP_NEWS/ BULLCP_NEWS EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS LOGICAL DELETE_ORIGINAL CHARACTER SAVE_FOLDER*44,POST_SUBJECT*256,TODAY*24 CHARACTER SCRFILE*18 DATA TEMP_FILE/.FALSE./ DIMENSION BTIM(2) ORIGINAL = CLI$PRESENT('ORIGINAL') IF (ORIGINAL.AND..NOT.SETPRV_PRIV()) THEN WRITE (6,'('' ERROR: You have no privileges to keep'' & ,'' original owner.'')') RETURN END IF ALL = CLI$PRESENT('ALL') MERGE = CLI$PRESENT('MERGE') SAVE_BULL_POINT = BULL_POINT FROM_REMOTE = REMOTE_SET CALL CLI$GET_VALUE('FOLDER',FOLDER1) IF (INDEX(FOLDER1,'.').GT.0) CALL LOWERCASE(FOLDER1) TO_NEWS = TEST_NEWS(FOLDER1) IF (.NOT.BULLCP_NEWS.AND.FOLDER.EQ.FOLDER1) THEN WRITE (6,'('' ERROR: Destination cannot be same as'', & '' current location.'')') RETURN END IF IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN IF (BULL_POINT.EQ.0) THEN ! If no message has been read WRITE(6,'('' ERROR: You are not reading any message.'')') RETURN ! and return END IF CALL OPEN_BULLDIR_SHARED CALL READDIR(BULL_POINT,IER) ! Get message directory entry IF (IER.NE.BULL_POINT+1.OR.BULL_POINT.NE.SAVE_BULL_POINT) THEN WRITE(6,'('' ERROR: Specified message was not found.'')') CALL CLOSE_BULLDIR BULL_POINT = SAVE_BULL_POINT RETURN END IF NUM_COPY = 1 ELSE CALL OPEN_BULLDIR_SHARED CALL READDIR(0,IER) ! Get message directory entry IF (NBULL.EQ.0) THEN ! Were messages found? WRITE(6,'('' ERROR: No messages were found.'')') CALL CLOSE_BULLDIR RETURN END IF IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1) IF (EBULL.GT.F_NBULL) EBULL = F_NBULL IF (SBULL.LE.0.OR.IER1.NE.0) THEN WRITE (6,'(A)') & ' ERROR: Specified message number has incorrect format.' CALL CLOSE_BULLDIR RETURN ELSE NUM_COPY = EBULL - SBULL + 1 BULL_POINT = SBULL END IF IF (NUM_COPY.GT.1) ALL = .TRUE. IF (INDEX(BULL_PARAMETER,'LAST').GT.0.AND.ORIGINAL) THEN NEWGROUP = .TRUE. ! Kludgey way of detecting new2bull NEXT = .TRUE. ! If SBULL does not exist, will find ELSE ! next message after SBULL SBULL1 = SBULL CALL READDIR(SBULL,IER) IF (IER.NE.SBULL+1.OR.SBULL.NE.SBULL1) THEN WRITE(6,'('' ERROR: Specified message was not found.'')') CALL CLOSE_BULLDIR RETURN END IF END IF ELSE IF (ALL) THEN NUM_COPY = NBULL BULL_POINT = 1 NEWGROUP = .TRUE. NEXT = .TRUE. END IF END IF IF (REMOTE_SET.OR.REMOTE_SET.EQ.4) THEN IF (.NOT.TEMP_FILE) THEN OPEN (UNIT=12,FILE='REMOTE.BULLDIR', & STATUS='SCRATCH',FORM='UNFORMATTED',IOSTAT=IER) IF (IER.EQ.0) THEN OPEN (UNIT=11,FILE='REMOTE.BULLFIL', & STATUS='SCRATCH',IOSTAT=IER, & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, & FORM='UNFORMATTED') END IF ELSE REWIND (12,IOSTAT=IER) END IF IF (IER.EQ.0) THEN TEMP_FILE = .TRUE. CALL OPEN_BULLFIL CALL READDIR(0,IER) I = BULL_POINT - 1 IER = I + 1 NBLOCK = 1 LAST = BULL_POINT+NUM_COPY-1 NUM_COPY = 0 DO WHILE (I.LT.LAST.AND.IER.EQ.I+1) I = I + 1 CALL READDIR(I,IER) IF (IER.EQ.I+1.AND.I.LE.LAST) THEN CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) IF (REMOTE_SET) THEN CALL REMOTE_READ_MESSAGE(I,IER1) IF (IER1.GT.0) THEN CALL DISCONNECT_REMOTE ELSE CALL GET_REMOTE_MESSAGE(IER1) END IF ELSE IER1 = 0 END IF IF (LENGTH.EQ.0) IER1 = 1 ! Don't allow empty messages IF (IER1.EQ.0) THEN SCRATCH_R = SCRATCH_R1 DO J=1,LENGTH IF (REMOTE_SET) THEN CALL READ_QUEUE(%VAL(SCRATCH_R), & SCRATCH_R,INPUT(:128)) ELSE READ (1'BLOCK+J-1,IOSTAT=IER1) INPUT(:128) END IF WRITE (11'NBLOCK+J-1,IOSTAT=IER1) INPUT(:128) END DO END IF NEWS2BULL = NEWS2BULL.AND..NOT.TO_NEWS.AND.ORIGINAL IF (IER1.EQ.0.AND..NOT.NEWS2BULL) THEN BLOCK = NBLOCK NBLOCK = NBLOCK + LENGTH WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY END IF IF (TO_NEWS.AND.ORIGINAL) THEN WRITE (12,IOSTAT=IER1) NEWS_MSGID END IF IF (IER1.NE.0) THEN I = IER ELSE IF (.NOT.NEWS2BULL) THEN NUM_COPY = NUM_COPY + 1 END IF NEWS2BULL = .FALSE. END IF END DO CALL CLOSE_BULLFIL END IF IF (IER1.NE.0.OR..NOT.TEMP_FILE.OR.NUM_COPY.EQ.0) THEN WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')') CLOSE (UNIT=12) CLOSE (UNIT=11) TEMP_FILE = .FALSE. CALL CLOSE_BULLDIR RETURN END IF END IF CALL CLOSE_BULLDIR SAVE_FOLDER = FOLDER SAVE_FOLDER_NUMBER = FOLDER_NUMBER FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER FROM_BULL_POINT = BULL_POINT CALL SELECT_FOLDER(.FALSE.,IER) IER1 = .TRUE. POST_NEWS = (REMOTE_SET.EQ.4.AND..NOT.BULLCP_NEWS).OR.REMOTE_SET.EQ.3 POST_FEED = .FALSE. SLIST = 0 IF (.NOT.IER) THEN WRITE (6,'('' ERROR: Cannot access specified folder.'')') ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN IF (READ_ONLY) THEN WRITE (6,'('' ERROR: No access to write into folder.'')') ELSE WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')') END IF IER1 = .FALSE. ELSE IF (REMOTE_SET.EQ.0) THEN IF (.NOT.CLI$PRESENT('LOCAL').AND.NEWS_FEED()) THEN SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 FOLDER1_DESCRIP = & FOLDER_DESCRIP(SLIST:INDEX(FOLDER_DESCRIP,'>')-1) POST_FEED = .TRUE. END IF IF (NEWS_FEED()) THEN SLIST = INDEX(FOLDER_DESCRIP,'[') + 1 ELSE SLIST = INDEX(FOLDER_DESCRIP,'<') + 1 END IF IF (SLIST.GT.1) THEN IF (NEWS_FEED()) THEN ELIST = INDEX(FOLDER_DESCRIP,']') - 1 ELSE ELIST = INDEX(FOLDER_DESCRIP,'>') - 1 END IF END IF IF (CLI$PRESENT('LOCAL').AND..NOT.BULLCP_NEWS) SLIST = 0 END IF IF (.NOT.IER.OR..NOT.IER1) THEN FOLDER_NUMBER = SAVE_FOLDER_NUMBER IF (.NOT.IER) THEN FOLDER = SAVE_FOLDER BULL_POINT = SAVE_BULL_POINT ELSE FOLDER_NUMBER = SAVE_FOLDER_NUMBER FOLDER1 = SAVE_FOLDER CALL SELECT_FOLDER(.FALSE.,IER1) END IF BULL_POINT = SAVE_BULL_POINT CLOSE (UNIT=12) CLOSE (UNIT=11) TEMP_FILE = .FALSE. RETURN END IF C C Add bulletin to bulletin file and directory entry for to directory file. C IF (POST_NEWS.OR.(POST_FEED.AND.SLIST.LE.1)) THEN OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST') SCRFILE = 'SYS$LOGIN:BULL.SCR' END IF IF (.NOT.POST_NEWS) THEN CALL OPEN_BULLDIR ! Prepare to add dir entry IF (REMOTE_SET.EQ.4) THEN ! In case exdate has bad date IF (FOLDER_BBEXPIRE.GT.0) THEN EX = FOLDER_BBEXPIRE ELSE EX = NEWS_EXPIRE_DEFAULT END IF CALL GET_EXDATE(EXDATE,EX) CALL SYS$ASCTIM(,TODAY,,) ! Get the present time EXTIME = TODAY(13:) END IF CALL OPEN_BULLFIL ! Prepare to add bulletin CALL READDIR(0,IER) ! Get NBLOCK IF (IER.EQ.0.AND.REMOTE_SET.LT.3) NBLOCK = 0 END IF FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) & //SAVE_FOLDER IF (.NOT.FROM_REMOTE.AND.FROM_REMOTE.NE.4) THEN DO WHILE (FILE_LOCK(IER,IER1)) OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED', & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4, & ORGANIZATION='INDEXED',IOSTAT=IER, & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED') END DO IF (IER.EQ.0) THEN DO WHILE (FILE_LOCK(IER,IER1)) OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE)) & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER, & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32, & FORM='UNFORMATTED') END DO END IF ELSE IER= 0 END IF IF (REMOTE_SET.GE.3) THEN SAVE_HEADER = HEADER IF (CLI$PRESENT('HEADER')) THEN HEADER = .TRUE. ELSE HEADER = .FALSE. END IF END IF IF (MERGE) CALL INITIALIZE_MERGE(IER) START_BULL_POINT = BULL_POINT IF (IER.EQ.0) THEN IF (FROM_REMOTE.OR.FROM_REMOTE.EQ.4) THEN REWIND (12) ELSE READ (12,KEYID=0,KEY=FROM_BULL_POINT-1,IOSTAT=IER) END IF END IF DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0) READ (12,IOSTAT=IER) BULLDIR_ENTRY IF ((FROM_REMOTE.OR.FROM_REMOTE.EQ.4).AND. & (TO_NEWS.AND.ORIGINAL)) THEN READ (12,IOSTAT=IER) NEWS_MSGID END IF NUM_COPY = NUM_COPY - 1 CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) CALL CONVERT_ENTRY_FROMBIN_FOLDER IF (REMOTE_SET.GE.3) SYSTEM = 0 IF (FROM_REMOTE.GE.3.AND.REMOTE_SET.LE.3) THEN SYSTEM = 0 IF (FOLDER_BBEXPIRE.GT.0) THEN CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message EXDATE = '5-NOV-2100' SYSTEM = 2 ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN CALL GET_EXDATE(EXDATE,14) END IF ELSE IF (REMOTE_SET.EQ.4.AND.ORIGINAL) THEN IF (EX_BTIM(1).NE.0.OR.EX_BTIM(2).NE.0) THEN LIMIT = NEWS_F_EXPIRE_LIMIT IF (LIMIT.EQ.0) LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT IF (LIMIT.GT.0) THEN CALL GET_EXDATE(EXDATE,LIMIT) CALL SYS_BINTIM(EXDATE,BTIM) IF (COMPARE_BTIM(BTIM,EX_BTIM).LT.0) THEN CALL COPY2(EX_BTIM,BTIM) END IF END IF CALL SYS$ASCTIM(,EXDATE,EX_BTIM,) IF (COMPARE_DATE(EXDATE,' ').LE.0) THEN IER = 0 GO TO 100 END IF ELSE IF (FOLDER_BBEXPIRE.GT.0) THEN EX = FOLDER_BBEXPIRE ELSE EX = NEWS_EXPIRE_DEFAULT END IF IF (F_LAST.EQ.0) THEN EX = EX + COMPARE_DATE(DATE,' ') IF (EX.LE.0) THEN IER = 0 GO TO 100 END IF END IF CALL GET_EXDATE(EXDATE,EX) END IF CALL SYS$ASCTIM(,TODAY,,) ! Get the present time EXTIME = TODAY(13:) END IF IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? & .NOT.SETPRV_PRIV()) THEN ! Or no privileges? SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit END IF IF (BTEST(SYSTEM,2).AND. ! Shutdown message? & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder? & .NOT.SETPRV_PRIV())) THEN ! Or no privileges? SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit WRITE (6,'('' ERROR: No privileges to add'', & '' shutdown message.'')') IF (FOLDER_BBEXPIRE.GT.0) THEN CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) WRITE (6,'('' Expiration will be '',I,'' days.'')') & FOLDER_BBEXPIRE ELSE CALL GET_EXDATE(EXDATE,14) WRITE (6,'('' Expiration will be '',I,'' days.'')') 14 END IF EXTIME = '00:00:00.00' ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent? & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present? & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN WRITE (6,'('' ERROR: No privileges to add'', & '' permanent message.'')') WRITE (6,'('' Expiration will be '',I,'' days.'')') & F_EXPIRE_LIMIT SYSTEM = IBCLR(SYSTEM,1) CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT) EXTIME = '00:00:00.00' END IF IF (.NOT.ORIGINAL) THEN ! If not /ORIGINAL FROM = USERNAME ! Specify owner END IF IF (REMOTE_SET.EQ.1) THEN WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2 IF (IER.NE.0) CALL ERROR_AND_EXIT END IF IF (SLIST.GT.1.OR.POST_NEWS.OR.POST_FEED) THEN BLOCK_SAVE = BLOCK LENGTH_SAVE = LENGTH IF (SLIST.GT.1) THEN OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') SCRFILE = 'SYS$LOGIN:BULL.SCR' IF (IER.NE.0) THEN OPEN(UNIT=3,FILE='BULL.SCR',IOSTAT=IER, & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST') SCRFILE = 'BULL.SCR' END IF ENDIF ILEN = LINE_LENGTH + 1 INFROM = FROM CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN INFROM = INPUT(7:) CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) END IF IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN POST_SUBJECT = INPUT(7:ILEN) ELSE POST_SUBJECT = DESCRIP IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN) END IF DO WHILE (ILEN.GT.0) ! Copy bulletin into file CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN) END DO REWIND (UNIT=3) IF (POST_NEWS.OR.POST_FEED) THEN USE_INFROM = ORIGINAL IF (CLI$PRESENT('LOCAL')) NEWS2BULL = .TRUE. CALL NEWS_POST & (SCRFILE(:TRIM(SCRFILE)),.TRUE.,IER,POST_SUBJECT) NEWS2BULL = .FALSE. END IF IF (SLIST.GT.1) THEN CLOSE (UNIT=3) USE_INFROM = ORIGINAL IF (BTEST(FOLDER_FLAG,10).OR.BTEST(FOLDER_FLAG,15)) THEN CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), & FOLDER_DESCRIP(SLIST:ELIST), & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) ELSE CALL RESPOND_MAIL(SCRFILE(:TRIM(SCRFILE)), & FOLDER_DESCRIP(SLIST:ELIST), & FOLDER(:TRIM(FOLDER))//' folder message: '// & POST_SUBJECT(:TRIM(POST_SUBJECT)),STATUS) END IF CALL LIB$DELETE_FILE(SCRFILE(:TRIM(SCRFILE))//';') ELSE IF (POST_FEED.OR.POST_NEWS) THEN REWIND (UNIT=3) END IF BLOCK = BLOCK_SAVE LENGTH = LENGTH_SAVE END IF IF (.NOT.POST_NEWS) THEN IF (MERGE) CALL ADD_MERGE_TO(IER) IF (REMOTE_SET.EQ.4) CALL SET_BULLFIL_UPDATE IF (IER.EQ.0) THEN NBLOCK = NBLOCK + 1 DO I=BLOCK,BLOCK+LENGTH-1 READ (11'I,IOSTAT=IER) INPUT(:128) IF (IER.EQ.0) THEN CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128)) END IF NBLOCK = NBLOCK + 1 END DO END IF IF (IER.EQ.0) THEN IF (MERGE) THEN CALL ADD_MERGE_FROM(IER) ELSE IF (.NOT.ORIGINAL) SYSTEM = IBSET(SYSTEM,4) CALL ADD_ENTRY ! Add the new directory entry END IF BULL_POINT = BULL_POINT + 1 END IF END IF 100 CONTINUE END DO IF (SLIST.LT.1.AND.POST_NEWS.OR.POST_FEED) CLOSE (UNIT=3) IF (MERGE) CALL ADD_MERGE_REST(IER) IF (.NOT.POST_NEWS) CALL CLOSE_BULLFIL IF (.NOT.(TO_NEWS.AND.ORIGINAL.AND.TEMP_FILE)) THEN CLOSE (UNIT=11) CLOSE (UNIT=12) TEMP_FILE = .FALSE. END IF IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND..NOT.POST_NEWS & .AND.FOLDER_NUMBER.LT.FOLDER_MAX) THEN DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), & F_NEWEST_BTIM) CALL UPDATE_FOLDER ! Update folder info C C If user is adding message, an no new messages, update last read time for C folder, so user is not alerted of new message which is owned by user. C IF (DIFF.GE.0) THEN CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) END IF END IF IF (.NOT.POST_NEWS) CALL CLOSE_BULLDIR ! Totally finished with add IF (IER.EQ.0) THEN IF (TEST_BULLCP().NE.2) & WRITE (6,'('' Successful copy to folder '',A)') & FOLDER(:TRIM(FOLDER))//'.' IF (MERGE) THEN CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))// & '.BULLDIR;-1') END IF ELSE IF (MERGE) THEN WRITE (6,'('' ERROR: Copy aborted. No files copied.'')') ELSE WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')') & BULL_POINT - START_BULL_POINT END IF IF (.NOT.POST_NEWS) HEADER = SAVE_HEADER IF (BULLCP_NEWS) RETURN IF (INDEX(INCMD,' ').EQ.TRIM(INCMD)+1) & INCMD = INCMD(:TRIM(INCMD))//' '//FOLDER1 FOLDER_NUMBER = SAVE_FOLDER_NUMBER FOLDER1 = SAVE_FOLDER CALL SELECT_FOLDER(.FALSE.,IER1) BULL_POINT = SAVE_BULL_POINT IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN IF (FROM_REMOTE.AND.ALL) THEN WRITE (6,'('' WARNING: Original messages not deleted.'')') WRITE (6,'('' Multiple deletions not possible for '', & ''remote folders.'')') ELSE IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) CALL DELETE_MSG END IF END IF RETURN END SUBROUTINE PRINT(PRINT_NUM,OPEN_IT) C C SUBROUTINE PRINT C C FUNCTION: Print header to queue. C IMPLICIT INTEGER (A-Z) INCLUDE '($SJCDEF)' INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' COMMON /POINT/ BULL_POINT COMMON /BULLPAR/ BULL_PARAMETER,LEN_P CHARACTER*64 BULL_PARAMETER COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD EXTERNAL CLI$_ABSENT CHARACTER*32 QUEUE,TEST INTEGER*2 IOSB(4) EQUIVALENCE (IOSB(1),JBC_ERROR) CHARACTER*32 FORM PARAMETER FF = CHAR(12) DATA FIRST /.TRUE./, CHANGED /.FALSE./ OPENED = .FALSE. IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND. & INCMD(:4).EQ.'PRIN') THEN WRITE (6,'('' Printing all previously queued messages.'')') GO TO 200 ELSE IF (.NOT.FIRST) THEN IER = CLI$GET_VALUE('QUEUE',TEST,TLEN) CHANGED = TEST(:TLEN).NE.QUEUE(:QLEN).AND.TLEN.GT.0 CHANGED = CHANGED.OR.CLI$PRESENT('NOTIFY').NE.NOTIFY IER = CLI$GET_VALUE('FORM',TEST,FLEN) CHANGED = CHANGED.OR.(TEST(:TLEN).NE.FORM(:FLEN).AND.TLEN.GT.0) IF (CHANGED) THEN WRITE (6,'('' Printing all previously queued messages.'')') GO TO 200 END IF END IF IF (INCMD(:4).EQ.'PRIN') THEN IF (CLI$PRESENT('CANCEL')) THEN WRITE (6,'('' Cancelling all previously queued messages.'')') CLOSE (UNIT=24,DISPOSE='DELETE') FIRST = .TRUE. RETURN END IF END IF 50 IF (PRINT_NUM.EQ.0) THEN IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P) IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified? CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER) IF (EBULL.GT.F_NBULL) EBULL = F_NBULL ELSE IF (OPENED) THEN CALL CLOSE_BULLFIL CALL CLOSE_BULLDIR GO TO 150 ELSE IF (CLI$PRESENT('ALL')) THEN SBULL = 1 EBULL = F_NBULL IER = 0 ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin? WRITE(6,1010) ! No, then error. RETURN ELSE SBULL = BULL_POINT EBULL = SBULL IER = 0 END IF IF (SBULL.LE.0.OR.IER.NE.0.OR.EBULL.LT.SBULL) THEN WRITE (6,1015) IF (OPENED) THEN CALL CLOSE_BULLFIL CALL CLOSE_BULLDIR END IF WRITE (6,'(1X,A)') BULL_PARAMETER(:LEN_P) RETURN END IF ELSE SBULL = PRINT_NUM EBULL = SBULL END IF IF (FIRST) THEN QLEN = 0 IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name IF (QLEN.EQ.0) THEN QUEUE = 'SYS$PRINT' QLEN = TRIM(QUEUE) END IF NOTIFY = CLI$PRESENT('NOTIFY') FLEN = 0 IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name CALL DISABLE_PRIVS OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER, & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') CALL ENABLE_PRIVS END IF IF (OPEN_IT) THEN CALL OPEN_BULLDIR_SHARED CALL OPEN_BULLFIL_SHARED OPENED = .TRUE. END IF HEAD = CLI$PRESENT('HEADER') DO I=SBULL,EBULL I1 = I CALL READDIR(I,IER) ! Get info for specified message IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1 IF (I1.GT.SBULL) GO TO 100 CLOSE (UNIT=24,DISPOSE='DELETE') IF (OPEN_IT) THEN CALL CLOSE_BULLFIL CALL CLOSE_BULLDIR END IF RETURN ELSE IF (REMOTE_SET) THEN CALL REMOTE_READ_MESSAGE(I,IER1) IF (IER1.GT.0) THEN CALL DISCONNECT_REMOTE ELSE CALL GET_REMOTE_MESSAGE(IER1) END IF IF (IER1.NE.0) GO TO 100 END IF IF (.NOT.FIRST) THEN WRITE (24,'(A)') FF ELSE FIRST = .FALSE. END IF ILEN = LINE_LENGTH + 1 CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN IF (HEAD) THEN WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8) END IF CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) ELSE IF (HEAD) THEN WRITE(24,1060) FROM,DATE//' '//TIME(:8) END IF IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN IF (HEAD) WRITE(24,1050) INPUT(7:ILEN) ELSE IF (HEAD) WRITE(24,1050) DESCRIP IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN) END IF DO WHILE (ILEN.GT.0) ! Copy bulletin into file CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN) END DO END DO 100 IF (PRINT_NUM.EQ.0) THEN IER = OTS$CVT_L_TI(SBULL,BULL_PARAMETER,,,) IF (SBULL.EQ.EBULL) THEN WRITE(6,1040) & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) ELSE WRITE(6,1045) & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) IER = OTS$CVT_L_TI(EBULL,BULL_PARAMETER,,,) WRITE(6,1046) & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):) END IF 1040 FORMAT(' Message ',A,' sent to printer.') 1045 FORMAT(' Messages ',A,$) 1046 FORMAT('+-',A,' sent to printer.') GO TO 50 ELSE IF (OPEN_IT) THEN CALL CLOSE_BULLFIL CALL CLOSE_BULLDIR END IF 150 IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN ENTRY PRINT_NOW 200 IF (FIRST) RETURN FIRST = .TRUE. CLOSE (UNIT=24) CALL INIT_ITMLST ! Initialize item list CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION, & %LOC('SYS$LOGIN:BULL.LIS')) CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE)) CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0) IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0) IF (FLEN.GT.0) THEN CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM)) END IF CALL DISABLE_PRIVS CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM)) CALL END_ITMLST(SJC_ITMLST) IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,) IF (IER.AND.(.NOT.JBC_ERROR)) THEN CALL SYS_GETMSG(JBC_ERROR) IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') ELSE IF (.NOT.IER) THEN CALL SYS_GETMSG(IER) IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;') ELSE IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,) IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A, & '') started on '',A)') QUEUE(:QLEN), & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN) END IF CALL ENABLE_PRIVS ! Reset SYSPRV privileges IF (CHANGED) THEN CHANGED = .FALSE. GO TO 50 END IF RETURN 900 CALL ERRSNS(IDUMMY,IER) CALL ENABLE_PRIVS ! Reset SYSPRV privileges WRITE(6,1000) CALL SYS_GETMSG(IER) RETURN 1000 FORMAT(' ERROR: Unable to open temporary file & SYS$LOGIN:BULL.LIS for printing.') 1010 FORMAT(' ERROR: You have not read any message.') 1015 FORMAT(' ERROR: Specified message number has incorrect format:') 1030 FORMAT(' ERROR: Following bulletin was not found: ',I) 1050 FORMAT('Description: ',A,/) 1060 FORMAT('From: ',A,/,'Date: ',A) END SUBROUTINE READ_MSG(READ_COUNT,BULL_READ) C C SUBROUTINE READ_MSG C C FUNCTION: Reads a specified bulletin. C C PARAMETER: C READ_COUNT - Variable to store the record in the message file C that READ will read from. Must be set to 0 to indicate C that it is the first read of the message. If -1, C READ will search for the last message in the message file C and read that one. If -2, just display header information. C BULL_READ - Message number to be read. C IMPLICIT INTEGER (A - Z) COMMON /POINT/ BULL_POINT INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLUSER.INC' COMMON /READIT/ READIT COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING LOGICAL PAGING COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /READ_DISPLAY/ LINE_OFFSET COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG COMMON /HEADER/ HEADER COMMON /NEXT/ NEXT LOGICAL NEXT /.FALSE./ COMMON /POST/ POSTTIME COMMON /MSGID/ MESSAGE_ID CHARACTER*256 MESSAGE_ID COMMON /BULL_USER_CUSTOM/ BULL_USER_CUSTOM DATA BULL_USER_CUSTOM/.FALSE./ COMMON /THREAD/ THREAD DATA THREAD /.FALSE./ COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP COMMON /MAIN_HEADER_INFO/ INEXDATE CHARACTER*(INPUT_LENGTH) INFROM,INDESCRIP DATA SCRATCH_B1/0/,LAST_THREAD/.FALSE./ CHARACTER TODAY*12,DATETIME*24,BUFFER*(INPUT_LENGTH) CHARACTER HEADLINE*132 LOGICAL SINCE,PAGE EXTERNAL CLI$_NEGATED FIRST = BULL_READ.LT.F_START KILL = BTEST(BULL_USER_CUSTOM,3) BULL_USER_CUSTOM = IBCLR(BULL_USER_CUSTOM,3) POSTTIME = .TRUE. CALL LIB$ERASE_PAGE(1,1) ! Clear screen END = 0 ! Nothing outputted on screen IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is ! not first page of bulletin IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR. & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR. & INCMD(:4).EQ.'FIRS'.OR.INCMD(:1).EQ.'N') THEN IF (CLI$PRESENT('HEADER')) THEN HEADER = .TRUE. ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN HEADER = .FALSE. END IF ROTC = CLI$PRESENT('ROTATE') END IF SINCE = .FALSE. NEW = .FALSE. PAGE = .TRUE. THREAD = .FALSE. IER = 0 IF (.NOT.PAGING) PAGE = .FALSE. IF (INCMD(:4).EQ.'READ') THEN ! If READ command... POSTTIME = CLI$PRESENT('POST') THREAD = CLI$PRESENT('THREADS') IF (CLI$PRESENT('MARKED')) THEN READ_TAG = 1 + IBSET(0,1) ELSE IF (CLI$PRESENT('SEEN')) THEN READ_TAG = 1 + IBSET(0,2) ELSE IF (CLI$PRESENT('UNMARKED').OR. & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN READ_TAG = 1 + IBSET(0,1) + IBSET(0,3) ELSE IF (CLI$PRESENT('UNSEEN').OR. & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) ELSE IF (CLI$PRESENT('ALL')) THEN READ_TAG = IBSET(0,1) + IBSET(0,2) IF (REMOTE_SET.GE.3) THEN BULL_READ = F_START ELSE BULL_READ = 1 END IF END IF IF (READ_TAG) THEN IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN WRITE (6,'('' ERROR: Invalid qualifier'', & '' with remote folder.'')') READ_TAG = 1 + IBSET(0,2) + IBSET(0,3) GO TO 9999 END IF CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT) END IF IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE. IF (CLI$PRESENT('SINCE').AND. & .NOT.THREAD) THEN ! was /SINCE specified? IER = CLI$GET_VALUE('SINCE',DATETIME) IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default. IER = SYS$BINTIM('-- 00:00:00.00',TODAY) CALL GET_MSGKEY(TODAY,MSG_KEY) ELSE CALL SYS_BINTIM(DATETIME,MSG_BTIM) CALL GET_MSGKEY(MSG_BTIM,MSG_KEY) END IF CALL OPEN_BULLDIR_SHARED CALL READDIR_KEYGE(IER) CALL CLOSE_BULLDIR ELSE IF (CLI$PRESENT('NEW').OR.(THREAD.AND..NOT. & CLI$PRESENT('SINCE').AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') & .AND.(.NOT.LAST_THREAD & .OR.LAST_THREAD_NUMBER.NE.FOLDER_NUMBER) & .AND.CLI$PRESENT('NEW').NE.%LOC(CLI$_NEGATED))) THEN NEW = .TRUE. IF (REMOTE_SET.LT.3) THEN DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1), & F_NEWEST_BTIM) IF (DIFF.GE.0) THEN WRITE (6,'('' No new messages are present.'')') GO TO 9999 ELSE CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), & MSG_KEY) END IF CALL OPEN_BULLDIR_SHARED IER = 0 DO WHILE (IER.EQ.0) CALL READDIR_KEYGE(IER) IF (IER.NE.0.AND.BULL_TAG.AND.BTEST(BULL_TAG,1)) THEN CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,IER,DUMMY) IF (IER1.EQ.0) THEN CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1), & MSG_BTIM) CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1), & MSG_KEY) IER = 0 END IF ELSE IF (IER.EQ.0) THEN CALL CLOSE_BULLDIR WRITE (6,'('' No more messages are present.'')') GO TO 9999 END IF IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN IER = 0 END IF END DO CALL CLOSE_BULLDIR ELSE IER = 0 SKIPPED_THREAD = .FALSE. IF (THREAD) CALL OPEN_BULLDIR_SHARED DO WHILE (IER.EQ.0) IF (.NOT.SKIPPED_THREAD) THEN CALL NEWS_GET_NEWEST_MESSAGE(IER) BULL_READ = IER END IF IF ((SKIPPED_THREAD.OR.(THREAD.AND.IER.NE.0)).AND. & BULL_READ.LE.F_NBULL) THEN CALL READDIR(BULL_READ,IER) IER = IER - 1 IF (IER.NE.BULL_READ) IER = 0 END IF IF (IER.NE.0.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN MSG_NUM = IER CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,DUMMY,DUMMY) IF (IER1.EQ.0) THEN IF (.NOT.SKIPPED_THREAD) THEN CALL NEWS_UPDATE_NEWEST_MESSAGE(IER) ELSE BULL_READ = BULL_READ + 1 END IF IER = 0 END IF ELSE IF (IER.EQ.0) THEN WRITE (6,'('' No more messages are present.'')') IF (SKIPPED_THREAD) CALL CLOSE_BULLDIR GO TO 9999 END IF IF (IER.NE.0.AND.THREAD.AND..NOT.BTEST(SYSTEM,8)) THEN SKIPPED_THREAD = .TRUE. BULL_READ = IER + 1 IER = 0 END IF END DO END IF IF (THREAD) CALL CLOSE_BULLDIR BULL_READ = IER IER = IER + 1 ELSE IF (THREAD) THEN IF (CLI$PRESENT('SINCE')) THEN IF (IER.EQ.0) THEN WRITE (6,'('' No messages past specified date.'')') GO TO 9999 ELSE BULL_READ = IER - 1 IER = IER + 1 END IF SINCE = .TRUE. ELSE IF (CLI$PRESENT('BULLETIN_NUMBER')) THEN BULL_READ = BULL_READ - 1 ELSE IF (LAST_THREAD_NUMBER.EQ.FOLDER_NUMBER) THEN BULL_READ = LAST_THREAD_READ ELSE BULL_READ = BULL_POINT - 1 END IF CALL OPEN_BULLDIR_SHARED IER = BULL_READ + 1 IER1 = .FALSE. DO WHILE (.NOT.IER1.AND.IER.EQ.BULL_READ+1.AND. & BULL_READ.LT.F_NBULL) BULL_READ = BULL_READ + 1 CALL READDIR(BULL_READ,IER) IER1 = BTEST(SYSTEM,8) IF (IER1.AND.((BULL_NEWS_TAG.AND.REMOTE_SET.GE.3) & .OR.(BULL_TAG.AND.BTEST(BULL_TAG,1)))) THEN CALL GET_THIS_TAG(FOLDER_NUMBER,IER2,DUMMY,DUMMY) IER1 = IER2.NE.0 END IF END DO IF (.NOT.IER1) THEN WRITE (6,'('' No more messages are present.'')') GO TO 9999 END IF END IF END IF NEXT = .FALSE. LAST_THREAD = .FALSE. IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN NEXT = .TRUE. ELSE IF (INCMD(:4).EQ.'READ') THEN LAST_THREAD = THREAD IF (THREAD) THEN LAST_THREAD_READ = BULL_READ LAST_THREAD_NUMBER = FOLDER_NUMBER ELSE IF (.NOT.SINCE.AND..NOT.NEW & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER') & .AND..NOT.CLI$PRESENT('ALL')) NEXT = .TRUE. END IF END IF BULL_NOW = BULL_POINT OK = .TRUE. 50 IF (READ_TAG) THEN IER = 0 IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.GE.3).OR. & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN IF (BULL_NOW.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN MSG_NUM = F_NBULL+1 ELSE MSG_NUM = BULL_NOW END IF CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) IF (IER1.EQ.0) IER = BULL_READ + 1 ELSE IF (INCMD(:4).EQ.'BACK') THEN CALL OPEN_BULLDIR_SHARED CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) CALL CLOSE_BULLDIR IF (IER1.EQ.0) IER = BULL_READ + 1 ELSE IF (INCMD(:4).EQ.'LAST') THEN CALL OPEN_BULLDIR_SHARED IF (BULL_NOW.GT.0) THEN CALL READDIR(BULL_NOW,IER) IF (IER.NE.BULL_NOW+1) THEN BULL_NOW = 0 ELSE CALL GET_THIS_OR_NEXT_TAG & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY) IF (IER1.NE.0) BULL_NOW = 0 END IF END IF IF (BULL_NOW.EQ.0) THEN CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) IF (IER1.EQ.0) IER = BULL_READ + 1 END IF DO WHILE (IER1.EQ.0) CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) IF (IER1.EQ.0) IER = BULL_READ + 1 END DO CALL CLOSE_BULLDIR ELSE IF (INCMD(:4).EQ.'FIRS') THEN CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) IF (IER1.EQ.0) IER = BULL_READ + 1 ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN OLD_NEXT = NEXT NEXT = .FALSE. IF (NEW) MSG_NUM = BULL_READ IF (.NOT.OLD_NEXT) THEN CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) ELSE IF (REMOTE_SET.GE.3) THEN MSG_NUM = BULL_NOW ELSE IF (BULL_NOW.GT.0) THEN CALL OPEN_BULLDIR_SHARED CALL READDIR(BULL_NOW,IER) CALL CLOSE_BULLDIR ELSE MSG_KEY = BULLDIR_HEADER MSG_NUM = 0 END IF CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) END IF NEXT = OLD_NEXT IF (IER1.EQ.0) THEN IER = BULL_READ + 1 ELSE IER = 0 END IF END IF END IF IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND. & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND. & INCMD(:4).NE.'FIRS'))) THEN IF (BULL_READ.GT.0) THEN ! Valid bulletin number? CALL OPEN_BULLDIR_SHARED CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.GE.3 & .AND.INCMD(:4).EQ.'READ') THEN IF (NEW) THEN NEXT = .TRUE. CALL READDIR(BULL_READ,IER) END IF END IF IF (REMOTE_SET.LT.3.AND. & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN READ_COUNT = 0 IF (IER.NE.BULL_READ+1) THEN CALL READDIR(0,IER) IF (NBULL.GT.0) THEN BULL_READ = NBULL CALL READDIR(BULL_READ,IER) ELSE IER = 0 END IF END IF ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY) IF (IER1.NE.0) IER = 0 END IF CALL CLOSE_BULLDIR ELSE IER = -1 END IF END IF IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found? IF (REMOTE_SET.LT.3) THEN WRITE(6,1030) ! If not, then error out ELSE WRITE(6,1040) END IF NEXT = .FALSE. IF (.NOT.OK.AND..NOT.REMOTE_SET) CALL CLOSE_BULLFIL GO TO 9999 END IF SAVE_BULL_POINT = BULL_POINT BULL_POINT = BULL_READ ! Update bulletin counter IF (OK.OR.REMOTE_SET) CALL OPEN_BULLFIL_SHARED IF (BTEST(BULL_USER_CUSTOM,1) & .AND.(FIRST.OR.NEW.OR.NEXT.OR.INCMD(:4).EQ.'BACK'.OR. & INCMD(:4).EQ.'LAST'.OR.INCMD(:4).EQ.'FIRS')) THEN ILEN = LINE_LENGTH + 1 BLOCK_SAVE = BLOCK CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN INFROM = INPUT(7:ILEN) CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) ELSE INFROM = FROM END IF IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN INDESCRIP = INPUT(7:ILEN) ELSE INDESCRIP = DESCRIP END IF OK = INCLUDE_MSG(INFROM,INDESCRIP) OK = OK.AND.(.NOT.THREAD.OR.BTEST(SYSTEM,8)) IF (.NOT.OK) THEN BULL_POINT = SAVE_BULL_POINT BULL_NOW = MSG_NUM IF (INCMD(:4).EQ.'BACK'.OR.INCMD(:4).EQ.'LAST') THEN BULL_READ = MSG_NUM - 1 ELSE BULL_READ = MSG_NUM + 1 IF (INCMD(:4).EQ.'FIRS'.OR.FIRST) NEXT = .TRUE. END IF IF (REMOTE_SET) CALL CLOSE_BULLFIL IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN DIFF = COMPARE_BTIM(MSG_BTIM, & LAST_READ_BTIM(1,FOLDER_NUMBER+1)) IF (DIFF.GT.0) THEN CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) END IF ELSE IF (.NOT.THREAD) THEN CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_NOW) END IF IF (BULL_READ.GT.F_NBULL.OR.BULL_READ.LT.F_START) THEN IF (REMOTE_SET.LT.3) THEN WRITE(6,1030) ELSE WRITE(6,1040) END IF NEXT = .FALSE. IF (.NOT.REMOTE_SET) CALL CLOSE_BULLFIL GO TO 9999 END IF GO TO 50 END IF BLOCK = BLOCK_SAVE END IF NEXT = .FALSE. IF (REMOTE_SET.LT.3.AND..NOT.THREAD) THEN IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1)) IF (DIFF.GT.0) THEN CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM) END IF END IF IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2) IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM) END IF ELSE IF (REMOTE_SET.EQ.4) MESSAGE_ID = NEWS_MSGID IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2) IF (.NOT.THREAD.OR.INCMD(:4).NE.'READ') THEN IF (INCMD.EQ.'LAST'.AND..NOT.READ_TAG) THEN CALL NEWS_UPDATE_NEWEST_MESSAGE(F_NBULL) END IF IF (INCMD(:4).NE.'SEAR'.AND.INCMD(:3).NE.'CUR') THEN CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) ELSE CALL NEWS_GET_NEWEST_MESSAGE(IER) IF (IER.EQ.BULL_READ) & CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ) END IF END IF END IF EDIT = .FALSE. PAGE_WIDTH = REAL_PAGE_WIDTH IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN IF (CLI$PRESENT('EDIT')) THEN OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER, & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST') IF (IER.NE.0) THEN CALL ERRSNS(IDUMMY,IER) CALL SYS_GETMSG(IER) GO TO 9999 END IF EDIT = .TRUE. PAGE_WIDTH = LINE_LENGTH PAGE = .FALSE. END IF END IF IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT IF (REMOTE_SET.GE.3) THEN WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)') & BULL_POINT,F_START,F_NBULL DO WHILE (INDEX(HEADLINE,'- ').GT.0) I = INDEX(HEADLINE,'- ') HEADLINE(I+1:) = HEADLINE(I+2:) END DO ELSE WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL END IF DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE)) I = INDEX(HEADLINE,' ') HEADLINE(I:) = HEADLINE(I+1:) END DO I = TRIM(HEADLINE) HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE)) FLEN = TRIM(FOLDER_NAME) HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN) IF (READIT.GT.0) THEN WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE)) ELSE IF (EDIT) THEN WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE)) ELSE WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE)) END IF END = 1 ! Outputted 1 line to screen IF (EXDATE(8:11).LT.'1995') THEN IF (REMOTE_SET.NE.3) THEN INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) & //' (DELETED)' ELSE INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) END IF ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin? INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) & //' Expires on shutdown' ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin? INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5) & //' Permanent' ELSE INPUT = 'Date: '//DATE(:TRIM(DATE))//' '//TIME(:5)// & ' Expires: '//EXDATE//' '//EXTIME(:5) END IF IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin? INPUT = INPUT(:TRIM(INPUT))//' / System' END IF IF (EDIT) THEN WRITE (3,'(A)') INPUT(:TRIM(INPUT)) ELSE WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT)) END IF END = END + 1 LINE_OFFSET = 0 CHAR_OFFSET = 0 ILEN = LINE_LENGTH + 1 CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ' & .AND..NOT.BTEST(SYSTEM,4)) THEN INPUT = 'From: '//INPUT(7:) DO WHILE (TRIM(INPUT).GT.0) I = MIN(PAGE_WIDTH,TRIM(INPUT)) IF (EDIT) THEN WRITE(3,'(A)') INPUT(:I) ELSE WRITE(6,'(1X,A)') INPUT(:I) END IF INPUT = INPUT(I+1:) END = END + 1 END DO LINE_OFFSET = 1 ELSE IF (EDIT) THEN WRITE(3,'(''From: '',A)') FROM ELSE WRITE(6,'('' From: '',A)') FROM END IF END = END + 1 END IF IF (INPUT(:6).NE.'Subj: ') THEN CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) END IF LEN_TEMP = ILEN CALL CONVERT_TABS(INPUT,LEN_TEMP) IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN INPUT = 'Subj: '//INPUT(7:) DO WHILE (TRIM(INPUT).GT.0) I = MIN(PAGE_WIDTH,TRIM(INPUT)) IF (EDIT) THEN WRITE(3,'(A)') INPUT(:I) ELSE WRITE(6,'(1X,A)') INPUT(:I) END IF INPUT = INPUT(I+1:) END = END + 1 END DO LINE_OFFSET = LINE_OFFSET + 1 IF (EDIT) WRITE(3,'(1X)') ELSE END = END + 1 IF (EDIT) THEN WRITE(3,'(''Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP) ELSE WRITE(6,'('' Subj: '',A)') DESCRIP(:TRIM(DESCRIP)) IF (LINE_OFFSET.EQ.1) THEN CHAR_OFFSET = 1 - PAGE_WIDTH LINE_OFFSET = 2 IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) END IF END IF END IF IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1 CALL CLOSE_BULLFIL ! End of bulletin file read IF (EDIT) GO TO 200 WRITE(6,'(1X)') IF (READIT.GT.0) WRITE(6,'(1X)') END = END + 1 C C Each page of the bulletin is buffered into temporary memory storage before C being outputted to the terminal. This is to be able to quickly close the C bulletin file, and to avoid the possibility of the user holding the screen, C and thus causing the bulletin file to stay open. The temporary memory C is structured as a linked-list queue, where SCRATCH_B1 points to the header C of the queue. See BULLSUBS.FOR for more description of the queue. C IF (SCRATCH_B1.NE.0) THEN ! Is queue empty? SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head ELSE ! Else if queue is empty CALL INIT_QUEUE(SCRATCH_B,INPUT) SCRATCH_B1 = SCRATCH_B ! Init header pointer END IF READ_ALREADY = 0 ! Number of lines already read ! from record. IF (READ_COUNT.EQ.-2) THEN ! Just output header first read READ_COUNT = BLOCK GO TO 9999 ELSE READ_COUNT = BLOCK ! Init bulletin record counter END IF GO TO 200 100 IF (READIT.EQ.0) THEN ! If not 1st page of READ WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info END = END + 2 ! Increase display counter END IF SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header 200 DISPLAY = 0 IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines CALL OPEN_BULLFIL_SHARED ! Get bulletin file MORE_LINES = .TRUE. DO WHILE (ILEN.GT.0.AND.MORE_LINES) IF (CHAR_OFFSET.EQ.0) THEN CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) LINE_OFFSET = LINE_OFFSET + 1 END IF IF (ILEN.LT.0) THEN ! Error, couldn't read record ILEN = 0 ! Fake end of reading file MORE_LINES = .FALSE. ELSE IF (ILEN.GT.0) THEN IF (EDIT) THEN WRITE(3,'(A)') INPUT(:ILEN) ELSE IF (CHAR_OFFSET.EQ.0) THEN LEN_TEMP = ILEN CALL CONVERT_TABS(INPUT,LEN_TEMP) IF (ROTC) CALL CONVERT_ROTC(INPUT,LEN_TEMP) IF (LEN_TEMP.GT.PAGE_WIDTH) THEN CHAR_OFFSET = 1 BUFFER = INPUT(:PAGE_WIDTH) CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ELSE CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT) END IF ELSE CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP) CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) CHAR_OFFSET = 0 ELSE BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1) CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) END IF END IF DISPLAY = DISPLAY + 1 IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN MORE_LINES = .FALSE. END IF END IF END DO CALL CLOSE_BULLFIL ! End of bulletin file read IF (EDIT) THEN CLOSE (UNIT=3) CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ') CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*') READ_COUNT = 0 ! init bulletin record counter GO TO 9999 END IF C C Bulletin page is now in temporary memory, so output to terminal. C Note that if this is a /READ, the first line will have problems with C the usual FORMAT statement. It will cause a blank line to be outputted C at the top of the screen. This is because of the input QIO at the C end of the previous page. The output gets confused and thinks it must C end the previous line. To prevent that, the first line of a new page C in a /READ must use a different FORMAT statement to surpress the CR/LF. C SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head DO I=1,DISPLAY ! Output page to terminal CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record IF (I.EQ.1.AND.READIT.GT.0) THEN WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments) ELSE WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER)) END IF END DO IF (ILEN.EQ.0) THEN ! End of message? READ_COUNT = 0 ! init bulletin record counter ELSE ! Possibly end of message since end of page could be last line CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC) IF (IREC.EQ.0) THEN ! Last record? CALL TEST_MORE_LINES(ILEN) ! More lines to read? IF (ILEN.GT.0) THEN ! Yes, there are still more IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin ELSE ! Yes, last line anyway READ_COUNT = 0 ! init bulletin record counter END IF ELSE IF (READIT.EQ.0) THEN ! Not last record so WRITE(6,1070) ! say there is more of bulletin END IF END IF 9999 POSTTIME = .FALSE. IF (KILL) BULL_USER_CUSTOM = IBSET(BULL_USER_CUSTOM,3) RETURN 1030 FORMAT(' No more messages.') 1040 FORMAT(' Message not found.') 1070 FORMAT(1X,/,' Press RETURN for more...',/) 2000 FORMAT(A) END SUBROUTINE CONVERT_ROTC(INPUT,LEN_TEMP) IMPLICIT INTEGER (A-Z) CHARACTER INPUT*(*) DO I=1,LEN_TEMP IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) IF (INPUT(I:I).LT.'A') & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) ELSE IF (INPUT(I:I).GE.'a'.AND.INPUT(I:I).LE.'z') THEN INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - 13) IF (INPUT(I:I).LT.'a') & INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) + 26) END IF END DO RETURN END SUBROUTINE READNEW(REDO) C C SUBROUTINE READNEW C C FUNCTION: Displays new non-system bulletins with prompts between bulletins. C IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' COMMON /BULLPAR/ BULL_PARAMETER,LEN_P CHARACTER*64 BULL_PARAMETER COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2) COMMON /POINT/ BULL_POINT COMMON /READ_DISPLAY/ LINE_OFFSET COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING LOGICAL PAGING COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /ACCESS/ READ_ONLY LOGICAL READ_ONLY EXTERNAL BULLETIN_SUBCOMMANDS CHARACTER INREAD4*4,FILE_DEF*80,NUMREAD*8 CHARACTER INREAD*1 EQUIVALENCE (INREAD4,INREAD) DATA LEN_FILE_DEF /0/, INREAD/0/ LOGICAL SLOW,SLOW_TERMINAL FIRST_MESSAGE = BULL_POINT IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time SLOW = SLOW_TERMINAL() ! Check baud rate of terminal END IF ! to avoid gobs of output LEN_P = 0 ! Tells read subroutine there is ! no bulletin parameter 1 WRITE(6,1000) ! Ask if want to read new bulletins CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ IF (IER.NE.0) THEN INREAD = NUMREAD(:1) IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN IF (INREAD.EQ.'Q') THEN WRITE (6,'(''+uit'',$)') ELSE IF (INREAD.EQ.'E') THEN WRITE (6,'(''+xit'',$)') DO I=1,FLONG ! Just show SYSTEM folders NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I) END DO DO I=1,FLONG ! Test for new messages in SYSTEM folders IF (NEW_MSG(I).NE.0) RETURN END DO CALL EXIT ELSE WRITE (6,'(''+o'',$)') END IF RETURN ! If NO, exit ! Include QUIT to be consistent with next question ELSE CALL LIB$ERASE_PAGE(1,1) END IF END IF 3 IF (TEMP_READ.GT.0) THEN IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN WRITE (6,'('' ERROR: Specified new message not found.'')') GO TO 1 ELSE BULL_POINT = TEMP_READ - 1 END IF END IF READ_COUNT = 0 ! Initialize display pointer 5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin BULL_POINT_READ = BULL_POINT IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed? CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls 10 CALL READDIR(BULL_POINT+1,IER_POINT) IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it. BULL_POINT = BULL_POINT + 1 GO TO 10 END IF CALL CLOSE_BULLDIR END IF GO TO 12 11 IF (READ_COUNT.GT.0) THEN CALL OPEN_BULLDIR_SHARED CALL OPEN_BULLFIL_SHARED CALL READDIR(BULL_POINT,IER) ILEN = LINE_LENGTH+1 DO I=1,LINE_OFFSET CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) END DO CALL CLOSE_BULLFIL CALL CLOSE_BULLDIR END IF BULL_POINT = BULL_POINT_SAVE LENGTH = LENGTH_SAVE BLOCK = BLOCK_SAVE 12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between WRITE(6,1020) ! full screens or end of bull. ELSE WRITE(6,1030) END IF CALL GET_INPUT_NOECHO(INREAD) CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case BLOCK_SAVE = BLOCK LENGTH_SAVE = LENGTH BULL_POINT_SAVE = BULL_POINT IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT WRITE (6,'(''+Quit'',$)') RETURN ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory WRITE (6,'(''+Dir'',$)') REDO = .TRUE. RETURN ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE(1)) THEN ! If F then copy bulletin to file WRITE (6,'(''+ '')') ! Move cursor from end of prompt line ! to beginning of next line. IF (LEN_FILE_DEF.EQ.0) THEN CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF) IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR', & BULL_PARAMETER,CONTEXT) IF (IER) THEN FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]' LEN_FILE_DEF = ILEN + 5 ELSE FILE_DEF = 'SYS$LOGIN:' LEN_FILE_DEF = 10 END IF END IF LEN_FOLDER = TRIM(FOLDER) CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P, & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)// & FOLDER(:LEN_FOLDER)//'.LIS) ') IF (LEN_P.EQ.0) THEN BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER) & //'.LIS' LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4 ELSE IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT) IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0 & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)// & BULL_PARAMETER(:LEN_P) LEN_P = LEN_P + LEN_FILE_DEF END IF END IF BULL_POINT = BULL_POINT_READ INCMD = 'FILE '//BULL_PARAMETER(:LEN_P) IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) CALL FILE(0,.TRUE.,.FALSE.) GO TO 11 ELSE IF (INREAD.EQ.'P') THEN WRITE (6,'(''+P'',$)') BULL_POINT = BULL_POINT_READ IF (REMOTE_SET.GE.3.OR. & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN WRITE(6,1040) CALL GET_INPUT_NOECHO(INREAD) CALL STR$UPCASE(INREAD,INREAD) IF (INREAD.EQ.'P') THEN WRITE (6,'(''+P'',$)') INCMD = 'REPLY' ELSE IF (INREAD.EQ.'U') THEN WRITE (6,'(''+U'',$)') INCMD = 'RESPOND' ELSE IF (INREAD.EQ.'B') THEN WRITE (6,'(''+B'',$)') INCMD = 'RESPOND/LIST' ELSE GO TO 11 END IF IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) CALL RESPOND ELSE IF (READ_ONLY) THEN WRITE (6,'( & '' ERROR: You do not write access to this folder.'')') ELSE INCMD = 'REPLY' IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) CALL REPLY END IF GO TO 11 ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN ! If NEXT and last bulletins not finished READ_COUNT = 0 ! Reset read bulletin counter CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin 20 CALL READDIR(BULL_POINT+1,IER) IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin CALL CLOSE_BULLDIR ! Exit WRITE(6,1010) RETURN ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it GO TO 20 ! Look for more bulletins END IF CALL CLOSE_BULLDIR ELSE IF (INREAD.EQ.'R') THEN WRITE (6,'(''+Read'')') WRITE (6,'('' Enter message number: '',$)') CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case READ (NUMREAD,'(I)',IOSTAT=IER) TEMP_READ IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN WRITE (6,'('' ERROR: Invalid message number specified.'')') GO TO 12 ELSE GO TO 3 END IF ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN WRITE(6,1010) RETURN END IF IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2 GO TO 5 1000 FORMAT(' Read messages? Type N(No),E(Exit),message', & ' number, or any other key for yes: ',$) 1010 FORMAT(' No more messages.') 1020 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),D(Dir),', & 'R(Read msg #),P(Reply) or other for next message: ',$) 1030 FORMAT(1X,('-'),/,' Type Q(Quit),F(File),N(Next),', & 'D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$) 1040 FORMAT(' Type P to post reply, U to reply to user,', & ' B to do both, or other to quit: ',$) END SUBROUTINE SET_DEFAULT_EXPIRE C C SUBROUTINE SET_DEFAULT_EXPIRE C C FUNCTION: Sets default expiration date. C IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLUSER.INC' CHARACTER EXPIRE*3 IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN) IF (EX_LEN.GT.3) EX_LEN = 3 READ (EXPIRE,'(I)') TEMP CALL OPEN_BULLFOLDER ! Open folder file CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN WRITE (6,'('' ERROR: Expiration cannot be > '', & I3,'' days.'')') BBEXPIRE_LIMIT ELSE IF (TEMP.LT.-1) THEN WRITE (6,'('' ERROR: Expiration must be > -1.'')') ELSE FOLDER_BBEXPIRE = TEMP WRITE (6,'('' Default expiration modified.'')') END IF CALL REWRITE_FOLDER_FILE(IER) CALL CLOSE_BULLFOLDER ELSE WRITE (6,'('' You are not authorized to set expiration.'')') END IF RETURN END LOGICAL FUNCTION NEWS_FEED() IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' NEWS_FEED = .FALSE. SLIST = INDEX(FOLDER_DESCRIP,'<') IF (SLIST.GT.0) THEN I = SLIST + 1 FLEN = TRIM(FOLDER_DESCRIP) DO WHILE (I.LE.FLEN) IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN C IF (INDEX(FOLDER_DESCRIP(SLIST:I),'.').GT.0) C & NEWS_FEED = .TRUE. NEWS_FEED = .TRUE. RETURN ELSE IF ((FOLDER_DESCRIP(I:I).LT.'A'.OR. & FOLDER_DESCRIP(I:I).GT.'Z').AND. & FOLDER_DESCRIP(I:I).NE.':'.AND. & FOLDER_DESCRIP(I:I).NE.'@'.AND. & FOLDER_DESCRIP(I:I).NE.'%') THEN I = I + 1 ELSE I = FLEN + 2 END IF END DO END IF RETURN END LOGICAL FUNCTION MAIL_POST() IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' IF (NEWS_FEED()) THEN MAIL_POST = INDEX(FOLDER_DESCRIP,'[').GT.0 ELSE MAIL_POST = INDEX(FOLDER_DESCRIP,'<').GT.0 END IF RETURN END