C
C  BULLSUB2.FOR, Version 9/3/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
C  NOTE: Subroutine CHECK_ACCESS which is used to see if user has only read
C  access to a folder only works for VMS V4.4 or later.  If you have an
C  early version, modify as indicated.
C
	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
	CALL STR$TRIM(INPUT,INPUT,TRIM)
	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 ADD_ACL(ID,ACCESS,IER)
C
C  SUBROUTINE ADD_ACL
C
C  FUNCTION: Adds ACL to bulletin files.
C
C  PARAMETERS:
C	ID - Character string containing identifier to add to ACL.
C	ACCESS - Character string containing access controls to give to ID.
C	IER - Return error from attempting to set ACL.
C
C  NOTE: The ID must be in the RIGHTS data base.
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	CHARACTER ACLENT*255,ID*(*),ACCESS*(*)

	INCLUDE '($ACLDEF)'

	INCLUDE '($SSDEF)'

	IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='
     &	   //ACCESS//')',ACLENT,,)
	IF (.NOT.IER) THEN
	   IF (IER.EQ.SS$_NOSUCHID.AND.ADDID) THEN
	      CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER)
	      IF (.NOT.IER) RETURN
	      IDENT = USER + ISHFT(GROUP,16)
	      IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,)
	      IF (IER) THEN
	         IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='
     &	           //ACCESS//')',ACLENT,,)
	      END IF
	   END IF
	END IF
	IF (.NOT.IER) RETURN

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT,%LOC(ACLENT))
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist

	LEN = TRIM(FOLDER1_FILE)

	IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)//
     &		'.BULLDIR',%VAL(ACL_ITMLST),,,)
	IF (.NOT.IER) RETURN
	IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)//
     &		'.BULLFIL',%VAL(ACL_ITMLST),,,)
	IF (.NOT.IER) RETURN

	RETURN
	END



	SUBROUTINE DEL_ACL(ID,ACCESS,IER)
C
C  SUBROUTINE DEL_ACL
C
C  FUNCTION: Adds ACL to bulletin files.
C
C  PARAMETERS:
C	ID - Character string containing identifier to add to ACL.
C	ACCESS - Character string containing access controls to give to ID.
C	IER - Return error from attempting to set ACL.
C
C  NOTE: The ID must be in the RIGHTS data base.
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	CHARACTER ACLENT*255,ID*(*),ACCESS*(*)

	INCLUDE '($ACLDEF)'

	IF (ID.NE.' ') THEN
	   IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='
     &	      //ACCESS//')',ACLENT,,)
	   IF (.NOT.IER) RETURN

	   CALL INIT_ITMLST	! Initialize item list
	   CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_DELACLENT,%LOC(ACLENT))
	   CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
	ELSE
	   CALL INIT_ITMLST	! Initialize item list
	   CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))
	   CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist
	END IF

	LEN = TRIM(FOLDER1_FILE)

	IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)//
     &		'.BULLDIR',%VAL(ACL_ITMLST),,,)
	IF (.NOT.IER) RETURN
	IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(1:LEN)//
     &		'.BULLFIL',%VAL(ACL_ITMLST),,,)
	IF (.NOT.IER) RETURN

	RETURN
	END


	SUBROUTINE CREATE_FOLDER
C
C  SUBROUTINE CREATE_FOLDER
C
C  FUNCTION: Creates a new bulletin folder.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFILES.INC'

	IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name

	IF (LEN_T.GT.25) THEN
	   WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')
	   RETURN
	END IF

	IF (.NOT.SETPRV_PRIV().AND.	! /NOTIFY & /READNEW are privileged
     &	    (CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW'))) THEN
	   WRITE (6,'(
     &      '' ERROR: No privs to change all NOTIFY or READNEW.'')')
	   RETURN
	END IF

	CALL OPEN_FILE(7)		! Open folder file
	READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=FOLDER,KEYID=0)
					! See if folder exists

	IF (IER.EQ.0) THEN
	   WRITE (6,'('' ERROR: Specified folder already exists.'')')
	   GO TO 1000
	END IF

	WRITE (6,'('' Enter one line description of folder.'')')

10	CALL GET_LINE(FOLDER_DESCRIP,LENDES)	! Get input line
	FOLDER_DESCRIP = FOLDER_DESCRIP(1:LENDES)	! End fill with spaces
	IF (LENDES.LE.0) GO TO 910
	IF (LENDES.GT.80) THEN			! If too many characters
	   WRITE(6,'('' ERROR: folder must be < 80 characters.'')')
	   GO TO 10
	END IF

	FOLDER_OWNER = USERNAME			! Get present username

	FOLDER_SET = .TRUE.

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

C
C  Folder file is placed in the directory FOLDER_DIRECTORY.
C  The file prefix is the name of the folder.
C

	FD_LEN = TRIM(FOLDER_DIRECTORY)
	IF (FD_LEN.EQ.0) THEN
	 WRITE (6,'('' ERROR: System programmer has disabled folders.'')')
	ELSE
	 FOLDER_FILE = FOLDER_DIRECTORY(1:FD_LEN)//FOLDER
	END IF

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

	IF (IER.NE.0) THEN
	   WRITE(6,'('' ERROR: Cannot create folder directory file.'')')
	   CALL ERRSNS(IDUMMY,IER)
	   CALL SYS_GETMSG(IER)
	   GO TO 910
	END IF

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

	IF (IER.NE.0) THEN
	   WRITE(6,'('' ERROR: Cannot create folder message file.'')')
	   CALL ERRSNS(IDUMMY,IER)
	   CALL SYS_GETMSG(IER)
	   GO TO 910
	END IF

	IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN
				! Will folder have access limitations?
	   FOLDER1_FILE = FOLDER_FILE
	   CLOSE (UNIT=1)
	   CLOSE (UNIT=2)
	   IF (CLI$PRESENT('SEMIPRIVATE')) THEN
	      CALL ADD_ACL('*','R',IER)
	   ELSE
	      CALL ADD_ACL('*','NONE',IER)
	   END IF
	   CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER)
	   OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	    //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)
	   OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
     1	    //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)
	   IF (.NOT.IER) THEN
	      WRITE(6,
     &	      '('' ERROR: Cannot create private folder using ACLs.'')')
	      CALL SYS_GETMSG(IER)
	      GO TO 910
	   END IF
	END IF

	IER = 0
	LAST_NUMBER = 1
	DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.64)
	   READ (7,FMT=FOLDER_FMT,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)
	   LAST_NUMBER = LAST_NUMBER + 1
	END DO

	IF (IER.EQ.0) THEN
	   WRITE (6,'('' ERROR: Limit of 63 folders has been reached.'')')
	   WRITE (6,'('' Unable to add specified folder.'')')
	   GO TO 910
	ELSE
	   FOLDER_NUMBER = LAST_NUMBER - 1
	END IF

	FOLDER_OWNER = USERNAME			! Get present username
	FOLDER_BBOARD = 'NONE'
	FOLDER_BBEXPIRE = 14

	WRITE (7,FMT=FOLDER_FMT) FOLDER,FOLDER_NUMBER,FOLDER_OWNER,
     &			FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE

	CLOSE (UNIT=1)
	CLOSE (UNIT=2)

	NOTIFY = 0
	READNEW = 0
	IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1
	IF (CLI$PRESENT('READNEW')) READNEW = 1
	CALL SET_FOLDER_NOTIFY_READNEW(NOTIFY,READNEW)

	WRITE (6,'('' Folder is now set to '',A)')
     &		FOLDER(1:TRIM(FOLDER))//'.'

	GO TO 1000

910	WRITE (6,'('' Aborting folder creation.'')')
	FOLDER_SET = .FALSE.
	CLOSE (UNIT=1,STATUS='DELETE')
	CLOSE (UNIT=2,STATUS='DELETE')

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

	RETURN

	END





	SUBROUTINE SET_FOLDER_NOTIFY_READNEW(NOTIFY,READNEW)
C
C  SUBROUTINE SET_FOLDER_NOTIFY_READNEW
C
C  FUNCTION: Sets NOTIFY or READNEW defaults for specified folder
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	IF (.NOT.SETPRV_PRIV().AND.INCMD(1:3).EQ.'SET') THEN
	   WRITE (6,'(
     &      '' ERROR: No privs to change all NOTIFY or READNEW.'')')
	   RETURN
	END IF

	CALL OPEN_FILE_SHARED(4)
	DO WHILE (REC_LOCK(IER))
	   READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER)	! Get header
     &      TEMP_USER,LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,
     &	    SET_FLAG,NEW_FLAG,NOTIFY_FLAG
	END DO
	F_POINT = FOLDER_NUMBER/32 + 1
	DO WHILE (IER.EQ.0)
	   IF (NOTIFY.EQ.0) NOTIFY_FLAG(F_POINT) =
     &			IBCLR(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER)
	   IF (NOTIFY.EQ.1) NOTIFY_FLAG(F_POINT) =
     &			IBSET(NOTIFY_FLAG(F_POINT),FOLDER_NUMBER)
	   IF (READNEW.EQ.0) SET_FLAG(F_POINT) =
     &			IBCLR(SET_FLAG(F_POINT),FOLDER_NUMBER)
	   IF (READNEW.EQ.1) SET_FLAG(F_POINT) =
     &			IBSET(SET_FLAG(F_POINT),FOLDER_NUMBER)
	   REWRITE(4,FMT=USER_FMT) TEMP_USER,LOGIN_DATE,LOGIN_TIME,
     &		READ_DATE,READ_TIME,SET_FLAG,NEW_FLAG,NOTIFY_FLAG
	   DO WHILE (REC_LOCK(IER))
	    READ (4,FMT=USER_FMT,KEYGT=TEMP_USER,IOSTAT=IER) TEMP_USER,
     &	     LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,SET_FLAG,
     &	     NEW_FLAG,NOTIFY_FLAG		! Find if there is an entry
	   END DO
	   IF (TEMP_USER.NE.USER_HEADER.AND.
     &			(NOTIFY.EQ.-1.OR.READNEW.EQ.-1)) THEN
	      IER = 1		! Modify READNEW and NOTIFY for all users
	   END IF		! only during folder creation or deletion.
	END DO
	CALL CLOSE_FILE(4)

	RETURN
	END




	SUBROUTINE REMOVE_FOLDER
C
C  SUBROUTINE REMOVE_FOLDER
C
C  FUNCTION: Removes a bulletin folder.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLFILES.INC'

	EXTERNAL CLI$_ABSENT

	CHARACTER RESPONSE*1,TEMP*80

	IER = CLI$GET_VALUE('REMOVE_FOLDER',FOLDER1,LEN_T) ! Get folder name

	IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN
	   IF (.NOT.FOLDER_SET) THEN
	      WRITE (6,'('' ERROR: No folder specified.'')')
	      RETURN
	   ELSE
	      FOLDER1 = FOLDER
	   END IF
	ELSE IF (LEN_T.GT.25) THEN
	   WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')
	   RETURN
	END IF

	CALL OPEN_FILE(7)		! Open folder file
	READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER) FOLDER1,
     &    FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP   ! See if it exists
	FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))//
     &		FOLDER1

	IF (IER.NE.0) THEN
	   WRITE (6,'('' ERROR: No such folder exists.'')')
	   GO TO 1000
	END IF

	IF ((FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()).OR.
     &	     FOLDER1_NUMBER.EQ.0) THEN
	   WRITE (6,'('' ERROR: You are not able to remove the folder.'')')
	   GO TO 1000
	END IF

	CALL GET_INPUT_PROMPT(RESPONSE,LEN,
     &   'Are you sure you want to remove folder '
     &	 //FOLDER1(1:TRIM(FOLDER1))//' (Y/N with N as default): ')
	IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN
	   WRITE (6,'('' Folder was not removed.'')')
	   RETURN
	END IF

	TEMP = FOLDER_FILE
	FOLDER_FILE = FOLDER1_FILE
	TEMPSET = FOLDER_SET
	FOLDER_SET = .TRUE.
	CALL OPEN_FILE(2)			! Remove directory file
	CALL OPEN_FILE(1)			! Remove bulletin file
	CALL CLOSE_FILE_DELETE(1)
	CALL CLOSE_FILE_DELETE(2)
	FOLDER_FILE = TEMP
	FOLDER_SET = TEMPSET

	DELETE (7)

	TEMP_NUMBER = FOLDER_NUMBER
	FOLDER_NUMBER = FOLDER1_NUMBER
	CALL SET_FOLDER_NOTIFY_READNEW(0,0)
	FOLDER_NUMBER = TEMP_NUMBER

	WRITE (6,'('' Folder removed.'')')

	IF (FOLDER.EQ.FOLDER1) FOLDER_SET = .FALSE.

1000	CALL CLOSE_FILE(7)

	RETURN

	END


	SUBROUTINE SELECT_FOLDER(OUTPUT,IER)
C
C  SUBROUTINE SELECT_FOLDER
C
C  FUNCTION: Selects the specified folder.
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	INCLUDE '($RMSDEF)'
	INCLUDE '($SSDEF)'

	COMMON /POINT/ BULL_POINT

	COMMON /ACCESS/ READ_ONLY
	LOGICAL READ_ONLY

	EXTERNAL CLI$_ABSENT

	DIMENSION FIRST_TIME(2)		! Bit set for folder if folder has
	DATA FIRST_TIME /2*0/		! been selected before this.

	IF (OUTPUT) IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1,LEN)
							! Get folder name

	CALL OPEN_FILE_SHARED(7)			! Go find folder

	IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND.
     &	 OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND.
     &	 FOLDER_NUMBER.EQ.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL
	   FOLDER_NUMBER = 0
	   FOLDER_SET = .FALSE.
	   DO WHILE (REC_LOCK(IER))
	      READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER)
     &		FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE
	   END DO
	   IF (OUTPUT) THEN
	      WRITE (6,'('' Folder has been set to '',A)')
     &		 FOLDER(1:TRIM(FOLDER))//'.'
	      BULL_POINT = 0	! Reset bulletin pointer to first bulletin
	   END IF
	   IER = 1
	   CALL CLOSE_FILE(7)
	   READ_ONLY = .FALSE.
	ELSE
	   DO WHILE (REC_LOCK(IER))
	      IF (OUTPUT.OR.FOLDER_NUMBER.EQ.-1) THEN
	       READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER)
     &		FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP
     &		,FOLDER1_BBOARD,FOLDER1_BBEXPIRE
	      ELSE
	       FOLDER1_NUMBER = FOLDER_NUMBER
	       READ (7,FMT=FOLDER_FMT,KEY=FOLDER_NUMBER,KEYID=1,IOSTAT=IER)
     &		FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP
     &		,FOLDER1_BBOARD,FOLDER1_BBEXPIRE
	      END IF
	   END DO

	   CALL CLOSE_FILE(7)

	   IF (IER.EQ.0) THEN				! Folder found
	      FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER1
	      CALL CHKACL
     &		(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)
	      IF (IER) THEN
	       FOLDER_SET = .TRUE.

	       FOLDER = FOLDER1			! Folder successfully set
	       FOLDER_NUMBER = FOLDER1_NUMBER	! so update permanent folder
	       FOLDER_OWNER = FOLDER1_OWNER	! parameters.
	       FOLDER_DESCRIP = FOLDER1_DESCRIP
	       FOLDER_BBOARD = FOLDER1_BBOARD
	       FOLDER_BBEXPIRE = FOLDER1_BBEXPIRE
	       FOLDER_FILE = FOLDER1_FILE

	       F_POINT = FOLDER_NUMBER/32 + 1
	       IF (OUTPUT) THEN
		  WRITE (6,'('' Folder has been set to '',A)') 
     &		    FOLDER(1:LEN)//'.'
		  BULL_POINT = 0	! Reset pointer to first bulletin
	       END IF

	       IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME
     &		  .NE.FOLDER_OWNER) THEN
	          CALL CHECK_ACCESS
     &		  (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',USERNAME,
     &		  READ_ACCESS,WRITE_ACCESS)

	          IF (.NOT.WRITE_ACCESS) THEN
		   IF (OUTPUT)
     &		    WRITE (6,'('' Folder only accessible for reading.'')')
		   READ_ONLY = .TRUE.
		  END IF
	       END IF

	       IF (.NOT.BTEST(FIRST_TIME(F_POINT),FOLDER_NUMBER)) THEN
		 CALL OPEN_FILE(2)
		 CALL READDIR(0,IER)	! Get header info from BULLDIR.DAT
	 	 IF (IER.EQ.1) THEN		! Is header present?
	   	    IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired?
	 	    IF (IER.LE.0) CALL UPDATE  ! Need to update
		 END IF
		 CALL CLOSE_FILE(2)
		 FIRST_TIME(F_POINT)=IBSET(FIRST_TIME(F_POINT),FOLDER_NUMBER)
	       END IF
	       IF (OUTPUT.AND.BTEST(NEW_FLAG(F_POINT),FOLDER_NUMBER)) THEN
		 CALL CHANGE_FLAG(0,2)
		 CALL FIND_NEWEST_BULL		! See if there are new bulletins
		 IF (BULL_POINT.NE.-1) THEN
	     	    WRITE(6,'('' Type READ to read new messages.'')')
						! Alert user if new bulletins
		 ELSE
		    BULL_POINT = 0
		 END IF
	       END IF
	       IER = 1
	      ELSE IF (OUTPUT) THEN
	       IF (IER.EQ.RMS$_PRV) THEN
	        WRITE (6,'('' You are not allowed to access folder.'')')
	        WRITE (6,'('' See '',A,'' if you wish to access folder.'')')
     &			FOLDER1_OWNER(1:TRIM(FOLDER1_OWNER))8
	       ELSE
		WRITE (6,'('' Cannot access specified folder.'')')
		CALL SYS_GETMSG(IER)
	       END IF
	      END IFP
	   ELSE						! Folder not found
	      IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')')r
	      IER = 0
	   END IF
	END IFs

	RETURN.

	END



	SUBROUTINE SHOW_FOLDERv
Ci
C  SUBROUTINE SHOW_FOLDER
CI
C  FUNCTION: Shows the information on any folder.S
C)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'_

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($SSDEF)' 

	INCLUDE '($RMSDEF)'

	EXTERNAL CLI$_ABSENT

	CALL OPEN_FILE_SHARED(7)			! Open folder file

	IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).NE.%LOC(CLI$_ABSENT))
     &		THEN
10	   DO WHILE (REC_LOCK(IER))
	      READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER)
     &		FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP
     &		,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPBB
	   END DO
	   FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))//A
     &		FOLDER1i
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR: Specified folder was not found.'')')
	      CALL CLOSE_FILE(7)n
	      RETURNc
	   ELSE
	      WRITE (6,1010) FOLDER1,FOLDER1_OWNER,
     &			FOLDER1_DESCRIP(1:TRIM(FOLDER1_DESCRIP)) 
	   END IF
	ELSE IF (FOLDER_SET) THEN
	   WRITE (6,1000) FOLDER,FOLDER_OWNER,C
     &			FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP))
	   FOLDER1_FILE = FOLDER_FILE
	   FOLDER1_BBOARD = FOLDER_BBOARD
	   FOLDER1_BBEXPIRE = FOLDER_BBEXPIRE
	   FOLDER1_NUMBER = FOLDER_NUMBER
	ELSE)
	   FOLDER1 = 'GENERAL'$
	   GO TO 10
	END IFE

	IF (CLI$PRESENT('FULL')) THEN
	   CALL CHKACL,
     &		(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)
	   IF (IER.NE.RMS$_PRV) THENA
	      IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THEN
	       WRITE (6,'('' Folder is not a private folder.'')')
	      ELSE)
	       CALL SHOWACL(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL')
	      END IFN
	   END IF
	   IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN
	      IF (FOLDER1_BBOARD.NE.'NONE') THEN_
		 LEN = TRIM(FOLDER1_BBOARD)s
		 IF (LEN.GT.0) THENT
 	          WRITE (6,'('' BBOARD for folder is '',A<LEN>,''.'')')E
     &		 	FOLDER1_BBOARD(1:LEN)A
		 END IFT
		 IF (USERB.EQ.0.AND.GROUPB.EQ.0) THENS
 		  WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')L
		 END IFC
		 IF (FOLDER1_BBEXPIRE.GT.0) THEN
		  WRITE (6,'('' BBOARD expiration is '',I3,'' days.'')')
     &			FOLDER1_BBEXPIREC
		 ELSE 
		  WRITE (6,'('' BBOARD messages will not expire.'')'):
		 END IFa
	      ELSE 
	         WRITE (6,'('' No BBOARD has been defined.'')')
	      END IFi
	      CALL OPEN_FILE_SHARED(4)
	      DO WHILE (REC_LOCK(IER))p
	        READ (4,FMT=USER_FMT,KEY=USER_HEADER,IOSTAT=IER) 
     &            TEMP_USER,LOGIN_DATE,LOGIN_TIME,READ_DATE,READ_TIME,
     &	          SET_FLAG,NEW_FLAG,NOTIFY_FLAG
	      END DOF
	      F_POINT = FOLDER1_NUMBER/32 + 1
	      IF (BTEST(SET_FLAG(F_POINT),FOLDER1_NUMBER)) THEN
		 WRITE (6,'('' Default is READNEW.'')')E
	      ELSEA
		 WRITE (6,'('' Default is NOREADNEW.'')')A
	      END IF(
	      IF (BTEST(NOTIFY_FLAG(F_POINT),FOLDER1_NUMBER)) THEND
		 WRITE (6,'('' Default is NOTIFY.'')')
	      ELSE
		 WRITE (6,'('' Default is NONOTIFY.'')')
	      END IF2
	      CALL CLOSE_FILE(4),
	   END IF
	END IFA

	CALL CLOSE_FILE(7)T

	RETURNr

1000	FORMAT(' Current folder is: ',A25,' Owner: ',A12,
     &		' Description: ',/,1X,A)
1010	FORMAT(' Folder name is: ',A25,' Owner: ',A12,_
     &		' Description: ',/,1X,A)
	END


	SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)N
C
C  SUBROUTINE DIRECTORY_FOLDERSL
C,
C  FUNCTION: Display all FOLDER entries.
CD
	IMPLICIT INTEGER (A - Z)L

	INCLUDE 'BULLFOLDER.INC'E

	COMMON /PAGE/ PAGE_LENGTH

	DATA SCRATCH_D1/0/d

	IF (FOLDER_COUNT.GT.0) GO TO 50		! Skip init steps if this is
						! not the 1st page of folder

C'
C  Folder listing is first buffered into temporary memory storage before
C  being outputted to the terminal.  This is to be able to quickly close the
C  folder file, and to avoid the possibility of the user holding the screen,
C  and thus causing the folder file to stay open.  The temporary memory'
C  is structured as a linked-list queue, where SCRATCH_D1 points to the header
C  of the queue.  See BULLSUBS.FOR for more description of the queue.L
CP

	IF (SCRATCH_D1.EQ.0) THEN		! Is queue empty?E
	   CALL LIB$GET_VM(132,SCRATCH_D)	! If so, allocated memory
	   CALL MAKE_CHAR(%VAL(SCRATCH_D),120)	! Form a character stringl
	   SCRATCH_D1 = SCRATCH_D		! Init header pointer
	ELSE					! Else queue is not emptyi
	   SCRATCH_D = SCRATCH_D1		! so reinit queue pointerI
	END IF					! to the header.

	CALL OPEN_FILE_SHARED(7)		! Get folder file

	NUM_FOLDER = 0I
	IER = 0
	FOLDER1 = '                         '	! Start folder search
	DO WHILE (IER.EQ.0)			! Copy all bulletins from filer
	   DO WHILE (REC_LOCK(IER))
	      READ (7,FMT=FOLDER_FMT,KEYGT=FOLDER1,KEYID=0,IOSTAT=IER)F
     &		FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP
	   END DO
	   IF (IER.EQ.0) THEN
	      NUM_FOLDER = NUM_FOLDER + 1
	      CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM) 
	   END IF
	END DOh

	CALL CLOSE_FILE(7)			! We don't need file anymore

	IF (NUM_FOLDER.EQ.0) THEN
	   WRITE (6,'('' There are no folders.'')')
	   RETURN
	END IF'

C
C  Folder entries are now in queue.  Output queue entries to screen.
CO

	SCRATCH_D = SCRATCH_D1			! Init queue pointer to header

	FOLDER_COUNT = 1			! Init folder number counter

50	CALL LIB$ERASE_PAGE(1,1)		! Clear the screen 

	DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*2,PAGE_LENGTH-4)
			! If more entries then page size, truncate output
	DO I=FOLDER_COUNT,FOLDER_COUNT+DISPLAY/2-1E
	   CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER_COM)
	   WRITE (6,1000) FOLDER1,FOLDER1_OWNER,FOLDER1_DESCRIP
	   FOLDER_COUNT = FOLDER_COUNT + 1	! Update folder counter'
	END DOE

	IF (FOLDER_COUNT.GT.NUM_FOLDER) THEN	! Outputted all entries?
	   FOLDER_COUNT = 0			! Yes. Set counter to 0.E
	ELSEa
	   WRITE(6,1010)			! Else say there are moreL
	END IFD

	RETURN

1000	FORMAT(' Folder: ',A25,' Owner: ',A12,' Description:',/,1X,A80)
1010	FORMAT(1X,/,' Press RETURN for more...',/)	

	END


	SUBROUTINE SET_ACCESS(ACCESS)
CO
C  SUBROUTINE SET_ACCESS
C 
C  FUNCTION: Set access on folder for specified ID.N
CS
C  PARAMETERS:
C	ACCESS  -  Logical: If .true., grant access, if .false. deny access,
CN

	IMPLICIT INTEGER (A-Z)A

	INCLUDE 'BULLFOLDER.INC'C

	INCLUDE 'BULLUSER.INC'L

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($SSDEF)'B

	LOGICAL ACCESS,ALL,READONLY

	EXTERNAL CLI$_ABSENT=

	CHARACTER ID*25,RESPONSE*1)

	IF (CLI$PRESENT('ALL')) THEN'
	   ALL = .TRUE.
	ELSEF
	   ALL = .FALSE. 
	END IFE

	IF (CLI$PRESENT('READONLY')) THEN
	   READONLY = .TRUE.s
	ELSEs
	   READONLY = .FALSE.
	END IFR

	IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name1

	IF (IER.EQ.%LOC(CLI$_ABSENT)) THENT
	   IF (.NOT.FOLDER_SET) THENT
	      WRITE (6,'('' ERROR: No folder specified.'')') 
	      RETURN
	   ELSE
	      FOLDER1 = FOLDER
	   END IF
	ELSE IF (LEN.GT.25) THENl
	   WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')f
	   RETURN
	END IF 

	IF (.NOT.ALL) THEN 
	   IER = CLI$GET_VALUE('ACCESS_ID',ID,LEN) 	! Get IDW
	   IF (LEN.GT.25) THENe
	      WRITE(6,'('' ERROR: ID name must be < 26 characters.'')')
	      RETURN=
	   END IF
	END IFL

	CALL OPEN_FILE(7)		! Open folder file
	READ (7,FMT=FOLDER_FMT,KEY=FOLDER1,KEYID=0,IOSTAT=IER)
     &	 FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP ! See if it existsI
	CALL CLOSE_FILE(7)E

	IF ((.NOT.ALL).AND.(ID.EQ.FOLDER1_OWNER)) THEN_
	 WRITE (6,'(R
     &	  '' ERROR: Cannot modify access for owner of folder.'')')O
	 RETURN
	END IF)

	IF (IER.NE.0) THEN
	   WRITE (6,'('' ERROR: No such folder exists.'')')
	ELSE IF (FOLDER1_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
	   WRITE (6,L
     &	'('' ERROR: You are not able to modify access to the folder.'')')
	ELSEf
	   FOLDER1_FILE = FOLDER_DIRECTORY(1:TRIM(FOLDER_DIRECTORY))//O
     &		FOLDER1E
	   CALL CHKACL
     &		(FOLDER1_FILE(1:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)
	   IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENl
	     IF ((ALL.AND..NOT.READONLY).OR.(.NOT.ACCESS)) THEN
	        WRITE (6,'('' ERROR: Folder is not a private folder.'')')
		RETURN
	     END IF
	     CALL GET_INPUT_PROMPT(RESPONSE,LEN,S
     &      'Folder is not private. Do you want to make it so? (Y/N): ')
	     IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THENL
	       WRITE (6,'('' Folder access was not changed.'')')D
	       RETURN
	     ELSE
	       IF (READONLY.AND.ALL) THEN
	          CALL ADD_ACL('*','R',IER)
	       ELSE
	          CALL ADD_ACL('*','NONE',IER)T
	       END IF
	       CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)I
	     END IF
	   END IF
	   IF (ACCESS) THEN
	      IF (.NOT.ALL) THENF
	         IF (READONLY) THEN
	            CALL ADD_ACL(ID,'R',IER)I
		 ELSE 
	            CALL ADD_ACL(ID,'R+W',IER)N
		 END IF 
	      ELSEQ
	         IF (READONLY) THEN
	            CALL ADD_ACL('*','R',IER)
		 ELSE 
		    CALL DEL_ACL(' ','R+W',IER) 
		 END IF	
	      END IF(
	   ELSE
	      IF (ALL) THEN
		 CALL DEL_ACL('*','R',IER)
	      ELSEL
	         CALL DEL_ACL(ID,'R+W',IER)
	         IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER)
	      END IF 
	   END IF
	   IF (.NOT.IER) THEN
	      WRITE(6,'('' ERROR: Cannot modify ACL of folder files.'')')
	      CALL SYS_GETMSG(IER) 
	   ELSE
	      WRITE (6,'('' Access to folder has been modified.'')') 
	   END IF
	END IFE

	RETURND

	END



	SUBROUTINE CHKACL(FILENAME,IERACL)
C 
C  SUBROUTINE CHKACL
CN
C  FUNCTION: Checks ACL of given file.
C 
C  PARAMETERS:
C	FILENAME - Name of file to check.C
C	IERACL   - Error returned for attempt to open file.N
CE

	IMPLICIT INTEGER (A-Z)T

	CHARACTER*(*) FILENAMEF

	INCLUDE '($ACLDEF)'
	INCLUDE '($SSDEF)'I

	CHARACTER*255 ACLENT,ACLSTR

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

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

	IF (IERACL.EQ.SS$_ACLEMPTY) THENF
	   IERACL = SS$_NORMAL.OR.IERACLI
	ELSE(
	   CALL DISABLE_PRIVS
	   IERACL = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,E
     &					%VAL(ACL_ITMLST),,,)F
	   CALL ENABLE_PRIVS 
	END IF,

	RETURN 
	END



	SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS)
C)
C  SUBROUTINE CHECK_ACCESS
CF
C  FUNCTION: Checks ACL of given file.
CR
C  PARAMETERS:
C	FILENAME - Name of file to check.L
C	USERNAME - Name of user to check access for.
C	READ_ACCESS - Error returned indicating read access.
C	WRITE_ACCESS - Error returned indicating write access.
CN
C  NOTE: SYS$CHECK_ACCESS is only available under V4.4 or later.
C	If you have an earlier version, comment out the lines which call
C	it and set both READ_ACCESS and WRITE_ACCESS to 1, which will 
C	allow program to run, but will not allow READONLY access feature.U
CR

	IMPLICIT INTEGER (A-Z) 

	CHARACTER FILENAME*(*),USERNAME*(*)

	INCLUDE '($ACLDEF)'
	INCLUDE '($CHPDEF)'
	INCLUDE '($ARMDEF)'

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS))
	CALL ADD_2_ITMLST(4,CHP$_ACCESS,%LOC(ACCESS))
	CALL END_ITMLST(ACL_ITMLST)	! Get address of itemlist

	FLAGS = 0		! Default is no access

	ACCESS = ARM$M_READ	! Check if user has read access
	READ_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,L
     &		%VAL(ACL_ITMLST))_

	ACCESS = ARM$M_WRITE	! Check if user has write access
	WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,
     &		%VAL(ACL_ITMLST))D

	RETURNF
	END




	SUBROUTINE SHOWACL(FILENAME)F
Ce
C  SUBROUTINE SHOWACL 
CL
C  FUNCTION: Shows users who are allowed to read private bulletin.
CT
C  PARAMETERS:
C	FILENAME - Name of file to check.R
C
	IMPLICIT INTEGER (A-Z)F

	INCLUDE '($ACLDEF)'

	CHARACTER*(*) FILENAMEe

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

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

	CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR)
	CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH)M

	CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH)

	RETURNT
	END


	/
	SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH)
CI
C  SUBROUTINE READACLE
CF
C  FUNCTION: Reads the ACL of a file.e
Ca
C  PARAMETERS:
C	FILENAME - Name of file to check.
C	ACLENT - String which will be large enough to hold ACL information. 
CP
	IMPLICIT INTEGER (A-Z).

	INCLUDE '($ACLDEF)'

	CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)H
	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

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

	DO ACCESS_TYPE=1,2P
	 POINT = 1 
	 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.E
     &	       (ACCESS_TYPE.EQ.2.AND.INDEX(ACLSTR,'READ)').GT.0)) THENU
	      START_ID = INDEX(ACLSTR,'=') + 1D
	      END_ID = INDEX(ACLSTR,'ACCESS') - 2
	      IF (ACLSTR(END_ID:END_ID).EQ.']') THEN1
		 START_ID = END_ID - 1
		 DO WHILER
     &		   (INDEX(NOT_ID,ACLSTR(START_ID:START_ID)).EQ.0)U
		    START_ID = START_ID - 1R
		 END DOL
		 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 IFE
	      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,'(I
     &		    '' These users can only read this folder:'')')
	         END IF
		 OUTLEN = 1y
	      END IFO
	      LEN = END_ID - START_ID + 1
	      IF (OUTLEN+LEN-1.GT.80) THENR
		 WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1) 
		 OUTPUT = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = LEN + 2O
	      ELSE IF (OUTLEN+LEN-1.EQ.80) THEN
		 WRITE (6,'(1X,A)') 
     &			OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)R
	         OUTLEN = 1
	      ELSE 
	         OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//','
		 OUTLEN = OUTLEN + LEN + 1
	      END IFT
	   END IF
	   POINT = POINT + ICHAR(ACLENT(POINT:POINT))
	 END DO
	 IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)	
	END DOD

	RETURNH
	END




	SUBROUTINE PRINT
C 
C  SUBROUTINE PRINTT
C(
C  FUNCTION:  Print header to queue.
C 

	IMPLICIT INTEGER (A-Z)E

	INCLUDE '($SJCDEF)'

	CHARACTER*32 QUEUE

	INTEGER*2 FILE_ID(14)
	INTEGER*2 IOSB(4)
	EQUIVALENCE (IOSB(1),JBC_ERROR)

	CHARACTER*80 INPUT.

	COMMON /POINT/ BULL_POINT

	INCLUDE 'BULLDIR.INC'

	IF (BULL_POINT.EQ.0) THEN	! If no bulletin has been readF
	   WRITE(6,1010)		! Write error
	   RETURN			! And return.
	END IF 

	CALL OPEN_FILE_SHARED(2)e

	CALL READDIR(BULL_POINT,IER)	! Get info for specified bulletinn

	IF (IER.NE.BULL_POINT+1) THEN	! Was bulletin found?
	   WRITE(6,1030)
	   CALL CLOSE_FILE(2)		! If not, then error out
	   RETURN
	END IF)

	CALL CLOSE_FILE(2) 

	CALL OPEN_FILE_SHARED(1)	! Open BULLETIN file

	IF (.NOT.SETPRV_PRIV()) THEN		! If no SETPRV, remove SYSPRV
	   CALL DISABLE_PRIVS			! privileges when trying to
	END IF					! create new file.

	OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER,
     &		STATUS='NEW',CARRIAGECONTROL='LIST')

	CALL ENABLE_PRIVS

	IF (CLI$PRESENT('HEADER')) THEN		! Printout header?
	   WRITE(3,1050) DESCRIP		! Output bulletin header info
	   WRITE(3,1060) FROM,DATEn
	END IFd

	LEN =81
	DO I=BLOCK,BLOCK+LENGTH-1	! Copy bulletin into file
	   DO WHILE (LEN.GT.0)'
	      CALL GET_BULL(I,INPUT,LEN)(
	      IF (LEN.GT.0) WRITE(3,'(A)') INPUT(1:TRIM(INPUT))
	   END DO
	   LEN = 80
	END DOS

	CLOSE (UNIT=3)			! Bulletin copy completed

	CALL CLOSE_FILE(1)n

	CALL INIT_ITMLST	! Initialize item list
	CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION,
     &		%LOC('SYS$LOGIN:BULL.LIS'))

	IER = CLI$GET_VALUE('QUEUE',QUEUE,LEN) 		! Get queue name
	IF (LEN.EQ.0) THENT
	   QUEUE = 'SYS$PRINT'n
	   LEN = 9r
	END IF

	CALL ADD_2_ITMLST(LEN,SJC$_QUEUE,%LOC(QUEUE))
	CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0)

	IF (CLI$PRESENT('NOTIFY')) THEN
	   CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0)
	END IFA

	IF (.NOT.SETPRV_PRIV()) THEN		! If no SETPRV, remove SYSPRV
	   CALL DISABLE_PRIVS			! privileges when trying to
	END IF					! create new file.

	CALL END_ITMLST(SJC_ITMLST)
	7
	IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)O
	IF (IER.AND.(.NOT.JBC_ERROR)) THENS
	   CALL SYS_GETMSG(JBC_ERROR)
	   IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;')
	ELSE IF (.NOT.IER) THEN
	   CALL SYS_GETMSG(IER)
	   IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;')
	END IFE

	CALL ENABLE_PRIVS			! Reset SYSPRV privileges

	RETURNC

900	CALL ERRSNS(IDUMMY,IER)R
	CALL ENABLE_PRIVS			! Reset SYSPRV privileges
	CLOSE (UNIT=3,STATUS='DELETE')R
	CALL CLOSE_FILE(1)C
	WRITE(6,1000)
	CALL SYS_GETMSG(IER)T

	RETURN 

1000	FORMAT(' ERROR: Unable to open temporary file
     & SYS$LOGIN:BULL.LIS for printing.')R
1010	FORMAT(' ERROR: You have not read any message.')D
1030	FORMAT(' ERROR: Specified message was not found.')B
1040	FORMAT(' Message ',I3,' written to ',A)
1050	FORMAT('Description: ',A53)
1060	FORMAT('From: ',A12,' Date: ',A11,/)K

	END



	SUBROUTINE SET_BBOARD(BBOARD)
C/
C  SUBROUTINE SET_BBOARD
C.
C  FUNCTION: Set username for BBOARD for selected folder.N
CA
	IMPLICIT INTEGER (A-Z) 

	PARAMETER UAF$V_DISACNT = 4

	INCLUDE 'BULLFOLDER.INC' 

	INCLUDE 'BULLUSER.INC'A

	INCLUDE 'BULLFILES.INC'

	EXTERNAL CLI$_ABSENT 

	CHARACTER EXPIRE*3,INPUT_BBOARD*12V

	IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN
	 WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')')_
	 RETURN
	END IFN

	IF (FOLDER_OWNER.EQ.USERNAME.OR.SETPRV_PRIV()) THEN

	   CALL OPEN_FILE(7)		! Open folder fileB
	   READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER))
     &		FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB

	   IF (BBOARD) THEN
	      IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN)
	      IF (IER.NE.%LOC(CLI$_ABSENT)) THENl
		 CALL GET_UAF:
     &		   (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER)R
	         IF (IER.AND..NOT.BTEST(FLAGS,UAF$V_DISACNT)) THEN ! DISUSER?
	            WRITE (6,'L
     &		    ('' ERROR: BBOARD account needs DISUSER flag set.'')')
		    IER = 0 
		 END IFU
		 IF (IER) THEN
	          READ (7,FMT=FOLDER_FMT,KEY='GENERAL',KEYID=0,IOSTAT=IER)F
     &		   FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP 
     &		   ,FOLDER1_BBOARD,FOLDER1_BBEXPIREE
		  DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR.E
     &		     FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0)
	           READ (7,FMT=FOLDER_FMT,IOSTAT=IER)
     &		   FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,FOLDER1_DESCRIP'
     &		   ,FOLDER1_BBOARD,FOLDER1_BBEXPIREi
	          END DO 
		  IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND. 
     &		      FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN
		   WRITE (6,'(
     &		    '' ERROR: Account used by other folder.'')')
		   CALL CLOSE_FILE(7)A
		   RETURNm
		  ELSE
	           READ (7,FMT=FOLDER_FMT,KEY=FOLDER,KEYID=0,IOSTAT=IER)B
     &		    FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		    ,FOLDER_BBOARD,FOLDER_BBEXPIRE
		   FOLDER_BBOARD = INPUT_BBOARDN
		   IF (CLI$PRESENT('SPECIAL')) THEN	! SPECIAL specified?
		     USERB = 0		! Set UIC to [0,0] to indicate to useN
		     GROUPB = 0		! special procedure to check BBOARD mailh
		   END IF 
		  END IF
		 ELSEe
		  CALL CLOSE_FILE(7)
		  RETURN
		 END IFr
	      ELSE IF (CLI$PRESENT('SPECIAL')) THEN
	       USERB = 0 
	       GROUPB = 0
	       DO I=1,LEN(FOLDER_BBOARD)o
		  FOLDER_BBOARD(I:I) = ' '
	       END DO
	      ELSE IF (FOLDER_BBOARD.EQ.'NONE') THENa
	       WRITE (6,'('' ERROR: No BBOARD specified for folder.'')')u
	      END IFT

	      IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN)
	      IF (IER.NE.%LOC(CLI$_ABSENT)) THENP
	         IF (EX_LEN.GT.3) EX_LEN = 3e
	         READ (EXPIRE,'(I<EX_LEN>)') TEMP
		 IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN
		    WRITE (6,'('' ERROR: Expiration cannot be > '',S
     &			I3,'' days.'')') BBEXPIRE_LIMIT
		    CALL CLOSE_FILE(7)
		    RETURN
		 ELSE IF (TEMP.LE.0) THEN 
		    WRITE (6,'('' ERROR: Expiration must be > 0.'')')N
		    CALL CLOSE_FILE(7)
		    RETURN
		 ELSE 
		    FOLDER_BBEXPIRE = TEMP
		 END IF 
	      ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN
		 FOLDER_BBEXPIRE = -1 
	      END IF 
	   ELSE
	      FOLDER_BBOARD = 'NONE'F
	   END IF

	   REWRITE (7,FMT=FOLDER_FMT,IOSTAT=IER)	
     &		FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
     &		,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
	   CALL CLOSE_FILE(7)
	   WRITE (6,'('' BBOARD has been modified for folder.'')')D
	ELSE
	   WRITE (6,'('' You are not authorized to modify BBOARD.'')')L
	END IF 

	RETURNR
	END




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

	IMPLICIT INTEGER (A-Z)e

	PARAMETER UAF$V_DISACNT = 4, UAF$L_UIC = '24'XD
	PARAMETER UAF$L_ACCOUNT = 53i
	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)O

	INTEGER*2 USER2,GROUP2R

	CALL OPEN_FILE_SHARED(8)A

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

	CALL CLOSE_FILE(8) 

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

	RETURN/
	END



	SUBROUTINE DCLEXH(EXIT_ROUTINE)

	IMPLICIT INTEGER (A-Z)S

	INTEGER*4 EXBLK(4)E

	EXBLK(2) = EXIT_ROUTINE
	EXBLK(3) = 1l
	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_ITMLSTS
	CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT))
	CALL END_ITMLST(CRELNM_ITMLST)S

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

	RETURN
	END

