From:	KBSVAX::KANE "Joseph Kane"  1-APR-1988 08:29
To:	everhart@arisia.DECNET
Subj:	forwarded mail from steinmetz

From uunet!rutgers.edu!Postmaster Thu Mar 31 22:10:55 1988
Received:  by kbsvax.steinmetz (1.2/1.1x Steinmetz)
	 id AA12154; Thu, 31 Mar 88 22:10:25 est
Received: from RUTGERS.EDU by uunet.UU.NET (5.54/1.14) 
	id AA07548; Thu, 31 Mar 88 21:50:38 EST
Received: by rutgers.edu (5.54/1.15) 
	id AB05331; Thu, 31 Mar 88 21:50:59 EST
Date: Thu, 31 Mar 88 21:50:59 EST
From: uunet!rutgers.edu!Postmaster (Mail Delivery Subsystem)
Subject: Returned mail: Host unknown
Message-Id: <8804010250.AB05331@rutgers.edu>
To: <MAILER-DAEMON>
Status: R
 
   ----- Transcript of session follows -----
550 <pfc-vax.mit.edu!mrl@rutgers.edu>... Host unknown
 
   ----- Unsent message follows -----
Received: by rutgers.edu (5.54/1.15) 
	id AA04731; Thu, 31 Mar 88 19:56:32 EST
Received: from steinmetz.UUCP by uunet.UU.NET (5.54/1.14) with UUCP 
	id AA27205; Thu, 31 Mar 88 19:51:49 EST
Received:  by kbsvax.steinmetz (1.2/1.1x Steinmetz)
	 id AA10010; Thu, 31 Mar 88 19:34:25 est
Date: 31 Mar 88 10:16:57 EST
From: steinmetz!MAILER-DAEMON@uunet.uu.net (Mail Delivery Subsystem)
Subject: Returned mail: User unknown
Message-Id: <8804010034.AA10010@kbsvax.steinmetz>
To: MRL@pfc-vax.mit.edu
 
   ----- Transcript of session follows -----
mail11: %MAIL-E-SYNTAX, error parsing 'CRD'
550 crd.ge.com!EVERHART%ARISIA.DECNET... User unknown
 
   ----- Unsent message follows -----
Received:  by kbsvax.steinmetz (1.2/1.1x Steinmetz)
	 id AA09993; Thu, 31 Mar 88 19:34:25 est
Received: by ge-dab.GE.COM (smail2.5)
	id AA14447; 31 Mar 88 18:51:20 EST (Thu)
Received: by ge-rtp.GE.COM (smail2.5)
	id AA05829; 31 Mar 88 15:26:29 EST (Thu)
Received: by mcnc.mcnc.org (5.54/MCNC/10-20-87)
	id AA20697; Thu, 31 Mar 88 14:42:41 EST
From: <mcnc!rutgers.edu!pfc-vax.mit.edu!MRL>
Received: by rutgers.edu (5.54/1.15) 
	id AA20468; Thu, 31 Mar 88 10:47:59 EST
Message-Id: <8803311547.AA20468@rutgers.edu>
Received: from PFC-VAX.MIT.EDU by XX.LCS.MIT.EDU via Chaosnet; 31 Mar 88 10:18-EST
Date: 31 Mar 88 10:16:57 EST
To: crd.ge.com!xx!EVERHART@ARISIA.DECNET
Subject: BULLETIN6.FOR
 
C
C  BULLETIN6.FOR, Version 3/1/88
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 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
	   CALL READ_USER_FILE_HEADER(IER)
	   CALL CLOSE_FILE(4)
	   NEEDPRIV(1) = USERPRIV(1)
	   NEEDPRIV(2) = USERPRIV(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
 
	INCLUDE '($HLPDEF)'
 
	IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P)
 
	CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,BULL_PARAMETER(1:LEN_P)
     &		,LIBRARY,HLP$M_HELP.OR.HLP$M_PROMPT,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 = STATUS
 
	END
 
 
 
	INTEGER FUNCTION REC_LOCK(IER)
 
	INCLUDE '($FORIOSDEF)'
 
	DATA INIT /.TRUE./
 
	IF (INIT) THEN
	   REC_LOCK = 1
	   INIT = .FALSE.
	ELSE
	   IF (IER.EQ.FOR$IOS_SPERECLOC) THEN
	      REC_LOCK = 1
	   ELSE
	      REC_LOCK = 0
	      INIT = .TRUE.
	   END IF
	END IF
 
	RETURN
	END
 
	INTEGER FUNCTION TRIM(INPUT)
	CHARACTER*(*) INPUT
	DO TRIM=LEN(INPUT),1,-1
	 IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN
	END DO
	RETURN
	END
 
	SUBROUTINE SYS_GETMSG(IER)
 
	IMPLICIT INTEGER (A-Z)
 
	CHARACTER*80 MESSAGE
 
	CALL LIB$SYS_GETMSG(IER,,MESSAGE)
	WRITE (6,'(A)') MESSAGE
 
	RETURN
	END
 
 
 
	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 'BULLDIR.INC'
 
	INCLUDE '($FORIOSDEF)'
 
	INCLUDE '($PRVDEF)'
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	EXTERNAL BULLDIR_ERR,BULLETIN_ERR,BULLUSER_ERR,BULLFOLDER_ERR
	EXTERNAL BULLINF_ERR
 	
	PARAMETER TIMEOUT = -10*1000*1000*30 
	DIMENSION TIMEBUF(2)
	DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/
 1
	IER = 0
 8
	IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN)e
 e
	CALL DISABLE_CTRL		! No breaks while file is open
 v
	IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN1
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,%VAL(4))t
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))5
     &	      //'.BULLDIR',STATUS='OLD',IOSTAT=IER,
     &	      RECORDTYPE='FIXED',ACCESS='DIRECT',
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP')
 M
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THENT
	       OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	        //'.BULLDIR',STATUS='NEW',-
     &	        RECORDTYPE='FIXED',RECORDSIZE=115,ACCESS='DIRECT',)
     &	        ORGANIZATION='RELATIVE',DISPOSE='KEEP',
     &	        FORM='FORMATTED',IOSTAT=IER2)
	       CLOSE (UNIT=2)
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	    ELSE IF (IER.EQ.0) THEN
	       INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE) 
	       IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENu
	          CLOSE (UNIT=2)e
	          IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop@
		  IER = SYS$CANTIM(%VAL(4),)
	          CALL CONVERT_BULLFILESp
	          IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLDIR_ERR,
     &					%VAL(4))c
	       END IF
	    END IFU
	   END DO
	END IF-
 -
	IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THENb
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,%VAL(4))
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))S
     &	      //'.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
	       IER = SYS$CANTIM(%VAL(4),)
	       CALL CONVERT_BULLFILE1
	       IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLETIN_ERR,
     &					%VAL(4))s
	    END IF8
	   END DO
	END IFM
 8
	IF (INPUT.EQ.4) THEN.
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,%VAL(4))
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4,r
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:12:CHARACTER)) 
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THENC
	     OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',C
     &	      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_KEY,NEWEST_BTIM,O
     &	      BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR.O
     &	      PRV$M_SETPRV,(0,I=1,FLONG*4-1)
	     CLOSE (UNIT=4)
	     IDUMMY = FILE_LOCK(IER,IER1)
	    ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	     IDUMMY = FILE_LOCK(IER,IER1)
	     IER = SYS$CANTIM(%VAL(4),)
	     CALL CONVERT_USERFILE_
	     IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLUSER_ERR,
     &					%VAL(4))r
	    END IFs
	   END DO
	END IFT
 W
	IF (INPUT.EQ.7) THEN,
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLFOLDER_ERR,
     &					%VAL(4))I
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:25:CHARACTER,26:29:INTEGER))E
	    IF (IER.EQ.FOR$IOS_FILNOTFOU) THENR
	      FOLDER1 = 'GENERAL'
	      FOLDER1_OWNER = 'SYSTEM'R
	      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',
     &	        RECORDSIZE=FOLDER_RECORD,
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,P
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	      WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2)
     &		FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIPB
     &		,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB
     &		,NBULL,F_NEWEST_BTIM,4,0	! 4 means system folder
	      CLOSE (UNIT=7)
	      IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loopi
	    END IFr
	   END DO
	END IFP
 F
	IF (INPUT.EQ.9) THENS
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLINF_ERR,%VAL(4))S
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN',R
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3,
     &	     IOSTAT=IER,ORGANIZATION='INDEXED',
     &	     KEY=(1:12:CHARACTER))O
	     IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       IER = SYS$CANTIM(%VAL(4),)
	       CALL CONVERT_INFFILE
	       IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,BULLINF_ERR,M
     &					%VAL(4)) 
	     END IF
	   END DO
	END IFT
 P
	IF (IER.NE.0) THENN
	   WRITE (6,'('' Cannot open unit = '',I)') INPUT
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)G
	   CALL SYS_GETMSG(IER1)f
	   CALL ENABLE_CTRL_EXIT	! Enable CTRL-Y & -C & EXITS
	END IF
 
	IER = SYS$CANTIM(%VAL(4),)		! Successful, so cancel timer.e
 t
	RETURN 
	END
 s
	SUBROUTINE TIMER_ERR.
  
	IMPLICIT INTEGER (A-Z)t
 s
	ENTRY BULLDIR_ERR
	WRITE(6,'('' ERROR: Unable to open directory file after 30 secs.'')')
	GO TO 10I
 S
	ENTRY BULLETIN_ERRi
	WRITE(6,'('' ERROR: Unable to open message file after 30 secs.'')')
	GO TO 10e
 d
	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 10T
 C
	ENTRY BULLINF_ERR
	WRITE(6,'('' ERROR: Unable to open BULLINF.DAT after 30 secs.'')')M
	GO TO 10I
 U
10	CALL ENABLE_CTRL_EXIT		! No breaks while file is open
	END
 E
 E
 )
	SUBROUTINE OPEN_FILE_SHARED(INPUT)U
 T
	IMPLICIT INTEGER (A-Z)
  
	INCLUDE '($FORIOSDEF)'.
 H
	INCLUDE 'BULLFILES.INC'
 
	INCLUDE 'BULLFOLDER.INC'
 I
	INCLUDE 'BULLUSER.INC'E
 (
	INCLUDE 'BULLDIR.INC'
  
	COMMON /POINT/ BULL_POINT
 $
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 /
	EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT
 M
	PARAMETER TIMEOUT = -10*1000*1000*30A
	DIMENSION TIMEBUF(2)I
	DATA TIMEBUF /TIMEOUT,-1/, TIMEEFN/0/
 L
	CHARACTER*25 SAVE_FOLDER
	DATA SAVE_BLOCK/-1/
 R
	IER = 0
 _
	IF (TIMEEFN.EQ.0) CALL LIB$GET_EF(TIMEEFN)
 T
	CALL DISABLE_CTRL
 I
	IF (INPUT.EQ.2.AND..NOT.REMOTE_SET) THEN=
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4)) 
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLDIR',STATUS='OLD',T
     &	      RECORDTYPE='FIXED',ACCESS='DIRECT',
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',
     &	      SHARED,IOSTAT=IER)
	    IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0Z
     &		.OR.FOLDER.EQ.'GENERAL')) THEN
	       IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')T
	       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.0) THEN
	       INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)o
	       IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THENL
	          CLOSE (UNIT=2).
	          IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loopC
		  IER = SYS$CANTIM(%VAL(4),)
	          CALL CONVERT_BULLFILES
	          IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4))R
	       END IF
	    END IFA
	   END DO
	END IFR
 R
	IF (INPUT.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR. 
     &		SAVE_FOLDER.NE.FOLDER)) THEN
	   WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_POINT
	   IF (IER.GT.0) THEN
	      CALL ERROR_AND_EXIT
	   ELSE
	      SAVE_BLOCK = BLOCKR
	      SAVE_FOLDER = FOLDERO
	      CALL GET_REMOTE_MESSAGE(IER)T
	      IER = 0
	   END IF
	ELSE IF (INPUT.EQ.1.AND..NOT.REMOTE_SET) THEN
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4))I
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))e
     &	      //'.BULLFIL',STATUS='OLD',l
     &	      ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
     &	      FORM='UNFORMATTED',IOSTAT=IER,SHARED)
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN,
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       IER = SYS$CANTIM(%VAL(4),)
	       CALL CONVERT_BULLFILET
	       IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4))
	    END IFE
	   END DO
	END IFT
 T
	IF (INPUT.EQ.4) THENF
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4)) 
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4,
     &	    IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
     &	    KEY=(1:12:CHARACTER))
	    IF (IER.EQ.FOR$IOS_INCRECLEN) THEN 
	       IDUMMY = FILE_LOCK(IER,IER1)
	       IER = SYS$CANTIM(%VAL(4),)
	       CALL CONVERT_USERFILE 
	       IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4))o
	    END IF	
	   END DO
	END IFA
 )
	IF (INPUT.EQ.7) THENV
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4)) 
	   DO WHILE (FILE_LOCK(IER,IER1))
	    OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',R
     &	    IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
     &	    KEY=(1:25:CHARACTER,26:29:INTEGER))
 F
	    IF (IER.EQ.0) THENF
	       INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)N
	       IF (ASK_SIZE.NE.FOLDER_RECORD/4) THENR
	          CLOSE (UNIT=7)E
	          IDUMMY = FILE_LOCK(IER,IER1) 
	          IER = SYS$CANTIM(%VAL(4),)
	          CALL CONVERT_BULLFOLDER
	          IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4))B
	       END IF
	    END IFE
	   END DO
	END IFM
 F
	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)F
	   END DO
	END IFO
 4
	IF (INPUT.EQ.9) THENA
	   IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,%VAL(4))
	   DO WHILE (FILE_LOCK(IER,IER1))
	     OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD',
     &	      ACCESS='KEYED',RECORDTYPE='FIXED',E
     &	      RECORDSIZE=FOLDER_MAX*2+3,F
     &	      IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
     &	      KEY=(1:12:CHARACTER))
	     IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
	       IDUMMY = FILE_LOCK(IER,IER1)	! Avoid breaking out of DO loop
	       IER = SYS$CANTIM(%VAL(4),)
	       CALL CONVERT_INFFILE
	       IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &					%VAL(4)) 
	     END IF
	   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)I
	   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)R
	   CALL ENABLE_CTRL_EXIT 
	END IFI
 I
	IER = SYS$CANTIM(%VAL(4),)		! Successful, so cancel timer.2
 N
	RETURN
	END
 I
 E
 O
 O
	SUBROUTINE CONVERT_BULLFILESE
C=
C  SUBROUTINE CONVERT_BULLFILES=
CY
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 
 A
	IMPLICIT INTEGER (A-Z)'
 E
	INCLUDE 'BULLDIR.INC'
 S
	INCLUDE 'BULLFOLDER.INC' 
  
	INCLUDE 'BULLFILES.INC'
 I
	CHARACTER*81 INPUTE
 P
	WRITE (6,'('' Converting data files to new format. Please wait.'')')M
 O
	OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))E
     &	      //'.BULLDIR',STATUS='OLD',R
     &	      RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',_
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', 
     &	      SHARED,READONLY,IOSTAT=IER)
  
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 I
	OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     &	      //'.BULLFIL',STATUS='OLD',E
     &	      RECORDTYPE='FIXED',RECORDSIZE=80,
     &	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)R
 R
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 O
	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT) 
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)N
 H
	OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))k
     &	      //'.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',S
     &	      ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED', 
     &	      IOSTAT=IER)
 E
	NEWEST_EXTIME = '00:00:00'(
	READ (9'1,1000,IOSTAT=IER) 
     &		NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME,
     &		NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIMED
	NEMPTY = 0E
	IF (IER.EQ.0) CALL WRITEDIR(0,IER1)
 i
	EXTIME = '00:00:00'
	ICOUNT = 2
	DO WHILE (IER.EQ.0)
	   READ(9'ICOUNT,1010,IOSTAT=IER)
     &		DESCRIP,FROM,DATE,TIME,LENGTH,EXDATE,SYSTEM,BLOCKY
	   IF (IER.EQ.0) THEN
	      READ(10,'(A)') INPUTU
	      WRITE(1,'(A)') INPUT(1:80)//CHAR(1)
	      DO I=2,LENGTH
	         READ(10,'(A)') INPUT
	         WRITE(1,'(A)') INPUT
	      END DOG
	      CALL WRITEDIR(ICOUNT-1,IER1)I
	      ICOUNT = ICOUNT + 1
	   END IF
	END DO 
 s
	CLOSE (UNIT=9)O
	CLOSE (UNIT=2) 
	CLOSE (UNIT=10)
	CLOSE (UNIT=1) 
 e
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionU
	RETURNP
 I
1000	FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)E
1010	FORMAT(A53,A12,A11,A8,A4,A11,A4,A4)
 U
	END
 O
	SUBROUTINE CONVERT_BULLFILE
CR
C  SUBROUTINE CONVERT_BULLFILE
C
C  FUNCTION: Converts bulletin data file to new format file.
CE
C  NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length.
C	 This converts from 81 byte length to 128 compressed format.
C
 T
	IMPLICIT INTEGER (A-Z)I
 F
	INCLUDE 'BULLDIR.INC'
 E
	INCLUDE 'BULLFOLDER.INC'-
 
	INCLUDE 'BULLFILES.INC'
 N
	CHARACTER*80 INPUT,NEW_FILE
 
	WRITE (6,'('' Converting data files to new format. Please wait.'')')
  
	CALL CLOSE_FILE(2)(
 E
	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)D
     &		FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
 
	FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER(:TRIM(FOLDER))Z
	NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD'
	OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'B
     &	      ,STATUS='OLD',N
     &	      RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT',
     &	      FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY) 
  
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 I
	OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))N
     &	   //'.BULLFIL',STATUS='NEW',IOSTAT=IER, 
     &	   ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,)
     &	   FORM='UNFORMATTED')I
	IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))
     &		//'.BULLFIL;-1',NEW_FILE)(
 R
	CALL OPEN_FILE(2)
 E
	CALL READDIR(0,IER)
 I
	IF (IER.EQ.1) THEN.
	 NBLOCK = 0
	 DO I=1,NBULL
	   CALL READDIR(I,IER)	
	   NBLOCK = NBLOCK + 1H
	   SBLOCK = NBLOCK_
	   DO J=BLOCK,LENGTH+BLOCK-1P
	      READ(10'J,'(A)') INPUT 
	      ILEN = TRIM(INPUT) 
	      IF (ILEN.EQ.0) ILEN = 1
	      CALL STORE_BULL(ILEN,INPUT,NBLOCK)L
	   END DO
	   CALL FLUSH_BULL(NBLOCK)0
	   LENGTH = NBLOCK - SBLOCK + 1
	   BLOCK = SBLOCK
	   CALL WRITEDIR(I,IER)
	 END DO
 F
	 NEMPTY = 0
	 CALL WRITEDIR(0,IER)
	END IF)
 
	CLOSE (UNIT=10)
	CLOSE (UNIT=1)
  
	CALL CLOSE_FILE(2)L
	GOTO 100T
 (
200	CALL OPEN_FILE_SHARED(2)
 B
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection=
 X
	RETURND
 E
	END
  
  
  
	SUBROUTINE CONVERT_BULLFOLDER
CE
C  SUBROUTINE CONVERT_BULLFOLDER
C)
C  FUNCTION: Converts bulletin folder file to new format.n
Cu
	IMPLICIT INTEGER (A-Z) 
 Y
	INCLUDE 'BULLDIR.INC'
  
	INCLUDE 'BULLFOLDER.INC' 
  
	INCLUDE 'BULLFILES.INC'
 )
	INCLUDE '($SSDEF)'E
 ,
	CHARACTER*80 NEW_FILE
  
	WRITE (6,'('' Converting data files to new format. Please wait.'')')Y
 E
	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT),
  
	EODIR = MAX(INDEX(BULLFOLDER_FILE,':'),INDEX(BULLFOLDER_FILE,']'))I
	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)))
	   OPEN (UNIT=7,FILE=NEW_FILE,STATUS='OLD',
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',Y
     &	        FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:25:CHARACTER,26:29:INTEGER))
	END DO%
 (
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 T
	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')S
 E
	IF (IER.NE.0) CALL ERROR_AND_EXIT		! Error.  Why?
 
	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)C
     &		FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP1
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
	   IF (IER.EQ.0) THEN
	      FOLDER_FLAG = 0
	      IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
	      FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER(:TRIM(FOLDER))E
	      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)S
	      END IFD
	      CALL OPEN_FILE_SHARED(2) 
	      CALL READDIR(0,IER)
	      IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THENE
		 IF (NBULL.GT.0) THEN%
		    CALL READDIR(NBULL,IER)L
		    NEWEST_DATE = DATE
		    NEWEST_TIME = TIME
		    CALL WRITEDIR(0,IER)
		 END IFA
	      END IF 
	      CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)=
	      WRITE (9,FMT=FOLDER_FMT,IOSTAT=IER)
     &	        FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &	        ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB_
     &	        ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0 
	      CALL CLOSE_FILE(2))
	      F_NUMBER = F_NUMBER + 1
	   END IF
	END DOE
 R
	CLOSE (UNIT=7)M
	CLOSE (UNIT=9,STATUS='SAVE')	
 %
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionO
 O
	IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY))
     &		//'BOARD.COM;*')	! BULLETIN$ is referenced in old file
 O
	RETURN 
	END
 _
	SUBROUTINE CONVERT_USERFILE
CR
C  SUBROUTINE CONVERT_USERFILE
Cr
C  FUNCTION: Converts user file to new format which has 8 bytes added.
C,
 )
	IMPLICIT INTEGER (A-Z))
 L
	INCLUDE 'BULLFILES.INC'
 A
	INCLUDE 'BULLUSER.INC' 
 L
	CHARACTER BUFFER*74,NEW_FILE*80
 R
	CHARACTER*11 LOGIN_DATE,READ_DATE
	CHARACTER*8 LOGIN_TIME,READ_TIME
 D
	WRITE (6,'('' Converting data files to new format. Please wait.'')')V
 _
	EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))t
	SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1
	NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'e
	IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE)
 c
	OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',A
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',
     &	     FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER, 
     &	     KEY=(1:12:CHARACTER))n
	INQUIRE (UNIT=9,RECORDSIZE=RECL)w
 .
	IF ((RECL-28)/16.GT.FLONG) THEN
	   WRITE (6,'('' ERROR: Old data files have more folders'',
     &		      '' than was specified with BULLFOLDER.INC.'')')S
	   WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')'
	   IF (USERNAME.EQ.'DECNET') THEN
	      CALL SYS$DELPRC(,)E
	   ELSE
	      CALL SYS$CANEXH()
	      CALL EXIT
	   END IF
	END IF=
 F
	IF (IER.EQ.0) THENM
	   CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
			! Set protection to (SYSTEM:RWE,OWNER:RWE,WORLD,GROUP)
	   OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',D
     &	    ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
     &	    FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	    KEY=(1:12:CHARACTER))
	END IFO
  
	IF (IER.NE.0) THENI
	   WRITE (6,'('' Cannot convert user file.'')')
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)S
	   CALL SYS_GETMSG(IER1)D
	   CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	   CALL ENABLE_CTRL_EXITO
	END IF)
 
	DO I=1,FLONG'
	   NEW_FLAG(I) = 'FFFFFFFF'X&
	   NOTIFY_FLAG(I) = 0
	   BRIEF_FLAG(I) = 0=
	   SET_FLAG(I) = 0 
	END DOZ
 O
	IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.S
     &		RECL.EQ.74) THEN		! Old format
	   IF (RECL.LE.58) RECL = 50 
	   IER = 0E
	   DO WHILE (IER.EQ.0)E
	      READ (9,'(A<RECL>)',IOSTAT=IER) BUFFERN
	      IF (IER.EQ.0) THENT
		TEMP_USER = BUFFER(1:12)
	        LOGIN_DATE = BUFFER(13:23)0
	        LOGIN_TIME = BUFFER(24:31).
	        READ_DATE = BUFFER(32:42)
	        READ_TIME = BUFFER(43:50)
	        IF (RECL.EQ.58)
     &		  CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1)) 
	        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,t
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	    END IF0
	   END DO
	   IF (RECL.LT.66) THEN
	     READ (4,KEY=USER_HEADER_KEY,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/flagU
	   DO WHILE (IER.EQ.0),
	    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) THEN0
	     WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
     &		READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
	    END IF
	   END DO
	END IFE
 I
	IER = 0
 (
	CLOSE (UNIT=9))
	CLOSE (UNIT=4)R
 R
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protectionL
 L
	RETURNE
	END
 0
 L
	SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT)
CB
C  SUBROUTINE READDIR'
C'
C  FUNCTION: Finds the entry for the specified bulletin in the
C	directory file and returns the information for that entry.
C 
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1.U
C			 If 0, gives header info, i.e number of bulls,
C			 number of blocks in bulletin file, etc.
C  OUTPUTS:S
C	ICOUNT  -  The last record read by this routine.
C 
 M
	IMPLICIT INTEGER (A - Z)B
 N
	INCLUDE 'BULLDIR.INC'
 F
	INCLUDE 'BULLFOLDER.INC'U
 I
	COMMON /PROMPT/ COMMAND_PROMPTF
	CHARACTER*39 COMMAND_PROMPT
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 U
	CHARACTER*2 CFOLDER_NUMBER
  
	ICOUNT = BULLETIN_NUM
 B
	IF (ICOUNT.EQ.0) THEN
	   IF (.NOT.REMOTE_SET) THENR
	      DO WHILE (REC_LOCK(IER))E
	        READ (2'1,IOSTAT=IER) BULLDIR_HEADER1
	      END DOT
	   ELSE
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,0
	      IF (IER.EQ.0) THENL
		 READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER
	      END IF 
	      IF (IER.GT.0) THEN(
		 CALL ERROR_AND_EXIT
	      ELSE)
		 RETURNN
	      END IFL
	   END IF
	   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 IFT
	      IF (NEMPTY.EQ.'    ') NEMPTY = 0C
Ce
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 checkE
C  to see if cleanup was in progress but didn't properly finish.
CE
	      IF (NEMPTY.GT.200.AND..NOT.TEST_BULLCP()) THENt
		 WRITE (CFOLDER_NUMBER,'(I2)') FOLDER_NUMBER
	         IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(I
     &		  COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER,
     &		  'NL:','NL:',1,'BULL_CLEANUP') 
	      ELSE IF (NEMPTY.EQ.-1) THEN
		 CALL CLEANUP_BULLFILE
	      END IFW
	   END IF
	ELSEL
	   IF (.NOT.REMOTE_SET) THENP
	      DO WHILE (REC_LOCK(IER))O
	         READ(2'ICOUNT+1,IOSTAT=IER) BULLDIR_ENTRY'
	      END DO 
	   ELSE
	      WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT 
	      IF (IER.EQ.0) THEN:
		 READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY
	      END IF?
	      IF (IER.GT.0) THENL
		 CALL ERROR_AND_EXIT
	      ELSE 
		 RETURN=
	      END IFY
	   END IF
	END IF 
  
	IF (IER.EQ.0) ICOUNT = ICOUNT + 1
  
	UNLOCK 2F
 A
	RETURNA
 A
	END
 E
 '
	SUBROUTINE WRITEDIR(BULLETIN_NUM,IER)
CA
C  SUBROUTINE WRITEDIR
C=
C  FUNCTION: Writes the entry for the specified bulletin in the?
C	directory file..
CD
C  INPUTS:
C	BULLETIN_NUM  -  Bulletin number.  Starts with 1.,
C			 If 0, write the header of the directory file.
C  OUTPUTS:N
C	IER - Error status from WRITE.
C 
 &
	IMPLICIT INTEGER (A - Z)X
 E
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
  
	INCLUDE 'BULLDIR.INC'
	I
	IF (BULLETIN_NUM.EQ.0) THEN
	   WRITE (2'1,IOSTAT=IER) BULLDIR_HEADER=
	   IF (REMOTE_SET) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER 
	   END IF
	ELSEL
	   WRITE (2'BULLETIN_NUM+1,IOSTAT=IER) BULLDIR_ENTRYI
	   IF (REMOTE_SET) THEN
	      WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRYD
	   END IF
	END IFL
 H
	IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXITW
 _
	RETURN5
 V
	END
 T
 E
		
	SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH)
CR
C  SUBROUTINE READACL 
CE
C  FUNCTION: Reads the ACL of a file.W
CE
C  PARAMETERS:
C	FILENAME - Name of file to check.Y
C	ACLENT - String which will be large enough to hold ACL information.,
C=
	IMPLICIT INTEGER (A-Z) 
 &
	INCLUDE '($ACLDEF)'
 F
	CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*),
	CHARACTER NOT_ID*3,
	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
 T
	IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)t
 f
	DO ACCESS_TYPE=1,2
	 POINT = 1L
	 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.n
     &	       (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENI
	      START_ID = INDEX(ACLSTR,'=') + 1.
	      END_ID = INDEX(ACLSTR,'ACCESS') - 2
	      IF (ACLSTR(END_ID:END_ID).EQ.']') THEN 
		 START_ID = END_ID - 1
		 DO WHILEN
     &		   (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0)t
		    START_ID = START_ID - 1V
		 END DOR
		 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 IFF
	      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,'(Q
     &		    '' These users can only read this folder:'')')
	         END IF
		 OUTLEN = 1:
	      END IF 
	      IDLEN = END_ID - START_ID + 1
	      IF (OUTLEN+IDLEN-1.GT.80) THEN.
		 WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)c
		 OUTPUT = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = IDLEN + 2 
	      ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN
		 WRITE (6,'(1X,A)') 
     &			OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)E
	         OUTLEN = 1
	      ELSEC
	         OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = OUTLEN + IDLEN + 1
	      END IFF
	   END IF
	   POINT = POINT + ICHAR(ACLENT(POINT:POINT))
	 END DO
	 IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)I
	END DOE
 I
	RETURN,
	END
  
 K
 (
 2
	SUBROUTINE CONVERT_INFFILEI
 I
	IMPLICIT INTEGER (A-Z) 
 '
	INCLUDE 'BULLUSER.INC'i
 '
	INCLUDE 'BULLFILES.INC'
  
	OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD',
     &	   ACCESS='KEYED',RECORDTYPE='FIXED',
     &	   IOSTAT=IER,ORGANIZATION='INDEXED',
     &	   KEY=(1:12:CHARACTER))
  
	INQUIRE (UNIT=10,RECORDSIZE=RECL)
 F
	RECL = RECL/8
 E
	OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',
     &	   ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3,
     &	   IOSTAT=IER,ORGANIZATION='INDEXED',
     &	   KEY=(1:12:CHARACTER))E
  
	DO WHILE (IER.EQ.0)
	 READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)E
	 IF (IER.EQ.0) WRITE (9) TEMP_USER,
     &			((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)U
	END DO1
 
	CLOSE (UNIT=10,STATUS='DELETE')
  
	CLOSE (UNIT=9)=
 F
	RETURN)
	END
  
  
	SUBROUTINE ERROR_AND_EXIT
 B
	IMPLICIT INTEGER (A-Z))
	T
	CALL ERRSNS(IDUMMY,IER)
	CALL SYS_GETMSG(IER)A
	CALL ENABLE_CTRL_EXIT
 5
	RETURNF
	END
 
  
