C C BULLETIN10.FOR, Version 9/29/95 C Purpose: Contains subroutines for the BULLETIN utility program. C Environment: VAX/VMS C Programmer: Mark R. London C INTEGER FUNCTION NEWS_READ() IMPLICIT INTEGER (A-Z) COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 PARAMETER CR = CHAR(13), LF = CHAR(10) COMMON /NEWS_INIT/ END_READ COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN COMMON /HEADER_SEEN/ HEADER_SEEN NEWS_READ = 1 IF (END_READ.EQ.0) THEN IER = NEWS_READ_PACKET(BUFFER(:1024)) IF (IER.LE.0) THEN CALL NEWS_LOGOUT NEWS_READ = 0 RETURN END IF START_READ = 1 END_READ = IER END IF IF (END_READ.EQ.0) THEN NEWS_READ = 0 RETURN END IF DO WHILE (NEWS_READ.GT.0) LAST_LF_SEEN = LF_SEEN LAST_REAL_LF_SEEN = REAL_LF_SEEN END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) CR_SEEN = INDEX(BUFFER(START_READ:END_READ),CR) IF ((END_LINE.EQ.0.AND.CR_SEEN+START_READ-1.LT.END_READ) & .OR.CR_SEEN.LT.END_LINE-1) THEN END_LINE = CR_SEEN CR_SEEN = 1 ELSE CR_SEEN = 0 END IF LF_SEEN = END_LINE.GT.0 IF (END_LINE.GT.257-CR_SEEN.OR. & (END_LINE.EQ.0.AND.END_READ-START_READ.GE.254)) THEN END_LINE = 255 IF (.NOT.HEADER_SEEN) END_LINE = 254 END IF REAL_LF_SEEN = INDEX(BUFFER(START_READ:END_READ),LF).LE.END_LINE IF (END_LINE.GT.0) THEN SB = START_READ END_LINE = END_LINE + SB - 1 EB = END_LINE IF (BUFFER(EB:EB).EQ.LF) EB = EB - 1 IF (BUFFER(EB:EB).EQ.CR) EB = EB - 1 IF (END_LINE.LT.END_READ) THEN START_READ = END_LINE + 1 ELSE END_READ = 0 END IF IF (EB.GT.0.OR.LAST_LF_SEEN) RETURN ELSE BUFFER = BUFFER(START_READ:END_READ) END_READ = END_READ - START_READ + 1 IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024)) IF (IER.LE.0) THEN NEWS_READ = 0 RETURN ELSE START_READ = 1 END_READ = END_READ + IER END IF END IF END DO RETURN END INTEGER FUNCTION NEWS_WRITE(WRITE) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' PARAMETER CR = CHAR(13), LF = CHAR(10) COMMON /NEWS_INIT/ END_READ COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /LOCALPOST/ LOCAL_POST CHARACTER*(*) WRITE LOGICAL TRY_RECONNECT/.FALSE./ IF (LOCAL_POST) THEN WRITE (8,'(A)') WRITE(:MIN(LEN(WRITE),256)) DO I=1,LEN(INPUT),255 CALL COMPRESS(WRITE,INPUT,L) LENGTH = LENGTH + MAX(1,L) + 1 END DO NEWS_WRITE = .TRUE. RETURN END IF END_READ = 0 IF (WRITE.EQ.' ') THEN NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF) ELSE NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF) END IF IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN TRY_RECONNECT = .TRUE. NEWS_WRITE = NEWS_RECONNECT(WRITE) TRY_RECONNECT = .FALSE. END IF RETURN END LOGICAL FUNCTION NEWS_RECONNECT(WRITE) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /POINT/ BULL_POINT CHARACTER*(*) WRITE CHARACTER*8 NUMBER CHARACTER*(FOLDER_RECORD) FOLDER2_COM NEWS_RECONNECT = .FALSE. CALL NEWS_LOGOUT IF (.NOT.NEWS_LOGIN()) RETURN IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN FOLDER2_COM = FOLDER1_COM FOLDER1 = FOLDER FOLDER1_DESCRIP = FOLDER_DESCRIP CALL NEWS_GROUP(IER) IF (IER.NE.0) RETURN FOLDER1_COM = FOLDER2_COM IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN END IF IF (.NOT.NEWS_WRITE(WRITE)) RETURN NEWS_RECONNECT = .TRUE. RETURN END SUBROUTINE NEWS_LOGOUT IMPLICIT INTEGER (A-Z) COMMON /NEWS_CONNECTED/ NEWS_CONNECTED CALL NEWS_DISCONNECT NEWS_CONNECTED = .FALSE. RETURN END SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLDIR.INC' COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /MSGID/ MESSAGE_ID CHARACTER*256 MESSAGE_ID COMMON /HEADER/ HEADER CHARACTER*(*) SUBJ,FOLDER1_COM IF (REMOTE_SET.EQ.1) THEN WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER) & 4,SBULL,IMMEDIATE,SUBJ IF (IER.EQ.0) THEN READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM END IF ELSE IF (REMOTE_SET.GE.3) THEN IF (TEST_NEWS_OWNER().OR.SETPRV_PRIV()) THEN IF (REMOTE_SET.EQ.4) THEN HEADER_SAVE = HEADER HEADER = .TRUE. CALL OPEN_BULLFIL_SHARED ILEN = LINE_LENGTH + 1 DO WHILE (ILEN.GT.0) CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (INPUT(:11).EQ.'Message-ID:') THEN MESSAGE_ID = INPUT(14:ILEN-1) ILEN = 0 END IF END DO CALL CLOSE_BULLFIL HEADER = HEADER_SAVE END IF CALL NEWS_POST('cancel',0,IER,SUBJ) ELSE IF (REMOTE_SET.EQ.3) THEN WRITE (6,'('' ERROR: Not owner of message.'')') END IF IER = 0 END IF RETURN END LOGICAL FUNCTION TEST_NEWS_OWNER() IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' INCLUDE 'BULLUSER.INC' COMMON /PATH/ PATHNAME,LPATH CHARACTER*132 PATHNAME COMMON /MSGID/ MESSAGE_ID CHARACTER*256 MESSAGE_ID CHARACTER*12 HIGHFROM CALL STR$UPCASE(HIGHFROM,FROM) IF (LPATH.EQ.0) CALL GET_PATHNAME TEST_NEWS_OWNER = FROM.EQ.USERNAME.OR. & (HIGHFROM.EQ.USERNAME.AND. & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'): & TRIM(MESSAGE_ID)).EQ. & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) RETURN END INTEGER FUNCTION FIRST_INDEX(INPUT,FIND) IMPLICIT INTEGER (A-Z) CHARACTER*(*) INPUT,FIND FIRST_INDEX = 0 DO I=1,LEN(FIND) J = INDEX(INPUT,FIND(I:I)) IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX)) & FIRST_INDEX = J END DO RETURN END SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /XHDR/ XHDR LOGICAL XHDR /.FALSE./ COMMON /POINT/ BULL_POINT CHARACTER*8 NUMBER,NUMBER1 CHARACTER*1024 TEMP DATA QXHDR1 /0/ IF (XHDR) THEN IF (QXHDR1.NE.0) THEN ! Is queue empty? QXHDR = QXHDR1 ! No, set queue pointer to head ELSE ! Else if queue is empty CALL INIT_QUEUE(QXHDR,TEMP) QXHDR1 = QXHDR ! Init header pointer END IF END IF SYSTEM = 0 IF (REMOTE_SET.EQ.1) THEN IF (REVERSE) THEN WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START ELSE WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END END IF ELSE IER = 2 NUMDIR = END - START + 1 IF (START.LT.F_START) THEN START = F_START END = START + NUMDIR - 1 END IF END IF STAT = .TRUE. IF (REMOTE_SET.EQ.3.AND.XHDR) THEN STAT = .FALSE. IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN DO WHILE (NUMBER1(1:1).EQ.' ') NUMBER1 = NUMBER1(2:) END DO NUMDIR1 = 0 DO WHILE (NUMDIR1.LT.NUMDIR) IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) & RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).NE.'22') THEN IF (NUMDIR1.EQ.0) THEN IER = 0 END = START - 1 RETURN ELSE NUMDIR = NUMDIR1 END IF ELSE IF (.NOT.NEWS_READ()) RETURN IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.') THEN IF (.NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ') & +SB-2),START,,%VAL(1))) RETURN END IF DO WHILE (BUFFER(SB:EB).NE.'.') IF (NUMDIR1.LT.NUMDIR) THEN NUMDIR1 = NUMDIR1 + 1 TEMP = BUFFER(SB:EB) CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) END IF IF (.NOT.NEWS_READ()) RETURN END DO IF (NUMDIR1.EQ.0) THEN IF (START.LE.F_START) THEN IF (END.GE.F_NBULL) RETURN START = MIN(F_NBULL,END+1) ELSE START = MAX(F_START,START-NUMDIR) END IF END = START + NUMDIR - 1 IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN DO WHILE (NUMBER1(1:1).EQ.' ') NUMBER1 = NUMBER1(2:) END DO ELSE IF (NUMDIR1.LT.NUMDIR) THEN STAT = .TRUE. IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1))) & RETURN IF (.NOT.NEWS_READ()) RETURN IF (.NOT.NEWS_WRITE('NEXT')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).NE.'22') THEN NUMDIR = NUMDIR1 ELSE NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2) IF (.NOT.OTS$CVT_TI_L(NUMBER, & MSG_NUM,,%VAL(1))) RETURN DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ') NUMBER = ' '//NUMBER(1:) END DO MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1 IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN DO WHILE (NUMBER1(1:1).EQ.' ') NUMBER1 = NUMBER1(2:) END DO END IF END IF END IF END DO CALL OTS$CVT_L_TI(START,NUMBER,,,) NUMBER1 = TEMP(:INDEX(TEMP,' ')-1) END = START + NUMDIR - 1 DO I=1,2 IF (I.EQ.1) THEN IF (.NOT.NEWS_WRITE & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN ELSE IF (.NOT.NEWS_WRITE & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN END IF IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).EQ.'22') THEN QXHDR = QXHDR1 IF (.NOT.NEWS_READ()) RETURN NUMDIR1 = 0 DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR) NUMDIR1 = NUMDIR1 + 1 CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP) DO WHILE (BUFFER(SB:EB).NE.'.'.AND. & .NOT.OTS$CVT_TI_L(BUFFER(SB:INDEX( & BUFFER(SB:EB),' ')+SB-2),J,,%VAL(1))) IF (.NOT.NEWS_READ()) RETURN END DO SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1 SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1 TEMP(I*256+1:) = BUFFER(SB1:EB) CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP) IF (.NOT.NEWS_READ()) RETURN END DO END IF END DO QXHDR = QXHDR1 IER = 0 ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN STAT = .TRUE. IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).NE.'22') THEN IF (.NOT.NEWS_WRITE('NEXT')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN BUFFER(:3) = '500' DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') START = START + 1 IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN END DO IF (BUFFER(:2).NE.'22') THEN IER = 0 END = START - 1 RETURN END IF END IF IF (.NOT.NEWS_WRITE('HEAD')) RETURN IF (.NOT.NEWS_READ()) RETURN IER = OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) END = START + NUMDIR - 1 END IF IER = 0 END IF IF (IER.EQ.0) THEN I = START DO WHILE (IER.EQ.0.AND.I.LE.END) IF (REMOTE_SET.EQ.1) THEN READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY ELSE IF (XHDR) THEN CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP) LTEMP = INDEX(TEMP,' ') CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1)) CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM) DO J=257,512 IF (TEMP(J:J).LT.' '.OR.ICHAR(TEMP(J:J)).GT.126) & TEMP(J:J) = ' ' END DO DESCRIP = TEMP(257:512) CALL GET_FROM(FROM,TEMP(512:768),TRIM(TEMP(512:768))) ELSE IER = OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) CALL NEWS_HEADER(IER) IF (IER.NE.0) RETURN END IF CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY) I = I + 1 IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN IER = 2 IF (.NOT.NEWS_WRITE('NEXT')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:3).NE.'223') THEN END = I - 1 IER = 0 RETURN END IF IF (.NOT.NEWS_WRITE('HEAD')) RETURN IF (.NOT.NEWS_READ()) RETURN IER = 0 END IF END DO END IF IF (REMOTE_SET.EQ.3) THEN IER = 1 IF (STAT) THEN IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN END IF IER = 0 END IF RETURN END INTEGER FUNCTION NEWS_LOGIN IMPLICIT INTEGER (A-Z) COMMON /NEWS_CONNECTED/ NEWS_CONNECTED LOGICAL NEWS_CONNECTED /.FALSE./ COMMON /XHDR/ XHDR LOGICAL XHDR /.FALSE./ COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /HEADER_SEEN/ HEADER_SEEN COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN IF (.NOT.NEWS_CONNECTED) THEN NEWS_LOGIN = .FALSE. CALL START_NEWS_TIMER() NEWS_CONNECTED = NEWS_CONNECT() CALL CANCEL_NEWS_TIMER() IF (.NOT.NEWS_CONNECTED) RETURN IF (.NOT.NEWS_READ()) RETURN IF (INDEX(BUFFER(SB:EB),'InterNetNews').GT.0) THEN IF (.NOT.NEWS_WRITE('mode reader')) RETURN IF (.NOT.NEWS_READ()) RETURN END IF IF (.NOT.NEWS_WRITE('XHDR')) RETURN IF (.NOT.NEWS_READ()) RETURN XHDR = BUFFER(:3).NE.'500' HEADER_SEEN = .FALSE. LF_SEEN = .FALSE. LAST_LF_SEEN = .FALSE. REAL_LF_SEEN = .FALSE. LAST_REAL_LF_SEEN = .FALSE. END IF NEWS_LOGIN = .TRUE. RETURN END SUBROUTINE CONVERT_TO_GMT(BTIM) IMPLICIT INTEGER (A-Z) COMMON /MONTHS/ MONTH CHARACTER*36 MONTH DIMENSION GMT_DIFF(2),BTIM(2) CHARACTER HOUR*8 DATA HOUR /' '/ PARAMETER NZONES = 5 COMMON /ZONE/ ZONE,LZONE CHARACTER*4 ZONE CHARACTER ZONES*(NZONES*4) DATA ZONES /'EST CST MST PST IST'/ CHARACTER*8 TIMES(1) DATA TIMES /'-5:30'/ CHARACTER TIME*12 TO_GMT = .TRUE. ENTRY CONVERT_FROM_GMT(BTIM) IF (HOUR.EQ.' ') THEN IF (.NOT.SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',HOUR)) THEN IF (SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) & .OR.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN IF (INDEX(ZONES,ZONE)/4.LT.4) THEN HOUR = CHAR(ICHAR('4')+(INDEX(ZONES,ZONE)+3)/4)//':00' ELSE HOUR = TIMES((INDEX(ZONES,ZONE)+3)/4-4) END IF ELSE HOUR = '00:00' END IF ELSE HOUR = HOUR(:TRIM(HOUR))//':00' END IF ZONE = 'GMT' IER = OTS$CVT_TI_L(HOUR(:INDEX(HOUR,':')-1),DIFF,,%VAL(1)) IF (DIFF.GE.5.AND.DIFF.LE.8) THEN C C Following computes DST based on US formula C IER = SYS$ASCTIM(,TIME,BTIM,) IER = OTS$CVT_TI_L(TIME(:2),DATE,,%VAL(1)) CALL LIB$DAY_OF_WEEK(BTIM,DAY) M = (INDEX(MONTH,TIME(4:6))+2)/3 IF (M.GE.4.AND.M.LE.10.AND.(M.NE.4.OR.DAY.LT.DATE) & .AND.(M.NE.10.OR.DATE-DAY.LT.24)) THEN DIFF = DIFF - 1 IER = OTS$CVT_L_TI(DIFF,HOUR(:1),,,) END IF END IF IF (DIFF.LT.0) THEN PAST = .TRUE. HOUR = HOUR(2:) ELSE IF (DIFF.GT.12) THEN PAST = .TRUE. DIFF = 24 - DIFF HOUR(3:) = HOUR(INDEX(HOUR,':'):) IER = OTS$CVT_L_TI(DIFF,HOUR(:2),,,) IF (HOUR(:1).EQ.' ') HOUR = HOUR(2:) ELSE PAST = .FALSE. END IF LZONE = TRIM(ZONE) IER = SYS_BINTIM('0 '//HOUR(:TRIM(HOUR)),GMT_DIFF) END IF IF ((PAST.AND..NOT.TO_GMT).OR.(.NOT.PAST.AND.TO_GMT)) THEN IER = LIB$SUBX(BTIM,GMT_DIFF,BTIM) ELSE IER = LIB$ADDX(BTIM,GMT_DIFF,BTIM) END IF TO_GMT = .FALSE. RETURN END SUBROUTINE START_NEWS_TIMER() IMPLICIT INTEGER (A-Z) INTEGER TIMADR(2) ! Buffer containing time ! in desired system format. CHARACTER TIMBUF*16,SEC*4 DATA TIMBUF/'0 00:00:00.00'/ EXTERNAL KILL_NEWS_CONNECT IF (TIMBUF(9:10).EQ.'00') THEN CALL LIB$GET_EF(WAITEFN) TIMBUF(9:10) = '30' IF (SYS_TRNLNM('BULL_NEWS_TIMER',SEC)) THEN IER = OTS$CVT_TI_L(SEC(:TRIM(SEC)),I,,%VAL(1)) IF (IER.AND.I.GT.0) THEN IF (TRIM(SEC).EQ.1) THEN TIMBUF(9:10) = '0'//SEC(:1) ELSE TIMBUF(9:10) = SEC END IF END IF END IF IER = SYS$BINTIM(TIMBUF(:13),TIMADR) END IF IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,KILL_NEWS_CONNECT,) RETURN ENTRY CANCEL_NEWS_TIMER() IER = SYS$CANCEL(%VAL(WAITEFN)) RETURN END SUBROUTINE KILL_NEWS_CONNECT() IMPLICIT INTEGER (A-Z) COMMON /NEWS_CONNECTED/ NEWS_CONNECTED IF (NEWS_CONNECTED) RETURN NLUN = NEWS_GET_CHAN() IER = SYS$CANCEL(%VAL(NLUN)) CALL NEWS_DISCONNECT() RETURN END SUBROUTINE NEWS_HEADER(IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /REF/ REFERENCES,LREF CHARACTER*256 REFERENCES COMMON /NEWSGROUPS/ NEWSGROUPS CHARACTER*256 NEWSGROUPS COMMON /FOLLOWUP/ FOLLOWUP CHARACTER*128 FOLLOWUP COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE CHARACTER*256 FROM_LINE,SUBJECT_LINE CHARACTER*12 MSGNUM COMMON /HEADER_SEEN/ HEADER_SEEN COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN EX_BTIM(1) = 0 EX_BTIM(2) = 0 DESCRIP = ' ' FROM = ' ' SUBJECT_LINE = ' ' FROM_LINE = ' ' NEWSGROUPS = ' ' FOLLOWUP = ' ' LREF = 0 MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) LAST_FROM = .FALSE. DO WHILE (BUFFER(SB:EB).NE.'.'.OR..NOT.LAST_REAL_LF_SEEN) IER = NEWS_READ() IF (.NOT.IER) RETURN IF (BUFFER(SB:EB).NE.'.') THEN IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8 DO I=SB1,EB IF (BUFFER(I:I).LT.' '.OR.ICHAR(BUFFER(I:I)).GT.126) & BUFFER(I:I) = ' ' END DO SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB) DESCRIP = BUFFER(SB1:EB) LAST_FROM = .FALSE. ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) LAST_FROM = .FALSE. ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) LAST_FROM = .FALSE. ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5 FROM_LINE = 'From: '//BUFFER(SB1:EB) CALL GET_FROM(FROM,BUFFER(SB1:EB),EB-SB1+1) LAST_FROM = .TRUE. ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. & EB.GT.SB+11) THEN NEWS_MSGID = BUFFER(SB+13:EB-1) IF (LREF.EQ.0) THEN REFERENCES = BUFFER(SB+12:EB) ELSE REFERENCES = REFERENCES(:LREF)//' '// & BUFFER(SB+12:EB) END IF LREF = TRIM(REFERENCES) LAST_FROM = .FALSE. ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. & EB.GT.SB+11) THEN SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11 NEWSGROUPS = BUFFER(SB1:EB) LAST_FROM = .FALSE. ELSE IF (BUFFER(SB:SB+11).EQ.'Followup-To:'.AND. & EB.GT.SB+12) THEN SB1 = FIRST_ALPHA(BUFFER(SB+13:EB))+SB+12 FOLLOWUP = BUFFER(SB1:EB) LAST_FROM = .FALSE. ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND. & EB.GT.SB+11) THEN IF (LREF.EQ.0) THEN REFERENCES = BUFFER(SB+12:EB) ELSE REFERENCES = BUFFER(SB+12:EB)//' '// & REFERENCES(:LREF) END IF LREF = TRIM(REFERENCES) LAST_FROM = .FALSE. ELSE IF (LAST_FROM.AND.BUFFER(SB:SB).EQ.' ') THEN FROM_LINE = FROM_LINE(:TRIM(FROM_LINE))//' '// & BUFFER(SB+FIRST_ALPHA(BUFFER(SB:EB))-1:EB) CALL GET_FROM(FROM,FROM_LINE(7:),TRIM(FROM_LINE)) LAST_FROM = .TRUE. ELSE LAST_FROM = .FALSE. END IF END IF END DO IER = 0 RETURN END INTEGER FUNCTION FIRST_ALPHA(INPUT) CHARACTER*(*) INPUT DO I=1,LEN(INPUT) IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' ' END DO DO FIRST_ALPHA=1,LEN(INPUT) IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN END DO RETURN END SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 CHARACTER*8 NUMBER IF (REMOTE_SET.EQ.1) THEN WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH ELSE IER = 2 IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('ARTICLE '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).NE.'22') RETURN IER = 0 END IF RETURN END SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLUSER.INC' COMMON /READIT/ READIT COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 DIMENSION IN_BTIM(2) CHARACTER TIME*20,FIRST*80 CHARACTER*8 NUMBER IF (REMOTE_SET.EQ.1) THEN WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2) IF (IER.EQ.0) THEN READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START END IF ELSE IF (READIT.EQ.1) THEN I = NEWS_FIND_SUBSCRIBE() START = (LAST_NEWS_READ2(2,I).AND.'1FFF'X) + & LAST_NEWS_READ(2,I) + 1 IF (START.GT.F_NBULL) THEN START = -1 ELSE LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I)) & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) END IF ELSE START = -1 CALL NEWNEWS(IN_BTIM,IER) IF (IER.NE.0) START = IER C C The following code makes use of the NNTP command NEWNEWS, but is C known to be slow and buggy in many servers. C C IER = SYS$ASCTIM(,TIME,IN_BTIM,) C CALL DATE_TIME(TIME) C SKIP = 0 C DO WHILE (SKIP.GE.0) C IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( C & FOLDER_NAME))//' '//TIME)) RETURN C IF (.NOT.NEWS_READ()) RETURN C IF (BUFFER(:2).EQ.'23') THEN C IF (.NOT.NEWS_READ()) CALL EXIT C DO I=1,SKIP C IF (.NOT.NEWS_READ()) CALL EXIT C END DO C IF (FIRST.EQ.'.') RETURN C DO WHILE (BUFFER(SB:EB).NE.'.') C IF (.NOT.NEWS_READ()) CALL EXIT C END DO C IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) C & CALL EXIT C IF (.NOT.NEWS_READ()) CALL EXIT C IF (BUFFER(:2).EQ.'22') THEN C IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN C I = F_NBULL + 1 C DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. C & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) C & .OR.I.GT.F_NBULL)) C I = I - 1 C IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN C IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN C IF (.NOT.NEWS_READ()) RETURN C END DO C IF (I.GE.F_START) START = I C ELSE C IER = OTS$CVT_TI_L(BUFFER(SB+4: C & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) C END IF C RETURN C END IF C END IF C SKIP = SKIP + 1 C END DO END IF RETURN END SUBROUTINE REMOTE_COPY_BULL(IER) IMPLICIT INTEGER (A-Z) COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT IF (REMOTE_SET.EQ.1) THEN WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER1) 2 IER = IER1 END IF RETURN END SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT) IMPLICIT INTEGER (A-Z) COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT CHARACTER*(*) OUTPUT IF (REMOTE_SET.EQ.1) THEN WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT ELSE END IF RETURN END SUBROUTINE GET_REMOTE_MESSAGE(IER) C C SUBROUTINE GET_REMOTE_MESSAGE C C FUNCTION: C Gets remote message. C IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' INCLUDE '($RMSDEF)' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1 DATA SCRATCH_R1 /0/ COMMON /REF/ REFERENCES,LREF CHARACTER*256 REFERENCES COMMON /NEWSGROUPS/ NEWSGROUPS CHARACTER*256 NEWSGROUPS COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE CHARACTER*256 FROM_LINE,SUBJECT_LINE CHARACTER*12 MSGNUM COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 COMMON /HEADER_SEEN/ HEADER_SEEN COMMON /LF/ LF_SEEN,LAST_LF_SEEN,LAST_REAL_LF_SEEN CHARACTER*256 TEMP IF (SCRATCH_R1.NE.0) THEN ! Is queue empty? SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head ELSE ! Else if queue is empty CALL INIT_QUEUE(SCRATCH_R,INPUT) SCRATCH_R1 = SCRATCH_R ! Init header pointer END IF ILEN = 128 IER = 0 LENGTH = 0 LTEMP = 0 HEADER_SEEN = .FALSE. IF (REMOTE_SET.EQ.3) THEN LSUB = TRIM(SUBJECT_LINE) LFRO = TRIM(FROM_LINE) IF (LOCAL_UPDATE1.NE.0) THEN ILEN = 1 INPUT(:1) = CHAR(0) END IF END IF DO WHILE (ILEN.GT.0.AND.IER.EQ.0) IF (REMOTE_SET.EQ.1) THEN READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT ELSE IF (ILEN.EQ.128) ILEN = 0 IF (LTEMP.GT.0) THEN ILEN = MIN(128,LTEMP) INPUT = TEMP(:ILEN) LTEMP = LTEMP - ILEN END IF IF (ILEN.LT.128) THEN IF (LFRO.GT.0) THEN IF (LOCAL_UPDATE1.NE.0) THEN CALL COMPRESS(FROM_LINE(:LFRO),FROM_LINE,LFRO) END IF LTEMP = LFRO LFRO = 0 IER = 0 TEMP = CHAR(LTEMP)//FROM_LINE LTEMP = LTEMP + 1 LINP = MIN(LTEMP,128-ILEN) INPUT = INPUT(:ILEN)//TEMP(:LINP) ILEN = ILEN + LINP LTEMP = LTEMP - LINP TEMP = TEMP(LINP+1:) ELSE IF (LSUB.GT.0) THEN IF (LOCAL_UPDATE1.NE.0) THEN CALL COMPRESS(SUBJECT_LINE(:LSUB),SUBJECT_LINE,LSUB) END IF LTEMP = LSUB LSUB = 0 IER = 0 TEMP = CHAR(LTEMP)//SUBJECT_LINE LTEMP = LTEMP + 1 LINP = MIN(LTEMP,128-ILEN) INPUT = INPUT(:ILEN)//TEMP(:LINP) ILEN = ILEN + LINP LTEMP = LTEMP - LINP TEMP = TEMP(LINP+1:) ELSE IER = NEWS_READ() IF (IER.AND.(BUFFER(SB:EB).NE.'.' & .OR..NOT.LAST_REAL_LF_SEEN)) THEN IER = 0 LTEMP = EB-SB+1 IF (LTEMP.GT.0) THEN TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) IF (.NOT.HEADER_SEEN) THEN IF (TRIM(TEMP).EQ.0) THEN HEADER_SEEN = .TRUE. ELSE IF ((INDEX(TEMP,': ').EQ.0.AND. & INDEX(TEMP,':'//CHAR(9)).EQ.0.AND.ICHAR( & TEMP(2:2)).GT.32.AND.LTEMP.LT.255).OR. & (LTEMP.EQ.254.AND..NOT.LAST_LF_SEEN)) THEN TEMP = CHAR(LTEMP+1) & //' '//BUFFER(SB:SB+LTEMP-1) LTEMP = LTEMP + 1 END IF ELSE IF (BUFFER(SB:SB).EQ.'.') THEN TEMP = CHAR(LTEMP-1)//BUFFER(SB+1:SB+LTEMP-1) LTEMP = LTEMP - 1 END IF IF (LOCAL_UPDATE1.NE.0) THEN CALL COMPRESS(TEMP(2:LTEMP+1),TEMP(2:),LTEMP) TEMP(:1) = CHAR(LTEMP) END IF ELSE HEADER_SEEN = .TRUE. TEMP = CHAR(1)//' ' LTEMP = 1 END IF LTEMP = LTEMP + 1 LINP = MIN(LTEMP,128-ILEN) INPUT = INPUT(:ILEN)//TEMP(:LINP) ILEN = ILEN + LINP LTEMP = LTEMP - LINP TEMP = TEMP(LINP+1:) ELSE IF (IER) THEN IER = 0 INPUT = INPUT(:ILEN)//CHAR(0) ILEN = -128 ELSE ILEN = 128 END IF END IF ELSE TEMP = TEMP(129:) END IF END IF IF (IER.NE.0.AND.ILEN.GT.0) THEN CALL ERRSNS(IDUMMY,IER1) IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error IER = 0 ILEN = 0 ELSE CALL SYS_GETMSG(IER1) LENGTH = 0 IER1 = IER CALL DISCONNECT_REMOTE IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE END IF ELSE IF (ABS(ILEN).EQ.128) THEN CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT) LENGTH = LENGTH + 1 END IF END DO HEADER_SEEN = .TRUE. RETURN END SUBROUTINE REMOTE_REMOVE_FOLDER(IER) IMPLICIT INTEGER (A-Z) COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT RETURN END SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER) C C SUBROUTINE CONNECT_REMOTE_FOLDER C C FUNCTION: Connects to folder that is located on other DECNET node. C IMPLICIT INTEGER (A-Z) COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT DATA REMOTE_UNIT /15/ COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2) COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE CHARACTER*4 SEPARATE COMMON /READIT/ READIT COMMON /NEWS_INIT/ END_READ INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFILES.INC' CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE CHARACTER*44 FOLDER_SAVE DIMENSION DUMMY(4) IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN END_READ = 0 IF (.NOT.NEWS_LOGIN()) THEN IER = 2 RETURN END IF CALL NEWS_GROUP(IER) IF (IER.NE.0) RETURN IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT) RETURN END IF REMOTE_UNIT = 31 - REMOTE_UNIT SAME = .TRUE. LEN_BBOARD = TRIM(FOLDER1_BBOARD) IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different SAME = .FALSE. ! from local? Yes. LEN_BBOARD = LEN_BBOARD - 1 END IF OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"') IF (IER.EQ.0) THEN IF (.NOT.SAME) THEN FOLDER1_FILE = FOLDER_FILE FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY)) & //FOLDER1 REMOTE_SET_SAVE = REMOTE_SET REMOTE_SET = .FALSE. CALL OPEN_BULLDIR CALL READDIR(0,IER) CALL CLOSE_BULLDIR REMOTE_SET = REMOTE_SET_SAVE FOLDER_FILE = FOLDER1_FILE FOLDER_SAVE = FOLDER1 FOLDER1 = BULLDIR_HEADER(13:) IF (NEMPTY.EQ.0) FOLDER1 = FOLDER1(:25) END IF SYSLOG = .FALSE. IF (READIT.EQ.1) THEN WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?' READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1 IF (IER1) THEN WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+' SYSLOG = .TRUE. END IF END IF IF (.NOT.SYSLOG) THEN WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1 END IF FOLDER_OWNER_SAVE = FOLDER1_OWNER FOLDER_BBOARD_SAVE = FOLDER1_BBOARD FOLDER_NUMBER_SAVE = FOLDER1_NUMBER IF (IER.EQ.0) THEN IF (SYSLOG) THEN READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY, & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM ELSE READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY, & DUMMY(1),DUMMY(2),FOLDER1_COM END IF END IF IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE FOLDER1_BBOARD = FOLDER_BBOARD_SAVE FOLDER1_NUMBER = FOLDER_NUMBER_SAVE FOLDER1_OWNER = FOLDER_OWNER_SAVE END IF IF (IER.NE.0.OR..NOT.IER1) THEN CLOSE (UNIT=REMOTE_UNIT) REMOTE_UNIT = 31 - REMOTE_UNIT IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0.AND. & TEST_BULLCP().NE.2) THEN ! Not BULLCP process IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) & .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN CALL OPEN_BULLUSER_SHARED CALL READ_USER_FILE_KEYNAME(USERNAME,IER) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE) CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE) IF (IER.EQ.0) REWRITE (4) USER_ENTRY CALL CLOSE_BULLUSER END IF END IF IER = 2 ELSE CLOSE (UNIT=31-REMOTE_UNIT) C C If remote folder has returned a last read time for the folder, C and if in /LOGIN mode, or last selected folder was a different C folder, or folder specified with "::", then update last read time. C IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1) & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0)) & .OR.FOLDER1_NUMBER.EQ.-1) THEN CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY) IF (SYSLOG) THEN CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3)) END IF END IF IER = 0 END IF RETURN END SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /MSGID/ MESSAGE_ID CHARACTER*256 MESSAGE_ID COMMON /NEXT/ NEXT LOGICAL NEXT /.FALSE./ COMMON /NEWGROUP/ NEWGROUP CHARACTER*8 NUMBER DIMENSION IN_BTIM(2) IF (REMOTE_SET.EQ.1) THEN IF (ICOUNT.GE.0) THEN WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT ELSE WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY END IF IF (IER.EQ.0) THEN IF (ICOUNT.EQ.0) THEN READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER ELSE IF (ICOUNT.EQ.-1) THEN READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY IF (IER1.GT.0) THEN CALL ERROR_AND_EXIT ELSE IF (IER.NE.0) THEN CALL CONVERT_ENTRY_FROMBIN END IF RETURN ELSE READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY END IF END IF IF (IER.GT.0) THEN CALL ERROR_AND_EXIT ELSE IF (ICOUNT.EQ.1) THEN CALL CONVERT_HEADER_FROMBIN ELSE CALL CONVERT_ENTRY_FROMBIN END IF ELSE IF (REMOTE_SET.EQ.3) THEN IF (ICOUNT.EQ.0) THEN NBULL = F_NBULL ICOUNT = 1 RETURN ELSE IF (ICOUNT.EQ.-1) THEN IER = 2 CALL GET_MSGBTIM(MSG_KEY,IN_BTIM) CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START) IF (START.EQ.-1) RETURN IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT ELSE IER = 2 IF (NEXT.AND..NOT.NEWGROUP) THEN IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT IF (BUFFER(:3).NE.'223') RETURN IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT ELSE IF (ICOUNT.LT.F_START) ICOUNT = F_START IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) & CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT END IF IF (BUFFER(:2).NE.'22') THEN DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START) ICOUNT = ICOUNT - 1 IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) & CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT IF (BUFFER(:2).EQ.'22') THEN NEXT = .FALSE. DO WHILE (BUFFER(SB:EB).NE.'.') IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT END DO END IF END DO IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT IF (BUFFER(:3).NE.'223') RETURN IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT IF (BUFFER(:3).NE.'223') RETURN IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT END IF END IF IF (BUFFER(:2).NE.'22') RETURN IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3), & ICOUNT,,%VAL(1)) IF (.NOT.IER) RETURN START = ICOUNT BULLETIN_NUM = START END IF NEWGROUP = .FALSE. MESSAGE_ID = BUFFER(INDEX(BUFFER,'<')+1:INDEX(BUFFER,'>')-1) IER = 0 CALL NEWS_HEADER(IER) CALL CONVERT_FROM_GMT(MSG_BTIM) IF (IER.GT.0) THEN CALL ERROR_AND_EXIT ELSE CALL CONVERT_ENTRY_FROMBIN END IF BLOCK = START MSG_NUM = START SYSTEM = 0 IF (ICOUNT.NE.-1) THEN ICOUNT = ICOUNT + 1 ELSE IER = START END IF END IF RETURN END SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM) IMPLICIT INTEGER (A-Z) INTEGER BTIM(2) CHARACTER*8 MSG_KEY,INPUT INPUT = MSG_KEY DO I=1,8 INPUT(9-I:9-I) = MSG_KEY(I:I) END DO CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1)) RETURN END SUBROUTINE NEWS_GROUP(IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /NEWGROUP/ NEWGROUP IF (INDEX(FOLDER1_DESCRIP,' ').EQ.0) THEN IER = 1 RETURN END IF IER = NEWS_WRITE('GROUP '// & FOLDER1_DESCRIP(:INDEX(FOLDER1_DESCRIP,' ')-1)) IF (.NOT.IER) RETURN IER = NEWS_READ() IF (.NOT.IER) RETURN IER = 1 IF (BUFFER(:3).EQ.'411') RETURN NEWGROUP = .TRUE. BUFFER = BUFFER(5:) IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_COUNT,,%VAL(1)) IF (.NOT.IER) RETURN BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1)) IF (.NOT.IER) RETURN BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1)) IF (.NOT.IER) RETURN BUFFER = BUFFER(INDEX(BUFFER,' ')+1:) IER = NEWS_WRITE('STAT') IF (.NOT.IER) RETURN IER = NEWS_READ() IF (.NOT.IER) RETURN IER = OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) IF (IER.AND.START.GT.F1_START) F1_START = START IF (F1_START.EQ.0) F1_NBULL = 0 IER = 0 RETURN END SUBROUTINE NEWS_TIME(INTIME,BTIM) IMPLICIT INTEGER (A-Z) CHARACTER*(*) INTIME CHARACTER*28 TIME DIMENSION DIFF(2) I = 1 LTIME = TRIM(INTIME) DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR. & ICHAR(INTIME(I:I)).GT.ICHAR('9'))) I = I + 1 END DO IF (I.GT.LTIME) THEN CALL SYS_BINTIM('-',BTIM) RETURN END IF CALL STR$UPCASE(TIME,INTIME(I:)) DO J = 1,2 I = 1 DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME)) I = I + 1 END DO TIME(I:I) = '-' END DO IF (I.EQ.LEN(TIME)) RETURN IF (TIME(I+3:I+3).EQ.' ') THEN IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN TIME = TIME(:I)//'19'//TIME(I+1:) ELSE TIME = TIME(:I)//'20'//TIME(I+1:) END IF END IF I = 1 DO J = 1,2 DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME)) I = I + 1 END DO I = I + 1 END DO IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) THEN CALL SYS_BINTIM('-',BTIM) RETURN END IF IF (INDEX(TIME(:I-2),'.').GT.0) THEN CALL SYS_BINTIM(TIME(:INDEX(TIME(:I-2),'.'))//'00',BTIM) ELSE IF (TIME(I-4:I-4).EQ.':'.AND.TIME(I-7:I-7).EQ.':') THEN CALL SYS_BINTIM(TIME(:I-2)//'.00',BTIM) ELSE CALL SYS_BINTIM(TIME(:I-2)//':00.00',BTIM) END IF IF (TIME(I:I).EQ.'+'.OR.TIME(I:I).EQ.'-') THEN IER = SYS_BINTIM('0 '//TIME(I+1:I+2)//':'//TIME(I+3:I+4),DIFF) IF (IER) THEN IF (TIME(I:I).EQ.'-') THEN IER = LIB$SUBX(BTIM,DIFF,BTIM) ELSE IER = LIB$ADDX(BTIM,DIFF,BTIM) END IF END IF END IF RETURN END SUBROUTINE NEWS_LIST IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 DATA LOCAL_UPDATE1/0/ COMMON /NEWSLIST/ NEWSLIST CHARACTER TODAY*24 DIMENSION EXPIRED(2) CALL LIB$DATE_TIME(TODAY) IF (.NOT.NEWS_LOGIN()) RETURN IF (.NOT.NEWS_WRITE('LIST')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:3).NE.'215') RETURN SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR. & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3 CALL INIT_QUEUE(LOCAL_UPDATE1,%DESCR(NEWS_FOLDER_NUMBER)) LOCAL_UPDATE = LOCAL_UPDATE1 NEWSLIST = .TRUE. CALL OPEN_BULLNEWS_SHARED ! Open folder file NEWS_FOLDER1_BBOARD = '::' CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) IF (IER1.NE.0) THEN NEWS_FOLDER1 = 'a' NEWS_FOLDER1_NUMBER = 1000 NEWS_F1_COUNT = 1001 NEWS_F1_EXPIRE = 14 NEWS_F1_EXPIRE_LIMIT = 0 NEWS_F1_FLAG = 0 CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM END IF NEWS_FLAG_DEFAULT = NEWS_F1_FLAG NEWS_EXPIRE_DEFAULT = NEWS_F1_EXPIRE NEWS_EXPIRE_LIMIT_DEFAULT = NEWS_F1_EXPIRE_LIMIT IF (NEWS_F1_COUNT.LT.1001) NEWS_F1_COUNT = 1001 NEWS_F_COUNT = NEWS_F1_COUNT DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') FLEN = INDEX(BUFFER(SB:),' ') - 1 NEWS_FOLDER1 = BUFFER(SB:MIN(44,FLEN)+SB-1) IF (IER1.EQ.0) THEN CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER) END IF SP = FLEN+SB+1 EP = INDEX(BUFFER(SP:),' ')+SP-2 IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1)) SP = EP + 2 EP = INDEX(BUFFER(SP:),' ')+SP-2 IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1)) IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0 CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) SP = EP + 1 IF (IER.EQ.0.AND.IER1.EQ.0) & NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) ! Old bug caused this. IF (IER.NE.0.OR.IER1.NE.0) THEN CALL STR$UPCASE(NEWS_FOLDER,NEWS_FOLDER1) IER2 = 1 I = FLEN NEWS_F1_COUNT = NEWS_F_COUNT DO WHILE (IER2.NE.0.AND.I.GT.1) IF (NEWS_FOLDER(I:I).EQ.'.') THEN NEWS_FOLDER = NEWS_FOLDER(:I) DO WHILE (REC_LOCK(IER)) READ (7,KEY=NEWS_FOLDER, & KEYID=0,IOSTAT=IER2) NEWS_FOLDER_COM END DO END IF IF (IER2.NE.0) I = I - 1 END DO NEWS_F_COUNT = NEWS_F1_COUNT IF (FLEN.GT.44) THEN NEWS_FOLDER1_DESCRIP = BUFFER(SB+44:FLEN+SB-1)// & BUFFER(SP:EB) ELSE NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) END IF IER = 0 DO WHILE (IER.EQ.0.AND.IER1.EQ.0) DO WHILE (REC_LOCK(IER)) READ (7,KEY=NEWS_F_COUNT,KEYID=1,IOSTAT=IER) END DO IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 END DO NEWS_FOLDER1_NUMBER = NEWS_F_COUNT IF (IER2.EQ.0) THEN NEWS_F1_FLAG = NEWS_F_FLAG NEWS_F1_FLAG = IBCLR(NEWS_F1_FLAG,10) IF (I.NE.INDEX(NEWS_FOLDER1,'.')) THEN NEWS_F1_EXPIRE = NEWS_F_EXPIRE NEWS_F1_EXPIRE_LIMIT = NEWS_F_EXPIRE_LIMIT END IF ELSE NEWS_F1_FLAG = NEWS_FLAG_DEFAULT NEWS_F1_EXPIRE = 0 NEWS_F1_EXPIRE_LIMIT = 0 END IF CALL GET_MSGKEY(NEWS_F1_NEWEST_BTIM,NEWS_F1_CREATED_DATE) CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',EXPIRED) CALL GET_MSGKEY(EXPIRED,NEWS_F1_EXPIRED_DATE) NEWS_F1_COUNT = MAX(0,NEWS_F1_NBULL - NEWS_F1_START + 1) IF (BTEST(NEWS_F1_FLAG,8)) THEN NEWS_F1_COUNT = 0 NEWS_F1_START = 0 NEWS_F1_NBULL = 0 NEWS_F1_FIRST = 0 NEWS_F1_LAST = 0 END IF IF (FLEN.LE.44.OR.FLEN-44+EB-SP+1.LT. & LEN(NEWS_FOLDER1_DESCRIP)) THEN WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM IF (IER.EQ.0) THEN NEWS_F_COUNT = NEWS_F_COUNT + 1 IF (BTEST(NEWS_F1_FLAG,8).AND. & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, & %DESCR(NEWS_FOLDER1_NUMBER)) END IF END IF END IF ELSE IF (BTEST(NEWS_F1_FLAG,8).AND. & .NOT.BTEST(NEWS_F1_FLAG,9)) THEN IF (NEWS_F1_LAST.NE.NEWS_F1_NBULL.AND..NOT.SPECIAL.AND. & NEWS_F1_START.LE.NEWS_F1_NBULL) THEN IF (NEWS_F1_FIRST.GT.NEWS_F1_START.AND. & NEWS_F1_FIRST.GT.NEWS_F1_NBULL) THEN NEWS_F1_LAST = 0 NEWS_F1_START = F1_START NEWS_F1_NBULL = F1_NBULL REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM END IF IF (NEWS_F1_LAST.LT.NEWS_F1_NBULL) THEN CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE, & %DESCR(NEWS_FOLDER1_NUMBER)) END IF END IF ELSE IF (.NOT.BTEST(NEWS_F1_FLAG,9)) THEN UPDATE = .FALSE. IF (FLEN.GT.44) THEN IF (NEWS_FOLDER1_DESCRIP.NE. & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB)) THEN NEWS_FOLDER1_DESCRIP = & BUFFER(SB+44:FLEN+SB-1)//BUFFER(SP:EB) UPDATE = .TRUE. END IF ELSE IF (NEWS_FOLDER1_DESCRIP.NE.BUFFER(SP:EB)) THEN NEWS_FOLDER1_DESCRIP = BUFFER(SP:EB) UPDATE = .TRUE. END IF IF (SPECIAL) THEN IF (UPDATE) THEN NEWS_F1_START = F1_START NEWS_F1_NBULL = F1_NBULL END IF ELSE IF (.NOT.UPDATE) THEN UPDATE = F1_START.LT.NEWS_F1_START.OR. & F1_NBULL.NE.NEWS_F1_NBULL END IF IF (UPDATE) REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM END IF END DO CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) NEWS_F1_COUNT = NEWS_F_COUNT REWRITE (7) NEWS_FOLDER1_COM IF (SPECIAL) THEN CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER) LAST = FOLDER1_NUMBER DO WHILE (IER.EQ.0) CALL READ_FOLDER_FILE_TEMP(IER) DO WHILE (IER.EQ.0.AND.LAST.EQ.FOLDER1_NUMBER) ! oops DELETE (7) CALL READ_FOLDER_FILE_TEMP(IER) END DO LAST = FOLDER1_NUMBER IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,10)) THEN NEWS_F1_NBULL = F1_NBULL NEWS_F1_START = F1_START NEWS_F1_COUNT = F1_COUNT CALL NEWS_GROUP(IER) IF (IER.EQ.0.AND..NOT.BTEST(NEWS_F1_FLAG,9)) THEN IF (BTEST(NEWS_F1_FLAG,8)) THEN IF (NEWS_F1_LAST.NE.F1_NBULL.AND. & F1_START.LE.F1_NBULL) THEN IF (NEWS_F1_FIRST.GT.F1_START.AND. & NEWS_F1_FIRST.GT.F1_NBULL) THEN NEWS_F1_LAST = 0 REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM END IF IF (NEWS_F1_LAST.LT.F1_NBULL) THEN CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE), & LOCAL_UPDATE,%DESCR(NEWS_FOLDER1_NUMBER)) END IF END IF ELSE IF (((F1_START.NE.NEWS_F1_START.OR. & F1_NBULL.NE.NEWS_F1_NBULL).AND.F1_START.GT.0).OR. & NEWS_F1_COUNT.NE.F1_COUNT) THEN CALL SYS_BINTIM('-',F1_NEWEST_BTIM) CALL REWRITE_FOLDER_FILE_TEMP(IER1) END IF ELSE IF (IER.EQ.1.AND..NOT.BTEST(NEWS_F1_FLAG,8)) THEN DELETE (UNIT=7) IER = 0 ELSE IF (IER.EQ.1) THEN IF (NEWS_F1_NBULL.GE.NEWS_F1_START & .AND.NEWS_F1_START.NE.0) THEN CALL CLOSE_BULLNEWS FOLDER_NUMBER = FOLDER1_NUMBER CALL SELECT_FOLDER(.FALSE.,IER1) IF (IER1) THEN CALL OPEN_BULLDIR_SHARED CALL READDIR(NEWS_F1_START,IER1) CALL CLOSE_BULLDIR IER1 = NEWS_F1_START+1.EQ.IER1 END IF CALL OPEN_BULLNEWS_SHARED CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER) IF (.NOT.IER1) DELETE (UNIT=7) END IF END IF END IF END DO END IF CALL WRITE_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,%DESCR(0)) CALL CLOSE_BULLNEWS NEWSLIST = .FALSE. IF (SYS_TRNLNM('BULL_NEWS_RECOUNT','DEFINED')) CALL RECOUNT RETURN END SUBROUTINE LOWERCASE(INPUT) CHARACTER*(*) INPUT DO I=1,LEN(INPUT) IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a')) END IF END DO RETURN END SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLNEWS.INC' INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLDIR.INC' INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFILES.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /REF/ REFERENCES,LREF CHARACTER*256 REFERENCES COMMON /PATH/ PATHNAME,LPATH CHARACTER*132 PATHNAME COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD COMMON /MSGID/ MESSAGE_ID CHARACTER*256 MESSAGE_ID COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /NEWSGROUPS/ NEWSGROUPS CHARACTER*256 NEWSGROUPS COMMON /FOLLOWUP/ FOLLOWUP CHARACTER*128 FOLLOWUP COMMON /ZONE/ ZONE,LZONE CHARACTER ZONE*4 COMMON /LOCALPOST/ LOCAL_POST DATA LOCAL_POST /.FALSE./ COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE CHARACTER*256 FROM_LINE,SUBJECT_LINE CHARACTER*12 MSGNUM COMMON /TEMP_INPUT/ GROUP_TEMP CHARACTER GROUP_TEMP*256 COMMON /HEADER/ HEADER CHARACTER*(*) FILENAME,SUBJECT CHARACTER RESPONSE*4 CHARACTER TODAY*24,UNAME*132 DATA UNAME /'()'/ COMMON /POINT/ BULL_POINT DIMENSION NOW(2) IER = 1 CREATE = FILENAME(:8).EQ.'newgroup' IF (FILENAME.NE.'cancel') THEN IF (.NOT.FILEOPEN) THEN OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1) IF (IER1.NE.0) RETURN END IF IER1 = 0 DO WHILE (IER1.EQ.0) READ (3,'(A)',IOSTAT=IER1) BUFFER IF (IER1.NE.0) GO TO 900 IF (TRIM(BUFFER).GT.0) IER1 = 1 END DO REWIND (UNIT=3) END IF IER = SYS$GETTIM(NOW) CALL CONVERT_TO_GMT(NOW) IER = SYS$ASCTIM(,TODAY,NOW,) DATE = TODAY(:11) TIME = TODAY(13:20)//'.00' NEWS_MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) IF (NEWS_MSGID(:1).EQ.' ') NEWS_MSGID = NEWS_MSGID(2:) IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN IF (.NOT.NEWS_LOGIN()) GO TO 900 IF (.NOT.NEWS_WRITE('POST')) GO TO 900 IF (.NOT.NEWS_READ()) GO TO 900 IF (BUFFER(:3).NE.'340') THEN WRITE (6,'('' ERROR: Posting not allowed.'')') GO TO 900 END IF ELSE I = INDEX(NEWS_MSGID,'.') LENGTH = 0 OPEN (UNIT=8,FILE=NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))// & NEWS_MSGID(:I-1)// & NEWS_MSGID(I+1:TRIM(NEWS_MSGID))//'.POST',IOSTAT=IER, & STATUS='NEW',DISPOSE='DELETE',RECL=256) IF (IER.NE.0) RETURN LOCAL_POST = .TRUE. CALL INIT_QUEUE(GROUP_LIST1,FOLDER) GROUP_LIST = GROUP_LIST1 END IF IF (LPATH.EQ.0) CALL GET_PATHNAME IF (REMOTE_SET.GE.3.OR.CREATE.OR.NEWS_FEED()) THEN IF (CREATE) THEN INPUT = 'Newsgroups: '//FILENAME(10:TRIM(FILENAME)) ELSE IF (NEWS_FEED()) THEN INPUT = 'Newsgroups: '//FOLDER1_DESCRIP ELSE IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN IF (TRIM(FOLLOWUP).EQ.0) THEN INPUT = 'Newsgroups: '//NEWSGROUPS ELSE INPUT = 'Newsgroups: '//FOLLOWUP END IF ELSE INPUT = 'Newsgroups: '//FOLDER_NAME END IF IF (FILENAME.NE.'cancel'.AND..NOT.CREATE.AND. & .NOT.NEWS_FEED()) THEN NGROUPS = 0 IF (BTEST(FOLDER_FLAG,8)) THEN CALL WRITE_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER) NGROUPS = NGROUPS + 1 END IF IF (CLI$PRESENT('GROUPS')) THEN CALL OPEN_BULLNEWS_SHARED FLEN = 0 DO WHILE (CLI$GET_VALUE('GROUPS',GROUP_TEMP)) IER = SYS_TRNLNM(GROUP_TEMP,GROUP_TEMP) DO WHILE (TRIM(GROUP_TEMP).GT.0) COMMA = INDEX(GROUP_TEMP,',') IF (COMMA.GT.0) THEN FOLDER1_NAME = GROUP_TEMP(1:COMMA-1) GROUP_TEMP = GROUP_TEMP(COMMA+1:) ELSE FOLDER1_NAME = GROUP_TEMP GROUP_TEMP = ' ' END IF CALL LOWERCASE(FOLDER1_NAME) FLEN = TRIM(FOLDER1_NAME) CALL READ_FOLDER_FILE_KEYNAME_TEMP & (FOLDER1_NAME(:FLEN),IER1) IF (IER1.EQ.0.AND..NOT.BTEST(FOLDER1_FLAG,9) & .AND.TRIM(INPUT)+FLEN+1.LE.LEN(INPUT).AND. & INDEX(INPUT,FOLDER1_NAME(:FLEN)//',').EQ.0.AND. & INPUT(:TRIM(INPUT)).NE.FOLDER1_NAME(:FLEN)) THEN INPUT = INPUT(:TRIM(INPUT))// & ','//FOLDER1_NAME(:FLEN) IF (BTEST(FOLDER1_FLAG,8).AND.LOCAL_POST) THEN CALL WRITE_QUEUE(%VAL(GROUP_LIST), & GROUP_LIST,FOLDER1) NGROUPS = NGROUPS + 1 END IF ELSE WRITE (6,'(1X,A,'' is not a valid news group.'')') & FOLDER1_NAME(:FLEN) CALL GET_INPUT_PROMPT(RESPONSE,RLEN, & 'Do you still want to specify it? (default = Y) ') IF (RESPONSE(:1).NE.'n'.AND. & RESPONSE(:1).NE.'N') THEN INPUT = INPUT(:TRIM(INPUT))// & ','//FOLDER1_NAME(:FLEN) END IF END IF END DO END DO CALL CLOSE_BULLNEWS END IF END IF IF (.NOT.NEWS_WRITE(INPUT(:TRIM(INPUT)))) GO TO 900 END IF ATSIGN = INDEX(PATHNAME,'@') PCSIGN = INDEX(PATHNAME,'%') CALL LOWERCASE(USERNAME) IF (PCSIGN.GT.0) THEN IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!' & //USERNAME(:TRIM(USERNAME)))) GO TO 900 ELSE IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!' & //USERNAME(:TRIM(USERNAME)))) GO TO 900 END IF IF (UNAME.EQ.'()') CALL GET_UNAME(UNAME) IF (FILENAME.NE.'cancel') THEN FROM_LINE = USERNAME(:TRIM(USERNAME))//PATHNAME(:LPATH)// & UNAME(:TRIM(UNAME)) IF (.NOT.NEWS_WRITE('From: '//FROM_LINE(:TRIM(FROM_LINE)))) & GO TO 900 CALL STR$UPCASE(FROM_LINE,FROM_LINE) FROM_LINE = FROM_LINE(:TRIM(USERNAME)+LPATH)//UNAME(:TRIM(UNAME)) CALL STR$UPCASE(USERNAME,USERNAME) ELSE HEADER_SAVE = HEADER HEADER = .TRUE. CALL OPEN_BULLFIL_SHARED ILEN = LINE_LENGTH + 1 DO WHILE (ILEN.GT.0) CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN) IF (INPUT(:5).EQ.'From:') THEN IF (.NOT.NEWS_WRITE(INPUT(:ILEN))) THEN CALL CLOSE_BULLFIL GO TO 900 END IF ILEN = 0 END IF END DO CALL CLOSE_BULLFIL HEADER = HEADER_SAVE END IF IF (FILENAME.EQ.'cancel'.AND.TEST_NEWS_OWNER()) THEN IF (.NOT.NEWS_WRITE('Subject: cancel <'// & MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) GO TO 900 ELSE IF (TRIM(SUBJECT).EQ.0) THEN IF (.NOT.NEWS_WRITE('Subject: (none)')) & GO TO 900 ELSE IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) & GO TO 900 END IF SUBJECT_LINE = SUBJECT IF (INCMD(:2).EQ.'RE') THEN IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) & GO TO 900 END IF IF (NGROUPS.GT.0) THEN FROM = USERNAME DESCRIP = SUBJECT END IF NEWS_MSGID = NEWS_MSGID(:TRIM(NEWS_MSGID))//PATHNAME(:LPATH) IF (.NOT.NEWS_WRITE('Message-ID: <'//NEWS_MSGID(: & TRIM(NEWS_MSGID))//'>')) GO TO 900 TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20) IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:) IF (LORGAN.EQ.0) THEN IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION) END IF LORGAN = TRIM(ORGANIZATION) END IF IF (LORGAN.GT.0) THEN IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN))) & GO TO 900 END IF IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '// & ZONE(:LZONE))) GO TO 900 INPUT_HEADER = .FALSE. IF (.NOT.(CREATE.OR.FILENAME.EQ.'cancel').AND..NOT.NEWS_FEED()) THEN IF (CLI$PRESENT('EXPIRATION')) THEN IF (.NOT.NEWS_WRITE('Expires: '//EXDATE( & FIRST_ALPHA(EXDATE):2) & //' '//EXDATE(4:6)//' '//EXDATE(10:TRIM(EXDATE)) & //' '//EXTIME(:8)//' '//ZONE(:LZONE))) GO TO 900 ELSE IF (REMOTE_SET.EQ.4) THEN IF ( FOLDER_BBEXPIRE.GT.0) THEN CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE) ELSE CALL GET_EXDATE(EXDATE,NEWS_EXPIRE_DEFAULT) END IF EXTIME = '00:00:00.00' END IF IF (CLI$GET_VALUE('FOLLOWUP',GROUP_TEMP)) THEN CALL LOWERCASE(GROUP_TEMP) IF (.NOT.NEWS_WRITE('Followup-To: ' & //GROUP_TEMP(:TRIM(GROUP_TEMP)))) GO TO 900 END IF INPUT_HEADER = CLI$PRESENT('HEADER') END IF IF (CREATE) THEN IF (.NOT.NEWS_WRITE('Control: '//FILENAME(:TRIM(FILENAME)))) & RETURN END IF IF (FILENAME.EQ.'cancel') THEN IF (.NOT.NEWS_WRITE('Control: cancel <' & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN IF (.NOT.NEWS_WRITE(' ')) RETURN IF (.NOT.NEWS_WRITE('cancel <' & //MESSAGE_ID(:TRIM(MESSAGE_ID))//'>')) RETURN IF (.NOT.NEWS_WRITE('.')) RETURN IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:3).EQ.'240') IER = 0 ELSE CLOSE (UNIT=8,STATUS='SAVE') IER = 0 END IF LOCAL_POST = .FALSE. RETURN END IF IF (.NOT.INPUT_HEADER) THEN IF (.NOT.NEWS_WRITE(' ')) GO TO 900 END IF IER1 = 0 DO WHILE (IER1.EQ.0) READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER IF (BUFFER(:ILEN).EQ.'.') THEN BUFFER = '..' ILEN = 2 END IF IF (IER1.EQ.0) THEN IF (.NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 END IF END DO IF (REMOTE_SET.EQ.3.OR.NEWS_FEED()) THEN IF (.NOT.NEWS_WRITE('.')) GO TO 900 IF (.NOT.NEWS_READ()) GO TO 900 IF (BUFFER(:3).EQ.'240') THEN IER = 0 ELSE WRITE (6,'('' ERROR: Server rejected your posting:'')') WRITE (6,'(1X,A)') BUFFER(SB:MIN(79+SB,EB)) IF (INDEX(BUFFER(SB:EB),'new text').GT.0) THEN WRITE (6,'('' Use /INDENT to change indentation'',$)') WRITE (6,'(''+ character. See Manager for permanent'',$)') WRITE (6,'(''+ change.'')') END IF END IF ELSE LENGTH = (LENGTH+127)/128 GROUP_LIST = GROUP_LIST1 FOLDER_NUMBER_SAVE = FOLDER_NUMBER SAVE_BULL_POINT = BULL_POINT DO I=NGROUPS,1,-1 CALL READ_QUEUE(%VAL(GROUP_LIST),GROUP_LIST,FOLDER1) FOLDER_NUMBER = -1 CALL SELECT_FOLDER(.FALSE.,IER) IF (IER) THEN CALL ADD_LOCAL_NEWS(8) END IF END DO IF (FOLDER_NUMBER.NE.FOLDER_NUMBER_SAVE) THEN FOLDER_NUMBER = FOLDER_NUMBER_SAVE CALL SELECT_FOLDER(.FALSE.,IER) END IF BULL_POINT = SAVE_BULL_POINT IF (.NOT.NEWS_WRITE('.')) GO TO 900 CLOSE (UNIT=8,STATUS='SAVE') IER = 0 END IF 900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) CALL STR$UPCASE(USERNAME,USERNAME) LOCAL_POST = .FALSE. RETURN END SUBROUTINE GET_PATHNAME IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' COMMON /PATH/ PATHNAME,LPATH CHARACTER*132 PATHNAME IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN IER = SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME) IF (.NOT.IER) & IER = SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME) IF (.NOT.IER) & IER = SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME) IF (.NOT.IER) THEN WRITE (6,'('' ERROR: Cannot find local host name.'')') RETURN END IF END IF IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME CALL LOWERCASE(PATHNAME) LPATH = TRIM(PATHNAME) RETURN END LOGICAL FUNCTION TEST_NEWS(NAME) IMPLICIT INTEGER (A-Z) CHARACTER*(*) NAME TEST_NEWS = .FALSE. MAYBE_NEWS = .FALSE. DO I=1,LEN(NAME) IF (NAME(I:I).GE.'A'.AND.NAME(I:I).LE.'Z') RETURN IF (NAME(I:I).GE.'a'.AND.NAME(I:I).LE.'z') MAYBE_NEWS = .TRUE. END DO TEST_NEWS = MAYBE_NEWS RETURN END SUBROUTINE UPDATE_LOCAL_NEWS IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD COMMON /LOCAL_UPDATE/ LOCAL_UPDATE1 COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT EXTERNAL BULLETIN_SUBCOMMANDS CHARACTER CNUM*4,NUMBER*8 EQUIVALENCE (CNUM,NUM) CALL INIT_QUEUE(LOCAL_UPDATE1,CNUM) LOCAL_UPDATE = LOCAL_UPDATE1 CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) IF (NUM.EQ.0) RETURN CALL OPEN_BULLNEWS_SHARED DO WHILE (NUM.GT.0) CALL READ_FOLDER_FILE_KEYNUM_TEMP(NUM,IER) IF (IER.EQ.0) THEN CALL CLOSE_BULLNEWS CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) LAST = F1_NBULL FIRST = F1_START IF (IER.EQ.0) THEN FOLDER_COM = FOLDER1_COM REMOTE_SET = 3 CALL OPEN_BULLDIR_SHARED I = F_LAST + 1 IER = I - 1 DO WHILE (I.NE.IER.AND.I.LE.LAST) CALL READDIR(I,IER) I = I + 1 END DO CALL CLOSE_BULLDIR CALL OTS$CVT_L_TI(I-1,NUMBER,,,) INCMD = 'COPY/ORIGINAL '//FOLDER(:TRIM( & FOLDER))//' '//NUMBER//'-LAST' CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) CALL MOVE(.FALSE.) CALL OPEN_BULLNEWS_SHARED IF (REMOTE_SET.EQ.4) THEN NEW_F_COUNT = F_COUNT NEW_NEWS_F_END = NEWS_F_END CALL READ_FOLDER_FILE_KEYNUM(NUM,IER) CALL GET_MSGKEY(NEWEST_EXBTIM,NEWS_F_EXPIRED_DATE) CALL COPY2(F_NEWEST_BTIM,NEWEST_MSGBTIM) IF (F_START.EQ.0.AND.NBULL.GT.0) F_START = 1 IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN NEWS_F_END = NEW_NEWS_F_END F_NBULL = NEW_NEWS_F_END F_COUNT = NEW_F_COUNT END IF F_LAST = LAST NEWS_F_FIRST = FIRST CALL REWRITE_FOLDER_FILE(IER) END IF END IF END IF CALL READ_QUEUE(%VAL(LOCAL_UPDATE),LOCAL_UPDATE,CNUM) IF (NUM.EQ.0) THEN CALL CLOSE_BULLNEWS RETURN END IF END DO RETURN END SUBROUTINE NEWS2BULL(RECLAIM) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /COMMAND_LINE/ INCMD CHARACTER*256 INCMD COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT EXTERNAL BULLETIN_SUBCOMMANDS CHARACTER FOLDER_SAVE*44,BBOARD_SAVE*12 CHARACTER*8 NUMBER DIMENSION NOW(2) IER = SYS$GETTIM(NOW) CALL ALLPRIV CALL DELETE_EXPIRED_NEWS(RECLAIM) IF (RECLAIM) CALL EXIT CALL SEND_POST CALL NEWS_LIST CALL UPDATE_LOCAL_NEWS CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM) FOLDER_Q = FOLDER_Q1 CALL OPEN_BULLFOLDER_SHARED ! Get folder file NUM_FOLDERS = 0 IER = 0 DO WHILE (IER.EQ.0) ! Find folders with news feed CALL READ_FOLDER_FILE(IER) IF (IER.EQ.0) THEN SLIST = INDEX(FOLDER_DESCRIP,'<') ELIST = INDEX(FOLDER_DESCRIP,'>') IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN IF ((FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR. & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))).AND. & INDEX(FOLDER_DESCRIP(SLIST+2:),'@').EQ.0) THEN NUM_FOLDERS = NUM_FOLDERS + 1 CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) END IF END IF END IF END DO CALL CLOSE_BULLFOLDER ! We don't need file anymore IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT FOLDER_Q = FOLDER_Q1 POINT_FOLDER = 0 DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) POINT_FOLDER = POINT_FOLDER + 1 CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) CALL SELECT_FOLDER(.FALSE.,IER) FOLDER_SAVE = FOLDER BBOARD_SAVE = FOLDER_BBOARD FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) IF (IER) THEN SAVE_LAST = F_LAST CALL OPEN_BULLNEWS_SHARED FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) CALL READ_FOLDER_FILE_KEYNAME & (FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)),IER) CALL CLOSE_BULLNEWS FOLDER1_DESCRIP = FOLDER_DESCRIP IF (IER.EQ.0) CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER) IF (IER.EQ.0) FOLDER_COM = FOLDER1_COM IF (IER.EQ.0.AND.BBOARD_SAVE.EQ.'NONE') THEN SAVE_LAST = F_NBULL CALL OPEN_BULLFOLDER CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) F_LAST = SAVE_LAST FOLDER_BBOARD = 'NONEFEED' CALL REWRITE_FOLDER_FILE(IER1) CALL CLOSE_BULLFOLDER ELSE IF (IER.EQ.0.AND.F_NBULL.NE.SAVE_LAST.AND. & F_NBULL.GE.F_START) THEN REMOTE_SET = 3 IF (SAVE_LAST.GT.F_NBULL.AND.F_START.EQ.1) & SAVE_LAST = F_START-1 SAVE_LAST = MAX(F_START-1,SAVE_LAST) CALL OTS$CVT_L_TI(SAVE_LAST+1,NUMBER,,,) INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( & FOLDER_SAVE))//' '//NUMBER//'-LAST' SAVE_LAST = F_NBULL CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) CALL MOVE(.FALSE.) CALL OPEN_BULLFOLDER CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER1) IF (IER1.EQ.0) THEN F_LAST = SAVE_LAST CALL REWRITE_FOLDER_FILE(IER1) END IF CALL CLOSE_BULLFOLDER END IF END IF END DO CALL EXIT END SUBROUTINE DATE_TIME(TIME) IMPLICIT INTEGER (A-Z) COMMON /MONTHS/ MONTH CHARACTER*36 MONTH DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/ CHARACTER*(*) TIME NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3 IF (TIME(1:1).EQ.' ') TIME(1:1) = '0' TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+ & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)// & TIME(16:17)//TIME(19:20) RETURN END SUBROUTINE ALLPRIV IMPLICIT INTEGER (A-Z) COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2) PROCPRIV(1) = -1 PROCPRIV(2) = -1 NEEDPRIV(1) = -1 NEEDPRIV(2) = -1 RETURN END SUBROUTINE NEWS_NEW_FOLDER IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM NEWS_FOLDER1 = FOLDER1 NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:) DO WHILE (IER.EQ.0) READ (7,IOSTAT=IER,KEYEQ=NEWS_F_COUNT,KEYID=1) IF (IER.EQ.0) NEWS_F_COUNT = NEWS_F_COUNT + 1 END DO NEWS_FOLDER1_NUMBER = NEWS_F_COUNT CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM NEWS_F1_COUNT = NEWS_F_COUNT REWRITE (7) NEWS_FOLDER1_COM RETURN END SUBROUTINE SUBSCRIBE IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) COMMON /USERINFO/ LAST(2,FOLDER_MAX) COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT IF (REMOTE_SET.LT.3) THEN WRITE (6,'('' ERROR: Selected folder is not a news folder.'')') RETURN END IF I = 1 DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND. & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1) I = I + 1 END DO IF (I.GT.FOLDER_MAX-1) THEN WRITE (6,'('' ERROR: Cannot subscribe. You have '', & '' reached the news folder limit of '',I,''.'')') & FOLDER_MAX-1 RETURN ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN WRITE (6,'('' You are already subscribed to '',A,''.'')') & FOLDER_NAME(:TRIM(FOLDER_NAME)) RETURN ELSE WRITE (6,'('' You are now subscribed to '',A,''.'')') & FOLDER_NAME(:TRIM(FOLDER_NAME)) END IF CALL UPDATE_USERINFO CALL OPEN_BULLNEWS_SHARED DO J=I,1,-1 IF (J.GT.1) THEN CALL READ_FOLDER_FILE_KEYNUM_TEMP( & ZEXT(LAST_NEWS_READ2(1,J-1)),IER) IF (FOLDER_DESCRIP.LT.FOLDER1_DESCRIP) THEN CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J-1)) END IF END IF IF (FOLDER_DESCRIP.GT.FOLDER1_DESCRIP.OR.J.EQ.1) THEN LAST_NEWS_READ2(1,J) = NEWS_FOLDER_NUMBER IF (F_START.LE.F_NBULL) THEN LAST_NEWS_READ2(2,J) = MIN(8191,F_NBULL-(F_START-1)) LAST_NEWS_READ(2,J) = F_START - 1 ELSE LAST_NEWS_READ2(2,J) = 0 LAST_NEWS_READ(2,J) = F_NBULL END IF CALL CLOSE_BULLNEWS CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) CALL UPDATE_USERINFO_NEWS_ALWAYS RETURN END IF END DO END SUBROUTINE UNSUBSCRIBE IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' COMMON /SCRATCH_INCLUDE/ SCRATCH_B1,NINCLUDE,EXC_EXPIRED COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX) COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX) COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX) COMMON /USERINFO/ LAST(2,FOLDER_MAX) I = NEWS_FIND_SUBSCRIBE() IF (I.GT.FOLDER_MAX-1) THEN WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') & FOLDER_NAME(:TRIM(FOLDER_NAME)) RETURN END IF CALL OPEN_BULLINF_SHARED DO WHILE (REC_LOCK(IER)) READ (9,KEY='*PERM',IOSTAT=IER) TEMP_USER,INF_REC END DO IF (IER.NE.0) THEN DO I=1,FOLDER_MAX INF_REC(1,I) = 0 INF_REC(2,I) = 0 END DO END IF CALL CLOSE_BULLINF I = 1 DO WHILE (INF_REC2(1,I).NE.NEWS_FOLDER_NUMBER & .AND.I.LE.FOLDER_MAX-1) I = I + 1 END DO IF (I.LE.FOLDER_MAX-1) THEN WRITE (6,'('' ERROR: Folder is permanent and cannot not be'', & '' unsubscribed.'')') RETURN END IF WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') & FOLDER_NAME(:TRIM(FOLDER_NAME)) CALL UPDATE_USERINFO I = NEWS_FIND_SUBSCRIBE() DO J=I,FOLDER_MAX-2 CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) END DO LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 CALL FREE_TAGS(I) IF (NINCLUDE.GT.0) WRITE (6,'('' Note: Excludes and/or '', & ''includes exist for this group.'')') CALL LIB$MOVC3(8*FOLDER_MAX,LAST_NEWS_READ,OLD_LAST_NEWS_READ) CALL UPDATE_USERINFO_NEWS_ALWAYS RETURN END SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' I = NEWS_FIND_SUBSCRIBE() IER = LAST_NEWS_READ(2,I) + 1 IF (IER.EQ.0) IER = 1 ! None read yet. IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN IER = 0 RETURN END IF RETURN END SUBROUTINE NEWS_GET_NEWEST_MESSAGE1(IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' I = NEWS_FIND_SUBSCRIBE1() IER = LAST_NEWS_READ(2,I) + 1 IF (I.GT.FOLDER_MAX-1) THEN IER = 0 RETURN END IF RETURN END SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' I = NEWS_FIND_SUBSCRIBE() IF (I.GT.FOLDER_MAX-1) RETURN IF (NUMBER.GT.LAST_NEWS_READ(2,I).OR.(LAST_NEWS_READ(2,I) & .GT.NEWS_F_NBULL.AND.F_START.LE.F_NBULL)) THEN LAST_NEWS_READ(2,I) = NUMBER LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER) & .OR.(LAST_NEWS_READ2(2,I).AND.'E000'X) END IF RETURN END SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' IF (SUBNUM.EQ.0) THEN COUNT = 0 SUBMSG = LAST_NEWS_READ(2,1) RETURN ELSE IF (SUBNUM.EQ.-1) THEN DO J=COUNT,FOLDER_MAX-1 CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1)) END DO LAST_NEWS_READ(1,FOLDER_MAX-1) = 0 LAST_NEWS_READ(2,FOLDER_MAX-1) = 0 ELSE IF (SUBNUM.GT.0) THEN COUNT = COUNT + 1 END IF IF (COUNT.LE.FOLDER_MAX-1) THEN SUBNUM = LAST_NEWS_READ2(1,COUNT) SUBMSG = LAST_NEWS_READ(2,COUNT) ELSE SUBNUM = 0 END IF RETURN END SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES) C C SUBROUTINE NEWS_NEW_NOTIFICATION C IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLUSER.INC' COMMON /READIT/ READIT COMMON /POINT/ BULL_POINT COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2) MESSAGES = .FALSE. IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) CALL OPEN_BULLNEWS_SHARED SUBNUM = 1 FOLDER_DESCRIP = ' ' REORDER = 0 DO WHILE (SUBNUM.GT.0) IER = 1 DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) FOLDER1_DESCRIP = FOLDER_DESCRIP IF (SUBNUM.NE.0) THEN CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) IF (IER.EQ.0) FOLDER_NUMBER = SUBNUM UNLOCK 7 IF (FOLDER1_DESCRIP.GT.FOLDER_DESCRIP) REORDER = 1 IF (IER.EQ.0.AND. & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START-1) ELSE IF (IER.NE.0) THEN SUBNUM = -1 ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR. & F_START.GT.F_NBULL) THEN IER = 1 END IF END IF IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN IF (READIT.EQ.1) THEN IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND. & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN IER = 1 ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR. & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR. & NEW_FLAG(2).NE.-1) THEN DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM) IF (DIFF.GT.0) IER = 1 END IF END IF END IF END DO IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN WRITE (6,'('' There are new messages in folder '', & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) MESSAGES = .TRUE. ELSE IF (SUBNUM.GT.0) THEN IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER) & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN WRITE (6,'('' There are new messages in folder '' & A,''.'')') FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,' ')-1) ELSE CALL CLOSE_BULLNEWS CALL SELECT_FOLDER(.FALSE.,IER1) IF (IER1) THEN CALL LOGIN_FOLDER IF (BULL_POINT.NE.-1) THEN NEWS_FOLDER_NUMBER = FOLDER_NUMBER IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN SAVE_BULL_POINT = BULL_POINT REDO = .TRUE. DO WHILE (REDO) REDO = .FALSE. CALL READNEW(REDO) IF (REDO) CALL REDISPLAY_DIRECTORY BULL_POINT = SAVE_BULL_POINT END DO END IF END IF END IF CALL OPEN_BULLNEWS_SHARED END IF END IF END DO IF (REORDER.EQ.1) CALL REORDER_SUBSCRIBE CALL CLOSE_BULLNEWS RETURN END SUBROUTINE REORDER_SUBSCRIBE IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLUSER.INC' I = 1 DO WHILE (LAST_NEWS_READ2(1,I).NE.0) I = I + 1 END DO I = I - 1 DO I1=1,I-1 DO J=1,I-I1 K = J + 1 S1 = LAST_NEWS_READ2(1,J) S2 = LAST_NEWS_READ2(1,K) CALL READ_FOLDER_FILE_KEYNUM(S1,IER) CALL READ_FOLDER_FILE_KEYNUM_TEMP(S2,IER1) IF (IER+IER1.EQ.0.AND.FOLDER1_DESCRIP.LT.FOLDER_DESCRIP) THEN DO L=1,2 TEMP = LAST_NEWS_READ(L,J) LAST_NEWS_READ(L,J) = LAST_NEWS_READ(L,K) LAST_NEWS_READ(L,K) = TEMP END DO END IF END DO END DO RETURN END LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) RETURN END IF I = NEWS_FIND_SUBSCRIBE() TEST_SET_FLAG = .FALSE. IF (I.GT.FOLDER_MAX-1) RETURN TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14) RETURN END LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) RETURN END IF I = NEWS_FIND_SUBSCRIBE() TEST_BRIEF_FLAG = .FALSE. IF (I.GT.FOLDER_MAX-1) RETURN TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) RETURN END LOGICAL FUNCTION TEST_NOTIFY_FLAG(NUMBER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN TEST_NOTIFY_FLAG = TEST2(NOTIFY_FLAG,NUMBER) RETURN END IF I = NEWS_FIND_SUBSCRIBE() TEST_NOTIFY_FLAG = .FALSE. IF (I.GT.FOLDER_MAX-1) RETURN TEST_NOTIFY_FLAG = BTEST(LAST_NEWS_READ2(2,I),13) RETURN END INTEGER FUNCTION NEWS_FIND_SUBSCRIBE() IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' I = 1 DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER & .AND.I.LE.FOLDER_MAX-1) I = I + 1 END DO NEWS_FIND_SUBSCRIBE = I RETURN END INTEGER FUNCTION NEWS_FIND_SUBSCRIBE1() IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' I = 1 DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER1_NUMBER & .AND.I.LE.FOLDER_MAX-1) I = I + 1 END DO NEWS_FIND_SUBSCRIBE1 = I RETURN END SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' I = NEWS_FIND_SUBSCRIBE() IF (I.GT.FOLDER_MAX-1) THEN WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') RETURN END IF CALL OPEN_BULLINF_SHARED DO WHILE (REC_LOCK(IER)) READ (9,KEY='*PERM',IOSTAT=IER1) TEMP_USER,INF_REC END DO IF (IER1.NE.0) THEN DO I=1,FOLDER_MAX INF_REC(1,I) = 0 INF_REC(2,I) = 0 END DO END IF CALL CLOSE_BULLINF IP = 1 DO WHILE (INF_REC2(1,IP).NE.NEWS_FOLDER_NUMBER & .AND.IP.LE.FOLDER_MAX-1) IP = IP + 1 END DO IER = .TRUE. IF (IP.EQ.FOLDER_MAX) THEN PERM = .FALSE. IP = 1 ELSE PERM = .TRUE. END IF IF (NOTIFY.EQ.0) THEN IF (PERM.AND.BTEST(INF_REC2(2,IP),13)) THEN WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')') RETURN ELSE LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),13) END IF ELSE IF (NOTIFY.EQ.1) THEN LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),13) RETURN ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.PERM.AND. & (BTEST(INF_REC2(2,IP),14).OR.BTEST(INF_REC2(2,IP),15))) THEN IER = .FALSE. ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.PERM.AND. & (BTEST(INF_REC2(2,IP),14).AND. & .NOT.BTEST(INF_REC2(2,IP),15))) THEN IER = .FALSE. ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.PERM.AND. & (BTEST(INF_REC2(2,IP),14).XOR.BTEST(INF_REC2(2,IP),15))) THEN IER = .FALSE. END IF IF (IER) THEN IF (READNEW.EQ.1) & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) IF (READNEW.EQ.0) & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) IF (BRIEF.EQ.1) & LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) IF (BRIEF.EQ.0) & LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) ELSE WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')') WRITE (6,'('' Flags will be set to those permanent settings.'')') IF (BTEST(INF_REC2(2,IP),14)) THEN LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14) ELSE LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14) END IF IF (BTEST(INF_REC2(2,IP),15)) THEN LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15) ELSE LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15) END IF END IF CALL UPDATE_USERINFO RETURN END SUBROUTINE ADD_LOCAL_NEWS(UNIT) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' COMMON /LAST_RECORD_WRITTEN/ OCOUNT COMMON /NEWS_HEADER_INFO/ MSGNUM,SUBJECT_LINE,FROM_LINE CHARACTER*256 FROM_LINE,SUBJECT_LINE CHARACTER*12 MSGNUM REWIND UNIT CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM) CALL OPEN_BULLDIR CALL OPEN_BULLFIL CALL SET_BULLFIL_UPDATE OBLOCK = NBLOCK + 1 CALL STORE_BULL(TRIM(FROM_LINE)+6,'From: '// & FROM_LINE(:TRIM(FROM_LINE)),OBLOCK) IF (TRIM(SUBJECT_LINE).GT.LEN(DESCRIP)) THEN CALL STORE_BULL(TRIM(SUBJECT_LINE)+6, & 'Subj: '//SUBJECT_LINE(:TRIM(SUBJECT_LINE)),OBLOCK) END IF CALL COPY_BULL(UNIT,1,OBLOCK,IER) IF (IER.NE.0) THEN CALL CLOSE_BULLFIL CALL CLOSE_BULLDIR RETURN END IF LENGTH = OCOUNT - (NBLOCK + 1) + 1 NBLOCK = NBLOCK + LENGTH + 1 SYSTEM = 0 CALL ADD_ENTRY CALL CLOSE_BULLFIL CALL UPDATE_NEWS_FOLDER CALL CLOSE_BULLDIR RETURN END SUBROUTINE UPDATE_NEWS_FOLDER C C SUBROUTINE UPDATE_NEWS_FOLDER C C FUNCTION: Updates folder info due to new message. C IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' NEW_NEWS_F_END = NEWS_F_END NEW_F_COUNT = F_COUNT CALL OPEN_BULLNEWS_SHARED CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER) IF (NEW_NEWS_F_END.GT.NEWS_F_END) THEN CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM) F_NBULL = NEW_NEWS_F_END NEWS_F_END = NEW_NEWS_F_END F_COUNT = NEW_F_COUNT END IF IF (F_START.EQ.0.AND.F_NBULL.GT.0) F_START = 1 CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM)) IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).LT.0) & NEWS_F_EXPIRED_DATE = NEWS_EX_BTIM_KEY CALL REWRITE_FOLDER_FILE(IER) CALL CLOSE_BULLNEWS RETURN END SUBROUTINE SEND_POST IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFILES.INC' INCLUDE 'BULLDIR.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /BULLPAR/ BULL_PARAMETER,LEN_P CHARACTER*64 BULL_PARAMETER CHARACTER FILE*132 C = 0 IF (.NOT.NEWS_LOGIN()) RETURN DO WHILE (LIB$FIND_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)) & //'*.POST',FILE,C)) IF (.NOT.NEWS_WRITE('POST')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:3).NE.'340') RETURN OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') DO WHILE (IER.EQ.0) READ (3,'(Q,A)',IOSTAT=IER) I,INPUT IF (IER.EQ.0) THEN IF (INPUT(:5).EQ.'From:') & BULL_PARAMETER = INPUT(7:INDEX(INPUT,'@')-1) IF (.NOT.NEWS_WRITE(INPUT(:I))) GO TO 100 END IF END DO IF (INPUT.NE.'.') THEN IF (.NOT.NEWS_WRITE('.')) GO TO 100 END IF IF (.NOT.NEWS_READ()) GO TO 100 IF (BUFFER(:3).NE.'240') THEN CLOSE (UNIT=3) CALL SENDMAIL(FILE,BULL_PARAMETER(:TRIM(BULL_PARAMETER)) & ,'ERROR: Posting rejected: '//BUFFER(SB:EB),IER) OPEN (UNIT=3,FILE=FILE,IOSTAT=IER,STATUS='OLD') END IF CLOSE (UNIT=3,STATUS='DELETE') END DO 100 CLOSE (UNIT=3) RETURN END SUBROUTINE GET_UNAME(UNAME) IMPLICIT INTEGER (A-Z) INCLUDE '($MAILDEF)' CHARACTER*(*) UNAME CALL DISABLE_PRIVS C = 0 STATUS = MAIL$USER_BEGIN(C,0,0) IF (.NOT.STATUS) GO TO 100 CALL INIT_ITMLST CALL ADD_2_ITMLST(LEN(UNAME),MAIL$_USER_PERSONAL_NAME, & %LOC(UNAME)) CALL END_ITMLST(GET_USER_ITMLST) STATUS = MAIL$USER_GET_INFO(C,0,%VAL(GET_USER_ITMLST)) IF (.NOT.STATUS) GO TO 100 STATUS = MAIL$USER_END(C,0,0) IF (.NOT.STATUS) GO TO 100 100 CALL ENABLE_PRIVS IF (UNAME.EQ.'()') THEN UNAME = ' ' ELSE IF (TRIM(UNAME).GT.0) THEN UNAME = ' ('//UNAME(:TRIM(UNAME))//')' END IF RETURN END SUBROUTINE RECOUNT C C SUBROUTINE RECOUNT C C FUNCTION: C C Fixes the message count of stored news groups. This may become wrong C if old copies of some of the database files are used with newer versions. C IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFILES.INC' COMMON /NEXT/ NEXT COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /BULLFIL/ BULLFIL COMMON /NEWSDIR_FILE/ BULLNEWSDIR_FILE CHARACTER*80 BULLNEWSDIR_FILE FOLDER_NUMBER = 1000 FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]' CALL OPEN_BULLNEWS_SHARED DO WHILE (REC_LOCK(IER)) READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) END DO IF (IER.NE.0) THEN CALL CLOSE_BULLNEWS RETURN END IF REMOTE_SET = 4 DO WHILE (IER.EQ.0) DO WHILE (REC_LOCK(IER)) READ (7,IOSTAT=IER) NEWS_FOLDER_COM END DO IF (BTEST(NEWS_F_FLAG,8).AND.IER.EQ.0) THEN CALL NEWS_TO_FOLDER CALL OPEN_BULLDIR_SHARED NUM = F_START F_COUNT = 0 IF (F_START.GT.0) THEN CALL READDIR(NUM,IER) NEXT = .TRUE. F_START = NUM DO WHILE (NUM+1.EQ.IER) F_COUNT = F_COUNT + 1 NUM = NUM + 1 IF (NUM.LE.F_NBULL) CALL READDIR(NUM,IER) END DO NEXT = .FALSE. F_NBULL = NUM - 1 END IF CALL CLOSE_BULLDIR CALL REWRITE_FOLDER_FILE(IER) END IF END DO CALL DELLNM('BULL_NEWS_RECOUNT') CALL CLOSE_BULLNEWS RETURN END SUBROUTINE DELLNM(LOG) IMPLICIT INTEGER (A-Z) INCLUDE '($PSLDEF)' CHARACTER*(*) LOG CALL SYS$DELLNM('LNM$SYSTEM',LOG,PSL$C_SUPER) RETURN END SUBROUTINE NEWNEWS(SINCE_BTIM,FOUND) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' INCLUDE 'BULLFOLDER.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /XHDR/ XHDR LOGICAL XHDR /.FALSE./ COMMON /POINT/ BULL_POINT CHARACTER*8 NUMBER,NUMBER1 DIMENSION SINCE_BTIM(2) START = F_START END = F_NBULL FOUND = 0 IF (REMOTE_SET.EQ.3.AND.XHDR) THEN IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN DO WHILE (NUMBER1(1:1).EQ.' ') NUMBER1 = NUMBER1(2:) END DO IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1)) & RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).EQ.'22') THEN IF (.NOT.NEWS_READ()) RETURN DO WHILE (BUFFER(SB:EB).NE.'.') IF (FOUND.EQ.0) THEN L = INDEX(BUFFER(SB:EB),' ') CALL OTS$CVT_TI_L(BUFFER(SB:SB+L-2),IER,,%VAL(1)) CALL NEWS_TIME(BUFFER(SB+L:EB),MSG_BTIM) CALL CONVERT_FROM_GMT(MSG_BTIM) IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) & FOUND = IER END IF IF (.NOT.NEWS_READ()) RETURN END DO IF (FOUND.NE.0) THEN IF (.NOT.OTS$CVT_L_TI(FOUND,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN END IF END IF ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).NE.'22') THEN IF (.NOT.NEWS_WRITE('NEXT')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN BUFFER(:3) = '500' DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22') START = START + 1 IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN END DO IF (BUFFER(:2).NE.'22') THEN IER = 0 END = START - 1 RETURN END IF END IF IF (.NOT.NEWS_WRITE('HEAD')) RETURN IF (.NOT.NEWS_READ()) RETURN IER = OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) END = START + NUMDIR - 1 END IF IER = 0 I = START DO WHILE (IER.EQ.0.AND.I.LE.END.AND.FOUND.EQ.0) IER = OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1)) CALL NEWS_HEADER(IER) IF (IER.NE.0) RETURN CALL CONVERT_FROM_GMT(MSG_BTIM) IF (COMPARE_BTIM(SINCE_BTIM,MSG_BTIM).LT.0) FOUND = MSG_NUM I = I + 1 IF (REMOTE_SET.EQ.3.AND.I.LE.END.AND.FOUND.EQ.0) THEN IER = 2 IF (.NOT.NEWS_WRITE('NEXT')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:3).NE.'223') THEN END = I - 1 IER = 0 RETURN END IF IF (.NOT.NEWS_WRITE('HEAD')) RETURN IF (.NOT.NEWS_READ()) RETURN IER = 0 END IF END DO IF (FOUND.EQ.0) THEN IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN END IF END IF RETURN END