C
C  BULLSUB3.FOR, Version 10/30/86
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 CLOSE_FILE(INPUT)
C
C  SUBROUTINE CLOSE_FILE
C
C  FUNCTION: To close out the bulletin files and enable CTRL-C & -Y
C
C  INPUT:
C	INPUT  -  Unit number of file to close out.
C	          1 = BULLETIN.DAT
C		  2 = BULLDIR.DAT
C		  4 = BULLUSER.DAT
C		  7 = BULLFOLDER.DAT
C		  8 = SYS$SYSTEM:SYSUAF.DAT
C

	CALL ENABLE_CTRL

	CLOSE (UNIT=INPUT)

	RETURN
	END


	SUBROUTINE CLOSE_FILE_DELETE(INPUT)

	IMPLICIT INTEGER (A-Z)

	CALL ENABLE_CTRL

	CLOSE (UNIT=INPUT,STATUS='DELETE')

	RETURN
	END


	SUBROUTINE OPEN_FILE(INPUT)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE '($FORIOSDEF)'

	INCLUDE '($PRVDEF)'

	EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR

	PARAMETER TIMEOUT = -10*1000*1000*30
	DIMENSION TIMEBUF(2)
	DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/

	IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN)

	CALL DISABLE_CTRL		! No breaks while file is open

	IF (INPUT.EQ.2) THEN
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,)
	   DO WHILE (FILE_LOCK(IER,IER1))
	    IF (FOLDER_SET) THEN
	      OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLDIR',STATUS='UNKNOWN',IOSTAT=IER,
     1	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED')
	    ELSE
	      OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='UNKNOWN',
     1	      IOSTAT=IER,
     1	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED')
	    END IF
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_BULLFILES
	    END IF
	   END DO
	END IF

	IF (INPUT.EQ.1) THEN
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,)
	   DO WHILE (FILE_LOCK(IER,IER1))
	    IF (FOLDER_SET) THEN
	      OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,
     1	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED')
	    ELSE
	      OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='UNKNOWN',
     1	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED',IOSTAT=IER)
	    END IF
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_BULLFILE
	    END IF
	   END DO
	END IF

	IF (INPUT.EQ.4) THEN
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,)
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
     1	     ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74,
     1	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     1	     KEY=(1:12:CHARACTER))
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
	     OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',
     1	      ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74,
     1	      FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     1	      KEY=(1:12:CHARACTER))
	     WRITE (4,FMT=USER_FMT) USER_HEADER,NEWEST_DATE,NEWEST_TIME,
     1	      BBOARD_DATE,BBOARD_TIME,0,0,PRV$M_OPER.OR.PRV$M_CMKRNL.OR.
     1	      PRV$M_SETPRV,0,0,0
	    ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	      IDUMMY = FILE_LOCK(IER,IER1)
	      CALL CONVERT_USERFILE
	    END IF
	   END DO
	END IF

	IF (INPUT.EQ.7) THEN
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR,)
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     1	     ACCESS='KEYED',RECORDTYPE='FIXED',
     1	     RECORDSIZE=FOLDER_RECORD,
     1	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     1	     KEY=(1:25:CHARACTER,26:29:INTEGER))
	   END DO
	   IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
	      FOLDER1 = 'GENERAL'
	      FOLDER1_OWNER = 'SYSTEM'
	      FOLDER1_DESCRIP = 'Default general bulletin folder.'
	      FOLDER1_BBOARD = 'NONE'
	      FOLDER1_BBEXPIRE = 14
	      OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN',
     1	        ACCESS='KEYED',RECORDTYPE='FIXED',
     1	        RECORDSIZE=FOLDER_RECORD,
     1	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     1	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	      WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER1)
     &		FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP
     &		,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB
	   END IF
	END IF

	IF (IER.NE.0) THEN
	   WRITE (6,'('' Cannot open unit = '',I)') INPUT
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
	   CALL SYS_GETMSG(IER1)
	   CALL ENABLE_CTRL_EXIT	! Enable CTRL-Y & -C & EXIT
	END IF

	IER = SYS$CANTIM(,)		! Successful, so cancel timer.

	RETURN
	END

	SUBROUTINE TIMER_ERR

	IMPLICIT INTEGER (A-Z)

	ENTRY BULLDIR_ERR
	WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')')
	GO TO 10

	ENTRY BULLETIN_ERR
	WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')')
	GO TO 10

	ENTRY BULLUSER_ERR
	WRITE(6,'('' ERROR: Unable to open BULLUSER.DAT after 30 secs.'')')
	GO TO 10

	ENTRY BULLFOLDER_ERR
	WRITE(6,'('' ERROR: Unable to open BULLFOLDER.DAT after 30 secs.'')')
	GO TO 10

10	CALL ENABLE_CTRL_EXIT		! No breaks while file is open
	END



	SUBROUTINE OPEN_FILE_SHARED(INPUT)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($FORIOSDEF)'

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'

	EXTERNAL LNM_MODE_EXEC

	CALL DISABLE_CTRL

	IF (INPUT.EQ.2) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    IF (FOLDER_SET) THEN
	      OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLDIR',STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',
     1	      SHARED,READONLY,IOSTAT=IER)
	    ELSE
	      OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',
     1	      SHARED,READONLY,IOSTAT=IER)
	    END IF
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_BULLFILES
	    END IF
	   END DO
	END IF

	IF (INPUT.EQ.1) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    IF (FOLDER_SET) THEN
	      OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLFIL',STATUS='OLD',
     1	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY)
	    ELSE
	      OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD',
     1	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY)
	    END IF
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_BULLFILE
	    END IF
	   END DO
	END IF

	IF (INPUT.EQ.4) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
     1	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74,IOSTAT=IER,
     1	    FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED,
     1	    KEY=(1:12:CHARACTER))
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_USERFILE
	    END IF
	   END DO
	END IF

	IF (INPUT.EQ.7) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     1	    ACCESS='KEYED',RECORDTYPE='FIXED',
     1	    RECORDSIZE=FOLDER_RECORD,IOSTAT=IER,
     1	    FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED,
     1	    KEY=(1:25:CHARACTER,26:29:INTEGER))
	   END DO
	END IF

	IF (INPUT.EQ.8) THEN
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT',
     &       ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,IOSTAT=IER,SHARED,
     &	     USEROPEN=LNM_MODE_EXEC)
	   END DO
	END IF

	IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.INPUT.NE.8) THEN
	   CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)
	   CALL OPEN_FILE(INPUT)
	   CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	ELSE IF (IER.NE.0) THEN
	   WRITE (6,'('' Cannot open unit = '',I)') INPUT
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
	   CALL SYS_GETMSG(IER1)
	   CALL ENABLE_CTRL_EXIT
	END IF

	RETURN
	END




	SUBROUTINE CONVERT_BULLFILES
C
C  SUBROUTINE CONVERT_BULLFILES
C
C  FUNCTION: Converts bulletin files to new format file.
C	Add expiration time to directory file, add extra byte to bulletin
C	file to show where each bulletin starts (for redunancy sake in
C	case crash occurs).
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLFILES.INC'

	CHARACTER*81 INPUT,NEW_FILE

	WRITE (6,'('' Converting data files to new format. Please wait.'')')

	IF (FOLDER_SET) THEN
	   OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLDIR',STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',
     1	      SHARED,READONLY,IOSTAT=IER)
	ELSE
	   EODIR = MAX(INDEX(BULLDIR_FILE,':'),INDEX(BULLDIR_FILE,']'))
	   SUFFIX = INDEX(BULLDIR_FILE(EODIR:),'.') + EODIR - 1
	   NEW_FILE = BULLDIR_FILE(:SUFFIX)//'OLD'
	   IER = LIB$RENAME_FILE(BULLDIR_FILE,NEW_FILE)
	   OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',
     1	      SHARED,READONLY,IOSTAT=IER)
	END IF

	IF (IER.NE.0) THEN				! Error.  Why?
	   CALL ERRSNS(IDUMMY,IER)
	   CALL SYS_GETMSG(IER)
	   CALL EXIT
	END IF

	IF (FOLDER_SET) THEN
	   OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLFIL',STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=80,
     1	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)
	ELSE
	   EODIR = MAX(INDEX(BULLETIN_FILE,':'),INDEX(BULLETIN_FILE,']'))
	   SUFFIX = INDEX(BULLETIN_FILE(EODIR:),'.') + EODIR - 1
	   NEW_FILE = BULLETIN_FILE(:SUFFIX)//'OLD'
	   IER = LIB$RENAME_FILE(BULLETIN_FILE,NEW_FILE)
	   OPEN (UNIT=10,FILE=NEW_FILE,STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=80,
     1	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)
	END IF

	IF (IER.NE.0) THEN				! Error.  Why?
	   CALL ERRSNS(IDUMMY,IER)
	   CALL SYS_GETMSG(IER)
	   CALL EXIT
	END IF

	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)

	IF (FOLDER_SET) THEN
	      OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLFIL',STATUS='NEW',IOSTAT=IER,
     1	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81,
     1	      FORM='FORMATTED')

	      OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLDIR',STATUS='NEW',
     1	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',
     1	      IOSTAT=IER)
	ELSE
	      OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='NEW',
     1	      RECORDTYPE='FIXED',RECORDSIZE=81,
     1	      FORM='FORMATTED',IOSTAT=IER)

	      OPEN (UNIT=2,FILE=BULLDIR_FILE,STATUS='NEW',
     1	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',
     1	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',
     1	      IOSTAT=IER)
	END IF

	NEWEST_EXTIME = '00:00:00'
	READ (9'1,1000,IOSTAT=IER) 
     &		NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME
	NEMPTY = 0
	IF (IER.EQ.0) CALL WRITEDIR(0,IER1)

	EXTIME = '00:00:00'
	ICOUNT = 2
	DO WHILE (IER.EQ.0)
	   READ(9'ICOUNT,1010,IOSTAT=IER)
     &		DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCK
	   IF (IER.EQ.0) THEN
	      READ(10,'(A)') INPUT
	      WRITE(1,'(A)') INPUT(1:80)//CHAR(1)
	      DO I=2,LENGTH
	         READ(10,'(A)') INPUT
	         WRITE(1,'(A)') INPUT
	      END DO
	      CALL WRITEDIR(ICOUNT-1,IER1)
	      ICOUNT = ICOUNT + 1
	   END IF
	END DO

	CLOSE (UNIT=9)
	CLOSE (UNIT=2)
	CLOSE (UNIT=10)
	CLOSE (UNIT=1)

	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	RETURN

1000	FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)
1010	FORMAT(A53,A12,A11,A8,A4,A11,A4,A4)

	END

	SUBROUTINE CONVERT_BULLFILE
C
C  SUBROUTINE CONVERT_BULLFILE
C
C  FUNCTION: Converts bulletin data file to new format file.
C
C  NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length.
C	 This converts from 81 byte length to 128 compressed format.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLFILES.INC'

	CHARACTER*80 INPUT,NEW_FILE

	WRITE (6,'('' Converting data files to new format. Please wait.'')')

	CALL CLOSE_FILE(2)

	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)

	CALL OPEN_FILE(7)

100	DO WHILE (REC_LOCK(IER))
	   READ (7,FMT=FOLDER_FMT,ERR=200)
     &		FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
	END DO

	IF (FOLDER_NUMBER.GT.0) THEN
	   FOLDER_SET = .TRUE.
	   FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER(:TRIM(FOLDER))
	   NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD'
	   OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'
     1	      ,STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT',
     1	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)
	ELSE
	   FOLDER_SET = .FALSE.
	   EODIR = MAX(INDEX(BULLETIN_FILE,':'),INDEX(BULLETIN_FILE,']'))
	   SUFFIX = INDEX(BULLETIN_FILE(EODIR:),'.') + EODIR - 1
	   NEW_FILE = BULLETIN_FILE(:SUFFIX)//'OLD'
	   IER = LIB$RENAME_FILE(BULLETIN_FILE,NEW_FILE)
	   OPEN (UNIT=10,FILE=NEW_FILE,STATUS='OLD',
     1	      RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT',
     1	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)
	END IF

	IF (IER.NE.0) THEN				! Error.  Why?
	   CALL ERRSNS(IDUMMY,IER)
	   CALL SYS_GETMSG(IER)
	   CALL EXIT
	END IF

	IF (FOLDER_NUMBER.GT.0) THEN
	   OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	      //'.BULLFIL',STATUS='NEW',IOSTAT=IER,
     1	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED')
	   IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))
     &		//'.BULLFIL;-1',NEW_FILE)
	ELSE
	   OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='NEW',
     1	   ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     1	   FORM='UNFORMATTED',IOSTAT=IER)
	END IF

	CALL OPEN_FILE(2)

	CALL READDIR(0,IER)

	IF (IER.EQ.1) THEN
	 NBLOCK = 0
	 DO I=1,NBULL
	   CALL READDIR(I,IER)
	   NBLOCK = NBLOCK + 1
	   SBLOCK = NBLOCK
	   DO J=BLOCK,LENGTH+BLOCK-1
	      READ(10'J,'(A)') INPUT
	      LEN = TRIM(INPUT)
	      IF (LEN.EQ.0) LEN = 1
	      CALL STORE_BULL(LEN,INPUT,NBLOCK)
	   END DO
	   CALL FLUSH_BULL(NBLOCK)
	   LENGTH = NBLOCK - SBLOCK + 1
	   BLOCK = SBLOCK
	   CALL WRITEDIR(I,IER)
	 END DO

	 NEMPTY = 0
	 CALL WRITEDIR(0,IER)
	END IF

	CLOSE (UNIT=10)
	CLOSE (UNIT=1)

	CALL CLOSE_FILE(2)
	GOTO 100

200	CALL OPEN_FILE_SHARED(2)

	FOLDER_SET = .FALSE.

	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection

	RETURN

	END

	SUBROUTINE CONVERT_USERFILE
C
C  SUBROUTINE CONVERT_USERFILE
C
C  FUNCTION: Converts user file to new format which has 8 bytes added.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFILES.INC'

	CHARACTER BUFFER*74,NEW_FILE*80
	DIMENSION ADD_USER(6)
	DATA ADD_USER/0,0,2*ZFFFFFFFF,2*0/

	WRITE (6,'('' Converting data files to new format. Please wait.'')')

	EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']')) 
	SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1
	NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'r
	IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE)

	RECL = 42
	IER = 1
	DO WHILE (IER.NE.0.AND.RECL.NE.74)I
	   RECL = RECL + 8T
	   OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',
     1	     ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=RECL,
     1	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,T
     1	     KEY=(1:12:CHARACTER))4
	END DOE

	IF (IER.EQ.0) THENL
	   CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)E
	   OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',P
     1	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=74,IOSTAT=IER,
     1	    FORM='FORMATTED',ORGANIZATION='INDEXED',L
     1	    KEY=(1:12:CHARACTER))
	END IFC

	IF (IER.NE.0) THEN
	   WRITE (6,'('' Cannot convert user file.'')')
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)'
	   CALL SYS_GETMSG(IER1)L
	   CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	   CALL ENABLE_CTRL_EXITD
	END IFT

	IF (RECL.LE.58) RECL = 50
	ADD_WORD = (74-RECL)/4I
	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (9,'(A<RECL>)',IOSTAT=IER) BUFFER
	   IF (IER.EQ.0) WRITE (4,'(A<RECL>,<ADD_WORD>A4)')
     &			BUFFER,(ADD_USER(I),I=7-ADD_WORD,6)
	END DO 

	IER = 0

	CLOSE (UNIT=9)
	CLOSE (UNIT=4)E

	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection)

	RETURN 
	END


	SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT)
C 
C  SUBROUTINE READDIR,
CO
C  FUNCTION: Finds the entry for the specified bulletin in the
C	directory file and returns the information for that entry.
CI
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1.,
C			 If 0, gives header info, i.e number of bulls,
C			 number of blocks in bulletin file, etc.
C  OUTPUTS:E
C	ICOUNT  -  The last record read by this routine.
CE

	IMPLICIT INTEGER (A - Z) 

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'T

	COMMON /PROMPT/ COMMAND_PROMPTO
	CHARACTER*39 COMMAND_PROMPT

	CHARACTER*2 CFOLDER_NUMBERA

	ICOUNT = BULLETIN_NUM

	IF (ICOUNT.EQ.0) THEN
	   DO WHILE (REC_LOCK(IER))
	    READ (2'1,1000,IOSTAT=IER) 
     &		NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY
	   END DO
	   IF (IER.EQ.0) THEN
	      IF (NBULL.LT.0) THEN	! This indicates bulletin deletion
					! was incomplete.
		 CALL CLOSE_FILE(2) 
		 CALL OPEN_FILE(2)
		 CALL CLEANUP_DIRFILE(1)
	      END IF 
	      IF (NEMPTY.EQ.'    ') NEMPTY = 0E
CI
C  Check to see if cleanup of empty file space is necessary, which isK
C  defined here as being 50 blocks (200 128byte records).  Also checkE
C  to see if cleanup was in progress but didn't properly finish.
CT
	      IF (NEMPTY.GT.200) THEN
		 WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER
	         IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX('
     &		  COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER,
     &		  'NL:','NL:',1,'BULL_CLEANUP') 
	      ELSE IF (NEMPTY.EQ.-1) THEN
		 CALL CLEANUP_BULLFILE
	      END IF 
	   END IF
	ELSE=
	   DO WHILE (REC_LOCK(IER))
	    READ(2'ICOUNT+1,1010,IOSTAT=IER)Y
     &	     DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK
	   END DO
	END IF,

	IF (IER.EQ.0) ICOUNT = ICOUNT + 1

	RETURN 

1000	FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)I
1010	FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4)0

	END


	SUBROUTINE WRITEDIR(BULLETIN_NUM,IER)
CT
C  SUBROUTINE WRITEDIR
CE
C  FUNCTION: Writes the entry for the specified bulletin in the
C	directory file.R
CS
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1.E
C			 If 0, write the header of the directory file.
C  OUTPUTS:
C	IER - Error status from WRITE.
C 

	IMPLICIT INTEGER (A - Z)E

	INCLUDE 'BULLDIR.INC'
	 
	IF (BULLETIN_NUM.EQ.0) THEN
	   WRITE (2'1,1000,IOSTAT=IER) NEWEST_EXDATE,NEWEST_EXTIME,
     &	    NEWEST_DATE,NEWEST_TIME,D
     &	    NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY 
	ELSE
	   WRITE(2'BULLETIN_NUM+1,1010,IOSTAT=IER) 
     &	    DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK1
	END IF=

	RETURNe

1000	FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4) 
1010	FORMAT(A53,A12,A11,A8,A4,A11,A8,A4,A4)O

	END


	SUBROUTINE TRUNCATE_FILE(TRUNC_SIZE)

	IMPLICIT INTEGER (A-Z)D

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'R

	COMMON /USER_OPEN/ CHANNEL,STATUS,SIZEA

	EXTERNAL USER_OPEN$TRUNCATE

	CALL DISABLE_CTRL

	DO WHILE (FILE_LOCK(IER,IER1)) 
	   IF (FOLDER_SET) THEN
	      OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))I
     1	      //'.BULLFIL',STATUS='OLD',I
     1	      INITIALSIZE=TRUNC_SIZE,USEROPEN=USER_OPEN$TRUNCATE,
     1	      RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED',IOSTAT=IER)M
	   ELSE
	      OPEN (UNIT=1,FILE=BULLETIN_FILE,STATUS='OLD',
     1	      INITIALSIZE=TRUNC_SIZE,USEROPEN=USER_OPEN$TRUNCATE,
     1	      RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED',IOSTAT=IER) 
	   END IF
	END DOD

	CLOSE (1)
	CALL ENABLE_CTRLl

	RETURNi

	END


	SUBROUTINE UPDATE_LOGIN(ADD_BULL)
CT
C  SUBROUTINE UPDATE_LOGIN
C 
C  FUNCTION:  Updates the login file when a bulletin has been deletedE
C	or added._
C
	IMPLICIT INTEGER (A - Z)l

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'W

	INCLUDE '($BRKDEF)'

	CHARACTER*11 TEMP_DATEt
	CHARACTER*8 TEMP_TIME
	CHARACTER READ_DATE_SAVE*12,READ_TIME_SAVE*8h

	CHARACTER*160 OUTPUT
	CHARACTER*1 CR/13/,LF/10/,BELL/7/

	DIMENSION SAVE_NEW_FLAG(2)

CI
C  We want to keep the last read date for comparison when selecting newR
C  folders, so save it for later restoring.I
CL

	READ_DATE_SAVE = READ_DATE
	READ_TIME_SAVE = READ_TIME,

	CALL OPEN_FILE_SHARED(4)T

C
C  Newest date/time in user file only applies to general bulletins. 
C  This was present before adding folder capability.
C  We set flags in user entry to show new folder added for folder bulletins.
C  However, the newest bulletin for each folder is not continually updated,)
C  As it is only used when comparing to the last bulletin read time, and to 
C  store this for each folder would be too expensive.
C 

	DO WHILE (REC_LOCK(IER))V
	   READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)
     &		TEMP_USER,TEMP_DATE,TEMP_TIME,BBOARD_DATE,BBOARD_TIME_
     &	        ,SET_FLAG,NEW_FLAG,NOTIFY_FLAGR
	END DO 

	IF (IER.NE.0) THENF
	   CALL CLOSE_FILE(4)
	   RETURN
	ELSE IF (FOLDER_NUMBER.EQ.0) THEN
	   REWRITE (4,FMT=USER_FMT)
     & 		TEMP_USER,NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME
     &	        ,SET_FLAG,NEW_FLAG,NOTIFY_FLAG,
	END IFL

C
C  Set flags in all user entries that have SET READNEW on the particular
C  folder to indicate that a new bulletin is present for the particular folder.=
C  Also send broadcast if notify flag set.
C 
	OUTPUT = BELL//CR//LF//LF//'New bulletin added to folder '// 
     &	 FOLDER(1:TRIM(FOLDER))//'. From: '//FROM(1:TRIM(FROM))//
     &   CR//LF//'Description: '//DESCRIP(1:TRIM(DESCRIP))

	IF (.NOT.ADD_BULL) THEN
	   SAVE_NEW_FLAG(1) = NEW_FLAG(1)
	   SAVE_NEW_FLAG(2) = NEW_FLAG(2)
	END IF

	F_POINT = FOLDER_NUMBER/32 + 1)
	IER = 0
	DO WHILE (IER.EQ.0)
	   DO WHILE (REC_LOCK(IER))
	    READ (4,FMT=USER_FMT,IOSTAT=IER) TEMP_USER,
     &	     LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG
     &	     ,NOTIFY_FLAG
	   END DO
	   SAVE_FLAG = NEW_FLAG(F_POINT)
 	   IF ((IER.EQ.0).AND.(TEMP_USER.NE.FROM.OR..NOT.ADD_BULL)) THEN
	      IF (ADD_BULL) THENO
  	       NEW_FLAG(F_POINT) = IBSET(NEW_FLAG(F_POINT),FOLDER_NUMBER)
	       IF (BTEST(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER)) THEN 
	         CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR,TEMP_USER,O
     &		   %VAL(BRK$C_USERNAME),,,,,,,)=
	       END IF
	      ELSEE
	       DIFF = COMPARE_DATE(NEWEST_DATE,READ_DATE)
	       IF (DIFF.EQ.0) DIFF = COMPARE_TIME(NEWEST_TIME,READ_TIME)I
	       IF (DIFF.LT.0) THEN 
		  NEW_FLAG(F_POINT) =F
     &			IBCLR(NEW_FLAG(F_POINT),FOLDER_NUMBER) 
		  IF (TEMP_USER.EQ.USERNAME) THENO
		     SAVE_NEW_FLAG(F_POINT) = NEW_FLAG(F_POINT)E
		  END IF
	       END IF
	      END IFR
	      IF (SAVE_FLAG.NE.NEW_FLAG(F_POINT)) THEN 
	         REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_DATE,
     &	          LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAGR
     &	         ,NOTIFY_FLAG
	      END IFE
	   END IF
	END DOS

	NEW_FLAG(1) = SAVE_NEW_FLAG(1)e
	NEW_FLAG(2) = SAVE_NEW_FLAG(2)E

	DO WHILE (REC_LOCK(IER))a
	   READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,S
     &	     LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAGE
     &	     ,NOTIFY_FLAG	! Reobtain present owner's values
				! as calling programs still uses them
	END DON

	READ_DATE = READ_DATE_SAVEt
	READ_TIME = READ_TIME_SAVEi

	CALL CLOSE_FILE(4)y

	RETURNe

	END




 i
	SUBROUTINE ADD_ENTRYe
Cc
C  SUBROUTINE ADD_ENTRYd
Cn
C  FUNCTION: Enters a new directory entry in the directory file.
C
	IMPLICIT INTEGER (A - Z)I
	U
	INCLUDE 'BULLDIR.INC'
	C
	CHARACTER*23 TODAY_TIME

	CALL SYS$ASCTIM(,TODAY_TIME,,)E
	DATE = TODAY_TIME(1:11)
	TIME = TODAY_TIME(13:20)w

	CALL READDIR(0,IER)

	IF (IER.NE.1) THEN(
	   NEWEST_EXDATE = '5-NOV-2000'
	   NEWEST_EXTIME = '00:00:00'
	   NBULL = 0L
	   NBLOCK = 0
	   SHUTDOWN = 0
	   NEMPTY = 0
	END IF=

	NEWEST_DATE = DATE 
	NEWEST_TIME = TIMEV

	DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)
	IF (DIFF.GT.0) THEN
	   NEWEST_EXDATE = EXDATE
	   NEWEST_EXTIME = EXTIME
	ELSE IF (DIFF.EQ.0) THEN)
	   DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)+
	   IF (DIFF.GT.0) NEWEST_EXTIME = EXTIMEF
	END IFD

	NBULL = NBULL + 1
	BLOCK = NBLOCK + 1N
	NBLOCK = NBLOCK + LENGTHF

	IF ((SYSTEM.AND.4).EQ.4) THEN
	   SHUTDOWN = SHUTDOWN + 1O
	   SHUTDOWN_DATE = DATE
	   SHUTDOWN_TIME = TIME
	END IFT

	CALL UPDATE_LOGIN(.TRUE.)

	CALL WRITEDIR(NBULL,IER),

	CALL WRITEDIR(0,IER)D

	RETURN 
	END




 	
	INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)
C 
C  FUNCTION COMPARE_DATE
CA
C  FUCTION: Compares dates to see which is farther in future.,
CE
C  INPUTS:
C	DATE1  -  First date  (dd-mm-yy)
C	DATE2  -  Second date (If is equal to ' ', then use present date)I
C  OUTPUT:
C	Returns the difference in days between the two dates.E
C	If the DATE1 is farther in the future, the output is positive,
C	else it is negative.
CB
	IMPLICIT INTEGER (A - Z) 

	CHARACTER*(*) DATE1,DATE2
	INTEGER USER_TIME(2)L

	CALL SYS$BINTIM(DATE1,USER_TIME)N
	CALL LIB$DAY(DAY1,USER_TIME)T

	IF (DATE2.NE.' ') THENL
	   CALL SYS$BINTIM(DATE2,USER_TIME)
	ELSEI
	   CALL SYS$GETTIM(USER_TIME)
	END IFT

	CALL LIB$DAY(DAY2,USER_TIME)

	COMPARE_DATE = DAY1 - DAY2r

	RETURN
	END




	INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2) 
CL
C  FUNCTION COMPARE_TIME
C$
C  FUCTION: Compares times to see which is farther in future.M
CE
C  INPUTS:
C	TIME1  -  First time	(hh:mm:ss)E
C	TIME2  -  Second timeI
C  OUTPUT:
C	Outputs (TIME1-TIME2) in seconds.  Thus, if TIME1 is further
C	in the future, outputs positive number, else negative.
C,

	IMPLICIT INTEGER (A-Z) 
	CHARACTER*(*) TIME1,TIME2
	CHARACTER*23 TODAY_TIME
	CHARACTER*8 TEMP2

	IF (TIME2.EQ.' ') THENL
	   CALL SYS$ASCTIM(,TODAY_TIME,,)
	   TEMP2 = TODAY_TIME(13:20)5
	ELSE=
	   TEMP2 = TIME2 
	END IFN

	COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1))) 
     &		         +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2)))
     &		        +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4)))
     &		           +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5)))
     &		           +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7)))
     &		              +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8)))

	RETURNT
	END

C-------------------------------------------------------------------------
CX
C  The following are subroutines to create a linked-list queue for T
C  temporary buffer storage of data that is read from files to beD
C  outputted to the terminal.  This is done so as to be able to close
C  the file as soon as possible.
C
C  Each record in the queue has the following format.  The first two
C  words are used for creating a character variable.  The first word
C  contains the length of the character variable, the second contains(
C  the address.  The address is simply the address of the 3rd word ofT
C  the record.  The last word in the record contains the address of the 
C  next record.  Every time a record is written, if that record has aO
C  zero link, it adds a new record for the next write operation. P
C  Therefore, there will always be an extra record in the queue.  To
C  check for the end of the queue, the last word (link to next record)
C  is checked to see if it is zero. 
C
C-------------------------------------------------------------------------
	SUBROUTINE INIT_QUEUE(HEADER,DATA):
	CHARACTER*(*) DATAn
	IF (HEADER.NE.0) RETURN		! Queue already initialized 
	LENGTH = LEN(DATA) 
	CALL LIB$GET_VM(LENGTH+12,HEADER)
	CALL MAKE_CHAR(%VAL(HEADER),LENGTH)
	RETURNC
	END


	SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA)
	INTEGER RECORD(1)
	CHARACTER*(*) DATA,
	LENGTH = LEN(DATA)f
	CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))L
	NEXT = RECORD((LENGTH+12)/4)P
	IF (NEXT.NE.0) RETURN
	CALL LIB$GET_VM(LENGTH+12,NEXT)
	CALL MAKE_CHAR(%VAL(NEXT),LENGTH)
	RECORD((LENGTH+12)/4) = NEXT(
	RETURNI
	END

	SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA)
	CHARACTER*(*) DATAR
	INTEGER RECORD(1)
	LENGTH = LEN(DATA)L
	CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA)
	NEXT = RECORD((LENGTH+12)/4)G
	RETURN
	END

	SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR)
	CHARACTER*(*) INCHAR,OUTCHAR)
	OUTCHAR = INCHAR(:LENGTH)
	RETURN
	END

	SUBROUTINE MAKE_CHAR(IARRAY,LEN)E
	DIMENSION IARRAY(1)
	IARRAY(1) = LEN
	IARRAY(2) = %LOC(IARRAY(3))
	IARRAY(LEN/4+3) = 0
	RETURN,
	END



	SUBROUTINE DISABLE_PRIVS=
CX
C  SUBROUTINE DISABLE_PRIVSE
C,
C  FUNCTION: Disable SYSPRV privileges.R
CA

	IMPLICIT INTEGER (A-Z) 

	INCLUDE '($PRVDEF)'

	COMMON /PRIVS/ SETPRV
	DIMENSION SETPRV(2)

	SETPRV(1) = 0
	SETPRV(1) = IBSET(SETPRV(1),PRV$V_SYSPRV)
	SETPRV(1) = IBSET(SETPRV(1),PRV$V_WORLD)E
	SETPRV(1) = IBSET(SETPRV(1),PRV$V_OPER)

	CALL SYS$SETPRV(%VAL(0),SETPRV,,)	! Disable SYSPRV 

	RETURN'
	END



	SUBROUTINE ENABLE_PRIVS
CE
C  SUBROUTINE ENABLE_PRIVS
C 
C  FUNCTION: Enable SYSPRV privileges.
CE

	IMPLICIT INTEGER (A-Z)I

	COMMON /PRIVS/ SETPRV
	DIMENSION SETPRV(2)

	CALL SYS$SETPRV(%VAL(1),SETPRV,,)	! Enable SYSPRV E

	RETURNI
	END



	SUBROUTINE CHECK_PRIV_IO(ERROR)
CN
C  SUBROUTINE CHECK_PRIV_IOF
CE
C  FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need
C	privileges to output to.
CT

	IMPLICIT INTEGER (A-Z)

	CALL DISABLE_PRIVS			! Disable SYSPRV  

	OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW')
	CLOSE (UNIT=6,STATUS='DELETE')

	OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW')
	IF (IER.NE.0.OR.IER1.NE.0) THEN
	   IF (IER1.EQ.0) WRITE (4,100)
	   IF (IER.EQ.0) WRITE (6,200)I
	   ERROR = 1N
	ELSE)
	   CLOSE (UNIT=4,STATUS='DELETE')
	   ERROR = 0 
	END IF0

	CALL ENABLE_PRIVS			! Enable SYSPRV 

100	FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.')
200	FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')U

	RETURNL
	END


	SUBROUTINE CHANGE_FLAG(CMD,FLAG)1
C 
C  SUBROUTINE CHANGE_FLAGP
CN
C  FUNCTION: Sets flags for specified folder.
C 
C  INPUTS:
C	CMD    -   LOGICAL*4 value. If TRUE, set flag. I
C		   If FALSE, clear flag.E
C	FLAG	-  If 1, modify SET_FLAG, if 2, modify NEW_FLAG
C		   If 3, modify NOTIFY_FLAG
CL
	IMPLICIT INTEGER (A - Z)

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFOLDER.INC'E

	DIMENSION FLAGS(2,3)p
	EQUIVALENCE (SET_FLAG(1),FLAGS(1,1))O

	LOGICAL CMD

	CHARACTER*23 TODAYN
	CHARACTER READ_DATE_SAVE*12,READ_TIME_SAVE*8s

Cl
C  Find user entry in BULLUSER.DAT to update information.N
CE

	CALL OPEN_FILE_SHARED(4)		! Open user fileT

	READ_DATE_SAVE = READ_DATEN
	READ_TIME_SAVE = READ_TIMES

	DO WHILE (REC_LOCK(IER))		! Read old entrye
	 READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME,R
     &	  LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG
     &	  ,NOTIFY_FLAGI
	END DO+

	F_POINT = FOLDER_NUMBER/32 + 1L

	IF (IER.GT.0) THEN 		! No entry (how did this happen??)
	   CALL SYS$ASCTIM(,TODAY,,)
	   READ_DATE = ' 5-NOV-1956'	! No entry, so make new one
	   READ_TIME = '11:05:56'	! Fake a read date. Set to the past.'
	   READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) TEMP_USER
     &	     NEWEST_DATE,NEWEST_TIME,BBOARD_DATE,BBOARD_TIME,SET_FLAG,R
     &	     NEW_FLAG,NOTIFY_FLAG
	   IF (CMD) THENS
	      FLAGS(F_POINT,FLAG) = O
     &		IBSET(FLAGS(F_POINT,FLAG),FOLDER_NUMBER)
	   ELSE
	      FLAGS(F_POINT,FLAG) = S
     &		IBCLR(FLAGS(F_POINT,FLAG),FOLDER_NUMBER)
	   END IF
	   WRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,TODAY(1:11),,
     &	    TODAY(13:20),READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG 
	ELSE.
	   IF (CMD) THEN 
	      FLAGS(F_POINT,FLAG) = e
     &		IBSET(FLAGS(F_POINT,FLAG),FOLDER_NUMBER)
	   ELSE
	      FLAGS(F_POINT,FLAG) = S
     &		IBCLR(FLAGS(F_POINT,FLAG),FOLDER_NUMBER)
	   END IF
	   REWRITE (4,FMT=USER_FMT,IOSTAT=IER) USERNAME,R
     &	     LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAGE
     &	     ,NOTIFY_FLAG		! Write modified entry
	   READ_DATE = READ_DATE_SAVE
	   READ_TIME = READ_TIME_SAVE
	END IF7

	CALL CLOSE_FILE (4)
	RETURN0

	END





	SUBROUTINE CONFIRM_PRIV(USERNAME,ALLOW)
CU
C  SUBROUTINE CONFIRM_PRIV
Co
C  FUNCTION: Confirms that given username has SETPRV.L
CN
C  INPUTS:
C	USERNAME  -  UsernameI
C  OUTPUTS:N
C  	ALLOW     -  Returns 1 if account has SETPRV.n
C		     returns 0 if account has no SETPRV.a
Cn

	IMPLICIT INTEGER (A-Z)P

	CHARACTER*(*) USERNAMEl

	INCLUDE '($PRVDEF)'

	PARAMETER UAF$Q_DEF_PRIV = '1A4'X

	LOGICAL*1 UAF(0:583)	
	EQUIVALENCE (UAF(UAF$Q_DEF_PRIV),UAF_DEF_PRIV)U

	CALL OPEN_FILE_SHARED(8)e
	ALLOW = 0					! Set return falseI
	READ (8,KEY=USERNAME,IOSTAT=STATUS) UAF		! Read RecordC
	IF (STATUS.EQ.0) THEN				! If username foundA
	   IF (BTEST(UAF_DEF_PRIV,PRV$V_SETPRV).OR.	! SETPRV or CMRKNLN
     &	       BTEST(UAF_DEF_PRIV,PRV$V_CMKRNL)) THEN	! privileges?
	      ALLOW = 1					! Yep
	   END IF
	END IFI
	CALL CLOSE_FILE(8)E
	RETURN						! ReturnE
	END						! EndM



	INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT,ACCESS)T

	IMPLICIT INTEGER (A-Z) 

	CHARACTER*(*) INPUT,OUTPUTN

        PARAMETER LNM$_STRING = '2'X

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT))
	CALL END_ITMLST(TRNLNM_ITMLST)	! Get address of itemlist 

	SYS_TRNLNM = SYS$TRNLNM(,'LNM$PROCESS',INPUT,ACCESS,i
     &		%VAL(TRNLNM_ITMLST))

	RETURNs
	END



	INTEGER FUNCTION FILE_LOCK(IER,IER1)E

	IMPLICIT INTEGER (A-Z)i

	INCLUDE '($RMSDEF)'

	DATA INIT /.TRUE./ 

	IF (INIT) THEN0
	   FILE_LOCK = 1F
	   INIT = .FALSE.
	ELSE_
	   IF (IER.GT.0) THEN
	      CALL ERRSNS(IDUMMY,IER1)I
	      IF (IER1.EQ.RMS$_FLK) THEN'
	         FILE_LOCK = 1R
	      ELSE 
	         FILE_LOCK = 0_
	         INIT = .TRUE.F
	      END IF 
	   ELSE
	      FILE_LOCK = 0
	      IER1 = 0 
	      INIT = .TRUE.
	   END IF
	END IFR

	RETURNA
	END



	SUBROUTINE ENABLE_CTRL&

	IMPLICIT INTEGER (A-Z)E

	COMMON /CTRLY/ CTRLYT

	COMMON /CTRL_LEVEL/ LEVEL

	QUIT = 1E

	ENTRY ENABLE_CTRL_EXIT

	QUIT = QUIT.AND.1		! If called via entry, QUIT = 04
	LEVEL = LEVEL - 1

	IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN
	   WRITE (6,'('' ERROR: Error in CTRL.'')')
	END IFT

	IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN
	   CALL LIB$ENABLE_CTRL(CTRLY,)	! Enable CTRL-Y & -Cr
	END IF

	IF (QUIT.EQ.0) CALL EXITM
	QUIT = 0			! Reinitialize

	RETURN
	END


	SUBROUTINE DISABLE_CTRL

	IMPLICIT INTEGER (A-Z)

	COMMON /CTRLY/ CTRLYo

	COMMON /CTRL_LEVEL/ LEVEL
	DATA LEVEL /0/I

	IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,)
	LEVEL = LEVEL + 1

	RETURNT
	END




	SUBROUTINE CLEANUP_BULLFILE
CN
C  SUBROUTINE CLEANUP_BULLFILE
C 
C  FUNCTION:  Searches for empty space in bulletin file and deletes it.R
C(
	IMPLICIT INTEGER (A - Z)T

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'I

	CHARACTER FILENAME*132,INPUT*128A

	CALL OPEN_FILE(2)

	CALL READDIR(0,IER)

	IF (FOLDER_SET) THENO
	   FILENAME = FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL'I
	ELSEE
	   FILENAME = BULLETIN_FILE
	END IF

	IF (NEMPTY.GT.0) THEN

	 IER = LIB$RENAME_FILE(FILENAME,FILENAME(1:TRIM(FILENAME))//';2')
				! Old file name to version number 2L

	 IF (.NOT.IER) RETURN

	 OPEN (UNIT=11,FILE=FILENAME(1:TRIM(FILENAME))//';1',
     1	      STATUS='UNKNOWN',IOSTAT=IER,'
     1	      RECORDTYPE='FIXED',RECORDSIZE=32,
     1	      FORM='UNFORMATTED')
				! Compressed version is number 1

	 CALL OPEN_FILE(1)			! Open bulletin file

	 NBLOCK = 0

	 DO I=1,NBULL				! Copy bulletins to new file
	   CALL READDIR(I,IER) 
	   ICOUNT = BLOCK
	   DO J=1,LENGTHE
	      NBLOCK = NBLOCK + 1
	      READ(1'ICOUNT) INPUTI
	      WRITE(11) INPUT
	      ICOUNT = ICOUNT + 1
	   END DO
	 END DO

	 CALL CLOSE_FILE(1)
	 CLOSE (UNIT=11)R

	 NEMPTY = -1		! Copying done, but not directory updating.
	 CALL WRITEDIR(0,IER)
	END IFT

	IER = LIB$DELETE_FILE(FILENAME(1:TRIM(FILENAME))//';2')
				! Can safely delete old file, since NEMPTY = -1I

	NBLOCK = 0		! Update directory entry pointers
	DO I=1,NBULLL
	   CALL READDIR(I,IER)'
	   BLOCK = NBLOCK + 1
	   CALL WRITEDIR(I,IER)
	   NBLOCK = NBLOCK + LENGTH
	END DO*

	READ (2'1,1000,IOSTAT=IER)	! Read directory headerT
     &		NEWEST_EXDATE,NEWEST_EXTIME,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME,NEMPTY
		! NOTE: Can't use READDIR since it'll call CLEANUP_BULLFILE

	NEMPTY = 0 
	CALL WRITEDIR(0,IER)		! Update header to show no empty spaces

	CALL CLOSE_FILE(2)s

1000	FORMAT(A11,A8,A11,A8,A4,A4,A4,A11,A8,A4)b

	RETURN
	END




	SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)W
Ce
C  SUBROUTINE CLEANUP_DIRFILEe
Co
C  FUNCTION:  Reorder directory file after deletions.t
C	      Is called either directly after a deletion, or isA
C	      called if it is detected that a deletion was not fully
C	      completed due to the fact that the deleting processe
C	      was abnormally terminated.
C 
	IMPLICIT INTEGER (A - Z)U

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLDIR.INC'

	NBULL = -NBULL		! Negative # Bulls signals deletion in progress
	MOVE_TO = 0		! Moving directory entries starting here
	MOVE_FROM = 0		! Moving directory entries from here
	I = DELETE_ENTRY	! Start search point for first deleted entries
	DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)
	   CALL READDIR(I,IER)N
	   IF (IER.NE.I+1) THEN	! Have we found a deleted entry?s
	      MOVE_TO = I	! If so, start moving entries to here
	      J=I+1		! Search for next entry in filef
	      DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)t
		 CALL READDIR(J,IER)
		 IF (IER.EQ.J+1) MOVE_FROM = J
		 J = J + 1
	      END DO 
	      IF (MOVE_FROM.EQ.0) THEN	! There are no more entriesM
		 NBULL = I - 1		! so just update number of bulletins
		 CALL WRITEDIR(0,IER)_
		 RETURN
	      END IFA
	      LENGTH = -LENGTH		! Indicate starting point by writing
	      CALL WRITEDIR(I,IER)	! next entry into deleted entryR
	      FIRST_DELETE = I		! with negative length4
	      MOVE_FROM = MOVE_FROM + 1	! Set up pointers to move rest of
	      MOVE_TO = MOVE_TO + 1	! the entries
	   ELSE IF (LENGTH.LT.0) THEN	! If negative length found, deletionT
	      FIRST_DELETE = I		! was previously in progressA
	      J = I			! Try to find where entry came from
	      DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)D
		 BLOCK_SAVE = BLOCK(
		 K = J + 1		! Search for duplicate entries
		 DO WHILE (MOVE_FROM.EQ.0.AND.K.LE.NBULL)(
		    CALL READDIR(K,IER) 
		    IF (IER.EQ.K+1) THEN
		       IF (BLOCK_SAVE.EQ.BLOCK) THEN
			  MOVE_TO=J+1
			  MOVE_FROM=K+1
		       ELSE
			  K = K + 1
		       END IFP
		    END IF
		 END DO_
		 J = J + 1		! If no duplicate entry found for this
		 CALL READDIR(J,IER)	! entry, see if one exists for any
	      END DO			! of the other entries
	   END IF
	   I = I + 1 
	END DOG

	IF (I.LE.NBULL) THEN		! Move reset of entries if necessaryI
	   IF (MOVE_FROM.GT.0) THEN
	      DO J=MOVE_FROM,NBULL 
	         CALL READDIR(J,IER)N
		 IF (IER.EQ.J+1) THEN	! Skip any other deleted entries
		    CALL WRITEDIR(MOVE_TO,IER)
		    MOVE_TO = MOVE_TO + 1
		 END IF
	      END DOW
	   END IF
	   DO J=MOVE_TO,NBULL		! Delete empty records at end of file 
	      DELETE(UNIT=2,REC=J+1,IOSTAT=IER)
	   END DO
	   NBULL = MOVE_TO - 1		! Update # bulletin count
	   CALL READDIR(FIRST_DELETE,IER)
	   LENGTH = -LENGTH		! Fix entry which has negative length'
	   CALL WRITEDIR(FIRST_DELETE,IER)t
	END IFt

	CALL WRITEDIR(0,IER)A

	RETURNA
	END


	SUBROUTINE SHOW_FLAGS
Ci
C  SUBROUTINE SHOW_FLAGS
CR
C  FUNCTION: Show READNEW and NOTIFY flags.N
Ce
	IMPLICIT INTEGER (A - Z)R

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC't

	INCLUDE 'BULLFOLDER.INC'I

	LOGICAL SKIP,FLAG_NOTIFY,FLAG_READNEW
	DATA SKIP /.FALSE./

	ENTRY SHOW_NOTIFY
	IF (.NOT.SKIP) THEN
	   FLAG_NOTIFY = .TRUE.
	   FLAG_READNEW =.FALSE.1
	   SKIP = .TRUE.D
	END IF)

	ENTRY SHOW_READNEW(
	IF (.NOT.SKIP) THEN
	   FLAG_NOTIFY = .FALSE.T
	   FLAG_READNEW =.TRUE.
	   SKIP = .TRUE.=
	END IFH

	SKIP = .FALSE.P

C0
C  Find user entry in BULLUSER.DAT to obtain flags.M
C

	CALL OPEN_FILE_SHARED(4)		! Open user fileI

	DO WHILE (REC_LOCK(IER))		! Read old entry
	 READ (4,FMT=USER_FMT,KEY=USERNAME,IOSTAT=IER) USERNAME, 
     &	  LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG
     &	  ,NOTIFY_FLAGI
	END DOU

	WRITE (6,'('' For the selected folder '',A,$)') FOLDER(1:TRIM(FOLDER))Y

	F_POINT = FOLDER_NUMBER/32 + 1N

	IF (FLAG_READNEW) THENO
	   IF (BTEST(SET_FLAG(F_POINT),FOLDER_NUMBER)) THEN
	      WRITE (6,'(''+, READNEW is set.'')')N
	   ELSE
	      WRITE (6,'(''+, READNEW is not set.'')')
	   END IF
	ELSE IF (FLAG_NOTIFY) THENT
	   IF (BTEST(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER)) THEN 
	      WRITE (6,'(''+, NOTIFY is set.'')')
	   ELSE
	      WRITE (6,'(''+, NOTIFY is not set.'')')
	   END IF
	END IFd

	CALL CLOSE_FILE(4),

	RETURNr
	END

