From:	HENRY::IN%"MRL%PFC-VAX.MIT.EDU%xx.lcs.mit.edu%zermatt.lcs.mit.edu%csnet-relay.CSNET%relay.cs.net@RCA.COM" 13-DEC-1987 08:50
To:	MHG <MHG%mitre-bedford.arpa@zermatt>, 
Subj:	BULLETIN5.FOR

C
C  BULLETIN5.FOR, Version 12/10/87
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_GENERIC(GENERIC)
C
C  SUBROUTINE SET_GENERIC
C
C  FUNCTION: Enables or disables "GENERIC" display, i.e. displaying
C	general bulletins continually for a certain amount of days.
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	IF (.NOT.SETPRV_PRIV()) THEN
	   WRITE (6,'(
     &      '' ERROR: No privs to change GENERIC.'')')
	   RETURN
	END IF

	IER = CLI$GET_VALUE('USERNAME',TEMP_USER)

	CALL OPEN_FILE_SHARED(4)

	DO WHILE (REC_LOCK(IER))
	   READ (4,FMT=USER_FMT,KEYEQ=TEMP_USER,IOSTAT=IER) TEMP_USER,
     &	     LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,
     &	     BRIEF_FLAG,NOTIFY_FLAG		! Find if there is an entry
	END DO

	IF (IER.EQ.0) THEN
	   IF (GENERIC) THEN
	      IF (CLI$PRESENT('DAYS')) THEN
	         IER = CLI$GET_VALUE('DAYS',BULL_PARAMETER)
	         CALL LIB$MOVC3(4,%REF(BULL_PARAMETER),NEW_FLAG(2))
	      ELSE
		 NEW_FLAG(2) = '   7'
	      END IF
	   ELSE
	      NEW_FLAG(2) = 0
	   END IF
	   REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &	       READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	ELSE
	   WRITE (6,'('' ERROR: Specified username not found.'')')
	END IF

	CALL CLOSE_FILE(4)

	RETURN
	END


	SUBROUTINE SET_LOGIN(LOGIN)
C
C  SUBROUTINE SET_LOGIN
C
C  FUNCTION: Enables or disables bulletin display at login.
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	CHARACTER TODAY*23

	DIMENSION NOLOGIN_BTIM(2)

	CALL SYS$ASCTIM(,TODAY,,)		! Get the present time

	IF (.NOT.SETPRV_PRIV()) THEN
	   WRITE (6,'(
     &      '' ERROR: No privs to change LOGIN.'')')
	   RETURN
	END IF

	IER = CLI$GET_VALUE('USERNAME',TEMP_USER)

	CALL OPEN_FILE_SHARED(4)

	DO WHILE (REC_LOCK(IER))
	   READ (4,FMT=USER_FMT,KEYEQ=TEMP_USER,IOSTAT=IER) TEMP_USER,
     &	     LOGIN_BTIM,READ_BTIM,NEW_FLAG,SET_FLAG,
     &	     BRIEF_FLAG,NOTIFY_FLAG		! Find if there is an entry
	END DO

	CALL SYS_BINTIM('5-NOV-2956',NOLOGIN_BTIM)
	IF (IER.EQ.0) THEN
	   IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).EQ.0) THEN
	      CALL SYS_BINTIM(TODAY,LOGIN_BTIM)
	   ELSE IF (.NOT.LOGIN) THEN
	      LOGIN_BTIM(1) = NOLOGIN_BTIM(1)
	      LOGIN_BTIM(2) = NOLOGIN_BTIM(2)
	   END IF
	   REWRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &	       READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	ELSE
	   WRITE (6,'('' ERROR: Specified username not found.'')')
	END IF

	CALL CLOSE_FILE(4)

	RETURN
	END




	SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER)

	IMPLICIT INTEGER (A-Z)

	PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'X
	PARAMETER UAF$L_ACCOUNT = 53
	PARAMETER UAF$L_FLAGS = '1D4'X
	PARAMETER INPUT_LEN = UAF$L_FLAGS + 4

	CHARACTER INPUT*(INPUT_LEN),USERNAME*(*),ACCOUNT*(*)

	EQUIVALENCE (INPUT(UAF$L_UIC+1:),USER2)
	EQUIVALENCE (INPUT(UAF$L_UIC+3:),GROUP2)
	EQUIVALENCE (INPUT(UAF$L_FLAGS+1:),FLAGS2)

	INTEGER*2 USER2,GROUP2

	CALL OPEN_FILE_SHARED(8)

        READ (8,KEY=USERNAME,IOSTAT=IER) INPUT
						! Move pointer to top of file

	CALL CLOSE_FILE(8)

	IF (IER.NE.0) THEN
	   CALL ERRSNS(IDUMMY,IER)
	   WRITE (6,'(
     &		    '' ERROR: Specified username cannot be verified.'')')
	   CALL SYS_GETMSG(IER)
	ELSE
	   FLAGS = FLAGS2
	   IER = 1
	   USER = USER2
	   GROUP = GROUP2
	   ACCOUNT = INPUT(UAF$L_ACCOUNT:UAF$L_ACCOUNT+7)
	END IF

	RETURN
	END



	SUBROUTINE DCLEXH(EXIT_ROUTINE)

	IMPLICIT INTEGER (A-Z)

	INTEGER*4 EXBLK(4)

	EXBLK(2) = EXIT_ROUTINE
	EXBLK(3) = 1
	EXBLK(4) = %LOC(EXBLK(4))

	CALL SYS$DCLEXH(EXBLK(1))

	RETURN
	END




	SUBROUTINE CRELNM(INPUT,OUTPUT)
	
	IMPLICIT INTEGER (A-Z)

	INCLUDE '($PSLDEF)'

	INCLUDE '($LNMDEF)'

	CHARACTER*(*) INPUT,OUTPUT

	CALL INIT_ITMLST
	CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT))
	CALL END_ITMLST(CRELNM_ITMLST)

	IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER,
     &		%VAL(CRELNM_ITMLST))

	RETURN
	END



	SUBROUTINE GETPRIV
C
C  SUBROUTINE GETPRIV
C
C  FUNCTION:
C	To get process privileges.
C  OUTPUTS:
C	PROCPRIV - Returned privileges
C

	IMPLICIT INTEGER (A-Z)

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

	INCLUDE '($JPIDEF)'

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlist

	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info

	RETURN
	END




	LOGICAL FUNCTION SETPRV_PRIV
	IMPLICIT INTEGER (A-Z)

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

	INCLUDE '($PRVDEF)'

	INCLUDE 'BULLUSER.INC'

	IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN
	   CALL OPEN_FILE_SHARED(4)		! Get BULLUSER.DAT file
	   DO WHILE (REC_LOCK(IER))
	      READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)
     &		TEMP_USER,NEWEST_BTIM,	! Get newest bulletin
     &		BBOARD_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	   END DO
	   CALL CLOSE_FILE(4)
	   NEEDPRIV(1) = NEW_FLAG(1)
	   NEEDPRIV(2) = NEW_FLAG(2)
	END IF

	IF ((PROCPRIV(1).AND.NEEDPRIV(1)).GT.0.OR.
     &	    (PROCPRIV(2).AND.NEEDPRIV(2)).GT.0) THEN
	   SETPRV_PRIV = .TRUE.
	ELSE
	   SETPRV_PRIV = .FALSE.
	END IF

	RETURN
	END



	LOGICAL FUNCTION OPER_PRIV
	IMPLICIT INTEGER (A-Z)
	COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
	INCLUDE '($PRVDEF)'
	OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER)
	RETURN
	END



 
	SUBROUTINE GETUSER(USERNAME)
C
C  SUBROUTINE GETUSER
C
C  FUNCTION:
C	To get username of present process.
C  OUTPUTS:
C	USERNAME   -   Username owner of present process.
C

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) USERNAME		! Limit is 12 characters

	INCLUDE '($JPIDEF)'

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlist

	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info

	RETURN
	END



	SUBROUTINE GETACC(ACCOUNT)
C
C  SUBROUTINE GETACC
C
C  FUNCTION:
C	To get account of present process.
C  OUTPUTS:
C	ACCOUNT   -   ACCOUNT owner of present process.
C

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) ACCOUNT		! Limit is 12 characters

	INCLUDE '($JPIDEF)'

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlist

	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info

	RETURN
	END




	SUBROUTINE GETSTS(STS)
C
C  SUBROUTINE GETSTS
C
C  FUNCTION:
C	To get status of present process. This tells if its a batch process.
C  OUTPUTS:
C	STS   -   Status word of present process.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($JPIDEF)'

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS))
	CALL END_ITMLST(GETJPI_ITMLST)	! Get address of itemlist

	IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info

	RETURN
	END




	SUBROUTINE HELP(LIBRARY)

	IMPLICIT INTEGER (A-Z)
	EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT
	CHARACTER*(*) LIBRARY

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P)

	CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P)
     &		,LIBRARY,,LIB$GET_INPUT)

	RETURN
	END



	INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($FABDEF)'
	INCLUDE '($RABDEF)'

	RECORD /FABDEF/ FAB
	RECORD /RABDEF/ RAB

	FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE)

	STATUS = SYS$OPEN(FAB)
	IF (STATUS) STATUS = SYS$CONNECT(RAB)

	LNM_MODE_EXEC = STATUSc

	END



	INTEGER FUNCTION REC_LOCK(IER)M

	INCLUDE '($FORIOSDEF)'H

	DATA INIT /.TRUE./p

	IF (INIT) THEN	
	   REC_LOCK = 1
	   INIT = .FALSE.
	ELSEo
	   IF (IER.EQ.FOR$IOS_SPERECLOC) THEN
	      REC_LOCK = 1 
	   ELSE
	      REC_LOCK = 0r
	      INIT = .TRUE.
	   END IF
	END IFm

	RETURN.
	END

	INTEGER FUNCTION TRIM(INPUT)E
	CHARACTER*(*) INPUT
	DO TRIM=LEN(INPUT),1,-1
	 IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURNe
	END DOt
	RETURNn
	END

	SUBROUTINE SYS_GETMSG(IER)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*80 MESSAGEC

	CALL LIB$SYS_GETMSG(IER,,MESSAGE)
	WRITE (6,'(A)') MESSAGE

	RETURN
	END



	SUBROUTINE CLOSE_FILE(INPUT) 
C'
C  SUBROUTINE CLOSE_FILE
Cp
C  FUNCTION: To close out the bulletin files and enable CTRL-C & -YV
CE
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
CL

	CALL ENABLE_CTRLE

	CLOSE (UNIT=INPUT)i

	RETURN 
	END


	SUBROUTINE CLOSE_FILE_DELETE(INPUT)

	IMPLICIT INTEGER (A-Z) 

	CALL ENABLE_CTRLA

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

	RETURNL
	END


	SUBROUTINE OPEN_FILE(INPUT)

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'D

	INCLUDE 'BULLUSER.INC'F

	INCLUDE '($FORIOSDEF)' 

	INCLUDE '($PRVDEF)'

	EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR

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

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

	CALL DISABLE_CTRL		! No breaks while file is open

	IF (INPUT.EQ.2) THENs
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,)
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)))
     &	      //'.BULLDIR',STATUS='UNKNOWN',IOSTAT=IER,
     &	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT','
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED')C
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THENL
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILES
	    END IFR
	   END DO
	END IF_

	IF (INPUT.EQ.1) THENE
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,)r
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED')
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THENN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILE 
	    END IF,
	   END DO
	END IFE

	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',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,M
     &	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,U
     &	     KEY=(1:12:CHARACTER))'
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THENS
	     OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',*
     &	      ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
     &	      FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	      KEY=(1:12:CHARACTER))
	     WRITE (4,FMT=USER_FMT) USER_HEADER,NEWEST_BTIM,I
     &	      BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR.
     &	      PRV$M_SETPRV,(0,I=1,FLONG*4-1)
	    ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	      IDUMMY = FILE_LOCK(IER,IER1)r
	      CALL CONVERT_USERFILE
	    END IFS
	   END DO
	END IF

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

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

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

	RETURN'
	END

	SUBROUTINE TIMER_ERRR

	IMPLICIT INTEGER (A-Z)E

	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 10t

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

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

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'Z

	INCLUDE 'BULLUSER.INC'O

	EXTERNAL LNM_MODE_EXECU

	CALL DISABLE_CTRL

	IF (INPUT.EQ.2) THENP
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))E
     &	      //'.BULLDIR',STATUS='OLD',f
     &	      RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT', 
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',U
     &	      SHARED,IOSTAT=IER)
	    IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0i
     &		.OR.FOLDER.EQ.'GENERAL')) THEN
	       IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')	
	       IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR')
	       IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop
	    ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILES
	    END IFI
	   END DO
	END IF

	IF (INPUT.EQ.1) THENT
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))t
     &	      //'.BULLFIL',STATUS='OLD',C
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED',IOSTAT=IER,SHARED)
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THENE
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       CALL CONVERT_BULLFILEp
	    END IFs
	   END DO
	END IF 

	IF (INPUT.EQ.4) THENS
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
     &	    IOSTAT=IER,FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED, 
     &	    KEY=(1:12:CHARACTER))
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THENt
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_USERFILEI
	    END IFA
	   END DO
	END IFU

	IF (INPUT.EQ.7) THENC
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',A
     &	    RECORDSIZE=FOLDER_RECORD,IOSTAT=IER,U
     &	    FORM='FORMATTED',ORGANIZATION='INDEXED',SHARED,
     &	    KEY=(1:25:CHARACTER,26:29:INTEGER))
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THENN
	       IDUMMY = FILE_LOCK(IER,IER1)
	       CALL CONVERT_BULLFOLDERF
	    END IFR
	   END DO
	END IF

	IF (INPUT.EQ.8) THENT
	   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)T
	   CALL OPEN_FILE(INPUT)R
	   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)A
	   CALL SYS_GETMSG(IER1)G
	   CALL ENABLE_CTRL_EXITI
	END IFG

	RETURN(
	END




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

	IMPLICIT INTEGER (A-Z).

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'E

	INCLUDE 'BULLFILES.INC'

	CHARACTER*81 INPUT

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

	OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='OLD',L
     &	      RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',$
     &	      SHARED,READONLY,IOSTAT=IER)

	IF (IER.NE.0) THEN				! Error.  Why?_
	   CALL ERRSNS(IDUMMY,IER)T
	   CALL SYS_GETMSG(IER)
	   CALL EXITN
	END IF2

	OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='OLD',L
     &	      RECORDTYPE='FIXED',RECORDSIZE=80,
     &	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY))

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

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

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

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

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

	EXTIME = '00:00:00'
	ICOUNT = 2E
	DO WHILE (IER.EQ.0)
	   READ(9'ICOUNT,1010,IOSTAT=IER)
     &		DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKF
	   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 DOM
	      CALL WRITEDIR(ICOUNT-1,IER1)I
	      ICOUNT = ICOUNT + 1
	   END IF
	END DO 

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

	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionR
	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
C4
C  SUBROUTINE CONVERT_BULLFILE
CT
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'E

	INCLUDE 'BULLFILES.INC'

	CHARACTER*80 INPUT,NEW_FILE

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

	CALL CLOSE_FILE(2) 

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

	CALL OPEN_FILE(7)

100	READ (7,FMT=FOLDER_FMT,ERR=200)N
     &		FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB

	FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER(:TRIM(FOLDER))E
	NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD'
	OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',
     &	      ,STATUS='OLD', 
     &	      RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT',
     &	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY):

	IF (IER.NE.0) THEN				! Error.  Why?E
	   CALL ERRSNS(IDUMMY,IER)1
	   CALL SYS_GETMSG(IER)
	   CALL EXITR
	END IFI

	OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE)),
     &	   //'.BULLFIL',STATUS='NEW',IOSTAT=IER,N
     &	   ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,n
     &	   FORM='UNFORMATTED') 
	IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))
     &		//'.BULLFIL;-1',NEW_FILE)L

	CALL OPEN_FILE(2)

	CALL READDIR(0,IER)

	IF (IER.EQ.1) THEN	
	 NBLOCK = 0
	 DO I=1,NBULL
	   CALL READDIR(I,IER)B
	   NBLOCK = NBLOCK + 1P
	   SBLOCK = NBLOCK
	   DO J=BLOCK,LENGTH+BLOCK-1'
	      READ(10'J,'(A)') INPUTt
	      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)U

	CALL CLOSE_FILE(2)e
	GOTO 100G

200	CALL OPEN_FILE_SHARED(2)

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

	RETURND

	END



	SUBROUTINE CONVERT_BULLFOLDER
C'
C  SUBROUTINE CONVERT_BULLFOLDER
C.
C  FUNCTION: Converts bulletin folder file to new format.C
C
	IMPLICIT INTEGER (A-Z)U

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'O

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($SSDEF)'E

	CHARACTER*80 NEW_FILE

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

	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) 

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

	DO WHILE (FILE_LOCK(IER,IER1))L
	   OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',=
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	END DO)

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

	OPEN (UNIT=9,FILE=BULLFOLDER_FILE,STATUS='NEW',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',&
     &	        RECORDSIZE=FOLDER_RECORD,
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')R

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

	F_NUMBER = 0
	DO WHILE (IER.EQ.0)
	   READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)',
     &			KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)=
     &		FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIPR
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
	   IF (IER.EQ.0) THEN
	      FOLDER_FLAG = 0
	      FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER(:TRIM(FOLDER)))
	      CALL CHKACL
     &		(FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER)
	      IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
		 FOLDER_FLAG = IBSET(FOLDER_FLAG,0)A
	      END IF 
	      CALL OPEN_FILE_SHARED(2)'
	      CALL READDIR(0,IER)
	      IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN=
		 IF (NBULL.GT.0) THEN'
		    CALL READDIR(NBULL,IER)Y
		    NEWEST_DATE = DATE
		    NEWEST_TIME = TIME
		    CALL WRITEDIR(0,IER)
		 END IF=
	      END IFI
	      CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)D
	      WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER)
     &	        FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &	        ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTBN
     &	        ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0A
	      CALL CLOSE_FILE(2)E
	      F_NUMBER = F_NUMBER + 1
	   END IF
	END DO 

	CLOSE (UNIT=7)
	CLOSE (UNIT=9,STATUS='SAVE')N

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

	IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY))
     &		//'BOARD.COM;*')	! BULLETIN$ is referenced in old file

	RETURNr
	END

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

	IMPLICIT INTEGER (A-Z)L

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLUSER.INC' 

	CHARACTER BUFFER*74,NEW_FILE*80

	CHARACTER*11 LOGIN_DATE,READ_DATE
	CHARACTER*8 LOGIN_TIME,READ_TIMEm

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

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

	OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',n
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',
     &	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, 
     &	     KEY=(1:12:CHARACTER)) 
	INQUIRE (UNIT=9,RECORDSIZE=RECL)I

	IF (IER.EQ.0) THEN
	   CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)S
	   OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
     &	    FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	    KEY=(1:12:CHARACTER))
	END IFL

	IF (IER.NE.0) THENP
	   WRITE (6,'('' Cannot convert user file.'')')
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)R
	   CALL SYS_GETMSG(IER1)y
	   CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	   CALL ENABLE_CTRL_EXIT 
	END IFP

	DO I=1,FLONGE
	   NEW_FLAG(I) = 'FFFFFFFF'Xo
	   NOTIFY_FLAG(I) = 0
	   BRIEF_FLAG(I) = 0U
	   SET_FLAG(I) = 0E
	END DOO

	IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.
     &		RECL.EQ.74) THEN		! Old format
	   IF (RECL.LE.58) RECL = 50 
	   IER = 0R
	   DO WHILE (IER.EQ.0),
	      READ (9,'(A<RECL>)',IOSTAT=IER) BUFFER 
	      IF (IER.EQ.0) THENE
		TEMP_USER = BUFFER(1:12)
	        LOGIN_DATE = BUFFER(13:23)C
	        LOGIN_TIME = BUFFER(24:31)T
	        READ_DATE = BUFFER(32:42)
	        READ_TIME = BUFFER(43:50)
	        IF (RECL.EQ.58)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))D
	        IF (RECL.EQ.66)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1)) 
	        IF (RECL.EQ.74)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1))
	        CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM)
	        CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM) 
	        WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,'
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	    END IFP
	   END DO
	   IF (RECL.LT.66) THEN
	     READ (4,KEY=USER_HEADER,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM, 
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	     NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV
	     WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	   END IF
	ELSE					! Folder maxmimum increase
	   OFLONG = (RECL - 28) / 16		! Old  #longwords/flagI
	   DO WHILE (IER.EQ.0)e
	    READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER) 
     &	     TEMP_USER,LOGIN_BTIM,READ_BTIM,y
     &	     (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG),
     &	     (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG)
	    IF (IER.EQ.0) THENI
	     WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	    END IFe
	   END DO
	END IF 

	IER = 0

	CLOSE (UNIT=9)D
	CLOSE (UNIT=4)_

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

	RETURNL
	END


	SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT)
C
C  SUBROUTINE READDIRU
CR
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:L
C	ICOUNT  -  The last record read by this routine.
CP

	IMPLICIT INTEGER (A - Z)S

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'A

	COMMON /PROMPT/ COMMAND_PROMPTE
	CHARACTER*39 COMMAND_PROMPT

	CHARACTER*2 CFOLDER_NUMBERS

	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)E
		 CALL OPEN_FILE(2)
		 CALL CLEANUP_DIRFILE(1)
	      END IFB
	      IF (NEMPTY.EQ.'    ') NEMPTY = 0N
CC
C  Check to see if cleanup of empty file space is necessary, which is 
C  defined here as being 50 blocks (200 128byte records).  Also checkU
C  to see if cleanup was in progress but didn't properly finish.
CE
	      IF (NEMPTY.GT.200.AND..NOT.TEST_BULLCP()) THENL
		 WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER
	         IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX((
     &		  COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER,
     &		  'NL:','NL:',1,'BULL_CLEANUP')E
	      ELSE IF (NEMPTY.EQ.-1) THEN
		 CALL CLEANUP_BULLFILE
	      END IFO
	   END IF
	ELSE'
	   DO WHILE (REC_LOCK(IER))
	    READ(2'ICOUNT+1,1010,IOSTAT=IER)n
     &	     DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,EXTIME,SYSTEM,BLOCK
	   END DO
	END IFC

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

	RETURN'

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

	END


	SUBROUTINE WRITEDIR(BULLETIN_NUM,IER)
C0
C  SUBROUTINE WRITEDIR
CR
C  FUNCTION: Writes the entry for the specified bulletin in theS
C	directory file.O
CR
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1.I
C			 If 0, write the header of the directory file.
C  OUTPUTS:D
C	IER - Error status from WRITE.
CP

	IMPLICIT INTEGER (A - Z)U

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

	RETURN 

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

	END


	A
	SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH)
C 
C  SUBROUTINE READACLR
C:
C  FUNCTION: Reads the ACL of a file.I
CN
C  PARAMETERS:
C	FILENAME - Name of file to check.I
C	ACLENT - String which will be large enough to hold ACL information. 
C
	IMPLICIT INTEGER (A-Z) 

	INCLUDE '($ACLDEF)'

	CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)I
	CHARACTER NOT_ID*3F
	DATA NOT_ID /'=[,'/

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT))
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist

	IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,) 

	DO ACCESS_TYPE=1,2&
	 POINT = 1E
	 OUTLEN = 0
	 DO WHILE ((POINT.LT.ACLLENGTH).AND.IER).
	   IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+
     &		ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,)
	   IF ((ACCESS_TYPE.EQ.1.AND.INDEX(ACLSTR,'WRITE').GT.0).OR.W
     &	       (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENR
	      START_ID = INDEX(ACLSTR,'=') + 1A
	      END_ID = INDEX(ACLSTR,'ACCESS') - 2
	      IF (ACLSTR(END_ID:END_ID).EQ.']') THEN 
		 START_ID = END_ID - 1
		 DO WHILES
     &		   (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0)A
		    START_ID = START_ID - 1_
		 END DOE
		 START_ID = START_ID + 1
		 END_ID = END_ID - 1
		 IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN&
		    START_ID = INDEX(ACLSTR,'=') + 1
	            END_ID = INDEX(ACLSTR,'ACCESS') - 2
		 END IF+
	      END IF
	      IF (OUTLEN.EQ.0) THEN
	         IF (ACCESS_TYPE.EQ.1) THEN
		    WRITE (6,'(_
     &		    '' These users can read and write to this folder:'')')
	         ELSE
		    WRITE (6,'(Y
     &		    '' These users can only read this folder:'')')
	         END IF
		 OUTLEN = 1O
	      END IFS
	      LEN = END_ID - START_ID + 1
	      IF (OUTLEN+LEN-1.GT.80) THENr
		 WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)e
		 OUTPUT = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = LEN + 2
	      ELSE IF (OUTLEN+LEN-1.EQ.80) THEN
		 WRITE (6,'(1X,A)') 
     &			OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)N
	         OUTLEN = 1
	      ELSEC
	         OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = OUTLEN + LEN + 1
	      END IFU
	   END IF
	   POINT = POINT + ICHAR(ACLENT(POINT:POINT))
	 END DO
	 IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)L
	END DO_

	RETURNE
	END

