C
C  BULLETIN3.FOR, Version 1/13/93
C  Purpose: Contains subroutines for the BULLETIN utility program.
C  Environment: VAX/VMS
C  Programmer: Mark R. London
C
	SUBROUTINE UPDATE
C
C  SUBROUTINE UPDATE
C
C  FUNCTION:  Searches for bulletins that have expired and deletes them.
C
C  NOTE:  Assumes directory file is already opened.
C
	IMPLICIT INTEGER (A - Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)

	CHARACTER*107 DIRLINE

	CHARACTER*12 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE
	CHARACTER*12 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME

	IF (REMOTE_SET.AND.
     &		NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN
	   CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
	END IF

	IF (TEST_BULLCP().OR.REMOTE_SET) RETURN
					! BULLCP cleans up expired bulletins

	ENTRY UPDATE_ALWAYS		! Entry to skip BULLCP test

	TEMP_EXDATE = '5-NOV-2000'  ! If a bulletin gets deleted, and there are
	TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value
				    ! assigned to the latest expiration date

	TEMP_DATE = '5-NOV-1956' 	! Storage for computing newest
	TEMP_TIME = '00:00:00.00'	! bulletin date if deletion occurs

	TEMP_NOSYSDATE = '5-NOV-1956' 	! Storage for computing newest
	TEMP_NOSYSTIME = '00:00:00.00'	! non-system bulletin date

	BULL_ENTRY = 1				! Init bulletin pointer
	UPDATE_DONE = 0			! Flag showing bull has been deleted

	NEW_SHUTDOWN = 0
	OLD_SHUTDOWN = SHUTDOWN

	DO WHILE (1)
	   CALL READDIR(BULL_ENTRY,IER)		! Get next directory entry
	   IF (IER.EQ.BULL_ENTRY) GO TO 100	! ERROR: Not found
	   IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0
						! If not shutdown, or time
     &	     .AND.(SYSTEM.AND.4).EQ.4)) THEN	! to delete shutdowns?
	    IF ((SYSTEM.AND.4).EQ.4) THEN	! Shutdown bulletin?
	       IF (NODE_AREA.GT.0) THEN
	          READ (EXTIME(1:2),'(I2)') I
	          READ (EXTIME(4:5),'(I2)') NODE_NUMBER_MSG
		  NODE_NUMBER_MSG = NODE_NUMBER_MSG + I*60
	          READ (EXTIME(7:8),'(I2)') I
	          READ (EXTIME(10:11),'(I2)') NODE_AREA_MSG
		  NODE_AREA_MSG = NODE_AREA_MSG + I*60
	          IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND.
     &		      NODE_AREA_MSG.EQ.NODE_AREA) THEN
		     DIFF = 0
		  ELSE
		     DIFF = 1
		  END IF
	       END IF
	       DIFF = COMPARE_DATE(EXDATE,' ')
	       IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ')
	       IF (DIFF.GT.0) NEW_SHUTDOWN = NEW_SHUTDOWN + 1
	    ELSE
	       DIFF = COMPARE_DATE(EXDATE,' ')	! Has expiration date passed?
	       IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ')
	    END IF
	    IF (DIFF.LE.0) THEN			! If so then delete bulletin
	      CALL DELETE_ENTRY(BULL_ENTRY)	! Delete bulletin entry
	      IF (UPDATE_DONE.EQ.0) THEN	! If this is first deleted file
	         UPDATE_DONE = BULL_ENTRY	! store it to use for reordering
	      END IF				! directory file.
	    ELSE IF ((SYSTEM.AND.7).LE.3) THEN	! Expiration date hasn't passed
		! If a bulletin is deleted, we'll have to update the latest
		! expiration date. The following does that.
	      DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE)
	      IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND.
     &		COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN
	         TEMP_EXDATE = EXDATE		! If this is the latest exp
	         TEMP_EXTIME = EXTIME		! date seen so far, save it.
	      END IF
	      TEMP_DATE = DATE			! Keep date after search
	      TEMP_TIME = TIME			! we have the last message date
	      IF (.NOT.BTEST(SYSTEM,0)) THEN
		 TEMP_NOSYSDATE = DATE
		 TEMP_NOSYSTIME = TIME
	      END IF
	    END IF
	   ELSE
	      TEMP_DATE = DATE
	      TEMP_TIME = TIME
	      IF (.NOT.BTEST(SYSTEM,0)) THEN
		 TEMP_NOSYSDATE = DATE
		 TEMP_NOSYSTIME = TIME
	      END IF
	   END IF
	   BULL_ENTRY = BULL_ENTRY + 1
	END DO

100	IF (UPDATE_DONE.GT.0) THEN		! Reorder directory file
	   CALL CLEANUP_DIRFILE(UPDATE_DONE)	! due to deleted entries
	END IF

	DATE = NEWEST_DATE
	TIME = NEWEST_TIME
	CALL READDIR(0,IER)
	SHUTDOWN = NEW_SHUTDOWN
	NEWEST_EXDATE = TEMP_EXDATE
	DIFF = COMPARE_DATE(NEWEST_EXDATE,' ')
	IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000'
	NEWEST_EXTIME = TEMP_EXTIME
	NEWEST_DATE = TEMP_DATE
	NEWEST_TIME = TEMP_TIME
	CALL WRITEDIR(0,IER)
	SYSTEM = 0			! Updating last non-system date/time
	NEWEST_DATE = TEMP_NOSYSDATE
	NEWEST_TIME = TEMP_NOSYSTIME
	CALL UPDATE_FOLDER
	SYSTEM = 1			! Now update latest date/time
	NEWEST_DATE = TEMP_DATE
	NEWEST_TIME = TEMP_TIME
	CALL UPDATE_FOLDER

	IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted?
	   CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)		  ! Save that info
	END IF

C
C  If newest message date has been changed, must change it in BULLUSER.DAT
C  and also see if it affects notification of new messages to users
C
	IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN
	   CALL UPDATE_LOGIN(.FALSE.)
	END IF

	RETURN

	END



	SUBROUTINE UPDATE_READ(USERFILE_OPEN)
C
C  SUBROUTINE UPDATE_READ
C
C  FUNCTION:
C	Store the latest date that user has used the BULLETIN facility.
C	If new bulletins have been added, alert user of the fact.
C

	IMPLICIT INTEGER (A - Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE '($PRVDEF)'

	CHARACTER TODAY*24

	DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2)

	LOGICAL MODIFY_SYSTEM /.TRUE./

C
C  Update user's latest read time in his entry in BULLUSER.DAT.
C
	IF (.NOT.USERFILE_OPEN) THEN
	   CALL OPEN_BULLUSER_SHARED		! Get BULLUSER.DAT file
	END IF

	CALL READ_USER_FILE_HEADER(IER)

	IF (IER.NE.0) THEN			! If header not present, exit
	   IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER
	   RETURN
	ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN
						! If header present, but no
	   DO I=1,FLONG				! SET_FLAG and NOTIFY_FLAG
	      SET_FLAG_DEF(I) = 0		! information, write default
	      NOTIFY_FLAG_DEF(I) = 0		! flags.
	      BRIEF_FLAG_DEF(I) = 0
	   END DO
	   SET_FLAG_DEF(1) = 1
	   USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV
	   USERPRIV(2) = 0
	   REWRITE (4) USER_HEADER
	END IF

	CALL SYS$ASCTIM(,TODAY,,)		! Get today's time
	CALL SYS_BINTIM(TODAY,TODAY_BTIM)

	UNLOCK 4

	CALL READ_USER_FILE_KEYNAME(USERNAME,IER1)

	IF (IER1.EQ.0) THEN			! If entry found, update it
	   READ_BTIM_SAVE(1) = READ_BTIM(1)
	   READ_BTIM_SAVE(2) = READ_BTIM(2)
	   READ_BTIM(1) = TODAY_BTIM(1)
	   READ_BTIM(2) = TODAY_BTIM(2)
	   REWRITE (4) USER_ENTRY
	   READ_BTIM(1) = READ_BTIM_SAVE(1)
	   READ_BTIM(2) = READ_BTIM_SAVE(2)
	ELSE					! If no entry create a new entry
	   NEW_FLAG(1) = 143
	   NEW_FLAG(2) = 0
	   LOGIN_BTIM(1) = TODAY_BTIM(1)
	   LOGIN_BTIM(2) = TODAY_BTIM(2)
	   READ_BTIM(1) = TODAY_BTIM(1)
	   READ_BTIM(2) = TODAY_BTIM(2)
	   CALL WRITE_USER_FILE_NEW(IER)
	END IF

	IF (MODIFY_SYSTEM) THEN
	   CALL MODIFY_SYSTEM_LIST(1)
	   MODIFY_SYSTEM = .FALSE.
	END IF

	IF (.NOT.USERFILE_OPEN) THEN
	   CALL CLOSE_BULLUSER			! All finished with BULLUSER
	END IF

	RETURN					! to go home...

	END




	SUBROUTINE FIND_NEWEST_BULL
C
C  SUBROUTINE FIND_NEWEST_BULL
C
C	If new bulletins have been added, alert user of the fact and
C	set the next bulletin to be read to the first new bulletin.
C
C  OUTPUTS:
C	BULL_POINT  -  If -1, no new bulletins to read, else there are.
C

	IMPLICIT INTEGER (A - Z)

	COMMON /POINT/ BULL_POINT

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	INTEGER DIR_BTIM(2)

C
C  Now see if bulletins have been added since the user's previous
C  read time.  If they have, then search for the first new bulletin.
C  Ignore new bulletins that are owned by the user or system notices
C  that have not been added since the user has logged in.
C
	BULL_POINT = -1				! Init bulletin pointer

	CALL OPEN_BULLDIR_SHARED		! Yep, so get directory file
	CALL READDIR(0,IER)			! Get # bulletins from header
	IF (IER.EQ.1) THEN3
	   CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START)
	   IF (START.LE.0) THEN
	      BULL_POINT = START 
	      CALL CLOSE_BULLDIR
	      RETURNN
	   END IF
	   DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM))
	      IF (FROM.NE.USERNAME) THEN	! Ignore bull if owner is user
	         IF (SYSTEM) THEN		! If system bulletin
	            CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM)
	            DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM)T
		    IF (DIFF.GT.0) THEN_
		       START = START + 1
	               CALL READDIR(START,IER)S
		    ELSE			! SYSTEM bulletin was not seenE
		       SYSTEM = 0		! so force exit to read it.
		    END IF
	         END IF
	      ELSEP
		 START = START + 1
		 CALL READDIR(START,IER)
		 IF (IER.NE.START+1) START = NBULL + 1
	      END IF_
	   END DO
	   IF (START.LE.NBULL) BULL_POINT = START - 1
	END IFT

	CALL CLOSE_BULLDIR 

	RETURNx
	END



	SUBROUTINE GET_EXPIRED(EXPDAT,IER) 

	IMPLICIT INTEGER (A-Z)M

	INCLUDE 'BULLUSER.INC'I

	INCLUDE 'BULLFOLDER.INC'd

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER*24 EXPDAT
	CHARACTER*24 TODAYp

	DIMENSION EXTIME(2),NOW(2)-

	EXTERNAL CLI$_ABSENTc

	IER = SYS$ASCTIM(,TODAY,,)		! Get today's datee

	IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN)5

	PROMPT = .TRUE.

	EXPIRE_LIMIT = F_EXPIRE_LIMIT
	IF (REMOTE_SET.EQ.4.AND.EXPIRE_LIMIT.EQ.0)a
     &	   EXPIRE_LIMIT = NEWS_EXPIRE_LIMIT_DEFAULT

5	IF (PROMPT) THEN
	   IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN	! Was value specified?
	      PROMPT = .FALSE.H
	   ELSE
	      DEFAULT_EXPIRE = FOLDER_BBEXPIREe
	      IF (REMOTE_SET.EQ.4.AND.DEFAULT_EXPIRE.EQ.0)1
     &		 DEFAULT_EXPIRE = NEWS_EXPIRE_DEFAULTL
	      IF ((DEFAULT_EXPIRE.GT.EXPIRE_LIMIT.OR.DEFAULT_EXPIRE
     &		  .EQ.0).AND.EXPIRE_LIMIT.GT.0.AND..NOT.
     &	          FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
		 DEFAULT_EXPIRE = F_EXPIRE_LIMIT
	      END IF 
	      IF (BTEST(FOLDER_FLAG,3).OR.A
     &		  REMOTE_SET.EQ.4) THEN		! NOPROMPT was setE
		 IF (DEFAULT_EXPIRE.LE.0) THEN		! If no expiration date)
	            SYSTEM = SYSTEM.OR.2		! make permanentD
	            EXPDAT = '5-NOV-2000 00:00:00.00'
		 ELSE					! Else set expirationG
		    CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)
		    EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'
		 END IF 
		 ILEN = TRIM(EXPDAT)
	      ELSE 
		 IF (DEFAULT_EXPIRE.EQ.0) THEN	! Get expiration date
	            WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4).
		 ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN
	            WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4)x
		 ELSEd
	            WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4),
     &					DEFAULT_EXPIRE
		 END IFF
		 WRITE (6,1035) 
	         CALL GET_LINE(EXPDAT,ILEN)	! Get EXPDAT line
		 IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN
		    IF (DEFAULT_EXPIRE.EQ.-1) THEN
		       EXPDAT = '5-NOV-2000 00:00:00.00'
		       SYSTEM = IBSET(SYSTEM,1)	! Indicate permanent message
		    ELSE
		       CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)i
		       EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'l
		    END IF
		    ILEN = TRIM(EXPDAT)i
		 END IFe
	      END IF 
	   END IF
	ELSE 
	   RETURN
	END IF,

	IF (ILEN.LE.0) THEN
	   IER = 0.
	   RETURN
	END IF 

	EXPDAT = EXPDAT(:ILEN)			! Change trailing zeros 2 spaces

	IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND.P
     &		INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN	! Only time specified?
	   EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT	! Add date
	ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND.		! Date specifiedT
     &			INDEX(EXPDAT,'-').GT.0) THEN	! but no year?
	   SPACE = INDEX(EXPDAT,' ') - 1			! Add year
	   IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT) 
	   YEAR = INDEX(TODAY(6:),'-')O
	   EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:) 
	END IF 

	CALL STR$UPCASE(EXPDAT,EXPDAT)		! Convert to upper case
	IER = SYS_BINTIM(EXPDAT,EXTIME)
	IF (IER.NE.1) THEN			! If not able to do so
    	   WRITE(6,1040)			! tell user is wrong
	   IER = 0				! Set error for return valueM
	   GO TO 5				! Re-request date (if prompting) 
	END IFT
	IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)
	IF (TIMLEN.EQ.16) THENA
	   CALL SYS$GETTIM(NOW)
	   CALL LIB$SUBX(NOW,EXTIME,EXTIME)
	   IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)M
	END IFN

	IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDATS
	IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today'sY
	IF (IER.GT.EXPIRE_LIMIT.AND.EXPIRE_LIMIT.GT.0.AND.F
     &	    .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
	   WRITE(6,1050) EXPIRE_LIMIT		! Expiration date > limitI
	   IER = 0				! Set error for return valueH
	   GO TO 5				! Re-request date (if prompting)N
	END IFU
	IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:23),TODAY(13:23))e
	IF (IER.LE.0) THEN			! If expiration date not future
	   WRITE(6,1045)			! tell useri
	   IER = 0				! Set error for return valueT
	   GO TO 5				! Re-request date (if prompting) 
	END IFT

	IF (PROMPT) THEND
	   IF (BTEST(SYSTEM,1)) THEN		! Permanent message
	      WRITE (6,'('' Message will be permanent.'')')
	   ELSE
	      WRITE (6,'('' Expiration date will be '',A,''.'')')
     &		EXPDAT(:TRIM(EXPDAT))s
	   END IF
	END IFr

	IER = 1

	RETURN

1030	FORMAT(' It is ',A,'. Specify when message expires.')
1031	FORMAT(' It is ',A,'. Specify when message expires.',
     &		' Default is permanent.')(
1032	FORMAT(' It is ',A,'. Specify when message expires.',
     &		' Default is ',I3,' days.') 
1035    Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',
     &		'or delta time: dddd hh:mm:ss')L
1040	FORMAT(' ERROR: Invalid date format specified.')(
1045	FORMAT(' ERROR: Specified time has already passed.')
1050	FORMAT(' ERROR: Specified expiration period too large.'
     &		' Limit is ',I3,' days.')S

	END


	SUBROUTINE MAILEDIT(INFILE,OUTFILE)

	IMPLICIT INTEGER (A-Z)	

	INCLUDE '($SSDEF)'_

	INCLUDE 'BULLUSER.INC')

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	EXTERNAL BULLETIN_SUBCOMMANDS

	CHARACTER*(*) INFILE,OUTFILE 

	CHARACTER*80 MAIL_EDIT,OUTR
	DATA MAIL_EDIT /' '/.

	CHARACTER*132 INPUT

	CHARACTER*256 SPAWN_COMMAND

	IF (CAPTIVE(2)) THEN
	   WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')')I
	   RETURN
	END IF)

	IF (MAIL_EDIT.EQ.' ') THENE
	  IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THENN
	    OPEN (UNIT=10,FILE='VMSMAIL_PROFILE',
     &	     DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA',
     &       ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,SHARED,IOSTAT=IER)T
	    IF (IER.EQ.0) THEN(
	      DO WHILE (REC_LOCK(IER))	
	         READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT
	      END DO2
	      CLOSE (UNIT=10)
	      IF (IER.EQ.0) THENI
		 INPUT = INPUT(32:)2
		 DO WHILE (TRIM(INPUT).GT.0)
		    IF (ICHAR(INPUT(1:1)).EQ.8) THEN
		       MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3)))
		       INPUT = ' '
		    ELSE
		       INPUT = INPUT(ICHAR(INPUT(3:3))+5:)
	            END IFE
	         END DO
	      END IFU
	    END IFi
	  END IF 
	  CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT) 
	END IF

	OUT = OUTFILE
	IF (TRIM(OUT).EQ.0) THEN
	   OUT = INFILE
	END IFS

	CALL DISABLE_PRIVSl
	CALL DECLARE_CTRLC_ASTl
	IF (TRIM(MAIL_EDIT).GT.0	
     &		.AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN
	   IF (MAIL_EDIT(:1).EQ.'@') MAIL_EDIT = MAIL_EDIT(2:)b
	   IF (OUT.EQ.INFILE) THENa
	      SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))
     &		//' "" '//OUT(:TRIM(OUT))C
	   ELSE
	      SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))
     &		//' '//INFILE//' '//OUT(:TRIM(OUT)) 
	   END IF
	   CALL LIB$SPAWN(SPAWN_COMMAND)r
	ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THENf
	   CONTEXT = 0.
	   IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT)
	   IF (.NOT.IER1) THEN 
	      CALL TPU$EDIT(' ',OUT) 
	   ELSE
	      CALL TPU$EDIT(INFILE,OUT)
	   END IF
	   IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
		! TPU does CLI$ stuff which wipes our parsed command linee
	ELSEo
	   CALL EDT$EDIT(INFILE,OUT)
	END IFG
	CALL CANCEL_CTRLC_AST
	CALL ENABLE_PRIVS

	RETURN
	END





	SUBROUTINE CREATE_BULLCP 

	IMPLICIT INTEGER (A-Z)_

	INCLUDE '($PRCDEF)'

	INCLUDE '($SSDEF)'I

	INCLUDE '($PRVDEF)'

	INCLUDE 'BULLFILES.INC'

	COMMON /REALPROC/ REALPROCPRIV(2)

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	STRUCTURE /QUOTA_ITMLST/_
	   BYTE ITEM'
	   INTEGER VALUE 
	END STRUCTURE

	RECORD /QUOTA_ITMLST/ QUOTA(5)T

	DIMENSION IMAGEPRIV(2)_

	CHARACTER IMAGENAME*132,ANSWER*4 

	IF (.NOT.SETPRV_PRIV()) THEN
	   WRITE (6,'('' ERROR: You do not have the privileges '', 
     &			''to execute the command.'')')N
	   CALL EXIT 
	END IF 

	JUST_STOP = CLI$PRESENT('STOP')

	IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN 
	   WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')')A
	   CALL EXITT
	ELSE IF (.NOT.JUST_STOP.AND.T
     &			.NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN
	   CALL SYS$SETPRV(,,,IMAGEPRIV)E
	   IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THENC
	      WRITE (6,'('' ERROR: This new version of BULLETIN'',T
     &			'' needs to be installed with SYSNAM.'')')
	      CALL EXIT
	   END IF
	END IFR

	IF (TEST_BULLCP()) THEN
	   IF (.NOT.JUST_STOP) THEN
	      WRITE (6,'('' BULLCP process running.
     & Do you wish to kill it and restart a new one? '',$)')
	      READ (5,'(A)') ANSWER(:1)
	      IF (ANSWER(:1).NE.'Y'.AND.ANSWER(:1).NE.'y') CALL EXITT
	   END IF

	   CALL DELPRC('BULLCP',IER)N

	   IF (.NOT.IER) THEN
	      CALL SYS_GETMSG(IER) 
	      CALL EXIT
	   ELSE IF (JUST_STOP) THEN
	      WRITE (6,'('' BULLCP process has been terminated.'')')E
	      CALL EXIT
	   END IF
	ELSE IF (JUST_STOP) THENL
	   WRITE (6,'('' BULLCP is not presently running.'')')_
	   CALL EXIT	
	END IFA

	CALL GETIMAGE(IMAGENAME,ILEN)

	LEN_B = TRIM(FOLDER_DIRECTORY)M

	CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)T
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW)
CG
C  Generate a new BULLCP.COM each time.  This is done in case the BULLETIN
C  executeable is moved, or a new version of BULLETIN is being installed that.
C  has changes to BULLCP.COM.  (It's also a security risk to execute the old
C  copy, as someone might have been able to write into that directory and	
C  replace BULLCP.COM, and the command procedure is executed under the
C  SYSTEM account, so it has all privileges.)P
C.
	OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM',
     &		STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')E
	IF (IER.NE.0) RETURN 
	WRITE(11,'(A)') '$SET NOON'
	WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN)
	WRITE(11,'(A)') '$LOOP:'.
	WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG'
	WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT '
     &				//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG'
	WRITE(11,'(A)') '$DEF/USER SYS$ERROR ' 
     &				//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR'
	WRITE(11,'(A)') '$B/BULLCP'
	WRITE(11,'(A)') '$WAIT 00:01:00' 
	WRITE(11,'(A)') '$GOTO LOOP'		! File open timed out
	CLOSE(UNIT=11)A
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection 

	CALL GETQUOTA(QUOTA,1)D

	IER = 0
	DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0))I
	   IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B)
     &		//'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4),
     &		,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))0
	END DO 

	IF (IER) THEN
	   OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1',
     &		STATUS='OLD',IOSTAT=IER1) 
	   IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1)c
	END IF 

	IF (.NOT.IER) THEN)
	   CALL SYS_GETMSG(IER)
	ELSEP
	   IF (CONFIRM_USER('DECNET').NE.0) THEN 
	      WRITE (6,'('' WARNING: Account with username DECNET'',Y
     &				'' does not exist.'')')A
	      WRITE (6,'('' BULLCP will be owned by present account.'')')
	   END IF
	   WRITE (6,'('' Successfully created BULLCP detached process.'')')
	END IFN
	CALL EXIT

	END






	SUBROUTINE FIND_BULLCP	

	IMPLICIT INTEGER (A-Z) 

	COMMON /BCP/ BULLCP
	DATA BULLCP /0/

	CHARACTER*80 TEMP

	IER = SYS_TRNLNM('BULL_BULLCP',TEMP)R
	IF (IER.AND.TEMP.NE.'IGNORE') BULLCP = 1T

	RETURN)
	END




	LOGICAL FUNCTION TEST_BULLCPB

	IMPLICIT INTEGER (A-Z) 

	COMMON /BCP/ BULLCP
	LOGICAL BULLCPM

	TEST_BULLCP = BULLCP(

	RETURN)
	END




	SUBROUTINE RUN_BULLCP

	IMPLICIT INTEGER (A-Z))

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'A

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'C

	COMMON /BCP/ BULLCP
	LOGICAL BULLCPH

	COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSd

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /BBOARD_LOOP/ BBOARD_LOOP

	CHARACTER*24 OLD_TIME,NEW_TIMEA

        COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY
	CHARACTER*80 FOLDER1_DIRECTORY

	IF (TEST_BULLCP()) CALL EXIT	! BULLCP already running, so exit.

	CALL LIB$DATE_TIME(OLD_TIME)e

	BULLCP = 2			! Enable process to do BULLCP functionsD

	IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')
	IF (.NOT.IER) THEN		! Can't create mailbox, so exit. 
	   CALL SYS_GETMSG(IER)
	   CALL EXITa
	END IFe

	IER = SYS$DELMBX(%VAL(CHAN))	! If process dies, mailbox is deleted.

	CALL REGISTER_BULLCP0

	CALL SET_REMOTE_SYSTEMe

	CALL START_DECNET

	BBOARD_LOOP = 0
	NEWS_LOOP = 0

	DO WHILE (1)			! Loop once every 15 minutes
	   CALL SYS$SETAST(%VAL(0))

	   UPDATEBBOARD = 1
	   IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN
	      LEN_P = TRIM(BULL_PARAMETER) 
	      DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER,IOSTAT=IER)m
     &		  UPDATEBBOARD
	      IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15
	   END IF

	   UPDATENEWS = 4
	   IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THENr
	      LEN_P = TRIM(BULL_PARAMETER)'
	      DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER,IOSTAT=IER)I
     &		  UPDATENEWS
	      IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15
	   END IF

	   CALL LIB$DATE_TIME(NEW_TIME)
	   CALL GET_PROXY_ACCOUNTS	! Proxy info for incoming connections
	   FOLDER1_DIRECTORY = FOLDER_DIRECTORY
	   CALL SYS$SETAST(%VAL(1))

           NOW = INDEX(NEW_TIME,' 03:').NE.0.AND.E
     &                     INDEX(OLD_TIME,' 03:').EQ.0
	   IER = 1c
	   DO WHILE (IER)
	      CALL BBOARD			! Look for BBOARD messages.
	      FOLDER_Q = FOLDER_Q1		! Init queue pointer to header 
	      POINT_FOLDER = 0O
	      DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)M
		 POINT_FOLDER = POINT_FOLDER + 1
		 CALL SYS$SETAST(%VAL(0))O
		 CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
		 IF (FOLDER_BBOARD(:2).NE.'::') THEN
		    CALL SELECT_FOLDER(.FALSE.,IER)	! Select folderE
		    IF (IER) THENA
		       CALL DELETE_EXPIRED	! Delete expired messages
		       IF (NOW) THEN	! Do empty block cleanup at 3 a.m.	
			  IF (NEMPTY.GT.200) THEN
			     CALL CLEANUP_BULLFILE	! Cleanup empty blocks
			  END IFB
		       END IFC
		    END IF
		 END IF 
	         IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
		    CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) 
	         END IF
		 CALL SYS$SETAST(%VAL(1))D
	      END DOT
	      CALL SYS$SETAST(%VAL(0))E
	      CALL DELETE_EXPIRED_NEWS(NOW)
	      CALL SYS$SETAST(%VAL(1))
	      IF (NOW) THEN  ! Cleanup deleted users from files at 3 a.m.
	         CALL SYS$SETAST(%VAL(0))
	         CALL TOTAL_CLEANUP_LOGIN
	         CALL SYS$SETAST(%VAL(1))
	      END IFI
	      CALL SYS$SETAST(%VAL(0))E
	      CALL REGISTER_BULLCP@
	      IER1 = 1M
	      DO WHILE (IER1)
	         IER = SYS_TRNLNM_SYSTEM_INDEX('BULL_DIR_LIST',
     &			   FOLDER_DIRECTORY)T
	         IF (IER.AND.FOLDER_DIRECTORY.EQ.FOLDER1_DIRECTORY) THEN 
		    IER1 = 1
	         ELSE
		    IER1 = 0
		 END IFU
      	      END DOO
	      IF (IER) CALL ADD_DIRECTORIES
	      CALL SYS$SETAST(%VAL(1))T
	   END DO

           CALL SYS$SETAST(%VAL(0)) 
	   FOLDER_DIRECTORY = FOLDER1_DIRECTORY
           CALL ADD_DIRECTORIESI
           CALL SYS$SETAST(%VAL(1))o

	   BBOARD_LOOP = BBOARD_LOOP + 1c
	   IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0

	   CALL SYS$SETAST(%VAL(0))
	   IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.O
     &	      NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')R
	   CALL SYS$SETAST(%VAL(1))

	   NEWS_LOOP = NEWS_LOOP + 1U
	   IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0

	   OLD_TIME = NEW_TIMER
	   CALL HIBER('15')		! Wait for 15 minutesR
CT
C  Look at remote folders and update local info to reflect new messages.
C  Do here after waiting in case problem with connecting to remote folder
C  which requires killing process.
C

	   FOLDER_Q = FOLDER_Q1
	   POINT_FOLDER = 0
	   DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)
	      POINT_FOLDER = POINT_FOLDER + 1
	      CALL SYS$SETAST(%VAL(0))S
	      CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
	      IF (FOLDER_BBOARD(:2).EQ.'::') THEN
		 CALL SELECT_FOLDER(.FALSE.,IER)
	      END IFO
	      CALL SYS$SETAST(%VAL(1))F
	   END DO
	   CALL SYS$SETAST(%VAL(0))
	   FOLDER_NUMBER = 0			! Reset to GENERAL folderS
	   CALL SELECT_FOLDER(.FALSE.,IER)B
	   CALL SYS$SETAST(%VAL(1))
	END DO

	RETURNE
	END





	SUBROUTINE SET_REMOTE_SYSTEMT

	IMPLICIT INTEGER (A-Z)n

	INCLUDE 'BULLFOLDER.INC' 

	INCLUDE 'BULLUSER.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	CHARACTER NODENAME*8W

	CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
	NODENAME = NODENAME(2:INDEX(NODENAME,':')-1),

 	CALL OPEN_BULLFOLDER_SHAREDR

	IER = 0
	DO WHILE (IER.EQ.0)
	   CALL READ_FOLDER_FILE(IER)
	   IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2)
     &		.AND.IER.EQ.0) THENY
	      CALL CLOSE_BULLFOLDER
	      CALL SETUSER(FOLDER_OWNER) 
	      CALL SELECT_FOLDER(.FALSE.,IER1)n
	      IF (IER1) THEN 
	         WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,
     &			BTEST(FOLDER_FLAG,2),NODENAME
	      END IF_
	      CALL SETUSER(USERNAME)C
 	      CALL OPEN_BULLFOLDER_SHAREDB
	      CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
	   END IF
	END DOT

	CALL CLOSE_BULLFOLDER

	FOLDER_NUMBER = 0			! Reset to GENERAL folder
	CALL SELECT_FOLDER(.FALSE.,IER)

	RETURNd
	END




	SUBROUTINE REGISTER_BULLCP 

	IMPLICIT INTEGER (A-Z)B

	INCLUDE 'BULLUSER.INC't

	INTEGER SHUTDOWN_BTIM(FLONG)M

	EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)e

	COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
	CHARACTER NODENAME*8	

	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)c

	CALL OPEN_BULLUSERi

	DO WHILE (REC_LOCK(IER)),
	   READ (4,KEY='*SYSTEM',IOSTAT=IER) 
     &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGT
	END DOW

	IF (IER.NE.0) THEN/
	   DO I=1,FLONG
	      SYSTEM_FLAG(I) = 0
	      SHUTDOWN_FLAG(I) = 0O
	   END DO
	   CALL SET2(SYSTEM_FLAG,0)
	   NODE_AREA = 0U
	END IFU

	CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
	NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)R

	DO I=1,FLONG	
	   SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)'
	END DO1

	IF (IER.NE.0) THENW
	   WRITE (4,IOSTAT=IER)
     &		'*SYSTEM     ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,O
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG!
	ELSEd
	   REWRITE (4,IOSTAT=IER)
     &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGP
	END IFS

	CALL CLOSE_BULLUSER

	RETURNE
	END





	SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER)

	IMPLICIT INTEGER (A-Z)F

	INCLUDE 'BULLUSER.INC'

	INTEGER SHUTDOWN_BTIM(FLONG)1

	EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG);

	COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
	CHARACTER NODENAME*8U

	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)

	CALL OPEN_BULLUSER_

	DO WHILE (REC_LOCK(IER)) 
	   READ (4,KEY='*SYSTEM',IOSTAT=IER) 
     &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGt
	END DO'

	CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)f

	SEEN_FLAG = 0
	DO I=1,FLONGe
	   IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1
	END DOB
	IF (SEEN_FLAG.EQ.0) NODE_AREA = 0	! All done with that node

	IF (IER.NE.0) THENP
	   WRITE (4,IOSTAT=IER)
     &		'*SYSTEM     ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,'
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGL
	ELSEF
	   REWRITE (4,IOSTAT=IER)
     &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
	END IFB

	CALL CLOSE_BULLUSER

	RETURNE
	END





	SUBROUTINE HIBER(MIN)
CI
C SUBROUTINE HIBER
CA
C FUNCTION: Waits for specified time period in minutes.
CM
	IMPLICIT INTEGER (A-Z)L
	INTEGER TIMADR(2)			! Buffer containing timeU
						! in desired system format.L
	CHARACTER TIMBUF*13,MIN*2
	DATA TIMBUF/'0 00:00:00.00'/B

	TIMBUF(6:7) = MIN

	IER=SYS$BINTIM(TIMBUF,TIMADR)
	IER=SYS$SCHDWK(,,TIMADR,)		! Set timer.
	IER=SYS$HIBER()

	RETURNA
	END



	SUBROUTINE WAIT_SEC(PARAM)U
CP
C SUBROUTINE WAIT_SECa
Ca
C FUNCTION: Waits for specified time period in seconds.
CL
	IMPLICIT INTEGER (A-Z)s
	INTEGER TIMADR(2)			! Buffer containing timeV
						! in desired system format. 
	CHARACTER TIMBUF*13,PARAM*2
	DATA TIMBUF/'0 00:00:00.00'/S
	DATA WAIT_EF /0/ 

	IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)C

	TIMBUF(9:10) = PARAMm

	IER=SYS$BINTIM(TIMBUF,TIMADR)
	IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3))	! Set timer.
	IER=SYS$WAITFR(%VAL(WAIT_EF))		! Wait for EFN to be set.p

	RETURN 
	END



	SUBROUTINE DELETE_EXPIRED_NEWS(NOW)
CE
C  SUBROUTINE DELETE_EXPIRED_NEWSL
CO
C  FUNCTION:
CP
C  Delete any expired message in local news folders.
C 

	IMPLICIT INTEGER (A-Z)>

	INCLUDE 'BULLFOLDER.INC'm

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFILES.INC'

	COMMON /NEXT/ NEXT4

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

        COMMON /BULLFIL/ BULLFIL

	INTEGER TODAY(2),DAY(2),NEXT_EX_BTIM(2)

	CHARACTER*8 TODAY_KEY
	CHARACTER ASCTIME*24_

	IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN

	FOLDER_NUMBER = 1000N

	FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//'.]'

	CALL OPEN_BULLNEWS_SHARED

	READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1)D

	IF (IER.NE.0) THEND
	   CALL CLOSE_BULLNEWST
	   RETURN
	END IF 

	CALL SYS_BINTIM('-',TODAY)'
	E
	CALL GET_MSGKEY(TODAY,TODAY_KEY) 

	DO WHILE (1) 
	   CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM)

	   DO WHILE (REC_LOCK(IER))
	      READ (7,IOSTAT=IER,KEYLE=TODAY_KEY,KEYID=3) NEWS_FOLDER_COM
	   END DO
	   CALL NEWS_TO_FOLDERL

	   UNLOCK 7

	   IF (IER.NE.0) THEN
	      IF (REMOTE_SET.EQ.4) CALL CLOSE_BULLDIR
	      CALL CLOSE_BULLNEWS
	      GO TO 1000D
	   ELSE IF (REMOTE_SET.NE.4) THEN
	      REMOTE_SET = 4	
	      CALL OPEN_BULLDIR_SHAREDR
           END IF

	   CALL GET_MSGKEY(%REF(NEWS_F_EXPIRED_DATE),%DESCR(NEWEST_EXBTIM))

	   DEL_COUNT = 0W
	   NDEL = -1t
	   DS = .FALSE.
	   DN = .FALSE.
	   CALL READ_FIRST_EXPIRED(NDEL)C
	   DO WHILE (NDEL.GT.0)
	      DIFF = COMPARE_BTIM(TODAY,EX_BTIM)C
	      IF (DIFF.GT.0) THEN
	         IF (NDEL.EQ.F_START) DS = .TRUE.
	         IF (NDEL.EQ.F_NBULL) DN = .TRUE.	_
                 IF (NDEL.GT.NEWS_F_END) THEN%
	            CALL READ_NEXT_EXPIRED(NDEL)E
		 ELSE IF (COMPARE_BTIM(EX_BTIM,NEWEST_EXBTIM).GE.0) THEN
      		    DEL_COUNT = DEL_COUNT + 1N
	            CALL READ_NEXT_EXPIRED(NDEL)s
	         ELSE IF (EXDATE(8:9).EQ.'18'.OR.	! Deleted manually?
     &				INDEX(EXDATE,'1900').GT.0) THEN 
	            IF (LENGTH.GT.0) CALL DUMP_MESSAGE()%
		    CALL SYS$ASCTIM(,ASCTIME,TODAY,)
	            EXDATE = ASCTIME(:11) R
		    EXTIME = ASCTIME(13:23)S
		    LENGTH = 0
	      	    CALL WRITEDIR(MSG_NUM,IER)
		    DEL_COUNT = 0.
	            CALL READ_FIRST_EXPIRED(NDEL)
		 ELSE 
                    CALL READ_NEXT_EXPIRED(NDEL) I
	         END IF
	      ELSE 
		 CALL COPY2(NEXT_EX_BTIM,EX_BTIM) 
	         IF (F_COUNT.LE.DEL_COUNT.OR.NDEL.GT.NEWS_F_END) THEN
		   CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NEXT_EX_BTIM) 
		 END IF 
		 NDEL = 0E
                 UNLOCK 2A
 	      END IF
	   END DO
	   CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER)
	   NEXT = .FALSE.
	   CALL READDIR(F_START,IER)L
	   IF (DS.OR.F_START.EQ.IER) THEN
	      IER = 0
	      NEXT = .TRUE.
              I = F_STARTE
              DO WHILE (F_NBULL.GE.I.AND.IER.EQ.0)
		 I = I + 1
		 CALL READDIR(I,IER)
		 IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = 0_
	      END DOR
              F_START = Ia
	      NEXT = .FALSE.
	   END IF
	   CALL READDIR(F_NBULL,IER)i
	   IF (DN.OR.F_NBULL.EQ.IER) THEN
	      I = F_NBULL
	      IER = I
	      DO WHILE (I.GE.F_START.AND.IER.EQ.I)q
		 I = I - 1
		 CALL READDIR(I,IER)
		 IF (COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0) IER = IN
	      END DO_
	      IF (I.GE.F_START) CALL COPY2(F_NEWEST_BTIM,MSG_BTIM) 
	      IF (I.NE.IER) F_NBULL = I
	   END IF
	   F_COUNT = MAX(0,F_COUNT - DEL_COUNT)
	   CALL GET_MSGKEY(TODAY,NEWS_F_EXPIRED_DATE)
	   FOLDER_FLAG = IBSET(FOLDER_FLAG,13)
	   CALL REWRITE_FOLDER_FILE(IER) 
	   IF (IER.EQ.0) THEN
    	      CALL READ_FIRST_EXPIRED(NDEL)
	      DO WHILE (NDEL.GT.0.AND.NDEL.LE.NEWS_F_END.AND.
     &		COMPARE_BTIM(EX_BTIM,NEXT_EX_BTIM).LT.0)
	         IF (LENGTH.GT.0) CALL DUMP_MESSAGE()
	         DELETE (UNIT=2)E
    	         CALL READ_FIRST_EXPIRED(NDEL)C
	      END DOI
	      CALL READ_FOLDER_FILE_KEYNAME(NEWS_FOLDER,IER)
	      FOLDER_FLAG = IBCLR(FOLDER_FLAG,13)
	      CALL GET_MSGKEY(NEXT_EX_BTIM,NEWS_F_EXPIRED_DATE)
	      CALL REWRITE_FOLDER_FILE(IER)
	   END IF
	END DO=

        CALL CLOSE_BULLDIR
        CALL CLOSE_BULLNEWS 

1000	IF (NOW) THEN .
	   CONTEXT = 0(
	   IER = LIB$FIND_FILE(BULLNEWSDIR_FILE,INPUT,CONTEXT) 
	   IF (IER) IER = CONV$RECLAIM(BULLNEWSDIR_FILE) 
	   CALL COPY2(EX_BTIM,TODAY)L
           BULLFIL = 0
	   DO I=1,31 
	      IER = SYS_BINTIM('1 00:00',DAY)
	      IER = LIB$ADDX(EX_BTIM,DAY,EX_BTIM)
	      CALL SET_BULLFIL 
	      IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
     &			'.BULLFIL;')E
	   END DO	E
           IER = LIB$DELETE_FILE(NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY))
     &                  //'BULLNEWS*.DIR;*')
	END IFL

	RETURN,
	END



	SUBROUTINE DELETE_EXPIRED
C 
C  SUBROUTINE DELETE_EXPIRED
CE
C  FUNCTION:
CC
C  Delete any expired bulletins (normal or shutdown ones).
C  (NOTE: If bulletin files don't exist, they get created now by
C  OPEN_FILE_SHARED.  Also, if new format has been defined for files,W
C  they get converted now.  The directory file has had it's record sizeL
C  lengthened in the past to include more info, and the bulletin file 
C  was lengthened from 80 to 81 characters to include byte which indicated
C  start of bulletin message.  However, that scheme was removed andR
C  was replaced with a 128 byte record compressed format).
C 

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC'T

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'Y

	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) 

	CHARACTER UPTIME_DATE*12,UPTIME_TIME*12

	CALL OPEN_BULLDIR_SHARED	! Open directory file 
	CALL OPEN_BULLFIL_SHARED	! Open bulletin file
	CALL CLOSE_BULLFIL,
	CALL READDIR(0,IER)		! Get directory header
	IF (IER.EQ.1) THEN		! Is header present?A
	   IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls? 
	   IF (IER.GT.20*356) IER = -1	! Check if latest expiration date valid.
	   IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')U
	   IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.F
     &		(FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND.G
     &		TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
			! Do shutdown messages exist and need to be checked?A
	      SHUTDOWN = 0
	      IER1 = -1
	   ELSE
	      IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
		 CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
	      END IF
	      IER1 = 1*
	   END IF
	   IF (IER.LE.0.OR.IER1.LE.0) THENN
	      CALL CLOSE_BULLDIRA
	      CALL OPEN_BULLDIR		! Reopen without sharing
	      CALL UPDATE 		! Need to updateF
	   END IF
	ELSE		! If header not there, then first time running BULLETIN
	   IF (FOLDER_NUMBER.EQ.0) THEN
	      CALL OPEN_BULLUSER	! Create user file to be able to set
	      CALL CLOSE_BULLUSER	! defaults, privileges, etc.T
	   END IF
           IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THENA
              CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) 
           END IF 
	END IFU
	CALL CLOSE_BULLDIRB

	RETURNA
	END




	SUBROUTINE BBOARD
CO
C  SUBROUTINE BBOARD
CE
C  FUNCTION: Converts mail to BBOARD into non-system bulletins.O
CN

	IMPLICIT INTEGER (A-Z)I

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLUSER.INC'I

	INCLUDE 'BULLFOLDER.INC'T

	INCLUDE '($RMSDEF)'

	COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS
	DATA FOLDER_Q1/0/

	COMMON /BBOARD_LOOP/ BBOARD_LOOPB

	CHARACTER*12 INEXDATE
	CHARACTER INDESCRIP*(INPUT_LENGTH),INFROM*(INPUT_LENGTH),INTO*76i
	CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12
	CHARACTER F_BBOARD*64,BBOARD_NAME*64 

	DIMENSION NEW_MAIL(FOLDER_MAX)N

	DATA SPAWN_EF/0/,HEADER_Q1/0/

	CALL SYS$SETAST(%VAL(0))N

	IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)i

	CALL DISABLE_CTRL

	CALL INIT_QUEUE(HEADER_Q1,INPUT)T

	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)			! Copy all bulletins from fileF
	   CALL READ_FOLDER_FILE(IER)
	   IF (IER.EQ.0) THEN
	      NUM_FOLDERS = NUM_FOLDERS + 1
	      CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
	   END IF
	END DOE

	CALL CLOSE_BULLFOLDER			! We don't need file anymorei
	CALL SYS$SETAST(%VAL(1))o

	IF (TEST_BULLCP().EQ.2.AND.BBOARD_LOOP.NE.0) GO TO 900D

	CALL SYS$SETAST(%VAL(0)).
	CALL CHECK_MAIL(NEW_MAIL)
	CALL SYS$SETAST(%VAL(1))4

	FOLDER_Q = FOLDER_Q1			! Init queue pointer to header

	NBBOARD_FOLDERS = 0

	POINT_FOLDER = 0Y

1	POINT_FOLDER = POINT_FOLDER + 1T
	IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 

	CALL SYS$SETAST(%VAL(0))E

	FOLDER_Q_SAVE = FOLDER_QF

	CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)

	IF (FOLDER_BBOARD(:4).EQ.'NONE'.OR.
     &		FOLDER_BBOARD(:2).EQ.'::') GO TO 1

	NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1

	IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1I
C
C  The process is set to the BBOARD uic and username in order to create
C  a spawned process that is able to read the BBOARD mail (a real kludge).
C 

	CALL GETUSER(USERNAME_SAVE)		! Get present username
	CALL GETACC(ACCOUNT_SAVE)		! Get present account
	CALL GETUIC(GROUP_SAVE,USER_SAVE)	! Get present uic

	IF (TRIM(FOLDER_BBOARD).GT.0) THEN	! BBOARD name present?
	   IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username
	   IF (IER.EQ.2) GO TO 910	! Can't set username. New VMS version?
	   CALL SETACC(ACCOUNTB)	! Set to BBOARD accountW
	   CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uicL
	END IF 

	LEN_B = TRIM(BBOARD_DIRECTORY) 
	IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//L
     &		FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*')
				! Delete old TXT files left due to errors_

	IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN 
	      						! If normal BBOARD user
	   IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)
     &		  //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF) 
	   CALL SYS$SETAST(%VAL(1))
	   IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))
	   CALL SYS$SETAST(%VAL(0))
	   IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR.
     &	    ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN
	      CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)
	      	! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW)
	      OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM',
     &		   STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST')S
	      WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT' 
	      WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV'E
	      WRITE(11,'(A)')
     &	       '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)//I
     &	       '''F$GETJPI("","USERNAME")'''
	      WRITE(11,'(A)') '$ MAIL' 
	      WRITE(11,'(A)') 'SELECT MAIL'
	      WRITE(11,'(A)') 'READ'F
	      WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'
	      WRITE(11,'(A)') 'DELETE/ALL'.
	      WRITE(11,'(A)') 'READ/NEW'0
	      WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'
	      WRITE(11,'(A)') 'DELETE/ALL'R
	      WRITE(11,'(A)') 'SELECT/NEW'(
	      CLOSE(UNIT=11)B
	      CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection 
	      IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B) 
     &		   //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)
	      CALL SYS$SETAST(%VAL(1))I
	      IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))	
	      CALL SYS$SETAST(%VAL(0)))
	   END IF
	ELSEI
	   CONTEXT = 0_
	   IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARDL
     &	      (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT)
	   IF (IER) THEN
	      IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//G
     &		  FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:',
     &		  'NL:',1,,,STATUS,SPAWN_EF)
	      CALL SYS$SETAST(%VAL(1))
	      IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))D
	      CALL SYS$SETAST(%VAL(0))W
	   END IF
	   IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR.
     &	    ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN
	      IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// 
     &		'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)
	      CALL SYS$SETAST(%VAL(1))
	      IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))D
	      CALL SYS$SETAST(%VAL(0))R
	   END IF
	END IFF

	CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)B

	NBULL = F_NBULL

	CALL SETACC(ACCOUNT_SAVE)		! Reset to original accountL
	CALL SETUSER(USERNAME_SAVE)		! Reset to original username
	CALL SETUIC(GROUP_SAVE,USER_SAVE)	! Reset to original uic

	OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD:
     &	   (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100)
	READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line
	CALL SYS$SETAST(%VAL(1))'

5	CALL SYS$SETAST(%VAL(0))

	CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)R

	DO WHILE (LEN_INPUT.GT.0)
	   IF (INPUT(:5).EQ.'From:') THEN
	      INFROM = INPUT(7:)		! Store usernameP
	   ELSE IF (INPUT(:5).EQ.'Subj:') THENE
	      INDESCRIP = INPUT(7:)		! Store subjectt
	   ELSE IF (INPUT(:3).EQ.'To:') THENE
	      INTO = INPUT(5:)			! Store addressr
	   END IF
	   READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail
	END DOe

	INTO = INTO(:TRIM(INTO))r
	CALL STR$TRIM(INTO,INTO)s
	CALL STR$UPCASE(INTO,INTO)s
	FLEN = TRIM(FOLDER_BBOARD)h
	HEADER_Q = 0 
	NHEAD = 0
	IF (.NOT.DETECT_BBOARD(INTO,FOLDER_BBOARD(:FLEN))) THEN
	   HEADER_Q = HEADER_Q1
	   IER = 0H
	   CALL STRIP_HEADER(' ',0,STRIP)
	   STRIP = .TRUE.
	   DO WHILE (IER.EQ.0.AND.STRIP)m
	      READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTL
	      IF (IER.EQ.0) THENL
		 CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)M
		 CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
		 NHEAD = NHEAD + 1
	      END IFT
	   END DO

	   FOUND = .FALSE.
	   J = 0B
	   DO WHILE (J.LT.2.AND..NOT.FOUND)
	      J = J + 1
	      POINT_FOLDER1 = 0
	      FOLDER_Q2 = FOLDER_Q1
	      FOUND = .FALSE.
	      DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS) 
		 CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)b
		 POINT_FOLDER1 = POINT_FOLDER1 + 1
		 IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND.
     &		     FOLDER1_BBOARD(:2).NE.'::'.AND.
     &		     FOLDER1_BBOARD(:4).NE.'NONE') THEN.
		    IF (J.EQ.1) THEN
		       F_BBOARD = FOLDER1_BBOARD
		    ELSE
		       F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP)n
		    END IF
		    IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN
		       FLEN = TRIM(F_BBOARD)
		       FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN))
		       IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN
			  HEADER_Q = HEADER_Q1 
			  I = 1
			  DO WHILE (I.LT.NHEAD.AND..NOT.FOUND)L
			     CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
			     FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN))
			     I = I + 1 
			  END DOe
		       END IFm
		    END IF
		 END IFF
	      END DO.
	   END DO
	   IF (FOUND) FOLDER_COM = FOLDER1_COMi
	END IFa

	IF (NHEAD.EQ.0) THENL
	   READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT	! Read first line
	ELSE2
	   HEADER_Q = HEADER_Q1
	   CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
	   LEN_INPUT = TRIM(INPUT) 
	   NHEAD = NHEAD - 1_
	END IF

	DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)D
	   READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
	   IF (INPUT(:5).EQ.'From:') GO TO 5N
	END DO		! If line is just form feed, the message is empty
	IF (IER.NE.0) GO TO 100				! If end of file, exit

	EFROM = 2
	I = TRIM(INFROM)F
	DO WHILE (EFROM.GT.0.AND.I.GT.0)		! Strip off the dateT
	   IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1	! From the "From:" lineN
	   I = I - 1T
	END DOR
	IF (I.GT.0) INFROM = INFROM(:I)

	CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)*

	ISTART = 0F
	NBLANK = 0O
	IER = 0
	DO WHILE (IER.EQ.0)		! Move text to bulletin file
	   IF (LEN_INPUT.EQ.0) THEN
	      IF (ISTART.EQ.1) THEN
		 NBLANK = NBLANK + 1
	      END IFi
	   ELSE
	      ISTART = 1L
	      DO I=1,NBLANK
		 CALL WRITE_MESSAGE_LINE(' ')E
	      END DO)
	      NBLANK = 0D
	      CALL WRITE_MESSAGE_LINE(INPUT)	
	   END IF
	   IF (NHEAD.EQ.0) THEN
	      READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTn
	   ELSE
	      CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)H
	      LEN_INPUT = TRIM(INPUT)
	      NHEAD = NHEAD - 1
	   END IF
	   IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN
	      DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)C
     &			.AND.IER.EQ.0)
		 READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTO
	      END DOL
	      IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN
		 IER = 1
	      ELSE4
		 NBLANK = NBLANK + 1
	      END IFe
	   END IF
	END DO

	FOLDER_NAME = FOLDER			! For broadcasts

	CALL FINISH_MESSAGE_ADD			! Totally finished with add

	CALL SYS$SETAST(%VAL(1))C

	GO TO 5					! See if there is more mail

100	CLOSE (UNIT=14,STATUS='DELETE')		! Close the input fileO
	CALL SYS$SETAST(%VAL(1)))
	GO TO 1

900	CALL SYS$SETAST(%VAL(0))

	FOLDER_NUMBER = 0
	CALL OPEN_BULLFOLDER_SHARED
	CALL READ_FOLDER_FILE_KEYNUM(0,IER)
	CALL CLOSE_BULLFOLDER
	CALL ENABLE_CTRLo
	FOLDER_SET = .FALSE.r

	IF (NBBOARD_FOLDERS.EQ.0) THENn
	   CALL OPEN_BULLUSER
	   CALL READ_USER_FILE_HEADER(IER)e
	   CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)a
	   REWRITE (4) USER_HEADER		! Rewrite headerc
	   CALL CLOSE_BULLUSERP
	END IFR
	CALL SYS$SETAST(%VAL(1))

	CALL SYS$SETAST(%VAL(0)))
	IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.
     &	    .NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL
	CALL SYS$SETAST(%VAL(1))e

	RETURNe

910	WRITE (6,1010)
	GO TO 100

930	CLOSE (UNIT=14)W
	CALL CLOSE_BULLFILL
	CALL CLOSE_BULLDIRE
	WRITE (6,1030)B
	GO TO 100

1010	FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')_
1030	FORMAT(' ERROR:Alert system programmer. Data file problems.')

	END




	LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) 

	IMPLICIT INTEGER (A-Z)U

	CHARACTER*(*) INPUT,BBOARD 

	DETECT_BBOARD = .TRUE.B

	LEN_BBOARD = LEN(BBOARD) - 1$

	DO I=1,TRIM(INPUT)-LEN_BBOARD
	   IF (.NOT.STREQ(INPUT(:4),'Subj').AND.A
     &		STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND.
     &		(I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.S
     &		(I.EQ.LEN(INPUT)-LEN_BBOARD.OR.F
     &		INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0))
     &		RETURN
	END DO 

	DETECT_BBOARD = .FALSE.

	RETURN,
	END



	LOGICAL FUNCTION ALPHA(IN)t

	CHARACTER*1 INR

	ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z'))
     &	    .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z'))

	RETURNS
	END



	CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP),

	CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP1

	BBOARD_NAME = FOLDER_BBOARD

	I = INDEX(FOLDER_DESCRIP,'<')
	IF (I.EQ.0) RETURN 

	BBOARD_NAME = FOLDER_DESCRIP(I+1:)

	I = INDEX(BBOARD_NAME,'%"')
	IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:)

	I = INDEX(BBOARD_NAME,'!') 
	DO WHILE (I.GT.0)
	   BBOARD_NAME = BBOARD_NAME(I+1:) 
	   I = INDEX(BBOARD_NAME,'!')
	END DOW

	I = INDEX(BBOARD_NAME,'>') 
	IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1)
	I = INDEX(BBOARD_NAME,'@'))
	IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1)
	I = INDEX(BBOARD_NAME,'%')B
	IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1)

	RETURNt
	END




	SUBROUTINE CREATE_PROCESS(COMMAND)I

	IMPLICIT INTEGER (A-Z) 

	INCLUDE '($PRCDEF)'

	INCLUDE 'BULLFILES.INC'

	COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)

	STRUCTURE /QUOTA_ITMLST/N
	   BYTE ITEMC
	   INTEGER VALUE(
	END STRUCTURE

	RECORD /QUOTA_ITMLST/ QUOTA(5) 

	CHARACTER*132 IMAGENAME

	CHARACTER*(*) COMMAND

	CALL GETIMAGE(IMAGENAME,ILEN)

	LEN_B = TRIM(BBOARD_DIRECTORY)F

	OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM',
     &		STATUS='OLD',IOSTAT=IER)
	IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE'),

	CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)%
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW)
	OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM',
     &		STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')A
	IF (IER.NE.0) RETURN_
	WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN)
	WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT' 
	WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT'
	WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT' 
	WRITE(11,'(A)') '$B/'//'''F$PROCESS()''')
	WRITE(11,'(A)') '$EXIT:'%
	WRITE(11,'(A)') '$LOGOUT'
	CLOSE(UNIT=11)Q
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionU

	DEL = .FALSE.
	IER = .FALSE.

	CALL GETQUOTA(QUOTA,0)L

	DO WHILE (.NOT.IER)
	   IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',
     &	    BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,=
     &	    PROCPRIV,QUOTA,COMMAND(:TRIM(COMMAND)) 
     &	    ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))=
	   IF (.NOT.IER.AND..NOT.DEL) THENI
	      CALL DELPRC('BULLCP NEWS',DEL)$
	      IER = .NOT.DELA
	   ELSE
	      IER = .TRUE. 
	   END IF
	END DOR

	RETURNU
	END




	SUBROUTINE GETQUOTA(QUOTA,CLI)
C 
C  SUBROUTINE GETQUOTA
CH
	IMPLICIT INTEGER (A-Z)(

	INCLUDE '($PQLDEF)'

	INCLUDE '($JPIDEF)'
                              
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	STRUCTURE /QUOTA_ITMLST/	
	   BYTE ITEMr
	   INTEGER VALUEE
	END STRUCTURE

	RECORD /QUOTA_ITMLST/ QUOTA(5) 

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to listT
	CALL ADD_2_ITMLST(4,JPI$_DFWSCNT,%LOC(WSDEFAULT))
	CALL ADD_2_ITMLST(4,JPI$_WSEXTENT,%LOC(WSEXTENT))
	CALL ADD_2_ITMLST(4,JPI$_WSQUOTA,%LOC(WSQUOTA))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlistA

	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)	! Get Info command.

	I = 1
	IF (CLI.AND.CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)) THEN T
	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) PGFLQUOTAL
	   QUOTA(I).ITEM = PQL$_PGFLQUOTA
	   QUOTA(I).VALUE = PGFLQUOTA
	   I = I + 1
	END IFO
	IF (CLI.AND.CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)) THEN.
	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) WSEXTENT
	END IF_
 	QUOTA(I).ITEM = PQL$_WSEXTENTA
	QUOTA(I).VALUE = WSEXTENT
	I = I + 1
	QUOTA(I).ITEM = PQL$_WSQUOTA	
	QUOTA(I).VALUE = WSQUOTAR
	I = I + 1
	QUOTA(I).ITEM = PQL$_WSDEFAULT1
	QUOTA(I).VALUE = WSDEFAULTP
	I = I + 1
	QUOTA(I).ITEM = PQL$_LISTEND 
	QUOTA(I).VALUE = 0.

        RETURN
	END
	F



	SUBROUTINE GETUIC(GRP,MEM)
C 
C  SUBROUTINE GETUIC(UIC) 
CB
C  FUNCTION:
C	To get UIC of process submitting the job.A
C  OUTPUT:
C	GRP   -    Group number of UIC
C	MEM   -	   Member number of UICA
CN

	IMPLICIT INTEGER (A-Z) 

	INCLUDE '($JPIDEF)'

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to listO
	CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP))
	CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlistH

	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)	! Get Info command.

	RETURN	
	END



	SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)F
C	
C  SUBROUTINE GET_UPTIME
C 
C  FUNCTION: Gets time of last reboot.
C_

	IMPLICIT INTEGER (A-Z)D

	INCLUDE '($SYIDEF)'

	INTEGER 	UPTIME(2)L
	CHARACTER*(*)	UPTIME_TIME,UPTIME_DATE
	CHARACTER	ASCSINCE*24

	CALL INIT_ITMLSTU
	CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME))
	CALL END_ITMLST(GETSYI_ITMLST) 

	IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,)

	CALL SYS$ASCTIM(,ASCSINCE,UPTIME,) 

	UPTIME_DATE = ASCSINCE(:11)
	UPTIME_TIME = ASCSINCE(13:23)

	RETURN	
	END



	INTEGER FUNCTION GET_L_VAL(I)
	INTEGER I
	GET_L_VAL = I
	RETURN.
	END



	SUBROUTINE CHECK_MAIL(NEW_MAIL)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'T

	COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSQ
	DATA FOLDER_Q1/0/

	DIMENSION NEW_MAIL(1)

	CHARACTER INPUT*132

	INTEGER*2 COUNT

	FOLDER_Q = FOLDER_Q1			! so reinit queue pointerN

	OPEN (UNIT=10,FILE='VMSMAIL_PROFILE',
     &	     DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA',
     &       ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,SHARED,IOSTAT=IER) 

	DO I=1,NUM_FOLDERSD
	   CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)D

	   IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.N
     &		 BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND.I
     &		 FOLDER_BBOARD(:4).NE.'NONE') THEN
						! If normal BBOARD or /VMSMAIL
	      DO WHILE (REC_LOCK(IER1))
	         READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT
	      END DO)
	      COUNT = 0
	      IF (IER1.EQ.0) THEN
		 INPUT = INPUT(32:)C
		 DO WHILE (TRIM(INPUT).GT.0)
		    IF (ICHAR(INPUT(1:1)).EQ.1) THEN
		       CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT)
		       INPUT = ' '
		    ELSE
		       INPUT = INPUT(ICHAR(INPUT(3:3))+5:)
	            END IF 
	         END DO
	      END IF=
	      IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN!
		 NEW_MAIL(I) = .TRUE.d
	      ELSE$
		 NEW_MAIL(I) = .FALSE.
	      END IF 
	   ELSE
	      NEW_MAIL(I) = .TRUE.4
	   END IF
	END DOC

	CLOSE (10)f

	RETURN 
	END



	SUBROUTINE GETIMAGE(IMAGNAME,ILEN)T
C(
C  SUBROUTINE GETIMAGE(IMAGNAME,ILEN)P
CB
C  FUNCTION:
C	To get image name of process.(
C  OUTPUT:
C	IMAGNAME   -    Image name of processF
C	ILEN	   -	Length of imagenameA
CF

	IMPLICIT INTEGER (A-Z)L

	INCLUDE '($JPIDEF)'

	CHARACTER*(*) IMAGNAMEe

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list 
	CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME,
     &					%LOC(IMAGNAME),%LOC(ILEN))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlistS

	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)	! Get Info command.

	RETURNL
	END




	SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)	

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	DIMENSION IN_BTIM(2)0

	IF (REMOTE_SET) THEN 
	   CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)0
	ELSEA
	   CALL GET_MSGKEY(IN_BTIM,MSG_KEY)
	   CALL READDIR_KEYGE(START)
	   IF (START.EQ.0) THEN
	      START = -1A
	   END IF
	END IFE

	RETURN
	END



	SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM)

	IMPLICIT INTEGER (A-Z)B

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	DIMENSION IN_BTIM(2)E

	CALL GET_MSGKEY(IN_BTIM,MSG_KEY)
	CALL READDIR_KEYGE(START)

	IF (START.EQ.0) RETURN 

	CALL OPEN_BULLUSER_SHARED

	IER = START + 1
	DO WHILE (START+1.EQ.IER)
	   IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0)
	   START = START + 1.
	   CALL READDIR(START,IER)
	END DOL

	CALL CLOSE_BULLDIR

	RETURN1
	END





	SUBROUTINE READ_NOTIFY.

	IMPLICIT INTEGER (A-Z))

	INCLUDE 'BULLFOLDER.INC'E

	INCLUDE 'BULLUSER.INC'E

	COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG)

	CALL OPEN_BULLUSER_SHARED

	DO WHILE (REC_LOCK(IER))
	   READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE=
	END DOB

	IF (IER.NE.0) THENE
	   DO I=1,FLONG
	      NOTIFY_REMOTE(I) = 0_
	   END DO
	   WRITE (4,IOSTAT=IER) '*NOTIFY     ',NOTIFY_REMOTEI
	END IFO

	CALL CLOSE_BULLDIRI

	RETURN=
	END



	SUBROUTINE DELPRC(DELNAM,IER)

	IMPLICIT INTEGER (A-Z)N

	INCLUDE '($JPIDEF)'

	CHARACTER*(*) DELNAMD

	DATA OBIO/0/,OCPU/0/,ODIO/0/ 

	CHARACTER PRCNAM*15

	TEST = 'BULLCP NEWS'.EQ.DELNAMB

	WILDCARD = -1

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to listB
	I
	CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM))
	CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))
	IF (TEST) THEN 
           CALL ADD_2_ITMLST(4,JPI$_BUFIO,%LOC(BIO))
           CALL ADD_2_ITMLST(4,JPI$_CPUTIM,%LOC(CPU))P
           CALL ADD_2_ITMLST(4,JPI$_DIRIO,%LOC(DIO))
	END IFE
 	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlist
	IER = SYS$GETJPIW(,,DELNAM(:LEN(DELNAM)),%VAL(GETJPI_ITMLST),,,,)
	IF (.NOT.IER) THEN 
	   IER = 1I
	   DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)T
						! Get next interactive process
	      IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,)
						! Get next process.$
	   END DO
	END IF_
	IF (IER.AND.PID.NE.0) THEN 
	   IF (TEST.AND.N
     &		(BIO.GT.OBIO.OR.DIO.GT.ODIO.OR.CPU.GT.OCPU+10)) THEN
	      OBIO = BIOM
	      ODIO = DIO	
	      OCPU = CPU=
	      IER = 0
	      RETURNI
	   END IF
	   IER = SYS$DELPRC(PID,)
	   IF (IER.AND.TEST) THEN
              OBIO = 0
              ODIO = 0
              OCPU = 0  
	   END IF
	END IFE
	RETURN)
	END
