From:	CRDGW2::CRDGW2::MRGATE::"SMTP::PFCVAX.PFC.MIT.EDU::BULLETIN" 21-JUL-1989 10:26
To:	MRGATE::"ARISIA::EVERHART"
Subj:	BULLETIN5.FOR

Message-Id:  <8907211344.AA23705@crdgw1.ge.com>
Received: from PFCVAX.PFC.MIT.EDU by mitvma.mit.edu (IBM VM SMTP R1.2.1MX) with TCP; Fri, 21 Jul 89 08:56:52 EDT
Date: Fri, 21 Jul 89 08:38 EDT
From: BULLETIN@PFCVAX.PFC.MIT.EDU
Subject: BULLETIN5.FOR
To: EVERHART@ARISIA.DECNET
X-Vms-To: IN%"EVERHART%ARISIA.DECNET@CRDGW1.GE.COM"

C
C  BULLETIN5.FOR, Version 5/16/89
C  Purpose: Contains subroutines for the bulletin board utility program.
C  Environment: MIT PFC VAX-11/780, VMS
C  Programmer: Mark R. London
C
	SUBROUTINE SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF)
C
C  SUBROUTINE SET_FOLDER_DEFAULT
C
C  FUNCTION: Sets flag defaults for specified folder
C
	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLUSER.INC'

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	EXTERNAL CLI$_NEGATED

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

	CALL OPEN_BULLUSER_SHARED
	CALL READ_USER_FILE_HEADER(IER)
	IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG_DEF,FOLDER_NUMBER)
	IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG_DEF,FOLDER_NUMBER)
	IF (READNEW.EQ.0) CALL CLR2(SET_FLAG_DEF,FOLDER_NUMBER)
	IF (READNEW.EQ.1) CALL SET2(SET_FLAG_DEF,FOLDER_NUMBER)
	IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG_DEF,FOLDER_NUMBER)
	IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG_DEF,FOLDER_NUMBER)
	REWRITE(4) USER_HEADER

	FLAG = 0
	IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',TEMP_USER)
	IF (.NOT.IER) THEN
	   IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',TEMP_USER)
	END IF
	READ (TEMP_USER(:1),'(I1)',IOSTAT=IER) FLAG

	IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND.
     &		CLI$PRESENT('CLUSTER').EQ.%LOC(CLI$_NEGATED)) THEN
	   CALL OPEN_BULLNOTIFY
	   READ (10,KEY='*',IOSTAT=IER)
	   IF (IER.EQ.0) DELETE (UNIT=10)
	   FLAG = -1
	END IF

	IF (BRIEF.NE.-1.AND.NOTIFY.NE.-1.AND.READNEW.NE.-1) THEN
	   CALL READ_USER_FILE(IER)
	   DO WHILE (IER.EQ.0)
	      IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN
	         IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER)
	         IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_FLAG,FOLDER_NUMBER)
	         IF (READNEW.EQ.0) CALL CLR2(SET_FLAG,FOLDER_NUMBER)
	         IF (READNEW.EQ.1) CALL SET2(SET_FLAG,FOLDER_NUMBER)
	         IF (BRIEF.EQ.0) CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER)
	         IF (BRIEF.EQ.1) CALL SET2(BRIEF_FLAG,FOLDER_NUMBER)
	         REWRITE(4) TEMP_USER//USER_ENTRY(13:)
		 IF (FLAG.EQ.-1) WRITE (10,IOSTAT=IER) TEMP_USER
	      END IF
	      CALL READ_USER_FILE(IER)
	   END DO
	END IF

	IF (FLAG.EQ.-1) THEN
	   CALL CLOSE_BULLNOTIFY
	ELSE IF (NOTIFY.EQ.1.AND.BTEST(FLAG,1).AND.
     &	     CLI$PRESENT('CLUSTER').NE.%LOC(CLI$_NEGATED)) THEN
	   WRITE (6,'('' NOTE: In a cluster, /ALL or /DEFAULT '',
     &		  ''causes all users to be notified.'')')
	   WRITE (6,'('' They will not be able to disable this.'',
     &		  '' See HELP SET NOTIFY for more info.'')')
	   CALL OPEN_BULLNOTIFY
	   CALL CLOSE_BULLNOTIFY_DELETE
	   CALL OPEN_BULLNOTIFY
	   WRITE (10) '*           '
	   CALL CLOSE_BULLNOTIFY
	ELSE IF (NOTIFY.EQ.0.AND.BTEST(FLAG,1)) THEN
	   CALL OPEN_BULLNOTIFY
	   READ (10,IOSTAT=IER) TEMP_USER
	   IF ((IER.EQ.0.AND.TEMP_USER.EQ.'*').OR.
     &		(BRIEF.NE.-1.AND.READNEW.NE.-1)) THEN
	      CALL CLOSE_BULLNOTIFY_DELETE
	   ELSE
	      CALL CLOSE_BULLNOTIFY
	   END IF
	END IF

	CALL CLOSE_BULLUSER

	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'

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	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 GET_INPUT_PROMPT(RESPONSE,LEN,
     &   'Are you sure you want to remove folder '
     &	 //FOLDER1(: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

	CALL OPEN_BULLFOLDER				! Open folder file
	CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)	! See if folder exists
	FOLDER1_FILE = FOLDER_DIRECTORY(: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

	TEMP = FOLDER_FILE
	FOLDER_FILE = FOLDER1_FILE

	REMOTE_SET_SAVE = REMOTE_SET
	REMOTE_SET = .FALSE.

	IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER1_FLAG,2)) THEN
	   FLEN = TRIM(FOLDER1_BBOARD)
	   IF (INDEX(FOLDER1_BBOARD,'*').GT.0) FLEN = FLEN - 1
	   OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,
     &		RECL=256,FILE=FOLDER1_BBOARD(3:FLEN)
     &		//'::"TASK=BULLETIN1"')
	   IF (IER.EQ.0) THEN		! Deregister remote SYSTEM folder
	      IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN
	         CALL OPEN_BULLDIR
	         CALL READDIR(0,IER)
		 IF (IER.EQ.1) FOLDER1 = BULLDIR_HEADER(13:)
		 CALL CLOSE_BULLDIR
	      END IF
	      WRITE (17,'(2A)',IOSTAT=IER) 1,FOLDER1	! Select folder
	      IF (IER.EQ.0) READ(17,'(5A)',IOSTAT=IER)	! Throw away response
	      IF (IER.EQ.0) WRITE(17,'(2A)',IOSTAT=IER) 14,0	! Deregister
	      CLOSE (UNIT=17)
	   END IF
	END IF

	TEMPSET = FOLDER_SET
	FOLDER_SET = .TRUE.
	CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
		! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
		! in case files don't exist and are created.
	CALL OPEN_BULLDIR			! Remove directory file
	CALL OPEN_BULLFIL			! Remove bulletin file
	CALL OPEN_BULLNOTIFY
	CALL CLOSE_BULLNOTIFY_DELETE
	CALL CLOSE_BULLFIL_DELETE
	CALL CLOSE_BULLDIR_DELETE
	CALL SYS$SETDFPROT(CUR_DEF_PROT,)	! Reset default protection
	FOLDER_FILE = TEMP
	FOLDER_SET = TEMPSET

	DELETE (7)

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

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

	IF (FOLDER.EQ.FOLDER1) THEN
	   FOLDER_SET = .FALSE.
	ELSE
	   REMOTE_SET = REMOTE_SET_SAVE
	END IF

1000	CALL CLOSE_BULLFOLDER

	RETURN

	END


	SUBROUTINE SELECT_FOLDER(OUTPUT,IER)
C
C  SUBROUTINE SELECT_FOLDER
C
C  FUNCTION: Selects the specified folder.
C
C  INPUTS:
C	OUTPUT - Specifies whether status messages are outputted.
C
C  NOTES:
C	FOLDER_NUMBER is used for selecting the folder.
C	If FOLDER_NUMBER = -1, the name stored in FOLDER1 is used.
C	If FOLDER_NUMBER = -2, the name stored in FOLDER1 is used,
C	but the folder is not selected if it is remote.
C	If the specified folder is on a remote node and does not have
C	a local entry (i.e. specified via NODENAME::FOLDERNAME), then
C	FOLDER_NUMBER is set to -1.
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

	COMMON /COMMAND_LINE/ INCMD
	CHARACTER*132 INCMD

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
	DATA REMOTE_SET /.FALSE./

	COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
	COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	COMMON /TAGS/ BULL_TAG,READ_TAG

	EXTERNAL CLI$_ABSENT

	CHARACTER*80 LOCAL_FOLDER1_DESCRIP:

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

	COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR.I
     &		  (INCMD(:3).EQ.'DIR').OR.(INCMD(:3).EQ.'IND').OR.
     &		  (INCMD(:3).EQ.'REP').OR.(INCMD(:3).EQ.'SEL').OR.
     &		  (INCMD(:3).EQ.'SET')

	IF (.NOT.OUTPUT.OR.FOLDER_NUMBER.NE.-1.OR.COMMAND) THEN
	   IF (OUTPUT) THEN			! Get folder name
	      IER = CLI$GET_VALUE('SELECT_FOLDER',FOLDER1)r
	   END IF

	   FLEN = TRIM(FOLDER1)		! Add GENERAL after :: if no
	   IF (FLEN.GT.1) THEN		! name specified after the ::
	      IF (FOLDER1(FLEN-1:FLEN).EQ.'::') THENU
	         FOLDER1 = FOLDER1(:FLEN)//'GENERAL'_
	      END IF
	   END IF

	   IF (((IER.EQ.%LOC(CLI$_ABSENT).OR.FOLDER1.EQ.'GENERAL').AND.
     &	    OUTPUT).OR.((FOLDER_NUMBER.EQ.0.OR.(FOLDER1.EQ.'GENERAL'.AND.
     &	    FOLDER_NUMBER.LE.-1)).AND..NOT.OUTPUT)) THEN ! Select GENERAL
	      FOLDER_NUMBER = 0
	      FOLDER1 = 'GENERAL'
	   END IF
	END IF 

	CALL OPEN_BULLFOLDER_SHARED			! Go find folder'

	REMOTE_TEST = 0

	IF (OUTPUT.OR.FOLDER_NUMBER.LE.-1) THEN
	   REMOTE_TEST = INDEX(FOLDER1,'::').
	   IF (REMOTE_TEST.GT.0) THEN
	      FOLDER1_BBOARD = '::'//FOLDER1(:REMOTE_TEST-1)_
	      FOLDER1 = FOLDER1(REMOTE_TEST+2:TRIM(FOLDER1))A
	      FOLDER1_NUMBER = -1
	      IER = 0
	   ELSE IF (INCMD(:2).EQ.'SE') THEN
	      CALL READ_FOLDER_FILE_KEYNAME_TEMPD
     &				(FOLDER1(:TRIM(FOLDER1)),IER)I
	   ELSE
	      CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
	   END IF
	ELSE(
	   FOLDER1_NUMBER = FOLDER_NUMBER
	   CALL READ_FOLDER_FILE_KEYNUM_TEMP(FOLDER_NUMBER,IER)
	END IFR

	IF (BTEST(FOLDER1_FLAG,29)) THEN	! Error in folder flag!!
	   FOLDER1_FLAG = FOLDER1_FLAG.AND.3
	   F1_EXPIRE_LIMIT = 0U
	   CALL REWRITE_FOLDER_FILE_TEMP
	END IFO

	CALL CLOSE_BULLFOLDER

	IF (IER.EQ.0.AND.FOLDER1_BBOARD(:2).EQ.'::') THEN
	   IF (FOLDER_NUMBER.EQ.-2) RETURN	! Don't allowA
	   LOCAL_FOLDER1_FLAG = FOLDER1_FLAG
	   LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP(
	   CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER).
	   IF (IER.NE.0) THEN
	      IF (OUTPUT) THENE
	         WRITE (6,'('' ERROR: Unable to connect to folder.'')')
	      END IFN
	      RETURNE
	   END IF
	   IF (REMOTE_TEST.GT.0) THEN	! Folder specified with "::"
	      FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'//
     &			FOLDER1
	      FOLDER1_NUMBER = -1
	   ELSE				! True remote folder
	      FOLDER1_DESCRIP = LOCAL_FOLDER1_DESCRIP	! Use local description
	      IF (BTEST(FOLDER1_FLAG,0)) THEN	! Copy remote folder protection
		 LOCAL_FOLDER1_FLAG = IBSET(LOCAL_FOLDER1_FLAG,0)
	      ELSE
		 LOCAL_FOLDER1_FLAG = IBCLR(LOCAL_FOLDER1_FLAG,0)L
	      END IF 
	      FOLDER1_FLAG = LOCAL_FOLDER1_FLAG		! Use local flag infoC
	      CALL OPEN_BULLFOLDER	! Update local folder informationn
              CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER)
	      FOLDER_COM = FOLDER1_COMR
	      CALL REWRITE_FOLDER_FILE 
	      CALL CLOSE_BULLFOLDER
	   END IF
	   REMOTE_SET = .TRUE.o
	END IF 

	IF (IER.EQ.0) THEN				! Folder foundL
	   FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER1L
	   IF (BTEST(FOLDER1_FLAG,0).AND.FOLDER1_BBOARD(:2).NE.'::'
     &		.AND..NOT.SETPRV_PRIV()) THEND
				! Is folder protected and not remote?.
	      CALL CHKACL
     &		(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) 
	      IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME_
     &		  .NE.FOLDER1_OWNER) THEN
	         IF (SETPRV_PRIV()) THENE
	            READ_ACCESS = 1
		    WRITE_ACCESS = 1
	         ELSE
	            CALL CHECK_ACCESS
     &		     (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',
     &		      USERNAME,READ_ACCESS,WRITE_ACCESS)
	         END IF
	         IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN
		  IF (OUTPUT) THEN
	           WRITE(6,'('' You are not allowed to access folder.'')')C
	           WRITE(6,'('' See '',A,'' if you wish to access folder.'')')R
     &			FOLDER1_OWNER(:TRIM(FOLDER1_OWNER))
		  ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR.e
     &			 TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN
		   CALL OPEN_BULLUSER_SHARED
		   CALL READ_USER_FILE_KEYNAME(USERNAME,IER)
		   CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)r
		   CALL CLR2(SET_FLAG,FOLDER1_NUMBER)E
		   IF (IER.EQ.0) REWRITE (4) USER_ENTRY 
		   CALL CLOSE_BULLUSER
		  END IF
		  IER = 0D
		  RETURN
	         END IF
	      ELSE IF (BTEST(FOLDER1_FLAG,0).AND.
     &		  IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THENs
	         CALL OPEN_BULLFOLDER
	         CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1)
		 FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0),
	         CALL REWRITE_FOLDER_FILE_TEMPL
		 CALL CLOSE_BULLFOLDER
	      END IFR
	   ELSE					! Folder not protectedN
	      IER = SS$_ACLEMPTY.OR.SS$_NORMAL	! Indicate folder selected
	   END IF

	   IF (FOLDER1_BBOARD(:2).NE.'::') THEN
	      IF (REMOTE_SET) CLOSE(UNIT=REMOTE_UNIT)
	      REMOTE_SET = .FALSE.R
	   END IF

	   IF (IER) THENl
	      FOLDER_COM = FOLDER1_COM		! Folder successfully set so 
	      FOLDER_FILE = FOLDER1_FILE	! update folder parameters

	      IF (FOLDER_NUMBER.NE.0) THEN
		 FOLDER_SET = .TRUE.
	      ELSEN
		 FOLDER_SET = .FALSE.T
	      END IF=

	      IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN
		 WRITE (6,'('' Folder has been set to '',A)') 
     &		    FOLDER(:TRIM(FOLDER))//'.'
		 BULL_POINT = 0	! Reset pointer to first bulletinK
	      END IF

	      IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.USERNAME 
     &		  .NE.FOLDER_OWNER) THEN
	         IF (.NOT.WRITE_ACCESS) THEN
		   IF (OUTPUT.AND.INCMD(:3).NE.'DIR')I
     &		    WRITE (6,'('' Folder only accessible for reading.'')')
		   READ_ONLY = .TRUE.(
		 ELSE,
		   READ_ONLY = .FALSE.
		 END IF
	      ELSEI
		 READ_ONLY = .FALSE.
	      END IFh

	      IF (FOLDER_NUMBER.GT.0) THEN)
		IF (TEST_BULLCP()) THEN)
		 CALL SET2(FIRST_TIME,FOLDER_NUMBER)
		ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THENL
	       			! If first select, look for expired messages.
		 CALL OPEN_BULLDIR
		 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 (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.O
     &			(FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))U
     &			.AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
						! Do shutdown bulletins exist?
		       SHUTDOWN = 0P
		       IER1 = -1
		    ELSE
		       IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
			  CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
		       END IFB
	               IER1 = 1
		    END IF
	 	    IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THENS
		       CALL UPDATE	! Need to update_
		    END IF
		 ELSEC
		    NBULL = 0D
		 END IFR
		 CALL CLOSE_BULLDIRT
		 CALL SET2(FIRST_TIME,FOLDER_NUMBER)
	        END IFF
	      END IFF

	      IF (OUTPUT) THENi
	       IF (FOLDER_NUMBER.GE.0.AND.CLI$PRESENT('MARKED')) THEN
		 READ_TAG = .TRUE.
		 CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)t
		 IF (INCMD(:3).NE.'DIR') THENB
		   IF (IER.EQ.0) THENi
		    WRITE(6,'('' NOTE: Only marked messages'',
     &					'' will be shown.'')')u
		   ELSEr
		    WRITE(6,'('' ERROR: No marked messages found.'')')
		   END IFe
		 END IFn
	       ELSE
		 READ_TAG = .FALSE.e
	       END IF
	      END IFR

	      IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG) THENI
	        IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN
	         DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &					F_NEWEST_BTIM)'
	         IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN 	! If new unread messages
		  CALL FIND_NEWEST_BULL			! See if we can find itM
		  IF (BULL_POINT.NE.-1) THEN
	     	    WRITE(6,'('' Type READ to read new messages.'')')
		    NEW_COUNT = F_NBULL - BULL_POINT
		    DIG = 0R
		    DO WHILE (NEW_COUNT.GT.0)U
		      NEW_COUNT = NEW_COUNT / 10
		      DIG = DIG + 1P
		    END DO
		    WRITE(6,'('' There are '',I<DIG>,'' new messages.'')')
     &			F_NBULL - BULL_POINT	! Alert user if new bulletinsD
		  ELSE
		    BULL_POINT = 0
		  END IF
		 END IFe
		END IF
	      END IF/
	      IER = 1
	   ELSE IF (OUTPUT) THENC
	      WRITE (6,'('' Cannot access specified folder.'')')
	      CALL SYS_GETMSG(IER))
	   END IF
	ELSE						! Folder not foundC
	   IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')')
	   IER = 0
	END IF.

	RETURNO

	END



	SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
Cl
C  SUBROUTINE CONNECT_REMOTE_FOLDER'
CE
C  FUNCTION: Connects to folder that is located on other DECNET node.E
C 
	IMPLICIT INTEGER (A-Z)L

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
	DATA REMOTE_UNIT /15/

	COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCHG
	COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)(
	COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE
	CHARACTER*1 SEPARATEO

	INCLUDE 'BULLUSER.INC'F

	INCLUDE 'BULLFOLDER.INC' 

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFILES.INC'

	CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE
	CHARACTER*25 FOLDER_SAVE

	DIMENSION DUMMY(2)B

	REMOTE_UNIT = 31 - REMOTE_UNIT'

	SAME = .TRUE.
	LEN_BBOARD = TRIM(FOLDER1_BBOARD)
	IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN  ! Remote folder name different0
	   SAME = .FALSE.			  ! from local?  Yes.
	   LEN_BBOARD = LEN_BBOARD - 11
	END IF1

	OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256, 
     &		FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"')

	IF (IER.EQ.0) THEND
	   IF (.NOT.SAME) THENM
	      FOLDER1_FILE = FOLDER_FILEC
	      FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &		//FOLDER1B
	      REMOTE_SET_SAVE = REMOTE_SETD
	      REMOTE_SET = .FALSE.M
	      CALL OPEN_BULLDIR
	      CALL READDIR(0,IER)
	      CALL CLOSE_BULLDIR
	      REMOTE_SET = REMOTE_SET_SAVE
	      FOLDER_FILE = FOLDER1_FILEL
	      FOLDER_SAVE = FOLDER1
	      FOLDER1 = BULLDIR_HEADER(13:)
	   END IF
	   WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1N
	   FOLDER_OWNER_SAVE = FOLDER1_OWNER 
	   FOLDER_BBOARD_SAVE = FOLDER1_BBOARDO
	   FOLDER_NUMBER_SAVE = FOLDER1_NUMBER 
	   IF (IER.EQ.0) THEN
	      READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,T
     &		DUMMY(1),DUMMY(2),FOLDER1_COMO
	   END IF
	   IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE
	END IFT

	IF (IER.NE.0.OR..NOT.IER1) THEN
	   CLOSE (UNIT=REMOTE_UNIT)
	   REMOTE_UNIT = 31 - REMOTE_UNIT
	   IF (IER.EQ.0.AND.FOLDER_NUMBER_SAVE.GE.0) THEN
	      IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)	
     &		  .OR.TEST2(SET_FLAG,FOLDER_NUMBER_SAVE)) THEN
	         CALL OPEN_BULLUSER_SHARED
	         CALL READ_USER_FILE_KEYNAME(USERNAME,IER)f
	         CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)
	         CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE)
	         IF (IER.EQ.0) REWRITE (4) USER_ENTRY
	         CALL CLOSE_BULLUSERA
	      END IF	
	   END IF
	   IER = 2 
	ELSEL
	   FOLDER1_BBOARD = FOLDER_BBOARD_SAVEn
	   FOLDER1_NUMBER = FOLDER_NUMBER_SAVER
	   FOLDER1_OWNER = FOLDER_OWNER_SAVEE
	   CLOSE (UNIT=31-REMOTE_UNIT) 
CR
C  If remote folder has returned a last read time for the folder,O
C  and if in /LOGIN mode, or last selected folder was a differentL
C  folder, or folder specified with "::", then update last read time.	
CO
	   IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.LOGIN_SWITCH)
     &		.AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0))
     &		.OR.FOLDER1_NUMBER.EQ.-1) THEN
	      LAST_READ_BTIM(1,FOLDER1_NUMBER+1) = DUMMY(1)
	      LAST_READ_BTIM(2,FOLDER1_NUMBER+1) = DUMMY(2)
	   END IF
	   IER = 0)
	END IFN

	RETURN&
	END









	SUBROUTINE UPDATE_FOLDERP
C(
C  SUBROUTINE UPDATE_FOLDERC
CS
C  FUNCTION: Updates folder info due to new message.
C 

	IMPLICIT INTEGER (A-Z)	

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

	IF (FOLDER_NUMBER.LT.0) RETURNI

	CALL OPEN_BULLFOLDER_SHARED			! Open folder file_

	CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)

	CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)s

	F_NBULL = NBULL

	IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)'

	IF (.NOT.BTEST(SYSTEM,0)) THEN 	! Is non-system message?I
	   F_NEWEST_NOSYS_BTIM(1) = F_NEWEST_BTIM(1) ! If so, update latest
	   F_NEWEST_NOSYS_BTIM(2) = F_NEWEST_BTIM(2) ! system time.
	END IF_

	CALL REWRITE_FOLDER_FILE	

	CALL CLOSE_BULLFOLDER

	RETURNR
	END



	SUBROUTINE SHOW_FOLDERU
CR
C  SUBROUTINE SHOW_FOLDERI
C(
C  FUNCTION: Shows the information on any folder.F
C	

	IMPLICIT INTEGER (A-Z) 

	INCLUDE 'BULLUSER.INC'F

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLDIR.INC'

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	INCLUDE '($SSDEF)'E

	INCLUDE '($RMSDEF)'

	EXTERNAL CLI$_ABSENT_

	IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT))U
     &		FOLDER1 = FOLDER

	IF (INDEX(FOLDER1,'::').NE.0) THEN 
	   WRITE (6,'('' ERROR: Invalid command for remote folder.'')')
	   RETURN
	END IF(

	CALL OPEN_BULLFOLDER_SHARED			! Open folder fileE

	CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
	FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//O
     &		FOLDER1e
	IF (IER.NE.0) THEN 
	   WRITE (6,'('' ERROR: Specified folder was not found.'')')
	   CALL CLOSE_BULLFOLDERN
	   RETURN
	ELSE IF (FOLDER.EQ.FOLDER1) THENN
	   WRITE (6,1000) FOLDER1,FOLDER1_OWNER,
     &			FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))
	ELSEE
	   WRITE (6,1010) FOLDER1,FOLDER1_OWNER, 
     &			FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))
	END IFe

	IF (CLI$PRESENT('FULL')) THEN
	   CALL CHKACL 
     &		(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER) 
	   IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL).OR.(.NOT.IER)) THENT
	      IF (FOLDER1_BBOARD(:2).EQ.'::'.AND.	! Is folder remoteT
     &		BTEST(FOLDER1_FLAG,0)) THEN		! and private?	
	         WRITE (6,'('' Folder is a private folder.'')')
	      ELSE
	         WRITE (6,'('' Folder is not a private folder.'')')
	      END IFB
	   ELSE
	      IF (SETPRV_PRIV()) THEN
	         READ_ACCESS = 1O
		 WRITE_ACCESS = 1I
	      ELSE(
	        CALL CHECK_ACCESS
     &		  (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',e
     &		   USERNAME,READ_ACCESS,WRITE_ACCESS))
	      END IFn
	      IF (WRITE_ACCESS)
     &	      CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL')
	   END IF
	   IF (SETPRV_PRIV().OR.USERNAME.EQ.FOLDER1_OWNER) THEN
	      IF (FOLDER1_BBOARD(:2).EQ.'::') THENO
		 FLEN = TRIM(FOLDER1_BBOARD)
		 IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THENH
		    WRITE (6,'('' Folder is located on node '',S
     &		     A,''.'')') FOLDER1_BBOARD(3:FLEN)
		 ELSE 
		    FOLDER1_FILE = FOLDER_FILE
	            FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
     &			//FOLDER1
		    REMOTE_SET_SAVE = REMOTE_SET
		    REMOTE_SET = .FALSE.
		    CALL OPEN_BULLDIRL
		    CALL READDIR(0,IER)
		    CALL CLOSE_BULLDIR
		    REMOTE_SET = REMOTE_SET_SAVE
		    WRITE (6,'('' Folder is located on node '',E
     &		       A,''. Remote folder name is '',A,''.'')') T
     &		       FOLDER1_BBOARD(3:FLEN-1),
     &		       BULLDIR_HEADER(13:TRIM(BULLDIR_HEADER))
		 END IF_
	      ELSE IF (FOLDER1_BBOARD.NE.'NONE') THEN
		 FLEN = TRIM(FOLDER1_BBOARD)
		 IF (FLEN.GT.0) THEN
 	          WRITE (6,'('' BBOARD for folder is '',A<FLEN>,''.'')')
     &		 	FOLDER1_BBOARD(:FLEN)(
		 END IFR
		 IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN 
 		  WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')R
		  IF (BTEST(GROUPB1,31)) THEN.
		   WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')E
		  END IF
		 END IF 
	      ELSEE
	         WRITE (6,'('' No BBOARD has been defined.'')')
	      END IF 
	      IF (FOLDER1_BBEXPIRE.GT.0) THEN
		 WRITE (6,'('' Default expiration is '',I3,'' days.'')')
     &			FOLDER1_BBEXPIRE 
	      ELSE IF (FOLDER1_BBEXPIRE.EQ.-1) THEN
		 WRITE (6,'('' Default expiration is permanent.'')')
	      ELSE 
		 WRITE (6,'('' No default expiration set.'')')
	      END IF	
	      IF (BTEST(FOLDER1_FLAG,2)) THEN
		 WRITE (6,'('' SYSTEM has been set.'')')
	      END IFe
	      IF (BTEST(FOLDER1_FLAG,1)) THEN
		 WRITE (6,'('' DUMP has been set.'')')
	      END IF	
	      IF (BTEST(FOLDER1_FLAG,3)) THEN
		 WRITE (6,'('' NOPROMPT_EXPIRE has been set.'')')1
	      END IFO
	      IF (BTEST(FOLDER1_FLAG,4)) THEN
		 WRITE (6,'('' STRIP has been set.'')')L
	      END IFR
	      IF (BTEST(FOLDER1_FLAG,5)) THEN
		 WRITE (6,'('' DIGEST has been set.'')')
	      END IFt
	      IF (F1_EXPIRE_LIMIT.GT.0) THEN
		 WRITE (6,'('' EXPIRATION limit is '',I3,'' days.'')')
     &			F1_EXPIRE_LIMIT
	      END IF_
	      CALL OPEN_BULLUSER_SHARED
	      CALL READ_USER_FILE_HEADER(IER)
	      IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THENM
	       IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN
		 WRITE (6,'('' Default is BRIEF.'')')L
	       ELSE
		 WRITE (6,'('' Default is READNEW.'')')S
	       END IF
	      ELSEC
	       IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN
		 WRITE (6,'('' Default is SHOWNEW.'')')C
	       ELSE
		 WRITE (6,'('' Default is NOREADNEW.'')')E
	       END IF
	      END IF1
	      IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN
		 WRITE (6,'('' Default is NOTIFY.'')')
	      ELSE 
		 WRITE (6,'('' Default is NONOTIFY.'')')
	      END IF1
	      CALL CLOSE_BULLUSER
	   END IF
	END IFE

	CALL CLOSE_BULLFOLDER

	RETURN 

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


	SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)T
CD
C  SUBROUTINE DIRECTORY_FOLDERS 
CL
C  FUNCTION: Display all FOLDER entries.
C=
	IMPLICIT INTEGER (A - Z)D

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'E

	INCLUDE 'BULLUSER.INC'T

	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
	LOGICAL PAGING,

	DATA SCRATCH_D1/0/_

	CHARACTER*17 DATETIME

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

	IF (CLI$PRESENT('DESCRIBE')) THEN
	   NLINE = 2	! Include folder descriptor if /DESCRIBE specified
	ELSE 
	   NLINE = 1 
	END IFD

CO
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.A
C	
	CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM)
	SCRATCH_D = SCRATCH_D1 

	CALL OPEN_BULLFOLDER_SHARED		! Get folder fileR

	NUM_FOLDER = 0A
	IER = 0
	FOLDER1 = '                         '	! Start folder search
	DO WHILE (IER.EQ.0)			! Copy all bulletins from fileE
	   CALL READ_FOLDER_FILE_TEMP(IER) 
	   IF (IER.EQ.0) THEN
	      IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN_
		 FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))B
     &					//FOLDER1
	         CALL CHECK_ACCESS 
     &		  (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL', 
     &		   USERNAME,READ_ACCESS,-1)d
	      ELSEi
		 READ_ACCESS = 1
	      END IFf
	      IF (READ_ACCESS) THEN
	         NUM_FOLDER = NUM_FOLDER + 1n
	         CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)M
	      END IFI
	   END IF
	END DOU

	CALL CLOSE_BULLFOLDER			! We don't need file anymoreR

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

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

	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 screenZ

	WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'',F
     &		2X,''Owner'',/,1X,80(''-''))')

	IF (.NOT.PAGING) THEN
	   DISPLAY = (NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2L
	ELSE)
	   DISPLAY = MIN((NUM_FOLDER-FOLDER_COUNT+1)*NLINE+2,PAGE_LENGTH-4)
			! If more entries than page size, truncate output
	END IFT

	DO I=FOLDER_COUNT,FOLDER_COUNT+(DISPLAY-2)/NLINE-1I
	   CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)
	   DIFF = COMPARE_BTIM 
     &			(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM)
	   IF (F1_NBULL.GT.0) THENR
	      CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,)R
	   ELSE
	      DATETIME = '      NONE'
	   END IF
	   IF (DIFF.GE.0.OR.F1_NBULL.EQ.0) THEN
	      WRITE (6,1000) ' '//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER
	   ELSE
	      WRITE (6,1000) '*'//FOLDER1,DATETIME,F1_NBULL,FOLDER1_OWNER
	   END IF
	   IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP
	   FOLDER_COUNT = FOLDER_COUNT + 1	! Update folder counter
	END DOA

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

	RETURNr

1000	FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)
1010	FORMAT(1X,/,' Press RETURN for more...',/)l

	END


	SUBROUTINE SET_ACCESS(ACCESS)
CR
C  SUBROUTINE SET_ACCESS
CR
C  FUNCTION: Set access on folder for specified ID.R
C
C  PARAMETERS:
C	ACCESS  -  Logical: If .true., grant access, if .false. deny access 
CA

	IMPLICIT INTEGER (A-Z)E

	INCLUDE 'BULLFOLDER.INC'D

	INCLUDE 'BULLUSER.INC'0

	INCLUDE 'BULLFILES.INC'

	INCLUDE '($SSDEF)'P

	LOGICAL ACCESS,ALL,READONLY

	EXTERNAL CLI$_ABSENTE

	CHARACTER ID*64,RESPONSE*1L

	CHARACTER INPUT*132

	IF (CLI$PRESENT('ALL')) THENI
	   ALL = .TRUE.
	ELSE 
	   ALL = .FALSE. 
	END IFE

	IF (CLI$PRESENT('READONLY')) THEN
	   READONLY = .TRUE.Q
	ELSEC
	   READONLY = .FALSE.
	END IFR

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

	IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN!
	   FOLDER1 = FOLDER
	ELSE IF (LEN.GT.25) THEN 
	   WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')r
	   RETURN
	END IFd

	CALL OPEN_BULLFOLDER		! Open folder file 
	CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)	! See if it existsI
	OLD_FOLDER1_FLAG = FOLDER1_FLAG
	CALL CLOSE_BULLFOLDER

	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,C
     &	'('' ERROR: You are not able to modify access to the folder.'')')
	ELSE(
	   FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
     &		FOLDER1O
	   CALL CHKACLF
     &		(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',IER)
	   IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
	     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,E
     &      'Folder is not private. Do you want to make it so? (Y/N): ')
	     IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEND
	       WRITE (6,'('' Folder access was not changed.'')') 
	       RETURN
	     ELSE
	       FOLDER1_FLAG = IBSET(FOLDER1_FLAG,0)
	       IF (READONLY.AND.ALL) THEN
	          CALL ADD_ACL('*','R',IER)
	       ELSE
	          CALL ADD_ACL('*','NONE',IER) 
	       END IF
	       CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)E
	       IF (ALL) THEN		! All finished, so exit
	        WRITE (6,'('' Access to folder has been modified.'')')	
		GOTO 100
	       END IF
	     END IF
	   END IF

	   IF (ALL) THENR
	      IF (ACCESS) THEN
		 CALL DEL_ACL(' ','R+W',IER)
	         IF (READONLY) THEN
	            CALL ADD_ACL('*','R',IER)
		 ELSE(
		    FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0)
		 END IFF
	      ELSE
		 CALL DEL_ACL('*','R',IER)
	      END IFR
	      IF (.NOT.IER) THEN 
		 WRITE(6,'('' Cannot modify access.'')')
		 CALL SYS_GETMSG(IER)'
	      END IFt
	   END IF

	   DO WHILE (CLI$GET_VALUE('ACCESS_ID',INPUT,ILEN) 
     &	    .NE.%LOC(CLI$_ABSENT).AND..NOT.ALL)
	      IER = SYS_TRNLNM(INPUT,INPUT)
	      IF (INPUT(:1).EQ.'@') THENN
		 ILEN = INDEX(INPUT,',') - 1
		 IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)1
		 OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN),
     &			DEFAULTFILE='.DIS',IOSTAT=IER)T
		 IF (IER.NE.0) THEN
		    WRITE (6,'('' ERROR: Cannot find file '',A)')I
     &					INPUT(2:ILEN)
		    RETURN
		 END IFE
		 READ (3,'(A)',IOSTAT=IER) INPUT
		 IF (IER.NE.0) THENO
		    CLOSE (UNIT=3)
		    INPUT = ' '
		 ELSE(
		    FILE_OPEN = .TRUE.
		 END IF 
	      ELSE 
		 FILE_OPEN = .FALSE.
	      END IF	
	      DO WHILE (TRIM(INPUT).GT.0)
	         COMMA = INDEX(INPUT,',')
		 IF (INPUT(:1).EQ.'[') COMMA = INDEX(INPUT,']') + 1i
		 IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2 
	         IF (COMMA.GT.0) THEN
		    ID = INPUT(1:COMMA-1)U
		    INPUT = INPUT(COMMA+1:) 
	         ELSE
		    ID = INPUT
		    INPUT = ' 'F
	         END IF
	         ILEN = TRIM(ID)
	         IF (ID.EQ.FOLDER1_OWNER) THEN
	            WRITE (6,'('' ERROR: Cannot modify access'', 
     &			       '' for owner of folder.'')')
		 ELSEG
		    IF (ACCESS) THEN
	               IF (READONLY) THEN
	                  CALL ADD_ACL(ID,'R',IER)f
		       ELSEE
	                  CALL ADD_ACL(ID,'R+W',IER) 
		       END IF_
	            ELSEM
	               CALL DEL_ACL(ID,'R+W',IER)
	               IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER)
	            END IFD
	            IF (.NOT.IER) THEN
		       WRITE(6,'('' Cannot modify access for '',A,
     &					''.'')') ID(:ILEN)o
		       CALL SYS_GETMSG(IER)
		    ELSE
		       WRITE(6,'('' Access modified for '',A,''.'')'),
     &				ID(:ILEN) 
		    END IF
		 END IF,
	         IF (TRIM(INPUT).EQ.0.AND.FILE_OPEN) THEN
		    READ (3,'(A)',IOSTAT=IER) INPUTD
		    IF (IER.NE.0) THEN
		       CLOSE (UNIT=3)
		       INPUT = ' '
		       FILE_OPEN = .FALSE.
		    END IF
		 END IFO
	      END DOI
	   END DO
	   
100	   IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THENG
	      CALL OPEN_BULLFOLDER		! Open folder fileA
	      OLD_FOLDER1_FLAG = FOLDER1_FLAG
	      CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
	      FOLDER1_FLAG = OLD_FOLDER1_FLAG
	      CALL REWRITE_FOLDER_FILE_TEMP
	      CALL CLOSE_BULLFOLDER
	   END IF
	END IF

	RETURN 

	END



	SUBROUTINE CHKACL(FILENAME,IERACL)r
Cb
C  SUBROUTINE CHKACL
Cm
C  FUNCTION: Checks ACL of given file.
Ch
C  PARAMETERS:
C	FILENAME - Name of file to check.
C	IERACL   - Error returned for attempt to open file.r
Cl

	IMPLICIT INTEGER (A-Z)u

	CHARACTER*(*) FILENAMEo

	INCLUDE '($ACLDEF)'
	INCLUDE '($SSDEF)'u

	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) THENR
	   IERACL = SS$_NORMAL.OR.IERACL 
	END IF!

	RETURNe
	END



	SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS)
CR
C  SUBROUTINE CHECK_ACCESS
CQ
C  FUNCTION: Checks ACL of given file.
CA
C  PARAMETERS:
C	FILENAME - Name of file to check.R
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.
C		       If initially set to -1, indicates just
C		       folder for read access. 
CA

	IMPLICIT INTEGER (A-Z)U

	CHARACTER FILENAME*(*),USERNAME*(*),ACE*255,OUTPUT*80

	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 ADD_2_ITMLST(LEN(ACE),CHP$_MATCHEDACE,%LOC(ACE))
	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,Z
     &		%VAL(ACL_ITMLST))'

	IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENn
	   CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,)
	   IF (INDEX(OUTPUT,'=*').NE.0.AND.
     &		INDEX(OUTPUT,'READ').EQ.0) READ_ACCESS = 0
	ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.READ_ACCESS) THENI
	   READ_ACCESS = 0a
	END IFt

	IF (WRITE_ACCESS.EQ.-1) THEN	! Only check read access
	   RETURN
	ELSE IF (READ_ACCESS.EQ.0) THEN	! If no read access, then ofR
	   WRITE_ACCESS = 0		! course there is no write access.
	   RETURN
	END IFF

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

	IF (.NOT.SETPRV_PRIV().AND.ICHAR(ACE(:1)).NE.0) THENE
	   CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,)
	   IF (INDEX(OUTPUT,'=*').NE.0.AND.
     &		INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0
	END IFF

	RETURNL
	END




	SUBROUTINE SHOWACL(FILENAME)
C 
C  SUBROUTINE SHOWACLO
C 
C  FUNCTION: Shows users who are allowed to read private bulletin.
CE
C  PARAMETERS:
C	FILENAME - Name of file to check.0
C!
	IMPLICIT INTEGER (A-Z)

	INCLUDE '($ACLDEF)'

	CHARACTER*(*) FILENAMEr

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

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

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

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

	RETURN
	END



	SUBROUTINE FOLDER_FILE_ROUTINES

	IMPLICIT INTEGER (A-Z)I

	CHARACTER*(*) KEY_NAMEE

	INCLUDE 'BULLFOLDER.INC'E

	ENTRY WRITE_FOLDER_FILE(IER)

	DO WHILE (REC_LOCK(IER))L
	   WRITE (7,IOSTAT=IER) FOLDER_COMP
	END DOL

	RETURN

	ENTRY REWRITE_FOLDER_FILE

	REWRITE (7) FOLDER_COM

	RETURNE

	ENTRY REWRITE_FOLDER_FILE_TEMPY

	REWRITE (7) FOLDER1_COM

	RETURNS

	ENTRY READ_FOLDER_FILE(IER)

	DO WHILE (REC_LOCK(IER))L
	   READ (7,IOSTAT=IER) FOLDER_COM
	END DOI

	RETURNT

	ENTRY READ_FOLDER_FILE_TEMP(IER)(

	DO WHILE (REC_LOCK(IER)),
	   READ (7,IOSTAT=IER) FOLDER1_COMc
	END DO.

	RETURN 

	ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER)

	SAVE_FOLDER_NUMBER = FOLDER_NUMBERY

	DO WHILE (REC_LOCK(IER))i
	   READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM_
	END DOR

	FOLDER_NUMBER = SAVE_FOLDER_NUMBER'

	RETURNN

	ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)U

	DO WHILE (REC_LOCK(IER)))
	   READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM
	END DO 

	RETURNh

	ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER)

	DO WHILE (REC_LOCK(IER)))
	   READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM
	END DO(

	RETURNE

	ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)Y

	DO WHILE (REC_LOCK(IER)) 
	   READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM 
	END DO(

	RETURNR

	END


	SUBROUTINE USER_FILE_ROUTINES

	IMPLICIT INTEGER (A-Z)A

	CHARACTER*(*) KEY_NAMEE

	INCLUDE 'BULLUSER.INC' 

	CHARACTER*12 SAVE_USERNAMEm

	ENTRY READ_USER_FILE(IER)

	SAVE_USERNAME = USERNAMEE

	DO WHILE (REC_LOCK(IER)) 
	   READ (4,IOSTAT=IER) USER_ENTRY
	END DO

	TEMP_USER = USERNAMEE
	USERNAME = SAVE_USERNAMES

	RETURNF

	ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER) 

	SAVE_USERNAME = USERNAMEE

	DO WHILE (REC_LOCK(IER))C
	   READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY 
	END DOA

	USERNAME = SAVE_USERNAMEI
	TEMP_USER = KEY_NAMET

	RETURNf

	ENTRY READ_USER_FILE_HEADER(IER)(

	DO WHILE (REC_LOCK(IER))m
	   READ (4,KEY='            ',IOSTAT=IER) USER_HEADER
	END DO 

	RETURNF

	ENTRY WRITE_USER_FILE_NEW(IER)E

	SET_FLAG(1) = SET_FLAG_DEF(1)
	SET_FLAG(2) = SET_FLAG_DEF(2)
	BRIEF_FLAG(1) = BRIEF_FLAG_DEF(1)
	BRIEF_FLAG(2) = BRIEF_FLAG_DEF(2)
	NOTIFY_FLAG(1) = NOTIFY_FLAG_DEF(1)
	NOTIFY_FLAG(2) = NOTIFY_FLAG_DEF(2)

	ENTRY WRITE_USER_FILE(IER)O

	DO WHILE (REC_LOCK(IER)) 
	   WRITE (4,IOSTAT=IER) USER_ENTRYY
	END DOI

	RETURN 

	END





	SUBROUTINE SET_GENERIC(GENERIC)
CC
C  SUBROUTINE SET_GENERIC&
C 
C  FUNCTION: Enables or disables "GENERIC" display, i.e. displayingN
C	general bulletins continually for a certain amount of days.,
C)
	IMPLICIT INTEGER (A-Z)I

	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_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)

	IF (IER.EQ.0) THEN.
	   IF (GENERIC) THENS
	      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 IFX
	   ELSE
	      NEW_FLAG(2) = 0
	   END IF
	   REWRITE (4) TEMP_USER//USER_ENTRY(13:)
	ELSE 
	   WRITE (6,'('' ERROR: Specified username not found.'')')U
	END IF

	CALL CLOSE_BULLUSER

	RETURNT
	END


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

	INCLUDE 'BULLUSER.INC' 

	CHARACTER TODAY*23N

	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_BULLUSER_SHARED

	CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER) 

	CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)N
	IF (IER.EQ.0) THEN_
	   IF (LOGIN.AND.COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.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) TEMP_USER//USER_ENTRY(13:)
	ELSEI
	   WRITE (6,'('' ERROR: Specified username not found.'')')D
	END IF 

	CALL CLOSE_BULLUSER

	RETURN 
	END





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

	IMPLICIT INTEGER (A-Z)O

	CHARACTER USERNAME*(*),ACCOUNT*(*)C

	INCLUDE '($UAIDEF)'

	INTEGER*2 UIC(2))

	CALL INIT_ITMLST 
	CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))
	CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))
	CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC))
	CALL END_ITMLST(GETUAI_ITMLST)B

	IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)

	USER = UIC(1)
	GROUP = UIC(2)-

	RETURNl
	END



	SUBROUTINE DCLEXH(EXIT_ROUTINE)

	IMPLICIT INTEGER (A-Z)

	INTEGER*4 EXBLK(4)Z

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

	CALL SYS$DCLEXH(EXBLK(1))

	RETURNC
	END
