C
C  BULLETIN3.FOR, Version 4/27/91
C  Purpose: Contains subroutines for the bulletin board utility program.
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
	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*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE
	CHARACTER*11 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
		  EXTIME(3:4) = EXTIME(4:5)
	          READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG
		  EXTIME(9:10) = EXTIME(10:11)
	          READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG
	          IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND.
     &		      NODE_AREA_MSG.EQ.NODE_AREA) THEN
		     DIFF = 0
		  ELSE
		     DIFF = 1
		  END IF
	       ELSE
	          DIFF = COMPARE_DATE(EXDATE,' ')
	          IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ')
	       END IF
	       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*23
 
	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.E
C 
	BULL_POINT = -1				! Init bulletin pointer
 C
	CALL OPEN_BULLDIR_SHARED		! Yep, so get directory filee
	CALL READDIR(0,IER)			! Get # bulletins from header
	IF (IER.EQ.1) THENi
	   CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START)
	   IF (START.LE.0) THEN
	      BULL_POINT = START.
	      CALL CLOSE_BULLDIR
	      RETURN 
	   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) THENS
		       START = START + 1
	               CALL READDIR(START,IER)G
		    ELSE			! SYSTEM bulletin was not seenR
		       SYSTEM = 0		! so force exit to read it.
		    END IF
	         END IF
	      ELSE
		 START = START + 1
		 CALL READDIR(START,IER)
		 IF (IER.NE.START+1) START = NBULL + 1
	      END IFL
	   END DO
	   IF (START.LE.NBULL) BULL_POINT = START - 1
	END IF
 	
	CALL CLOSE_BULLDIRx
 e
	RETURNn
	END
 E
 Y
 D
	SUBROUTINE GET_EXPIRED(EXPDAT,IER)s
 
	IMPLICIT INTEGER (A-Z)-
 0
	INCLUDE 'BULLUSER.INC'e
 e
	INCLUDE 'BULLFOLDER.INC'I
 =
	INCLUDE 'BULLDIR.INC'
 e
	CHARACTER*23 EXPDAT
	CHARACTER*23 TODAYs
 n
	DIMENSION EXTIME(2),NOW(2)a
 
	EXTERNAL CLI$_ABSENT-
 6
	IER = SYS$ASCTIM(,TODAY,,)		! Get today's date'
 0
	IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN)
 M
	PROMPT = .TRUE.
 1
5	IF (PROMPT) THEN
	   IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN	! Was value specified?
	      PROMPT = .FALSE.N
	   ELSE
	      DEFAULT_EXPIRE = FOLDER_BBEXPIRE0
	      IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE
     &		  .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND..NOT.
     &	          FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THENB
		 DEFAULT_EXPIRE = F_EXPIRE_LIMIT
	      END IFS
	      IF (BTEST(FOLDER_FLAG,3)) THEN		! NOPROMPT was setu
		 IF (DEFAULT_EXPIRE.LE.0) THEN		! If no expiration date	
	            SYSTEM = SYSTEM.OR.2		! make permanent 
	            EXPDAT = '5-NOV-2000 00:00:00.00'
		 ELSE					! Else set expirationI
		    CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)
		    EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'
		 END IFA
		 ILEN = TRIM(EXPDAT)
	      ELSE
		 IF (DEFAULT_EXPIRE.EQ.0) THEN	! Get expiration date
	            WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4)F
		 ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN
	            WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4)D
		 ELSE
	            WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4),
     &					DEFAULT_EXPIRE 
		 END IF.
		 WRITE (6,1035)E
	         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)E
		       EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'P
		    END IF
		    ILEN = TRIM(EXPDAT)f
		 END IFn
	      END IFI
	   END IF
	ELSEl
	   RETURN
	END IFS
 .
	IF (ILEN.LE.0) THEN
	   IER = 0 
	   RETURN
	END IFf
 b
	EXPDAT = EXPDAT(:ILEN)			! Change trailing zeros 2 spaces
 a
	IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND.A
     &		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 specifiedE
     &			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:),'-') 
	   EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:)M
	END IFM
  
	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 valueT
	   GO TO 5				! Re-request date (if prompting)E
	END IF0
	IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)
	IF (TIMLEN.EQ.16) THENO
	   CALL SYS$GETTIM(NOW)
	   CALL LIB$SUBX(NOW,EXTIME,EXTIME)
	   IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)
	END IF 
 E
	IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT 
	IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's'
	IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND.=
     &	    .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
	   WRITE(6,1050) F_EXPIRE_LIMIT		! Expiration date > limit_
	   IER = 0				! Set error for return valueC
	   GO TO 5				! Re-request date (if prompting)t
	END IFt
	IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:))C
	IF (IER.LE.0) THEN			! If expiration date not futureO
	   WRITE(6,1045)			! tell userl
	   IER = 0				! Set error for return valueR
	   GO TO 5				! Re-request date (if prompting)e
	END IFa
 d
	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))R
	   END IF
	END IF
 
	IER = 1
 N
	RETURNR
 (
1030	FORMAT(' It is ',A,'. Specify when message expires.')
1031	FORMAT(' It is ',A,'. Specify when message expires.',
     &		' Default is permanent.')v
1032	FORMAT(' It is ',A,'. Specify when message expires.',
     &		' Default is ',I3,' days.')R
1035    Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',
     &		'or delta time: dddd hh:mm:ss')Y
1040	FORMAT(' ERROR: Invalid date format specified.')/
1045	FORMAT(' ERROR: Specified time has already passed.')e
1050	FORMAT(' ERROR: Specified expiration period too large.'
     &		' Limit is ',I3,' days.')B
 U
	END
 i
 
	SUBROUTINE MAILEDIT(INFILE,OUTFILE)
 (
	IMPLICIT INTEGER (A-Z)T
 	
	INCLUDE '($SSDEF)'s
 ,
	INCLUDE 'BULLUSER.INC'F
 _
	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD
 R
	EXTERNAL BULLETIN_SUBCOMMANDS
 T
	CHARACTER*(*) INFILE,OUTFILE,
 t
	CHARACTER*80 MAIL_EDIT,OUTE
	DATA MAIL_EDIT /' '/
  
	CHARACTER*132 INPUT
  
	CHARACTER*255 SPAWN_COMMAND
  
	IF (MAIL_EDIT.EQ.' ') THENa
	  IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THENE
	    OPEN (UNIT=10,FILE='VMSMAIL_PROFILE',
     &	     DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA',
     &       ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,SHARED,IOSTAT=IER))
	    IF (IER.EQ.0) THENL
	      DO WHILE (REC_LOCK(IER)),
	         READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT
	      END DOD
	      CLOSE (UNIT=10)
	      IF (IER.EQ.0) THEN 
		 INPUT = INPUT(32:)D
		 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 IF 
	    END IF1
	  END IFI
	  CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT)(
	END IFY
 I
	OUT = OUTFILE
	IF (TRIM(OUT).EQ.0) THEN 
	   OUT = INFILE
	END IFR
 
	CALL DISABLE_PRIVSD
	CALL DECLARE_CTRLC_ASTL
	IF (TRIM(MAIL_EDIT).GT.0 
     &		.AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN
	   IF (OUT.EQ.INFILE) THENO
	      SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))
     &		//' "" '//OUT(:TRIM(OUT))E
	   ELSE
	      SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))
     &		//' '//INFILE//' '//OUT(:TRIM(OUT)) 
	   END IF
	   CALL LIB$SPAWN(SPAWN_COMMAND)h
	ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THENu
	   CONTEXT = 0O
	   IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT)
	   IF (.NOT.IER1) THENe
	      CALL TPU$EDIT(' ',OUT)A
	   ELSE
	      CALL TPU$EDIT(INFILE,OUT)
	   END IF
	   IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
		! TPU does CLI$ stuff which wipes our parsed command lines
	ELSEu
	   CALL EDT$EDIT(INFILE,OUT)h
	END IFp
	CALL CANCEL_CTRLC_AST
	CALL ENABLE_PRIVS
 r
	RETURNe
	END
 w
 l
 i
 
 I
	SUBROUTINE CREATE_BULLCPe
 n
	IMPLICIT INTEGER (A-Z)n
 c
	INCLUDE '($PRCDEF)'
  
	INCLUDE '($JPIDEF)'
 l
	INCLUDE '($SSDEF)'_
 N
	INCLUDE '($PQLDEF)'
  
	INCLUDE '($PRVDEF)'
 B
	INCLUDE 'BULLFILES.INC'
 d
	COMMON /REALPROC/ REALPROCPRIV(2)
 !
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 S
	EXTERNAL CLI$_ABSENTE
 U
	DIMENSION IMAGEPRIV(2)T
 .
	CHARACTER IMAGENAME*132,ANSWER*1,PRCNAM*15 
 L
	STRUCTURE /QUOTA_ITMLST/T
	   BYTE ITEMF
	   INTEGER VALUER
	END STRUCTURE
 M
	RECORD /QUOTA_ITMLST/ QUOTA(3)I
 F
	IF (.NOT.SETPRV_PRIV()) THENb
	   WRITE (6,'('' ERROR: You do not have the privileges '', 
     &			''to execute the command.'')')T
	   CALL EXITR
	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.'')')u
	   CALL EXITs
	ELSE IF (.NOT.JUST_STOP.AND. 
     &			.NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN 
	   CALL SYS$SETPRV(,,,IMAGEPRIV)	
	   IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THENT
	      WRITE (6,'('' ERROR: This new version of BULLETIN'',U
     &			'' needs to be installed with SYSNAM.'')')_
	      CALL EXIT
	   END IF
	END IFD
 S
	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
	      IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXITA
	   END IF
 
	   WILDCARD = -1I
 T
	   CALL INIT_ITMLST	! Initialize item list$
				! Now add items to list,
	   CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM))(
	   CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))p
	   CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlist
	   IER = 1R
	   DO WHILE (IER.AND.PRCNAM(:6).NE.'BULLCP')I
						! Get next interactive process
	      IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,)
						! Get next process.F
	   END DO
	   IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,)
	   IF (.NOT.IER) THEN
	      CALL SYS_GETMSG(IER)	
	      CALL EXIT
	   ELSE IF (JUST_STOP) THEN
	      WRITE (6,'('' BULLCP process has been terminated.'')')O
	      CALL EXIT
	   END IF
	ELSE IF (JUST_STOP) THEN 
	   WRITE (6,'('' BULLCP is not presently running.'')')A
	   CALL EXITX
	END IFU
 E
	CALL GETIMAGE(IMAGENAME,ILEN)
 (
	LEN_B = TRIM(FOLDER_DIRECTORY)I
 
	CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT) 
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW)
C6
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 thatW
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 andi
C  replace BULLCP.COM, and the command procedure is executed under the
C  SYSTEM account, so it has all privileges.) 
C0
	OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM',
     &		STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST'),
	IF (IER.NE.0) RETURN 
	WRITE(11,'(A)') '$SET NOON'
	WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN)
	WRITE(11,'(A)') '$LOOP:'I
	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 'E
     &				//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)F
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionI
 X
	I = 1
	IER = CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)
	IF (IER.NE.%LOC(CLI$_ABSENT)) THEN.
	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) PGFLQUOTA'
	   QUOTA(I).ITEM = PQL$_PGFLQUOTA
	   QUOTA(I).VALUE = PGFLQUOTA
	   I = I + 1M
	END IFL
	IER = CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)I
	IF (IER.NE.%LOC(CLI$_ABSENT)) THENI
	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) WSEXTENT
	   QUOTA(I).ITEM = PQL$_WSEXTENTE
	   QUOTA(I).VALUE = WSEXTENT 
	   I = I + 1T
	END IFR
	QUOTA(I).ITEM = PQL$_LISTEND
	QUOTA(I).VALUE = 0A
 I
	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))D
	END DOT
 1
	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)T
	END IF 
 X
	IF (.NOT.IER) THENi
	   CALL SYS_GETMSG(IER)
	ELSE!
	   IF (CONFIRM_USER('DECNET').NE.0) THEN	
	      WRITE (6,'('' WARNING: Account with username DECNET'',R
     &				'' does not exist.'')')3
	      WRITE (6,'('' BULLCP will be owned by present account.'')')
	   END IF
	   WRITE (6,'('' Successfully created BULLCP detached process.'')')
	END IFR
	CALL EXIT
 (
	END
 i
 e
 E
 I
 
 
	SUBROUTINE FIND_BULLCPF
 T
	IMPLICIT INTEGER (A-Z)r
 e
	COMMON /BCP/ BULLCP
	DATA BULLCP /0/
 l
	IER = SYS_TRNLNM('BULL_BULLCP','DEFINED')
	IF (IER) BULLCP = 1
 w
	RETURN,
	END
 )
  
 &
 X
	LOGICAL FUNCTION TEST_BULLCPF
 E
	IMPLICIT INTEGER (A-Z)
 T
	COMMON /BCP/ BULLCP
	LOGICAL BULLCPe
 y
	TEST_BULLCP = BULLCP)
 0
	RETURN(
	END
 ,
 .
 e
 y
	SUBROUTINE RUN_BULLCP
  
	IMPLICIT INTEGER (A-Z)e
 '
	INCLUDE 'BULLFOLDER.INC',
 S
	INCLUDE 'BULLDIR.INC'
 .
	INCLUDE 'BULLUSER.INC''
 ,
	COMMON /BCP/ BULLCP
	LOGICAL BULLCPl
  
	COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERSe
  
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 d
	CHARACTER*23 OLD_TIME,NEW_TIMEi
 t
	IF (TEST_BULLCP()) CALL EXIT	! BULLCP already running, so exit.
  
	CALL LIB$DATE_TIME(OLD_TIME)i
  
	BULLCP = 2			! Enable process to do BULLCP functionsD
 I
	IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')I
	IF (.NOT.IER) THEN		! Can't create mailbox, so exit.C
	   CALL SYS_GETMSG(IER)
	   CALL EXIT2
	END IFR
 E
	IER = SYS$DELMBX(%VAL(CHAN))	! If process dies, mailbox is deleted.
 A
	CALL REGISTER_BULLCPE
 D
	CALL SET_REMOTE_SYSTEM
 A
	CALL START_DECNET
 C
	UPDATEBBOARD = 1C
	IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN
	   LEN_P = TRIM(BULL_PARAMETER)
	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER,IOSTAT=IER)
     &		  UPDATEBBOARD
	   IF (IER.EQ.0) UPDATEBBOARD = UPDATEBBOARD / 15
	END IFM
 E
	UPDATENEWS = 4I
	IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN
	   LEN_P = TRIM(BULL_PARAMETER)
	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER,IOSTAT=IER)
     &		  UPDATENEWS
	   IF (IER.EQ.0) UPDATENEWS = UPDATENEWS / 15
	END IFI
 I
	BBOARD_LOOP = 0
	NEWS_LOOP = 0
 D
	DO WHILE (1)			! Loop once every 15 minutes
	   CALL SYS$SETAST(%VAL(0))
	   CALL LIB$DATE_TIME(NEW_TIME)
	   CALL GET_PROXY_ACCOUNTS	! Proxy info for incoming connections 
	   CALL SYS$SETAST(%VAL(1))
 )
	   IF (BBOARD_LOOP.EQ.0) CALL BBOARD	! Look for BBOARD messages.E
 I
	   BBOARD_LOOP = BBOARD_LOOP + 1M
	   IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0
 T
	   FOLDER_Q = FOLDER_Q1		! Init queue pointer to header
	   POINT_FOLDER = 0
	   DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)
	      POINT_FOLDER = POINT_FOLDER + 1
	      CALL SYS$SETAST(%VAL(0))Q
	      CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
	      IF (FOLDER_BBOARD(:2).NE.'::') THEN
	         CALL SELECT_FOLDER(.FALSE.,IER)	! Select folderM
	         IF (IER) THEN 
	            CALL DELETE_EXPIRED		! Delete expired messagesA
		    IF (INDEX(NEW_TIME,' 03:').NE.0.AND.   ! Do empty blocku
     &			INDEX(OLD_TIME,' 03:').EQ.0) THEN  ! cleanup at 3 a.m.)
	               IF (NEMPTY.GT.200) THENP
	                  CALL CLEANUP_BULLFILE	! Cleanup empty blocks 
	               END IF
		    END IF
	         END IF
	      END IFo
	      CALL SYS$SETAST(%VAL(1))s
	   END DO
 s
	   CALL SYS$SETAST(%VAL(0))
	   IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.B
     &	      NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')A
	   CALL SYS$SETAST(%VAL(1))
  
	   NEWS_LOOP = NEWS_LOOP + 1'
	   IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0
 _
	   IF (INDEX(NEW_TIME,' 03:').NE.0.AND.   ! Cleanup deleted users fromI
     &	       INDEX(OLD_TIME,' 03:').EQ.0) THEN  ! data files at 3 a.m.U
	      CALL SYS$SETAST(%VAL(0)) 
	      CALL TOTAL_CLEANUP_LOGIN$
	      CALL SYS$SETAST(%VAL(1))V
	   END IF
 A
	   OLD_TIME = NEW_TIME*
	   CALL HIBER('15')		! Wait for 15 minutes
C 
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 folderu
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))
	      CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
	      IF (FOLDER_BBOARD(:2).EQ.'::') THEN
	         CALL SELECT_FOLDER(.FALSE.,IER)V
	      END IFM
	      CALL SYS$SETAST(%VAL(1))I
	   END DO
	   CALL SYS$SETAST(%VAL(0))
	   FOLDER_NUMBER = 0			! Reset to GENERAL folder 
	   CALL SELECT_FOLDER(.FALSE.,IER) 
	   CALL REGISTER_BULLCP
	   CALL SYS$SETAST(%VAL(1))
	END DOT
  
	RETURN
	END
 
 
  
 S
 U
	SUBROUTINE SET_REMOTE_SYSTEM_
 P
	IMPLICIT INTEGER (A-Z)(
 B
	INCLUDE 'BULLFOLDER.INC' 
 D
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 )
	CHARACTER NODENAME*8 
 W
	CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
	NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)-
 
	CALL OPEN_BULLFOLDER_SHARED
 l
	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) THEN
	      CALL SELECT_FOLDER(.FALSE.,IER1)a
	      IF (IER1) THEN 
	         WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,'
     &			BTEST(FOLDER_FLAG,2),NODENAME
	      END IFS
	   END IF
	END DO,
 L
	CALL CLOSE_BULLFOLDER
 	
	FOLDER_NUMBER = 0			! Reset to GENERAL folder
	CALL SELECT_FOLDER(.FALSE.,IER)
  
	RETURNT
	END
 N
  
  
 L
	SUBROUTINE REGISTER_BULLCPL
 X
	IMPLICIT INTEGER (A-Z)P
 H
	INCLUDE 'BULLUSER.INC'B
 C
	INTEGER SHUTDOWN_BTIM(FLONG)'
 O
	EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)(
 T
	COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
	CHARACTER NODENAME*8A
 E
	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)O
 I
	CALL OPEN_BULLUSERP
 (
	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_FLAGu
	END DO 
 e
	IF (IER.NE.0) THENf
	   DO I=1,FLONG
	      SYSTEM_FLAG(I) = 0a
	      SHUTDOWN_FLAG(I) = 0s
	   END DO
	   CALL SET2(SYSTEM_FLAG,0)
	   NODE_AREA = 0h
	END IFe
 b
	CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
	NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)x
 t
	DO I=1,FLONG 
	   SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)e
	END DO
 E
	IF (IER.NE.0) THEN_
	   WRITE (4,IOSTAT=IER)
     &		'*SYSTEM     ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGO
	ELSEI
	   REWRITE (4,IOSTAT=IER)
     &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGW
	END IF(
 )
	CALL CLOSE_BULLUSER
 
	RETURN	
	END
 D
 C
 Y
 E
 )
	SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER)
 $
	IMPLICIT INTEGER (A-Z)D
 D
	INCLUDE 'BULLUSER.INC'.
 '
	INTEGER SHUTDOWN_BTIM(FLONG)
 I
	EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG),
 )
	COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
	CHARACTER NODENAME*8(
 _
	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)'
 L
	CALL OPEN_BULLUSERI
 I
	DO WHILE (REC_LOCK(IER))E
	   READ (4,KEY='*SYSTEM',IOSTAT=IER) 
     &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGD
	END DOR
 C
	CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)N
 I
	SEEN_FLAG = 0
	DO I=1,FLONG)
	   IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1
	END DOS
	IF (SEEN_FLAG.EQ.0) NODE_AREA = 0	! All done with that node
 W
	IF (IER.NE.0) THEN 
	   WRITE (4,IOSTAT=IER)
     &		'*SYSTEM     ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG, 
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
	ELSE 
	   REWRITE (4,IOSTAT=IER)
     &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
     &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAGM
	END IFC
 D
	CALL CLOSE_BULLUSER
 I
	RETURNH
	END
 P
 U
 =
 F
 =
	SUBROUTINE HIBER(MIN)
CB
C SUBROUTINE HIBER
C	
C FUNCTION: Waits for specified time period in minutes.=
CS
	IMPLICIT INTEGER (A-Z)1
	INTEGER TIMADR(2)			! Buffer containing timeL
						! in desired system format.O
	CHARACTER TIMBUF*13,MIN*2
	DATA TIMBUF/'0 00:00:00.00'/I
  
	TIMBUF(6:7) = MIN
 E
	IER=SYS$BINTIM(TIMBUF,TIMADR)
	IER=SYS$SCHDWK(,,TIMADR,)		! Set timer.
	IER=SYS$HIBER()
 e
	RETURNt
	END
  
 N
 F
	SUBROUTINE WAIT_SEC(PARAM)l
Cc
C SUBROUTINE WAIT_SECp
Ce
C FUNCTION: Waits for specified time period in seconds.
C
	IMPLICIT INTEGER (A-Z)C
	INTEGER TIMADR(2)			! Buffer containing timeB
						! in desired system format.I
	CHARACTER TIMBUF*13,PARAM*2
	DATA TIMBUF/'0 00:00:00.00'/1
	DATA WAIT_EF /0/D
 )
	IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)
 
	TIMBUF(9:10) = PARAM
 T
	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.A
 e
	RETURNC
	END
 L
 D
 I
 ,
	SUBROUTINE DELETE_EXPIRED
 .
CI
C  SUBROUTINE DELETE_EXPIRED
CO
C  FUNCTION:
CL
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,L
C  they get converted now.  The directory file has had it's record sizeM
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 andA
C  was replaced with a 128 byte record compressed format).
Ce
 d
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLUSER.INC'D
 C
	INCLUDE 'BULLDIR.INC'
 
	INCLUDE 'BULLFOLDER.INC'D
 B
	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG) 
 M
	CHARACTER UPTIME_DATE*11,UPTIME_TIME*11
 )
	CALL OPEN_BULLDIR_SHARED	! Open directory fileA
	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?R
	   IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?A
	   IF (IER.GT.20*356) IER = -1	! Check if latest expiration date valid.
	   IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')D
	   IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND. 
     &		(FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND.
     &		TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
			! Do shutdown messages exist and need to be checked?F
	      SHUTDOWN = 0A
	      IER1 = -1
	   ELSE
	      IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN 
		 CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
	      END IF
	      IER1 = 1L
	   END IF
	   IF (IER.LE.0.OR.IER1.LE.0) THEN_
	      CALL CLOSE_BULLDIRO
	      CALL OPEN_BULLDIR		! Reopen without sharing
	      CALL UPDATE 		! Need to update%
	   END IF
	ELSE		! If header not there, then first time running BULLETIN
	   CALL OPEN_BULLUSER		! Create user file to be able to set
	   CALL CLOSE_BULLUSER		! defaults, privileges, etc.T
	END IF 
	CALL CLOSE_BULLDIRE
 R
	RETURNe
	END
 d
 s
 e
 
	SUBROUTINE BBOARD
CE
C  SUBROUTINE BBOARD
C 
C  FUNCTION: Converts mail to BBOARD into non-system bulletins.u
Ct
 a
	IMPLICIT INTEGER (A-Z)(
 P
	INCLUDE 'BULLDIR.INC'
  
	INCLUDE 'BULLFILES.INC'
 E
	INCLUDE 'BULLUSER.INC'
  
	INCLUDE 'BULLFOLDER.INC'N
 F
	INCLUDE '($RMSDEF)'
  
	COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS 
	DATA FOLDER_Q1/0/
 S
	CHARACTER*11 INEXDATE
	CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76W
	CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12
	CHARACTER F_BBOARD*64,BBOARD_NAME*64
  
	DIMENSION NEW_MAIL(FOLDER_MAX)F
 E
	DATA SPAWN_EF/0/,HEADER_Q1/0/
 0
	CALL SYS$SETAST(%VAL(0))E
 0
	IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)
  
	CALL DISABLE_CTRL
 E
	CALL INIT_QUEUE(HEADER_Q1,INPUT)t
 a
	CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM)
  
	FOLDER_Q = FOLDER_Q1O
 $
	CALL OPEN_BULLFOLDER_SHARED		! Get folder fileA
  
	NUM_FOLDERS = 0
	IER = 0
	DO WHILE (IER.EQ.0)			! Copy all bulletins from filet
	   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)e
	   END IF
	END DO&
 '
	CALL CLOSE_BULLFOLDER			! We don't need file anymoreO
	CALL SYS$SETAST(%VAL(1))_
 D
	CALL SYS$SETAST(%VAL(0)) 
	CALL CHECK_MAIL(NEW_MAIL)
	CALL SYS$SETAST(%VAL(1)) 
 C
	FOLDER_Q = FOLDER_Q1			! Init queue pointer to header
 I
	NBBOARD_FOLDERS = 0
 :
	POINT_FOLDER = 0 
 L
1	POINT_FOLDER = POINT_FOLDER + 1 
	IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900 
 N
	CALL SYS$SETAST(%VAL(0))V
 0
	FOLDER_Q_SAVE = FOLDER_Q	
 e
	CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
 R
	IF (FOLDER_BBOARD.EQ.'NONE'.OR.
     &		FOLDER_BBOARD(:2).EQ.'::') GO TO 1
 
	NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1
 _
	IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1(
CB
C  The process is set to the BBOARD uic and username in order to createT
C  a spawned process that is able to read the BBOARD mail (a real kludge).
CM
 
	CALL GETUSER(USERNAME_SAVE)		! Get present username
	CALL GETACC(ACCOUNT_SAVE)		! Get present account 
	CALL GETUIC(GROUP_SAVE,USER_SAVE)	! Get present uic
 R
	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 account
	   CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic0
	END IFt
  
	LEN_B = TRIM(BBOARD_DIRECTORY)E
	IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//
     &		FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*')
				! Delete old TXT files left due to errorsS
 D
	IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THENT
							! 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))) THENT
	   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')
	   WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT'
	   WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV'
	   WRITE(11,'(A)')D
     & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)//
     & '''F$GETJPI("","USERNAME")'''
	   WRITE(11,'(A)') '$ MAIL'
	   WRITE(11,'(A)') 'SELECT MAIL'A
	   WRITE(11,'(A)') 'READ'
	   WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'_
	   WRITE(11,'(A)') 'DELETE/ALL'
	   WRITE(11,'(A)') 'READ/NEW'
	   WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'
	   WRITE(11,'(A)') 'DELETE/ALL'
	   WRITE(11,'(A)') 'SELECT/NEW'
	   CLOSE(UNIT=11)
	   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)A
	   CALL SYS$SETAST(%VAL(1))
	   IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))
	   CALL SYS$SETAST(%VAL(0))
	 END IF
	ELSEB
	 CONTEXT = 0D
	 IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD 
     &	    (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT)
	 IF (IER) THENM
	    IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)// 
     &		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))i
	    CALL SYS$SETAST(%VAL(0)))
	 END IF
	 IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR.
     &	 ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THENN
	    IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//P
     &	      'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF),
	    CALL SYS$SETAST(%VAL(1))E
	    IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))
	    CALL SYS$SETAST(%VAL(0))O
	 END IF
	END IFB
  
	CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)p
 o
	NBULL = F_NBULL
 I
	CALL SETACC(ACCOUNT_SAVE)		! Reset to original accountt
	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))t
 o
5	CALL SYS$SETAST(%VAL(0))
 n
	CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)!
 f
	DO WHILE (LEN_INPUT.GT.0)
	   IF (INPUT(:5).EQ.'From:') THEN
	      INFROM = INPUT(7:)		! Store username:
	   ELSE IF (INPUT(:5).EQ.'Subj:') THENI
	      INDESCRIP = INPUT(7:)		! Store subjectU
	   ELSE IF (INPUT(:3).EQ.'To:') THENI
	      INTO = INPUT(5:)			! Store address,
	   END IF
	   READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail
	END DO
 T
	INTO = INTO(:TRIM(INTO))
	CALL STR$TRIM(INTO,INTO)
	CALL STR$UPCASE(INTO,INTO)E
	FLEN = TRIM(FOLDER1_BBOARD)
	HEADER_Q = 0x
	IF (.NOT.DETECT_BBOARD(INTO,FOLDER1_BBOARD(:FLEN))) THENl
	   HEADER_Q = HEADER_Q1
	   IER = 0e
	   NHEAD = 0E
	   CALL STRIP_HEADER(' ',0,STRIP)
	   STRIP = .TRUE.
	   DO WHILE (IER.EQ.0.AND.STRIP).
	      READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTn
	      IF (IER.EQ.0) THENu
		 CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)l
		 CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
		 NHEAD = NHEAD + 1
	      END IF 
	   END DO
 r
	   FOUND = .FALSE.o
	   J = 0 
	   DO WHILE (J.LT.2.AND..NOT.FOUND)
	    J = J + 1
	    POINT_FOLDER1 = 0
 	    FOLDER_Q2 = FOLDER_Q1U
	    FOUND = .FALSE.
	    DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS)O
	      FOLDER_Q2_SAVE = FOLDER_Q2
	      CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)_
	      POINT_FOLDER1 = POINT_FOLDER1 + 1
	      IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND.
     &		  FOLDER1_BBOARD(:2).NE.'::'.AND. 
     &		  FOLDER1_BBOARD.NE.'NONE') THEN
		 IF (J.EQ.1) THENI
	            F_BBOARD = FOLDER1_BBOARD
		 ELSE 
	            F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP)(
		 END IF5
		 IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN.
	          FLEN = TRIM(F_BBOARD)
		  FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN))N
		  IF (.NOT.FOUND.AND.NHEAD.GT.1) THENU
		    HEADER_Q = HEADER_Q1
		    I = 1
		    DO WHILE (I.LT.NHEAD.AND..NOT.FOUND)
		       CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)k
		       FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN))
		       I = I + 1
		    END DO
	          END IF
	         END IF
	      END IFM
	    END DOE
	   END DO
	   IF (FOUND) THEN 
	      FOLDER_COM = FOLDER1_COM)
	      FOLDER_Q_SAVE = FOLDER_Q2_SAVE 
	   END IF
	END IF	
 e
	IF (NHEAD.EQ.0) THEN 
	   READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT	! Read first line
	ELSEe
	   HEADER_Q = HEADER_Q1
	   CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
	   LEN_INPUT = TRIM(INPUT)L
	   NHEAD = NHEAD - 1u
	END IFi
 e
	DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)s
	   READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
	   IF (INPUT(:5).EQ.'From:') GO TO 5 
	END DO		! If line is just form feed, the message is empty
	IF (IER.NE.0) GO TO 100				! If end of file, exit
 L
	EFROM = 2
	I = TRIM(INFROM)S
	DO WHILE (EFROM.GT.0.AND.I.GT.0)		! Strip off the date$
	  IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1	! From the "From:" line
	  I = I - 1
	END DOT
	IF (I.GT.0) INFROM = INFROM(:I)
 (
	CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)R
 C
	ISTART = 0S
	NBLANK = 02
	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 IFN
	   ELSE
	      ISTART = 1W
	      DO I=1,NBLANK
		 CALL WRITE_MESSAGE_LINE(' ')A
	      END DO
	      NBLANK = 0E
	      CALL WRITE_MESSAGE_LINE(INPUT) 
	   END IF
	   IF (NHEAD.EQ.0) THEN
	      READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUTR
	   ELSE
	      CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT) 
	      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)L
     &			.AND.IER.EQ.0)'
	         READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
	      END DO%
	      IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN
		 IER = 1
	      ELSE_
		 NBLANK = NBLANK + 1
	      END IF 
	   END IF
	END DOF
 E
	CALL FINISH_MESSAGE_ADD			! Totally finished with add
 F
	CALL SYS$SETAST(%VAL(1))E
 T
	GO TO 5					! See if there is more mail
 T
100	CLOSE (UNIT=14,STATUS='DELETE')		! Close the input fileE
	CALL SYS$SETAST(%VAL(1))F
	GO TO 1
 R
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_CTRLT
	FOLDER_SET = .FALSE.s
  
	IF (NBBOARD_FOLDERS.EQ.0) THENe
	   CALL OPEN_BULLUSER
	   CALL READ_USER_FILE_HEADER(IER)a
	   CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)S
	   REWRITE (4) USER_HEADER		! Rewrite headerA
	   CALL CLOSE_BULLUSERr
	END IFo
	CALL SYS$SETAST(%VAL(1))V
 S
	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))Q
  
	RETURN	
 a
910	WRITE (6,1010)
	GO TO 100
 
930	CLOSE (UNIT=14)N
	CALL CLOSE_BULLFILc
	CALL CLOSE_BULLDIRI
	WRITE (6,1030))
	GO TO 100
 )
1010	FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')I
1030	FORMAT(' ERROR:Alert system programmer. Data file problems.')
 (
	END
 D
 B
 R
 /
	LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD) 
 e
	IMPLICIT INTEGER (A-Z)S
 S
	CHARACTER*(*) INPUT,BBOARDO
 .
	DETECT_BBOARD = .TRUE. 
 m
	LEN_BBOARD = LEN(BBOARD) - 1W
 $
	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.M
     &		INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0))
     &		RETURN
	END DOL
 S
	DETECT_BBOARD = .FALSE.
 O
	RETURNe
	END
 i
 t
 S
	LOGICAL FUNCTION ALPHA(IN)W
 O
	CHARACTER*1 INU
 =
	ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z'))
     &	    .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z'))
 O
	RETURNW
	END
 L
 
  
	CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP) 
 '
	CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIPY
 E
	BBOARD_NAME = FOLDER_BBOARD
 E
	I = INDEX(FOLDER_DESCRIP,'<')
	IF (I.EQ.0) RETURN1
 A
	BBOARD_NAME = FOLDER_DESCRIP(I+1:)'
 R
	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 DOT
 L
        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,'%')O
	IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1)
 A
	RETURNT
	END
 1
 
  
 (
	SUBROUTINE CREATE_PROCESS(COMMAND)
  
	IMPLICIT INTEGER (A-Z)
 N
	INCLUDE '($PRCDEF)'
  
	INCLUDE 'BULLFILES.INC'
 A
	COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
 (
	CHARACTER*132 IMAGENAME
 ,
	CHARACTER*(*) COMMAND
 T
	CALL GETIMAGE(IMAGENAME,ILEN)
 O
	LEN_B = TRIM(BBOARD_DIRECTORY)	
 D
	OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM',
     &		STATUS='OLD',IOSTAT=IER)
	IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')V
 S
	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')N
	IF (IER.NE.0) RETURNO
	WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN)
	WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'I
	WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT'
	WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'
	WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''L
	WRITE(11,'(A)') '$EXIT:'U
	WRITE(11,'(A)') '$LOGOUT'
	CLOSE(UNIT=11)	
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectione
  
	IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',V
     &	 BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,
     &	 PROCPRIV,,COMMAND(:TRIM(COMMAND)) 
     &	 ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))
 =
	RETURNA
	END
 ,
 ,
 =
	SUBROUTINE GETUIC(GRP,MEM)i
C 
C  SUBROUTINE GETUIC(UIC)(
Ct
C  FUNCTION:
C	To get UIC of process submitting the job.(
C  OUTPUT:
C	GRP   -    Group number of UIC
C	MEM   -	   Member number of UIC(
C.
 '
	IMPLICIT INTEGER (A-Z)O
  
	INCLUDE '($JPIDEF)'
 m
	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list7
	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 itemlist1
  
	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)	! Get Info command.
 :
	RETURN)
	END
  
 $
 M
	SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME) 
CR
C  SUBROUTINE GET_UPTIME
C 
C  FUNCTION: Gets time of last reboot.
CB
 R
	IMPLICIT INTEGER (A-Z)D
 Q
	INCLUDE '($SYIDEF)'
 e
	INTEGER 	UPTIME(2) 
	CHARACTER*(*)	UPTIME_TIME,UPTIME_DATE
	CHARACTER	ASCSINCE*23
 E
	CALL INIT_ITMLST
	CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME))
	CALL END_ITMLST(GETSYI_ITMLST)	
 L
	IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,)
 R
	CALL SYS$ASCTIM(,ASCSINCE,UPTIME,)U
 
	UPTIME_DATE = ASCSINCE(:11)
	UPTIME_TIME = ASCSINCE(13:)
  
	RETURN	
	END
  
 
  
	INTEGER FUNCTION GET_L_VAL(I)
	INTEGER I
	GET_L_VAL = I
	RETURN=
	END
  
 D
 Q
	SUBROUTINE CHECK_MAIL(NEW_MAIL)
 
	IMPLICIT INTEGER (A-Z).
 .
	INCLUDE 'BULLFOLDER.INC'S
 
	COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS 
	DATA FOLDER_Q1/0/
 Q
	DIMENSION NEW_MAIL(1)
 
	CHARACTER INPUT*132
 I
	INTEGER*2 COUNT
  
	FOLDER_Q = FOLDER_Q1			! so reinit queue pointerO
 R
	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_FOLDERSE
	   CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
  
	   IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.N
     &		 BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND. 
     &		 FOLDER_BBOARD.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:)E
		 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 IFi
	         END DO
	      END IF_
	      IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN 
		 NEW_MAIL(I) = .TRUE.L
	      ELSE 
		 NEW_MAIL(I) = .FALSE.
	      END IFI
	   ELSE
	      NEW_MAIL(I) = .TRUE..
	   END IF
	END DO(
 '
	CLOSE (10)=
 )
	RETURNT
	END
  
 F
 N
	SUBROUTINE GETIMAGE(IMAGNAME,ILEN)	
CI
C  SUBROUTINE GETIMAGE(IMAGNAME,ILEN)s
Cp
C  FUNCTION:
C	To get image name of process.e
C  OUTPUT:
C	IMAGNAME   -    Image name of process 
C	ILEN	   -	Length of imagenameo
Ct
 d
	IMPLICIT INTEGER (A-Z)E
  
	INCLUDE '($JPIDEF)'
 o
	CHARACTER*(*) IMAGNAME=
 -
	CALL INIT_ITMLST	! Initialize item list
				! Now add items to listA
	CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME,
     &					%LOC(IMAGNAME),%LOC(ILEN))	
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlist
  
	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)	! Get Info command.
 L
	RETURN 
	END
  
 
  
 D
	SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)'
 
	IMPLICIT INTEGER (A-Z)L
  
	INCLUDE 'BULLDIR.INC'
 S
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 H
	DIMENSION IN_BTIM(2),
 ,
	IF (REMOTE_SET) THENN
	   CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)D
	ELSEE
	   CALL GET_MSGKEY(IN_BTIM,MSG_KEY)
	   CALL READDIR_KEYGE(START)-
	   IF (START.EQ.0) THEN
	      START = -1P
	   END IF
	END IFH
 
	RETURN 
	END
 N
 P
 E
	SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM)
 .
	IMPLICIT INTEGER (A-Z)D
 4
	INCLUDE 'BULLDIR.INC'
 P
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 N
	DIMENSION IN_BTIM(2)N
 	
	CALL GET_MSGKEY(IN_BTIM,MSG_KEY) 
	CALL READDIR_KEYGE(START)
  
	IF (START.EQ.0) RETURNL
 I
	CALL OPEN_BULLUSER_SHARED
 n
	IER = START + 1
	DO WHILE (START+1.EQ.IER)
	   IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0)
	   START = START + 1U
	   CALL READDIR(START,IER)t
	END DOC
  
	CALL CLOSE_BULLDIR
  
	RETURN
	END
 S
 S
 S
 V
 0
	SUBROUTINE READ_NOTIFY0
 C
	IMPLICIT INTEGER (A-Z)D
 C
	INCLUDE 'BULLFOLDER.INC'(
 E
	INCLUDE 'BULLUSER.INC'R
 C
	COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG)
 I
	CALL OPEN_BULLUSER_SHARED
 
	DO WHILE (REC_LOCK(IER)) 
	   READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE5
	END DO0
 '
	IF (IER.NE.0) THENE
	   DO I=1,FLONG
	      NOTIFY_REMOTE(I) = 0A
	   END DO
	   WRITE (4,IOSTAT=IER) '*NOTIFY     ',NOTIFY_REMOTE 
	END IFT
 A
	CALL CLOSE_BULLDIRN
 B
	RETURNS
	END
