Skip to content
Snippets Groups Projects
Select Git revision
  • 4c18bf803900d6073355ce26943fe9f61b7b2758
  • release default protected
  • more-testing
  • attempt-vax90b1
  • attempt-1
  • conversion protected
  • linux
  • v0.9.1 protected
  • v0.9.0 protected
9 results

bulletin2.for

Blame
  • user avatar
    Kevin Lyda authored
    4c18bf80
    History
    bulletin2.for 40.19 KiB
    C
    C  BULLETIN2.FOR, Version 9/1/89
    C  Purpose: Contains subroutines for the bulletin board utility program.
    C  Environment: MIT PFC VAX-11/780, VMS
    C  Programmer: Mark R. London
    C
    	SUBROUTINE SET_BBOARD(BBOARD)
    C
    C  SUBROUTINE SET_BBOARD
    C
    C  FUNCTION: Set username for BBOARD for selected folder.
    C
    	IMPLICIT INTEGER (A-Z)
    
    	INCLUDE 'bullfolder.inc
    
    	INCLUDE 'bulluser.inc
    
    	INCLUDE 'bullfiles.inc
    
    	INCLUDE '($UAIDEF)'
    
    	EXTERNAL CLI$_ABSENT
    
    	CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1
    
    	IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN
    	 WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')')
    	 RETURN
    	END IF
    
    	IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN
    
    	   CALL OPEN_BULLFOLDER		! Open folder file
    	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
    
    	   IF (FOLDER_BBOARD(:2).EQ.'::') THEN
    	      WRITE (6,'(
         &		'' ERROR: Cannot set BBOARD for remote folder.'')')
    	      CALL CLOSE_BULLFOLDER
    	      RETURN
    	   END IF
    
    	   IF (BBOARD) THEN
    	      IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN)
    	      IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
    		 CALL GET_UAF
         &		   (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1)
    		 CALL CLOSE_BULLFOLDER
    	         IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER?
    	            WRITE (6,'('' ERROR: '',A,
         &			'' account needs DISUSER flag set.'')')
         &			INPUT_BBOARD(:INPUT_LEN)
    		    RETURN
    		 ELSE IF (IER1.AND.BTEST(USERB,31)) THEN
    		    WRITE (6,'('' ERROR: User number of UIC cannot '',
         &				''be greater than 7777777777.'')')
    		    RETURN
    		 END IF
    		 CALL OPEN_BULLFOLDER
    		 CALL READ_FOLDER_FILE_TEMP(IER)
    		 DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR.
         &		     FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0)
    		   CALL READ_FOLDER_FILE_TEMP(IER)
    	         END DO
    		 IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND.
         &		      FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN
    		    WRITE (6,'(
         &		     '' ERROR: Account used by other folder.'')')
    		    CALL CLOSE_BULLFOLDER
    		    RETURN
    		 END IF
    		 IF (.NOT.IER1) THEN
    		    CALL CLOSE_BULLFOLDER
    		    WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'',
         &		       '' file.'')') INPUT_BBOARD(:INPUT_LEN)
    		    CALL GET_INPUT_PROMPT(RESPONSE,RLEN,
         &                 'Is the name a mail forwarding entry? '//
         &		       '(Y/N with N as default): ')
    		    IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN
    		       WRITE (6,'('' Folder was not modified.'')')
    		       RETURN
    		    END IF
    		    CALL OPEN_BULLFOLDER
    		    USERB = 1		! Fake userb/groupb, as old method of
    		    GROUPB = 1		! indicating /SPECIAL used [0,0]
    		 END IF
    		 GROUPB1 = GROUPB
    		 USERB1 = USERB
    		 ACCOUNTB1 = ACCOUNTB
    		 CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
    		 GROUPB = GROUPB1
    		 USERB = USERB1
    		 ACCOUNTB = ACCOUNTB1
    		 FOLDER_BBOARD = INPUT_BBOARD
    		 CALL OPEN_BULLUSER
    		 CALL SYS$ASCTIM(,TODAY,,)		! Get the present time
    		 CALL READ_USER_FILE_HEADER(IER)
    		 CALL SYS_BINTIM(TODAY,BBOARD_BTIM)
    		 REWRITE (4) USER_HEADER
    		 CALL CLOSE_BULLUSER
    		 IF (CLI$PRESENT('SPECIAL')) THEN	! SPECIAL specified?
    		    USERB = IBSET(USERB,31)	! Set bit to show /SPECIAL
    		    IF (CLI$PRESENT('VMSMAIL')) THEN
    		       GROUPB = IBSET(GROUPB,31)   ! Set bit to show /VMSMAIL
    		    END IF
    		 END IF
    	      ELSE IF (CLI$PRESENT('SPECIAL')) THEN
    	         USERB = IBSET(0,31)		! Set top bit to show /SPECIAL
    	         GROUPB = 0
    	         DO I=1,LEN(FOLDER_BBOARD)
    		    FOLDER_BBOARD(I:I) = ' '
    	         END DO
    	      ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN
    	         WRITE (6,'('' ERROR: No BBOARD specified for folder.'')')
    	      END IF
    
    	      IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN)
    	      IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
    	         IF (EX_LEN.GT.3) EX_LEN = 3
    	         READ (EXPIRE,'(I<EX_LEN>)') TEMP
    		 IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN
    		    WRITE (6,'('' ERROR: Expiration cannot be > '',
         &			I3,'' days.'')') BBEXPIRE_LIMIT
    		    CALL CLOSE_BULLFOLDER
    		    RETURN
    		 ELSE IF (TEMP.LE.0) THEN
    		    WRITE (6,'('' ERROR: Expiration must be > 0.'')')
    		    CALL CLOSE_BULLFOLDER
    		    RETURN
    		 ELSE
    		    FOLDER_BBEXPIRE = TEMP
    		 END IF
    	      ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN
    		 FOLDER_BBEXPIRE = -1
    	      END IF
    	   ELSE
    	      FOLDER_BBOARD = 'NONE'
    	   END IF
    
    	   CALL REWRITE_FOLDER_FILE
    	   CALL CLOSE_BULLFOLDER
    	   WRITE (6,'('' BBOARD has been modified for folder.'')')
    	ELSE
    	   WRITE (6,'('' You are not authorized to modify BBOARD.'')')
    	END IF
    
    	RETURN
    	END
    
    
    
    
    
    
    	SUBROUTINE SET_SYSTEM(SYSTEM_SET)
    C
    C  SUBROUTINE SET_SYSTEM
    C
    C  FUNCTION: Set SYSTEM specification for selected folder.
    C
    	IMPLICIT INTEGER (A-Z)
    
    	INCLUDE 'bullfolder.inc
    
    	INCLUDE 'bulluser.inc
    
    	IF (FOLDER_NUMBER.EQ.0) THEN
    	   WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')')
    	ELSE IF (SETPRV_PRIV()) THEN
    	   CALL OPEN_BULLFOLDER		! Open folder file
    	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
    	   IF (SYSTEM_SET) THEN
    	      FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
    	      WRITE (6,'('' SYSTEM designation has been set.'')')
    	   ELSE
    	      FOLDER_FLAG = IBCLR(FOLDER_FLAG,2)
    	      WRITE (6,'('' SYSTEM designation has been removed.'')')
    	   END IF
    	   CALL REWRITE_FOLDER_FILE
    	   CALL MODIFY_SYSTEM_LIST(0)
    	   CALL CLOSE_BULLFOLDER
    	   CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
    	ELSE
    	   WRITE (6,'('' You are not authorized to modify SYSTEM.'')')
    	END IF
    
    	RETURN
    	END
    
    
    
    	SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED)
    
    	IMPLICIT INTEGER (A-Z)
    
    	INCLUDE 'bullfolder.inc
    
    	INCLUDE 'bulluser.inc
    
    	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
    
    	COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
    	CHARACTER NODENAME*8
    
    	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
    	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
    
    	INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG)
    
    	CHARACTER UPDATE*11,UPTIME*8
    
    	INTEGER UP_BTIM(2)
    
    	IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER
    
    	DO WHILE (REC_LOCK(IER))
    	   READ (4,KEY='*SYSTEM',IOSTAT=IER) 
         &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,
         &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
    	END DO
    
    	IF (IER.NE.0.OR.VERSION(1).NE.168) THEN
    	   DO I=1,FLONG
    	      SYSTEM_FLAG(I) = 0
    	      SHUTDOWN_FLAG(I) = 0
    	   END DO
    	   CALL SET2(SYSTEM_FLAG,0)
    	   CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
    	   NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)
    	   SHUTDOWN_BTIM(1) = 0
    	   SHUTDOWN_BTIM(2) = 0
    	   NODE_NUMBER = 0
    	   NODE_AREA = 0
    	   IF (IER.EQ.0) THEN
    	      DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0)
    	         DELETE (UNIT=4)
    	         DO WHILE (REC_LOCK(IER))
    	           READ (4,IOSTAT=IER) TEMP_USER
    		 END DO
    	      END DO
    	      IER = 2
    	   ELSE
    	      VERSION(1) = 168
    	   END IF
    	END IF
    
    	IF (VERSION(1).NE.168) THEN
    	   CALL CLOSE_BULLFOLDER
    	   CALL OPEN_BULLFOLDER
    	   NODE_AREA = 0
    	   DO I=1,FLONG
    	      SYSTEM_FLAG(I) = 0
    	   END DO
    	   IER1 = 0
    	   DO WHILE (IER1.EQ.0)
    	      CALL READ_FOLDER_FILE_TEMP(IER1)
    	      IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN
    		 CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER)
    	      END IF
    	   END DO
    	   VERSION(1) = 168
    	END IF
    
    	IF (BTEST(FOLDER_FLAG,2)) THEN
    	   CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER)
    	ELSE
    	   CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER)
    	END IF
    
    	IF (REMOTE_SET) THEN
    	   WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2),
         &				NODENAME
    	   IF (IER1.NE.0) THEN
    	      CALL DISCONNECT_REMOTE
    	      IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER
    	      RETURN
    	   END IF
    	END IF
    
    	CALL GET_UPTIME(UPDATE,UPTIME)
    
    	CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM)
    
    	IF (NODE_AREA.EQ.0) THEN
    	   IF (SHUTDOWN_BTIM(1).EQ.0) THEN
    	      DIFF = -1
    	   ELSE
    	      DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM)
    	   END IF
    	   IF (DIFF.EQ.-1) THEN
    	      CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
    	      SHUTDOWN_BTIM(1) = UP_BTIM(1)
    	      SHUTDOWN_BTIM(2) = UP_BTIM(2)
    	      DO I=1,FLONG
    		 SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)
                  END DO
    	   END IF
    	ELSE			! Test to make sure NODE_AREA is zero
    	   SEEN_FLAG = 0		! if all of SHUTDOWN_FLAG is zero
    	   DO I=1,FLONG
    	      IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1
    	   END DO
    	   IF (SEEN_FLAG.EQ.0) NODE_AREA = 0
    	END IF
    
    	IF (IER.NE.0) THEN
    	   WRITE (4,IOSTAT=IER)
         &		'*SYSTEM     ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION,
         &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
    	ELSE
    	   REWRITE (4,IOSTAT=IER)
         &		TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,
         &		SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
    	END IF
    
    	IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER
    
    	RETURN
    	END
    
    
    	
    	SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
    
    	IMPLICIT INTEGER (A-Z)
    
    	INCLUDE '($SYIDEF)'
    
    	CALL INIT_ITMLST	! Initialize item list
    				! Now add items to list
    	CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA))
    	CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER))
    	CALL END_ITMLST(GETSYI_ITMLST)	! Get address of itemlist
    
    	IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,)	! Get Info command.
    C
    C  NODE_AREA is set to 0 after shutdown messages are deleted.
    C  If node is not part of cluster, NODE_AREA will be 0,
    C  so set it to 1 as a dummy value to cause messages to be deleted.
    C
    	IF (NODE_AREA.EQ.0) NODE_AREA = 1
    
    	RETURN
    	END
    
    
    
    
    	SUBROUTINE SET_NODE(NODE_SET)
    C
    C  SUBROUTINE SET_NODE
    C
    C  FUNCTION: Set or reset remote node specification for selected folder.
    C
    	IMPLICIT INTEGER (A-Z)
    
    	INCLUDE 'bullfolder.inc
    
    	INCLUDE 'bulluser.inc
    
    	INCLUDE 'bullfiles.inc
    
    	INCLUDE 'bulldir.inc
    
    	EXTERNAL CLI$_ABSENT
    
    	CHARACTER RESPONSE*1,FOLDER_SAVE*25
    
    	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
    
    	IF (CLI$PRESENT('FOLDER')) THEN
    	   IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name
    	   FOLDER_SAVE = FOLDER
    	   CALL OPEN_BULLFOLDER_SHARED		! Open folder file
    	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER)
    	   IF (IER.EQ.0) THEN
    	      IF (FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
    		 WRITE (6,'('' ERROR: No privs to modify folder.'')')
    		 IER = 1
    	      END IF
    	   ELSE
    	      WRITE (6,'('' ERROR: Specified folder not found.'')')
    	   END IF
    	   IF (IER.NE.0) THEN
    	      CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)
    	      CALL CLOSE_BULLFOLDER
    	      RETURN
    	   END IF
    	   CALL CLOSE_BULLFOLDER
    	END IF
    
    	IF (FOLDER_NUMBER.EQ.0) THEN
    	   WRITE (6,'('' Cannot set remote node for GENERAL folder.'')')
    	ELSE IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN
    	   IF (.NOT.NODE_SET) THEN
    	      IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN
    		 REMOTE_SET_SAVE = REMOTE_SET
    		 REMOTE_SET = .FALSE.
    	         FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
         &		     FOLDER
    	         CALL OPEN_BULLDIR		! Remove directory file which
    	         CALL CLOSE_BULLDIR_DELETE	! contains remote folder name
    		 REMOTE_SET = REMOTE_SET_SAVE
    	      END IF
    	      FOLDER1_BBOARD = 'NONE'
    	      WRITE (6,'('' Remote node setting has been removed.'')')
    	      IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE.
    	   ELSE
    	      CALL GET_INPUT_PROMPT(RESPONSE,RLEN,
         &          'Are you sure you want to make folder '//
         &	        FOLDER(:TRIM(FOLDER))//
         &		' remote? (Y/N with N as default): ')
    	      IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN
    	        WRITE (6,'('' Folder was not modified.'')')
    	        RETURN
    	      END IF
    	      IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN
    	         FOLDER1 = FOLDER
    	      END IF
    	      IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN)
    	      FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN)
    	      CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
    	      IF (IER.NE.0) THEN
    	         WRITE (6,'(
         &		  '' ERROR: Folder not accessible on remote node.'')')
    	         RETURN
    	      ELSE
    	         WRITE (6,'('' Folder has been converted to remote.'')')
    	      END IF
    	      FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
         &		FOLDER
    	      REMOTE_SET_SAVE = REMOTE_SET
    	      REMOTE_SET = .FALSE.
    	      CALL OPEN_BULLDIR			! Remove directory file
    	      CALL OPEN_BULLFIL			! Remove bulletin file
    	      CALL CLOSE_BULLFIL_DELETE
    	      CALL CLOSE_BULLDIR_DELETE
    	      IF (FOLDER.NE.FOLDER1) THEN	! Different remote folder name?
    	         CALL OPEN_BULLDIR		! If so, put name in header
    		 BULLDIR_HEADER(13:) = FOLDER1	! of directory file.
    		 CALL WRITEDIR_NOCONV(0,IER)
    	         CALL CLOSE_BULLDIR
    	         FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*'
    	      END IF
    	      REMOTE_SET = REMOTE_SET_SAVE
    	      IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE.
    	   END IF
    	   CALL OPEN_BULLFOLDER		! Open folder file
    	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
    	   IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::'
         &			.AND.BTEST(FOLDER_FLAG,2)) THEN
    	      OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,
         &		RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD))
         &		//'::"TASK=BULLETIN1"')
    	      IF (IER.EQ.0) THEN	! Disregister remote SYSTEM folder
    		 WRITE(17,'(2A)',IOSTAT=IER) 14,0
    		 CLOSE (UNIT=17)
    	      END IF
    	   END IF
    	   FOLDER_BBOARD = FOLDER1_BBOARD
    	   IF (NODE_SET) THEN
    	      F_NBULL = F1_NBULL
    	      F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)
    	      F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)
    	      F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1)
    	      F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2)
    	      FOLDER_FLAG = 0
    	      F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT
    	   ELSE
    	      F_NBULL = 0
    	   END IF
    	   CALL REWRITE_FOLDER_FILE
    	   CALL CLOSE_BULLFOLDER
    	ELSE
    	   WRITE (6,'('' You are not authorized to modify NODE.'')')
    	END IF
    
    	IF (CLI$PRESENT('FOLDER')) THEN
    	   CALL OPEN_BULLFOLDER_SHARED		! Open folder file
    	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)
    	   CALL CLOSE_BULLFOLDER
    	   FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
         &		FOLDER
    	END IF
    
    	RETURN
    	END
    
    
    
    
    	SUBROUTINE RESPOND(STATUS)
    C
    C  SUBROUTINE RESPOND
    C
    C  FUNCTION: Sends a mail message in reply to a posted message.
    C
    C  NOTE: Modify the last SPAWN statement to specify the command
    C	you use to send mail to sites other than via MAIL.
    C	If you always use a different command, modify both
    C	spawn commands.
    C
    	IMPLICIT INTEGER (A - Z)
    
    	COMMON /POINT/ BULL_POINT
    
    	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
    	CHARACTER*64 BULL_PARAMETER
    
    	COMMON /EDIT/ EDIT_DEFAULT
    	DATA EDIT_DEFAULT/.FALSE./
    
    	COMMON /COMMAND_LINE/ INCMD
    	CHARACTER*132 INCMD
    
    	INCLUDE 'bulldir.inc
    
    	INCLUDE 'bullfolder.inc
    
    	CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH)
    
    	EXTERNAL CLI$_NEGATED
    
    	IF (INCMD(:4).NE.'POST') THEN
    	   IF (BULL_POINT.EQ.0) THEN	! If no bulletin has been read
    	      WRITE(6,'('' ERROR: You have not read any message.'')')
    	      RETURN			! And return
    	   END IF
    
    	   CALL OPEN_BULLDIR_SHARED
    
    	   CALL READDIR(BULL_POINT,IER)	! Get info for specified bulletin
    
    	   IF (IER.NE.BULL_POINT+1) THEN	! Was bulletin found?
    	      WRITE(6,'('' ERROR: Bulletin was not found.'')')
    	      CALL CLOSE_BULLDIR		! If not, then error out
    	      RETURN
    	   END IF
    
    	   CALL CLOSE_BULLDIR
    
    	   BULL_PARAMETER = 'RE: '//DESCRIP
    	END IF
    
    	IF (CLI$PRESENT('SUBJECT')) THEN
    	   IER = CLI$GET_VALUE('SUBJECT',BULL_PARAMETER,LEN_P)
    	   IF (LEN_P.GT.LEN(BULL_PARAMETER)-2) THEN
    	      WRITE(6,'('' ERROR: Subject limit is 64 characters.'')')
    	      RETURN
    	   END IF
    	ELSE IF (INCMD(:4).EQ.'POST') THEN
    	   WRITE(6,'('' Enter subject of message:'')')
    	   CALL GET_LINE(BULL_PARAMETER,LEN_P)
    	   IF (LEN_P.LE.0) THEN
    	      WRITE(6,'('' ERROR: No subject specified.'')')
    	      RETURN
    	   END IF
    	END IF
    
    	IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND.	! If /EDIT specified
         &      (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN
    	   EDIT = .TRUE.
    	   CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
    	ELSE
    	   EDIT = .FALSE.
    	END IF
    
    	IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN
    	   OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
         &		RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
    
    	   IF (IER.NE.0) THEN
    	      CALL ERRSNS(IDUMMY,IER)
    	      CALL SYS_GETMSG(IER)
    	      RETURN
    	   END IF
    	END IF
    
    	LENFRO = 0
    	IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN
    	   INFROM = INPUT(:ILEN)//','
    	   LENFRO = ILEN + 1
    	END IF
    
    	IF ((EDIT.AND.CLI$PRESENT('TEXT')).OR.
         &					INCMD(:4).NE.'POST') THEN
    	   CALL OPEN_BULLFIL_SHARED
    
    	   ILEN = LINE_LENGTH + 1
    
    	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
    	      INFROM = INFROM(:LENFRO)//INPUT(7:)
    	      LENFRO = LENFRO + ILEN - 6
    	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	   ELSE
    	      INFROM = INFROM(:LENFRO)//FROM
    	      LENFRO = TRIM(FROM) + LENFRO
    	   END IF
    
    	   IF (CLI$PRESENT('LIST')) THEN
    	      INFROM = INFROM(:LENFRO)//','
    	      LENFRO = LENFRO + 1
    	   END IF
    
    	   IF (INCMD(:4).EQ.'POST') LENFRO = 0
    
    	   IF (EDIT.AND.CLI$PRESENT('TEXT')) THEN
    	      IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
    	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	      END IF
    	      DO WHILE (ILEN.GT.0)		! Copy bulletin into file
    	         IF (CLI$PRESENT('NOINDENT')) THEN
    	            WRITE (3,'(A)') INPUT(:ILEN)
    	         ELSE
    	            WRITE (3,'(A)') '>'//INPUT(:ILEN)
    	         END IF
    	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	      END DO
    
    	      CLOSE (UNIT=3)			! Bulletin copy completed
    	   END IF
    
    	   CALL CLOSE_BULLFIL
    	END IF
    
    	IF (CLI$PRESENT('LIST')) THEN
    	   LIST = INDEX(FOLDER_DESCRIP,'<')
    	   IF (LIST.GT.0) THEN
    	      INFROM = INFROM(:LENFRO)//
         &		FOLDER_DESCRIP(LIST+1:TRIM(FOLDER_DESCRIP)-1)
    	      LENFRO = LENFRO + TRIM(FOLDER_DESCRIP) - 1 - LIST
    	   ELSE
    	      WRITE (6,'('' ERROR: No list address'',
         &			'' found in folder description.'')')
    	      GO TO 900
    	   END IF
    	END IF
    
    	I = 1		! Must change all " to "" in FROM field
    	DO WHILE (I.LE.LENFRO)
    	   IF (INFROM(I:I).EQ.'"') THEN
    	      INFROM = INFROM(:I)//'"'//INFROM(I+1:)
    	      I = I + 1
    	      LENFRO = LENFRO + 1
    	   END IF
    	   I = I + 1
    	END DO
    
    	LEN_P = TRIM(BULL_PARAMETER)
    	I = 1		! Must change all " to "" in SUBJECT field
    	DO WHILE (I.LE.LEN_P)
    	   IF (BULL_PARAMETER(I:I).EQ.'"') THEN
    	      IF (LEN_P.EQ.64) THEN
    		 BULL_PARAMETER(I:I) = '`'
    	      ELSE
    		 BULL_PARAMETER = BULL_PARAMETER(:I)//'"'
         &				//BULL_PARAMETER(I+1:)
    		 I = I + 1
    		 LEN_P = LEN_P + 1
    	      END IF
    	   END IF
    	   I = I + 1
    	END DO
    	CALL DISABLE_PRIVS
    	IF (EDIT) THEN
    	   CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
    	   IF (CLI$PRESENT('TEXT')) THEN
    	      CONTEXT = 0
    	      CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT)
    	      VERSION = INDEX(INPUT,';') + 1
    	      IF (INPUT(VERSION:VERSION).EQ.'1') THEN
    	         CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
    	      END IF
    	   END IF
    	   CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//INFROM(:LENFRO)
         &		//'"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS)
    	ELSE
    	   CALL LIB$SPAWN('$MAIL SYS$INPUT "'//INFROM(:LENFRO)//
         &		'"/SUBJECT="'//BULL_PARAMETER//'"',,,,,,STATUS)
    	END IF
    	CALL ENABLE_PRIVS
    
    900	IF (EDIT) THEN
    	   CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
    	END IF
    
    	RETURN
    
    	END
    
    
    	INTEGER FUNCTION CONFIRM_USER(USERNAME)
    C
    C  FUNCTION CONFIRM_USER
    C
    C  FUNCTION: Confirms that username is valid user.
    C
    	IMPLICIT INTEGER (A-Z)
    
    	CHARACTER*(*) USERNAME
    
    	CALL OPEN_SYSUAF_SHARED
    
    	READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER)
    
    	CALL CLOSE_SYSUAF
    
    	RETURN
    	END
    
    
    
    
    
    	SUBROUTINE REPLACE
    C
    C  SUBROUTINE REPLACE
    C
    C  FUNCTION: Replaces existing bulletin to bulletin file.
    C
    	IMPLICIT INTEGER (A - Z)
    
    	COMMON /POINT/ BULL_POINT
    
    	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
    	CHARACTER*64 BULL_PARAMETER
    
    	COMMON /EDIT/ EDIT_DEFAULT
    
    	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
    
    	COMMON /LAST_RECORD_WRITTEN/ OCOUNT
    
    	INCLUDE 'bulldir.inc
    
    	INCLUDE 'bulluser.inc
    
    	INCLUDE 'bullfolder.inc
    
    	CHARACTER INEXDATE*11,INEXTIME*11
    	CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH)
    	CHARACTER*1 ANSWER
    
    	CHARACTER DATE_SAVE*11,TIME_SAVE*11
    
    	INTEGER TIMADR(2)
    
    	EXTERNAL CLI$_ABSENT,CLI$_NEGATED
    
    	LOGICAL*1 DOALL
    
    C
    C  Get the bulletin number to be replaced.
    C
    	IF (.NOT.CLI$PRESENT('NUMBER')) THEN	! No number has been specified
    	   IF (BULL_POINT.EQ.0) THEN	! If no bulletin has been read
    	      WRITE (6,1005)		! Tell user of the error
    	      RETURN			! and return
    	   END IF
    	   NUMBER_PARAM = BULL_POINT	! Replace the bulletin we are reading
    	ELSE
    	   CALL CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)
    	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) NUMBER_PARAM
    	END IF
    
    	IF (CLI$PRESENT('SYSTEM')) THEN
    	   IF (.NOT.SETPRV_PRIV()) THEN
    	    WRITE (6,'(
         &	     '' ERROR: Not enough privileges to change to system.'')')
    	    RETURN
    	   ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN
    	    WRITE (6,'(
         &       '' ERROR: /SYSTEM cannot be set with selected folder.'')')
    	    RETURN
    	   END IF
    	END IF
    
    	IF (CLI$PRESENT('SHUTDOWN')) THEN
    	   IF (.NOT.SETPRV_PRIV()) THEN
    	    WRITE (6,'(
         &	     '' ERROR: Not enough privileges to change to shutdown.'')')
    	    RETURN
    	   ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN
    	    WRITE (6,'(
         &      '' ERROR: /SHUTDOWN cannot be set with selected folder.'')')
    	    RETURN
    	   ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE.
         &		    %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN
    	    WRITE (6,'('' ERROR: Shutdown node name not'',
         &			    '' permitted for remote folder.'')')
    	    RETURN
    	   END IF
    	END IF
    
    	IF (CLI$PRESENT('PERMANENT').AND.
         &      .NOT.FOLDER_SET.AND..NOT.SETPRV_PRIV()) THEN
    	   WRITE (6,'(
         &	    '' ERROR: Not enough privileges to change to permanent.'')')
    	   RETURN
    	END IF
    C
    C  Check to see if specified bulletin is present, and if the user
    C  is permitted to replace the bulletin.
    C
    
    	CALL OPEN_BULLDIR_SHARED
    
    	CALL READDIR(NUMBER_PARAM,IER)	! Get info for specified bulletin
    
    	CALL CLOSE_BULLDIR
    
    	IF (IER.NE.NUMBER_PARAM+1) THEN	! Was bulletin found?
    	   WRITE (6,1015)		! If not, tell the person
    	   RETURN			! and error out
    	END IF
    
    	IF (USERNAME.NE.FROM) THEN	! If doesn't match owner of bulletin,
    	   IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR.    ! Privileges or
         &	       (.NOT.SETPRV_PRIV().AND.
         &		USERNAME.NE.FOLDER_OWNER.AND.FOLDER_SET)) THEN ! folder owner?
    	      WRITE(6,1090)		! If not, then error out.
    	      RETURN
    	   ELSE
    	      WRITE (6,1100)		! Make sure user wants to delete it
    	      READ (5,'(A)',IOSTAT=IER) ANSWER	! Get his answer
    	      CALL STR$UPCASE(ANSWER,ANSWER)	! Convert input to uppercase
    	      IF (ANSWER.NE.'Y') RETURN	! If not Yes, then exit
    	   END IF
    	END IF
    
    C
    C  If no switches were given, replace the full bulletin
    C
    
    	DOALL = .FALSE.
    
    	IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND.
         &	   (.NOT.CLI$PRESENT('GENERAL')).AND.
         &	   (.NOT.CLI$PRESENT('SYSTEM')).AND.
         &	   (.NOT.CLI$PRESENT('HEADER')).AND.
         &	   (.NOT.CLI$PRESENT('SUBJECT')).AND.
         &	   (.NOT.CLI$PRESENT('TEXT')).AND.
         &	   (.NOT.CLI$PRESENT('SHUTDOWN')).AND.
         &	   (.NOT.CLI$PRESENT('PERMANENT'))) THEN
    	   DOALL = .TRUE.
    	END IF
    
    	CALL DISABLE_CTRL			! Disable CTRL-Y & -C
    
    	IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN
    	   CALL GET_EXPIRED(INPUT,IER)
    	   IF (.NOT.IER) GO TO 910
    	   INEXDATE = INPUT(:11)
    	   INEXTIME = INPUT(13:)
    	END IF
    
    8	LENDES = 0
    	IF (CLI$PRESENT('HEADER').OR.DOALL) THEN
    	   WRITE(6,1050)			! Request header for bulletin
    	   READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP
    	   IF (LENDES.EQ.0) GO TO 910		! If no header, don't add bull
    	ELSE IF (CLI$PRESENT('SUBJECT')) THEN
    	   IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)
    	END IF
    
    	IF (LENDES.GT.0) THEN
    	   INDESCRIP = 'Subj: '//INDESCRIP
    	   LENDES = MIN(LENDES+6,LEN(INDESCRIP))
    	END IF
    
    	REC1 = 0
    
    	LENFROM = 0
    
    	IF (LENDES.GT.0.OR.CLI$PRESENT('TEXT').OR.DOALL) THEN
    	   OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
         &	     RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')
    
    	   IF (IER.NE.0) THEN
    	      CALL ERRSNS(IDUMMY,IER)
    	      CALL SYS_GETMSG(IER)
    	      GO TO 910
    	   END IF
    
    	   CALL OPEN_BULLFIL_SHARED
    
    	   REC1 = 1
    
    	   ILEN = LINE_LENGTH + 1
    
    	   CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
    	      INFROM = INPUT(:ILEN)
    	      LENFROM = ILEN
    	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	   END IF
    	   IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
    	      IF (LENDES.EQ.0.AND..NOT.DOALL) THEN
    		 INDESCRIP = INPUT(:ILEN)
    		 LENDES = ILEN
    	      END IF
    	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	   END IF
    
    	   DO WHILE (ILEN.GT.0)		! Copy bulletin into file
    	      WRITE (3,'(A)') INPUT(:ILEN)
    	      CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	   END DO
    
    	   CALL CLOSE_BULLFIL
    
    	   IF (CLI$PRESENT('TEXT').OR.DOALL) CLOSE(UNIT=3)
    	END IF
    
    	IF (CLI$PRESENT('TEXT').OR.DOALL) THEN
    C
    C  If file specified in REPLACE command, read file to obtain bulletin.
    C  Else, read the bulletin from the terminal.
    C
    	
    	  ICOUNT = 0				! Line count for bulletin
    	  LAST_NOBLANK = 0			! Last line with data
    	  REC1 = 1
    
    	  IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)
    	  IF (IER.NE.%LOC(CLI$_ABSENT).OR.	! If file param in ADD command
         &	    ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND.	! or /EDIT specified
         &       (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN
    
    	   IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified
         &       (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN
    	      IF (LEN_P.EQ.0) THEN		! If no file param specified
    		 IF (.NOT.CLI$PRESENT('NEW')) THEN
    	            OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',
         &		       RECL=LINE_LENGTH,
         &		       ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')
    	            CALL OPEN_BULLFIL_SHARED	! Prepare to copy message
    		    ILEN = LINE_LENGTH + 1
    		    CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    		    IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
    		       CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    		    END IF
    		    IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
    		       CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    		    END IF
    		    DO WHILE (ILEN.GT.0)	! Copy message into file
    		       WRITE (3,'(A)') INPUT(:ILEN)
    		       CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    		    END DO
    		    CALL CLOSE_BULLFIL
    	            CLOSE (UNIT=3)		! Bulletin copy completed
    		 END IF
    		 CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
    	      ELSE 
    		 IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS
    		 CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')
    	      END IF
    	      IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')
    	      OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',
         &		 DISPOSE='DELETE',ERR=920,FORM='FORMATTED')
    	   ELSE IF (LEN_P.GT.0) THEN
    	      IF (.NOT.SETPRV_PRIV()) CALL DISABLE_PRIVS
    	      OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',
         &		READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file
    	   END IF
    
    	   CALL ENABLE_PRIVS			! Reset SYSPRV privileges
    
    	   DO WHILE(1)				! Read until end of file to
    	      READ (3,'(Q,A)',END=10) ILEN,INPUT	! get record count
    	      IF (ILEN.GT.LINE_LENGTH) GO TO 950
    	      CALL STR$TRIM(INPUT,INPUT,ILEN)
    	      IF (ILEN.GT.0) THEN		! If good input line entered
    		 ICOUNT = ICOUNT + ILEN + 1	! Increment record count
    		 LAST_NOBLANK = ICOUNT
    	      ELSE IF (ILEN.EQ.0) THEN
    		 IF (ICOUNT.GT.0) THEN
    		    ICOUNT = ICOUNT + 2		! COPY_BULL writes a line with
    		 ELSE				! 1 space for a blank line.
    		    REC1 = REC1 + 1
    		 END IF
    	      END IF
    	   END DO
    	  ELSE					! If no input file
    	   OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920,
         &		 DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH,
         &		 CARRIAGECONTROL='LIST')	! Scratch file to save bulletin
    	   WRITE (6,1000)		! Request bulletin input from terminal
    	   ILEN = LINE_LENGTH			! Length of input line
    	   DO WHILE (ILEN.GE.0)			! Input until no more input
    	      CALL GET_LINE(INPUT,ILEN)		! Get input line
    	      IF (ILEN.GT.LINE_LENGTH) THEN	! Line too long.
    		 WRITE(6,'('' ERROR: Input line length > '',I,
         &			''. Reinput::'')') LINE_LENGTH
    	      ELSE IF (ILEN.GT.0) THEN		! If good input line entered
    		 ICOUNT = ICOUNT + 1 + ILEN	! Increment character count
    		 WRITE(3,'(A)') INPUT(:ILEN)	! Save line in scratch file
    		 LAST_NOBLANK = ICOUNT
    	      ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN
    		 WRITE(3,'(A)') INPUT(:ILEN)	! Save line in scratch file
    		 ICOUNT = ICOUNT + 2		! COPY_BULL writes a line with
    	      END IF				! 1 space for a blank line.
    	   END DO
    	   IF (ILEN.EQ.-1) GO TO 910		! CTRL_C entered, error out
    10	   ICOUNT = LAST_NOBLANK
    	   IF (ICOUNT.EQ.0) GO TO 910		! No lines entered, error out
    	  ENDIF
    
    	END IF
    
    C
    C  Add bulletin to bulletin file and directory entry for to directory file.
    C
    
    	DATE_SAVE = DATE
    	TIME_SAVE = TIME
    	INPUT = DESCRIP
    
    	CALL OPEN_BULLDIR			! Prepare to add dir entry
    
    	CALL READDIR(NUMBER_PARAM,IER)		! Get info for message
    
    	IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.
         &	    TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN
    				! If message disappeared, try to find it.
    	   IF (IER.NE.NUMBER_PARAM+1) DATE = ' '
    	   NUMBER_PARAM = 0
    	   IER = 1
    	   DO WHILE (IER.EQ.NUMBER_PARAM+1.AND.
         &	    (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT))
    	      NUMBER_PARAM = NUMBER_PARAM + 1
    	      CALL READDIR(NUMBER_PARAM,IER)
    	   END DO
    
    	   IF (IER.NE.NUMBER_PARAM+1) THEN	! Couldn't find message
    	      CALL CLOSE_BULLDIR
    	      CLOSE (UNIT=3,STATUS='SAVE')
    	      WRITE(6,'('' ERROR: Message has been deleted'',
         &			'' by another user.'')')
    	      IF (DOALL.OR.CLI$PRESENT('TEXT')) THEN
    		 WRITE (6,'('' New text has been saved in'',
         &				'' SYS$LOGIN:BULL.SCR.'')')
    	      END IF
    	      GO TO 100
    	   END IF
    	END IF
    
    	CALL READDIR(0,IER)			! Get directory header
    
    	IF (REC1.GT.0) THEN			! If text has been replaced
    
    	   CALL OPEN_BULLFIL			! Prepare to add bulletin
    
    	   BLOCK = NBLOCK + 1
    	   BLOCK_SAVE = BLOCK
    	   NEMPTY = NEMPTY + LENGTH
    	   NBLOCK = NBLOCK + ICOUNT
    
    	   IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)
    
    	   OBLOCK = BLOCK
    	   IF (LENFROM.GT.0) THEN
    	      CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK)
    	   END IF
    	   IF (LENDES.GT.0) THEN
    	      CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK)
    	   END IF
    	   REWIND (UNIT=3)
    	   CALL COPY_BULL(3,REC1,OBLOCK,IER)	! Add the new bulletin
    	   IF (IER.NE.0) THEN		! Error in creating bulletin
    	      WRITE (6,'(A)') ' ERROR: Unable to replace message.'
    	      CALL CLOSE_BULLFIL
    	      CALL CLOSE_BULLDIR
    	      CLOSE (UNIT=3)
    	      GO TO 100
    	   END IF
    
    	   LENGTH_SAVE = OCOUNT - BLOCK + 1
    
    	   CALL CLOSE_BULLFIL
    
    	   IF (.NOT.REMOTE_SET) THEN
    	    CALL READDIR(NUMBER_PARAM,IER)	! Get directory entry
    	    LENGTH = LENGTH_SAVE		! Update size
    	    BLOCK = BLOCK_SAVE
    	    CALL WRITEDIR(NUMBER_PARAM,IER)	! Write new directory entry
    	   END IF
    	ELSE
    	   CALL READDIR(NUMBER_PARAM,IER)
    	END IF
    
    	IF (.NOT.REMOTE_SET) THEN
    
    	   IF (LENDES.GT.0.OR.DOALL) THEN
    	      DESCRIP=INDESCRIP(7:59)		! Update description header
    	   END IF
    	   CALL UPDATE_DIR_HEADER(CLI$PRESENT('EXPIRATION').OR.DOALL,
         &		CLI$PRESENT('PERMANENT'),CLI$PRESENT('SHUTDOWN'),
         &		INEXDATE,INEXTIME)
    	   IF (CLI$PRESENT('SYSTEM')) THEN
    	      SYSTEM = IBSET(SYSTEM,0)
    	   ELSE IF (CLI$PRESENT('GENERAL')) THEN
    	      SYSTEM = IBCLR(SYSTEM,0)
    	   END IF
    	   CALL WRITEDIR(NUMBER_PARAM,IER)
    	ELSE
    	   MSGTYPE = 0
    	   IF (CLI$PRESENT('SYSTEM').OR.
         &		(BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN
    	      MSGTYPE = IBSET(MSGTYPE,0)
    	   END IF
    	   IF (CLI$PRESENT('PERMANENT')) THEN
    	      MSGTYPE = IBSET(MSGTYPE,1)
    	   ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN
    	      MSGTYPE = IBSET(MSGTYPE,2)
    	   ELSE IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN
    	      MSGTYPE = IBSET(MSGTYPE,3)
    	   END IF
    	   IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP
    	   IF (CLI$PRESENT('EXPIRATION')) THEN
    	      EXDATE = INEXDATE
    	      EXTIME = INEXTIME
    	   END IF
    	   WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)
         &      10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,EXDATE,EXTIME
    	   IF (IER.EQ.0) THEN
    	      READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM
    	   END IF
    	   IF (IER.EQ.0) THEN
    	      IF (I.NE.LEN(FOLDER1_COM)) THEN
    		 WRITE (6,'(1X,A)') FOLDER1_COM(:I)
    	      END IF
    	   ELSE
    	      CALL DISCONNECT_REMOTE
    	   END IF
    	END IF
    
    	CALL CLOSE_BULLDIR		! Totally finished with replace
    
    	CLOSE (UNIT=3)
    
    100	CALL ENABLE_CTRL		! Enable CTRL-Y & -C
    	RETURN
    
    910	WRITE(6,1010)
    	CLOSE (UNIT=3,ERR=100)
    	GOTO 100
    
    920	WRITE(6,1020)
    	CALL ENABLE_PRIVS	! Reset SYSPRV privileges
    	GOTO 100
    
    950	WRITE (6,1030) LINE_LENGTH
    	CLOSE (UNIT=3)
    	GO TO 100
    
    1000	FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')
    1005	FORMAT (' ERROR: You are not reading any message.')
    1010	FORMAT (' No message was replaced.')
    1015	FORMAT (' ERROR: Specified message was not found.')
    1020	FORMAT (' ERROR: Unable to open specified file.')
    1030	FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')
    1050	FORMAT (' Enter description header.')
    1090	FORMAT(' ERROR: Specified message is not owned by you.')
    1100	FORMAT(' Message is not owned by you.',
         &	       ' Are you sure you want to replace it? ',$)
    2020	FORMAT(1X,A)
    
    	END
    
    
    
    	SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME)
    
    	IMPLICIT INTEGER (A-Z)
    
    	INCLUDE 'bulldir.inc
    
    	EXTERNAL CLI$_ABSENT
    
    	COMMON /COMMAND_LINE/ INCMD
    	CHARACTER*132 INCMD
    
    	CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11
    
    	IF (EXPIRE) THEN
    	   SYSTEM = IBCLR(SYSTEM,1)
    	   SYSTEM = IBCLR(SYSTEM,2)
    	   EXDATE=INEXDATE			! Update expiration date
    	   EXTIME=INEXTIME
    	   DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE)	! Compare expiration
    	   IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME)
    	   IF (DIFF.LT.0) THEN			! If it's oldest expiration bull
    	      NEWEST_EXDATE = EXDATE		! Update the header in
    	      NEWEST_EXTIME = EXTIME		! the directory file
    	      CALL WRITEDIR(0,IER)
    	   END IF
    	ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN
    	   IF (BTEST(SYSTEM,2)) THEN
    	      SYSTEM = IBCLR(SYSTEM,2)
    	      SHUTDOWN = SHUTDOWN - 1
    	      CALL WRITEDIR(0,IER)
    	   END IF
    	   SYSTEM = IBSET(SYSTEM,1)
    	   EXDATE = '5-NOV-2000'
    	   EXTIME = '00:00:00.00'
    	ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN
    	   SYSTEM = IBSET(SYSTEM,2)
    	   SYSTEM = IBCLR(SYSTEM,1)
    	   EXDATE = '5-NOV-2000'
    	   NODE_AREA = 0
    	   IF (INCMD(:4).EQ.'REPL') THEN
    	      IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME)
         &		    .NE.%LOC(CLI$_ABSENT)) THEN
    		 CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME)
    	         IF (NODE_AREA.EQ.0) THEN
    		    WRITE (6,'('' ERROR: Shutdown node name ignored.'',
         &		               '' Invalid node name specified.'')')
    		 END IF
    	      END IF
    	   END IF
    	   IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
    	   WRITE (EXTIME,'(I4)') NODE_NUMBER
    	   WRITE (EXTIME(7:),'(I4)') NODE_AREA
    	   DO I=1,11
    	      IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'
    	   END DO
    	   EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//
         &		    EXTIME(7:8)//'.'//EXTIME(9:10)
    	   SHUTDOWN = SHUTDOWN + 1
    	   CALL SYS$ASCTIM(,TODAY,,)		! Get the present time
    	   SHUTDOWN_DATE = TODAY(:11)
    	   SHUTDOWN_TIME = TODAY(13:)
    	   CALL WRITEDIR(0,IER)
    	END IF
    
    	RETURN
    	END
    
    
    
    
    	SUBROUTINE SEARCH(READ_COUNT)
    C
    C  SUBROUTINE SEARCH
    C
    C  FUNCTION: Search for bulletin with specified string
    C
    	IMPLICIT INTEGER (A - Z)
    
    	INCLUDE 'bulldir.inc
    
    	CHARACTER*132 SEARCH_STRING,SAVE_STRING
    	DATA SEARCH_STRING /' '/, SEARCH_LEN /1/
    
    	COMMON /POINT/ BULL_POINT
    
    	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
    	CHARACTER*64 BULL_PARAMETER
    
    	COMMON /CTRLC_FLAG/ FLAG
    
    	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
    
    	CALL DISABLE_CTRL
    
    	IF (CLI$PRESENT('START')) THEN		! Starting message specified
    	   CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)
    	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) BULL_POINT
    	   BULL_POINT = BULL_POINT - 1
    	END IF
    
    	SAVE_STRING = SEARCH_STRING
    	SAVE_LEN = SEARCH_LEN
    
    	IER1 = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN)
    	
    	IF (.NOT.IER1) THEN			! If no search string entered
    	   SEARCH_STRING = SAVE_STRING		! use saved search string
    	   SEARCH_LEN = SAVE_LEN
    	   IF (SAVE_LEN.EQ.0) THEN
    	      WRITE (6,'('' No search string present.'')')
    	      RETURN
    	   END IF
    	   IF (STEP_BULL.EQ.-1) BULL_POINT = BULL_POINT - 2
    	END IF
    
    	CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING)	! Make upper case
    
    	CALL OPEN_BULLDIR_SHARED
    
    	CALL READDIR(0,IER)
    
    	IF (IER1) THEN				! If string entered
    	   IF (.NOT.CLI$PRESENT('START')) THEN  ! If starting message not 
    	      BULL_POINT = 0			! specified, use first
    	      IF (CLI$PRESENT('REVERSE')) BULL_POINT = NBULL - 1  ! or last
    	   END IF
    	   SUBJECT = CLI$PRESENT('SUBJECT')
    	   IF (CLI$PRESENT('REVERSE')) THEN
    	      END_BULL = 1
    	      STEP_BULL = -1
    	   ELSE
    	      END_BULL = NBULL
    	      STEP_BULL = 1
    	   END IF
    	END IF
    
    	IF ((BULL_POINT+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR.
         &	    (BULL_POINT+1.EQ.0)) THEN
    	   WRITE (6,'('' ERROR: No more messages.'')')
    	   CALL CLOSE_BULLDIR
    	   CALL ENABLE_CTRL
    	   RETURN
    	END IF
    
    	CALL OPEN_BULLFIL_SHARED
    
    	CALL DECLARE_CTRLC_AST
    
    	DO BULL_SEARCH = BULL_POINT+1, END_BULL, STEP_BULL
    	   CALL READDIR(BULL_SEARCH,IER)	! Get bulletin directory entry
    	   IF (IER.EQ.BULL_SEARCH+1) THEN
    	      CALL STR$UPCASE(DESCRIP,DESCRIP)	! Make upper case
    	      IF (INDEX(DESCRIP,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN
    		 CALL CLOSE_BULLFIL
    		 CALL CLOSE_BULLDIR
    		 CALL CANCEL_CTRLC_AST
    		 CALL ENABLE_CTRL
    		 BULL_POINT = BULL_SEARCH - 1
    		 CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin
    		 RETURN
    	      END IF
    	   END IF
    	   IF (IER.EQ.BULL_SEARCH+1.AND..NOT.SUBJECT) THEN
    	      IF (REMOTE_SET) THEN
    	         WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH
    	         IF (IER.GT.0) THEN
    	            CALL DISCONNECT_REMOTE
    		    GO TO 900
    	         ELSE
    	            CALL GET_REMOTE_MESSAGE(IER)
    		    IF (IER.GT.0) GO TO 900
    	         END IF
    	      END IF
    	      ILEN = LINE_LENGTH + 1
    	      DO WHILE (ILEN.GT.0)
    	         CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
    	         CALL STR$UPCASE(INPUT,INPUT)	! Make upper case
    		 IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN
    		    CALL CLOSE_BULLFIL
    		    CALL CLOSE_BULLDIR
    		    CALL CANCEL_CTRLC_AST
    		    CALL ENABLE_CTRL
    		    BULL_POINT = BULL_SEARCH - 1
    	            CALL READ(READ_COUNT,BULL_POINT+1) ! Read next bulletin
    		    RETURN
    		 ELSE IF (FLAG.EQ.1) THEN
    		    WRITE (6,'('' Search aborted.'')')
    		    CALL CLOSE_BULLFIL
    		    CALL CLOSE_BULLDIR
    		    CALL ENABLE_CTRL
    		    RETURN
    		 END IF
    	      END DO
    	   END IF
    	END DO
    
    900	CALL CANCEL_CTRLC_AST
    
    	CALL CLOSE_BULLFIL			! End of bulletin file read
    	CALL CLOSE_BULLDIR
    
    	CALL ENABLE_CTRL
    
    	WRITE (6,'('' No messages found with given search string.'')')
    
    	RETURN
    	END
    
    
    
    
    	SUBROUTINE UNDELETE
    C
    C  SUBROUTINE UNDELETE
    C
    C  FUNCTION: Undeletes deleted message.
    C
    	IMPLICIT INTEGER (A - Z)
    
    	COMMON /POINT/ BULL_POINT
    
    	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
    	CHARACTER*64 BULL_PARAMETER
    
    	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
    
    	INCLUDE 'bulldir.inc
    
    	INCLUDE 'bulluser.inc
    
    	INCLUDE 'bullfolder.inc
    
    	EXTERNAL CLI$_ABSENT
    
    C
    C  Get the bulletin number to be undeleted.
    C
    
    	IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
    	IF (IER.NE.%LOC(CLI$_ABSENT)) THEN	! Was bulletin specified?
    	   DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE	! Yes
    5	   FORMAT(I<LEN_P>)
    	ELSE IF (BULL_POINT.EQ.0) THEN	! No.  Have we just read a bulletin?
    	   GO TO 910			! No, then error.
    	ELSE
    	   BULL_DELETE = BULL_POINT	! Delete the file we are reading
    	END IF
    
    	IF (BULL_DELETE.LE.0) GO TO 920
    
    C
    C  Check to see if specified bulletin is present, and if the user
    C  is permitted to delete the bulletin.
    C
    
    	CALL OPEN_BULLDIR
    
    	CALL READDIR(BULL_DELETE,IER)	! Get info for specified bulletin
    
    	IF (IER.NE.BULL_DELETE+1) THEN	! Was bulletin found?
    	   WRITE(6,1030)	! If not, then error out
    	   GOTO 100
    	END IF
    
    	IF (USERNAME.NE.FROM) THEN	! If doesn't match owner of bulletin,
    	   IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR.    ! Privileges or
         &	       (.NOT.SETPRV_PRIV().AND.USERNAME.NE.FOLDER_OWNER
         &		.AND.FOLDER_SET)) THEN	! folder owner?
    	      WRITE(6,1040)		! Then error out.
    	      GO TO 100
    	   ELSE
    	      CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin
    	      IF (IER.NE.BULL_DELETE+1) THEN	! Was bulletin found?
    	         WRITE(6,1030)		! If not, then error out
    	         GOTO 100
    	      END IF
    	   END IF
    	END IF
    
    	IF (SYSTEM.LE.1) THEN		! General or System message
    	   EXDATE = EXDATE(:7)//'19'//EXDATE(10:)
    	ELSE				! Permanent or Shutdown
    	   IF (EXDATE(2:2).EQ.'-') THEN
    	      EXDATE = EXDATE(:6)//'20'//EXDATE(9:)
    	   ELSE
    	      EXDATE = EXDATE(:7)//'20'//EXDATE(10:)
    	   END IF
    	END IF
    
    	IF (.NOT.REMOTE_SET) THEN
    	   CALL WRITEDIR(BULL_DELETE,IER)	! Update message expiration date
    	   WRITE (6,'('' Message was undeleted.'')')
    	ELSE
    	   WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)
         &      11,BULL_DELETE,DESCRIP,EXDATE,EXTIME
    	   IF (IER.EQ.0) THEN
    	      READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM
    	   END IF
    	   IF (IER.EQ.0) THEN
    	      IF (I.NE.LEN(FOLDER1_COM)) THEN
    		 WRITE (6,'(1X,A)') FOLDER1_COM(:I)
    	      ELSE
    	         WRITE (6,'('' Message was undeleted.'')')
    	      END IF
    	   ELSE
    	      CALL DISCONNECT_REMOTE
    	   END IF
    	END IF
    
    100	CALL CLOSE_BULLDIR
    
    900	RETURN
    
    910	WRITE(6,1010)
    	GO TO 900
    
    920	WRITE(6,1020)
    	GO TO 900
    
    1010	FORMAT(' ERROR: You are not reading any message.')
    1020	FORMAT(' ERROR: Specified message number has incorrect format.')
    1030	FORMAT(' ERROR: Specified message was not found.')
    1040	FORMAT(' ERROR: Message was not undeleted. Not owned by you.')
    
    	END