From:	SMTP%"BULLETIN@PFC.MIT.EDU" 19-AUG-1994 17:36:30.94
To:	EVERHART
CC:	
Subj:	BULLETIN8.FOR

Date: Fri, 19 Aug 1994 17:25:57 -0400 (EDT)
From: BULLETIN@PFC.MIT.EDU
To:   EVERHART@arisia.gce.com
Message-Id: <940819172557.21438991@PFC.MIT.EDU>
Subject: BULLETIN8.FOR

C
C  BULLETIN8.FOR, Version 5/2/94
C  Purpose: Contains subroutines for the BULLETIN utility program.
C  Environment: VAX/VMS
C  Programmer: Mark R. London
C
C  Copyright (c) 1990
C  Property of Massachusetts Institute of Technology, Cambridge MA 02139.
C  This program cannot be copied or distributed in any form for non-MIT
C  use without specific written approval of MIT Plasma Fusion Center
C  Management.
C
	SUBROUTINE START_DECNET

	IMPLICIT INTEGER (A - Z)

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1

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

	PARAMETER MAXLINK = 20

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

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

	COMMON /NEWSHOST/ NEWS_GOT_HOST

	COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4)
	INTEGER*2 LISTEN_IOSB

	CHARACTER NAMEDESC*12 /'BULLETIN1'/
	CHARACTER NAMEDESC1*4 /'NNTP'/

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

	EXTERNAL IO$_ACPCONTROL,LISTEN_AST

	PARAMETER NFB$C_DECLNAME = '15'X

	IF (CONFIRM_USER('DECNET').EQ.0) THEN
	   CALL SETDEFAULT('DECNET')
	END IF

C	CALL SET_TIMER('02')

	GATEWAY_ONLY = SYS_TRNLNM('BULL_NEWS_GATEWAY_ONLY','DEFINED')

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

	NFB(1) = NFB$C_DECLNAME

	NEWS_GOT_HOST = NEWS_GETHOST()

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

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

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

	   CALL SYS$SETAST(%VAL(0))
	   CALL READ_MBX(DCL_CHAN)
	   CALL SYS$SETAST(%VAL(1))
	END IF

	IF (.NOT.SYS_TRNLNM('BULL_NO_NEWS_GATEWAY','DEFINED')) THEN
	   IER = SYS$CREMBX(%VAL(0),MBX_CHAN1,%VAL(132),%VAL(528),,,
     &                   'BULL_MBX1')
	   IF (.NOT.IER) CALL SYS_GETMSG(IER)
	   IF (.NOT.IER) CALL EXIT

	   IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1')
	   IF (.NOT.IER) CALL SYS_GETMSG(IER)
	   IF (.NOT.IER) CALL EXIT

	   IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,,
     &		NFBDESC,NAMEDESC1,,,,)
	   IF (.NOT.IER) CALL SYS_GETMSG(IER)
	   IF (.NOT.IER) CALL EXIT

	   CALL SYS$SETAST(%VAL(0))
	   CALL READ_MBX(DCL_CHAN1)
	   CALL SYS$SETAST(%VAL(1))
	END IF

	IF (SYS_TRNLNM('BULL_TCP_NEWS_GATEWAY','DEFINED')) THEN
	   IF (NNTP_LISTEN(LISTEN_CHAN)) THEN
	      CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB)
	   END IF
	END IF

	IF (GATEWAY_ONLY) CALL SYS$HIBER()

	RETURN
	END



	SUBROUTINE LISTEN_AST(ASTPRM)

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 20
	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF

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

	COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4)
	INTEGER*2 LISTEN_IOSB

	COMMON /NNTP/ NNTP_CHANS(MAXLINK)

	COMMON /NEWSHOST/ NEWS_GOT_HOST

	EXTERNAL NEWS_SOCKET_AST

	INTEGER*2 ACCEPT_IOSB(4)

	IF (LISTEN_IOSB(1)) THEN
	   IER = NNTP_ACCEPT(LISTEN_CHAN,ACCEPT_CHAN,ACCEPT_IOSB)
	   IF (IER) THEN
	      UNIT_INDEX = 1
	      DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).GT.0)
	          UNIT_INDEX = UNIT_INDEX + 1
	      END DO
	      IF (UNIT_INDEX.LE.MAXLINK) THEN
	         COUNT = COUNT + 1
	         DEVS(UNIT_INDEX) = ACCEPT_CHAN
		 UNITS(UNIT_INDEX) = ACCEPT_CHAN
	         IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN()
	         IF (IER) THEN
	            NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN()
		    WRITE_IOSB(1,UNIT_INDEX) = 1
		    IER = NEWS_SOCKET_BULLCP(0,
     &			WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX)
		    IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX))
	         END IF
	         IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)
	      ELSE
	         CALL SYS$DASSGN(%VAL(ACCEPT_CHAN))
	      END IF
	   ELSE IF (ACCEPT_CHAN.NE.-1) THEN
	      CALL SYS$DASSGN(%VAL(ACCEPT_CHAN)) 
	   END IF
 	END IF                                   

	CALL REQUEUE_NNTP_ACCEPT_WAIT()
	
	RETURN
	END



	SUBROUTINE REQUEUE_NNTP_ACCEPT_WAIT()
	
	IMPLICIT INTEGER (A-Z) 

	COMMON /LISTEN/ LISTEN_CHAN,LISTEN_IOSB(4)
	INTEGER*2 LISTEN_IOSB

	EXTERNAL LISTEN_AST

	CALL NNTP_ACCEPT_WAIT(LISTEN_CHAN,LISTEN_AST,LISTEN_IOSB)

	RETURN
	END



	SUBROUTINE SETDEFAULT(USERNAME)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($LNMDEF)'

	INCLUDE '($PSLDEF)'

	INCLUDE '($UAIDEF)'

	CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*12
	CHARACTER SYSLOGIN*72

	INTEGER*2 UIC(2)

	CALL INIT_ITMLST
	CALL ADD_2_ITMLST(LEN(DEFDEV),UAI$_DEFDEV,%LOC(DEFDEV))
	CALL ADD_2_ITMLST(LEN(DEFDIR),UAI$_DEFDIR,%LOC(DEFDIR))
	CALL ADD_2_ITMLST(LEN(ACCOUNT),UAI$_ACCOUNT,%LOC(ACCOUNT))
	CALL ADD_2_ITMLST(4,UAI$_UIC,%LOC(UIC))
	CALL END_ITMLST(GETUAI_ITMLST)

	CALL SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)

	CALL SETACC(ACCOUNT)
	CALL SETUSER(USERNAME)
	CALL SETUIC(INT(UIC(2)),INT(UIC(1)))

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list
	CALL ADD_2_ITMLST
     &		(ICHAR(DEFDEV(:1)),LNM$_STRING,%LOC(DEFDEV(2:)))
	CALL END_ITMLST(CRELNM_ITMLST)	! Get address of itemlist

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

	CALL INIT_ITMLST	! Initialize item list
				! Now add items to list
	SYSLOGIN = 'SYS$DISK:'//DEFDIR(2:)
	CALL ADD_2_ITMLST
     &		(ICHAR(DEFDIR(:1))+9,LNM$_STRING,%LOC(SYSLOGIN))
	CALL END_ITMLST(CRELNM_ITMLST)	! Get address of itemlist

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

	CALL SYS$SETDDIR(DEFDIR(2:ICHAR(DEFDIR(:1))+1),,)

	RETURN
	END



	SUBROUTINE READ_MBX(DCL_CHAN_NUM)

	IMPLICIT INTEGER (A-Z)

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1

	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)

	IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN
	   MBX_CHAN_NUM = MBX_CHAN
	ELSE
	   MBX_CHAN_NUM = MBX_CHAN1
	END IF

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

	RETURN

	END




	SUBROUTINE MBX_AST(DCL_CHAN_NUM)

	IMPLICIT INTEGER (A-Z)

	INCLUDE '($MSGDEF)'

	INCLUDE 'BULLUSER.INC'

	PARAMETER MAXLINK = 20

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(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

	INTEGER*2 MBXMSG,UNIT2

	EQUIVALENCE (MBX_BUF(1),MBXMSG)

	CHARACTER NODENAME*8,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 = 0O
	   DO WHILE (MBX_BUF(I+LUSER+1).NE.' '.AND.
     &		     MBX_BUF(I+LUSER+1).NE.'/')V
	      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 = USERNAMEl
	   CALL GET_PROXY_USERNAME(NODENAME,USERNAME)
	   CALL BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM))
	ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR.i
     &		 MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN
	   CALL READ_MBX(%LOC(DCL_CHAN_NUM))t
	ELSEr
 	   CALL LIB$MOVC3(2,MBX_BUF(3),UNIT2)g
	   UNIT_INDEX = 1
	   DO WHILE (UNIT_INDEX.LE.MAXLINK.AND.UNITS(UNIT_INDEX).NE.UNIT2)B
	      UNIT_INDEX = UNIT_INDEX + 1
	   END DO
	   IF (UNIT_INDEX.LE.MAXLINK) CALL DISCONNECT(UNIT_INDEX)
 	   CALL READ_MBX(%LOC(DCL_CHAN_NUM))
	END IF1

	RETURN
 	ENDT




	SUBROUTINE READ_CHAN(CHAN,UNIT_INDEX)

	IMPLICIT INTEGER (A-Z)X

	PARAMETER MAXLINK = 20E

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

	EXTERNAL READ_AST

	EXTERNAL IO$_READVBLK

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

	RETURNN

	END




	SUBROUTINE WRITE_AST(ASTPRM)A

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 20M

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E
	INTEGER*2 WRITE_IOSBI
	LOGICAL*1 WRITE_BUF

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)F
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK) 
	COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK)
	COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)2
	COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 

	COMMON /NNTP/ NNTP_CHANS(MAXLINK)

	CHARACTER*128 INPUT

	EXTERNAL IO$_READVBLK,NEWS_READ_AST

	UNIT_INDEX = %LOC(ASTPRM)

	IF (.NOT.WRITE_IOSB(1,UNIT_INDEX)) THEN
	   CALL DISCONNECT(UNIT_INDEX)F
	ELSE IF (LEN_SAVE(UNIT_INDEX).GT.0) THENS
	   LEN_SAVE(UNIT_INDEX) = LEN_SAVE(UNIT_INDEX) - 1S
	   IF (LEN_SAVE(UNIT_INDEX).EQ.0) THENY
	      IF (REC_SAVE(UNIT_INDEX).EQ.128) THEN
	         REC_SAVE(UNIT_INDEX) = 0
	      ELSE3
	         RETURN
	      END IF 
	   ELSE
              CALL READ_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)),F
     &		OUT_SAVE(UNIT_INDEX),INPUT)Y
	   END IF
	   CALL WRITE_CHAN(REC_SAVE(UNIT_INDEX),INPUT,UNIT_INDEX,IER)
	ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THEN 
	   IER = SYS$QIO(,%VAL(NNTP_CHANS(UNIT_INDEX)),
     &	      IO$_READVBLK,WRITE_IOSB(1,UNIT_INDEX),NEWS_READ_AST,)
     &	      %VAL(UNIT_INDEX),WRITE_BUF(1,UNIT_INDEX),
     &	      %VAL(1024),,,,)
	   IF (IER.AND.WRITE_IOSB(1,UNIT_INDEX).NE.0) THEN 
	      IER = WRITE_IOSB(1,UNIT_INDEX)F
	   END IF
	   IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX) 
	END IFP

	RETURNT
	END



	SUBROUTINE READ_AST(ASTPRM)

	IMPLICIT INTEGER (A-Z)T

	PARAMETER MAXLINK = 20

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)I
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUF0

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

	COMMON /NNTP/ NNTP_CHANS(MAXLINK)

	EXTERNAL NEWS_WRITE_AST

	EXTERNAL IO$_WRITEVBLKM

	UNIT_INDEX = %LOC(ASTPRM)

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

C	IO(UNIT_INDEX) = IO(UNIT_INDEX) + 1_

	CALL LIB$MOVC3(4,READ_BUF(1,UNIT_INDEX),CMD_TYPE)

	IF ((CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16).AND._
     &	    READ_IOSB(2,UNIT_INDEX).EQ.0) THEN2
	   CALL DISCONNECT(UNIT_INDEX)O
	ELSE IF (CMD_TYPE.LT.1.OR.CMD_TYPE.GT.16) THENC
	   CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX))
	   IER = NEWS_WRITE_PACKET_BULLCP(0,I
     &			READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX,I
     &			READ_BUF(1,UNIT_INDEX),READ_IOSB(2,UNIT_INDEX))
	   IF (IER.AND.READ_IOSB(1,UNIT_INDEX).NE.0) THEN
	      IER = READ_IOSB(1,UNIT_INDEX)
	   END IF
	   IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)E
	ELSEH
	   CALL EXECUTE_COMMAND(UNIT_INDEX)
	   CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX) 
	END IFC

	RETURN 
	END





	SUBROUTINE NEWS_WRITE_AST(ASTPRM)

	IMPLICIT INTEGER (A-Z)I

	PARAMETER MAXLINK = 20S

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

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)
	INTEGER*2 WRITE_IOSBH
	LOGICAL*1 WRITE_BUF

	COMMON /NNTP/ NNTP_CHANS(MAXLINK)

	UNIT_INDEX = %LOC(ASTPRM)

	IF (READ_IOSB(1,UNIT_INDEX)) THEN
	   CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)
	   RETURN
	END IF_

	CALL DISCONNECT(UNIT_INDEX)

	RETURNA
	END




	SUBROUTINE NEWS_READ_AST(ASTPRM)4

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 20C

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)
	INTEGER*2 WRITE_IOSBN
	LOGICAL*1 WRITE_BUF

	UNIT_INDEX = %LOC(ASTPRM)

	IF (WRITE_IOSB(1,UNIT_INDEX)) THENS
	   NUM = WRITE_IOSB(2,UNIT_INDEX)
	   CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)O
	   IF (IER) RETURNS
	END IF

	CALL DISCONNECT(UNIT_INDEX)

	RETURN
	END




	SUBROUTINE WRITE_CHAN(NUM,OUTPUT,UNIT_INDEX,IER)D

	IMPLICIT INTEGER (A-Z)_

	PARAMETER MAXLINK = 20 

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)_
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUFV

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)R
	INTEGER*2 WRITE_IOSBT
	LOGICAL*1 WRITE_BUF

	CHARACTER*(*) OUTPUTn

	EXTERNAL IO$_WRITEVBLK, WRITE_AST

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

	ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)C

	IER = SYS$QIO(,%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 

	RETURND

	END





	SUBROUTINE BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM)s

	IMPLICIT INTEGER (A-Z)$

	PARAMETER MAXLINK = 20L

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E
	INTEGER*2 WRITE_IOSBF
	LOGICAL*1 WRITE_BUF

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

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1S

	COMMON /NNTP/ NNTP_CHANS(MAXLINK)

	CHARACTER*(*) USERNAME,FROMNAME

	COMMON /NEWSHOST/ NEWS_GOT_HOST

	EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST
	I
	IO_REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)

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

	IF (REJECT.NE.IO_REJECT) THEN
	   IF (DCL_CHAN_NUM.NE.DCL_CHAN) THEN
	      IER = NEWS_GOT_HOST.AND.NEWS_ASSIGN()
	      IF (IER) THEN
	         NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN()
		 WRITE_IOSB(1,UNIT_INDEX) = 1_
		 IER = NEWS_SOCKET_BULLCP(0,
     &			WRITE_IOSB(1,UNIT_INDEX),NEWS_SOCKET_AST,UNIT_INDEX)P
		 IF (IER.EQ.-1) CALL NEWS_SOCKET_AST(%VAL(UNIT_INDEX))
	      END IF(
	      IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)
	   ELSE
	      CALL READ_CHAN(CHAN,UNIT_INDEX)
	   END IF
	END IFO

	CALL READ_MBX(DCL_CHAN_NUM)

	RETURNr
	END



	SUBROUTINE NEWS_SOCKET_AST(ASTPRM) 

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 20

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)E
	INTEGER*2 WRITE_IOSBM
	LOGICAL*1 WRITE_BUF

	COMMON /NNTP/ NNTP_CHANS(MAXLINK)

	EXTERNAL NEWS_CREATE_AST'

	UNIT_INDEX = %LOC(ASTPRM)

	IF (WRITE_IOSB(1,UNIT_INDEX)) THEN_
	   CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX))
	   IER = NEWS_CREATE_BULLCP(0,=
     &			WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX)N
	   IF (IER) RETURN+
	END IFN

	CALL DISCONNECT(UNIT_INDEX)

	RETURN(
	END


 .
	SUBROUTINE NEWS_CREATE_AST(ASTPRM)R

	IMPLICIT INTEGER (A-Z)=

	PARAMETER MAXLINK = 20(

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)1
	INTEGER*2 WRITE_IOSBU
	LOGICAL*1 WRITE_BUF

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

	UNIT_INDEX = %LOC(ASTPRM)

	IF (WRITE_IOSB(1,UNIT_INDEX)) THEN.
	   CALL WRITE_AST(%VAL(UNIT_INDEX))
	   CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)
	ELSEL
	   CALL DISCONNECT(UNIT_INDEX)
	END IFI

	RETURN 
	END



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

	IMPLICIT INTEGER (A-Z)L

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

	PARAMETER MAXLINK = 20P

	COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)F
	INTEGER*2 WRITE_IOSBR
	LOGICAL*1 WRITE_BUF

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

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK) 
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)R
	COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK)
	COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)R
	COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12K

	COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1M

	EXTERNAL IO$_ACCESS,IO$M_ABORTO

	CHARACTER*(*) USERNAME,FROMNAME,NODENAMEE

	CHARACTER*100 NCBDESC

	START_NCB = 7+MBX_BUF(5)L

	LEN_NCB = MBX_BUF(START_NCB-1)S

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

	IF (COUNT.GT.MAXLINK) THENR
	   REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)
	   CHAN = DCL_CHAN_NUMT
	ELSEI
	   IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN
	      IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX')O
	   ELSE
	      IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1')
	   END IF

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

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

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

	   IF (.NOT.IER.OR.UNIT_INDEX.GT.MAXLINK) THENU
	      REJECT = %LOC(IO$_ACCESS)+%LOC(IO$M_ABORT)A
	      CHAN = DCL_CHAN_NUM
	   ELSE
	      COUNT = COUNT + 1
	      UNITS(UNIT_INDEX) = DEV_UNITL
	      DEVS(UNIT_INDEX) = DEV_CHAN
	      USER_SAVE(UNIT_INDEX) = USERNAMET
	      FROM_SAVE(UNIT_INDEX) = FROMNAME0
	      NODE_SAVE(UNIT_INDEX) = NODENAMEI
	      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 IFT

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

	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 - 1M
	   DEVS(UNIT_INDEX) = 0
	   UNITS(UNIT_INDEX) = 0O
	END IFN

	RETURNA
	END



	SUBROUTINE GETDEVUNIT(CHAN,DEV_UNIT,IER)T
CL
C  SUBROUTINE GETDEVUNIT
CR
C  FUNCTION:
C	To get device unit numberT
C  INPUT:O
C	CHAN - Channel numberD
C  OUTPUT:
C	DEV_UNIT - Device unit number_
CE

	IMPLICIT INTEGER (A-Z)Y

	INCLUDE '($DVIDEF)'

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

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

	RETURNI
	END



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

	IMPLICIT INTEGER (A-Z)E

	INCLUDE '($DVIDEF)'

	CHARACTER*(*) DEV_NAMEI

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

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

	RETURNL
	END



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

	IMPLICIT INTEGER (A-Z)C

	PARAMETER MAXLINK = 201

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)X
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUFE

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

	COMMON /NNTP/ NNTP_CHANS(MAXLINK)

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

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

	IF (NNTP_CHANS(UNIT_INDEX).EQ.0) THEN
	   CALL UPDATE_REMOTE_USERINFO(UNIT_INDEX)R
	END IFF

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

	IF (NNTP_CHANS(UNIT_INDEX).NE.0) THEN
	   CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX))
	   CALL NEWS_DISCONNECT
	   NNTP_CHANS(UNIT_INDEX) = 0
	END IFL

	RETURNU
	END



	SUBROUTINE SET_TIMER(MIN)
CX
C SUBROUTINE SET_TIMER
C
C FUNCTION: Wakes up every MIN minutes to check for idle connections
CB
	IMPLICIT INTEGER (A-Z)4
	INTEGER TIMADR(2)			! Buffer containing timeW
						! in desired system format.
	CHARACTER MIN*(*)

	EXTERNAL CHECK_CONNECTIONSO

	CALL LIB$GET_EF(WAITEFN)F

	IER=SYS$BINTIM('0 00:'//MIN//':00.00',TIMADR)

	ENTRY RESET_TIMER

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

	RETURNA
	END




	SUBROUTINE CHECK_CONNECTIONSU

	IMPLICIT INTEGER (A-Z)

	PARAMETER MAXLINK = 20,

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

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)C
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUFK

	IF (COUNT.GT.0) THENF
	   DO UNIT_INDEX=1,MAXLINK_
	      IF (DEVS(UNIT_INDEX).NE.0.AND.S
     &		IO(UNIT_INDEX).EQ.IO_SAVE(UNIT_INDEX)) THENS
	         CALL DISCONNECT(UNIT_INDEX)C
	      END IF 
	   END DO
	END IFA

	CALL RESET_TIMERR

	RETURNB
	END



	SUBROUTINE GET_USER_PRIV(USERNAME,PRIV)

	IMPLICIT INTEGER (A-Z)S

	DIMENSION PRIV(2)

	CHARACTER USERNAME*(*)T

	INCLUDE '($UAIDEF)'

	INTEGER*2 UIC(2)/

	CALL INIT_ITMLSTT
	CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV))
	CALL END_ITMLST(GETUAI_ITMLST)S

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

	IF (.NOT.IER) THENE
	   USERNAME = 'DECNET'L
	   IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)_
	END IFN

	RETURN 
	END





	SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME)I

	IMPLICIT INTEGER (A-Z)A

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

	CHARACTER NETUAF*100,USERTEMP*12R

	COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM

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

	NUM = 1
	NENTRY = NETUAF_QUEUE

	USERTEMP = 'DECNET'

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

	USERNAME = USERTEMP

	RETURNE
	END





	SUBROUTINE GET_PROXY_ACCOUNTS

	IMPLICIT INTEGER (A-Z)S

	CHARACTER NETUAF*656E

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

	CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100))R

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

	FORMAT = 0R

	IF (IER.NE.0) THEN
	   OPEN (UNIT=7,FILE='NETUAF',DEFAULTFILE='SYS$SYSTEM:NETUAF.DAT',_
     &       ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
     &       STATUS='OLD',READONLY,SHARED,IOSTAT=IER)T
	   FORMAT = 1
	END IFH

	NETUAF_NUM = 0,
	NENTRY = NETUAF_QUEUE
	DO WHILE (IER.EQ.0)
	   READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAFS
	   IF (IER.EQ.0) THEN
	      NETUAF_NUM = NETUAF_NUM + 1
	      IF (FORMAT.EQ.0) THEN
		 NETUAF = NETUAF(13:)E
		 NLEN = NLEN - 12 
		 DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)I
		    SKIP = 4 + ICHAR(NETUAF(65:65))l
		    NETUAF(65:) = NETUAF(65+SKIP:)
		    NLEN = NLEN - SKIP
		 END DOT
		 IF (NLEN.GT.64) THENU
		    ULEN = ICHAR(NETUAF(65:65))I
		    NETUAF(65:) = NETUAF(69:)M
		    DO I=65+ULEN,76(
		       NETUAF(I:I) = ' '
		    END DO
		 ELSEF
		    NETUAF(65:) = 'DECNET'
		 END IFT
	      END IFB
              CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100))
	   END IF
	END DO)

	CLOSE (UNIT=7)

	RETURNN

	END




	SUBROUTINE EXECUTE_COMMAND(UNIT_INDEX)M

	IMPLICIT INTEGER (A-Z)A

	INCLUDE 'BULLFOLDER.INC'N

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLUSER.INC'A

        INCLUDE 'BULLFILES.INC'U

	PARAMETER MAXLINK = 20V

	COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)S
	COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),COUNT
	INTEGER*2 READ_IOSB
	LOGICAL*1 READ_BUFA

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)E
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(MAXLINK)C
	COMMON /CONNECT_STATUS/ FROM_SAVE(MAXLINK),PRIV_SAVE(2,MAXLINK)
	COMMON /CONNECT_STATUS/ NODE_SAVE(MAXLINK),OUT_SAVE(MAXLINK)C
	COMMON /CONNECT_STATUS/ REC_SAVE(MAXLINK),LEN_SAVE(MAXLINK)
	COMMON /CONNECT_STATUS/ LAST_SAVE(2,MAXLINK),LAST_SYS_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDERNAME*44,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 +2
	CHARACTER*(BRDCST_LIMIT) BMESSAGE

        COMMON /MAIN_FOLDER_DIRECTORY/ FOLDER1_DIRECTORY
        CHARACTER*80 FOLDER1_DIRECTORY

        CHARACTER*80 FOLDER2_DIRECTORY

	DIMENSION SCRATCH(MAXLINK),OUT_HEAD(MAXLINK).
	DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/

	EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ

	CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*56
	CHARACTER NODENAME*8,BULLCP_USER*12,INQUEUE*128

	EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE)T

	INTEGER BULLCP_PRIV(2)E

	CALL COPY2(BULLCP_PRIV,PROCPRIV)_

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

	REMOTE_SET = .FALSE.=
	REC_SAVE(UNIT_INDEX) = 0_
	USERNAME = USER_SAVE(UNIT_INDEX)
	FOLDER = FOLDERNAME(UNIT_INDEX)
	FOLDER_NUMBER = FOLDER_NUM(UNIT_INDEX)_
	FOLDER_FLAG = 0
	NODENAME = NODE_SAVE(UNIT_INDEX) 
	CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) 

	CALL INIT_QUEUE(OUT_HEAD(UNIT_INDEX),INQUEUE)

	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.OR.CMD_TYPE.EQ.1) THENA
						! Do we need priv info?T
	   IF (PROCPRIV(1).EQ.0.AND.PROCPRIV(2).EQ.0) THENt
	      CALL GET_USER_PRIV(USER_SAVE(UNIT_INDEX),
     &		 PRIV_SAVE(1,UNIT_INDEX))n
	      USERNAME = USER_SAVE(UNIT_INDEX)	! If changed to DECNET
	      CALL COPY2(PROCPRIV,PRIV_SAVE(1,UNIT_INDEX)) 
	      IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.O
     &		   (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THENd
		 CALL CHECK_BULLETIN_PRIV(USERNAME)W
		 CALL COPY2(PRIV_SAVE(1,UNIT_INDEX),PROCPRIV)I
	      END IFS
	   END IF
	END IFC

	FOLDER2_DIRECTORY = FOLDER_DIRECTORY 
	IF (FOLDER_DIRECTORY.NE.FOLDER1_DIRECTORY.AND.e
     &		TRIM(FOLDER1_DIRECTORY).GT.0) THEN
	   FOLDER_DIRECTORY = FOLDER1_DIRECTORY
	   CALL ADD_DIRECTORIES
	END IFI

	IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN(
	   IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THENi
	      CALL LIB$MOVC3(4,1,%REF(BUFFER(1:)))C
	      CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1)
	   ELSE M
	      CALL LIB$MOVC3(4,0,%REF(BUFFER(1:)))T
	      CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1)
	   END IF
	ELSE IF (CMD_TYPE.EQ.1) THEN			! Select folderR
	   IF (BUFFER(ILEN:ILEN).EQ.'+') THEN
	      SYSLOG = .TRUE.
	      ILEN = ILEN - 1
	   ELSE D
	      SYSLOG = .FALSE.m
	   END IF
	   FOLDER1 = BUFFER(5:ILEN)
	   FOLDER_NUMBER = -2
	   CALL SELECT_FOLDER(.FALSE.,IER)R
	   CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:)))
	   CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:)))
	   IF (USERNAME.NE.'DECNET'.AND.IER) THEN
	      CALL OPEN_USERINFOX
	      IF (USERNAME.EQ.'DECNET') THEN	! User wasn't real.2
	       USER_SAVE(UNIT_INDEX) = USERNAME
	       CALL LIB$MOVC3(4,0,%REF(BUFFER(9:)))
	       CALL LIB$MOVC3(4,0,%REF(BUFFER(13:)))
	      ELSES
	       CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),0
     &				%REF(BUFFER(9:)))E
	       LAST_SAVE(1,UNIT_INDEX) = LAST_READ_BTIM(1,FOLDER_NUMBER+1)D
	       LAST_SAVE(2,UNIT_INDEX) = LAST_READ_BTIM(2,FOLDER_NUMBER+1) 
	      END IFN
	   ELSE
	      CALL LIB$MOVC3(4,0,%REF(BUFFER(9:)))C
	      CALL LIB$MOVC3(4,0,%REF(BUFFER(13:)))
	   END IF
	   LINFO = 16
	   IF (SYSLOG) THEN
	      LINFO = 24I
	      CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1), 
     &			       LAST_SYS_SAVE(1,UNIT_INDEX))
	      CALL LIB$MOVC3(8,LAST_SYS_BTIM(1,FOLDER_NUMBER+1),
     &				%REF(BUFFER(17:)))
	      IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THENI
	         CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),M
     &				  LAST_SYS_BTIM(1,FOLDER_NUMBER+1))I
	      END IFV
	   END IF
	   BUFFER = BUFFER(:LINFO)//FOLDER_COMi
	   CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)I
	   IF (IER.AND.IER1) THEN
	      IF (SYSLOG) THEN
		 CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX)
	      ELSEC
		 LAST_SYS_SAVE(1,UNIT_INDEX) = 0
		 LAST_SYS_SAVE(2,UNIT_INDEX) = 0
	      END IFX
	      FOLDERNAME(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) + 1B
	   CALL WRITE_QUEUE(%VAL(OUT_SAVE(UNIT_INDEX)),
     &			OUT_SAVE(UNIT_INDEX),BUFFER(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(56,%REF(BUFFER(5:)),%REF(DESCRIP))G
	   P = LEN(DESCRIP) + 5
	   CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE))
	   P = LEN(EXDATE) + P$
	   CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME))
	   P = LEN(EXTIME) + P
	   CALL LIB$MOVC3(4,%REF(BUFFER(P:)),SYSTEM)I
	   P = 4 + PN
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)1
	   IF (READ_ONLY.AND.
     &		FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THENN
	      BUFFER = 'ERROR: Insufficient privileges to add message.'
	      CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
	      GO TO 1000N
	   ELSE IF ((SYSTEM.AND.7).NE.0) THEN
	      IF (FOLDER_NUMBER.GT.0.AND.IBCLR(SYSTEM,1).NE.0.AND.T
     &			.NOT.BTEST(FOLDER_FLAG,2)) THEN	! Test if SYSTEM folder
		 SYSTEM = SYSTEM.AND.2
	         CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)E
	      END IF'
	      IF ((SYSTEM.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN
							! Priv test
	         IF (F_EXPIRE_LIMIT.GT.0.AND..NOT.  ! Expiration limit presentS
     &		     FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN 
	            SYSTEM = 0E
	            CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
		 ELSE					! Allow permanent if
		    SYSTEM = SYSTEM.AND.2		! owner of folder
	         END IF
	      END IF
	      IF (BTEST(SYSTEM,2)) THEN			! Shutdown?
	         CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)E
	         WRITE (EXTIME,'(I4)') NODE_NUMBERM
	         WRITE (EXTIME(7:),'(I4)') NODE_AREA 
	         DO I=1,11N
		    IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'R
	         END DO
	         EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//.
     &			 EXTIME(7:8)//'.'//EXTIME(9:10)
	      END IFN
	   END IF
	   CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BROAD)
	   P = 4 + PT
	   IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THENQ
	      BROAD = 0
	   END IF
	   CALL LIB$MOVC3(4,%REF(BUFFER(P:)),BELL) 
	   P = 4 + P 
	   CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ALL)
	   P = 4 + P.
	   CALL LIB$MOVC3(4,%REF(BUFFER(P:)),CLUSTER)
	   CALL SET_FOLDER_FILE(0)A
	   CALL OPEN_BULLDIR.
	   CALL READDIR(0,IER)			! Get NBLOCK
	   IF (IER.EQ.0) NBLOCK = 0		! If new file, NBLOCK is 0
	   CALL OPEN_BULLFILE
	   OENTRY = OUT_HEAD(UNIT_INDEX)	
	   LENGTH = LEN_SAVE(UNIT_INDEX)	
	   LEN_SAVE(UNIT_INDEX) = 0
	   DO I=1,LENGTHN
	      CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)S
	      WRITE (1'NBLOCK+I) INQUEUE	
	   END DO
	   IF (BROAD) THEN 
	      CALL GET_BROADCAST_MESSAGE(BELL)Y
	      CALL BROADCAST(ALL,CLUSTER)
	   END IF
	   CALL CLOSE_BULLFIL			! Finished adding bulletinC
	   CALL ADD_ENTRY			! Add the new directory entry
	   CALL UPDATE_FOLDER			! Update info in folder file'
	   CALL CLOSE_BULLDIR			! 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) GO TO 1000

100	   CALL GETUSER(BULLCP_USER)		! Get present username
	   CALL OPEN_BULLUSER_SHARED		! Broadcast on other nodesX
	   TEMP_USER = ':'E
	   DO WHILE (TEMP_USER(:1).EQ.':')A
	      DO WHILE (REC_LOCK(IER))		 
	         READ (4,KEYGT=TEMP_USER,IOSTAT=IER)M
     &		   TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG,USERNAMEC
		 TEMP_USER = TEMP_USER(:TRIM(TEMP_USER))
		 IF (IER.EQ.0.AND.
     &		     (TEMP_USER(2:TRIM(TEMP_USER)).EQ.NODENAME
     &		     .OR..NOT.TEST2(NEW_FLAG,FOLDER_NUMBER))
     &		     .AND.TEMP_USER(:1).EQ.':') THEN
		    IER1 = REC_LOCK(IER)	! Skip the node thatP
		 END IF				! originated the messageT
	      END DO
	      IF (TEMP_USER(:1).NE.':') THENT
		 CALL CLOSE_BULLUSER
		 CALL SETUSER(BULLCP_USER)
		 REMOTE_SET = .FALSE. 
	         CLOSE (UNIT=REMOTE_UNIT)
		 GO TO 1000
	      END IF/
	      CALL SETUSER(USERNAME)		! Reset to original username0
	      FOLDER1 = 'GENERAL'
	      FOLDER1_BBOARD = ':'//TEMP_USER
	      CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
	      IF (IER.NE.0) THEN/
		 CALL ERRSNS(IDUMMY,IDUMMY,INODE)E
	         IF (INODE.EQ.%LOC(SS$_NOSUCHNODE).OR.D
     &		     INODE.EQ.%LOC(SS$_NOSUCHOBJ).OR.INODE.EQ.0) THENE
		    DELETE (4)
		 END IFR
	      ELSEU
		 IER = 0
		 I = 1
		 DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)P
		    WRITE (REMOTE_UNIT,'(4A)',IOSTAT=IER)I
     &			15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))X
		    I = I + 128
		 END DO 
		 IF (IER.EQ.0) WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)
     &			15,BLENGTH,BELL,ALL,CLUSTER
	      END IF
	   END DO
	ELSE IF (CMD_TYPE.EQ.8) THEN		! Read directory entryM
	   CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT)V
	   CALL SET_FOLDER_FILE(0)
	   CALL OPEN_BULLDIR_SHARED
	   IF (ICOUNT.GE.0) THEND
	      CALL READDIR(ICOUNT,IER)M
	   ELSE
	      CALL LIB$MOVC3(8,%REF(BUFFER(9:)),%REF(MSG_KEY(1:)))Y
	      CALL READDIR_KEYGE(IER)
	   END IF
	   CALL CLOSE_BULLDIR
	   CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:)))
	   IF (ICOUNT.NE.0) THENN
	      BUFFER(5:) = BULLDIR_ENTRYI
	      CALL WRITE_CHAN
     &		(LEN(BULLDIR_ENTRY)+4,BUFFER,UNIT_INDEX,IER)
	   ELSE
	      BUFFER(5:) = BULLDIR_HEADER
	      CALL WRITE_CHAN
     &		(LEN(BULLDIR_HEADER)+4,BUFFER,UNIT_INDEX,IER)V
	   END IF
	ELSE IF (CMD_TYPE.EQ.13) THEN		! Read directory entry
	   CALL LIB$MOVC3(4,%REF(BUFFER(5:)),SBULL)
	   CALL LIB$MOVC3(4,%REF(BUFFER(9:)),EBULL)
	   CALL SET_FOLDER_FILE(0)E
  	   CALL OPEN_BULLDIR_SHARED
	   OENTRY = OUT_HEAD(UNIT_INDEX) 
	   DO I=SBULL,EBULL,ISIGN(1,EBULL-SBULL) 
	      CALL READDIR(I,IER)
	      INQUEUE = BULLDIR_ENTRY
              CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)?
	   END DO
	   CALL CLOSE_BULLDIR
	   OENTRY = OUT_HEAD(UNIT_INDEX)O
	   REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY)H
	   LEN_SAVE(UNIT_INDEX) = ABS(EBULL - SBULL) + 1L
           CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)N
	   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(BUFFER(5:)),ICOUNT) 
	   CALL SET_FOLDER_FILE(0)D
	   CALL OPEN_BULLDIR 
	   IF (ICOUNT.GT.0) THENA
	      BULLDIR_ENTRY = BUFFER(9:) 
	      CALL WRITEDIR_NOCONV(ICOUNT,IER) 
	   ELSE
	      BULLDIR_HEADER = BUFFER(9:)
	      CALL WRITEDIR_NOCONV(ICOUNT,IER)H
	   END IF
	   CALL CLOSE_BULLDIR
	ELSE IF (CMD_TYPE.EQ.4) THENE
	   CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE)
	   CALL LIB$MOVC3(4,%REF(BUFFER(9:)),IMMEDIATE)
	   DESCRIP_TEMP = BUFFER(13:ILEN)
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)R
	   CALL OPEN_BULLDIR	
	   CALL READDIR(BULL_DELETE,IER)V
	   IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN 
	      CALL CLOSE_BULLDIRA
	      BUFFER = 'ERROR: Cannot find message to delete.'E
	      CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
	      GO TO 1000B
	   ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM 
     &	    .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN+
	      CALL CLOSE_BULLDIRS
	      BUFFER = 'ERROR: Insufficient privileges to delete message.'R
	      CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
	      GO TO 1000E
	   END IF
	   CALL REMOVE_ENTRYM
     &		(BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)A
	   CALL CLOSE_BULLDIR
	   CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.5) THEN		! Read messageO
	   CALL LIB$MOVC3(4,%REF(BUFFER(5:)),ICOUNT).
	   CALL SET_FOLDER_FILE(0)S
	   CALL OPEN_BULLDIR_SHARED
	   CALL READDIR(ICOUNT,IER)
	   CALL OPEN_BULLFIL_SHARED
	   OENTRY = OUT_HEAD(UNIT_INDEX)_
	   DO I=BLOCK,BLOCK+LENGTH-1 
	      READ (1'I,IOSTAT=IER) INQUEUE
              CALL WRITE_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)S
	   END DO
	   CALL CLOSE_BULLFIL
	   CALL CLOSE_BULLDIR
	   OENTRY = OUT_HEAD(UNIT_INDEX))
	   REC_SAVE(UNIT_INDEX) = 128
	   LEN_SAVE(UNIT_INDEX) = LENGTHa
           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))
	   CALL SET_FOLDER_FILE(0)(
	   CALL OPEN_BULLDIRL
	   CALL LIB$MOVC3(56,%REF(BUFFER(5:)),%REF(DESCRIP_TEMP))
	   P = LEN(DESCRIP_TEMP) + 5,
	   CALL LIB$MOVC3(4,%REF(BUFFER(P:)),ICOUNT)I
	   P = 4 + PA
	   CALL READDIR(ICOUNT,IER)
	   IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN
	      CALL CLOSE_BULLDIRS
	      BUFFER = 'ERROR: Cannot find message to replace.'
	      CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
	      GO TO 1000R
	   END IF
	   CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP))T
	   P = LEN(DESCRIP) + P
	   CALL LIB$MOVC3(4,%REF(BUFFER(P:)),%REF(MSGTYPE))
	   P = 4 + P
	   CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE))
	   P = LEN(EXDATE) + PS
	   CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME))
	   P = LEN(EXTIME) + P 
	   ALLOW = (FOLDER_OWNER.EQ.USERNAME).OR.SETPRV_PRIV()I
	   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_BULLDIR 
	      BUFFER = 'ERROR: Insufficient privileges to replace message.'
	      CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
	      GO TO 1000 
	   END IF
	   CALL READDIR(0,IER)			! Get NBLOCK
	   CALL OPEN_BULLFIL 
	   NEW_LENGTH = LEN_SAVE(UNIT_INDEX)N
	   LEN_SAVE(UNIT_INDEX) = 0
	   OENTRY = OUT_HEAD(UNIT_INDEX) 
	   DO I=1,NEW_LENGTH4
	      CALL READ_QUEUE(%VAL(OENTRY),OENTRY,INQUEUE)E
	      WRITE (1'NBLOCK+I) INQUEUE 
	   END DO
	   CALL CLOSE_BULLFIL			! Finished adding bulletin/
	   IF (NEW_LENGTH.GT.0) THEN'
	      NEMPTY = NEMPTY + LENGTH
	      LENGTH = NEW_LENGTH
	      BLOCK = NBLOCK + 1)
	   END IF
	   CALL WRITEDIR(ICOUNT,IER)T
	   NBLOCK = NBLOCK + NEW_LENGTH
	   CALL WRITEDIR(0,IER)
	   CALL UPDATE_DIR_HEADER(BTEST(MSGTYPE,3),BTEST(MSGTYPE,1), 
     &		BTEST(MSGTYPE,2),EXDATE,EXTIME)P
	   IF (BTEST(MSGTYPE,0)) THEN
	      SYSTEM = IBSET(SYSTEM,0)		! System?
	   ELSE
	      SYSTEM = IBCLR(SYSTEM,0)		! General? 
	   END IF
	   CALL WRITEDIR(ICOUNT,IER)(
	   CALL CLOSE_BULLDIR
	   CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.11) THEN		! Undeleting
	   CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BULL_DELETE)
	   P = 4 + P 
	   CALL LIB$MOVC3(56,%REF(BUFFER(P:)),%REF(DESCRIP_TEMP))
	   P = LEN(DESCRIP_TEMP) + P 
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)A
	   CALL OPEN_BULLDIR 
	   CALL READDIR(BULL_DELETE,IER)F
	   IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THENd
	      CALL CLOSE_BULLDIRD
	      BUFFER = 'ERROR: Cannot find message to undelete.'B
	      CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
	      GO TO 1000R
	   ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM
     &	    .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN 
	      CALL CLOSE_BULLDIRA
	      BUFFER = 'ERROR: Insufficient privileges to undelete message.':
	      CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
	      GO TO 1000 
	   END IF
	   CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXDATE))
	   P = LEN(EXDATE) + P_
	   CALL LIB$MOVC3(12,%REF(BUFFER(P:)),%REF(EXTIME))
	   P = LEN(EXTIME) + P.
	   CALL WRITEDIR(BULL_DELETE,IER)
	   CALL CLOSE_BULLDIR
	   CALL WRITE_CHAN(LEN(FOLDER_COM),FOLDER_COM,UNIT_INDEX,IER)
	ELSE IF (CMD_TYPE.EQ.12) THEN		! Find newest bulletin
	   CALL SET_FOLDER_FILE(0)	
	   CALL OPEN_BULLDIR_SHARED
	   CALL READDIR(0,IER) 
	   CALL GET_NEWEST_MSG(%REF(BUFFER(5:)),BULL_POINT)
	   CALL CLOSE_BULLDIR
	   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(BUFFER(5:)),FLAG)e
	   FOLDER1 = FOLDER
	   FOLDER_NUMBER = -1
	   CALL SELECT_FOLDER(.FALSE.,IER)C
	   CALL OPEN_BULLUSER_SHAREDO
	   TEMP_USER = ':'//NODENAME(:TRIM(NODENAME))
	   DO WHILE (REC_LOCK(IER))
	      READ (4,KEY=TEMP_USER,IOSTAT=IER) R
     &		TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAGI
	   END DO
	   IF (IER.NE.0) THEN
	      DO I=1,FLONGS
		 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_BULLUSERO
	ELSE IF (CMD_TYPE.EQ.15) THEN		! Broadcast message 
	   CALL LIB$MOVC3(4,%REF(BUFFER(5:)),BLENGTH)
	   CALL LIB$MOVC3(4,%REF(BUFFER(9:)),START)
	   IF (BLENGTH.EQ.-1) THENG
	      IF (SCRATCH(UNIT_INDEX).EQ.0) THEN
		 CALL LIB$GET_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))
	      END IFN
	      CALL LIB$MOVC3(ILEN-12,%REF(BUFFER(13:)),
     &				%VAL(SCRATCH(UNIT_INDEX)+START-1))
	   ELSE
	      CALL LIB$MOVC3(BLENGTH,%VAL(SCRATCH(UNIT_INDEX)),
     &				%REF(BMESSAGE(1:)))L
	      CALL LIB$MOVC3(4,%REF(BUFFER(13:)),ALL)
	      CALL LIB$MOVC3(4,%REF(BUFFER(17:)),CLUSTER)
	      CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))
	      IF (ILEN.GT.20) THENF
	         CALL LIB$MOVC3(4,%REF(BUFFER(21:)),FOLDER_NUMBER)_
	         FOLDER = BUFFER(44:)
		 GO TO 100
	      ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN
	         CALL BROADCAST(ALL,CLUSTER)E
	      END IFY
	   END IF
	ELSE IF (CMD_TYPE.EQ.16) THEN		! Change folder nodename
 	   CALL OPEN_BULLFOLDER_SHARED
	   IER = 0H
	   DO WHILE (IER.EQ.0)_
	      CALL READ_FOLDER_FILE(IER)Y
	      IF ('::'//BUFFER(5:TRIM(BUFFER(:12))).EQ.
     &		  FOLDER_BBOARD(:TRIM(BUFFER(:12))+2).AND.IER.EQ.0) THEN
	         FOLDER_BBOARD(3:) = BUFFER(13:TRIM(BUFFER(:20)))
	         CALL REWRITE_FOLDER_FILE(IER)E
	      END IFE
	   END DO
	   CALL CLOSE_BULLFOLDER 
	END IFB

1000	CALL COPY2(PROCPRIV,BULLCP_PRIV)A

	IF (FOLDER_DIRECTORY.NE.FOLDER2_DIRECTORY) THEN
	   FOLDER_DIRECTORY = FOLDER2_DIRECTORY
	   CALL ADD_DIRECTORIES
	END IFD

	RETURNC
	END



	SUBROUTINE UPDATE_REMOTE_USERINFO(UNIT_INDEX)

	IMPLICIT INTEGER (A-Z)C

	INCLUDE 'BULLUSER.INC' 

	INCLUDE 'BULLDIR.INC'

	INCLUDE 'BULLFOLDER.INC' 

	PARAMETER MAXLINK = 20R

	COMMON /CONNECT_STATUS/ FOLDER_NUM(MAXLINK),OUT_NUM(MAXLINK)T
	COMMON /CONNECT_STATUS/ USER_SAVE(MAXLINK),FOLDERNAME(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),LAST_SYS_SAVE(2,MAXLINK)
	CHARACTER USER_SAVE*12,FOLDERNAME*44,FROM_SAVE*12,NODE_SAVE*12 

	DIMENSION SAVE_BTIM(2) 

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

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

	CALL OPEN_USERINFOF
	DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),R
     &				LAST_SAVE(1,UNIT_INDEX))
	IF (DIFF.LT.0) THEN
	   LAST_READ_BTIM(1,FOLDER_NUMBER+1) = LAST_SAVE(1,UNIT_INDEX)&
	   LAST_READ_BTIM(2,FOLDER_NUMBER+1) = LAST_SAVE(2,UNIT_INDEX)E
	END IF

	IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND._
     &	    LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND.g
     &	    LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.
     &	    LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENI
 	   DIFF1 = -1L
	ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.D
     &	    LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THENK
	   DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1),
     &				LAST_SYS_SAVE(1,UNIT_INDEX))
	ELSEI
	   DIFF1 = 0N
	END IF 

	IF (DIFF1.LT.0) THENA
	   LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = LAST_SYS_SAVE(1,UNIT_INDEX)
	   LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = LAST_SYS_SAVE(2,UNIT_INDEX)
	END IFE

	IF (DIFF1.LT.0.OR.DIFF.LT.0) CALL UPDATE_USERINFO

	RETURNR

	ENTRY SAVE_LAST_READ_BTIM(UNIT_INDEX)

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

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

	IF (DIFF.GE.0) RETURN

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

	RETURNE

	ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX)B

	CALL SYS_BINTIM('-',SAVE_BTIM)			! Get today's date

	LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)E
	LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)A

	RETURNI

	END




	SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME)P

	IMPLICIT INTEGER (A-Z)U

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

	INCLUDE 'BULLFILES.INC'

	IER = SETPRV_PRIV()

	IF ((PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.
     &	    (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN(
	   CALL CHECK_ACCESS(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),
     &		USERNAME,R_ACCESS,W_ACCESS) 
	   IF (R_ACCESS) CALL COPY2(PROCPRIV,NEEDPRIV)%
	END IFE

	RETURN 
	END



	SUBROUTINE GETACC(ACCOUNT)R
CB
C  SUBROUTINE GETACC
C
C  FUNCTION:
C	To get account of present process.
C  OUTPUTS:O
C	ACCOUNT   -   ACCOUNT owner of present process.B
CT

	IMPLICIT INTEGER (A-Z)T

	CHARACTER*(*) ACCOUNT		! Limit is 12 characters

	INCLUDE '($JPIDEF)'

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

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

	RETURN
	END





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

	IMPLICIT INTEGER (A-Z)%

	INCLUDE '($JPIDEF)'

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

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

	RETURNL
	END





	INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN)

	IMPLICIT INTEGER (A-Z) 

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

	RECORD /FABDEF/ FAB
	RECORD /RABDEF/ RAB

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

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

	LNM_MODE_EXEC = STATUSL

	END



	INTEGER FUNCTION REC_LOCK(IER)W

	INCLUDE '($FORIOSDEF)'A

	DATA INIT /.TRUE./A

	IF (INIT) THENO
	   REC_LOCK = 1
	   INIT = .FALSE.
	ELSEF
	   IF (IER.EQ.FOR$IOS_SPERECLOC) THEN
	      CALL WAIT_SEC('01')
	      INIT = INIT + 2
	      IF (INIT.GT.60) THENV
		 WRITE (6,'('' Bulletin aborting due to record lock'',
     &			    '' problem.  Alert system administrator.'')')
		 CALL EXIT
	      END IFA
	   ELSE
	      REC_LOCK = 0I
	      INIT = .TRUE.
	   END IF
	END IF 

	RETURNB
	END

	INTEGER FUNCTION TRIM(INPUT)T
	CHARACTER*(*) INPUT
	DO TRIM=LEN(INPUT),1,-1
	 IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURNI
	END DO,
	RETURNI
	END

	SUBROUTINE SYS_GETMSG(IER) 

	IMPLICIT INTEGER (A-Z)N

	CHARACTER*80 MESSAGEE

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

	RETURNE
	END



	SUBROUTINE HELP(LIBRARY)B

	IMPLICIT INTEGER (A-Z)t

	CHARACTER*(*) LIBRARY

	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER

	IER = CLI$GET_VALUE('HELP_FOLDER',BULL_PARAMETER,LEN_P)
	IF (.NOT.IER) BULL_PARAMETER = ' 'X

	CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY)

	RETURN
	END




	SUBROUTINE GET_NODE_INFOI
CU
C  SUBROUTINE GET_NODE_INFOE
CL
C  FUNCTION: Gets local node name and obtains node names from,
C	command line.M
CY

	IMPLICIT INTEGER (A-Z)s

	EXTERNAL CLI$_ABSENTF

	COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
     &				NODE_ERROR,POINT_NODES

	COMMON /TEMP_INPUT/ NODE_TEMP
	CHARACTER NODE_TEMP*256

	CHARACTER*32 NODES(10)R
	LOGICAL LOCAL_NODE_FOUND,NODE_ERROR

	CHARACTER LOCAL_NODE*32,PASSWORD*32,TEMP_USER*12 

	NODE_ERROR = .FALSE.F

	LOCAL_NODE_FOUND = .FALSE.O
	CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE)
	L_NODE = L_NODE - 2			! Remove '::'
	IF (LOCAL_NODE(1:1).EQ.'_') THENN
	   LOCAL_NODE = LOCAL_NODE(2:)E
	   L_NODE = L_NODE - 1R
	END IFY

	NODE_NUM = 0				! Initialize number of nodes_
	IF (CLI$PRESENT('NODES')) THEN		! Decnet nodes specified?
	   DO WHILE (CLI$GET_VALUE('NODES',NODE_TEMP)
     &	    .NE.%LOC(CLI$_ABSENT))		! Get the specified nodes
	    IER = SYS_TRNLNM(NODE_TEMP,NODE_TEMP)
	    DO WHILE (TRIM(NODE_TEMP).GT.0)
	      NODE_NUM = NODE_NUM + 1
	      COMMA = INDEX(NODE_TEMP,',')&
	      IF (COMMA.GT.0) THENF
		 NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1) 
		 NODE_TEMP = NODE_TEMP(COMMA+1:)
	      ELSET
		 NODES(NODE_NUM) = NODE_TEMP
		 NODE_TEMP = ' '
	      END IFN
	      NLEN = TRIM(NODES(NODE_NUM)) 
	      I = INDEX(NODES(NODE_NUM),'::')
	      TEMP_USER = ' '
	      IF (I.GT.0.AND.NLEN-I.EQ.1) THENL
		 NLEN = NLEN - 2
		 NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)
	      ELSE IF (I.GT.0.AND.NLEN-I.GT.1) THEN
		 TEMP_USER = NODES(NODE_NUM)(I+2:)
		 NLEN = I - 1 
		 NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)F
	         POINT_NODE = NODE_NUMR
	         IER = 1A
	         DO WHILE (IER.NE.0)I
	            WRITE(6,'('' Enter password for node '',2A)')
     &			NODES(NODE_NUM)(:NLEN),CHAR(10)
		    CALL GET_INPUT_NOECHO(PASSWORD)O
		    IF (TRIM(PASSWORD).EQ.0) THEN 
		       DO WHILE (NODE_NUM.GT.0)R
		          CLOSE(UNIT=9+NODE_NUM)
		          NODE_NUM = NODE_NUM - 13
		       END DO:
		       NODE_ERROR = .TRUE.
		       RETURN4
	            END IF 
	            OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//
     &		     '"'//TEMP_USER(:TRIM(TEMP_USER))//' '//
     &		     PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"',N
     &		     ACCESS='SEQUENTIAL',FORM='FORMATTED',
     &		     CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)
		    IF (IER.NE.0) THEN
		       WRITE (6,'('' ERROR: Password is invalid.'')').
		    END IF
	         END DO
	      END IFU
	      IF (LOCAL_NODE(:L_NODE).EQ.NODES(NODE_NUM)(:NLEN)) THEN
	         NODE_NUM = NODE_NUM - 1 
	         LOCAL_NODE_FOUND = .TRUE.
	      ELSE IF (TRIM(TEMP_USER).EQ.0) THEN
	         POINT_NODE = NODE_NUMR
	         OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//L
     &		  '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',E
     &		  CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)
	         IF (IER.NE.0) THEN
		    DO WHILE (NODE_NUM.GT.0)
		       CLOSE(UNIT=9+NODE_NUM)R
		       NODE_NUM = NODE_NUM - 1
		    END DO
		    NODE_ERROR = .TRUE.I
		    RETURN
	         END IF
	      END IFK
	    END DOM
	   END DO
	ELSEC
	   LOCAL_NODE_FOUND = .TRUE.K
	END IFV
	RETURNN
	END




	SUBROUTINE SET_FOLDER_FILE(NUM)
C_
C  SUBROUTINE SET_FOLDER_FILET
CA
C  FUNCTION: Sets folder file name.  If NUM = 0, set FOLDER_FILE,L
C		if = 1, set FOLDER1_FILES
C(

	IMPLICIT INTEGER (A-Z)_

	INCLUDE 'BULLFOLDER.INC'V

	IF (NUM.EQ.0) THEND
	   CALL SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE)L
	ELSE IF (NUM.EQ.1) THEN
	   CALL SET_FILE(FOLDER1,FOLDER1_FLAG,FOLDER1_NUMBER,FOLDER1_FILE)L
	END IF 

	RETURNF
	END



	SUBROUTINE SET_FILE(FOLDER,FOLDER_FLAG,FOLDER_NUMBER,FOLDER_FILE)
C,
C  SUBROUTINE SET_FILE
C0
	IMPLICIT INTEGER (A-Z)M

	INCLUDE 'BULLFILES.INC'

	CHARACTER*(*) FOLDER,FOLDER_FILEM

	IF (.NOT.BTEST(FOLDER_FLAG,8)) THEN
	   FOLDER_FILE =
     &		FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER 
	ELSEY
	   FOLDER_FILE = NEWS_DIRECTORY(:TRIM(NEWS_DIRECTORY)-1)//E
     &		'.]'
	END IF.

	RETURN 
	END




        SUBROUTINE SET_BULLFIL

        IMPLICIT INTEGER (A-Z)

	INCLUDE 'BULLFOLDER.INC'

	INCLUDE 'BULLDIR.INC'

        COMMON /BULLFIL/ BULLFIL

	CHARACTER FILDATE*12T

	DATA UPDATE/.FALSE./ 

	UPDATE = .TRUE.

	ENTRY SET_BULLFIL_UPDATE 

	UPDATE = .NOT.UPDATEI

	IER = SYS$ASCTIM(,FILDATE,EX_BTIM,) ,
	IF (.NOT.IER.OR.FILDATE.EQ.'17-NOV-1858 ') 
     &				IER = SYS$ASCTIM(,FILDATE,,)
	IF (BULLFIL.EQ.1) FILDATE = EXDATEE
	FILDATE = FILDATE(FIRST_ALPHA(FILDATE):)T

	M = INDEX(FILDATE,'-')E
	FOLDER1_FILE = FOLDER_FILE(:MINGT0(INDEX(FOLDER_FILE,'.]'),
     &		INDEX(FOLDER_FILE,'.BULLNEWS')))//'BULLNEWS'//
     &		FILDATE(INDEX(FILDATE,' ')-2:TRIM(FILDATE))//']'//
     &		FILDATE(:M-1)//FILDATE(M+1:M+3)S
	A
	IF (FOLDER1_FILE.NE.FOLDER_FILE) THEN R
	   FOLDER_FILE = FOLDER1_FILE
	   IF (BULLFIL.GT.0) CALL CLOSE_BULLFIL
	   IF (BULLFIL.EQ.-1) THEN
	      BULLFIL = 1
	      CALL OPEN_BULLFIL
	   ELSE IF (BULLFIL.EQ.-2) THEN
	      BULLFIL = 2
	      CALL OPEN_BULLFIL_SHAREDH
	   END IF
	END IFR
	E
        IF (UPDATE) THEN	Z
	   READ (1'1) NBLOCKE
	   REWRITE (1) NBLOCK + LENGTHC
	   UPDATE = .FALSE.
	END IFS

	RETURN)
	END



	INTEGER FUNCTION MINGT0(I,J).

        IMPLICIT INTEGER (A-Z)

	IF (I.LE.0) THENE
	   MINGT0 = J
	ELSE IF (J.LE.0) THEN
	   MINGT0 = I
	ELSE
	   MINGT0 = MIN(I,J)S
	END IF	

	RETURN(
	END
