C
C  BULLETIN8.FOR, Version 3/28/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 START_DECNET

	IMPLICIT INTEGER (A - Z)

	CHARACTER NAMEDESC*9 /'BULLETIN1'/

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN

	COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132)	! Buffer area for
	INTEGER*2 MBX_IOSB				! terminal QIO calls.
	LOGICAL*1 MBX_BUF

	PARAMETER MAXLINK = 10

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK)
	COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
	INTEGER*2 WRITE_IOSB
	LOGICAL*1 WRITE_BUF

	DIMENSION NFBDESC(2)
	LOGICAL*1 NFB(5)

	EXTERNAL IO$_ACPCONTROL

	PARAMETER NFB$C_DECLNAME = '15'X

	CALL SETDDIR('DECNET')

	CALL SETUSER('DECNET')

C	CALL SET_TIMER('02')

	IER = SYS$CREMBX(%VAL(0),MBX_CHAN,%VAL(132),%VAL(528),,,
     &                   'BULL_MBX')
	IF (.NOT.IER) CALL EXIT(IER)

	IER = SYS$ASSIGN('_NET:',DCL_CHAN,,'BULL_MBX')	! Assign net device
	IF (.NOT.IER) CALL EXIT(IER)

	NFBDESC(1) = 5
	NFBDESC(2) = %LOC(NFB)

	NFB(1) = NFB$C_DECLNAME

	IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,,
     &		NFBDESC,NAMEDESC,,,,)
	IF (.NOT.IER) CALL EXIT(IER)

	DO I=1,MAXLINK
	   CALL LIB$GET_EF(READ_EFS(I))
	   CALL LIB$GET_EF(WRITE_EFS(I))
	END DO

	CALL READ_MBX

	RETURN
	END


	SUBROUTINE SETDDIR(USERNAME)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($LNMDEF)'

	INCLUDE '($PSLDEF)'

	CHARACTER SYSUAF*181,USERNAME*(*),DIRECTORY*64

	EXTERNAL UAF$T_DEFDEV,UAF$T_DEFDIR

	OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT',
     &       ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,SHARED)

	READ (8,KEY=USERNAME) SYSUAF

	CLOSE (8)

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list
	DEV = %LOC(UAF$T_DEFDEV) + 1
	LDEV = ICHAR(SYSUAF(DEV:DEV))
	CALL ADD_2_ITMLST
     &		(LDEV,LNM$_STRING,%LOC(SYSUAF(DEV+1:)))
	CALL END_ITMLST(CRELNM_ITMLST)	! Get address of itemlist

	CALL SYS$CRELNM(,'LNM$PROCESS','SYS$DISK',PSL$C_SUPER,
     &						%VAL(CRELNM_ITMLST))

	DIR = %LOC(UAF$T_DEFDIR) + 1
	CALL SYS$SETDDIR(SYSUAF(DIR+1:ICHAR(SYSUAF(DIR:DIR))+DIR),,)

	RETURN
	END



	SUBROUTINE READ_MBX

	IMPLICIT INTEGER (A-Z)

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN

	COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132)	! Buffer area for
	INTEGER*2 MBX_IOSB				! terminal QIO calls.
	LOGICAL*1 MBX_BUF

	EXTERNAL MBX_AST

	EXTERNAL IO$_READVBLK

	DATA MBX_EF/0/

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

	IER = SYS$QIO(%VAL(MBX_EF),%VAL(MBX_CHAN),IO$_READVBLK,MBX_IOSB,
     &		MBX_AST,,MBX_BUF,%VAL(132),,,,)
	IF (.NOT.IER) CALL EXIT(IER)

	RETURN

	END




	SUBROUTINE MBX_AST

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($MSGDEF)'

	INCLUDE 'BULLUSER.INC'

	PARAMETER MAXLINK = 10

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN

	COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132)	! Buffer area for
	INTEGER*2 MBX_IOSB				! terminal QIO calls.
	LOGICAL*1 MBX_BUF

	INTEGER*2 MBXMSG,UNIT2

	EQUIVALENCE (MBX_BUF(1),MBXMSG)

	CHARACTER NODENAME*6,FROMNAME*12

	IF (MBXMSG.EQ.MSG$_CONNECT.AND.MBX_IOSB(1)) THEN
	   LNODE = 0
	   DO WHILE (MBX_BUF(10+LNODE).NE.':')
	      LNODE = LNODE + 1
	      NODENAME(LNODE:LNODE) = CHAR(MBX_BUF(9+LNODE))
	   END DO
	   DO I=LNODE+1,LEN(NODENAME)
	      NODENAME(I:I) = ' '
	   END DO
	   I = 10 + LNODE
	   DO WHILE (MBX_BUF(I).NE.'=')
	      I = I + 1
	   END DO
	   LUSER = 0
	   DO WHILE (MBX_BUF(I+LUSER).NE.' ')
	      LUSER = LUSER + 1
	      USERNAME(LUSER:LUSER) = CHAR(MBX_BUF(I+LUSER))
	   END DO
	   DO I=LUSER+1,LEN(USERNAME)
	      USERNAME(I:I) = ' '
	   END DO
	   FROMNAME = USERNAME
	   CALL GET_PROXY_USERNAME(NODENAME,USERNAME)
	   CALL CONNECT(NODENAME,USERNAME,FROMNAME)
	ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR.
     &		 MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN
	   CALL READ_MBX
	ELSE
	   CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2)
	   UNIT_INDEX = 1
	   DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2)
	      UNIT_INDEX = UNIT_INDEX + 1
	   END DO
	   IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX)
	   CALL READ_MBX
	END IF

	RETURN
	END




	SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX)

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 10

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	EXTERNAL READ_AST

	EXTERNAL IO$_READVBLK

	IER = SYS$QIO(%VAL(READ_EFS(UNIT_INDEX)),%VAL(CHAN),IO$_READVBLK,
     &	   READ_IOSB(1,UNIT_INDEX),READ_AST,
     &	   %VAL(UNIT_INDEX),READ_BUF(1,UNIT_INDEX),%VAL(200),,,,)

	RETURN

	END




	SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER)

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 10

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK)
	COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
	INTEGER*2 WRITE_IOSB
	LOGICAL*1 WRITE_BUF

	CHARACTER*(*) OUTPUT

	EXTERNAL IO$_WRITEVBLK, WRITE_AST

	CALL LIB$MOVC3(NUM,%REF(OUTPUT),WRITE_BUF(1,UNIT_INDEX))

	IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)),
     &	   %VAL(DEVS(UNIT_INDEX)),
     &	   IO$_WRITEVBLK,WRITE_IOSB(1,UNIT_INDEX),WRITE_AST,
     &	   %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),%VAL(NUM),,,,)

	IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN
	   IER = WRITE_IOSB(1,UNIT_INDEX)
	END IF

	RETURN

	END




	SUBROUTINE WRITE_AST(ASTPRM)

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 10

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK)
	COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
	INTEGER*2 WRITE_IOSB
	LOGICAL*1 WRITE_BUF

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK)
	COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK)
	COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12

	CHARACTER*128 INPUT

	UNIT_INDEX = %LOC(ASTPRM)

	IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN
	   CALL DISCONNECT(UNIT_INDEX)
	ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THEN
	   LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1
	   IF (LEN_SAVE(UNIT_INDEX).EQ.0) THEN
	      IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN
	         REC_SAVE(UNIT_INDEX) = 0
	      ELSE
	         RETURN
	      END IF
	   ELSE
              CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)),
     &		OUT_SAVE(UNIT_INDEX),INPUT)
	   END IF
	   CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER)
	END IF

	RETURN
	END



	SUBROUTINE READ_AST(ASTPRM)

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 10

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)

	UNIT_INDEX = %LOC(ASTPRM)

	IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN

	IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1

	CALL EXECUTE_COMMAND(UNIT_INDEX)

	CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)

	RETURN
	END





	SUBROUTINE CONNECT(NODENAME,USERNAME,FROMNAME)

	IMPLICIT INTEGER (A-Z)

	COMMON /ANY_ACTIVITY/ CONNECT_COUNT
	DATA CONNECT_COUNT /0/

	CHARACTER*(*) USERNAME,FROMNAME

	EXTERNAL IO$_ACCESS,IO$M_ABORT

	CONNECT_COUNT = CONNECT_COUNT + 1

	IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)

	CALL CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX,
     &		NODENAME,USERNAME,FROMNAME)

	IF (REJECT.NE.IO_REJECT) THEN
	   CALL READ_CHAN(CHAN,UNIT_INDEX)
	END IF

	CALL READ_MBX

	RETURN
	END


	SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX,
     &		NODENAME,USERNAME,FROMNAME)

	IMPLICIT INTEGER (A-Z)

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN

	COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132)	! Buffer area for
	INTEGER*2 MBX_IOSB				! terminal QIO calls.
	LOGICAL*1 MBX_BUF

	PARAMETER MAXLINK = 10

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(256,MAXLINK)
	COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
	INTEGER*2 WRITE_IOSB
	LOGICAL*1 WRITE_BUF

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF
	DATA COUNT /0/

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK)
	COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK)
	COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12

	EXTERNAL IO$_ACCESS,IO$M_ABORT

	CHARACTER*(*) USERNAME,FROMNAME,NODENAME

	CHARACTER*100 NCBDESC

	START_NCB = 7+MBX_BUF(5)

	LEN_NCB = MBX_BUF(START_NCB-1)

	CALL LIB$MOVC3(LEN_NCB,MBX_BUF(START_NCB),%REF(NCBDESC))

	IF (COUNT.GT.MAXLINK) THEN
	   REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)
	   CHAN = DCL_CHAN
	ELSE
	   IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX')

	   IF (IER) CALL GETDEVUNIT(DEV_CHAN,DEV_UNIT,IER)

	   IF (IER) THEN
	      CHAN = DEV_CHAN
	      REJECT = %LOC(IO$_ACCESS)

	      UNIT_INDEX = 1
	      DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0.)
	          UNIT_INDEX = UNIT_INDEX + 1
	      END DO
	   ELSE
	      CALL SYS$DASSGN(%VAL(DEV_CHAN))
	   END IF

	   IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THEN
	      REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)
	      CHAN = DCL_CHAN
	   ELSE
	      COUNT = COUNT + 1
	      UNITS(UNIT_INDEX) = DEV_UNIT
	      DEVS(UNIT_INDEX) = DEV_CHAN
	      USER_SAVE(UNIT_INDEX) = USERNAME
	      FROM_SAVE(UNIT_INDEX) = FROMNAME
	      NODE_SAVE(UNIT_INDEX) = NODENAME
	      FOLDER_NUM(UNIT_INDEX) = -1
	      LEN_SAVE(UNIT_INDEX) = 0
	      PRIV_SAVE(1,UNIT_INDEX) = 0
	      PRIV_SAVE(2,UNIT_INDEX) = 0
	   END IF
	END IF

	IER = SYS$QIOW(,%VAL(CHAN),%VAL(REJECT),MBX_IOSB,,,
     &		,NCBDESC(:LEN_NCB),,,,)

	IF (REJECT.EQ.%LOC(IO$_ACCESS).AND.
     &		(.NOT.IER.OR..NOT.MBX_IOSB(1))) THEN
	   REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)
	   COUNT = COUNT - 1
	   DEVS(UNIT_INDEX) = 0
	   UNITS(UNIT_INDEX) = 0
	END IF

	RETURN
	END



	SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER)
C
C  SUBROUTINE GETDEVUNIT
C
C  FUNCTION:
C	To get device unit number
C  INPUT:
C	CHAN - Channel number
C  OUTPUT:
C	DEV_UNIT - Device unit number
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($DVIDEF)'

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list
	CALL ADD_2_ITMLST(4,DVI$_UNIT,%LOC(DEV_UNIT))
	CALL END_ITMLST(GETDVI_ITMLST)	! Get address of itemlist

	IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,)

	RETURN
	END



	SUBROUTINE GETDEVNAME(CHAN,DEV_NAME,DLEN,IER)
C
C  SUBROUTINE GETDEVMAME
C
C  FUNCTION:
C	To get device name
C  INPUT:
C	CHAN - Channel number
C  OUTPUT:
C	DEV_NAME - Device name
C	DLEN - Length of device name
C

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($DVIDEF)'

	CHARACTER*(*) DEV_NAME

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list
	CALL ADD_2_ITMLST_WITH_RET
     &		(LEN(DEV_NAME),DVI$_DEVNAM,%LOC(DEV_NAME),%LOC(DLEN))
	CALL END_ITMLST(GETDVI_ITMLST)	! Get address of itemlist

	IER = SYS$GETDVIW(,%VAL(CHAN),,%VAL(GETDVI_ITMLST),,,,)

	RETURN
	END



	SUBROUTINE DISCONNECT(UNIT_INDEX)
C
C  SUBROUTINE DISCONNECT
C
C  FUNCTION: Disconnects channel and remove its entry from the lists.
C

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 10

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	COMMON /MBXBUF/ MBX_IOSB(4),MBX_BUF(132)	! Buffer area for
	INTEGER*2 MBX_IOSB				! terminal QIO calls.
	LOGICAL*1 MBX_BUF

	IF (UNITS(UNIT_INDEX).EQ.0) RETURN

	CALL SYS$DASSGN(%VAL(DEVS(UNIT_INDEX)))

	CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX)

	COUNT = COUNT - 1
	DEVS(UNIT_INDEX) = 0
	UNITS(UNIT_INDEX) = 0

	RETURN
	END



	SUBROUTINE SET_TIMER(MIN)
C
C SUBROUTINE SET_TIMER
C
C FUNCTION: Wakes up every MIN minutes to check for idle connections
C
	IMPLICIT INTEGER (A-Z)
	INTEGER TIMADR(2)			! Buffer containing time
						! in desired system format.
	CHARACTER TIMBUF*13,MIN*2
	DATA TIMBUF/'0 00:00:00.00'/

	EXTERNAL CHECK_CONNECTIONS

	CALL LIB$GET_EF(WAITEFN)

	TIMBUF(6:7) = MIN

	IER=SYS$BINTIM(TIMBUF,TIMADR)

	ENTRY RESET_TIMER

	IER=SYS$SETIMR(%VAL(WAITEFN),TIMADR,CHECK_CONNECTIONS,)
						! Set timer.

	RETURN
	END




	SUBROUTINE CHECK_CONNECTIONS

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 10

	COMMON /ACTIVITY/ IO(MAXLINK),IO_SAVE(MAXLINK)

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	IF (COUNT.GT.0) THEN
	   DO UNIT_INDEX=1,MAXLINK
	      IF (DEVS(UNIT_INDEX).NE.0.AND.
     &		IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THEN
	         CALL DISCONNECT(UNIT_INDEX)
	      END IF
	   END DO
	END IF

	CALL RESET_TIMER

	RETURN
	END



	SUBROUTINE GET_USER_PRIV(USERNAME,PRIV)

	IMPLICIT INTEGER (A-Z)

	DIMENSION PRIV(2)

	EXTERNAL UAF$Q_PRIV

	PARAMETER UAF$K_LENGTH = '584'X

	CHARACTER SYSUAF*(UAF$K_LENGTH),USERNAME*(*)

	OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT',
     &       ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,SHARED,IOSTAT=IER)

	READ (8,KEY=USERNAME,FMT='(Q,A)',IOSTAT=IER) LUAF,SYSUAF(:LUAF)

	IF (IER.NE.0) THEN
	   USERNAME = 'DECNET'
	   READ(8,KEY=USERNAME,FMT='(Q,A)',IOSTAT=IER)LUAF,SYSUAF(:LUAF)
	END IF

	CALL LIB$MOVC3(8,%REF(SYSUAF(%LOC(UAF$Q_PRIV)+1:)),PRIV)

	CLOSE (8)

	RETURN
	END





	SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME)

	IMPLICIT INTEGER (A-Z)

	CHARACTER NODE*(*),USERNAME*(*)

	CHARACTER NETUAF*100

	COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM

	LNODE = LEN(NODE)
	LUSER = LEN(USERNAME)

	NUM = 1
	NENTRY = NETUAF_QUEUE

	DO WHILE (NUM.LE.NETUAF_NUM)
	   NUM = NUM + 1
	   CALL READ_QUEUE(%VAL(NENTRY),NENTRY,NETUAF)
	   IF ((NETUAF(:1).EQ.'*'.OR.NETUAF(:LNODE).EQ.NODE).AND.
     &	       (NETUAF(33:32+LUSER).EQ.USERNAME.OR.
     &	       NETUAF(65:65).EQ.'*')) THEN
	      IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:)
	      RETURN
	   END IF
	END DO

	USERNAME = 'DECNET'

	RETURN
	END





	SUBROUTINE GET_PROXY_ACCOUNTS

	IMPLICIT INTEGER (A-Z)

	CHARACTER NETUAF*100

	COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM
	DATA NETUAF_QUEUE/0/

	CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF)

	OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',
     &       ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,SHARED,IOSTAT=IER)


	NETUAF_NUM = 0
	NENTRY = NETUAF_QUEUE
	DO WHILE (IER.EQ.0)
	   READ (7,IOSTAT=IER) NETUAF
	   IF (IER.EQ.0) THEN
	      NETUAF_NUM = NETUAF_NUM + 1
              CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF)
	   END IF
	END DO

	CLOSE (UNIT=7)

	RETURN

	END




	SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFILES.INC'

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'

	PARAMETER MAXLINK = 10

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(200,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK)
	COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK)
	COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12

	COMMON /ACCESS/ READ_ONLY
	LOGICAL READ_ONLY

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

	COMMON /POINT/ BULL_POINT

	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT

	COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH

	PARAMETER BRDCST_LIMIT = 82*12 + 2
	CHARACTER*(BRDCST_LIMIT) BMESSAGE

	DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK)

	EXTERNAL ENABLE_CTRL_EXIT,SS$_NOSUCHNODE,SS$_NOSUCHOBJ

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

	CHARACTER INPUT*(FOLDER_RECORD+16),DESCRIP_TEMP*53
	CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128

	EQUIVALENCE (INPUT,CMD_TYPE),(INPUT,INQUEUE)

	ILEN = READ_IOSB(2,UNIT_INDEX)
	CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(INPUT))

	REC_SAVE(UNIT_INDEX) = 0
	USERNAME = USER_SAVE(UNIT_INDEX)
	FOLDER = FOLDER_NAME(UNIT_INDEX)
	FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)
	NODENAME = NODE_SAVE(UNIT_INDEX)
	PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX)
	PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX)
	IF (OUT_HEAD(UNIT_INDEX).EQ.0) THEN
	   CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE)
	END IF

	IF (CMD_TYPE.EQ.3.OR.CMD_TYPE.EQ.4.OR.(CMD_TYPE.GE.9.AND.
     &	    CMD_TYPE.LE.11).OR.CMD_TYPE.EQ.15) THEN	! Do we need priv info?
	   IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THEN
	      CALL GET_USER_PRIV(USERNAME,PRIV_SAVE(1,UNIT_INDEX))
	      PROCPRIV(1) = PRIV_SAVE(1,UNIT_INDEX)
	      PROCPRIV(2) = PRIV_SAVE(2,UNIT_INDEX)
	   END IF
	END IF

	IF (CMD_TYPE.EQ.1) THEN			! Select folder
	   FOLDER1 = INPUT(5:ILEN)
	   FOLDER_NUMBER = -2
	   CALL SELECT_FOLDER(.FALSE.,IER)
	   CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1)))
	   CALL LIB$MOVC3(4,READ_ONLY,%REF(INPUT(5:5)))
	   IF (USERNAME.NE.'DECNET'.AND.IER) THEN
	      CALL OPEN_USERINFO
	      CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &				%REF(INPUT(9:9)))
	      LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)
	      LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1)
	   ELSE
	      CALL LIB$MOVC3(4,0,%REF(INPUT(9:9)))
	      CALL LIB$MOVC3(4,0,%REF(INPUT(13:13)))
	   END IF
	   INPUT = INPUT(:16)//FOLDER_COM
	   CALL WRITE_CHAN(16+LEN(FOLDER_COM),INPUT,UNIT_INDEX,IER1)
	   IF (IER.AND.IER1) THEN
	      FOLDER_NAME(UNIT_INDEX) = FOLDER
	      FOLDER_NUM(UNIT_INDEX) = FOLDER_NUMBER
	   END IF
	ELSE IF (CMD_TYPE.EQ.2) THEN		! Add message
	   LEN_SAVE(UNIT_INDEX) = 0
	   OUT_SAVE(UNIT_INDEX) = OUT_HEAD(UNIT_INDEX)
	ELSE IF (CMD_TYPE.EQ.6) THEN		! Add message line
	   LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) + 1
	   CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)),
     &			OUT_SAVE(UNIT_INDEX),INPUT(5:132))
	ELSE IF (CMD_TYPE.EQ.3) THEN		! Add message entry
	   FROM = USER_SAVE(UNIT_INDEX)
	   IF (FROM.EQ.'DECNET') FROM = FROM_SAVE(UNIT_INDEX)
	   CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP))
	   CALL LIB$MOVC3(11,%REF(INPUT(58:58)),%REF(EXDATE))
	   CALL LIB$MOVC3(8,%REF(INPUT(69:69)),%REF(EXTIME))
	   CALL LIB$MOVC3(4,%REF(INPUT(77:77)),SYSTEM)
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)
	   IF (READ_ONLY.AND.
     &		FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
	      INPUT = 'ERROR: Insufficient privileges to add message.'
	      CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER)
	      RETURN
	   ELSE IF (SYSTEM.NE.0) THEN
	      IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.
     &			.NOT.BTEST(FOLDER_FLAG,2)) THEN	! Test if SYSTEM folder
		 SYSTEM = SYSTEM.AND.2
	         CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
	      END IF
	      IF (SYSTEM.NE.0.AND..NOT.SETPRV_PRIV()) THEN	! Priv test
		 IF (FOLDER_OWNER.NE.USERNAME) THEN
	            SYSTEM = 0
		 ELSE					! Allow permanent if
		    SYSTEM = SYSTEM.AND.2		! owner of folder
	         END IF
	         CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
	      END IF
	   END IF
	   CALL LIB$MOVC3(4,%REF(INPUT(81:81)),BROAD)
	   IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN
	      BROAD = 0
	   END IF
	   CALL LIB$MOVC3(4,%REF(INPUT(85:85)),BELL)
	   CALL LIB$MOVC3(4,%REF(INPUT(89:89)),ALL)
	   CALL LIB$MOVC3(4,%REF(INPUT(93:93)),CLUSTER)
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
	   CALL OPEN_FILE(2)
	   CALL READDIR(0,IER)			! Get NBLOCK
	   IF (IER.EQ.0) NBLOCK = 0		! If new file, NBLOCK is 0
	   CALL OPEN_FILE(1)
	   OENTRY = OUT_HEAD(UNIT_INDEX)
	   LENGTH = LEN_SAVE(UNIT_INDEX)
	   LEN_SAVE(UNIT_INDEX) = 0
	   DO I=1,LENGTH
	      CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INPUT)
	      WRITE (1'NBLOCK+I) INPUT(:128)
	   END DO
	   IF (BROAD) THEN
	      CALL GET_BROADCAST_MESSAGE(BELL)
	      CALL BROADCAST(ALL,CLUSTER)
	   END IF
	   CALL CLOSE_FILE(1)			! Finished adding bulletin
	   CALL ADD_ENTRY			! Add the new directory entry
	   CALL UPDATE_FOLDER			! Update info in folder file
	   CALL CLOSE_FILE(2)			! Totally finished with add
	   CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER)

	   CALL SAVE_LAST_READ_BTIM(UNIT_INDEX)

	   IF (.NOT.BROAD) RETURN

100	   CALL GETUSER(BULLCP_USER)		! Get present username
	   CALL OPEN_FILE_SHARED(4)		! Broadcast on other nodes
	   TEMP_USER = ':'
	   DO WHILE (1)
	      DO WHILE (REC_LOCK(IER))		 
	         READ (4,KEYGT=TEMP_USER,IOSTAT=IER)
     &		   TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME
		 TEMP_USER = TEMP_USER(:TRIM(TEMP_USER))
		 IF (IER.EQ.0.AND.(TEMP_USER(2:).EQ.NODENAME
     &		     .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER))
     &		     .AND.TEMP_USER(:1).EQ.':') THEN
		    IER1 = REC_LOCK(IER)	! Skip the node that
		 END IF				! originated the message
	      END DO
	      IF (TEMP_USER(:1).NE.':') THEN
		 CALL CLOSE_FILE(4)
		 CALL SETUSER(BULLCP_USER)
		 REMOTE_SET = .FALSE.
	         CLOSE (UNIT=REMOTE_UNIT)
		 RETURN
	      END IF
	      IER = SYS$SETIMR(%VAL(TIMEEFN),TIMEBUF,ENABLE_CTRL_EXIT,
     &			%VAL(1))
	      CALL SETUSER(USERNAME)		! Reset to original username
	      FOLDER1 = 'GENERAL'
	      FOLDER1_BBOARD = ':'//TEMP_USER
	      CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
	      IF (IER.NE.0) THEN
		 CALL ERRSNS(IDUMMY,IDUMMY,INODE)
	         IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.
     &		     INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THEN
		    DELETE (4)
		 END IF
	      ELSE
		 IER = 0
		 I = 1
		 DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)
		    WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER)
     &			15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))
		    I = I + 128
		 END DO
		 IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)
     &			15,BLENGTH,BELL,ALL,CLUSTER
	      END IF
	      IER = SYS$CANTIM(%VAL(1),)
	   END DO
	ELSE IF (CMD_TYPE.EQ.8) THEN		! Read directory entry
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT)
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
	   CALL OPEN_FILE_SHARED(2)
	   CALL READDIR(ICOUNT,IER)
	   CALL CLOSE_FILE(2)
	   CALL LIB$MOVC3(4,IER,%REF(INPUT(1:1)))
	   IF (ICOUNT.GT.0) THEN
	      INPUT(5:) = BULLDIR_ENTRY
	      CALL WRITE_CHAN
     &		(LEN(BULLDIR_ENTRY)+4,INPUT,UNIT_INDEX,IER)
	   ELSE
	      INPUT(5:) = BULLDIR_HEADER
	      CALL WRITE_CHAN
     &		(LEN(BULLDIR_HEADER)+4,INPUT,UNIT_INDEX,IER)
	   END IF
	ELSE IF (CMD_TYPE.EQ.13) THEN		! Read directory entry
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),SBULL)
	   CALL LIB$MOVC3(4,%REF(INPUT(9:9)),EBULL)
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
  	   CALL OPEN_FILE_SHARED(2)
	   OENTRY = OUT_HEAD(UNIT_INDEX)
	   DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL)
	      CALL READDIR(I,IER)
	      INQUEUE = BULLDIR_COM
              CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)
	   END DO
	   CALL CLOSE_FILE(2)
	   OENTRY = OUT_HEAD(UNIT_INDEX)
	   REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_COM)
	   LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1
           CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)
	   OUT_SAVE(UNIT_INDEX) = OENTRY
	   CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.9) THEN		! Write directory entry
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT)
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
	   CALL OPEN_FILE(2)
	   IF (ICOUNT.GT.0) THEN
	      BULLDIR_ENTRY = INPUT(9:)
	      CALL WRITEDIR(ICOUNT,IER)
	   ELSE
	      BULLDIR_HEADER = INPUT(9:)
	      CALL WRITEDIR(ICOUNT,IER)
	   END IF
	   CALL CLOSE_FILE(2)
	ELSE IF (CMD_TYPE.EQ.4) THEN
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE)
	   CALL LIB$MOVC3(4,%REF(INPUT(9:9)),IMMEDIATE)
	   DESCRIP_TEMP = INPUT(13:ILEN)
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)
	   CALL OPEN_FILE(2)
	   CALL READDIR(BULL_DELETE,IER)
	   IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN
	      CALL CLOSE_FILE(2)
	      INPUT = 'ERROR: Cannot find message to delete.'
	      CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER)
	      RETURN
	   ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM
     &	    .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
	      CALL CLOSE_FILE(2)
	      INPUT = 'ERROR: Insufficient privileges to delete message.'
	      CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER)
	      RETURN
	   END IF
	   CALL REMOVE_ENTRY
     &		(BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)
	   CALL CLOSE_FILE(2)
	   CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.5) THEN		! Read message
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),ICOUNT)
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
	   CALL OPEN_FILE_SHARED(2)
	   CALL READDIR(ICOUNT,IER)
	   CALL OPEN_FILE_SHARED(1)
	   OENTRY = OUT_HEAD(UNIT_INDEX)
	   DO I=BLOCK,BLOCK+LENGTH-1
	      READ (1'I) INQUEUE
              CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)
	   END DO
	   CALL CLOSE_FILE(1)
	   CALL CLOSE_FILE(2)
	   OENTRY = OUT_HEAD(UNIT_INDEX)
	   REC_SAVE(UNIT_INDEX) = 128
	   LEN_SAVE(UNIT_INDEX) = LENGTH
           CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)
	   OUT_SAVE(UNIT_INDEX) = OENTRY
	   CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INQUEUE,UNIT_INDEX,IER)
	   CALL SAVE_LAST_READ_BTIM(UNIT_INDEX)
	ELSE IF (CMD_TYPE.EQ.10) THEN		! Replacing bulletin
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
	   CALL OPEN_FILE(2)
	   CALL LIB$MOVC3(53,%REF(INPUT(5:5)),%REF(DESCRIP_TEMP))
	   CALL LIB$MOVC3(4,%REF(INPUT(58:58)),ICOUNT)
	   CALL READDIR(ICOUNT,IER)
	   IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN
	      CALL CLOSE_FILE(2)
	      INPUT = 'ERROR: Cannot find message to replace.'
	      CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER)
	      RETURN
	   END IF
	   CALL LIB$MOVC3(53,%REF(INPUT(62:62)),%REF(DESCRIP))
	   CALL LIB$MOVC3(4,%REF(INPUT(115:115)),%REF(MSGTYPE))
	   CALL LIB$MOVC3(11,%REF(INPUT(119:119)),%REF(EXDATE))
	   CALL LIB$MOVC3(8,%REF(INPUT(130:130)),%REF(EXTIME))
	   ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()
	   IF ((FOLDER_NUMBER.GT.0.AND.(BTEST(MSGTYPE,0).OR.
     &		BTEST(MSGTYPE,2)).AND..NOT.BTEST(FOLDER_FLAG,2)).OR.
     &		(USERNAME.NE.FROM.AND..NOT.ALLOW).OR.
     &		((MSGTYPE.AND..NOT.8).NE.0.AND..NOT.ALLOW)) THEN
	      CALL CLOSE_FILE(2)
	      INPUT = 'ERROR: Insufficient privileges to replace message.'
	      CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER)
	      RETURN
	   END IF
	   CALL READDIR(0,IER)			! Get NBLOCK
	   CALL OPEN_FILE(1)
	   NEW_LENGTH = LEN_SAVE(UNIT_INDEX)
	   LEN_SAVE(UNIT_INDEX) = 0
	   OENTRY = OUT_HEAD(UNIT_INDEX)
	   DO I=1,NEW_LENGTH
	      CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)
	      WRITE (1'NBLOCK+I) INQUEUE
	   END DO
	   CALL CLOSE_FILE(1)			! Finished adding bulletin
	   IF (NEW_LENGTH.GT.0) THEN
	      NEMPTY = NEMPTY + LENGTH
	      LENGTH = NEW_LENGTH
	      BLOCK = NBLOCK + 1
	   END IF
	   CALL WRITEDIR(ICOUNT,IER)
	   NBLOCK = NBLOCK + NEW_LENGTH
	   CALL WRITEDIR(0,IER)
	   CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1),
     &		BTEST(MSGTYPE,2),EXDATE,EXTIME)
	   IF (BTEST(MSGTYPE,0)) THEN
	      SYSTEM = IBSET(SYSTEM,0)		! System?
	   ELSE
	      SYSTEM = IBCLR(SYSTEM,0)		! General?
	   END IF
	   CALL WRITEDIR(ICOUNT,IER)
	   CALL CLOSE_FILE(2)
	   CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.11) THEN		! Undeleting
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BULL_DELETE)
	   DESCRIP_TEMP = INPUT(9:61)
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)
	   CALL OPEN_FILE(2)
	   CALL READDIR(BULL_DELETE,IER)
	   IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN
	      CALL CLOSE_FILE(2)
	      INPUT = 'ERROR: Cannot find message to undelete.'
	      CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER)
	      RETURN
	   ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM
     &	    .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
	      CALL CLOSE_FILE(2)
	      INPUT = 'ERROR: Insufficient privileges to undelete message.'
	      CALL WRITE_CHAN(TRIM(INPUT),INPUT,UNIT_INDEX,IER)
	      RETURN
	   END IF
	   CALL LIB$MOVC3(11,%REF(INPUT(62:62)),%REF(EXDATE))
	   CALL LIB$MOVC3(8,%REF(INPUT(73:73)),%REF(EXTIME))
	   CALL WRITEDIR(BULL_DELETE,IER)
	   CALL CLOSE_FILE(2)
	   CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.12) THEN		! Find newest bulletin
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
	   CALL OPEN_FILE_SHARED(2)
	   CALL READDIR(0,IER)
	   CALL GET_NEWEST_MSG(%REF(INPUT(5:5)),BULL_POINT)
	   CALL CLOSE_FILE(2)
	   CALL WRITE_CHAN(4,%DESCR(BULL_POINT),UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.14) THEN		! Register remote folder
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),FLAG)
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)
	   CALL OPEN_FILE_SHARED(4)
	   NODENAME = INPUT(9:)
	   TEMP_USER = ':'//NODENAME(:TRIM(NODENAME))
	   DO WHILE (REC_LOCK(IER))
	      READ (4,KEY=TEMP_USER,IOSTAT=IER) 
     &		TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG
	   END DO
	   IF (IER.NE.0) THEN
	      DO I=1,FLONG
		 NEW_FLAG (I) = 0
	      END DO
	   END IF
	   IF (FLAG) THEN
	      CALL SET2(NEW_FLAG,FOLDER_NUMBER)
	   ELSE
	      CALL CLR2(NEW_FLAG,FOLDER_NUMBER)
	   END IF
	   IF (IER.EQ.0) THEN
	      REWRITE (4) TEMP_USER,
     &				LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME
	   ELSE
	      TEMP_USER =  ':'//NODENAME(:TRIM(NODENAME))
	      WRITE (4) TEMP_USER,
     &				LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAME
	   END IF
	   CALL CLOSE_FILE(4)
	ELSE IF (CMD_TYPE.EQ.15) THEN		! Broadcast message
	   CALL LIB$MOVC3(4,%REF(INPUT(5:5)),BLENGTH)
	   CALL LIB$MOVC3(4,%REF(INPUT(9:9)),START)
	   IF (BLENGTH.EQ.-1) THEN
	      IF (SCRATCH(UNIT_INDEX).EQ.0) THEN
		 CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))
	      END IF
	      CALL LIB$MOVC3(ILEN-12,%REF(INPUT(13:13)),
     &				%VAL(SCRATCH(UNIT_INDEX)+START-1))
	   ELSE
	      CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)),
     &				%REF(BMESSAGE(1:1)))
	      CALL LIB$MOVC3(4,%REF(INPUT(13:13)),ALL)
	      CALL LIB$MOVC3(4,%REF(INPUT(17:17)),CLUSTER)
	      CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))
	      IF (ILEN.GT.20) THEN
	         CALL LIB$MOVC3(4,%REF(INPUT(21:21)),FOLDER_NUMBER)
	         FOLDER = INPUT(25:)
		 GO TO 100
	      ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN
	         CALL BROADCAST(ALL,CLUSTER)
	      END IF
	   END IF
	END IF

	RETURN
	END



	SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX)

	IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLUSER.INC'

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC'

	PARAMETER MAXLINK = 10

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDER_NAME(MAXLINK)
	COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK)
	COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDER_NAME*25,FROM_SAVE*12,NODE_SAVE*12

	DIMENSION SAVE_BTIM(2)

	USERNAME = USER_SAVE(UNIT_INDEX)
	FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)

	IF (USERNAME.EQ.'DECNET'.OR.FOLDER_NUMBER.LT.0) RETURN

	CALL OPEN_USERINFO
	DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
     &				LAST_SAVE(1,UNIT_INDEX))
	IF (DIFF.GE.0) RETURN
	LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX)
	LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX)
	CALL UPDATE_USERINFO

	RETURN

	ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX)

	CALL SYS_BINTIM(DATE//' '//TIME,SAVE_BTIM)

	DIFF = COMPARE_BTIM(LAST_SAVE(1,UNIT_INDEX),SAVE_BTIM)

	IF (DIFF.GE.0) RETURN

	LAST_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)
	LAST_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)

	RETURN

	END
