From: ADVAX::"MRL@NERUS.PFC.MIT.EDU" " " 7-MAR-1991 13:06:15.96 To: ARISIA::EVERHART CC: Subj: BULLETIN Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Thu, 7 Mar 91 13:03:14 EST Received: from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP id AA01068 for ; Thu, 7 Mar 91 11:34:18 -0500 From: MRL@NERUS.PFC.MIT.EDU Received: from ALCVAX.PFC.MIT.EDU by mcnc.mcnc.org (5.59/MCNC/6-11-90) id AA03246; Thu, 7 Mar 91 10:14:22 -0500 for ARISIA.DNET.ge.com!EVERHART Message-Id: Date: Thu, 7 Mar 91 10:09 EST Subject: BULLETIN To: ARISIA::EVERHART X-Envelope-To: EVERHART@ARISIA.DNET.GE.COM X-Vms-To: IN%"EVERHART@ARISIA.DNET.GE.COM" Greetings: I've discovered a bug in BULLETIN10.FOR which affects the newsreader feature. It could result in file corruption when using NEWS in BULLETIN. Enclosed is the corrected BULLETIN10.FOR. MRL ------------------------------------------------------------------------------ C C BULLETIN10.FOR, Version 3/7/91 C Purpose: Bulletin board utility program. C Environment: VAX/VMS C Usage: Invoked by the BULLETIN command. 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 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 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 (1) END_LINE = INDEX(BUFFER(START_READ:END_READ),LF) IF (END_LINE.GT.0) THEN SB = START_READ IF (END_LINE-2.LE.255) THEN END_LINE = END_LINE + SB - 1 EB = END_LINE - 2 ELSE EB = SB + 254 IF (INDEX(BUFFER(SB:EB),' ').GT.0) THEN DO WHILE (BUFFER(EB:EB).NE.' ') EB = EB - 1 END DO END IF END_LINE = EB END IF IF (END_LINE.LT.END_READ) THEN START_READ = END_LINE + 1 ELSE END_READ = 0 END IF RETURN ELSE IF (END_READ-START_READ.EQ.1023) THEN NEWS_READ = 0 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) PARAMETER CR = CHAR(13), LF = CHAR(10) COMMON /NEWS_INIT/ END_READ CHARACTER*(*) WRITE LOGICAL TRY_RECONNECT/.FALSE./ 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. CALL NEWS_RECONNECT(WRITE) TRY_RECONNECT = .FALSE. END IF RETURN END SUBROUTINE NEWS_RECONNECT(WRITE) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /POINT/ BULL_POINT CHARACTER*(*) WRITE CHARACTER*6 NUMBER CHARACTER*(FOLDER_RECORD) FOLDER2_COM CALL NEWS_LOGOUT IF (.NOT.NEWS_LOGIN()) RETURN IF (INDEX(FOLDER,'.').GT.0) 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 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 'BULLDIR.INC' INCLUDE 'BULLUSER.INC' COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /PATH/ PATHNAME,LPATH CHARACTER*132 PATHNAME COMMON /MSGID/ MESSAGE_ID CHARACTER*255 MESSAGE_ID CHARACTER*12 HIGHFROM 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.EQ.3) THEN CALL STR$UPCASE(HIGHFROM,FROM) IF (LPATH.EQ.0) CALL GET_PATHNAME IF (HIGHFROM.EQ.USERNAME.AND.MESSAGE_ID(INDEX(MESSAGE_ID,'@')+1: & TRIM(MESSAGE_ID)-1).EQ.PATHNAME(:INDEX(PATHNAME,'!')-1)) & THEN CALL NEWS_POST('cancel',0,IER,'Delete news item.') ELSE WRITE (6,'('' ERROR: Not owner of message.'')') END IF IER = 0 END IF 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*6 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 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 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.'.'.AND..NOT. & OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')+SB-2) & ,START,,%VAL(1))) RETURN 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) RETURN START = MAX(F_START,START-NUMDIR) 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 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.AND..NOT.NEWS_WRITE & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN IF (I.EQ.2.AND..NOT.NEWS_WRITE & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN 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 J=SB+INDEX(BUFFER(SB:EB),' '),EB IF (ICHAR(BUFFER(J:J)).LT.32) BUFFER(J:J) = ' ' END DO TEMP(I*256+1:) = BUFFER(SB+INDEX(BUFFER(SB:EB),' '):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 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) DESCRIP = TEMP(257:512) CALL GET_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 (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN 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 IF (.NOT.NEWS_CONNECTED) THEN NEWS_LOGIN = .FALSE. NEWS_CONNECTED = NEWS_CONNECT() IF (.NOT.NEWS_CONNECTED) RETURN IF (.NOT.NEWS_READ()) RETURN IF (.NOT.NEWS_WRITE('XHDR')) RETURN IF (.NOT.NEWS_READ()) RETURN XHDR = BUFFER(:3).NE.'500' END IF NEWS_LOGIN = .TRUE. RETURN END SUBROUTINE NEWS_HEADER(IER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLDIR.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 EX_BTIM(1) = 0 EX_BTIM(2) = 0 DESCRIP = ' ' FROM = ' ' DO WHILE (BUFFER(SB:EB).NE.'.') 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 DO I=SB+9,EB IF (ICHAR(BUFFER(I:I)).LT.32) BUFFER(I:I) = ' ' END DO DESCRIP = BUFFER(SB+9:EB) ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM) ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM) ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN CALL GET_FROM(BUFFER(SB+6:EB),EB-SB+1) END IF END IF END DO IER = 0 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*6 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('HEAD '//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*6 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.'3FFF'X) + & LAST_NEWS_READ(2,I) + 1 IF (START.GT.F_NBULL) THEN START = -1 ELSE LAST_NEWS_READ2(2,I) = (F_NBULL-LAST_NEWS_READ(2,I)) & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X) END IF ELSE START = -1 IER = SYS$ASCTIM(,TIME,IN_BTIM,) CALL DATE_TIME(TIME) SKIP = 0 DO WHILE (1) IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM( & FOLDER_NAME))//' '//TIME)) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).EQ.'23') THEN IF (.NOT.NEWS_READ()) CALL EXIT DO I=1,SKIP IF (.NOT.NEWS_READ()) CALL EXIT END DO FIRST = BUFFER(SB:EB) IF (FIRST.EQ.'.') RETURN DO WHILE (BUFFER(SB:EB).NE.'.') IF (.NOT.NEWS_READ()) CALL EXIT END DO IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST)))) & CALL EXIT IF (.NOT.NEWS_READ()) CALL EXIT IF (BUFFER(:2).EQ.'22') THEN IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN I = F_NBULL + 1 DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE. & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>')) & .OR.I.GT.F_NBULL)) I = I - 1 IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN IF (.NOT.NEWS_READ()) RETURN END DO IF (I.GE.F_START) START = I ELSE IER = OTS$CVT_TI_L(BUFFER(SB+4: & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1)) END IF RETURN END IF END IF SKIP = SKIP + 1 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=IER) 2 ELSE 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*255 REFERENCES COMMON /NEWSGROUPS/ NEWSGROUPS CHARACTER*255 NEWSGROUPS CHARACTER*255 TEMP,FROM_LINE,SUBJECT_LINE CHARACTER*10 MSGNUM 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 IF (REMOTE_SET.EQ.3) THEN MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4) SUBJECT_LINE = ' ' FROM_LINE = ' ' NEWSGROUPS = ' ' LREF = 0 DO WHILE (BUFFER(SB:EB).NE.'.') IER = NEWS_READ() IF (.NOT.IER) RETURN IF (BUFFER(SB:EB).NE.'.') THEN IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GT.SB+5) THEN FROM_LINE = 'From: '//BUFFER(SB+6:EB) ELSE IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND. & EB.GT.SB+8) THEN DO I=SB+9,EB IF (ICHAR(BUFFER(I:I)).LT.32) BUFFER(I:I) = ' ' END DO SUBJECT_LINE = 'Subj: '//BUFFER(SB+9:EB) ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND. & EB.GT.SB+11) THEN NEWSGROUPS = BUFFER(SB+12:EB) 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) ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND. & EB.GT.SB+11) THEN IF (LREF.EQ.0) THEN REFERENCES = BUFFER(SB+12:EB) ELSE REFERENCES = REFERENCES(:LREF)//' '// & BUFFER(SB+12:EB) END IF LREF = TRIM(REFERENCES) END IF END IF END DO LSUB = TRIM(SUBJECT_LINE) LFRO = TRIM(FROM_LINE) END IF ILEN = 128 IER = 0 LENGTH = 0 LTEMP = 0 IF (REMOTE_SET.EQ.3.AND. & LSUB.EQ.0.AND..NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN 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 BUFFER = FROM_LINE SB = 1 EB = LFRO LFRO = 0 IER = 1 ELSE IF (LSUB.GT.0) THEN IF (BUFFER.EQ.SUBJECT_LINE) THEN IF (.NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:2).NE.'22') THEN IER = 0 RETURN END IF LSUB = 0 IER = NEWS_READ() ELSE BUFFER = SUBJECT_LINE SB = 1 EB = LSUB IER = 1 END IF ELSE IER = NEWS_READ() END IF IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN IER = 0 LTEMP = MIN(255,EB-SB+1) IF (LTEMP.GT.0) THEN TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1) ELSE 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 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 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*1 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*25 FOLDER_SAVE DIMENSION DUMMY(4) IF (INDEX(FOLDER1,'.').GT.0) 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:) 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 LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1) LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2) IF (SYSLOG) THEN LAST_SYS_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(3) LAST_SYS_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(4) 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*132 INCMD COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /MSGID/ MESSAGE_ID CHARACTER*255 MESSAGE_ID COMMON /NEXT/ NEXT LOGICAL NEXT /.FALSE./ COMMON /NEWGROUP/ NEWGROUP CHARACTER*6 NUMBER CHARACTER 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') NEXT = .FALSE. 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,'<'):INDEX(BUFFER,'>')) IER = 0 CALL NEWS_HEADER(IER) 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 IER = NEWS_WRITE('GROUP '//FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))) IF (.NOT.IER) RETURN IER = NEWS_READ() IF (.NOT.IER) RETURN IF (BUFFER(:3).EQ.'411') THEN CALL OPEN_BULLNEWS_SHARED CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1) IF (IER1.EQ.0) DELETE (7) CALL CLOSE_BULLFOLDER RETURN END IF NEWGROUP = .TRUE. BUFFER = BUFFER(5:) IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_END,,%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 = 0 RETURN END SUBROUTINE NEWS_TIME(INTIME,BTIM) IMPLICIT INTEGER (A-Z) CHARACTER*(*) INTIME CHARACTER*20 TIME 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.' ') I = I + 1 END DO TIME(I:I) = '-' END DO 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 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 CALL SYS_BINTIM(TIME(:I-2),BTIM) RETURN END SUBROUTINE NEWS_LIST IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 IF (.NOT.NEWS_LOGIN()) RETURN IF (.NOT.NEWS_WRITE('LIST')) RETURN IF (.NOT.NEWS_READ()) RETURN IF (BUFFER(:3).NE.'215') RETURN 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_END = 1001 WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM END IF IF (NEWS_F1_END.LT.1001) NEWS_F1_END = 1001 NEWS_F_END = NEWS_F1_END LAST_READ = NEWS_FOLDER1_NUMBER DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.') FLEN = INDEX(BUFFER(SB:),' ') - 1 NEWS_FOLDER1 = BUFFER(SB:MIN(25,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)) CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM) IF (IER.NE.0.OR.IER1.NE.0) THEN IF (FLEN.GT.25) THEN NEWS_FOLDER1_DESCRIP = BUFFER(SB+25:FLEN+SB-1) ELSE NEWS_FOLDER1_DESCRIP = ' ' END IF IER = 0 DO WHILE (IER.EQ.0.AND.IER1.EQ.0) DO WHILE (REC_LOCK(IER)) READ (7,KEY=NEWS_F_END,KEYID=1,IOSTAT=IER) END DO IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 END DO NEWS_FOLDER1_NUMBER = NEWS_F_END WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 ELSE IF (F1_START.NE.NEWS_F1_START.OR. & F1_NBULL.NE.NEWS_F1_NBULL) THEN REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM DO I = LAST_READ+1,NEXT_READ-1 DO WHILE (REC_LOCK(IER)) ! Delete non-existant READ (7,KEY=I,KEYID=1,IOSTAT=IER) ! newsgroups END DO IF (IER.EQ.0) DELETE (UNIT=7) END DO LAST_READ = NEXT_READ END IF END DO CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1) NEWS_F1_END = NEWS_F_END REWRITE (7) NEWS_FOLDER1_COM CALL CLOSE_BULLNEWS 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 'BULLUSER.INC' COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 COMMON /REF/ REFERENCES,LREF CHARACTER*255 REFERENCES COMMON /PATH/ PATHNAME,LPATH CHARACTER*132 PATHNAME COMMON /COMMAND_LINE/ INCMD CHARACTER*132 INCMD COMMON /MSGID/ MESSAGE_ID CHARACTER*255 MESSAGE_ID COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT COMMON /NEWSGROUPS/ NEWSGROUPS CHARACTER*255 NEWSGROUPS CHARACTER*(*) FILENAME,SUBJECT CHARACTER TODAY*23,MSGID*23,ZONE*5 DIMENSION NOW(2),GMT(2) IER = 1 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 IF (.NOT.NEWS_LOGIN()) GO TO 900 IF (LPATH.EQ.0) CALL GET_PATHNAME 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 IF (REMOTE_SET.GE.3) THEN IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN IF (.NOT.NEWS_WRITE('Newsgroups: '// & NEWSGROUPS(:TRIM(NEWSGROUPS)))) GO TO 900 ELSE IF (REMOTE_SET.EQ.4) THEN IF (.NOT.NEWS_WRITE('Newsgroups: '// & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)))) GO TO 900 ELSE IF (.NOT.NEWS_WRITE('Newsgroups: '// & FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)))) GO TO 900 END IF NEWSGROUPS = ' ' END IF IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(:LPATH))) GO TO 900 IF (.NOT.NEWS_WRITE('From: '//PATHNAME(INDEX(PATHNAME,'!')+1: & TRIM(PATHNAME))//'@'//PATHNAME(:INDEX(PATHNAME,'!')-1))) & GO TO 900 IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT)))) & GO TO 900 IF (INCMD(:2).EQ.'RE') THEN IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF))) & GO TO 900 END IF CALL SYS$ASCTIM(,TODAY(:23),,) IF (LZONE.EQ.0) THEN IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',ZONE)) THEN IER = OTS$CVT_TI_L(ZONE(:TRIM(ZONE)),DIFF,,%VAL(1)) IF (DIFF.LT.0) THEN PAST = .TRUE. ZONE = ZONE(2:) ELSE IF (DIFF.GT.12) THEN PAST = .TRUE. DIFF = 24 - DIFF IER = OTS$CVT_L_TI(DIFF,ZONE(1:2),,,) IF (ZONE(1:1).EQ.' ') ZONE = ZONE(2:) ELSE PAST = .FALSE. END IF IER = SYS_BINTIM('0 '//ZONE(:TRIM(ZONE))//':00',GMT) IER = SYS$GETTIM(NOW) IF (PAST) THEN IER = LIB$ADDX(NOW,GMT,GMT) ELSE IER = LIB$SUBX(NOW,GMT,GMT) END IF IER = SYS$ASCTIM(,TODAY,GMT,) ZONE = 'GMT' ELSE IF (.NOT.SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE) & .AND..NOT.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN ZONE = 'GMT' END IF LZONE = TRIM(ZONE) END IF MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'// & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23) IF (MSGID(1:1).EQ.' ') MSGID = MSGID(2:) IF (.NOT.NEWS_WRITE('Message-ID: <'//MSGID(:TRIM(MSGID))// & '@'//PATHNAME(:INDEX(PATHNAME,'!')-1)//'>')) 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 LORGAN = TRIM(ORGANIZATION) IF (LORGAN.EQ.0) THEN IF (.NOT.SYS_TRNLNM_SYSTEM('BULL_NEWS_ORGANIZATION', & ORGANIZATION)) THEN LORGAN = -1 ELSE LORGAN = TRIM(ORGANIZATION) END IF END IF 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 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_READ()) RETURN IF (BUFFER(:3).EQ.'240') IER = 0 RETURN END IF IF (.NOT.NEWS_WRITE(' ')) GO TO 900 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.AND..NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900 END DO IF (.NOT.NEWS_WRITE('.')) GO TO 900 IF (.NOT.NEWS_READ()) GO TO 900 IF (BUFFER(:3).EQ.'240') IER = 0 900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3) 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 IF (.NOT.SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME).AND. & .NOT.SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME)) THEN WRITE (6,'('' ERROR: Cannot find local host name.'')') RETURN END IF END IF PATHNAME = PATHNAME(:TRIM(PATHNAME))//'!' & //USERNAME(:TRIM(USERNAME)) CALL LOWERCASE(PATHNAME) LPATH = TRIM(PATHNAME) RETURN END SUBROUTINE NEWS2BULL IMPLICIT INTEGER (A-Z) INCLUDE 'BULLFOLDER.INC' COMMON /COMMAND_LINE/ INCMD CHARACTER*132 INCMD COMMON /BUFFER/ BUFFER,SB,EB CHARACTER BUFFER*1280 EXTERNAL BULLETIN_SUBCOMMANDS CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*25 CHARACTER*6 NUMBER DIMENSION SAVE_F_NEWEST_BTIM(2) CALL ALLPRIV CALL NEWS_LIST 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,'<') IF (SLIST.GT.0) THEN IF ((INDEX(FOLDER_DESCRIP,'@').LE.SLIST.OR. & FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@').AND. & INDEX(FOLDER_DESCRIP,'.').GT.SLIST) 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 FILEOPEN = .FALSE. DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS) IF (.NOT.FILEOPEN) THEN POINT_FOLDER = POINT_FOLDER + 1 CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM) CALL SELECT_FOLDER(.FALSE.,IER) SAVE_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1) SAVE_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2) FOLDER_SAVE = FOLDER FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:) FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1) IF (FOLDER_DESCRIP(1:1).EQ.'@'.AND.IER) THEN OPEN (UNIT=3,FILE=FOLDER_DESCRIP(2:TRIM(FOLDER_DESCRIP)) & ,STATUS='OLD',IOSTAT=IER1) IF (IER1.EQ.0) THEN READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP IF (IER1.NE.0) CLOSE (UNIT=3) IF (IER1.EQ.0) FILEOPEN = .TRUE. END IF ELSE IER1 = 0 END IF END IF IF (IER.AND.IER1.EQ.0) THEN FOLDER_NUMBER = -1 FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP)) CALL SELECT_FOLDER(.FALSE.,IER) IF (IER) THEN CALL REMOTE_GET_NEWEST_MSG(SAVE_F_NEWEST_BTIM,START) IF (START.GE.F_START) THEN CALL OTS$CVT_L_TI(START,NUMBER,,,) INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM( & FOLDER_SAVE))//' '//NUMBER//'-LAST' CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS) CALL MOVE(.FALSE.) END IF END IF IF (FILEOPEN) THEN READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP IF (IER1.NE.0) CLOSE (UNIT=3) IF (IER1.NE.0) FILEOPEN = .FALSE. END IF END IF END DO CALL EXIT END SUBROUTINE DATE_TIME(TIME) IMPLICIT INTEGER (A-Z) 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_END,KEYID=1) IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1 END DO NEWS_FOLDER1_NUMBER = NEWS_F_END 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_END = NEWS_F_END REWRITE (7) NEWS_FOLDER1_COM RETURN END SUBROUTINE SUBSCRIBE IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT IF (REMOTE_SET.NE.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) I = I + 1 END DO IF (I.GT.FOLDER_MAX) THEN WRITE (6,'('' ERROR: Cannot subscribe. You have '', & '' reached the news folder limit of '',I,''.'')') & FOLDER_MAX 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 LAST_NEWS_READ2(1,I) = NEWS_FOLDER_NUMBER IF (F_START.LE.F_NBULL) THEN LAST_NEWS_READ2(2,I) = F_NBULL - (F_START - 1) LAST_NEWS_READ(2,I) = F_START - 1 ELSE LAST_NEWS_READ2(2,I) = 0 LAST_NEWS_READ(2,I) = F_NBULL END IF RETURN END SUBROUTINE UNSUBSCRIBE IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' INCLUDE 'BULLFOLDER.INC' I = NEWS_FIND_SUBSCRIBE() IF (I.GT.FOLDER_MAX) THEN WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')') & FOLDER_NAME(:TRIM(FOLDER_NAME)) RETURN ELSE WRITE (6,'('' You are now no longer subscribed to '',A,''.'')') & FOLDER_NAME(:TRIM(FOLDER_NAME)) END IF DO J=I,FOLDER_MAX-1 LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1) LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1) END DO LAST_NEWS_READ(1,FOLDER_MAX) = 0 LAST_NEWS_READ(2,FOLDER_MAX) = 0 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 (I.GT.FOLDER_MAX.OR.IER.GT.F_NBULL) 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) RETURN IF (NUMBER.GT.LAST_NEWS_READ(2,I)) THEN LAST_NEWS_READ(2,I) = NUMBER LAST_NEWS_READ2(2,I) = & (F_NBULL-NUMBER).OR.(LAST_NEWS_READ2(2,I).AND.'C000'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 LAST_NEWS_READ(1,J) = LAST_NEWS_READ(1,J+1) LAST_NEWS_READ(2,J) = LAST_NEWS_READ(2,J+1) END DO LAST_NEWS_READ(1,FOLDER_MAX) = 0 LAST_NEWS_READ(2,FOLDER_MAX) = 0 ELSE COUNT = COUNT + 1 END IF IF (COUNT.LE.FOLDER_MAX) 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 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) CHARACTER*1 DUMMY MESSAGES = .FALSE. IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER',DUMMY)) RETURN CALL NEWS_GET_SUBSCRIBE(0,MSGNUM) IF (MSGNUM.EQ.0) RETURN CALL OPEN_BULLNEWS_SHARED SUBNUM = 1 DO WHILE (SUBNUM.GT.0) IER = 1 DO WHILE (SUBNUM.NE.0.AND.IER.NE.0) CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM) IF (SUBNUM.NE.0) THEN CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER) IF (IER.EQ.0.AND. & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START) ELSE IF (IER.NE.0) THEN SUBNUM = -1 ELSE IF (MSGNUM.GE.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(1:TRIM(FOLDER_DESCRIP)) 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(1:TRIM(FOLDER_DESCRIP)) ELSE CALL CLOSE_BULLNEWS CALL SELECT_FOLDER(.FALSE.,IER1) IF (IER1) THEN CALL LOGIN_FOLDER IF (BULL_POINT.NE.-1) THEN 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 CALL CLOSE_BULLNEWS RETURN END LOGICAL FUNCTION TEST_SET_FLAG(NUMBER) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX) THEN TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER) RETURN END IF I = NEWS_FIND_SUBSCRIBE() 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) THEN TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER) RETURN END IF I = NEWS_FIND_SUBSCRIBE() TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15) 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) I = I + 1 END DO NEWS_FIND_SUBSCRIBE = I RETURN END SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF) IMPLICIT INTEGER (A-Z) INCLUDE 'BULLUSER.INC' I = NEWS_FIND_SUBSCRIBE() IF (I.GT.FOLDER_MAX) THEN WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')') RETURN END IF IF (NOTIFY.EQ.1) THEN WRITE (6,'('' ERROR: NOTIFY cannot be set for news folder.'')') RETURN END IF 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) RETURN END