diff --git a/NOTES.md b/NOTES.md
index 9ce89dc3f071adfc4d3def1017b0a46515d48f69..3f345ae7e010a8deac225d5c6fc8b2cd0668b5c0 100644
--- a/NOTES.md
+++ b/NOTES.md
@@ -6,6 +6,6 @@ The idea is to use the help files to implement BULLETIN.
## Module links
- * cli ([docs](https://cli.urfave.org/v3/getting-started/), [github](https://pkg.go.dev/github.com/urfave/cli/v3))
- * readline ([docs](https://pkg.go.dev/github.com/chzyer/readline), [github](https://github.com/chzyer/readline))
- * xdg ([docs](https://pkg.go.dev/github.com/adrg/xdg), [github](https://github.com/adrg/xdg))
+ * cli - [docs](https://cli.urfave.org/v3/getting-started/)
+ * readline - [docs](https://pkg.go.dev/github.com/chzyer/readline)
+ * xdg - [docs](https://pkg.go.dev/github.com/adrg/xdg)
diff --git a/decus/vax91b/bulletin-net91b/allmacs.mar b/decus/vax91b/bulletin-net91b/allmacs.mar
deleted file mode 100644
index 7d32442660a0cb2aa2e7f25d7d77445dd8167601..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/allmacs.mar
+++ /dev/null
@@ -1,345 +0,0 @@
-;
-; Name: SETACC.MAR
-;
-; Type: Integer*4 Function (MACRO)
-;
-; Author: M. R. London
-;
-; Date: Jan 26, 1983
-;
-; Purpose: To set the account name of the current process (which turns out
-; to be the process running this program.)
-;
-; Usage:
-; status = SETACC(account)
-;
-; status - $CMKRNL status return. 0 if arguments wrong.
-; account - Character string containing account name
-;
-; NOTES:
-; Must link with SS:SYS.STB
-;
-
- .Title SETACC
- .IDENT /830531/
-;
-; Libraries:
-;
- .LIBRARY /SYS$LIBRARY:LIB.MLB/
-;
-; Global variables:
-;
- $PCBDEF
- $JIBDEF
-;
-; local variables:
-;
-
- .PSECT DATA,NOEXE
-
-NEWACC: .BLKB 12 ; Contains new account name
-;
-; Executable:
-;
- .PSECT CODE,EXE,NOWRT ; Executable code
-
- .ENTRY SETACC,^M<R2,R3,R4,R5,R6,R7>
- CLRL R0 ; 0 is error code
- MOVZBL (AP),R6 ; Get number of arguments
- CMPL R6,#1 ; Correct number of arguments?
- BNEQ 5$ ; If not, return
- MOVZBL @4(AP),R6 ; Get size of string
- MOVL 4(AP),R7 ; Get address of descriptor
- MOVL 4(R7),R7 ; Get address of string
- MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string
- $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode
-5$: RET
-10$: .WORD ^M<> ; Entry mask
- MOVL @#CTL$GL_PCB,R6 ; Address of current process
- MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block
- ; NOTE: MOVC destroys r0-r5
- MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB
- MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1
- MOVZWL #SS$_NORMAL,R0 ; Normal ending
- RET
-;
-; Name: SETUIC.MAR
-;
-; Type: Integer*4 Function (MACRO)
-;
-; Author: M. R. London
-;
-; Date: May 31, 1983
-;
-; Purpose: To set the UIC of the current process (which turns out
-; to be the process running this program.)
-;
-; Usage:
-; status = SETUIC(group number, user number)
-;
-; status - $CMKRNL status return. 0 if arguments wrong.
-; group number - longword containing UIC group number
-; user number - longword containing UIC user number
-;
-; NOTES:
-; Must link with SS:SYS.STB
-;
-
- .Title SETUIC Set uic
- .IDENT /830531/
-;
-; Libraries:
-;
- .LIBRARY /SYS$LIBRARY:LIB.MLB/
-;
-; Global variables:
-;
- $PCBDEF
-;
-; Executable:
-;
- .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code
-
- .ENTRY SETUIC,^M<R2,R3>
- CLRL R0 ; 0 is error code
- MOVZBL (AP),R2 ; Get number of arguments
- CMPL R2,#2 ; Are there 2 arguments
- BNEQ 5$ ; If not, return
- MOVL @4(AP),R3 ; Group number into R3
- ROTL #16,R3,R3 ; Move to upper half of R3
- ADDL2 @8(AP),R3 ; User number to top half of R3
- $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode
-5$: RET
-10$: .WORD ^M<> ; Entry mask
- MOVL @#CTL$GL_PCB,R2 ; Address of current process
- MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified
- MOVZWL #SS$_NORMAL,R0 ; Normal ending
- RET
-;
-; Name: SETUSER.MAR
-;
-; Type: Integer*4 Function (MACRO)
-;
-; Author: M. R. London
-;
-; Date: Jan 26, 1983
-;
-; Purpose: To set the Username of the current process (which turns out
-; to be the process running this program.)
-;
-; Usage:
-; status = SETUSER(username)
-;
-; status - $CMKRNL status return. 0 if arguments wrong.
-; username - Character string containing username
-;
-; NOTES:
-; Must link with SS:SYS.STB
-;
-
- .Title SETUSER Set uic
- .IDENT /830531/
-;
-; Libraries:
-;
- .LIBRARY /SYS$LIBRARY:LIB.MLB/
-;
-; Global variables:
-;
- $PCBDEF
- $JIBDEF
-;
-; local variables:
-;
-
- .PSECT SETUSER_DATA,NOEXE
-
-NEWUSE: .BLKB 12 ; Contains new username
-OLDUSE: .BLKB 12 ; Contains old username
-;
-; Executable:
-;
- .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code
-
- .ENTRY SETUSER,^M<R2,R3,R4,R5,R6,R7,R8>
- CLRL R0 ; 0 is error code
- MOVZBL (AP),R8 ; Get number of arguments
- CMPL R8,#1 ; Correct number of arguments
- BLSS 5$ ; If not, return
- MOVZBL @4(AP),R6 ; Get size of string
- MOVL 4(AP),R7 ; Get address of descriptor
- MOVL 4(R7),R7 ; Get address of string
- MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string
- CMPL R8,#2 ; Old username given?
- BLSS 2$ ; No
- MOVZBL @8(AP),R6 ; Get size of string
- MOVL 8(AP),R7 ; Get address of descriptor
- MOVL 4(R7),R7 ; Get address of string
- MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string
- $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode
- TSTL R0 ; If old username is checks with
- BEQL 2$ ; present process name, change
- MOVL #2,R0 ; to new username, else flag
- RET ; error and return
-2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode
-5$: RET
-10$: .WORD ^M<> ; Entry mask
- MOVL @#CTL$GL_PCB,R7 ; Address of current process
- MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block
- ; NOTE: MOVC destroys r0-r5
- MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB
- MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1
- MOVZWL #SS$_NORMAL,R0 ; Normal ending
- RET
-20$: .WORD ^M<> ; Entry mask
- MOVL @#CTL$GL_PCB,R7 ; Address of current process
- MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block
- ; NOTE: MOVC destroys r0-r5
- CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB
- RET
-
-
- .TITLE READ_HEADER - Read Image Header
- .IDENT /1-001/
-
-; This subroutine returns the image identification and link time.
-;
-; Format:
-;
-; status.wlc.v = READ_HEADER( ident.wt.ds [,time.wt.ds] )
-;
-; Parameters:
-;
-; ident The image identification text.
-;
-; time The image link time (text format).
-
-
-; Date By Comments
-; 4/10/87 D.E. Greenwood Originally written by John Miano, 24-June-1986 -
-; obtained from April 87 DECUS L&T Sig Newsletter
- .LIBRARY "SYS$LIBRARY:LIB"
-
- $DSCDEF
- $IHDDEF
- $IHIDEF
- $SSDEF
-
-; Argument pointer offsets
-
- $OFFSET 4,POSITIVE,<IDENT,TIME>
-
- .PSECT READ_HEADER, RD, NOWRT, EXE, LONG
- .ENTRY READ_HEADER, ^M< R2, R3, R4, R5, R6, R7, R8, R11 >
-
- CMPL (AP),#1 ; Make sure that there is at least
- BGEQ ENOUGH_ARGUMENTS ; one argument to this routine
- MOVL #SS$_INSFARG, R0
- RET
-
-ENOUGH_ARGUMENTS:
-
-; Get the identification of the image.
-
- MOVL @#CTL$GL_IMGHDRBF, R11 ; R11 - Address of image buffer
- MOVL (R11), R6 ; R6 - Address of image header
-
- CVTWL IHD$W_IMGIDOFF(R6), R7
- MOVAB (R6)[R7], R7 ; R7 - Address of ID Block
-
- CVTBL IHI$T_IMGID(R7),R0 ; Length of the ID string
- MOVL IDENT(AP), R8
- MOVC5 R0, <IHI$T_IMGID+1>(R7), #32, -
- DSC$W_LENGTH(R8), @DSC$A_POINTER(R8)
-
- CMPL (AP), #2
- BGEQ RETURN_TIME
- MOVZBL #1, R0
- RET
-
-RETURN_TIME:
-
-; Get the time the image was linked and convert it to ASCII
-
- $ASCTIM_S -
- TIMBUF=@TIME(AP), -
- TIMADR=IHI$Q_LINKTIME(R7)
-
- RET
-
- .MACRO M$$DEFERRED_CALL, IMAGE, NAME, NAME1
-;
-; Defer image activation on this routine
-;
- .PSECT $LOCAL,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG
- IMAGE_'NAME: .ASCID /IMAGE/
- SYMBOL_'NAME: .ASCID /NAME1/
- ADDRESS_'NAME: .BLKL 1
- FIND_'NAME: .LONG 3
- .ADDRESS IMAGE_'NAME
- .ADDRESS SYMBOL_'NAME
- .ADDRESS ADDRESS_'NAME
- .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
- .ENTRY 'NAME,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
- CALLG G^FIND_'NAME',G^LIB$FIND_IMAGE_SYMBOL
- ADDL3 #2,G^ADDRESS_'NAME,R2
- JMP (R2)
- .ENDM M$$DEFERRED_CALL
-
- M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostbyname1 gethostbyname
- M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY htons1 htons
- M$$DEFERRED_CALL MULTINET_SOCKET_LIBRARY gethostname1 gethostname
-
- .END
-.title Get_AP - Obtains the callers argument pointer
-;
-; Function:
-;
-; Returns the address of the argument list for the preceeding Stack Frame
-; as a Function Value and loads its only Formal Argument with the value
-; stored at that location, the number of argument pointers in the list.
-;
-; Example:
-;
-; program Test_AP
-; C
-; C The following is a FORTRAN example of use of the Get_AP subroutine.
-; C
-; call Test( 1, 2, 3, 4 )
-; end
-;
-; subroutine Test
-; implicit integer (A-Z)
-; Pointer = Get_AP( Count )
-; call List_AP( %val(Pointer) )
-; write(6,10)Count
-; return
-; 10 format(1X,I2,' arguments were passed to me.')
-; end
-;
-; subroutine List_AP( Pointer )
-; integer Pointer(*)
-; write(6,10)Pointer(1)
-; return
-; 10 format(1X,I2,' arguments were passed to my caller.')
-; end
-;
-; Author:
-;
-; Chris Hume 7-Sep-1982
-;
-$SFDEF ; Stack Frame definitions
-
-Arg_Pointer = 4 ; Pointer to get argument list adr
-
-.entry Get_AP,^m<>
-
- moval @SF$L_Save_AP(fp),r0 ; Get AP for previous Frame.
- tstl (ap) ; Check for presence of Our Formal.
- beqlu 10$ ; Exit if not present,
- moval @Arg_Pointer(ap),r1 ; or if the Address is Null.
- beqlu 10$
- movzbl (r0),(r1) ; Copy argument count.
-10$: ret
-
-.end
diff --git a/decus/vax91b/bulletin-net91b/bull_ann.txt b/decus/vax91b/bulletin-net91b/bull_ann.txt
deleted file mode 100644
index 8fc445beffbcfcf6339ddfb7347077a454efcb2e..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bull_ann.txt
+++ /dev/null
@@ -1,412 +0,0 @@
-From: AITGW::"BULLETIN@ORYANA.PFC.MIT.EDU" 26-SEP-1991 16:10:22.31
-To: ARISIA::EVERHART
-CC:
-Subj: BULLETIN utility.
-
-Received: by AITGW.DECnet (utk-mail11 v1.5) ; Thu, 26 Sep 91 16:10:22 EDT
-Received: from ORYANA.PFC.MIT.EDU by aitgw.ge.com (5.65/GE Gateway 1.4)
- id AA03731; Thu, 26 Sep 91 16:09:04 -0400
-Message-Id: <0C62FFB72B2FC0142E@ORYANA.PFC.MIT.EDU>
-Date: Thu, 26 Sep 91 15:20 EST
-From: BULLETIN@ORYANA.PFC.MIT.EDU
-Subject: BULLETIN utility.
-To: ARISIA::EVERHART
-X-Envelope-To: EVERHART@ARISIA.dnet.ge.com
-X-Vms-To: IN%"EVERHART@ARISIA.dnet.ge.com"
-
-You are about to receive version 2.06 of the PFC BULLETIN.
-
-BULLETIN is public domain software. (I will gladly accept
-recommendations for new features, not for changes that are due to
-"personal" preference.)
-
-As of V2.0, BULLETIN is able to read USENET NEWS via TCP/IP using either
-CMU, MULTINET, UCX, TWG, or via DECNET. It can also serve as a NEWS
-gateway for DECNET nodes without direct access to the NEWS server, i.e. a
-DECNET node without Internet access will be able to read NEWS.
-
-NOTE: The following commands can be sent to BULLETIN@ORYANA.PFC.MIT.EDU:
- SEND ALL [SINCE time] Sends all bulletin files.
- If SINCE time specified, only files created
- since that time will be sent.
- SEND filename Sends the specified file.
- BUGS Sends a list of the latest bug fixes.
- HELP or INFO Sends a brief description of BULLETIN.
- SUBSCRIBE Subscribes to mailing list for upgrade
- notifications.
- UNSUBSCRIBE Unsubscribes from mailing list.
-
-There is also a documentation file written by Chris Tanner from Chalk
-River Nuclear Labs which can be used as handout. To obtain this,
-request the file BULLETIN.DOC. (This does not describe the NEWS reader
-feature, however.)
-
-NOTE: An old bug might have changed the protection on the BULLETIN data
-files. The protection on all data files (i.e. B*.DAT, *.BULLFIL, and
-*.BULLDIR) should be (RWED,RWED,,).
-
-This version includes all necessary modifications to work under VMS
-V5.0. However, it will still be necessary to reassemble the ALLMACS.MAR
-source under V5 and relink. The V4 version will not be installable
-under V5 due to a change in a shared library which BULLETIN uses.
-However, relinking by itself will not be enough. You MUST also
-reassemble ALLMACS.MAR. If you only relink, BULLETIN can cause your
-system to crash (the BULLCP process will do this because it uses the
-routines in ALLMACS.MAR).
-
-If you are running a version of BULLETIN older than 1.52, this version
-will modify the format of some of the data files. (This will be done
-automatically when the new version is run). After successful
-installation, the older versions of these files can be removed. This
-format change can take a significant amount of time if the folder is
-large. If your site has large folders, it is suggested that the new
-version be installed during off peak hours. NOTE: Problems can occur
-if the old version of BULLETIN is run after the data files have been
-modified. Such a situation is possible on a cluster where each node has
-installed the executable separately. To help installation, a new
-command procedure INSTALL_REMOTE.COM has been included. This can be
-used to install BULLETIN on several nodes from a single node. Read the
-comments in the file for information on how to use it.
-
-NOTE: The BULLCP process should be stopped using the BULLETIN/STOP
-command before the new version of BULLETIN is installed. It can then be
-restarted using the BULLETIN/STARTUP command. (The INSTALL_REMOTE.COM
-command procedure does this automatically for remote nodes.)
-
-You will be receiving 20 files (NOT NECESSARILY IN THIS ORDER!):
- 1) BULLETIN.FOR
- 2) BULLETIN0.FOR
- 3) BULLETIN1.FOR
- 4) BULLETIN2.FOR
- 5) BULLETIN3.FOR
- 6) BULLETIN4.FOR
- 7) BULLETIN5.FOR
- 8) BULLETIN6.FOR
- 9) BULLETIN7.FOR
- 10) BULLETIN8.FOR
- 11) BULLETIN9.FOR
- 12) BULLETIN10.FOR
- 13) BULLETIN11.FOR
- 14) ALLMACS.MAR
- 15) BULLCOMS1.HLP
- 16) BULLCOMS2.HLP
- 17) BULLET1.COM
- 18) BULLET2.COM
- 19) PMDF.COM
- 20) MX.COM
-
-(They will be identified in the SUBJECT header.) BULLET1.COM and
-BULLET2.COM are command procedures which when run, will create several
-small files. After you run them, you can delete them. If you have PMDF
-at your site, you should also run PMDF.COM. Otherwise, you can delete
-it. The same applies to MX. Then, read AAAREADME.TXT for BULLETN
-installation instructions.
-
-NOTE: When creating these files (using the EXTRACT command) from the VMS
-MAIL utility, you will have to strip off any mail headers that are
-present, including blank lines.
- MRL@NERUS.PFC.MIT.EDU
---------------------------------------------------------------------------
-Add REPLY option to READNEW feature when reading messages. Also, really fix
-the REPLY command, as mentioned in V2.06. 8/11/91
-
-V 2.06
-
-Added code to keep track of which messages have been read a per message basis.
-Added SEEN & UNSEEN commands. Added /SEEN, /UNSEEN, and /UNMARKED to
-DIRECTORY, INDEX, READ, and SELECT commands. Modified directory listing to
-indicate which messages have been SEEN. 7/31/91
-
-Added /NOW to PRINT command. Messages no longer have to be printed one message
-at a time. It now works identical to VMS MAIL. 7/31/91
-
-Added code to NEWS users when new groups have been created. User will be
-alerted when selecting a news group that new groups are present, and will be
-instructed to type NEWS/NEWGROUP in order to see them. 7/31/91
-
-Added /PRINT to DIRECTORY command to allow printing of messages which are found
-by using the DIRECTORY command. 7/31/91
-
-Modified directory listing display so that the first and last message in the
-folder are now displayed at the top. Fixed bug which truncated very large news
-group names. 7/31/91
-
-Added FIRST command to read first message found in folder. 7/31/91
-
-Modified REPLY command for folders associated with mailing lists, so that the
-reply message to the mailing list rather than adding a local message. 7/31/91
-
-Modified code to correctly store subject headers from BBOARD mail which are
-more than one line long. Previously, the subject would be truncated. 6/18/91
-
-V 2.05
-
-The MARK code was modified to work with NEWS folders. 6/3/91
-
-Added /FOLDER=(folder,[...]) to the SEARCH command to allow searching more than
-one folder at a time. 6/13/91
-
-NEWS/SUBSCRIBED listing was fixed. If the list could not fit on a single page,
-a folder was skipped when the next page was shown. 6/3/91
-
-INDEX was fixed. If it was used with the qualifiers /NEW or /MARK, and the
-directory listing of a folder was displayed, and then RETURN is entered to
-skip to the next folder, the directory display of the next folder would be
-incorrect. 6/3/91
-
-Fixed broadcast bug. If a message was added with /BROADCAST to a remote folder
-from a node in a cluster which was not the node that BULLCP was running on.
-The broadcast would appear twice on the cluster. 5/24/91
-
-Added code to alert user if message too large to be fully broadcasted. 5/24/91
-
-Added code to avoid erroneous notifications of new messages for an empty NEWS
-group. Unlike a similar fix in V2.03 which was due to a bug, this fix may not
-affect all sites, as it depends on the behavior of the server. 5/22/91
-
-Fixed NEWS to FOLDER feed. A recent change broke it. 5/22/91
-
-Added /EDIT qualifier for MAIL. 5/20/91
-
-Added /HEADER qualifier for LAST, BACK, and CURRENT commands. 5/19/91
-
-Added TWG (Wollongong) interface for NEWS. 5/18/91
-
-Fixed bug which truncated subject headers of messages created when using REPLY
-and RESPOND to messages which have long subject lines. 5/12/91
-
-V2.04
-
-Added ALWAYS attribute for folders. Any SYSTEM messages in a folder in which
-ALWAYS has been set will be displayed every time a user logs in, rather than
-just once. Also, non-SYSTEM messages will be displayed continuously (via
-whatever mode is set, i.e. READNEW, SHOWNEW, or BRIEF) until it is actually
-read. 4/29/91
-
-Added capability of controlling the time between updates for BBOARD and NEWS in
-BULLCP by defining the logical names BULL_BBOARD_UPDATE or BULL_NEWS_UPDATE to
-the number of minutes of desired time in minutes. 4/27/91
-
-Added /GROUPS= qualifier to all commands which post to NEWS groups. 4/26/91
-
-Fixed bug which prevented SET SHOWNEW or READNEW from working with subscribed
-news group folders. 4/25/91
-
-V2.03
-
-Added /FOLDER to SHOW USER in order to show the latest message that a user
-has read in the specified folder. Also added /SINCE and /START (the former
-for real folders, the latter for news groups). 4/11/91
-
-Fixed logic so that defining BULL_NEWS_ORGANIZATION will override the
-definition defined in BULLNEWS.INC. 4/10/91
-
-Fixed SEARCH command, as it broke in V2.02 when /EDIT was added to read
-message commands. There is a missing QUALIFIER EDIT in BULLCOM.CLD for the
-SEARCH verb. /EDIT now works with SEARCH. 4/9/91
-
-Fixed bug in BULLCP which prevented the DECNET/INTERNET NEWS gateway software
-from working with UCX. 4/9/91
-
-Fixed bug caused by V2.00 which caused incorrect listing of message during
-BULL/LOGIN for remote folders. 4/3/91
-
-Fixed bugs which caused erroneous new message notifications for subscribed
-NEWS groups that were empty. 3/27/91
-
-V 2.02
-
-Include BBOARD support for MX (courtesy of goathunter@wkuvx1.bitnet).
-
-Changed BBOARD algorithm so that it is now possible to have only one real
-BBOARD account, and have all the others be VMS MAIL forwarding entries.
-See HELP SET BBOARD MORE_INFO for more info (it's been updated).
-
-Added hook to allow postings from BULLETIN to a LISTSERV mailing list to use
-the BBOARD account from it was subscribed to. See HELP SET BBOARD LISTSERV.
-
-Fixed many bugs in POST, REPLY, and RESPOND.
-
-Fixed /ALL for COPY, PRINT, and EXTRACT when using NEWS groups.
-
-Included RMS optimizer procedure for indexed files to optimize BULLNEWS.DAT
-to speed up NEWS updates. Can be used on other files (in particular
-BULLINF.DAT) in order to save space.
-
-Add /EDIT to BACK, NEXT, LAST, and when entering message number.
-
-Modify ADD/REPLY command to local (non-NEWS) folders so if there are new
-messages present, it doesn't reset the newest message count. Previously,
-adding a message would reset the user's last read message date to that message
-in order to avoid notifying the user of new messages due to the user's own
-message.
-
-Fixed code so that when reading new messages, and if READ/EDIT or DELETE/IMMED-
-IATE IS entered, a carriage return will read the next new message. Previously
-the wrong message would be displayed.
-
-V 2.01
-
-Fixed many bugs associated with USENET NEWS reading feature.
-
-Added UCX interface for NEWS.
-
-Added signature file for POST and RESPOND messages.
-
-Added capability to specify file name for POST, REPLY, and RESPOND.
-
-Added the line "In a previous message, <message-owner> wrote:" to the
-beginning of a message when /EXTRACT is specified
-
-Added hook for network mail to run command procedure rather then using
-VMS MAIL. BULL_MAILER can be defined to point to the procedure, and it
-is called with the username and subject as the parameters.
-
-V 2.00
-
-Added USENET NEWS reading feature.
-
-V 1.93
-
-Fixed bug which wouldn't allow a permanent message to be added by a
-non-privileged user in a remote folder (the folder had been setup to allow
-permanent messages from non-privileged users, of course).
-
-Fixed bug which causes the DELETE command not to delete a SHUTDOWN message
-without the use of /IMMEDIATE.
-
-Fixed the algorithm which prevented duplicate notification of messages in
-remote folders on different nodes, as duplication was still possible.
-
-V 1.92
-
-Fixed bug which causes BULLCP to loop when trying to cleanup a folder which
-has more than 127 identifiers granted access to a folder. Also correct
-SHOW FOLDER/FULL, which had a similar problem when trying to display the
-identifiers.
-
-Fix PMDF interface to recognize to recognize PMDF_PROTOCOL.
-
-V 1.91
-
-Disallow SPAWN command for CAPTIVE account.
-
-Fix MAIL command to correctly allow passing addresses with quotes, i.e.
-IN%"""MRL@NERUS.PFC.MIT.EDU""".
-
-V 1.90
-
-SET NOTIFY now works for remote folders.
-
-Avoid generating notification message due to SET NOTIFY flag if the message
-was broadcasted when added using ADD/BROADCAST.
-
-Bug in DIR/SINCE for remote folders fixed. If no new messages were present,
-it would incorrectly show messages.
-
-Added /FF to EXTRACT command to seperate messages in the file with form feeds.
-
-Allow specifying CURRENT and LAST when specifying a range of messages for
-commands that accept a range, i.e. EXTRACT 1-CURRENT, CURRENT-LAST, etc.
-
-Open folder files with READONLY when not writing to them in order to avoid
-changing modification date, which results in unnecessary backups.
-
-Modify HELP so that it won't prompt for Subtopic is there is none.
-
-Prevent screen from being erased after exiting HELP.
-
-Fix bug which causes CREATE/NOTIFY to crash.
-
-SET NOTIFY/CLUSTER has been removed. As of VMS V5.2, it is possible to obtain
-the list of users logged in to all nodes of a cluster, so this qualifier is no
-long necessary. NOTE: You can delete all the BULL_DIR:*.NOTIFY files, as they
-are no longer used.
-
-BULLETIN now will use the editor specified by the SET EDITOR command within
-MAIL for editing messages.
-
-Typing BACK after typing a DIRECTORY command will now show the previous
-DIRECTORY display entries rather than reading the previous message.
-
-Several bugs related to the MARK command were fixed. Also the software has been
-optimized so that scanning for MARKed messages should take less time.
-
-/EXPIRATION added to DIRECTORY command to show expiration rather than creation
-date of messages.
-
-Any BULLETIN interactive command can be executed at DCL level by typing
-BULLETIN "command" or BULLETIN "command1;command2;etc.".
-
-The CHANGE command has been modified so a range of message can be specified,
-i.e. /NUMBER=1-10. Also, the code incorrectly misinterpreted /TEXT as meaning
-to extract the old text message, whereas it should have meant that only the
-text was to be changed. This prevented a user from specifying that only the
-text should be changed if that user didn't have editing enabled. This has been
-fixed. To eliminate confusing, the /TEXT qualifier on the ADD command has been
-removed (previously it was a synonym for /EXTRACT).
-
-SHOW FOLDER/FULL display of access IDs was fixed to correctly display UICs.
-
-Removed security hole which occurs if you are using the old method of accessing
-a remote node via /NODES (it would have required looking a the sources to find,
-which one installer did and was worried about). Because of this, if you use
-this old method (i.e. via BULLETIN.COM), the object BULLETIN must be installed
-in the NCP database pointing to the file BULLETIN.COM, i.e. the command
-"MCR NCP SET BULLETIN FILE directory:BULLETIN.COM NUMBER 0" must be executed
-during the system startup.
-
-Fixed bug in /LOGIN display when erasing page if terminal is hardcopy. No
-page would be erased (of course), and the next line outputted would start where
-the previous line left off, rather than starting on a new line.
-
-Added BULLETIN/WIDTH=page_width for users who have BULLETIN/LOGIN in their
-login procedure before the terminal is known, and whose default page width is
-larger (i.e. 132) than what the terminals are (i.e. 80).
-
-Added BULLETIN/PGFLQUOTA and /WSEXTENT in order to set those quotas for the
-BULLCP process.
-
-Added ATTACH command.
-
-Modify SET STRIP so that it saves the date that the message was sent and
-leaves it at the to of the message.
-
-BULLETIN will search BBOARD message headers for a line that starts with
-"Expires:" or "X-Expires:", followed by a date (DD MMM YYYY or similar). It if
-finds that line, it will use that date as the expiration date of the message.
-
-Added /REPLY to SEARCH command. Modified so that it's possible to abort out of
-a /SUBJECT or /REPLY search using CTRL-C (previous possible only if searching
-the text for a string. Also, if you hit CTRL-C at the wrong time, BULLETIN
-would abort totally rather than just aborting the search).
-
-Added /SEARCH= /SUBJ= and /REPLY to the DIRECTORY command. Basically this is
-combining the DIRECTORY and SEARCH commands.
-
-Fixed design flaw which allowed the following to occur: If a folder is a
-remote system folder, when BULLETIN/LOGIN was executed, the same messages might
-be displayed on both the local and remote nodes. BULLETIN now will know that
-the user has seen the message on one node and will not display it if that user
-logs in on the other node.
-
-Optimized code which caused slow display of new messages when executing
-BULLETIN/LOGIN without /REVERSE for a remote folder.
-
-Added /PERMANENT to SET NOTIFY, SHOWNEW, BRIEF, and READNEW. The affect is
-that users will not be allowed to change the setting. The main intent here
-was to allow the removal ofthe permanent setting of SHOWNEW from the GENERAL
-folder.
-
-Fixed bug which would cause a SYSTEM message not to be shown if SET BRIEF was
-selected for that folder, and a non-SYSTEM message was also present.
-
-Added SET CONTINUOUS_BRIEF. This causes the SET BRIEF setting to show that
-there are unread new messages every time BULLETIN/LOGIN is executed, rather
-than just the one time. The BRIEF notification code has also been optimized
-so that it'll take less time to notify you of new messages.
-
-A major bug was fixed which was introduced in previous mods to speed up
-BULLETIN/LOGIN. The effect is that no notifications will appear for certain
-folders via BULLETIN/LOGIN. This would only happen if a folder was removed at
-some time.
diff --git a/decus/vax91b/bulletin-net91b/bullcoms1.hlp b/decus/vax91b/bulletin-net91b/bullcoms1.hlp
deleted file mode 100644
index 8b8bd34541b7e70113beb038df36f5a41c2b8157..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bullcoms1.hlp
+++ /dev/null
@@ -1,906 +0,0 @@
-1 ADD
-Adds a message to the specified folder. A file can be specified which
-contains the message. Otherwise, BULLETIN will prompt for the text.
-BULLETIN will ask for an expiration date and a header to contain the
-topic of the message.
-
- Format:
- ADD [file-name]
-2 /ALL
-This option is restricted to privileged users. It is used in conjunction
-with the /BROADCAST qualifier. If specified, all terminals are sent the
-message. Otherwise, only users are sent the message.
-2 /BELL
-This option is restricted to privileged users. It is used in conjunction
-with the /BROADCAST qualifier. If specified, the bell is rung on the
-terminals when the message is broadcasted.
-2 /BROADCAST
-This option is restricted to privileged users and SYSTEM folders. If
-specified, a message is both stored and broadcasted to all users logged
-in at the time. If the folder is remote, a message will be broadcast on
-all nodes which are connected to that folder, unless /LOCAL is specified.
-A node which does not have BULLCP running cannot have a message
-broadcasted to it, (even though it is able to create a remote folder).
-
-See also /ALL and /BELL.
-2 /CLUSTER
- /[NO]CLUSTER
-
-This option specifies that broadcasted messages should be sent to all
-nodes in the cluster. /CLUSTER is the default.
-2 /EDIT
- /[NO]EDIT
-Determines whether or not the editor is invoked to edit the message
-you are adding. /EDIT is the default if you have added /EDIT to your
-BULLETIN command line.
-2 /EXPIRATION
- /EXPIRATION=time
-
-Specifies the time at which the message is to expire. Either absolute
-time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be
-used.
-2 /EXTRACT
-Specifies that the text of the previously read message should be included
-at the beginning of the new message. The previous message must be in the
-same folder. This qualifier is valid only when used with /EDIT. The
-text is indented with > at the beginning of each line. This can be
-suppressed with /NOINDENT.
-2 /FOLDER
- /FOLDER=(foldername,[...])
-
-Specifies the foldername into which the message is to be added. Does
-not change the current selected folder. Folders can be either local or
-remote folders. Thus, a nodename can precede the foldername (this
-assumes that the remote node is capable of supporting this feature, i.e.
-the BULLCP process is running on that node. If it is not, you will
-receive an error message). If the the foldername is specified with only
-a nodename, i.e. FOO::, the foldername is assumed to be GENERAL. NOTE:
-Specifying remote nodes is only possible if that remote node is running
-a special BULLCP process. If it isn't, the only way to add messages to
-that remote node is via the /NODE command. However, /FOLDER is a much
-quicker method, and much more versatile.
-
-You can specify logical names which translate to one or more folder
-names. I.e. $ DEFINE ALL_FOLDERS "VAX1,VAX2,VAX3", and then specify
-ALL_FOLDERS after /FOLDER=. Note that the quotation marks are required.
-
-When using /FOLDER for remote nodes, proxy logins are used to determine
-if privileged options are allowed. If they are not allowed, the message
-will still be added, but without the privileged settings.
-2 /LOCAL
-Specifies that when /BROADCAST is specified for a remote folder, the
-message is broadcasted ONLY on the local node.
-2 /NODES
- /NODES=(nodes[,...])
-
-Specifies to send the message to the listed DECNET nodes. The BULLETIN
-utility must be installed properly on the other nodes. (See
-installation notes). You can specify a different username to use at the
-other nodes by either using the USERNAME qualifier, or by specifying the
-nodename with 2 semi-colons followed by the username, i.e.
-nodename::username. If you specify a username, you will be prompted for
-the password of the account on the other nodes.
-
-Additionally, you can specify logical names which translate to one or
-more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then
-specify /NODES=ALL_NODES. Note that the quotation marks are required.
-
-NOTE: It is preferable to use /FOLDER instead of /NODE if possible,
-since adding messages via /FOLDER is much quicker.
-2 /NOINDENT
-See /EXTRACT for information on this qualifier.
-2 /PERMANENT
-If specified, message will be a permanent message and will never expire.
-If an expiration limit is set, then permament is not allowed unless
-user has privileges.
-2 /SUBJECT
- /SUBJECT=description
-
-Specifies the subject of the message to be added.
-2 /SHUTDOWN
- /SHUTDOWN[=nodename]
-This option is restricted to privileged users. If specified, message
-will be automatically deleted after a computer shutdown has occurred.
-This option is restricted to SYSTEM folders.
-
-If the bulletin files are shared between cluster nodes, the message
-will be deleted after the node on which the message was submitted from
-is rebooted. If you wish the message to be deleted after a different
-node reboots, you have the option of specifying that node name.
-
-NOTE: If the folder is a remote folder, the message will be deleted
-after the remote node reboots, not the node from which the message was
-added. The nodename cannot be specified with a remote folder.
-2 /SYSTEM
-This option is restricted to privileged users. If specified, message
-is both saved in the folder and displayed in full as a system message
-when a user logs in. System messages should be as brief as possible to
-avoid the possibility that system messages could scroll off the screen.
-This option is restricted to SYSTEM folders.
-2 /USERNAME
-Specifies username to be used at remote DECNET nodes when adding messages
-to DECNET nodes via the /NODE qualifier.
-1 ATTACH
-Permits you to switch control of your terminal from your current
-process to another process in your job.
-
-The ATTACH command allows you to move quickly between processes that
-you have created with the SPAWN command. For example, while you are
-editing a file, you can SPAWN a subprocess to read a new message.
-Enter the ATTACH command to get back to back to the editing session.
-If you want to read another new message, you can use the ATTACH command
-to get back to the BULLETN subprocess you already created.
-
- Format:
-
- ATTACH [/PARENT] [process-name]
-2 Parameters
-
- process-name
-
- Indicates the name of the subprocess to which the connection is to
- be made. Only the /PARENT qualifier or a process-name may be specified.
-
-2 Qualifiers
-
-/PARENT
-
- Allows you to attach to your process' parent process.
- If there is no parent process an error message is printed.
-
-
-2 Examples
-
- 1.
- $ SPAWN BULLETIN
- %DCL-S-SPAWNED, process MAGNANI_3 spawned
- %DCL-S-ATTACHED, terminal now attached to process MAGNANI_3
- BULLETIN> ATTACH MAGNANI_2
- %DCL-S-RETURNED, control returned to process MAGNANI_2
- $ ATTACH MAGNANI_3
- BULLETIN>
-
-
- This example shows how to spawn subprocesses (MAGNANI_2 and
- MAGNANI_3) to move from BULLETIN to DCL back to BULLETIN. The ATTACH
- command allows you to transfer control between subprocesses.
-
-
- NOTE
-
- You always SPAWN a new process and ATTACH to a process that
- already exists.
-1 BACK
-Displays the message preceding the current message.
-2 /EDIT
-Specifies that the editor is to be used to read the message. This is
-useful for scanning a long message.
-2 /HEADER
- /[NO]HEADER
-
-Specifies that if a message header exists, the header will be shown.
-If /HEADER or /NOHEADER is specified, the setting will apply for all
-further reads in the selected folder. The default is /HEADER for non-
-NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command
-is set for the folder, it will change the default to be /HEADER.
-1 BULLETIN
-The BULLETIN utility permits a user to create a message for reading by
-all users. Users are notified upon logging in that new messages have
-been added, and what the topic of the messages are. Actual reading of
-the messages is optional. (See the command SET READNEW for info on
-automatic reading.) Messages are automatically deleted when their
-expiration date has passed.
-1 CHANGE
-Replaces or modifies existing stored message. This is for changing part
-or all of a message without causing users who have already seen the
-message to be notified of it a second time. You can select qualifiers so
-that either the message text, expiration date, or the header are to be
-changed. If no qualifier is added, the default is that all these parameters
-are to be changed. If the text of the message is to be changed, a file can
-be specified which contains the text. If the editor is used for changing
-the text, the old message text will be extracted. This can be suppressed
-by the qualifier /NEW.
-
- Format:
- CHANGE [file-name]
-2 /ALL
-Makes the changes to all the messages in the folder. Only the expiration
-date and message headers can be changed if this qualifier is specified.
-2 /EDIT
- /[NO]EDIT
-Determines whether or not the editor is invoked to edit the message
-you are replacing. The old message text is read into the editor unless
-a file-name or /NEW is specified. /EDIT is the default if you have
-added /EDIT to your BULLETIN command line.
-2 /EXPIRATION
- /EXPIRATION[=time]
-
-Specifies the time at which the message is to expire. Either absolute
-time: [dd-mmm-yyyy] hh:mm:ss, or delta time: dddd [hh:mm:ss] can be
-used. If no time is specified, you will be prompted for the time.
-2 /GENERAL
-Specifies that the message is to be converted from a SYSTEM message to
-a GENERAL message. This only applies to the GENERAL folder.
-2 /HEADER
-Specifies that the message header is to be replaced. You will be
-prompted for the new message description.
-2 /NEW
-If the editor is to be used for replacing the text of the message,
-NEW specifies not to read in the old message text, and that a totally
-new text is to be read in.
-2 /NUMBER
- /NUMBER=message_number[-message_number1]
-
-Specifies the message or messages to be replaced. If this qualifier is
-omitted, the message that is presently being read will be replaced.
-A range of messages can be specified, i.e. /NUMBER=1-5. Only the expiration
-date and message headers can be changed if a range is specified.
-
-The key words CURRENT and LAST can also be specified in the range,
-in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc.
-2 /PERMANENT
-Specifies that the message is to be made permanent.
-2 /SHUTDOWN[=nodename]
-Specifies that the message is to expire after the next computer
-shutdown. This option is restricted to SYSTEM folders.
-2 /SUBJECT
- /SUBJECT=description
-
-Specifies the subject of the message to be added.
-2 /SYSTEM
-Specifies that the message is to be made a SYSTEM message. This is a
-privileged command and is restricted to SYSTEM folders.
-2 /TEXT
-Specifies that the message text is to be replaced.
-1 COPY
-Copies a message to another folder without deleting it from the
-current folder.
-
- Format:
-
- COPY folder-name [message_number][-message_number1]
-
-The folder-name is the name of the folder to which the message is to be
-copied to. Optionally, a range of messages which are to be copied can be
-specified following the folder name, i.e. COPY NEWFOLDER 2-5.
-
-The key words CURRENT and LAST can also be specified in the range,
-in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc.
-2 /ALL
-Specifies to copy all the messages in the old folder.
-2 /GROUPS
- /GROUPS=(newsgroup,[...])
-
-Valid only if a NEWS group is selected. Specifies to send the message to
-the specified NEWS group(s) in addition to the selected NEWS group.
-2 /HEADER
- /[NO]HEADER
-
-Valid only if destination folder is a news group. Specifies that header
-of message is to be included with the text when the text is copied.
-The default is /NOHEADER.
-2 /MERGE
-Specifies that the original date and time of the copied messages are
-saved and that the messages are placed in correct chronological order
-in the new folder. This operation is lengthy if the new folder is large.
-2 /ORIGINAL
-Specifies that the owner of the copied message will be the original owner
-of the message. The default is that the copied message will be owned by
-the person copying the message.
-1 CREATE
-Creates a folder of messages. This is similar to the folders in the VMS
-MAIL utility. Folders are often created so that messages of a similar
-topic are grouped separately, or to restrict reading of certain messages
-to specified users. Once created, that message is automatically
-selected (see information on SELECT command). The commands that can be
-used to modify the folder's characteristics are: MODIFY, REMOVE, SET
-ACCESS, SET BBOARD, SET NODE, and SET SYSTEM.
-
- Format:
- CREATE folder-name
-
-The folder-name is limited to 25 letters and must not include spaces or
-characters that are also invalid in filenames (this is because the
-folder is stored in a file name created with the folder name).
-
-NOTE: Creation of folders may be a restricted command if the installer
-has elected to install it as such. This is done by modifying
-BULLCOM.CLD.
-2 /ALWAYS
-Specifies that the folder has the ALWAYS attribute. This causes
-messages in the folder to be displayed differently when logging in.
-SYSTEM messages will be displayed every time a user logs in, rather than
-just once. Non-SYSTEM message will also be displayed every time (in
-whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until the
-user actually reads that message (or a later one). This feature is
-meant for messages which are very important, and thus you want to make
-sure they are read.
-2 /BRIEF
-Specifies that all users automatically have BRIEF set for this folder.
-Only a privileged user can use this qualifier. (See HELP SET BRIEF for
-more information.)
-2 /DESCRIPTION
- /DESCRIPTION=description
-
-Specifies the description of the folder, which is displayed using the
-SHOW FOLDER command. If omitted, you are prompted for a description.
-
-If this folder is to receive messages from a network mailing list
-via the BBOARD feature, and you wish to use the POST and RESPOND/LIST
-commands, the address of the mailing list should be included in the
-description. This is done by enclosing the address using <> and
-placing it at the end of the description, i.e.
-
- INFOVAX MAILING LIST <INFO-VAX@KL.SRI.COM>
-
-If a mailer protocol is needs to be added to the network address in
-order for it to be sent by VMS MAIL, i.e. protocol%"address", the
-appropriate protocol can be specified by either hardcoding it into the
-file BULLNEWS.INC before compiling BULLETIN, or by defining the system
-logical name BULL_NEWS_MAILER (it is the same protocol used by the NEWS
-feature in order to respond to NEWS messages). The default protocol is
-IN%. If desired, you can specify the protocol with the address, i.e.
-
- INFOVAX MAILING LIST <IN%"INFO-VAX@KL.SRI.COM">
-2 /ID
-Designates that the name specified as the owner name is a rights
-identifier. The creator's process must have the identifier presently
-assigned to it. Any process which has that identifier assigned to it
-will be able to control the folder as if it were the folder's owner.
-This is used to allow more than one use to control a folder.
-
-Note: This feature will not work during remote access to the folder.
-2 /NODE
- /NODE=node
-
-Specifies that the folder is a remote folder at the specified node.
-A remote folder is a folder in which the messages are actually stored
-on a folder at a remote DECNET node. The specified node is checked to
-see if a folder of the same name is located on that node. If so, the
-folder will then be modified to point to that folder. For example if
-there was a folder on node A with name INFO, and you issued the command:
- CREATE INFO/NODE=A
-from node B, then if INFO is selected on node B, you will actually
-obtain the folder INFO on node A. In this manner, a folder can be shared
-between more than one node. This capability is only present if the BULLCP
-process is running on the remote node via the BULL/STARTUP command.
-If the remote folder name is different from the local folder name, the
-remote folder name is specified using the /REMOTENAME qualifier.
-
-NOTE: If a message is added to a remote node, the message is stored
-immediately. However, a user logging into another node might not be
-immediately alerted that the message is present. That information is
-only updated every 15 minutes (same algorithm for updating BBOARD
-messages), or if a user accesses that folder. Thus, if the folder is
-located on node A, and the message is added from node B, and a user logs
-in to node C, the BULLETIN login notification might not notify the user
-of the message. However, if the message is added with /BROADCAST, the
-message will be broadcasted immediately to all nodes.
-2 /NOTIFY
-Specifies that all users automatically have NOTIFY set for this folder.
-Only a privileged user can use this qualifier. (See HELP SET NOTIFY for
-more information.)
-2 /OWNER
- /OWNER=username
-Specifies the owner of the folder. This is a privileged command.
-See also /ID.
-2 /PRIVATE
-Specifies that the folder can only be accessed by users who have been
-granted access via the SET ACCESS command. Note: This option uses ACLs
-and users who are granted access must be entered into the Rights Data Base.
-If the RDB does not exist on your system, a privileged user will have to
-create it. If a user is not in the RDB, this program will automatically
-enter the user into it (unless this feature was disabled during the
-compilation of this program). NOTE: See HELP SET ACCESS for more info.
-2 /READNEW
-Specifies that all users automatically have READNEW set for this folder.
-Only a privileged user can use this qualifier. (See HELP SET READNEW for
-more information.)
-2 /REMOTENAME
- /REMOTENAME=foldername
-Valid only if /NODE is present, i.e. that the folder is a remote folder.
-Specifies the name of the remote folder name. If not specified, it is
-assumed that the remote name is the same as the local name.
-2 /SHOWNEW
-Specifies that all users automatically have SHOWNEW set for this folder.
-Only a privileged user can use this qualifier. (See HELP SET SHOWNEW for
-more information.)
-2 /SEMIPRIVATE
-Similar to /PRIVATE, except that the folder is restricted only with
-respect to adding or modifying messages. All users can read the folder.
-2 /SYSTEM
-Specifies that the folder is a SYSTEM folder. A SYSTEM folder is
-allowed to have SYSTEM and SHUTDOWN messages added to it. By default,
-the GENERAL folder is a SYSTEM folder. This is a privileged command.
-
-If this is a remote folder, /SYSTEM cannot be specified unless the
-folder at the other node is also a SYSTEM folder.
-1 Ctrl-C
-Except for when BULLETIN is awaiting input from the terminal, a
-CTRL-C will cause BULLETIN to abort the execution of any command. If
-BULLETIN is waiting for terminal input, a CTRL-C will cause BULLETIN
-to return to the BULLETIN> prompt. If for some reason the user wishes
-to suspend BULLETIN, CTRL-Y will usually do so. However, this is not
-always true, as BULLETIN will ignore the CTRL-Y if it has a data file
-opened at the time. (Otherwise it would be possible to put the files
-in a state such that they would be inaccessible by other users.)
-1 CURRENT
-Displays the beginning of the message you are currently reading. If
-you are reading a long message and want to display the first part
-of the message again, you can enter the CURRENT command.
-
- Format:
-
- CURRENT
-2 /EDIT
-Specifies that the editor is to be used to read the message. This is
-useful for scanning a long message.
-2 /HEADER
- /[NO]HEADER
-
-Specifies that if a message header exists, the header will be shown.
-If /HEADER or /NOHEADER is specified, the setting will apply for all
-further reads in the selected folder. The default is /HEADER for non-
-NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command
-is set for the folder, it will change the default to be /HEADER.
-1 DELETE
-Deletes the specified message. If no message is specified, the current
-message is deleted. Only the original owner or a privileged user can
-delete a message. Note that the message is not deleted immediately, but
-its expiration is set 15 minutes in the future. This is to allow a user
-to recover the message using the UNDELETE command. If you want the
-message deleted immediately, use the /IMMEDIATE qualifier.
-
- Format:
- DELETE [message_number][-message_number1]
-
-The message's relative number is found by the DIRECTORY command. It is
-possible to delete a range of messages by specifying two numbers
-separated by a dash, i.e. DELETE 1-5. However, a range cannot be
-specified if the folder is remote.
-
-The key words CURRENT and LAST can also be specified in the range,
-in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc.
-2 /ALL
-Specifies to delete all the messages in the folder. Note: This will
-not work for remote folders. Only one message can be deleted from a
-remote folder at a time.
-2 /IMMEDIATE
-Specifies that the message is to be deleted immediately.
-2 /NODES
- /NODES=(nodes[,...])
-
-Specifies to delete the message at the listed DECNET nodes. The BULLETIN
-utility must be installed properly on the other nodes. You can specify
-a different username to use at the other nodes by either using the
-USERNAME qualifier, or by specifying the nodename with 2 semi-colons
-followed by the username, i.e. nodename::username. If you specify a
-username, you will be prompted for the password of the account on the
-other nodes. The /SUBJECT must be specified to identify the specific
-message that is to be deleted.
-
-Additionally, you can specify logical names which translate to one or
-more node names. I.e. $ DEFINE ALL_NODES "VAX1,VAX2,VAX3", and then
-specify /NODES=ALL_NODES. Note that the quotation marks are required.
-2 /SUBJECT
- /SUBJECT=subject
-
-Specifies the subject of the bulletin to be deleted at a remote DECNET
-node. The DECNET node must be specified with the /NODE qualifier.
-The specified subject need not be the exact subject of the message.
-It can be a substring of the subject. This is in case you have forgotten
-the exact subject that was specified. Case is not critical either.
-You will be notified if the deletion was successful.
-2 /USERNAME
-Specifies username to be used at remote DECNET nodes when deleting messages
-on other DECNET nodes via the /NODE qualifier.
-1 DIRECTORY
-Lists a summary of the messages. The message number, submitter's name,
-date, and subject of each message is displayed.
-
- Format:
-
- DIRECTORY [folder]
-
-If a folder is specified, that folder is selected before the directory
-is listed. Unless otherwise specified, listing starts with the first
-newest message. If there are no new messages, listing will start at the
-first message, or if a message has already been read, it will start at
-that message.
-2 /ALL
-Lists all messages. Used if the qualifiers /MARKED, /UNMARKED, /SEEN,
-or /UNSEEN were previously specified.
-2 /DESCRIBE
-Valid when used with /FOLDERS. Specifies to include description of
-folder.
-2 /EXPIRATION
-Shows the message's expiration date rather than the creation date.
-2 /END
- /END=message_number
-
-Indicates the last message number you want to display.
-2 /FOLDERS
-Lists the available message folders. Shows last message date and number
-of messages in folder. An asterisk (*) next to foldername indicates
-that there are unread messages in that folder. This will not show
-newsgroups. To see newsgroups, use the NEWS command or DIR/NEWS.
-2 /MARKED
-Lists messages that have been marked (indicated by an asterisk).
-This is equivalent to selecting the folder with /MARKED, i.e. only
-marked messages will be shown and be able to be read. To see all
-messages, use either /ALL, or reselect the folder.
-2 /UNMARKED
-Lists messages that have not been marked (marked messages are indicated
-by an asterisk). Using /UNMARKED is equivalent to selecting the folder
-with /UNMARKED, i.e. only unmarked messages will be shown and be able
-to be read. To see all messages, use either /ALL, or reselect the
-folder.
-2 /SEEN
-Lists messages that have been seen (indicated by a greater than sign).
-Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only
-seen messages will be shown and be able to be read. To see all
-messages, use either /ALL, or reselect the folder.
-2 /UNSEEN
-Lists messages that have not been seen (seen message are indicated by a
-greater than sign). Using /UNSEEN is equivalent to selecting the folder
-with /UNSEEN, i.e. only unseen messages will be shown and be able to be
-read. To see all messages, use either /ALL, or reselect the folder.
-2 /NEW
-Specifies to start the listing of messages with the first unread
-message.
-2 /NEWS
-Lists the available news groups. This does the same thing as the NEWS
-command. See that command for qualifiers which apply.
-2 /PRINT
-Specifies that the text of the messages which are found by the
-DIRECTORY command are to be printed. All qualifiers which are valid
-for the PRINT command are valid in conjunction with /PRINT. The list
-of messages to be printed will be displayed on the terminal (in
-nopaging format).
-2 /REPLY
-Specifies that only messages which are replies to the current message
-are to be displayed. This cannot be used in conjunction with /MARKED.
-2 /SEARCH
- /SEARCH=[string]
-
-Specifies that only messages which contain the specified string are
-to be displayed. This cannot be used in conjunction with /MARKED.
-If no string is specified, the previously specified string is used.
-2 /SINCE
- /SINCE=date
-
-Displays a listing of all the messages created on or after the
-specified date. If no date is specified, the default is TODAY.
-2 /START
- /START=message_number
-
-Indicates the first message number you want to display. For example,
-to display all the messages beginning with number three, enter the
-command line DIRECTORY/START=3. Not valid with /FOLDER.
-2 /SUBJECT
- /SUBJECT=[string]
-
-Specifies that only messages which contain the specified string in it's
-subject header are to be displayed. This cannot be used in conjunction
-with /MARKED. If no string is specified, the previously specified string
-is used.
-1 EXIT
-Exits the BULLETIN program.
-1 EXTRACT
-Synonym for FILE command.
-1 FILE
-Copies the current message to the named file. The file-name parameter
-is required. If the file exists, the message is appended to the file,
-unless the /NEW qualifier is specified.
-
- Format:
- FILE filename [message_number][-message_number1]
-
-A range of messages to be copied can optionally be specified, i.e.
-FILE 2-5.
-
-The key words CURRENT and LAST can also be specified in the range,
-in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc.
-2 /ALL
-Copies all the messages in the current folder.
-2 /FF
-Specifies that a form feed is placed between messages in the file.
-2 /HEADER
- /[NO]HEADER
-
-Controls whether a header containing the owner, subject, and date of the
-message is written in the file. The default is to write the header.
-2 /NEW
-
-Specifies that a new file is to be created. Otherwise, if the specified
-file exists, the file would be appended to that file.
-1 FIRST
-Specifies that the first message in the folder is to be read.
-1 FORWARD
-Synonym for MAIL command.
-1 Folders
-All messages are divided into separate folders. The default folder is
-GENERAL. New folders can be created by any user. As an example, the
-following creates a folder for GAMES related messages:
-
-BULLETIN> CREATE GAMES
-Enter a one line description of folder.
-GAMES
-
-To see the list of available folders, use DIRECTORY/FOLDERS. To select
-a specific folder, use the SELECT command.
-
-If a user selects a folder and enters the SET READNEW command, that
-user will be alerted of topics of new messages at login time, and will
-then be given the option of reading them. Similar to READNEW is SHOWNEW,
-which displays the topics but doesn't prompt to read them. Even less is
-SET BRIEF, which will cause only a one line output indicating that there
-are new messages in the folder. There also is the SET NOTIFY option,
-which will cause a message to be broadcast to a user's terminal alerting
-the user that a new message has been added. Any of these options can be
-the default for the folder by using the /DEFAULT switch on the command.
-
-A folder can be restricted to only certain users, if desired. This is
-done by specifying CREATE/PRIVATE. Afterwards, access to the folder is
-controlled by the creator by the SET [NO]ACCESS command. If /SEMIPRIVATE
-rather than /PRIVATE is specified, all users can read the messages in the
-folder, but only those give access can add messages.
-
-A folder can be converted into a remote folder using CREATE/NODE or SET
-NODE. A remote folder is one which points to a folder on a remote DECNET
-node. Messages added to a remote node are actually stored on the folder
-on the remote node. The BULLCP process (created by BULLETIN/STARTUP)
-must be running on the remote node for this option to be used.
-
-A folder can be specified as a SYSTEM folder, i.e. one in which SYSTEM/
-SHUTDOWN/BROADCAST messages can be added. By default, the GENERAL folder
-is a SYSTEM folder (and cannot be changed). One use for this is to create
-a remote SYSTEM folder which is shared by all nodes, so that the GENERAL
-folder is used for messages pertaining only to the local host, while the
-remote folder is used for messages pertaining to all nodes. Another
-use is to create a folder for posting SYSTEM messages only meant for a
-certain UIC group. This is done by creating a PRIVATE SYSTEM folder, and
-giving access to that UIC group. Only users in that UIC group will see
-the messages in that folder when they log in.
-1 HELP
-To obtain help on any topic, type:
-
- HELP topic
-1 INDEX
-Gives directory listing of all folders in alphabetical order. If the
-INDEX command is re-entered while the listing is in progress, the listing
-will skip to the next folder. This is useful for skipping a particular
-folder. It also can be used to continue the listing from where one left
-off after one has read a message.
-
- Format:
- INDEX
-2 /MARKED
-Lists messages that have been marked (marked messages are indicated by
-an asterisk). This is equivalent to selecting the folder with /MARKED,
-i.e. only marked messages will be shown and be able to be read.
-2 /UNMARKED
-Lists messages that have not been marked (marked messages are indicated
-by an asterisk). Using /UNMARKED is equivalent to selecting the folder
-with /UNMARKED, i.e. only unmarked messages will be shown and be able
-to be read.
-2 /SEEN
-Lists messages that have been seen (indicated by a greater than sign).
-Using /SEEN is equivalent to selecting the folder with /SEEN, i.e. only
-seen messages will be shown and be able to be read.
-2 /UNSEEN
-Lists messages that have not been seen (seen message are indicated by a
-greater than sign). Using /UNSEEN is equivalent to selecting the folder
-with /UNSEEN, i.e. only unseen messages will be shown and be able to be
-read.
-2 /NEW
-Specifies to start the listing of each folder with the first unread message.
-Otherwise, the listing will start with the first message in the folder.
-If the INDEX command is re-entered for continuing the listing, /NEW must
-be respecified.
-2 /RESTART
-If specified, causes the listing to be reinitialized and start from the
-first folder.
-2 /SUBSCRIBE
-If specified, lists only those news folders which have been subscribed to.
-1 KEYPAD
- +--------+--------+--------+--------+
- | PF1 | PF2 | PF3 | PF4 |
- | GOLD | HELP | EXTRACT|SHOW KEY|
- | |ST NOKEY| FILE |SH KY/PR|
- |--------|--------|--------|--------|
- | 7 | 8 | 9 | -- |
- | ADD | REPLY | MAIL |READ/NEW|
- | ADD/EDI|RP/ED/EX|M/NOHEAD|SHOW NEW|
- |--------|--------|--------|--------|
- | 4 | 5 | 6 | , |
- | CURRENT| RESPOND| LAST | DIR/NEW|
- |CURR/EDI|RS/ED/EX| | INDEX |
- |--------|--------|--------|--------|
- | 1 | 2 | 3 |ENTER |
- | BACK | PRINT | DIR | |
- | NEXT |P/NONOTI|DIR/FOLD| |
- |--------+--------|--------| ENTER |
- | 0 | . | SELECT |
- | SHOW FOLDER/FULL| DELETE | |
- | SHOW FLAGS | UNDELE | |
- +-----------------+--------+--------+
-1 LAST
-
-Displays the last message in the current folder.
-
- Format:
- LAST
-2 /EDIT
-Specifies that the editor is to be used to read the message. This is
-useful for scanning a long message.
-2 /HEADER
- /[NO]HEADER
-
-Specifies that if a message header exists, the header will be shown.
-If /HEADER or /NOHEADER is specified, the setting will apply for all
-further reads in the selected folder. The default is /HEADER for non-
-NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command
-is set for the folder, it will change the default to be /HEADER.
-1 MAIL
-Invokes the VAX/VMS Personal Mail Utility (MAIL) to send the message
-which you are reading to the specified recipients.
-
- Format:
-
- MAIL recipient-name[s]
-
-The input for the recipient name is exactly the same format as used by
-the MAIL command at DCL level. Note that this means when specifying an
-address that has quotes, in order to pass the quotes you must specify
-triple quotes. I.e. a network address of the form xxx%"address" must
-be specified as xxx%"""address""".
-2 /EDIT
-Specifies that the editor is to be used to edit the message before
-mailing it.
-2 /HEADER
- /[NO]HEADER
-
-Controls whether a header containing the owner, subject, and date of the
-message is written in the mail. The default is to write the header.
-2 /SUBJECT
- /SUBJECT=text
-
-Specifies the subject of the mail message. If the text consists of more
-than one word, enclose the text in quotation marks (").
-
-If you omit this qualifier, the description of the message will be used
-as the subject.
-1 MARK
-Sets the current or message-id message as marked. Marked messages are
-displayed with an asterisk in the left hand column of the directory
-listing. A marked message can serve as a reminder of important
-information. The UNMARK command sets the current or message-id message
-as unmarked.
-
- Format:
-
- MARK [message-number or numbers]
- UNMARK [message-number or numbers]
-
-NOTE: The list of marked messages for non-NEWS folders are stored in a
-file username.BULLMARK, and NEWS folders are stored in
-username.NEWSMARK. The files are created in the directory pointed to by
-the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN
-will be used.
-1 MODIFY
-Modifies the database information for the current folder. Only the
-owner of the folder or a user with privileges can use this command.
-
- Format:
-
- MODIFY
-2 /DESCRIPTION
-Specifies a new description for the folder. You will be prompted for
-the text of the description.
-
-NOTE: If this folder is to receive messages from a network mailing list
-via the BBOARD feature, and you wish to use the POST and RESPOND/LIST
-commands, the address of the mailing list should be included in the
-description. This is done by enclosing the address using <> and
-placing it at the end of the description, i.e.
-
- INFOVAX MAILING LIST <IN%"INFO-VAX@KL.SRI.COM">
-2 /ID
-Designates that the name specified as the owner name is a rights
-identifier. The creator's process must have the identifier presently
-assigned to it. Any process which has that identifier assigned to it
-will be able to control the folder as if it were the folder's owner.
-This is used to allow more than one use to control a folder.
-
-Note: This feature will not work during remote access to the folder.
-2 /NAME
- /NAME=foldername
-
-Specifies a new name for the folder.
-2 /OWNER
- /OWNER=username
-
-Specifies a new owner for the folder. If the owner does not have
-privileges, BULLETIN will prompt for the password of the new owner
-account in order to okay the modification. See also /ID.
-1 MOVE
-Moves a message to another folder and deletes it from the current
-folder.
-
- Format:
-
- MOVE folder-name [message_number][-message_number1]
-
-The folder-name is the name of the folder to which the message is to be
-be moved to. Optionally, a range of messages which are to be moved can be
-specified following the folder name, i.e. COPY NEWFOLDER 2-5. However,
-if the old folder is remote, they will be copied but not deleted, as
-only one message can be delted from a remote folder at a time.
-
-The key words CURRENT and LAST can also be specified in the range,
-in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc.
-2 /ALL
-Specifies to move all the messages from the old folder. Note: If the
-old folder is remote, they will be copied but not deleted, as only one
-message can be deleted from a remote folder at a time.
-2 /GROUPS
- /GROUPS=(newsgroup,[...])
-
-Valid only if a NEWS group is selected. Specifies to send the message to
-the specified NEWS group(s) in addition to the selected NEWS group.
-2 /HEADER
- /[NO]HEADER
-
-Valid only if destination folder is a news group. Specifies that header
-of message is to be included with the text when the text is copied.
-The default is /NOHEADER.
-2 /MERGE
-Specifies that the original date and time of the moved messages are
-saved and that the messages are placed in correct chronological order
-in the new folder. This operation is lengthy if the new folder is large.
-2 /ORIGINAL
-Specifies that the owner of the moved message will be the original owner
-of the message. The default is that the moved message will be owned by
-the person moving the message.
-1 NEWS
-Displays the list of available news groups.
-
-Format:
-
- NEWS [string]
-
-If the string is specified, lists news groups whose name contains that
-string. If the string contains an asterisk, a wild card match will be
-applied. I.e. if ALT* is specified, all groups starting with ALT will
-be displayed.
-2 /NEWGROUP
-If specified, will list new news groups that have been added since the
-last time that a user has accessed a news group. If there are new
-groups, a user will see a message indicating that there are new groups
-when the user accesses a news group.
-2 /START
- /START=string
-
-If specified, the list will start with the first group which follows
-alphabetically after that string. I.e. if /START=B is specified, the
-list will start with groups whose name starts with a B.
-2 /SUBSCRIBE
-If specified, lists only those news folders which have been subscribed to.
-An asterisk before the group indicates that new messages are present for
-that folder.
-1 NEXT
-Skips to the next message and displays it. This is useful when paging
-through the messages and you encounter a particularly long message
-that you would like to skip over.
-2 /EDIT
-Specifies that the editor is to be used to read the message. This is
-useful for scanning a long message.
-2 /HEADER
- /[NO]HEADER
-
-Specifies that if a message header exists, the header will be shown.
-If /HEADER or /NOHEADER is specified, the setting will apply for all
-further reads in the selected folder. The default is /HEADER for non-
-NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command
-is set for the folder, it will change the default to be /HEADER.
diff --git a/decus/vax91b/bulletin-net91b/bullcoms2.hlp b/decus/vax91b/bulletin-net91b/bullcoms2.hlp
deleted file mode 100644
index bd53b60aacb3e8e2e32bb16cd0197a8fe2e07fa4..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bullcoms2.hlp
+++ /dev/null
@@ -1,1025 +0,0 @@
-1 POST
-If a NEWS group is selected, posts a message to that group. If a normal
-folder is selected, sends a message via MAIL to the network mailing list
-which is associated with the selected folder. The address of the
-mailing list must be stored using either CREATE/DESCRIPTION or
-MODIFY/DESCRIPTION. See help on those commands for more information.
-
- Format:
- POST [file-name]
-2 /CC
- /CC=user[s]
-Specifies additional users that should receive the mail message.
-2 /EDIT
-Specifies that the editor is to be used for creating the mail message.
-2 /EXTRACT
-Specifies that the text of the message that is being read should be
-included in the mail message. This qualifier is valid only when used
-with /EDIT. The text of the message is indented with > at the
-beginning of each line. This can be suppressed with /NOINDENT.
-2 /GROUPS
- /GROUPS=(newsgroup,[...])
-
-Valid only if a NEWS group is selected. Specifies to send the message to
-the specified NEWS group(s) in addition to the selected NEWS group.
-2 /NOINDENT
-See /EXTRACT for information on this qualifier.
-2 /SUBJECT
- /SUBJECT=text
-
-Specifies the subject of the mail message. If the text consists of more
-than one word, enclose the text in quotation marks (").
-
-If you omit this qualifier, you will prompted for the subject.
-2 Signature_file
-It is possibly to have the contents of a file be automatically appended
-to the end of a message added with the POST and/or the RESPOND command.
-This file is known as a signature file, and it typically contains one's
-name, address, or perhaps a favorite quote. The name of the file should
-be SYS$LOGIN:BULL_SIGNATURE.TXT, and it should be a simple text file. In
-order to specify a different file to use, define the logical name
-BULL_SIGNATURE to point to the desired file.
-
-It is possible to specify that portions or all of the signature file are
-to be included only for specific folders or news groups. Simply surround
-the exclusive text starting with the line "START <folder-name>" and ending
-with the line "END", i.e.
-
-START INFOVAX
-This line will only appear in the INFOVAX folder.
-END
-START MISC.TEST
-This line will only appear in the news folder MISC.TEST.
-END
-This line will appear in all postings.
-
-Note that an empty line is automatically created to separate the text of
-the message and the contents of the signature file.
-1 PRINT
-Queues a copy of the message you are currently reading (or have
-just read) for printing. The file(s) created by the PRINT command
-are not released to the print queue until you exit from MAIL.
-Multiple messages are concatenated into one print job. The PRINT
-command can take optional qualifiers.
-
- Format:
-
- PRINT [message_number][-message_number1]
-
-A range of messages to be printed can optionally be specified, i.e.
-FILE 2-5.
-
-The key words CURRENT and LAST can also be specified in the range,
-in place of an actual number, i.e. CURRENT-LAST, 1-CURRENT, etc.
-
-NOTE: The qualifier /PRINT is present on the DIRECTORY command. This
-provides more flexibility than is present with the PRINT command. For
-example, if you want to print all messages with a particular string in
-it's subject line, DIRECTORY/PRINT/SUBJ would allow you do it.
-2 /ALL
-Prints all the messages in the current folder.
-2 /FORM
-Specifies the name or number of the form that you want for the print
-job. Codes for form types are installation-defined. You can use the
-SHOW QUEUE/FORM command at DCL level to find out the form types
-available for your system. Use the SHOW QUEUE/FULL command at DCL
-level to find out the name of the mounted form and the default form for
-a particular queue. If you specify a form whose stock is different
-from the stock of the form mounted on the queue, your job is placed in
-a pending state until the stock of the mounted form of the queue is
-set equal to the stock of the form associated with the job. (In order
-to have your job print, the system manager should stop the queue,
-physically change the paper stock on the output device, and restart the
-queue specifying the new form type as the mounted form.)
-2 /HEADER
- /[NO]HEADER
-
-Controls whether a header containing the owner, subject, and date of the
-message is printed at the beginning. The default is to write the header.
-2 /NOTIFY
- /[NO]NOTIFY
-
-Indicates that you will be notified by a broadcast message when the
-file or files have been printed. If /NONOTIFY is specified, there
-is no notification. The default is /NOTIFY.
-2 /NOW
-Sends all messages that have been queued for printing with the PRINT
-command during this session to the printer.
-2 /QUEUE
- /QUEUE=queue_name
-
-The name of the queue to which a message is to be sent. If the /QUEUE
-qualifier is not specified, the message is queued to SYS$PRINT.
-1 READ
-Displays the specified message. If you do not specify a message, then
-the first time you enter the command, the first message in the folder
-will be displayed. However, if there are new messages, the first new
-message will be displayed. Each time you enter the command, the next
-page, or if there are no more pages, the next message will be displayed.
-
- Format:
- READ [message-number]
-
-The message's relative number is found by the DIRECTORY command.
-If you specify a number greater than the number of messages in the
-folder, the last message in the folder will be displayed.
-
-NOTE: The READ command can be abbreviated by omitting the READ command,
-i.e. typing the command "2" is equivalent to "READ 2", and simply
-hitting the <RETURN> key is equivalent to "READ".
-
-BULLETIN normally stores only the latest message that has been read per
-folder. It can optionally store and display which messages have been
-read in a folder on a per message basis. For information on this, see
-the help on the SEEN command.
-2 /ALL
-Specifies to read all messages. Used after /MARKED, /UNMARKED, /SEEN,
-or /UNSEEN had been specified.
-2 /EDIT
-Specifies that the editor is to be used to read the message. This is
-useful for scanning a long message.
-2 /HEADER
- /[NO]HEADER
-
-Specifies that if a message header exists, the header will be shown.
-If /HEADER or /NOHEADER is specified, the setting will apply for all
-further reads in the selected folder. The default is /HEADER for non-
-NEWS folders, /NOHEADER for NEWS folders. If the SET STRIP command
-is set for the folder, it will change the default to be /HEADER.
-2 /MARKED
-Specifies to read only messages that have been marked (marked messages
-are indicated by an asterisk). Using /MARKED is equivalent to
-selecting the folder with /MARKED, i.e. only marked messages will be
-shown and be able to be read. To see all messages, use either /ALL,
-or reselect the folder.
-2 /UNMARKED
-Specifies to read only messages that have not been marked (marked
-messages are indicated by an asterisk). Using /UNMARKED is equivalent
-to selecting the folder with /UNMARKED, i.e. only unmarked messages
-will be shown and be able to be read. To see all messages, either
-reselect the folder or specify /ALL.
-2 /SEEN
-Specifies to read only messages that have been seen (indicated by a
-greater than sign). Using /SEEN is equivalent to selecting the folder
-with /SEEN, i.e. only seen messages will be shown and be able to be
-read. To see all messages, use either /ALL, or reselect the folder.
-2 /UNSEEN
-Specifies to read only messages that have not been seen (seen message
-are indicated by a greater than sign). Using /UNSEEN is equivalent to
-selecting the folder with /UNSEEN, i.e. only unseen messages will be
-shown and be able to be read. To see all messages, use either /ALL, or
-reselect the folder.
-2 /NEW
-Specifies to read the first unread message.
-2 /PAGE
- /[NO]PAGE
-
-Specifies that the display of the message will pause when it reaches the
-end of the page. If /NOPAGE is specified, the whole message will be
-displayed. This is useful for terminals that can store more than one
-screenful at a time, and that have a remote printer that can then print
-the contents of the terminal's memory.
-2 /SINCE
- /SINCE=date
-
-Specifies to read the first message created on or after the specified
-date. If no date is specified, the default is TODAY.
-1 REMOVE
-Removes a folder. Only the owner of a folder or a privileged user can
-remove the folder.
-
- Format:
- REMOVE folder-name
-1 REPLY
-Adds message with subject of message being the subject of the currently
-read message with "RE:" preceeding it. Format and qualifiers is exactly
-the same as the ADD command except for /NOINDENT and /EXTRACT.
-
- Format:
- REPLY [file-name]
-2 /EXTRACT
-Specifies that the text of the message should be included in the reply
-mail message. This qualifier is valid only when used with /EDIT. The
-text of the message is indented with > at the beginning of each line.
-This can be suppressed with /NOINDENT.
-2 /NOINDENT
-See /EXTRACT for information on this qualifier.
-1 RESPOND
-Invokes the VAX/VMS Personal Mail Utility (MAIL) to send a reply mail
-message to the owner of the currently read message.
-
- Format:
- RESPOND [file-name]
-
-If you wish to use another method for sending the mail, define BULL_MAILER
-to point to a command procedure. This procedure will then be executed in
-place of MAIL, and the parameters passed to it are the username and subject
-of the message.
-2 /CC
- /CC=user[s]
-Specifies additional users that should receive the reply.
-2 /EDIT
-Specifies that the editor is to be used for creating the reply mail
-message.
-2 /EXTRACT
-Specifies that the text of the message should be included in the reply
-mail message. This qualifier is valid only when used with /EDIT. The
-text of the message is indented with > at the beginning of each line.
-This can be suppressed with /NOINDENT.
-2 /GROUPS
- /GROUPS=(newsgroup,[...])
-
-Valid only if a NEWS group is selected and /LIST is present. Specifies
-to send the message to the specified NEWS group(s) in addition to the
-selected NEWS group.
-2 /LIST
-Specifies that the reply should also be sent to the network mailing list
-associated with the folder. The mailing list address should be stored
-in the folder description. See CREATE/DESCRIPTION or MODIFY/DESCRIPTION
-for more informaton.
-2 /NOINDENT
-See /EXTRACT for information on this qualifier.
-2 /SUBJECT
- /SUBJECT=text
-
-Specifies the subject of the mail message. If the text consists of more
-than one word, enclose the text in quotation marks (").
-
-If you omit this qualifier, the description of the message will be used
-as the subject preceeded by "RE: ".
-1 QUIT
-Exits the BULLETIN program.
-1 SEARCH
-Searches the currently selected folder for the message containing the
-first occurrence of the specified text string.
-
- Format:
-
- SEARCH [search-string]
-
-The search starts from the first message in the current folder. The
-search includes both the text of the message, and the description header.
-If a "search-string" is not specified, a search is made using the
-previously specified string, starting with the message following the
-one you are currently reading (or have just read). Once started, a
-search can be aborted by typing a CTRL-C.
-2 /EDIT
-Specifies that the editor is to be used for reading the message.
-2 /FOLDER
- /FOLDER=(folder,[...])
-
-Specifies a list of folders to be searched. The search will start by
-selecting the first folder in the list and searching the messages for
-a match. If, during a search, no more matches or messages are found,
-the next folder in the list is automatically selected. The presently
-selected folder can be included in the search by specifying "" as the
-first folder in the list.
-2 /REPLY
-Specifies that messages are to be searched for that are replies to the
-currently read message, or the message specified by /START. Replies are
-messages which have subject of the original message prefaced by "Re:".
-2 /REVERSE
-Specifies that the messages are to be searched in reverse order. If
-no starting message is specified, the search is started from the last
-message.
-2 /START
- /START=message_number
-
-Specifies the message number to start the search at.
-2 /SUBJECT
-Specifies that only the subject of the messages are to be searched.
-1 SEEN
-Sets the current or message-id message as seen. This allows you to keep
-track of messages on a per message basis. Seen messages are displayed
-with a greater than sign in the left hand column of the directory
-listing. Once you have used the SEEN command once, messages will be
-automatically be set as being SEEN when they are read. The UNSEEN
-command sets the current or message-id message as unseen.
-
- Format:
-
- SEEN [message-number or numbers]
- UNSEEN [message-number or numbers]
-
-Keeping track of seen messages requires very little overhead for NEWS
-folders. However, there is a moderate overhead for regular non-NEWS
-folders. If you have used the SEEN command and wish to disable the
-automatic marking of messages in regular folders as SEEN when they are
-read, type the command SEEN/NOREAD. To reenable, simply use the SEEN
-command again.
-
-NOTE: The list of SEEN messages for non-NEWS folders are stored in a
-file username.BULLMARK, and NEWS folders are stored in
-username.NEWSMARK. The files are created in the directory pointed to by
-the logical name BULL_MARK. If BULL_MARK is not defined, SYS$LOGIN
-will be used.
-1 SELECT
-Selects a folder of messages. See HELP Folders for a description of a
-folder. Once a folder has been selected, all commands, i.e. DIRECTORY,
-READ, etc. will apply only to those messages. Use the CREATE command to
-create a folder. Use the DIRECTORY/FOLDER command to see the list of
-folders that have been created.
-
- Format:
-
- SELECT [node-name::][folder-name]
-
-The complete folder name need not be specified. BULLETIN will try to
-find the closest matching name. I.e. INFOV can be used for INFOVAX.
-
-Omitting the folder name will select the default general messages.
-
-The node name can be specified only if the remote node has the special
-BULLCP process running (invoked by BULLETIN/STARTUP command.)
-
-After selecting a folder, the user will notified of the number of unread
-messages, and the message pointer will be placed at the first unread
-message.
-
-BULLETIN automatically determines if the selcted name is a NEWS group by
-detecting if a period is present in the name being specified, as most
-NEWS groups contain a period, whereas a real folder cannot. A few
-special NEWS groups, i.e. JUNK and CONTROL, do not contain a period. If
-desired, you can select these groups by enclosing them in double quotes
-("), and typing the name in lower case.
-2 /MARKED
-Selects only messages that have been marked (indicated by an asterisk).
-After using /MARKED, in order to see all messages, the folder will have
-to be reselected.
-1 SET
-The SET command is used with other commands to define or change
-characteristics of the BULLETIN Utility.
-
- Format:
-
- SET option
-2 ACCESS
-Controls access to a private folder. A private folder can only be
-selected by users who have been granted access. Only the owner of that
-folder is allowed to grant access.
-
- Format:
-
- SET [NO]ACCESS id-name [folder-name]
-
-The id-name can be one or more ids from the system Rights Database for
-which access is being modified. It can also be a file name which
-contains a list of ids. For more information concerning usage of
-private folders, see HELP CREATE /PRIVATE. NOTE: Access is created via
-ACLs. If a user's process privileges are set to override ACLs, that
-user will be able to access the folder even if access has not been
-granted.
-
-It is suggested that if you plan on granting access to many users, that
-you create an id using the AUTHORIZE utility and then use the SET ACCESS
-command to grant access to that id. Then, you can use the GRANT/ID
-command in AUTHORIZE to grant the id to users, and this will give those
-users access to the folder. This is preferred because of problems with
-running into system quota when checking for acls on a file with a large
-amount of acls. It is also means that you don't have to remember to
-remove the access for that user from a folder if that user is removed
-from the system.
-
-A user with BULLETIN privileges (see HELP SET PRIV) will be able to
-select a protected folder regardless of the access settings. However, a
-user without explicit access will not receive login notifications of new
-messages, and thus will not be able to set any login flags. (NOTE: If
-such a user selects such a folder and then uses SET ACCESS to grant him
-or herself access, the user must reselect the folder in order for the
-new access to take affect in order to be able to set login flags.)
-3 id
-The id-name can be one or more ids contained in the system Rights
-Database. This includes usernames and UICs. A UIC that contains a
-comma must be enclosed in quotes. UICs can contain wildcards, i.e.
-"[130,*]". Note that by default, a process is given the process rights
-id SYS$NODE_nodename, where nodename is the decnet nodename. Thus, by
-specifing this id, a folder can be restricted to a specific node, which
-is useful when the folder is shared among nodes in a cluster.
-
-Alternatively, the id-name can be a filename which contains a list of
-ids. The filename should be preceeded by a "@". If the suffix is not
-specified, it will be assumed that the suffix is ".DIS" .
-3 /ALL
-Specifies that access to the folder is granted to all users. If /READ
-is not specified, the folder will no longer be private. If /READ is
-specified, all users will have read access, but only privileged users
-will have write access (of course non-privileged users can gain access
-via a later SET ACCESS command.)
-
-Format:
-
- SET ACCESS /ALL [folder-name]
-3 /READ
-Specifies that access to the folder will be limited to being able to
-read the messages.
-3 Warning
-If a user logs in after a private folder has been created but before
-being given access, and then is given access, any defaults that the
-folder has, i.e. /BRIEF, /READNEW, & /NOTIFY, will not be set for that
-user. This is because if the id is not a username, it becomes an
-extremely lengthy operation to check each user to see if have that id
-assigned to them. The alternative is to set the defaults for all users
-after every SET ACCESS, but that might cause problems with users who
-have manually reset those defaults. The correct solution requires a
-large programming modification, which will be done in a later version.
-2 ALWAYS
-Specifies that the selected folder has the ALWAYS attribute. This
-causes messages in the folder to be displayed differently when logging
-in. SYSTEM messages will be displayed every time a user logs in, rather
-than just once. Non-SYSTEM message will also be displayed every time
-(in whatever mode is selected, i.e. BRIEF, SHOWNEW, or READNEW) until
-the user actually reads that message (or a later one). This feature is
-meant for messages which are very important, and thus you want to make
-sure they are read.
-
- Format:
-
- SET [NO]ALWAYS
-2 BBOARD
-Specifies a username to be used as a BBOARD destination. Mail which is
-sent to that user are converted into messages. This command will apply
-to the selected folder, and each folder can have its own BBOARD. Only
-privileged users or owners of the folders can set BBOARD. Note: The
-specified account must have the DISUSER flag specified in the system
-authorization file, and it either must be given SYSPRV privileges, or
-the scratch bboard_directory (specified when compiling BULLETIN) must
-have world rwed protection. Also, certain system parameters which
-affect detached subprocesses are usually too low for the subprocess
-which is spawned to read the mail. The parameters and the suggested
-values are: PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, and PQL_DFILLM
-= 30. If you are not using the BULLCP process, the subprocess limit for
-users must be at least 2.
-
- Format:
-
- SET BBOARD [username]
-
-BBOARD cannot be set for remote folders. See also the commands SET
-STRIP and SET DIGEST for options on formatting BBOARD messages.
-
-If BULLCP is running, BBOARD is updated every 15 minutes. If you want
-to length this period, define BULL_BBOARD_UPDATE to be the number of
-minutes, between updates. I.e. DEFINE/SYSTEM BULL_BBOARD_UPDATE "30"
-will cause the updates to be don every 30 minutes.
-
-NOTE: If you want to control the expiration date on a per message basis,
-you can do so by adding a special header line to the message. The form
-is Expires: or X-Expires: followed by the date in the form DD MMM YYYY.
-The time will always be 00:00, even if the time is specified on the line.
-3 /EXPIRATION
- /EXPIRATION=days
- /NOEXPIRATION
-
-Specifies the number of days the message created by the BBOARD is to be
-retained. The default is 14 days. The highest limit that can be
-specified is 30 days. This can be overridden by a user with privileges.
-If /NOEXPIRATION is specified, messages will become permanent.
-
-NOTE: This value is the same value as specified by SET DEFAULT_EXPIRE.
-If one is changed, the other will change also.
-3 /SPECIAL
-Specifies that the input should be processed using a special command
-procedure, and not to use the simple VMS MAIL to message conversion.
-Specifying a username is optional. To remove this feature, you must
-either SET NOBBOARD, or SET BBOARD and specify a username. See
-installation notes for exactly how to use this feature.
-3 /VMSMAIL
-Used in conjunction with /SPECIAL. If /SPECIAL and a username is
-specified, and the conversion still takes its input from VMS MAIL, then
-the VMS system mail file is checked to see if new mail exists for the
-specified user before running the command procedure. This saves time
-and avoids creating subprocesses. (Useful if input is digest format.)
-3 Listserv
-For a LISTSERV mailing list, only a subscribed user can post to it. If
-the BBOARD account is subscribed to the list in order for BULLETIN to
-receive the list, only the BBOARD account will be able to post to it.
-This problem is solved by placing the word LISTSERV in the folder
-description line. Then, messages sent to the mailing list by the POST
-command will be sent from the BBOARD account rather than from the user's
-account. For example, the folder description might be:
-
-FAKE MAILING LIST <FAKELIST@FAKENODE.BITNET> LISTSERV.
-
-If you have PMDF or MX installed, the corresponding logical name
-PMDF_REPLY_TO or MX_REPLY_TO will be temporarily defined in order to add
-a REPLY-TO: line to the message header to display the real user's
-address.
-
-Users who use the method described in HELP SET BBOARD MORE_INFORMATION
-should note the following: When using this LISTSERV feature, the BBOARD
-account must be a real account, not simply a VMS MAIL forwarding entry.
-Mail can only be sent from a real account. However, if mail forwarding
-is set for that the account, the account does not need a real directory
-or a unique uic, since it will not need space to store mail.
-
-In order to be able to send LISTSERV commands from the BBOARD account
-without having to actually login to the BBOARD account, there is a
-utility included with BULLETIN called SETUSER. This requires privileges
-to use. After compiling it, use the link command:
-
- LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT
-
-When you run it, it will prompt for a username. After verifying that
-the given username is a valid account, it will then change your
-process's username. You can then send mail from that account.
-
-If you are using PMDF or MX, and wish to use this feature, you can still
-do so by setting BBOARD. As long as the BBOARD account is not a real
-account, it will work properly, even though the mail feed is not really
-coming from the BBOARD account.
-
-In order to find out if the LISTSERV mailing list will accept posts only
-from subscribed users, send the command 'REV listname'. This will
-retrieve the file listname.LIST. It begins with a list of keywords. If
-the keyword 'send' is set to 'public', you don't need to set the
-LISTSERV switch. If it's set to 'private', you do. For a description
-of the keywords and the meaning of their settings, send any LISTSERV the
-command 'INFO KEY'. Note that the 'listname.LIST' files include a list
-of owners and subscribers. If 'send' is set to 'owners', then neither
-the public nor the subscribers can post to the list.
-
-3 More_information
-If more than one folder is to have a BBOARD setting, only one of the
-BBOARD names need be a real account. All other names could be names
-whose mail is forwarded to the real account. BULLETIN will then
-determine from the mail header which folder the mail is to be sent to.
-Forwarding can be enabled for any name within MAIL by the command:
-
- MAIL> SET FORWARD/USER=from_name to_name
-
-Any mail sent to FROM_NAME will be forwarded to TO_NAME. Thus, only
-TO_NAME need be a real account. For example, if you have INFOVAX and
-LASER-LOVERS folders, you need create only a INFOVAX account, and then
-forward LASER-LOVERS mail to INFOVAX within mail using the command SET
-FORWARD/USER=LASER-LOVERS INFOVAX. You would then do a SET BBOARD
-INFOVAX for the INFOVAX folder, and SET BBOARD LASER-LOVERS for the
-LASER-LOVERS folder. This method will speed up the BBOARD conversion,
-since mail need be read only from one account. NOTE: Folders that have
-the /SPECIAL set on their BBOARD accounts cannot have their mail
-forwarded to BBOARD accounts that don't have /SPECIAL set. Folders of
-the same type, i.e. that use the same /SPECIAL command procedure, must
-be grouped separately.
-
-The BBOARD account must match the mailing list name. If you prefer not
-to have them match, then you must include the actual address of the
-mailing list in the folder description in the format described under
-HELP CREATE /DESCRIPTION.
-2 BRIEF
-Controls whether you will be alerted upon logging that there are new
-messages in the currently selected folder. A new message is defined as
-one that has been created since the last time you logged in or accessed
-BULLETIN. Note the difference between BRIEF and READNEW. The latter
-causes a listing of the description of the new messages to be displayed
-and prompts the user to read the messages. Setting BRIEF will clear a
-READNEW setting (and visa versa).
-
- Format:
-
- SET [NO]BRIEF
-3 /ALL
-Specifies that the SET [NO]BRIEF option is the default for all users for
-the specified folder. This is a privileged qualifier.
-3 /DEFAULT
-Specifies that the [NO]BRIEF option is the default for the specified
-folder. This is a privileged qualifier. It will only affect brand new
-users (or those that have never logged in). Use /ALL to modify all users.
-3 /FOLDER
- /FOLDER=foldername
-
-Specifies the folder for which the option is to modified. If not
-specified, the selected folder is modified. Valid only with NOBRIEF.
-3 /PERMANENT
- /[NO]PERMANENT
-
-Specifies that BRIEF is a permanent flag and cannot be changed by the
-individual, except if changing to SHOWNEW or READNEW. This is a
-privileged qualifier.
-2 CONTINUOUS_BRIEF
-Specifies that if BRIEF is set for a folder, and there are new messages,
-the notification message "there are new messages" will be displayed every
-time when logging in, until the new messages are read. Normally, the
-BRIEF setting causes notification only at the first time that new messages
-are detected.
-
- Format:
-
- SET [NO]CONTINUOUS_BRIEF
-
-NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the
-same user.
-2 DEFAULT_EXPIRE
-Specifies the number of days the message created by BBOARD (or direct
-PMDF path) is to be retained. The default is 14 days. The highest
-limit that can be specified is 30 days. This can be overridden by a
-user with privileges.
-
-This also specifies the default expiration date when adding a message.
-If no expiration date is entered when prompted for a date, or if
-prompting has been disabled via SET NOPROMPT_EXPIRE, this value will be
-used.
-
- Format:
-
- SET DEFAULT_EXPIRE days
-
-If -1 is specified, messages will become permanent. If 0 is specified,
-no default expiration date will be present. The latter should never be
-specified for a folder with a BBOARD, or else the messages will
-disappear.
-
-NOTE: This value is the same value that SET BBOARD/EXPIRATION specifies.
-If one is changed, the other will change also.
-2 DIGEST
-Affect only messages which are added via either the BBOARD option, or
-written directly from a network mailing program (i.e. PMDF). Several
-mailing lists use digest format to send their messages, i.e. the
-messages are concatenated into one long message. If DIGEST is set, the
-messages will be separated into individual BULLETIN messages.
-
- Format:
-
- SET [NO]DIGEST
-
-The command SHOW FOLDER/FULL will show if DIGEST has been set.
-
-2 DUMP
-Specifies that messages deleted from the selected folder are written
-into a dump (or log) file. The name of the log file is foldername.LOG,
-and it is located in the folder directory.
-
- Format:
-
- SET [NO]DUMP
-
-The command SHOW FOLDER/FULL will show if dump has been set. (NOTE:
-SHOW FOLDER/FULL is a privileged command.)
-2 EXPIRE_LIMIT
-Specifies expiration limit that is allowed for messages. Non-privileged
-users cannot specify an expiration that exceeds the number of days
-specified. Privileged users can exceed the limit.
-
- SET [NO]EXPIRE_LIMIT [days]
-
-The command SHOW FOLDER/FULL will show the expiration limit, if one
-exists. (NOTE: SHOW FOLDER/FULL is a privileged command.)
-2 FOLDER
-Select a folder of messages. Identical to the SELECT command. See help
-on that command for more information.
-
- Format:
-
- SET FOLDER [node-name::][folder-name]
-3 /MARKED
-Selects messages that have been marked (indicated by an asterisk).
-After using /MARKED, in order to see all messages, the folder will have
-to be reselected.
-2 GENERIC
-Specifies that the given account is a "generic" account, i.e used by
-many different people. If an account is specified as GENERIC, new
-messages placed in the GENERAL folder will be displayed upon logging in
-for a specific number of days, rather than only once. The default
-period is 7 days. This command is a privileged command.
-
- Format:
-
- SET [NO]GENERIC username
-
-NOTE: Both SET GENERIC and SET CONTINUOUS_BRIEF cannot be set for the
-same user.
-3 /DAYS
- /DAYS=number_of_days
-
-Specifies the number days that new GENERAL messages will be displayed
-for upon logging in.
-2 KEYPAD
-Controls whether the keypad has been enabled such that the keys on the
-keypad correspond to command definitions. These definitions can be seen
-via the SHOW KEYPAD command. The default is NOKEYPAD unless the /KEYPAD
-qualifier has been added to the BULLETIN command line.
-
- Format:
-
- SET [NO]KEYPAD
-2 LOGIN
-Controls whether the specified user will be alerted of any messages,
-whether system or non-system, upon logging in. If an account has the
-DISMAIL flag set, SET NOLOGIN is automatically applied to that account
-during the first time that the account logs in. However, this will not
-occur if DISMAIL is set for an old account. Additionally, removing the
-DISMAIL flag will not automatically enable LOGIN. (The reason for the
-above was to avoid extra overhead for constant checking for the DISMAIL
-flag.) This command is a privileged command.
-
- Format:
-
- SET [NO]LOGIN username
-2 NODE
-Modifies the selected folder from a local folder to a remote folder. A
-remote folder is a folder in which the messages are actually stored on a
-folder at a remote DECNET node. The SET NODE command specifies the name
-of the remote node, and optionally the name of the remote folder. If
-the remote folder name is not included, it is assumed to be the same as
-the local folder. When the command is executed, the selected folder
-will then point to the remote folder. If there were messages in the
-local folder, they will be deleted. This feature is present only if the
-BULLCP process is running on the remote node.
-
- Format:
- SET NODE nodename [remotename]
- SET NONODE
-
-NOTE: If one node adds a message to a remote node, other nodes connected
-to the same folder will not immediately be aware of the new message.
-This info is updated every 15 minutes, or if a user accesses that
-folder.
-3 /FOLDER
- /FOLDER=foldername
-
-Specifies the folder for which the node information is to modified.
-If not specified, the selected folder is modified.
-2 NOTIFY
-Specifies whether you will be notified via a broadcast message when a
-message is added to the selected folder.
-
- Format:
-
- SET [NO]NOTIFY
-
-In a cluster, if the logical name MAIL$SYSTEM_FLAGS is defined so that
-bit 1 is set, users will be notified no matter which node they are logged
-in to. If you wish to disable this, you should define BULL_SYSTEM_FLAGS
-so that bit 1 is cleared.
-3 /ALL
-Specifies that the SET [NO]NOTIFY option is the default for all users for
-the specified folder. This is a privileged qualifier.
-3 /DEFAULT
-Specifies that the [NO]NOTIFY option is the default for the specified
-folder. This is a privileged qualifier. It will only affect brand new
-users (or those that have never logged in). Use /ALL to modify all users.
-3 /FOLDER
- /FOLDER=foldername
-
-Specifies the folder for which the option is to modified. If not
-specified, the selected folder is modified. Valid only with NONOTIFY.
-3 /PERMANENT
- /[NO]PERMANENT
-
-Specifies that NOTIFY is a permanent flag and cannot be changed by the
-individual. /DEFAULT must be specified. This is a privileged qualifier.
-2 PAGE
-Specifies whether any directory listing or message reading output will
-pause when it reaches the end of the page or not. Setting NOPAGE is
-useful for terminals that can store more than one screenful at a time,
-and that have a remote printer that can then print the contents of the
-terminal's memory. The default is PAGE, unless the default was changed
-by specifying /NOPAGE on the command line to invoke BULLETIN.
-
- Format:
-
- SET [NO]PAGE
-2 PRIVILEGES
-Specifies either process privileges or rights identifiers that are
-necessary to use privileged commands. Use the SHOW PRIVILEGES command
-to see what is presently set. This is a privileged command.
-
- Format:
-
- SET PRIVILEGES parameters
-
-The parameters are one or more privileges separated by commas. To
-remove a privilege, specify the privilege preceeded by "NO". If /ID is
-specified, the parameters are rights identifiers.
-3 /ID
- /[NO]ID
-
-If specified, then the rights identifier which is specified as the
-parameter will allow users holding that rights identifier to execute
-privileged commands. If /NOID is specified, the identifier is removed.
-2 PROMPT_EXPIRE
-Specifies that a user will be prompted for an expiration date when
-adding a message. If NOPROMPT_EXPIRE is specified, the user will not be
-prompted, and the default expiration (which is set by SET DEFAULT_EXPIRE
-or SET BBOARD/EXPIRATION) will be used. If the value specified is
-greater than the expiration limit, and the user does not have
-privileges, then the expiration limit will be used as the default
-expiration. (If there is no expiration limit, and the user doesn't have
-privileges, then an error will result.) PROMPT_EXPIRE is the default.
-
- Format:
-
- SET [NO]PROMPT_EXPIRE
-2 READNEW
-Controls whether you will be prompted upon logging in if you wish to
-read new non-system or folder messages (if any exist). A new message is
-defined as one that has been added since the last login, or since
-accessing BULLETIN. The default setting for READNEW is dependent on how
-the folder was created by the owner.
-
-In order to apply this to a specific folder, first select the folder
-(using the SELECT command), and then enter the SET READNEW command.
-
- Format:
-
- SET [NO]READNEW
-
-NOTE: If you have several folders with READNEW enabled, each folder's
-messages will be displayed separately. However, if you EXIT the READNEW
-mode before all the folders have been displayed, you will not be alerted
-of the new messages in the undisplayed folders the next time you login.
-However, if you enter BULLETIN, you will be told that new messages are
-present in those other folders. Also, it is not possible to EXIT the
-READNEW mode if there are SYSTEM folders which have new messages. Typing
-the EXIT command will cause you to skip to those folders. (See HELP SET
-SYSTEM for a description of a SYSTEM folder).
-3 /ALL
-Specifies that the SET [NO]READNEW option is the default for all users for
-the specified folder. This is a privileged qualifier. The difference
-between this and /DEFAULT is that the latter will only apply to new users
-(i.e. any users which have never executed BULLETIN).
-3 /DEFAULT
-Specifies that the [NO]READNEW option is the default for the specified
-folder. This is a privileged qualifier. It will only affect brand new
-users (or those that have never logged in). Use /ALL to modify all users.
-3 /FOLDER
- /FOLDER=foldername
-
-Specifies the folder for which the option is to modified. If not
-specified, the selected folder is modified. Valid only with NOREADNEW.
-3 /PERMANENT
- /[NO]PERMANENT
-
-Specifies that READNEW is a permanent flag and cannot be changed by the
-individual. This is a privileged qualifier.
-2 SHOWNEW
-Controls whether a directory listing of new messages for the current
-folder will be displayed when logging in. This is similar to READNEW,
-except you will not be prompted to read the messages. The default is
-dependent on how the folder was created by the owner. A new message is
-defined as one that has been added since the last login, or since
-accessing BULLETIN.
-
-In order to apply this to a specific folder, first select the folder
-(using the SELECT command), and then enter the SET SHOWNEW command.
-
- Format:
-
- SET [NO]SHOWNEW
-3 /ALL
-Specifies that the SET [NO]SHOWNEW option is the default for all users for
-the specified folder. This is a privileged qualifier. The difference
-between this and /DEFAULT is that the latter will only apply to new users
-(i.e. any users which have never executed BULLETIN).
-3 /DEFAULT
-Specifies that the [NO]SHOWNEW option is the default for the specified
-folder. This is a privileged qualifier. It will only affect brand new
-users (or those that have never logged in). Use /ALL to modify all users.
-3 /FOLDER
- /FOLDER=foldername
-
-Specifies the folder for which the option is to modified. If not
-specified, the selected folder is modified. Valid only with NOSHOWNEW.
-3 /PERMANENT
- /[NO]PERMANENT
-
-Specifies that SHOWNEW is a permanent flag and cannot be changed by the
-individual, except if changing to READNEW. This is a privileged qualifier.
-2 STRIP
-Affect only messages which are added via either the BBOARD option, or
-written directly from a network mailing program (i.e. PMDF). If
-STRIP is set, the header of the mail message will be stripped off
-before it is stored as a BULLETIN message.
-
- Format:
-
- SET [NO]STRIP
-
-The command SHOW FOLDER/FULL will show if STRIP has been set.
-2 SYSTEM
-Specifies that the selected folder is a SYSTEM folder. A SYSTEM folder
-is allowed to have SYSTEM and SHUTDOWN messages added to it. This is a
-privileged command.
-
- Format:
-
- SET [NO]SYSTEM
-
-By default, the GENERAL folder is a SYSTEM folder, and the setting for
-that folder cannot be removed.
-
-If the selected folder is remote, /SYSTEM cannot be specified unless the
-folder at the other node is also a SYSTEM folder.
-1 SHOW
-The SHOW command displays information about certain characteristics.
-2 FLAGS
-Shows whether BRIEF, NOTIFY, READNEW, or SHOWNEW has been set for the
-currently selected folder.
-2 FOLDER
-Shows information about a folder of messages. Owner and description are
-shown. If the folder name is omitted, and a folder has been selected via
-the SELECT command, information about that folder is shown.
-
- Format:
-
- SHOW FOLDER [folder-name]
-3 /FULL
-Control whether all information of the folder is displayed. This
-includes DUMP & SYSTEM settings, the access list if the folder is
-private, and BBOARD information. This information is only those who
-have access to that folder.
-2 KEYPAD
-Displays the keypad command definitions. If the keypad has been enabled
-by either the SET KEYPAD COMMAND, or /KEYPAD is specified on the command
-line, the keypad keys will be defined as commands. SHOW KEYPAD is the
-equivalent of HELP KEYPAD.
-
-NOTE: If the keypad is not enabled, PF2 is defined to be SET KEYPAD.
-3 /PRINT
-Prints the keypad definitions on the default printer (SYS$PRINT).
-2 NEW
-Shows folders which have new unread messages for which BRIEF or READNEW
-have been set. (Note: If you enter BULLETIN but do not read new unread
-messages, you will not be notified about them the next time you enter
-BULLETIN. This is a design "feature" and cannot easily be changed.)
-2 PRIVILEGES
-Shows the privileges necessary to use privileged commands. Also shows
-any rights identifiers that would also give a user privileges. (The
-latter are ACLs which are set on the BULLUSER.DAT file.)
-2 USER
-Shows the last time that a user logged in, or if /FOLDER is specified,
-the latest message which a user has read in the folder. If NOLOGIN is
-set for a user, this information will be displayed. This is a
-privileged command. Non-privileged users will only be able to display
-the information for their own account.
-
- Format:
- SHOW USER [username]
-
-The username is optional. If omitted, the process's username is used.
-The username should not be included if /ALL or /[NO]LOGIN is specified.
-
-NOTE: The last logged in time displayed is that which is stored when the
-BULLETIN/LOGIN command is executed, not that which VMS stores. Some
-sites make BULLETIN/LOGIN an optional command for users to store in
-their own LOGIN.COM, so this command can be used to show which users
-have done this.
-3 /ALL
-Specifies that information for all users is to be displayed. This is a
-privileged command.
-3 /LOGIN
- /[NO]LOGIN
-
-Specifies that only those users which do not have NOLOGIN set are to be
-displayed. If negated, only those users with NOLOGIN set are displayed.
-This is a privileged command. The qualifier /ALL need not be specified.
-3 /FOLDER
- /FOLDER=[foldername]
-
-Specifies to display the latest message that was read by the user(s) for
-the specified foldername. A newsgroup can be specified, but the info
-can only be shown if the user has subscribed to the newsgroup. If the
-foldername is not specified, the selected folder will be used.
-3 /SINCE
- /SINCE=[date]
-
-Specifies to display only those users whose latest read message date is
-the same date or later than the specified date. If no date is
-specified, the date of the current message is used. Only valid for
-folders or with /LOGIN. Use /START for newsgroups.
-3 /START
- /START=[number]
-
-Specifies to display only those users whose latest read message number
-is equal to or greather than the specified number. If no number is
-specified, the message number of the current message is used. Only
-valid for newsgroups. Use /SINCE for folders and with /LOGIN.
-2 VERSION
-Shows the version of BULLETIN and the date that the executable was
-linked.
-1 SPAWN
-Creates a subprocess of the current process. To return to BULLETIN,
-type LOGOUT.
-
- Format:
- SPAWN [command-string]
-
-NOTE: BULLETIN disables the use of CONTROL-C, so that you must use
-CONTROL-Y if you wish to break out of a spawned command.
-1 SUBSCRIBE
-Used only for NEWS folders. Specifies that BULLETIN will keep track of
-the newest message that has been read for that NEWS folder. When the
-NEWS folder is selected, the message pointer will automatically point to
-the next newest message that has not been read.
-1 UNDELETE
-Undeletes he specified message if the message was deleted using the
-DELETE command. Deleted messages are not actually deleted but have
-their expiration date set to 15 minutes in the future and are deleted
-then. Undeleting the message will reset the expiration date back to its
-original value. Deleted messages will be indicated as such by the
-string (DELETED) when either reading or doing a directory listing.
-
- Format:
- UNDELETE [message-number]
-1 UNSUBSCRIBE
-Used only for NEWS folders. Specifies that BULLETIN will no longer keep
-track of the newest message that has been read for that NEWS folder. See the
-SUBSCRIBE command for further info.
diff --git a/decus/vax91b/bulletin-net91b/bullet1.com b/decus/vax91b/bulletin-net91b/bullet1.com
deleted file mode 100644
index ac82c98b9bac2b43f375586c3c5cde7ba53e685b..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bullet1.com
+++ /dev/null
@@ -1,1452 +0,0 @@
-$set nover
-$copy/log sys$input AAAREADME.TXT
-$deck
-The following are instructions for creating and installing the BULLETIN
-utility. None of the command procedures included here are sophisticated, so it
-is likely that several modifications will have to be made by the installer.
-The installer should enable all privileges before installation.
-
-Once installation is complete, it is suggested that the installer enter
-BULLETIN and read HELP FOLDERS to see the options available when creating
-or modifying folders.
-
-One of the main uses of BULLETIN, besides storage of messages that are manually
-entered by users, is storage of messages from network mailing lists. This is
-done by using the BBOARD feature, which is enabled using the SET BBOARD command
-inside BULLETIN. The alternative method is for mail messages to be written
-directly by a mailing program by calling internal BULLETIN routines. Such a
-a program has been written for the popular mail utility PMDF. If you wish to
-do so for another utility, read the text file WRITEMSG.TXT. I would be glad to
-include any such programs with my distribution if you think such a program
-would be of use to other users.
-
-Responding to mail which is either added via the BBOARD feature is done using
-VMS MAIL. If for some reason this is inappropriate, you can define BULL_MAILER
-to point to a command procedure, and which will be run instead of VMS MAIL.
-The parameters passed to this procedure are P1 = username and P2 = subject.
-
-1) CREATE.COM
- This will compile and link the BULLETIN sources. Also, there are several
- INCLUDE files for the fortran sources (.INC files). BULLETIN will create it's
- data files in the directory pointed to by the logical name BULL_DIR. If you
- elect not to use this definition, BULLFILES.INC should be modified.
- Note that after this procedure compiles the sources, it puts the objects
- into an object library, and then deletes all the OBJ files in the directory.
-
- NOTE 1: If you plan on using the USENET NEWS reader capability of BULLETIN,
- read NEWS.TXT for installation instructions before compiling.
-
- NOTE 2: The maximum number of folders for this distribution is 96 folders.
- If you wish to increase this, modify BULLUSER.INC and recompile the sources.
- When the new executable is run, it will create a new BULLUSER.DAT data file
- and rename the old one to BULLUSER.OLD. You cannot reduce the number of
- folders.
-
-2) INSTALL.COM
- The following procedure copies the executable image to BULL_DIR and
- installs it with certain privileges. It also installs the necessary
- help files in SYS$HELP. (BULLETIN help file is installed into the
- system help library HELPLIB.HLB. If you don't wish this done, delete
- or modify the appropriate line in the procedure. Also, the help
- library for the BULLETIN program, BULL.HLB, can be moved to a different
- directory other than SYS$HELP. If this is done, the system logical name
- BULL_HELP should be defined to be the directory where the library is
- to be found.)
-
-3) LOGIN.COM
- This contains the commands that should be executed at login time
- by SYS$MANAGER:SYLOGIN.COM. It defines the BULLETIN commands.
- It also executes the command BULLETIN/LOGIN in order to notify
- the user of new messages. NOTE: If you wish the utility to be a
- different name than BULLETIN, you should modify this procedure.
- The prompt which the utility uses is named after image executable.
- If you want messages displayed upon logging in starting from
- oldest to newest (rather than newest to oldest), add /REVERSE to
- the BULLETIN/LOGIN command. Note that users with the DISMAIL
- flag setting in the authorization file will not be notified of
- new messages. See help on the SET LOGIN command within the BULLETIN
- utility for more information on this. Also, please note that when
- a brand new user to the system logins, to avoid overwhelming the new
- user with lots of messages, only PERMANENT SYSTEM messages are displayed.
-
- If you want SYSTEM messages, i.e. messages which are displayed in full
- when logging in, to be continually displayed for a period of time rather
- than just once, you should add the /SYSTEM= qualifier. This is documented
- in BULLETIN.HLP, although there it is referred to only with respect to
- a user wanting to review system messages. It can be added with /LOGIN.
-
- DECWINDOWS users should note the following: Both SYLOGIN and LOGIN are
- executed twice, once before the terminal is actually created, while
- SYS$OUTPUT is still a mailbox, the other time after the terminal is
- created. To avoid this, place the following code in both procedure.
- It causes them to execute only when the output is a terminal. This code
- also helps to allow programs to be placed in LOGIN.COM that prompt for
- terminal input. BULLETIN does this if you select READNEW mode for
- displaying messages when logging in, as READNEW mode will ask you if
- you want to display the messages text. Attempts to read terminal input
- under DECWINDOWS when SYS$OUTPUT is still a mailbox will cause DECTERM
- creation to fail.
-
- $ IF F$LOCATE("_TW",F$GETJPI("","PRCNAM")) .NE. 0 THEN GOTO START
- $ IF "''F$MODE()'" .NES. "INTERACTIVE" THEN GOTO START
- $ IF F$GETDVI("SYS$OUTPUT","TRM") THEN GOTO START
- $ GOTO FINISH
- $START:
- .
- .
- body of SYLOGIN.COM (including BULLETIN command)
- .
- .
- $FINISH:
- $ EXIT
-
-4) BULLSTART.COM
- This procedure contains the commands that should be executed after
- a system startup. It should be executed by SYS$MANAGER:SYSTARTUP.COM.
- It installs the BULLETIN utility with correct privileges. It also
- includes the command BULLETIN/STARTUP. This starts up a detached process
- with the name BULLCP. It periodically check for expire messages, cleanup
- empty space in files, and converts BBOARD mail to messages. It also allows
- other DECNET nodes to share it's folders. If you don't want this feature
- and don't plan on having multiple folders or make use of BBOARD, you could
- eliminate this command if you like. However, it is highly recommended that
- you create this process to avoid extra overhead when users login. NOTE:
- BULLCP normally is created so it is owned by the DECNET account. If that
- account does not exist, BULLCP will be owned by the account that issues
- the BULLETIN/START command. In that case, access via other DECNET nodes
- will not be available.
-
- If you are installing BULLETIN on a cluster and plan to have the bulletin
- files be shared between all of the cluster nodes, you only need to have
- this process running on one node. On all other nodes, the system logical
- name BULL_BULLCP should be defined (to anything you want) so as to notify
- BULLETIN that BULLCP is running. (On the local node where BULLCP is running,
- this logical name is automatically defined.)
-
- The use of the MARK command to mark messages require that a file be
- created for each user which saves the marked info. That file file is
- stored in the directory pointed to by the logical name BULL_MARK. You can
- either let users who want to use this command define it themselves, or
- you can define it for them, i.e. DEFINE/SYSTEM BULL_MARK SYS$LOGIN.
-
-5) INSTRUCT.COM
- This procedure adds 2 permanent messages which give a very brief
- description about the BULLETIN utility, and how to turn off optional
- prompting of non-system messages (via SET NOREADNEW).
-
-6) BOARD_SPECIAL.COM
- This command procedure describes and illustrates how to use the
- SET BBOARD/SPECIAL feature. This feature allows the use of BBOARD
- where the input does not come from VMS MAIL. For example, this could
- be used in the case where mail from a non-DEC network is not stored
- in the VMS MAIL. Another example is BOARD_DIGEST.COM. This file
- takes mail messages from "digest" type mailing lists and splits them
- into separate BULLETIN messages for easier reading.
-
- To use this feature, place the special command procedure into the
- bulletin file directory using the name BOARD_SPECIAL.COM. If you want
- to have several different special procedure, you should name the command
- procedure after the username specified by the SET BBOARD command.
-
-7) INSTALL_REMOTE.COM
- This procedure, in conjunction with REMOTE.COM and DCLREMOTE.COM allows
- a user to install new versions of BULLETIN on several DECNET nodes from
- a single node, rather than having to login to each node. This is
- especially useful when a new version modifies the format of one of the
- data file. Older versions of BULLETIN will not run with newer formats
- and will either issue error statements when run, or may cause major
- problems by attempting to change the files back to the old format.
- (NOTE: Don't attempt to use this if different nodes are running
- different versions of VMS, i.e. V4 and V5, as they require different
- linked executables.)
-
-8) MASTER.COM
- If you are using PMDF, and want to use the BBOARD option, a set of
- routines are included which will allow PMDF to write message directly
- into folders, which is a much more effecient way of doing it than
- the normal BBOARD method of using VMS MAIL. Read PMDF.TXT for how
- to do this.
-
-9) OPTIMIZE_RMS.COM
- This routine optimizes index files. To run, type @OPTIMIZE_RMS.COM
- followed by the filename. If you omit the filename, it will prompt
- you to allow you to turn off or on several different types of RMS
- compression. The default is to turn on all types of compression.
- The optimization will cause the file to be compressed.
-
- If you use the NEWS feature, it is suggest that you run this procedure
- on BULLNEWS.DAT after it is created. Compression that file greatly speeds
- up the NEWS update process. If you are tight on space, and have been
- running BULLETIN for a long time, it might also be useful to compress
- BULLINF.DAT if that file is very large. However, compressing that (or
- the other BULLETIN data files) don't appear to save any execution time,
- unlike BULLNEWS.DAT.
-
-10) BULLETIN.COM
- If one wants BULLETIN to be able to send messages to other DECNET
- node's GENERAL folder, but wants to avoid running the process created
- by BULLETIN/STARTUP on this node, another method exists. This is the
- "older" (and slower) method. BULLETIN.COM must be put in each node's
- DECNET default user's directory (usually [DECNET]). Once this is done,
- the /NODE qualifier for the ADD & DELETE commands can be used.
- The object BULLETIN pointing to BULLETIN.COM must be added to the NCP
- database, i.e. the command
- MCR NCP SET OBJ BULLETIN FILE directory:BULLETIN.COM number 0
- must be executed at startup time on the remote node.
- NOTE: Privileged functions such as /SYSTEM will work on other nodes
- if you have an account on the other node with appropriate privileges.
-$eod
-$copy/log sys$input BULLDIR.INC
-$deck
- PARAMETER DIR_RECORD_LENGTH = ((97+3)/4)*4
-
- COMMON /BULL_DIR/ MSG_BTIM,MSG_NUM,DESCRIP,FROM,LENGTH,EX_BTIM
- & ,SYSTEM,BLOCK,HEADER_BTIM,HEADER_NUM,NEWEST_EXBTIM,NEWEST_MSGBTIM
- & ,NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_BTIM,NEMPTY
- & ,DATE,TIME,EXDATE,EXTIME,NEWEST_EXDATE,NEWEST_EXTIME
- & ,NEWEST_DATE,NEWEST_TIME,SHUTDOWN_DATE,SHUTDOWN_TIME
- CHARACTER*53 DESCRIP
- CHARACTER*12 FROM
- LOGICAL SYSTEM
-
- CHARACTER*11 DATE,EXDATE,NEWEST_EXDATE,NEWEST_DATE,SHUTDOWN_DATE
- CHARACTER*11 TIME,EXTIME,NEWEST_EXTIME,NEWEST_TIME,SHUTDOWN_TIME
-
- INTEGER MSG_BTIM(2),EX_BTIM(2),HEADER_BTIM(2)
- INTEGER NEWEST_EXBTIM(2),NEWEST_MSGBTIM(2),SHUTDOWN_BTIM(2)
-
- CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY
- EQUIVALENCE (MSG_BTIM,BULLDIR_ENTRY)
-
- CHARACTER*52 BULLDIR_HEADER
- EQUIVALENCE (HEADER_BTIM,BULLDIR_HEADER)
-
- DATA HEADER_BTIM/0,0/,HEADER_NUM/0/
-
- CHARACTER MSG_KEY*8
-
- EQUIVALENCE (MSG_BTIM,MSG_KEY)
-
- PARAMETER LINE_LENGTH=255
-
- COMMON /INPUT_BUFFER/ INPUT
- CHARACTER INPUT*(LINE_LENGTH)
-$eod
-$copy/log sys$input BULLETIN.HLP
-$deck
-1 BULLETIN
-Invokes the PFC BULLETIN Utility. This utility is used for reading,
-adding and deleting message. Users are notified at login time that new
-messages have been added and the topics of those messages are displayed.
-Reading of those messages is optional. (Use the command SET READNEW
-while in BULLETIN for setting automatic reading.) Privileged users can
-add system bulletins that are displayed in full at login time. These
-messages are also saved, and can be read by BULLETIN. Messages are
-automatically deleted after a specified expiration date, or they can
-manually be deleted by either the submitter of the message or a
-privileged user.
-
- Format:
-
- BULLETIN [foldername or bulletin interactive command]
-
-BULLETIN has an interactive help available while using the utility.
-Type HELP after invoking the BULLETIN command.
-2 Description
-
-The BULLETIN utility is a utility to display messages to users when
-logging in. Users are notified of messages only once. They're not
-forced into reading them every time they log in. Submitting and reading
-messages is easy to do via a utility similar to the VMS MAIL utility.
-Privileged users can create messages which are displayed in full. (known
-as SYSTEM messages). Non-privileged users may be able to create
-non-SYSTEM messages (unless your system manager has disabled the
-feature), but only topics are displayed at login.
-
-Folders can be created so that messages pertaining to a single topic can
-be placed together. Folders can be made private so that reading and
-writing is limited to only users or groups who are granted access.
-Alternatively, folders can be made semi-private in that everyone is
-allowed to read them but write access is limited.
-
-When new non-system messages are displayed, an optional feature which a
-user may enable will cause BULLETIN to ask whether the user wishes to
-read the new bulletins. The user can then read the messages (with the
-ability to write any of the messages to a file). A user can enable the
-notification and prompting of new messages feature on a folder per
-folder basis. However, the exception is messages submitted to the
-default GENERAL folder. Users are always notified at login of new
-bulletins in this folder, but can disable the prompting. This is to
-give non-privileged users some ability to force a notification of an
-important message.
-
-Messages have expiration dates and times, and are deleted automatically.
-Expiration dates and times can be specified in absolute or delta
-notation. Privileged users can specify "SHUTDOWN" messages, i.e.
-messages that get deleted after a system shutdown has occurred.
-"PERMANENT" messages can also be created which never expire.
-
-Privileged users can broadcast their message (to either all users or all
-terminals).
-
-A user can select, on a folder per folder basis, to have a message
-broadcast to their terminal immediately notifying them when a new
-message has been added.
-
-An optional "Bulletin Board" feature allows messages to be created by
-users of other systems connected via networks. A username can be
-assigned to a folder, and any mail sent to that user is converted to
-messages and stored in that folder. This feature originally was
-designed to duplicate the message board feature that exists on some
-Arpanet sites. However, with the addition of folders, another possible
-use is to assign an Arpanet mailing list to a folder. For example, one
-could have an INFOVAX folder associated with an INFOVAX username, and
-have INFO-VAX mail sent to INFOVAX. Users could then read the mailing
-list in that folder, rather than having INFO-VAX sent to each user.
-Optionally, the input for the bulletin board can be directed to be taken
-from any source other than VMS MAIL. This might be useful if incoming
-mail is stored in a different place other than VMS MAIL.
-
-Messages can be either sent to a file, to a print queue, or mailed to
-another user.
-
-BULLETIN can also act a USENET NEWS reader if the appropriate network
-software is available to interact with. See the installation notes for
-more detail.
-2 Parameters
-The parameter following the BULLETIN command is interpreted as the
-folder name which should be selected, rather than the default GENERAL
-folder. If the parameter is specified with quotes ("parameter"), the
-parameter is interpreted as an interactive BULLETIN command, i.e.
-commands which are entered once BULLETIN is executed, i.e. "DIRECTORY",
-"ADD", etc. BULLETIN will exit immediately after entering that command,
-rather than prompting for another command. More than one command can be
-specified by separating the commands with semi-colons, i.e. "SELECT
-DATA;DIR".
-
-NOTE: Depending on how the BULLETIN command is defined, triple quotes
-rather than single quotes may be required.
-2 /EDIT
-Specifies that all ADD or REPLACE commands within BULLETIN will select
-the editor for inputting text.
-2 /KEYPAD
- /[NO]KEYPAD
-Specifies that keypad mode is to be set on, such that the keypad keys
-correspond to BULLETIN commands. The default is /KEYPAD.
-2 /PAGE
- /[NO]PAGE
-
-Specifies whether BULLETIN will stop outputting when it displays a full
-screen or not. /PAGE is the default. If /NOPAGE is specified, any
-output will continue until it finishes. This is useful if you have a
-terminal which can store several screenfuls of display in its memory.
-2 /PGFLQUOTA
- /PGFLQUOTA=pages
-
-Used if you want to specify the page file quota for the BULLCP process.
-2 /STARTUP
-Starts up a detached process which will periodically check for expired
-messages, cleanup empty space in files, and convert BBOARD mail to
-messages. This is recommended to avoid delays when invoking BULLETIN.
-It will create a process with the name BULLCP. For clusters, this
-need be done only on one node. On all other nodes, the system logical
-name BULL_BULLCP should be defined (to anything) in order that BULLETIN
-is aware that it is running on another node. (On the local node where
-BULLCP is running, this logical name is automatically defined.)
-2 /STOP
-Stops the BULLCP process without restarting a new one. (See /STARTUP
-for information on the BULLCP process.)
-2 /SYSTEM
- /SYSTEM=[days]
-
-Displays system messages that have been recently added. The default is
-to show the messages that were added during the last 7 days. This can
-be modified by specifying the number of days as the parameter.
-This command is useful for easily redisplaying system messages that
-might have been missed upon logging in (or were broadcasted but were
-erased from the screen.)
-2 /WIDTH
- /WIDTH=page_width
-
-Specifies the terminal width for display purposes. This is used if your
-startup procedure is configured such that BULLETIN/LOGIN is executed before
-the terminal type is known, and the default width is larger than what the
-terminal type actually is. I.e. the default width might be 132, but the
-real width is 80. In that case, you should add /WIDTH=80 to BULLETIN/LOGIN.
-2 /WSEXTENT
- /WSEXTENT=pages
-
-Used if you want to specify the working set limit for the BULLCP process.
-$eod
-$copy/log sys$input BULLETIN.LNK
-$deck
-$ ULIB = "NONE"
-$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO LINK
-$ ULIB = "PROCESS"
-$ DEFINE/USER LNK$LIBRARY TWG$TCP:[NETDIST.LIB]LIBNET
-$ DEFINE/USER LNK$LIBRARY_1 TWG$TCP:[NETDIST.LIB]LIBNETACC
-$ DEFINE/USER LNK$LIBRARY_2 TWG$TCP:[NETDIST.LIB]LIBNET
-$LINK:
-$ LINK/NOTRACE BULL/LIB/INC=BULLETIN$MAIN,SYS$SYSTEM:SYS.STB/SEL-
- /USERLIB='ULIB'/EXE=BULLETIN,SYS$INPUT/OPT
-SYS$SHARE:VAXCRTL/SHARE
-ID="V2.06"
-$eod
-$copy/log sys$input BULLFILES.INC
-$deck
-C
-C FOLDER_DIRECTORY IS THE DIRECTORY THAT FILES FOR FOLDERS THAT
-C ARE CREATED ARE KEPT IN. IF YOU WISH TO PREVENT FOLDER CREATION,
-C YOU SHOULD MODIFY BULLCOM.CLD TO MAKE THE CREATE COMMAND A PRIVILEGED
-C COMMAND (OR SIMPLY REMOVE THE LINES WHICH DEFINE THE CREATE COMMAND).
-C
-C BBOARD_DIRECTORY IS THE SCRATCH AREA USED BY BBOARD WHEN EXTRACTING
-C MAIL. IF IT IS UNDEFINED, BBOARD WILL NOT BE ABLE TO BE USED.
-C NOTE THAT EITHER THE BBOARD ACCOUNTS MUST HAVE ACCESS TO THIS DIRECTORY,
-C OR THE BBOARD ACCOUNTS MUST BE GIVEN SYSPRV PRIVILEGES TO BE ABLE
-C TO WRITE INTO THIS DIRECTORY. ALSO, FOR BBOARD TO WORK, MAKE SURE
-C THAT THE SUBPROCESS LIMIT FOR USERS IS AT LEAST 2. YOU WILL ALSO HAVE
-C TO INCREASE THE FOLLOWING SYSTEM PARAMETERS WHICH AFFECT DETACHED PROCESES:
-C PQL_DPGFLQUOTA = 10000, PQL_DWSQUOTA = 500, & PQL_DFILLM = 30.
-C (NOTE: ACCESS CAN BE GIVEN TO THE DIRECTORY FOR THE BBOARD ACCOUNTS USING
-C ACLS, I.E. " SET ACL/ACL=(ID=bboard,ACCESS=R+W)/OBJ=FILE directory.DIR")
-C
- COMMON /FILES/ BULLFOLDER_FILE,FOLDER_DIRECTORY,BBOARD_DIRECTORY
- COMMON /FILES/ BULLUSER_FILE,BULLINF_FILE
- CHARACTER*80 FOLDER_DIRECTORY /'BULL_DIR:'/
- CHARACTER*80 BBOARD_DIRECTORY /'BULL_DIR:'/
-C
-C NOTE: THE FOLLOWING DEFINITIONS ASSUME THAT BULL_DIR IS USED. IF IT
-C IS NOT, THEN THEY SHOULD ALSO BE CHANGED.
-C
- CHARACTER*80 BULLUSER_FILE /'BULL_DIR:BULLUSER.DAT'/
- CHARACTER*80 BULLFOLDER_FILE /'BULL_DIR:BULLFOLDER.DAT'/
- CHARACTER*80 BULLINF_FILE /'BULL_DIR:BULLINF.DAT'/
- CHARACTER*80 BULLNEWS_FILE /'BULL_DIR:BULLNEWS.DAT'/
-$eod
-$copy/log sys$input BULLFOLDER.INC
-$deck
-!
-! The following 2 parameters can be modified if desired before compilation.
-!
- PARAMETER BBEXPIRE_LIMIT = 30 ! Maxmimum time limit in days that
- ! BBOARDS can be set to.
- PARAMETER BBOARD_UPDATE = 15 ! Number of minutes between checks
- ! for new BBOARD mail. (Note: Check
- ! only occurs via BULLETIN/LOGIN.
- ! Check is forced via BULLETIN/BBOARD).
- ! NOT APPLICABLE IF BULLCP IS RUNNING.
- PARAMETER ADDID = .TRUE. ! Allows users who are not in the
- ! rights data base to be added
- ! according to uic number.
-
- PARAMETER FOLDER_FMT = '(A25,A4,A12,A80,A12,3A4,A8,7A4)'
- PARAMETER FOLDER_RECORD = 184 ! Must be multiple of 4
-
- COMMON /BULL_FOLDER/ FOLDER,FOLDER_NUMBER,FOLDER_OWNER,
- & FOLDER_DESCRIP,FOLDER_BBOARD,FOLDER_BBEXPIRE,
- & USERB,GROUPB,ACCOUNTB,
- & F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,F_EXPIRE_LIMIT,
- & F_NEWEST_NOSYS_BTIM,FILLER,
- & FOLDER_FILE,FOLDER_SET,FOLDER_NAME
- INTEGER F_NEWEST_BTIM(2)
- INTEGER F_NEWEST_NOSYS_BTIM(2)
- LOGICAL FOLDER_SET
- DATA FOLDER_SET /.FALSE./, FOLDER/'GENERAL'/
- CHARACTER FOLDER_OWNER*12,FOLDER*25,ACCOUNTB*8,FOLDER_NAME*80
- CHARACTER FOLDER_FILE*80,FOLDER_DESCRIP*80,FOLDER_BBOARD*12
-
- EQUIVALENCE (FOLDER_BBOARD(3:),F_START)
- EQUIVALENCE (FOLDER_BBOARD(7:),F_END)
-
- CHARACTER*(FOLDER_RECORD) FOLDER_COM
- EQUIVALENCE (FOLDER,FOLDER_COM)
-
- COMMON /BULL_FOLDER1/ FOLDER1,FOLDER1_NUMBER,FOLDER1_OWNER,
- & FOLDER1_DESCRIP,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,
- & USERB1,GROUPB1,ACCOUNTB1,
- & F1_NBULL,F1_NEWEST_BTIM,FOLDER1_FLAG,F1_EXPIRE_LIMIT,
- & F1_NEWEST_NOSYS_BTIM,FILLER1,
- & FOLDER1_FILE,FOLDER1_NAME
- CHARACTER FOLDER1_OWNER*12,FOLDER1*25,ACCOUNTB1*8,FOLDER1_NAME*80
- CHARACTER FOLDER1_FILE*80,FOLDER1_DESCRIP*80,FOLDER1_BBOARD*12
- INTEGER F1_NEWEST_BTIM(2)
- INTEGER F1_NEWEST_NOSYS_BTIM(2)
-
- EQUIVALENCE (FOLDER1_BBOARD(3:),F1_START)
- EQUIVALENCE (FOLDER1_BBOARD(7:),F1_END)
-
- CHARACTER*(FOLDER_RECORD) FOLDER1_COM
- EQUIVALENCE (FOLDER1,FOLDER1_COM)
-
- PARAMETER NEWS_FOLDER_FMT = '(A25,A4,A55,A12,3A4)'
- PARAMETER NEWS_FOLDER_RECORD = 108 ! Must be multiple of 4
-
- COMMON /NEWS_FOLDER/ NEWS_FOLDER,NEWS_FOLDER_NUMBER,
- & NEWS_FOLDER_DESCRIP,NEWS_FOLDER_BBOARD,
- & NEWS_F_NBULL,NEWS_F_NEWEST_BTIM
- INTEGER NEWS_F_NEWEST_BTIM(2)
- CHARACTER NEWS_FOLDER*25
- CHARACTER NEWS_FOLDER_DESCRIP*55,NEWS_FOLDER_BBOARD*12
-
- EQUIVALENCE (NEWS_FOLDER_BBOARD(3:),NEWS_F_START)
- EQUIVALENCE (NEWS_FOLDER_BBOARD(7:),NEWS_F_END)
-
- CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER_COM
- EQUIVALENCE (NEWS_FOLDER,NEWS_FOLDER_COM)
-
- COMMON /NEWS_FOLDER1/ NEWS_FOLDER1,NEWS_FOLDER1_NUMBER,
- & NEWS_FOLDER1_DESCRIP,NEWS_FOLDER1_BBOARD,
- & NEWS_F1_NBULL,NEWS_F1_NEWEST_BTIM
- INTEGER NEWS_F1_NEWEST_BTIM(2)
- CHARACTER NEWS_FOLDER1*25
- CHARACTER NEWS_FOLDER1_DESCRIP*55,NEWS_FOLDER1_BBOARD*12
-
- EQUIVALENCE (NEWS_FOLDER1_BBOARD(3:),NEWS_F1_START)
- EQUIVALENCE (NEWS_FOLDER1_BBOARD(7:),NEWS_F1_END)
-
- CHARACTER*(NEWS_FOLDER_RECORD) NEWS_FOLDER1_COM
- EQUIVALENCE (NEWS_FOLDER1,NEWS_FOLDER1_COM)
-$eod
-$copy/log sys$input BULLNEWS.INC
-$deck
- COMMON /NEWS_DEFAULTS/ ORGANIZATION,MAILER
-
- CHARACTER*132 ORGANIZATION
- DATA ORGANIZATION /'MIT PLASMA FUSION CENTER'/
-
- CHARACTER*10 MAILER
- DATA MAILER /'IN%'/
-$eod
-$copy/log sys$input BULLUSER.INC
-$deck
-!
-! The parameter FOLDER_MAX should be changed to increase the maximum number
-! of folders available. Due to storage via longwords, the maximum number
-! available is always a multiple of 32. Thus, it will probably make sense
-! to specify a multiple of 32 for FOLDER_MAX, as that it what really will be
-! the capacity. Note that the default general folder counts as a folder also,
-! so that if you specify 64, you will be able to create 63 folders on your own.
-!
- PARAMETER FOLDER_MAX = 96
- PARAMETER FLONG = (FOLDER_MAX + 31)/ 32
-
- PARAMETER USER_RECORD_LENGTH = 28 + FLONG*16
- PARAMETER USER_FMT = '(A12,<4+FLONG*4>A4)'
- PARAMETER USER_HEADER_KEY = ' '
-
- COMMON /HEADER_INFO/ TEMP_USER,BBOARD_BTIM,NEWEST_BTIM,USERPRIV
- COMMON /HEADER_INFO/ SET_FLAG_DEF,BRIEF_FLAG_DEF
- COMMON /HEADER_INFO/ NOTIFY_FLAG_DEF
- CHARACTER TEMP_USER*12
- DIMENSION BBOARD_BTIM(2),NEWEST_BTIM(2),USERPRIV(FLONG)
- DIMENSION SET_FLAG_DEF(FLONG),BRIEF_FLAG_DEF(FLONG)
- DIMENSION NOTIFY_FLAG_DEF(FLONG)
-
- COMMON /BULL_USER/ USERNAME,LOGIN_BTIM,READ_BTIM,
- & NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
- CHARACTER*12 USERNAME
- DIMENSION LOGIN_BTIM(2),READ_BTIM(2)
- DIMENSION NEW_FLAG(FLONG) ! Used to indicate new message in folder
- ! Now NEW_FLAG(2) contains SET GENERIC days
- DIMENSION SET_FLAG(FLONG) ! Bit set indicates READNEW set for folder
- DIMENSION BRIEF_FLAG(FLONG) ! Bit set indicates READNEW/BRIEF set
- DIMENSION NOTIFY_FLAG(FLONG)! Bit set indicates to broadcast
- ! notification when new bulletin is added.
-
- CHARACTER*(USER_RECORD_LENGTH) USER_ENTRY,USER_HEADER
- EQUIVALENCE (USER_ENTRY,USERNAME)
- EQUIVALENCE (USER_HEADER,TEMP_USER)
-
- COMMON /FOLDER_TIMES/ LAST_READ_BTIM(2,0:FOLDER_MAX)
- ! Must start with 0 to store info for folder specified with ::
- COMMON /SYS_FOLDER_TIMES/ LAST_SYS_BTIM(2,FOLDER_MAX)
- ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT
- COMMON /NEWS_TIMES/ LAST_NEWS_READ(2,FOLDER_MAX)
- INTEGER*2 LAST_NEWS_READ2(4,FOLDER_MAX)
- EQUIVALENCE (LAST_NEWS_READ2(1,1),LAST_NEWS_READ(1,1))
- ! Last read times for each folder as stored in BULL_DIR:BULLINF.DAT
-
- COMMON /NEW_MESSAGES/ NEW_MSG
- DIMENSION NEW_MSG(FLONG) ! Flag showing new messages detected
-$eod
-$copy/log sys$input BULL_NEWS.C
-$deck
-#include <descrip.h>
-#include "sys$library:iodef.h"
-
-#if MULTINET
-
-#include "multinet_root:[multinet.include.sys]types.h"
-#include "multinet_root:[multinet.include.sys]socket.h"
-#include "multinet_root:[multinet.include.netinet]in.h"
-#include "multinet_root:[multinet.include]netdb.h"
-#include "multinet_root:[multinet.include]errno.h"
-#include "multinet_root:[multinet.include.vms]inetiodef.h"
-
-static char inet[7] = "INET0:";
-$DESCRIPTOR(inet_d,inet);
-
-#else
-
-#if UCX
-
-#include <ucx$inetdef.h>
-
-struct sockaddr {
- short inet_family;
- short inet_port;
- int inet_adrs;
- char bklb[8];
- };
-
-struct itlist { int lgth; struct sockaddr *hst; };
-
-static short sck_parm[2];
-static struct sockaddr local_host, remote_host;
-struct itlist lhst_adrs, rhst_adrs;
-
-static char ucxdev[11] = "UCX$DEVICE";
-$DESCRIPTOR(ucxdev_d,ucxdev);
-
-static int addr_buff;
-
-#define htons(x) ((unsigned short)((x<<8)|(x>>8)))
-
-#else
-
-#if TWG
-
-#include <types.h>
-#include <socket.h>
-#include <netdb.h>
-#include <in.h>
-#include <inetiodef.h>
-
-static char inet[6] = "INET:";
-$DESCRIPTOR(inet_d,inet);
-
-#else
-
-#define CMU 1
-static char ip[4] = "IP:";
-$DESCRIPTOR(ip_d,ip);
-
-#endif
-
-#endif
-
-#endif
-
-static char task[20];
-$DESCRIPTOR(task_d,task);
-
-static int s;
-
-static struct iosb {
- short status;
- short size;
- int info;
-} iosb;
-
-#define TCP 0
-#define DECNET 1
-
-static int mode = TCP;
-
-news_get_chan()
-{return(s);}
-
-news_set_chan(i)
-int *i;
-{s = *i;}
-
-news_disconnect()
-{
-#if UCX
- sys$cancel(s);
- sys$qiow(0,s,IO$_DEACCESS,0,0,0,0,0,0,0,0,0);
-#endif
- sys$dassgn(s);
-}
-
-#if MULTINET || TWG
-
-static struct hostent *hp;
-static struct sockaddr_in sin;
-
-#endif
-
-int *node;
-
-news_assign()
-{
- int n;
-#if MULTINET
- struct hostent *GETHOSTBYNAME1();
-#endif
-#if TWG
- struct hostent *gethostbyname();
-#endif
- node = getenv("BULL_NEWS_SERVER");
- if (!node) return(0);
- if (!strchr(node,'.')) {
- strcpy(&task[0],node);
- n = strlen(node);
- strcpy(&task[n],"::\"TASK=NNTP\"");
- task_d.dsc$w_length = 13 + n;
- if (!(sys$assign(&task_d,&s,0,0) & 1)) return(0);
- mode = DECNET;
- return(1);
- }
-#if MULTINET || TWG
- /*
- * Get the IP address of the NEWS host.
- */
-
-#if TWG
- hp = gethostbyname(node);
-#else
- hp = GETHOSTBYNAME1(node);
-#endif
- /*
- * Create a "sockaddr_in" structure which describes the remote
- * IP address we want to send to (from gethostbyname()) and
- * the remote NNTP port number (from getservbyname()).
- */
-
- if (!hp) {
- int h[4],i;
- if (sscanf(node,"%d.%d.%d.%d",&h[0],&h[1],&h[2],&h[3]) == 4) {
- for (i=0;i<4;i++) if (h[i] < 0 || h[i] > 255) return(0);
- sin.sin_addr.s_addr = (h[3]<<24)+(h[2]<<16)+(h[1]<<8)+(h[0]);
- } else
- return(0);
- sin.sin_family = AF_INET;
- }
- else {
- sin.sin_family = hp->h_addrtype;
- memcpy(&sin.sin_addr, hp->h_addr, hp->h_length);
- }
-#if TWG
- sin.sin_port = htons(119);
-#else
- sin.sin_port = HTONS1(119);
-#endif
-
- /*
- * Create an IP-family socket on which to make the connection
- */
-
- if (!(sys$assign(&inet_d,&s,0,0) & 1)) return(0);
-#else
-#if UCX
- if (!(sys$assign(&ucxdev_d,&s,0,0) & 1)) return(0);
- {
- short retlen;
- struct dsc$descriptor host_name
- = {strlen(node),DSC$K_CLASS_S,DSC$K_DTYPE_T,node};
- int comm = INETACP$C_TRANS * 256 + INETACP_FUNC$C_GETHOSTBYNAME;
- struct dsc$descriptor command
- = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&comm};
- struct dsc$descriptor host_ad
- = {4,DSC$K_CLASS_S, DSC$K_DTYPE_T,&addr_buff};
- struct iosb nam_iosb;
-
- if (!(sys$qiow(0,s,IO$_ACPCONTROL,&nam_iosb,0,0,
- &command,&host_name,&retlen,&host_ad,0,0) & 1)
- || !(nam_iosb.status & 1)) {
- sys$dassgn(s);
- return(0);
- }
- }
-#else
- if (!(sys$assign(&ip_d,&s,0,0) & 1)) return(0);
-#endif
-#endif
- return(1);
-}
-
-news_socket()
-{
- if (mode == DECNET) return (1);
-
-#if MULTINET || TWG
- if (!(sys$qiow(0,s,IO$_SOCKET,&iosb,0,0,sin.sin_family,
- SOCK_STREAM,0,0,0,0) & 1) || !(iosb.status & 1)) {
- sys$dassgn(s);
- return(0);
- }
-#endif
-#if UCX
- sck_parm[0] = INET$C_TCP;
- sck_parm[1] = INET_PROTYP$C_STREAM;
- local_host.inet_family = INET$C_AF_INET;
- local_host.inet_port = 0;
- local_host.inet_adrs = INET$C_INADDR_ANY;
- lhst_adrs.lgth = sizeof local_host;
- lhst_adrs.hst = &local_host;
- if (!(sys$qiow(0,s,IO$_SETMODE,&iosb,0,0,&sck_parm,0,
- &lhst_adrs,0,0,0) & 1) || !(iosb.status & 1)) {
- sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0,
- UCX$C_DSC_ALL,0,0);
- sys$dassgn(s);
- return(0);
- }
-#endif
-
- return(1);
-}
-
-news_socket_bullcp(efn,biosb,astadr,astprm)
-int *biosb,*astadr,*astprm,*efn;
-{
- if (mode == DECNET) return (1);
-
-#if MULTINET || TWG
- if (!(sys$qio(*efn,s,IO$_SOCKET,biosb,astadr,*astprm,sin.sin_family,
- SOCK_STREAM,0,0,0,0) & 1) ) return(0);
-#else
-#if UCX
- sck_parm[0] = INET$C_TCP;
- sck_parm[1] = INET_PROTYP$C_STREAM;
- local_host.inet_family = INET$C_AF_INET;
- local_host.inet_port = 0;
- local_host.inet_adrs = INET$C_INADDR_ANY;
- lhst_adrs.lgth = sizeof local_host;
- lhst_adrs.hst = &local_host;
- if (!(sys$qio(0,s,IO$_SETMODE,biosb,astadr,*astprm,&sck_parm,0,
- &lhst_adrs,0,0,0) & 1) ) return(0);
-#else
- return(-1);
-#endif
-#endif
-
- return(1);
-}
-
-news_create()
-{
- if (mode == DECNET) return (1);
-
-#if MULTINET || TWG
-
- /*
- * Do a psuedo-connect to that address. This tells the kernel that
- * anything written on this socket gets sent to this destination. It
- * also binds us to a local port number (random, but that is ok).
- */
-
- if (!(sys$qiow(0,s,IO$_CONNECT,&iosb,0,0,&sin,sizeof(sin),0,0,0,0) & 1)
- || !(iosb.status & 1)) {
- sys$dassgn(s);
- return(0);
- }
-#else
-#if UCX
- remote_host.inet_family = INET$C_AF_INET;
- remote_host.inet_port = htons(119);
- remote_host.inet_adrs = addr_buff;
- rhst_adrs.lgth = sizeof remote_host;
- rhst_adrs.hst = &remote_host;
- if (!(sys$qiow(0,s,IO$_ACCESS,&iosb,0,0,0,0,&rhst_adrs,0,0,0) & 1)
- || !(iosb.status & 1)) {
- sys$qiow(0,s,IO$_DEACCESS|IO$M_SHUTDOWN,&iosb,0,0,0,0,0,
- UCX$C_DSC_ALL,0,0);
- sys$dassgn(s);
- return(0);
- }
-#else
- if (!(sys$qiow(0,s,IO$_CREATE,&iosb,0,0,node,119,0,1,0,300) & 1)
- || !(iosb.status & 1)) {
- sys$dassgn(s);
- return(0);
- }
-#endif
-#endif
-
- return(1);
-}
-
-news_create_bullcp(efn,biosb,astadr,astprm)
-int *biosb,*astadr,*astprm,*efn;
-{
- if (mode == DECNET) return (1);
-
-#if MULTINET || TWG
-
- /*
- * Do a psuedo-connect to that address. This tells the kernel that
- * anything written on this socket gets sent to this destination. It
- * also binds us to a local port number (random, but that is ok).
- */
-
- if (!(sys$qio(*efn,s,IO$_CONNECT,biosb,astadr
- ,*astprm,&sin,sizeof(sin),0,0,0,0) & 1)) return(0);
-#else
-#if UCX
- remote_host.inet_family = INET$C_AF_INET;
- remote_host.inet_port = htons(119);
- remote_host.inet_adrs = addr_buff;
- rhst_adrs.lgth = sizeof remote_host;
- rhst_adrs.hst = &remote_host;
- if (!(sys$qio(*efn,s,IO$_ACCESS,biosb,astadr,*astprm,0,
- 0,&rhst_adrs,0,0,0) & 1)) return(0);
-#else
- if (!(sys$qio(*efn,s,IO$_CREATE,biosb,astadr,*astprm,node,
- 119,0,1,0,300) & 1))
- return(0);
-#endif
-#endif
-
- return(1);
-}
-
-news_connect()
-{
- if (!news_assign()) return(0);
- if (!news_socket()) return(0);
- return(news_create());
-}
-
-news_write_packet(buf)
-
-struct dsc$descriptor_s *buf;
-{
- static int n,len;
-
- len = buf->dsc$w_length;
-#if CMU
- if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer,
- len,0,!mode,0,0) & 1)
- || !(iosb.status & 1)) return(0);
-#else
- if (!(sys$qiow(0,s,IO$_WRITEVBLK,&iosb,0,0,buf->dsc$a_pointer,
- len,0,0,0,0) & 1)
- || !(iosb.status & 1)) return(0);
-#endif
-
- return(1);
-}
-
-news_write_packet_bullcp(efn,biosb,astadr,astprm,buf,len)
-int *biosb,*astadr,*astprm,*efn,*buf,*len;
-{
-#if CMU
- if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf,
- *len,0,!mode,0,0) & 1)) return(0);
-#else
- if (!(sys$qio(*efn,s,IO$_WRITEVBLK,biosb,astadr,*astprm,buf,
- *len,0,0,0,0) & 1)) return(0);
-#endif
-
- return(1);
-}
-
-news_read_packet(buf)
-struct dsc$descriptor_s *buf;
-{
- static int n,len;
-
- len = buf->dsc$w_length;
- if (!(sys$qiow(0,s,IO$_READVBLK,&iosb,0,0,buf->dsc$a_pointer,
- len,0,0,0,0) & 1)
- || !(iosb.status & 1)) return(0);
- n = iosb.size;
-
- return(n);
-}
-
-news_gethostname(buf)
-
-struct dsc$descriptor_s *buf;
-{
- if (mode == DECNET) return (-1);
-#if MULTINET
- return(GETHOSTNAME1(buf->dsc$a_pointer, buf->dsc$w_length));
-#else
-#if TWG
- return(gethostname(buf->dsc$a_pointer, buf->dsc$w_length));
-#else
- return(-1);
-#endif
-#endif
-}
-$eod
-$copy/log sys$input HANDOUT.TXT
-$deck
- Introduction to BULLETIN on the Vax
- 2/88 AW
-
-PUBLISHED BY THE DREW UNIVERSITY ACADEMIC COMPUTER CENTER. MAY BE
-COPIED WITH WRITING CREDIT GIVEN TO DREW UNIVERSITY.
-
-BULLETIN was written for the Public Domain by Mark London at MIT.
-
- The BULLETIN utility permits a user to create messages for
-reading by other users. Users may be notified upon logging on
-that new messages have been added, and what the topic of the
-messages are. Actual reading of the messages is optional. (See
-the command SET READNEW for info on automatic reading.) Messages
-are automatically deleted when their expiration data has passed.
- The program runs like VAX mail. The different interest
-groups or BULLETIN boards are implemented in the form of
-'Folders', just like a filing cabinet. A Folder contain various
-messages on the same general topic. A message is a piece of text
-written by a user or staff person and added to a particular
-folder. All users are not permitted to submit messages to all
-folders.
-
- A message consists of an expiration date, a subject line
-and the text of the message. BULLETIN will prompt the user for
-these things when a message is being added.
-
- Several different folders are currently defined to
-BULLETIN. The General Folders will be used by Computer Center
-Staff to post messages of general interest concerning the VAX to
-the user community. If something is of an important nature, it
-will be posted in the General folder as a 'System' message.
-This is a special message type. It will be displayed to each
-user as they log in the first time after that message was
-posted. This will be done automatically by BULLETIN on login.
-Once a particular system message has been displayed, it will not
-be displayed for that user on subsequent logins.
-
-Folders
-
- Different folders have been created to contain messages on
-different topics. Folders may be public, semi-private, or
-private. The majority of the folders will be public. However a
-few will be semi-private, which will mean that all users may
-read messages in the folder but not all will be able to post to
-it. Currently, there are several folders defined:
-
-GENERAL -- system messages
-
-PUBLIC_ANNOUNCEMENTS -- Can be used by anyone to post messages
-of interest to the public
-
-On Beta:
-AIDE STATION -- Private folder for Computer Center Employees
-
-In addition on Alpha there are folders that receive electronic
-magazines, such as:
-NETMONTH -- The monthly magazine of BITNET information.
-RISKS -- Identifying the risks involved in using computers.
-INFOIBMPC -- Information about the IBM personal computers.
-INFOVAX -- Information on the Digital VAX.
-PROGRAMMING_JOURNALS-Includes MINIX, UNIX and C, Modula-2 and
-Prolog journals
-watch for new ones being added.
-
-Using BULLETIN
-
- BULLETIN is invoked by type the command 'BULLETIN' (or BULL,
-for short) at the '$' prompt. BULLETIN will display its prompt
-'BULLETIN>'. Help is available from DCL command level ($) or from
-within the BULLETIN program itself by typing the word 'HELP'. To
-leave the BULLETIN program, type 'EXIT'.
-
-To see what is there
-
- In order to see message and folders, on can use the
-'Directory' command. Upon entering BULLETIN, the user is place
-in the General folder. If the user wishes to see which folders
-exist, the directory/folders command is used. for example:
-typing:
-
- BULLETIN> directory/folders
-
-will make a display like:
-
- Folder Owner
- *GENERAL SYSTEM
- *PUBLIC_ANNOUNCEMENTS BBEYER
- NETMONTH BITNET
- *VAX_SIG BBEYER
-
-An asterisk (*) next to the folder name indicates you have unread
-messages in that folder.
-
-The command 'DIRECTORY/FOLDERS/DESCRIBE' would list all available
-folders, along with a brief description of each.
-
- To switch from one folder to another folder, the user may
-execute the 'SELECT' command. For example, the following
-command would show what a user would do to switch to the folder
-called PUBLIC_ANNOUNCEMENTS:
-
-BULLETIN> SELECT PUBLIC_ANNOUNCEMENTS
-
-and BULLETIN would respond:
- Folder has been set to PUBLIC_ANNOUNCEMENTS
-
- Now the user may get a list of the messages in this folder
-by issuing the directory command with no qualifiers.
-This command, for example:
-BULLETIN> DIRECTORY
-would have bulletin respond:
-
- # Description From Date
- 1 CHRISTMAS PARTY oleksiak 26-JUN-88
- 2 Learning about BULLETIN oleksiak 26-JUN-87
- 3 VAX MAIL LLLOYD 01-Jan-87
-
- The command 'DIR/NEW' will list just unread messages.
-
-
-Reading messages
-
- In order to read messages in a folder, the user may type
-the read command or he/she may simply type the number of the
-message he wishes to read. The message numbers can be acquired
-by doing the 'DIRECTORY' command. If the user hits a carriage
-return with no input whatsoever, BULLETIN will type the first
-message in the folder, or if there are new messages present, it
-will type the first new message in the folder.
-
- If a folder contains the above messages (as seen by the
-'Directory' command) then these messages can be read by:
-
-BULLETIN> READ
-and BULLETIN would respond:
-
-Message number: 1 PUBLIC_ANNOUNCEMENTS
-Description: CHRISTMAS PARTY
-Date: 26-JUN-1988 8:08:40 Expires: 1-JAN-1989 08:08:40
-
-...Body of message.....
-
- Should the user only wish to see message number 3, he can
-enter the 'READ' command with the message number as a parameter.
-for example:
-
-BULLETIN> READ 3
-
- There are three other useful commands that can be used at
-the 'BULLETIN>' prompt when reading messages. These are:
-
-BACK - Read the message preceding the message currently being
-read.
-
-CURRENT - Start reading the current message at the top. This is
-useful for someone who is reading a message and wishes to reread
-it from the beginning.
-
-NEXT - Start reading from the beginning of the next message.
-This is handy if the user is reading a very long message and
-wants to skip to the next one.
-
-Saving the interesting stuff.
-
- If the user sees something which he/she wants a copy of,
-the extract command can be use to write an ASCII copy of the
-message into a file. This command works on the current message
-being read. It requires the name of the file into which to save
-the message. If the file name is not given, the user will be
-prompted for it. For example:
-
-BULLETIN> Read 2
-
-********** Message on Screen ********
-
-A person could then type
-BULLETIN> extract
-file: FV.TXT
-BULLETIN>
-
-BULLETIN has now saved the contents of message number 2 into the
-file name 'FV.txt'.
- If the file to which the user is writing already exists,
-BULLETIN will append the message to the file. The user can
-force BULLETIN to write a new file containing only the message
-being saved by using the '/new' qualifier in the 'extract'
-command. These messages can then be sent to other users, or
-downloaded for use in Wordperfect. (See "Mail on the Vax", or
-"Transferring a file between a PC and the VAX").
-
-This command may be useful if you wish to transfer the message to
-your PC, perhaps using a BITNET journal message as a reference in
-a paper. Once the file is saved, you can transfer it to a PC by
-following the instructions in the handout 'Transferring files
-from the PC to the VAX of from the VAX to a PC".
-
-Adding messages
- A user may add a message to a folder by selecting the
-folder and then using the 'ADD' command. This is provided that
-the user is adding the message to a public folder. The user has
-the option of giving the 'ADD' command and typing a message using
-the VAX editor or uploading a message from your PC (see
-documentation), or add a message you have extracted from VAX
-mail. BULLETIN will prompt for the expiration date and subject
-line. It will then add the text of the file as the body of the
-message. To add a message that is stored in a file (from MAIL or
-from your PC, for example) type:
-
- ADD filename
-
-If the user does not specify a file name, he/she will be
-prompted to enter the body of the message. The user may also
-use the EDT text editor by issuing the command with the
-'/EDIT'option.
-
-For example:
-BULLETIN> sel PUBLIC_ANNOUNCEMENTS
- folder has been set to PUBLIC_ANNOUNCEMENTS
-BULLETIN> ADD MESS.TXT
-
-IT IS 10-JUL-1988 12:41:06.15. SPECIFY WHEN THE MESSAGE SHOULD
-EXPIRE: ENTER ABsolute TIME: <DD-MMM-YYYY]HH:MM:SS OR DELTA
-TIME: DDD HH:MM:SS
-
-A user then type the date of expiration and press the 'return'
-button. The time input may be ignored. For example, typing:
-20-JUL-1988 or type "10" - for ten days in the future.
-
-BULLETIN responds:
-ENTER DESCRIPTION HEADER. LIMIT HEADER TO 53 CHARACTERS.
-
-Now the user may enter the subject of the message.
-
-BULLETIN>
-
-The above session adds the text in the file 'mess.txt' as the
-next message in the PUBLIC_ANNOUNCEMENTS Folder. The message
-will be deleted automatically on the 20th of July as requested
-by the user adding the message.
-
-Asking BULLETIN to notify you of new messages upon logging in.
-
- If the user wishes to get notification on login when new
-messages are in a folder, he should use the 'READNEW' option.
-This command does not force the reader to reading new messages,
-only gives notification. To do this, 'SELECT' each folder you
-are interested in and do a 'SET READNEW' command while set to
-that folder.
-
-Example:
-
-BULLETIN> Select PUBLIC_ANNOUNCEMENTS
-folder has been set to PUBLIC_ANNOUNCEMENTS
-BULLETIN> SET READNEW
-
-Alternately, you may type SET SHOWNEW. This will just display a
-message notifying you that there are new messages.
-
-Mailing a BULLETIN message
-
- A user may directly mail another user a message found in the
-BULLETIN. While reading the message that he/she desires to send,
-at the 'BULLETIN>' type 'MAIL'. The Vax will then ask to whom
-you wish to send the information too.
-
-Check the BULLETIN DISCUSSION folder on ALPHA for new additions.
-If you have comments or questions about BULLETIN, leave them
-there.
-$eod
-$copy/log sys$input INSTRUCT.TXT
-$deck
-This message is being displayed by the BULLETIN facility. This is a non-DEC
-facility, so it is not described in the manuals. Messages can be submitted by
-using the BULLETIN command. System messages, such as this one, are displayed
-in full, but can only be entered by privileged users. Non-system messages can
-be entered by anyone, but only their topics will be displayed at login time,
-and will be prompted to optionally read them. (This prompting feature can be
-disabled). All bulletins can be reread at any time unless they are deleted or
-expire. For more information, see the on-line help (via HELP BULLETIN).
-$eod
-$copy/log sys$input NEWS.TXT
-$deck
-BULLETIN now has the capability to read and post messages to USENET NEWS in a
-client mode. I realize that there are many NEWS readers, some with much more
-elegant interfaces. However, I elected to modify BULLETIN for the following
-reason: We have many decnet nodes, but only several are internet nodes. Our
-only access to a news server was via internet. In order for those
-non-internet nodes to read USENET, the only method that seemed available was to
-run a NEWS server program on one of our own internet nodes so that it could
-be accessible via decnet. I did not want to do that, as that requires storing
-the news groups on disk, and I do not have the room for that. I thus added the
-ability in BULLETIN (actually BULLCP) so that it acts as as a gateway between
-decnet and tcp for NEWS. This method does not require spawning any processes,
-since the detached process BULLCP is always present, so the access is very
-fast. Also, since BULLETIN uses a shared database to store info on the NEWS
-groups and periodically updates it, there is no need for that to be done when a
-user accesses the NEWS groups. Several other NEWS readers do this when you run
-them, which is why they take a long time to start up. It is also possible to
-feed NEWS groups into a "real" BULLETIN folder, so that the messages are saved
-on disk.
-
-Presently, BULLETIN can be used with either UCX, MULTINET, or CMU TCP/IP
-packages (and of course DECNET) for reading NEWS. Support for other packages
-can be added if I can find sites willing to beta test the interface for me.
-The source for the TCP interface is in C rather than FORTRAN because the
-MULTINET include files are in C. However, if you do not have C, I will be glad
-to send the object for it (or to even possibly rewrite the code in FORTRAN).
-
-The instructions for installation are as follows. Define BULL_NEWS_SERVER
-to be a system logical name pointing to either your internet or decnet NEWS
-node. If it is decnet, simply specify the decnet node name, i.e.
-
- $ DEFINE/SYSTEM BULL_NEWS_SERVER NERUS
-
-BULLETIN decides to use DECNET rather than TCP access based on the node name.
-If it does not have any periods in it, then it assumes it is a DECNET node.
-
-In our cluster, we usually have one node which is an internet node, and the
-rest non-internet nodes. If you have a similar situation, you'll have to
-create a startup procedure that defines BULL_NEWS_SERVER to be the internet
-news server address only on the node (or nodes) on the cluster that have
-actually internet access. The other nodes will have BULL_NEWS_SERVER defined
-as the decnet node name that BULLCP is running on in the cluster. (Of course,
-BULLCP will have to be running on a node with internet access.)
-
-NOTE: If you want to disable the gateway feature, then before starting BULLCP,
-define the logical name:
-
- $ DEFINE/SYSTEM BULL_NO_NEWS_GATEWAY "TRUE"
-
-Defining this will only shut off the gateway. BULLETIN will still be allowed
-to read NEWS from the local node as long as BULL_NEWS_SERVER is defined.
-
-You can also specify that BULLCP is only to act as a NEWS gateway. This is to
-allow adding the news gateway to an INTERNET site that you have DECNET access
-to, but which does not want to make use of any of the other BULLETIN features.
-You would specify the following command before starting BULLCP:
-
- $ DEFINE/SYSTEM BULL_NEWS_GATEWAY_ONLY "TRUE"
-
-In order to post messages, BULLETIN needs to know the internet nodename of
-the local host. This is done automatically for nodes running MULTINET. For
-other nodes, BULLETIN attempts to translate the logical name ARPANET_HOST_NAME,
-INTERNET_HOST_NAME, and MX_NODE_NAME. If you are on a DECNET node that is not
-on INTERNET (and is not part of a cluster which has an INTERNET address), but
-you are accessing NEWS via DECNET, you can specify the hostname as follows:
-
- $ DEFINE/SYSTEM INTERNET_HOST_NAME "%localhost@internet-address"
-
-Where "localhost" is your local decnet hostname, and "internet-address" is the
-internet address of the gateway node.
-
-The local time zone is detected by looking at the following logical names:
-LISP$TIME_ZONE, MULTINET_TIMEZONE, or PMDF_TIMEZONE. (LISP$TIME_ZONE is
-defined if you have LISP installed.)
-
-The name of the organization is included in the header of the NEWS message.
-This can be anything, but usually is the company or university name. This
-can be hardcoded into the source by putting in BULLNEWS.INC, or by defining
-the system logical name BULL_NEWS_ORGANIZATION.
-
-The name of the mail protocol to use for responding by mail to NEWS messages
-can also be either hardcoded by putting in BULLNEWS.INC, or by defining the
-system logical name BULL_NEWS_MAILER.
-
-After installing the new BULLETIN, execute the command NEWS, which asks for a
-list of all the news groups. Because this is the first time it is executed, it
-will cause a load of all the remote news groups into a local data base
-(BULL_DIR:BULLNEWS.DAT). This will take several minutes to do. It is the only
-time that this load will be done interactively. Afterwards, BULLCP will
-periodically update the data base. For this reason, it is highly recommeded
-that BULLCP be installed. BULLCP will update NEWS every hour. If you want to
-change this frequency, define the logical name BULL_NEWS_UPDATE to the number
-of minutes in between updates, i.e. DEFINE/SYSTEM BULL_NEWS_UPDATE "30" for 30
-minutes. NOTE: BULLCP will create a subprocess BULLCP NEWS which does the
-update. You can watch how long it takes for this to run in order to determine
-if you want to change the update period). After BULLNEWS.DAT is created, it is
-suggested that you run OPTIMIZE_RMS.COM on it, as it will cause the file to be
-compressed and will allow updates to run much faster (factor of 5 or more).
-
-WARNING: One user discovered that his server (using bnews?) had a bug which
-caused the updates to cause bogus "new messages" notifications for subscribed
-NEWS group when entering BULLETIN. If you experience this problem, try
-defining the system logical name BULL_SPECIAL_NEWS_UPDATE. This will cause
-the update to use a different algorithm which should eliminate the problem,
-although it requires much more time to execute.
-
-It is possible to automatically have news messages to be fed into a real
-folder. Place the name of the news group into the folder description surrounded
-by <>, i.e. <misc.test>. It must be in lower case. (Other text is allowed in
-the description, i.e. "THIS IS A TEST FOLDER <misc.test>".) When the POST and
-ADD commands are used with this folder, the messages will be posted to the news
-group, rather than actually being added to the folder. If you want several
-news groups to be fed to the same folder, create a file with each group on a
-separate line in the file, and then specify the filename inside the <> preceded
-by @, i.e. <@SYS$MANAGER:TEST.FIL>. However, with a multiple feed, POSTs will
-not work.
-
-If you have any problems or questions, please let me know.
- MRL
-P.s.
- If you do not know what USENET NEWS, it's basically news messages which
-are passed between nodes. Originally it was limited to USENET, but that is no
-longer the case. Unlike internet mailing lists which use MAIL to send the
-messages to individuals, NEWS messages are not sent via MAIL. They are passed
-between nodes using a special protocol, NNTP. Users must use a NEWS reader
-package to read them. However, it is possible to read NEWS remotely over a
-network, and therefore avoiding having to actually store the messages.
-BULLETIN is setup to be used mainly in this client mode, i.e. it can read
-messages on another node via TCP or DECNET. This is useful, since the number
-of NEWS groups total over 1000, the disk space required for storage is very
-high. If you are interested in finding a server node that would allow you to
-read NEWS, and do not know of one (i.e. a USENET node), I know of no official
-way of doing so. However, one suggestion was to try connecting to BBN.COM via
-ANONYMOUS FTP and look through the directory uumap/comp.mail.maps to find a
-USENET node near you to contact.
-$eod
-$copy/log sys$input NONSYSTEM.TXT
-$deck
-Non-system bulletins (such as this) can be submitted by any user. Users are
-alerted at login time that new non-system bulletins have been added, but only
-their topics are listed. Optionally, users can be prompted at login time to
-see if they wish to read the bulletins. When reading the bulletins in this
-manner, the bulletins can optionally be written to a file. If you have the
-subdirectory [.BULL] created, BULLETIN will use that directory as the default
-directory to write the file into.
-
-A user can disable this prompting featuring by using BULLETIN as follows:
-
-$ BULLETIN
-BULLETIN> SET NOREADNEW
-BULLETIN> EXIT
-
-Afterwords, the user will only be alerted of the bulletins, and will have to
-use the BULLETIN utility in order to read the messages.
-$eod
-$copy/log sys$input WRITEMSG.TXT
-$deck
-BULLETIN contains subroutines for writing a message directly to a folder. This
-would be useful for someone who is using the BBOARD feature, but wants to avoid
-the extra overhead of having the message sent to an account as MAIL, and then
-have BULLCP read the mail. It is better if the network mail could be written
-directly to the folder bypassing VMS MAIL, as it reduces a lot of cpu overhead.
-
-Call INIT_MESSAGE_ADD to initiate a message addition.
-Call WRITE_MESSAGE_LINE to write individual message lines.
-Call FINISH_MESSAGE_ADD to complete a message addition.
-
-Calling formats:
-
- CALL INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER)
-C
-C INPUTS:
-C IN_FOLDER - Character string containing folder name
-C IN_FROM - Character string containing name of owner of message.
-C If empty, the default is the owner of the process.
-C IN_DESCRIP - Character string containing subject of message.
-C If empty, the message is searched for a line
-C which starts with "Subj:" or "Subject:".
-C OUTPUTS:
-C IER - Error status. True if properly connected to folder.
-C False if folder not found.
-C
-
- CALL WRITE_MESSAGE_LINE(BUFFER)
-C
-C INPUTS:
-C BUFFER - Character string containing line to be put into message.
-C
-
- CALL FINISH_MESSAGE_ADD
-C
-C NOTE: Only should be run if INIT_MESSAGE_ADD was successful.
-C
-$eod
diff --git a/decus/vax91b/bulletin-net91b/bullet2.com b/decus/vax91b/bulletin-net91b/bullet2.com
deleted file mode 100644
index a08ced43e08bf4260950668638340c48650d9f16..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bullet2.com
+++ /dev/null
@@ -1,1599 +0,0 @@
-$set nover
-$copy/log sys$input BOARD_DIGEST.COM
-$deck
-$!
-$! BOARD_DIGEST.COM
-$!
-$! Command file invoked by folder associated with a BBOARD which is
-$! is specified with /SPECIAL. It will convert "digest" mail and
-$! split it into separate messages. This type of mail is used in
-$! certain Arpanet mailing lists, such as TEXHAX and INFO-MAC.
-$!
-$ FF[0,8] = 12 ! Define a form feed character
-$ SET PROTECT=(W:RWED)/DEFAULT
-$ SET PROC/PRIV=SYSPRV
-$ USER := 'F$GETJPI("","USERNAME")
-$ EXTRACT_FILE = "BULL_DIR:" + "''USER'" + ".TXT"
-$ DEFINE/USER EXTRACT_FILE BULL_DIR:'USER'
-$ MAIL
-READ
-EXTRACT EXTRACT_FILE
-DELETE
-$ OPEN/READ INPUT 'EXTRACT_FILE'
-$ OPEN/WRITE OUTPUT 'EXTRACT_FILE'
-$ READ INPUT FROM_USER
-$AGAIN:
-$ READ/END=ERROR INPUT BUFFER
-$ IF F$EXTRACT(0,3,BUFFER) .NES. "To:" THEN GOTO SKIP
-$ USER = F$EXTRACT(4,F$LEN(BUFFER),BUFFER)
-$ GOTO AGAIN1
-$SKIP:
-$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN
-$AGAIN1:
-$ READ/END=ERROR INPUT BUFFER
-$ IF F$EXTRACT(0,15,BUFFER) .NES. "---------------" THEN GOTO AGAIN1
-$ FROM = " "
-$ SUBJ = " "
-$NEXT:
-$ READ/END=EXIT INPUT BUFFER
-$FROM:
-$ IF F$EXTRACT(0,5,BUFFER) .NES. "From:" THEN GOTO SUBJECT
-$ FROM = BUFFER
-$ GOTO NEXT
-$SUBJECT:
-$ IF F$EXTRACT(0,8,BUFFER) .NES. "Subject:" THEN GOTO NEXT
-$ SUBJ = BUFFER - "Subject:"
-$F2:
-$ IF F$LENGTH(SUBJ) .EQ. 0 THEN GOTO WRITE
-$ IF F$EXTRACT(0,1,SUBJ) .NES. " " THEN GOTO WRITE
-$ SUBJ = F$EXTRACT(1,F$LENGTH(SUBJ),SUBJ)
-$ GOTO F2
-$WRITE:
-$ WRITE OUTPUT FROM_USER
- ! Write From: + TAB + USERNAME
-$ WRITE OUTPUT "To: " + USER
- ! Write To: + TAB + BBOARDUSERNAME
-$ WRITE OUTPUT "Subj: " + SUBJ
- ! Write Subject: + TAB + mail subject
-$ WRITE OUTPUT "" ! Write one blank line
-$ IF FROM .NES. " " THEN WRITE OUTPUT FROM
-$READ:
-$ READ/END=EXIT/ERR=EXIT INPUT BUFFER
-$ IF F$EXTRACT(0,15,BUFFER) .EQS. "---------------" THEN GOTO READ1
-$ WRITE OUTPUT BUFFER
-$ GOTO READ
-$READ1:
-$ READ/END=EXIT/ERR=EXIT INPUT BUFFER
-$ IF F$LOCATE(":",BUFFER) .EQ. F$LENGTH(BUFFER) THEN GOTO READ1
-$ WRITE OUTPUT FF
-$ FROM = " "
-$ SUBJ = " "
-$ GOTO FROM
-$EXIT:
-$ CLOSE INPUT
-$ CLOSE OUTPUT
-$ PUR 'EXTRACT_FILE'
-$ EXIT
-$ERROR:
-$ CLOSE INPUT
-$ CLOSE OUTPUT
-$ DELETE 'EXTRACT_FILE';
-$eod
-$copy/log sys$input BOARD_SPECIAL.COM
-$deck
-$!
-$! BOARD_SPECIAL.COM
-$!
-$! Command file invoked by folder associated with a BBOARD which is
-$! is specified with /SPECIAL. This can be used to convert data to
-$! a message via a different means than the VMS mail. This is done by
-$! converting the data to look like output created by the MAIL utility,
-$! which appears as follows:
-$!
-$! First line is 0 length line.
-$! Second line is "From:" followed by TAB followed by incoming username
-$! Third line is "To:" followed by TAB followed by BBOARD username
-$! Fourth line is "Subj:" followed by TAB followed by subject
-$! The message text then follows.
-$! Message is ended by a line containing a FORM FEED.
-$!
-$! This command file should be put in the BBOARD_DIRECTORY as specified
-$! in BULLFILES.INC. You can also have several different types of special
-$! procedures. To accomplish this, rename the file to the BBOARD username.
-$! i.e. if you specify SET BBOARD FOO/SPECIAL, you could name the file
-$! FOO.COM and it will execute that rather than BOARD_SPECIAL.COM.
-$!
-$! The following routine is the one we use to convert mail from a non-DEC
-$! mail network. The output from this mail is written into a file which
-$! is slightly different from the type outputted by MAIL.
-$!
-$! (NOTE: A username in the SET BBOARD command need only be specified if
-$! the process which reads the mail requires that the process be owned by
-$! a specific user, which is the case for this sample, and for that matter
-$! when reading VMS MAIL. If this is not required, you do not have to
-$! specify a username.)
-$!
-$ USERNAME := 'F$GETJPI("","USERNAME")' ! This trims trailing spaces
-$ IF F$SEARCH("MFE_TELL_FILES:"+USERNAME+".MAI") .EQS. "" THEN EXIT
-$ SET DEFAULT BULL_DIR: ! BULLETIN looks for text in BBOARD directory
-$ SET PROTECT=(W:RWED)/DEFAULT
-$ IF F$SEARCH("MFEMSG.MAI") .NES. "" THEN -
- DELETE MFEMSG.MAI;* ! Delete any leftover output files.
-$ MSG := $MFE_TELL: MESSAGE
-$ DEFINE/USER SYS$COMMAND SYS$INPUT
-$ MSG ! Read MFENET mail
-copy * MFEMSG
-delete *
-exit
-$ FF[0,8] = 12 ! Define a form feed character
-$ OPEN/READ/ERROR=EXIT INPUT MFEMSG.MAI
-$ OUTNAME = USERNAME+".TXT" ! Output file will be 'USERNAME'.TXT
-$ OPEN/WRITE OUTPUT 'OUTNAME'
-$ READ/END=END INPUT DATA ! Skip first line in MSG output
-$HEADER:
-$ FROM = ""
-$ SUBJ = ""
-$ MFEMAIL = "T"
-$NEXTHEADER:
-$ IF (FROM.NES."") .AND. (SUBJ.NES."") THEN GOTO SKIPHEADER
-$ READ/END=END INPUT DATA ! Read header line in MSG output
-$ IF DATA .EQS. "" THEN GOTO SKIPHEADER ! Missing From or Subj ??
-$ IF FROM .NES. "" THEN GOTO SKIPFROM
-$ IF F$LOCATE("From: ",DATA) .NES. 0 THEN GOTO 10$
-$ MFEMAIL = "F"
-$ FROM= F$EXTRACT(6,F$LENGTH(DATA),DATA)
-$ GOTO NEXTHEADER
-$10$:
-$ IF F$LOCATE("Reply-to: ",DATA) .NES. 0 THEN GOTO 20$
-$ MFEMAIL = "F"
-$ FROM= F$EXTRACT(10,F$LENGTH(DATA),DATA)
-$ GOTO NEXTHEADER
-$20$:
-$ IF F$LOCATE("From ",DATA) .NES. 0 THEN GOTO SKIPFROM
-$ FROM= F$EXTRACT(5,F$LENGTH(DATA),DATA)
-$ GOTO NEXTHEADER
-$SKIPFROM:
-$ IF SUBJ .NES. "" THEN GOTO SKIPSUBJ
-$ IF F$LOCATE("Subject",DATA) .NES. 0 THEN GOTO SKIPSUBJ
-$ SUBJ= F$EXTRACT(F$LOCATE(": ",DATA)+2,F$LENGTH(DATA),DATA)
-$ GOTO NEXTHEADER
-$SKIPSUBJ:
-$ GOTO NEXTHEADER
-$SKIPHEADER:
-$ WRITE OUTPUT "From: " + FROM
- ! Write From: + TAB + USERNAME
-$ WRITE OUTPUT "To: " + USERNAME
- ! Write To: + TAB + BBOARDUSERNAME
-$ WRITE OUTPUT "Subj: " + SUBJ
- ! Write Subject: + TAB + mail subject
-$ WRITE OUTPUT "" ! Write one blank line
-$ IF (DATA.EQS."") .OR. MFEMAIL THEN GOTO SKIPBLANKS
-$50$:
-$ READ/END=END INPUT DATA ! Skip rest of main header
-$ IF DATA .NES. "" THEN GOTO 50$
-$60$:
-$ READ/END=END INPUT DATA ! Skip all of secondary header
-$ IF DATA .NES. "" THEN GOTO 60$
-$SKIPBLANKS:
-$ READ/END=END INPUT DATA ! Skip all blanks
-$ IF DATA .EQS. "" THEN GOTO SKIPBLANKS
-$NEXT: ! Read and write message text
-$ WRITE OUTPUT DATA
-$ IF DATA .EQS. FF THEN GOTO HEADER
- ! Multiple messages are seperated by form feeds
-$ READ/END=END INPUT DATA
-$ GOTO NEXT
-$END:
-$ CLOSE INPUT
-$ CLOSE OUTPUT
-$ DELETE MFEMSG.MAI;
-$EXIT:
-$ EXIT
-$eod
-$copy/log sys$input BULLCOM.CLD
-$deck
-!
-! BULLCOM.CLD
-!
-! VERSION 8/20/91
-!
- MODULE BULLETIN_SUBCOMMANDS
-
- DEFINE VERB ADD
- PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)
- QUALIFIER ALL, NONNEGATABLE
- QUALIFIER BELL, NONNEGATABLE
- QUALIFIER BROADCAST, NONNEGATABLE
- DISALLOW NOT BROADCAST AND ALL
- DISALLOW NOT BROADCAST AND BELL
- QUALIFIER CC, VALUE(LIST,REQUIRED)
- QUALIFIER CLUSTER, DEFAULT
- QUALIFIER EDIT, NEGATABLE
- QUALIFIER EXPIRATION, NONNEGATABLE, VALUE
- QUALIFIER EXTRACT, NONNEGATABLE
- QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)
- QUALIFIER GROUPS, VALUE(LIST,REQUIRED)
- QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST)
- NONNEGATABLE
- QUALIFIER LIST,DEFAULT
- QUALIFIER LOCAL, NONNEGATABLE
- DISALLOW LOCAL AND NOT BROADCAST
- DISALLOW NODES AND SELECT_FOLDER
- QUALIFIER NOINDENT, NONNEGATABLE
- DISALLOW NOINDENT AND NOT EXTRACT
- QUALIFIER PERMANENT, NONNEGATABLE
- QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE
- DISALLOW PERMANENT AND SHUTDOWN
- QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED)
- QUALIFIER SYSTEM, NONNEGATABLE
- DEFINE VERB ATTACH
- PARAMETER P1, LABEL=PROCESS, VALUE(TYPE=$FILE)
- QUALIFIER PARENT
- DISALLOW NOT PARENT AND NOT PROCESS
- DISALLOW PARENT AND PROCESS
- DEFINE VERB BACK
- QUALIFIER EDIT, NEGATABLE
- QUALIFIER HEADER
- DEFINE VERB CHANGE
- PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)
- QUALIFIER ALL
- QUALIFIER EDIT, NEGATABLE
- QUALIFIER EXPIRATION, NONNEGATABLE, VALUE
- QUALIFIER GENERAL, NONNEGATABLE
- QUALIFIER HEADER, NONNEGATABLE
- QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED)
- QUALIFIER NEW,NONNEGATABLE
- QUALIFIER NUMBER, VALUE(TYPE=$FILE,REQUIRED)
- QUALIFIER PERMANENT, NONNEGATABLE
- QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE
- QUALIFIER SYSTEM,NONNEGATABLE
- QUALIFIER TEXT, NONNEGATABLE
- DISALLOW ALL AND NUMBER
- DISALLOW NEW AND NOT EDIT
- DISALLOW SYSTEM AND GENERAL
- DISALLOW PERMANENT AND SHUTDOWN
- DISALLOW PERMANENT AND EXPIRATION
- DISALLOW SHUTDOWN AND EXPIRATION
- DISALLOW SUBJECT AND HEADER
- DEFINE VERB COPY
- PARAMETER P1, LABEL=FOLDER, PROMPT="Folder"
- VALUE(REQUIRED)
- PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE)
- QUALIFIER GROUPS, VALUE(LIST,REQUIRED)
- QUALIFIER HEADER
- QUALIFIER ALL
- QUALIFIER MERGE
- QUALIFIER ORIGINAL
- DISALLOW ALL AND BULLETIN_NUMBER
- DEFINE VERB CREATE
- QUALIFIER ALWAYS, NONNEGATABLE
- QUALIFIER BRIEF, NONNEGATABLE
- QUALIFIER DESCRIPTION, NONNEGATABLE, VALUE(REQUIRED)
- QUALIFIER ID, NONNEGATABLE
-!
-! Make the following qualifier DEFAULT if you want CREATE to be
-! a privileged command. NOTE: Make sure that BULL_DIR:BULLUSER.DAT
-! has the following protection: (RWED,RWED,,)
-!
- QUALIFIER NEEDPRIV, NONNEGATABLE
- QUALIFIER NODE, NONNEGATABLE, VALUE(REQUIRED)
- QUALIFIER NOTIFY, NONNEGATABLE
- QUALIFIER OWNER, NONNEGATABLE, VALUE(REQUIRED)
- QUALIFIER PRIVATE, NONNEGATABLE
- QUALIFIER READNEW, NONNEGATABLE
- QUALIFIER REMOTENAME, NONNEGATABLE, VALUE(REQUIRED)
- QUALIFIER SEMIPRIVATE, NONNEGATABLE
- QUALIFIER SHOWNEW, NONNEGATABLE
- QUALIFIER SYSTEM, NONNEGATABLE
- PARAMETER P1, LABEL=CREATE_FOLDER, PROMPT="Folder"
- VALUE(REQUIRED)
- DISALLOW ID AND NOT OWNER
- DISALLOW PRIVATE AND SEMIPRIVATE
- DISALLOW BRIEF AND READNEW
- DISALLOW SHOWNEW AND READNEW
- DISALLOW BRIEF AND SHOWNEW
- DISALLOW NODE AND (NOTIFY OR PRIVATE OR SEMIPRIVATE)
- DISALLOW REMOTENAME AND NOT NODE
- DEFINE VERB CURRENT
- QUALIFIER EDIT
- QUALIFIER HEADER
- DEFINE VERB DELETE
- PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE)
- QUALIFIER ALL
- QUALIFIER IMMEDIATE,NONNEGATABLE
- QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)
- QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST)
- QUALIFIER SUBJECT, VALUE(REQUIRED)
- DISALLOW NOT SUBJECT AND (NODES OR SELECT_FOLDER)
- DISALLOW NODES AND SELECT_FOLDER
- DEFINE VERB DIRECTORY
- PARAMETER P1, LABEL=SELECT_FOLDER
- QUALIFIER ALL
- QUALIFIER NEWS, SYNTAX=DIRECTORY_NEWS, NONNEGATABLE
- QUALIFIER END, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE
- QUALIFIER EXPIRATION
- QUALIFIER FO, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE
- QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE
- QUALIFIER NEW
- QUALIFIER PRINT
- QUALIFIER HEADER, DEFAULT
- QUALIFIER NOTIFY, DEFAULT
- QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE
- QUALIFIER FORM, VALUE, NONNEGATABLE
- QUALIFIER NOW
- QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE
- QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)
- QUALIFIER MARKED, NONNEGATABLE
- QUALIFIER UNMARKED, NONNEGATABLE
- QUALIFIER REPLY, NONNEGATABLE
- QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE
- QUALIFIER SEEN, NONNEGATABLE
- QUALIFIER UNSEEN, NONNEGATABLE
- QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE
- DISALLOW (SUBJECT AND SEARCH) OR (SEARCH AND REPLY)
- DISALLOW REPLY AND SUBJECT
- DISALLOW (REPLY OR SUBJECT OR SEARCH) AND
- (MARKED OR SEEN OR UNMARKED OR UNSEEN)
- DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR
- (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN)
- DISALLOW ALL AND (MARKED OR SEEN OR UNMARKED OR UNSEEN)
- DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE)
- DEFINE SYNTAX DIRECTORY_NEWS
- PARAMETER P1, LABEL=MATCH_FOLDER
- QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE
- QUALIFIER NEWS, DEFAULT, NONNEGATABLE
- QUALIFIER SUBSCRIBE
- QUALIFIER FOLDER
- QUALIFIER NEWGROUPS
- DISALLOW NEWGROUPS AND (SUBSCRIBE OR START)
- DEFINE SYNTAX DIRECTORY_FOLDER
- PARAMETER P1, LABEL=MATCH_FOLDER
- QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE
- QUALIFIER DESCRIBE
- QUALIFIER FOLDER, DEFAULT
- QUALIFIER NEWS, NONNEGATABLE
- DEFINE VERB E ! EXIT command.
- DEFINE VERB EX ! EXIT command.
- DEFINE VERB EXIT ! EXIT command.
- DEFINE VERB EXTRACT
- PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED),
- PROMPT="File"
- PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE)
- QUALIFIER ALL
- QUALIFIER FF
- QUALIFIER HEADER, DEFAULT
- QUALIFIER NEW, NONNEGATABLE
- DISALLOW ALL AND BULLETIN_NUMBER
- DEFINE VERB FILE
- PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE,REQUIRED),
- PROMPT="File"
- PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE)
- QUALIFIER ALL
- QUALIFIER FF
- QUALIFIER HEADER, DEFAULT
- QUALIFIER NEW, NONNEGATABLE
- DISALLOW ALL AND BULLETIN_NUMBER
- DEFINE VERB FIRST
- QUALIFIER EDIT, NEGATABLE
- QUALIFIER HEADER
- DEFINE VERB FORWARD
- PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients"
- VALUE(REQUIRED,IMPCAT,LIST)
- QUALIFIER EDIT, NONNEGATABLE
- QUALIFIER HEADER, DEFAULT
- QUALIFIER SUBJECT, VALUE(REQUIRED)
- DEFINE VERB HELP
- PARAMETER P1, LABEL=HELP_FOLDER, VALUE(TYPE=$REST_OF_LINE)
- DEFINE VERB INDEX
- PARAMETER P1, LABEL=SELECT_FOLDER
- QUALIFIER EXPIRATION
- QUALIFIER MARKED, NONNEGATABLE
- QUALIFIER UNMARKED, NONNEGATABLE
- QUALIFIER FOLDER, SYNTAX=DIRECTORY_FOLDER, NONNEGATABLE
- QUALIFIER NEW
- QUALIFIER REPLY, NONNEGATABLE
- QUALIFIER RESTART
- QUALIFIER SEARCH, VALUE(REQUIRED), NONNEGATABLE
- QUALIFIER SEEN, NONNEGATABLE
- QUALIFIER UNSEEN, NONNEGATABLE
- QUALIFIER SUBSCRIBE
- QUALIFIER SUBJECT, VALUE(REQUIRED), NONNEGATABLE
- QUALIFIER START, VALUE(REQUIRED,TYPE=$NUMBER), NONNEGATABLE
- QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)
- DISALLOW (NEW AND SINCE) OR (START AND NEW) OR (START AND SINCE)
- DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR
- (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN)
- DEFINE VERB LAST
- QUALIFIER EDIT, NEGATABLE
- QUALIFIER HEADER
- DEFINE VERB MAIL
- PARAMETER P1, LABEL=RECIPIENTS, PROMPT="Recipients"
- VALUE(REQUIRED,IMPCAT,LIST)
- QUALIFIER EDIT, NONNEGATABLE
- QUALIFIER HEADER, DEFAULT
- QUALIFIER SUBJECT, VALUE(REQUIRED)
- DEFINE VERB MARK
- PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST)
- DEFINE VERB MODIFY
- QUALIFIER DESCRIPTION
- QUALIFIER ID, NONNEGATABLE
- QUALIFIER NAME, VALUE(REQUIRED)
- QUALIFIER OWNER, VALUE(REQUIRED)
- DISALLOW ID AND NOT OWNER
- DEFINE VERB MOVE
- PARAMETER P1, LABEL=FOLDER, PROMPT="Folder"
- VALUE(REQUIRED)
- PARAMETER P2, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE)
- QUALIFIER ALL
- QUALIFIER GROUPS, VALUE(LIST,REQUIRED)
- QUALIFIER HEADER
- QUALIFIER MERGE
- QUALIFIER NODES
- QUALIFIER ORIGINAL
- QUALIFIER IMMEDIATE,NONNEGATABLE,DEFAULT
- DISALLOW ALL AND BULLETIN_NUMBER
- DISALLOW FOLDER AND NODES
- DEFINE VERB NEWS
- PARAMETER P1, LABEL=MATCH_FOLDER
- QUALIFIER NEWS, DEFAULT, NONNEGATABLE
- QUALIFIER START, VALUE(REQUIRED), NONNEGATABLE
- QUALIFIER SUBSCRIBE
- QUALIFIER NEWGROUPS
- DISALLOW NEWGROUPS AND (SUBSCRIBE OR START)
- DEFINE VERB N
- QUALIFIER EDIT, NEGATABLE
- DEFINE VERB NEXT
- QUALIFIER EDIT, NEGATABLE
- DEFINE VERB POST
- PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)
- QUALIFIER CC, VALUE(LIST,REQUIRED)
- QUALIFIER EXTRACT
- QUALIFIER GROUPS, VALUE(LIST,REQUIRED)
- QUALIFIER LIST, DEFAULT
- QUALIFIER SUBJECT, VALUE(REQUIRED)
- QUALIFIER NOINDENT, NONNEGATABLE
- DISALLOW NOINDENT AND NOT EXTRACT
- QUALIFIER EDIT
- DEFINE VERB PRINT
- PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE)
- QUALIFIER HEADER, DEFAULT
- QUALIFIER NOTIFY, DEFAULT
- QUALIFIER QUEUE, VALUE(DEFAULT=SYS$PRINT), NONNEGATABLE
- QUALIFIER FORM, VALUE, NONNEGATABLE
- QUALIFIER NOW
- QUALIFIER ALL
- DISALLOW ALL AND BULLETIN_NUMBER
- DEFINE VERB QUIT
- DEFINE VERB READ
- PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$NUMBER)
- QUALIFIER ALL
- QUALIFIER EDIT
- QUALIFIER HEADER
- QUALIFIER MARKED, NONNEGATABLE
- QUALIFIER UNMARKED, NONNEGATABLE
- QUALIFIER NEW
- QUALIFIER PAGE, DEFAULT
- QUALIFIER SEEN, NONNEGATABLE
- QUALIFIER UNSEEN, NONNEGATABLE
- QUALIFIER SINCE,VALUE(DEFAULT="TODAY",TYPE=$DATETIME)
- DISALLOW NEW AND SINCE
- DISALLOW BULLETIN_NUMBER AND (ALL OR NEW OR SINCE)
- DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR
- (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN)
- DEFINE VERB REPLY
- PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)
- QUALIFIER ALL, NONNEGATABLE
- QUALIFIER BELL, NONNEGATABLE
- QUALIFIER BROADCAST, NONNEGATABLE
- DISALLOW NOT BROADCAST AND ALL
- DISALLOW NOT BROADCAST AND BELL
- QUALIFIER CC, VALUE(LIST,REQUIRED)
- QUALIFIER CLUSTER, DEFAULT
- QUALIFIER EDIT, NEGATABLE
- QUALIFIER EXPIRATION, NONNEGATABLE, VALUE
- QUALIFIER EXTRACT, NONNEGATABLE
- QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)
- QUALIFIER GROUPS, VALUE(LIST,REQUIRED)
- QUALIFIER LIST,DEFAULT
- QUALIFIER LOCAL
- QUALIFIER NODES, LABEL=NODES, VALUE(REQUIRED,LIST)
- NONNEGATABLE
- DISALLOW LOCAL AND NOT BROADCAST
- DISALLOW NODES AND SELECT_FOLDER
- QUALIFIER NOINDENT, NONNEGATABLE
- DISALLOW NOINDENT AND NOT EXTRACT
- QUALIFIER PERMANENT, NONNEGATABLE
- QUALIFIER SHUTDOWN, NONNEGATABLE, VALUE
- DISALLOW PERMANENT AND SHUTDOWN
- QUALIFIER SUBJECT, NONNEGATABLE, VALUE(REQUIRED)
- QUALIFIER SYSTEM, NONNEGATABLE
- DEFINE VERB REMOVE
- PARAMETER P1, LABEL=REMOVE_FOLDER, PROMPT="Folder"
- VALUE(REQUIRED)
- DEFINE VERB RESPOND
- PARAMETER P1, LABEL=FILESPEC, VALUE(TYPE=$FILE)
- QUALIFIER CC, VALUE(LIST,REQUIRED)
- QUALIFIER EXTRACT
- QUALIFIER GROUPS, VALUE(LIST,REQUIRED)
- QUALIFIER LIST
- QUALIFIER SUBJECT, VALUE(REQUIRED)
- QUALIFIER NOINDENT, NONNEGATABLE
- DISALLOW NOINDENT AND NOT EXTRACT
- DISALLOW GROUPS AND NOT LIST
- QUALIFIER EDIT
- DEFINE VERB SEARCH
- PARAMETER P1, LABEL=SEARCH_STRING
- QUALIFIER EDIT
- QUALIFIER FOLDER, LABEL=SELECT_FOLDER, VALUE(REQUIRED,LIST)
- QUALIFIER START, VALUE(TYPE=$NUMBER,REQUIRED)
- QUALIFIER REPLY, NONNEGATABLE
- QUALIFIER REVERSE
- QUALIFIER SUBJECT
- DISALLOW SEARCH_STRING AND REPLY
- DEFINE VERB SEEN
- PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST)
- QUALIFIER READ
- DISALLOW (NUMBER AND (NEG READ OR READ))
- DEFINE VERB SELECT
- PARAMETER P1, LABEL=SELECT_FOLDER
- QUALIFIER MARKED, NONNEGATABLE
- QUALIFIER UNMARKED, NONNEGATABLE
- QUALIFIER SEEN, NONNEGATABLE
- QUALIFIER UNSEEN, NONNEGATABLE
- DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR
- (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN)
- DEFINE VERB SET
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- QUALIFIER ID
- DEFINE TYPE SET_OPTIONS
- KEYWORD NODE, SYNTAX=SET_NODE
- KEYWORD NONODE, SYNTAX = SET_NONODE
- KEYWORD EXPIRE_LIMIT, SYNTAX=SET_EXPIRE
- KEYWORD NOEXPIRE_LIMIT
- KEYWORD GENERIC, SYNTAX=SET_GENERIC
- KEYWORD NOGENERIC, SYNTAX=SET_GENERIC
- KEYWORD LOGIN, SYNTAX=SET_LOGIN
- KEYWORD NOLOGIN, SYNTAX=SET_LOGIN
- KEYWORD NOBBOARD
- KEYWORD BBOARD, SYNTAX=SET_BBOARD
- KEYWORD NOBRIEF, SYNTAX=SET_NOFLAGS
- KEYWORD BRIEF, SYNTAX=SET_FLAGS
- KEYWORD NOSHOWNEW, SYNTAX=SET_NOFLAGS
- KEYWORD SHOWNEW, SYNTAX=SET_FLAGS
- KEYWORD NOREADNEW, SYNTAX=SET_NOFLAGS
- KEYWORD READNEW, SYNTAX=SET_FLAGS
- KEYWORD ACCESS, SYNTAX=SET_ACCESS
- KEYWORD NOACCESS, SYNTAX=SET_NOACCESS
- KEYWORD FOLDER, SYNTAX=SET_FOLDER
- KEYWORD NOTIFY, SYNTAX=SET_FLAGS
- KEYWORD NONOTIFY, SYNTAX=SET_NOFLAGS
- KEYWORD PRIVILEGES, SYNTAX=SET_PRIVILEGES
- KEYWORD DUMP
- KEYWORD NODUMP
- KEYWORD PAGE
- KEYWORD NOPAGE
- KEYWORD SYSTEM
- KEYWORD NOSYSTEM
- KEYWORD KEYPAD
- KEYWORD NOKEYPAD
- KEYWORD PROMPT_EXPIRE
- KEYWORD NOPROMPT_EXPIRE
- KEYWORD DEFAULT_EXPIRE, SYNTAX=SET_DEFAULT_EXPIRE
- KEYWORD STRIP
- KEYWORD NOSTRIP
- KEYWORD DIGEST
- KEYWORD NODIGEST
- KEYWORD CONTINUOUS_BRIEF
- KEYWORD NOCONTINUOUS_BRIEF
- KEYWORD ALWAYS
- KEYWORD NOALWAYS
- DEFINE SYNTAX SET_NODE
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=NODENAME, VALUE(REQUIRED)
- PARAMETER P3, LABEL=REMOTENAME
- QUALIFIER FOLDER, VALUE(REQUIRED)
- DEFINE SYNTAX SET_NONODE
- QUALIFIER FOLDER, VALUE(REQUIRED)
- DEFINE SYNTAX SET_EXPIRE
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=EXPIRATION, VALUE(TYPE=$NUMBER,REQUIRED)
- DEFINE SYNTAX SET_GENERIC
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)
- QUALIFIER DAYS,VALUE(TYPE=$NUMBER,DEFAULT="7"),DEFAULT
- DEFINE SYNTAX SET_LOGIN
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=USERNAME, VALUE(REQUIRED)
- DEFINE SYNTAX SET_FLAGS
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- QUALIFIER DEFAULT, NONNEGATABLE
- QUALIFIER ALL, NONNEGATABLE
- QUALIFIER PERMANENT
- QUALIFIER NOPERMANENT
- QUALIFIER FOLDER, VALUE(REQUIRED)
- DEFINE SYNTAX SET_NOFLAGS
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- QUALIFIER DEFAULT, NONNEGATABLE
- QUALIFIER PERMANENT
- QUALIFIER NOPERMANENT
- QUALIFIER ALL, NONNEGATABLE
- QUALIFIER FOLDER, VALUE(REQUIRED)
- DEFINE SYNTAX SET_BBOARD
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=BB_USERNAME
- QUALIFIER EXPIRATION, VALUE(TYPE=$NUMBER)
- LABEL=EXPIRATION, DEFAULT
- QUALIFIER SPECIAL, NONNEGATABLE
- QUALIFIER VMSMAIL, NONNEGATABLE
- DISALLOW VMSMAIL AND NOT SPECIAL
- DISALLOW VMSMAIL AND NOT BB_USERNAME
- DEFINE SYNTAX SET_FOLDER
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=SELECT_FOLDER
- QUALIFIER MARKED, NONNEGATABLE
- QUALIFIER UNMARKED, NONNEGATABLE
- QUALIFIER SEEN, NONNEGATABLE
- QUALIFIER UNSEEN, NONNEGATABLE
- DISALLOW (MARKED AND SEEN) OR (MARKED AND UNSEEN) OR
- (UNMARKED AND SEEN) OR (UNMARKED AND UNSEEN)
- DEFINE SYNTAX SET_NOACCESS
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST)
- PARAMETER P3, LABEL=ACCESS_FOLDER
- QUALIFIER ALL, NONNEGATABLE
- QUALIFIER READONLY, NONNEGATABLE
- DISALLOW NOT ALL AND NOT ACCESS_ID
- DISALLOW ALL AND NOT READONLY
- DEFINE SYNTAX SET_ACCESS
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=ACCESS_ID, VALUE(LIST)
- PARAMETER P3, LABEL=ACCESS_FOLDER
- QUALIFIER READONLY, NONNEGATABLE
- QUALIFIER ALL, NONNEGATABLE
- DISALLOW NOT ALL AND NOT ACCESS_ID
- DEFINE SYNTAX SET_PRIVILEGES
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=PRIVILEGES, PROMPT="Privileges"
- VALUE (REQUIRED,LIST)
- DEFINE SYNTAX SET_DEFAULT_EXPIRE
- PARAMETER P1, LABEL=SET_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SET_OPTIONS)
- PARAMETER P2, LABEL=DEFAULT_EXPIRE, VALUE(TYPE=$NUMBER,REQUIRED)
- DEFINE VERB SHOW
- PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SHOW_OPTIONS)
-!
-! The following are defined to allow qualifiers to be specified
-! directly after the SHOW command, i.e. SHOW/FULL FOLDER.
-! Otherwise, the CLI routines will reject the command, because it
-! first attempts to process the qualifier before process the parameter,
-! so it has no information the qualifiers are valid.
-!
- QUALIFIER FULL, SYNTAX=SHOW_FOLDER_FULL, NONNEGATABLE
- QUALIFIER ALL, SYNTAX=SHOW_USER
- QUALIFIER FOLDER, VALUE, SYNTAX=SHOW_USER
- QUALIFIER LOGIN, SYNTAX=SHOW_USER
- QUALIFIER NOLOGIN, SYNTAX=SHOW_USER
- QUALIFIER PRINT, SYNTAX=SHOW_KEYPAD_PRINT
- QUALIFIER SINCE, VALUE(TYPE=$DATETIME), SYNTAX=SHOW_USER
- QUALIFIER START, SYNTAX=SHOW_USER
- DEFINE TYPE SHOW_OPTIONS
- KEYWORD FOLDER, SYNTAX=SHOW_FOLDER
- KEYWORD NEW, SYNTAX=SHOW_FLAGS
- KEYWORD PRIVILEGES, SYNTAX=SHOW_FLAGS
- KEYWORD FLAGS, SYNTAX=SHOW_FLAGS
- KEYWORD KEYPAD, SYNTAX=SHOW_KEYPAD
- KEYWORD USER, SYNTAX=SHOW_USER
- KEYWORD VERSION
- DEFINE SYNTAX SHOW_FLAGS
- PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SHOW_OPTIONS)
- DEFINE SYNTAX SHOW_KEYPAD
- PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SHOW_OPTIONS)
- QUALIFIER PRINT
- DEFINE SYNTAX SHOW_KEYPAD_PRINT
- PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SHOW_OPTIONS)
- QUALIFIER PRINT,DEFAULT
- DEFINE SYNTAX SHOW_FOLDER
- PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SHOW_OPTIONS)
- PARAMETER P2, LABEL=SHOW_FOLDER
- DEFINE SYNTAX SHOW_USER
- PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SHOW_OPTIONS)
- PARAMETER P2, LABEL=USERNAME
- QUALIFIER ALL
- QUALIFIER FOLDER, VALUE
- QUALIFIER LOGIN
- QUALIFIER NOLOGIN
- QUALIFIER SINCE, VALUE(TYPE=$DATETIME)
- QUALIFIER START, VALUE
- DISALLOW (NOLOGIN OR LOGIN OR ALL) AND USERNAME
- DISALLOW (LOGIN AND NOLOGIN)
- DISALLOW (LOGIN OR NOLOGIN) AND FOLDER
- DEFINE SYNTAX SHOW_FOLDER_FULL
- QUALIFIER FULL, DEFAULT
- PARAMETER P1, LABEL=SHOW_PARAM1, PROMPT="What"
- VALUE(REQUIRED, TYPE=SHOW_OPTIONS)
- PARAMETER P2, LABEL=SHOW_FOLDER
- DEFINE VERB SUBSCRIBE
- DEFINE VERB SPAWN
- PARAMETER P1, LABEL=COMMAND, VALUE(TYPE=$REST_OF_LINE)
- DEFINE VERB UNMARK
- PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST)
- DEFINE VERB UNDELETE
- PARAMETER P1, LABEL=BULLETIN_NUMBER, VALUE(TYPE=$FILE)
- DEFINE VERB UNSEEN
- PARAMETER P1, LABEL=NUMBER, VALUE(TYPE=$FILE,LIST)
- DEFINE VERB UNSUBSCRIBE
-$eod
-$copy/log sys$input BULLETIN.CLD
-$deck
-!
-! This file is the CLD file used to define a command to execute
-! BULLETIN by using CDU, which adds the command to the command table.
-! The alternative is to define a symbol to execute BULLETIN.
-! Either way will work, and it is up to the user's to decide which
-! method to work. (If you don't know which, you probably should use
-! the default symbol method.)
-!
-
-Define Verb BULLETIN
- Image BULL_DIR:BULLETIN
- Parameter P1, Label = SELECT_FOLDER
- Qualifier ALL
- Qualifier BBOARD
- Qualifier BULLCP
- Qualifier CLEANUP, Value (Required)
- Qualifier EDIT
- Qualifier KEYPAD, Default
- Qualifier LOGIN
- Qualifier MARKED
- Qualifier PAGE, Default
- Qualifier PGFLQUOTA, Value (Type = $NUMBER, Required)
- Qualifier PROMPT, Value (Default = "BULLETIN"), Default
- Qualifier READNEW
- Qualifier REVERSE
- !
- ! The following line causes a line to be outputted separating system notices.
- ! The line consists of a line of all "-"s, i.e.:
- !--------------------------------------------------------------------------
- ! If you want a different character to be used, simply put in the desired one
- ! in the following line. If you want to disable the feature, remove the
- ! Default at the end of the line. (Don't remove the whole line!)
- !
- Qualifier SEPARATE, Value (Default = "-"), Default
- Qualifier SEEN
- Qualifier STARTUP
- Qualifier STOP
- Qualifier SYSTEM, Value (Type = $NUMBER, Default = "7")
- Qualifier UNMARKED
- Qualifier UNSEEN
- Qualifier WIDTH, Value (Type = $NUMBER, Required)
- Qualifier WSEXTENT, Value (Type = $NUMBER, Required)
- Disallow (WSEXTENT Or PGFLQUOTA) And Not STARTUP
-$eod
-$copy/log sys$input BULLETIN.COM
-$deck
-$ DEFINE SYS$INPUT SYS$NET
-$ BULLETIN
-$eod
-$copy/log sys$input BULLMAIN.CLD
-$deck
- MODULE BULLETIN_MAINCOMMANDS
- DEFINE VERB BULLETIN
- PARAMETER P1, LABEL=SELECT_FOLDER
- QUALIFIER ALL
- QUALIFIER BBOARD
- QUALIFIER BULLCP
- QUALIFIER CLEANUP, LABEL=CLEANUP, VALUE(REQUIRED)
- QUALIFIER EDIT
- QUALIFIER KEYPAD, DEFAULT
- QUALIFIER LOGIN
- QUALIFIER MARKED
- QUALIFIER PAGE, DEFAULT
- QUALIFIER PGFLQUOTA, VALUE(TYPE=$NUMBER, REQUIRED)
- QUALIFIER READNEW
- QUALIFIER REVERSE
-!
-! The following line causes a line to be outputted separating system notices.
-! The line consists of a line of all "-"s, i.e.:
-!--------------------------------------------------------------------------
-! If you want a different character to be used, simply put in the desired one
-! in the following line. If you want to disable the feature, remove the
-! DEFAULT at the end of the line. (Don't remove the whole line!)
-!
- QUALIFIER SEEN
- QUALIFIER SEPARATE, VALUE(DEFAULT="-"), DEFAULT
- QUALIFIER STARTUP
- QUALIFIER STOP
- QUALIFIER SYSTEM, VALUE(TYPE=$NUMBER, DEFAULT="7")
- QUALIFIER UNSEEN
- QUALIFIER UNMARKED
- QUALIFIER WIDTH, VALUE(TYPE=$NUMBER, REQUIRED)
- QUALIFIER WSEXTENT, VALUE(TYPE=$NUMBER, REQUIRED)
- DISALLOW (WSEXTENT OR PGFLQUOTA) AND NOT STARTUP
-$eod
-$copy/log sys$input BULLSTART.COM
-$deck
-$ RUN SYS$SYSTEM:INSTALL
-BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/-
-PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM)
-/EXIT
-$ BULL*ETIN :== $BULL_DIR:BULLETIN
-$ BULLETIN/STARTUP
-$eod
-$copy/log sys$input BULL_NEWSDUMMY.FOR
-$deck
- INTEGER FUNCTION NEWS_ASSIGN()
-
- NEWS_ASSIGN = 0
-
- RETURN
- END
-
- INTEGER FUNCTION NEWS_GET_CHAN(I)
-
- RETURN
- END
-
-
- SUBROUTINE NEWS_SET_CHAN(I)
-
- RETURN
- END
-
- INTEGER FUNCTION NEWS_SOCKET_BULLCP(I,J,K,L)
-
- RETURN
- END
-
-
- INTEGER FUNCTION NEWS_CREATE_BULLCP(I,J,K,L)
-
- RETURN
- END
-
-
- INTEGER FUNCTION NEWS_WRITE_PACKET_BULLCP(I,J,K,L,M,N)
-
- RETURN
- END
-
-
- SUBROUTINE NEWS_DISCONNECT
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION NEWS_CONNECT
-
- NEWS_CONNECT = .FALSE.
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION NEWS_WRITE_PACKET(BUF)
-
- CHARACTER*(*) BUF
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION NEWS_READ_PACKET(BUF)
-
- CHARACTER*(*) BUF
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION NEWS_GETHOSTNAME(BUF)
-
- CHARACTER*(*) BUF
-
- RETURN
- END
-$eod
-$copy/log sys$input CREATE.COM
-$deck
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN0
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN1
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN2
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN3
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN4
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN5
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN6
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN7
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN8
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN9
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN10
-$ FORTRAN/EXTEND/CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)/NOHPO BULLETIN11
-$ MAC ALLMACS
-$ SET COMMAND/OBJ BULLCOM
-$ SET COMMAND/OBJ BULLMAIN
-$ ON WARNING THEN GOTO DUMMY
-$ IF F$TRNLNM("TWG$TCP") .EQS. "" THEN GOTO MULTI
-$ DEFINE VAXC$INCLUDE TWG$TCP:[NETDIST.INCLUDE],-
- TWG$TCP:[NETDIST.INCLUDE.SYS],-
- TWG$TCP:[NETDIST.INCLUDE.VMS],-
- TWG$TCP:[NETDIST.INCLUDE.NETINET],-
- TWG$TCP:[NETDIST.INCLUDE.ARPA],-
- SYS$LIBRARY
-$ CC BULL_NEWS/DEFINE=(TWG=1)
-$ GOTO LINK
-$MULTI:
-$ IF F$TRNLNM("MULTINET_SOCKET_LIBRARY") .EQS. "" THEN GOTO UCX
-$ CC BULL_NEWS/DEFINE=(MULTINET=1)
-$ GOTO LINK
-$UCX:
-$ IF F$TRNLNM("UCX$DEVICE") .EQS. "" THEN GOTO CMU
-$ CC BULL_NEWS/DEFINE=(UCX=1)
-$ GOTO LINK
-$CMU:
-$ CC BULL_NEWS
-$ GOTO LINK
-$DUMMY:
-$ WRITE SYS$OUTPUT "There is no C compiler available for the NEWS software."
-$ WRITE SYS$OUTPUT "BULLETIN will be assembled without that feature."
-$ FOR BULL_NEWSDUMMY
-$LINK:
-$ IF F$SEARCH("BULL_DIR:READ_BOARD.COM") .NES. "" THEN-
- DELETE BULL_DIR:READ_BOARD.COM;*
-$ IF F$SEARCH("BULL.OLB") .EQS. "" THEN LIBRARY/CREATE BULL
-$ LIBRARY BULL *.OBJ;
-$ DELETE *.OBJ;*
-$ @BULLETIN.LNK
-$eod
-$copy/log sys$input DCLREMOTE.COM
-$deck
-$! DCL procedure to execute DCL commands passed over Decnet on a remote system.
-$! Commands sent by the command procedure REMOTE.COM on the local system are
-$! are received by this procedure on the remote node.
-$! This procedure is usually a DECNET OBJECT with task name DCLREMOTE and
-$! normally resides in the default DECNET account. To install as an object,
-$! enter NCP, and then use the command:
-$! NCP> SET OBJECT DCLREMOTE FILE file-spec NUM 0
-$! where file-spec includes the disk, directory, and file name of the file.
-$! If DCLREMOTE is not installed as an object, the logical name DCLREMOTE can
-$! be defined to point at it.
-$!
-$! Alternativley, DCLREMOTE.COM could be placed in the directory of the user's
-$! proxy login on the remote system.
-$!
-$! WARNING: An EXIT command must not be passed as a command to execute at this
-$! procedure level or the link will hang.
-$!
-$ SET NOON
-$ N = 0
-$AGAIN:
-$ N = N + 1
-$ IF N .GE. 5 THEN GOTO DONE
-$ OPEN/WRITE/READ/ERR=AGAIN NET SYS$NET
-$ DEFINE /NOLOG SYS$OUTPUT NET
-$ DEFINE /NOLOG SYS$ERROR NET
-$NEXT_CMD:
-$ READ /ERR=DONE NET COMMAND
-$ 'COMMAND'
-$ WRITE/ERR=DONE SYS$OUTPUT "COMMAND$DONE ''$STATUS'"
-$ GOTO NEXT_CMD
-$DONE:
-$ CLOSE NET
-$eod
-$copy/log sys$input INSTALL.COM
-$deck
-$ COPY BULLETIN.EXE BULL_DIR:
-$ RUN SYS$SYSTEM:INSTALL
-BULL_DIR:BULLETIN/DEL
-BULL_DIR:BULLETIN/SHAR/OPEN/HEAD/-
-PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM)
-/EXIT
-$!
-$! NOTE: BULLETIN requires a separate help library. If you do not wish
-$! the library to be placed in SYS$HELP, modify the following lines and
-$! define the logical name BULL_HELP to be the help library directory, i.e.
-$! $ DEFINE/SYSTEM BULL_HELP SYSD$:[NEWDIRECTORY]
-$! The above line should be placed in BULLSTART.COM to be executed after
-$! every system reboot.
-$!
-$ IF F$SEARCH("SYS$HELP:BULL.HLB") .NES. "" THEN LIBRARY/DELETE=*/HELP SYS$HELP:BULL
-$ IF F$SEARCH("SYS$HELP:BULL.HLB") .EQS. "" THEN LIBRARY/CREATE/HELP SYS$HELP:BULL
-$ LIBRARY/HELP SYS$HELP:BULL BULLCOMS1,BULLCOMS2
-$ LIBRARY/HELP SYS$HELP:HELPLIB BULLETIN
-$eod
-$copy/log sys$input INSTALL_REMOTE.COM
-$deck
-$!
-$! INSTALL_REMOTE.COM
-$! VERSION 5/25/88
-$!
-$! DESCRIPTION:
-$! Command procedure to easily install BULLETIN.EXE on several nodes.
-$!
-$! INPUTS:
-$! The following parameters can be added to the command line. They
-$! should be placed on the command line which executes this command
-$! procedure, separated by spaces. I.e. @INSTALL_REMOTE.COM OLD COPY TEST
-$!
-$! OLD - Specifies that the present version of BULLETIN is 1.51 or earlier.
-$! COPY - Specifies that the executable is to be copied to the nodes.
-$! TEST - Specifies that all the nodes are to be checked to see if they
-$! are up before beginning the intallation.
-$!
-$! NOTES:
-$! ***PLEASE READ ALL COMMENTS BEFORE RUNNING THIS***
-$! This calls REMOTE.COM which is also included with the installation.
-$!
-$! DCLREMOTE.COM must be properly installed on all nodes.
-$! See comments at the beginning of that file for instructions.
-$! Also, you need to have a proxy login with privileges on those nodes.
-$! This procedure assumes that the BULLETIN executable on each node is
-$! located in the BULL_DIR directory. The new executable should be copied
-$! to that directory before running this procedure, or the COPY option
-$! should be used.
-$!
-$! If the present version of BULLETIN is 1.51 or earlier, it does not have
-$! the ability of setting BULL_DISABLE to disable BULLETIN, so you should
-$! use the OLD parameter when running this procedure.
-$!
-$! INSTRUCTIONS FOR SPECIFYING THE NODES AT YOUR SITE:
-$! Place the nodes where bulletin is to be reinstalled in variable NODES.
-$! Place the nodes where the executable is to be copied to in COPY_NODES.
-$! Place nodes where BULLCP is running in BULLCP_NODES.
-$!
-$ NODES = "ALCVAX,NERUS,ANANSI,MOLVAX,LAURIE,CANDLE,KLYPSO,DOME" +-
-",ARVON,LARAN,ORYANA,PALDAR,MOTHRA,TARNA,DARIUS"
-$ COPY_NODES = "NERUS,LAURIE,ARVON"
-$ BULLCP_NODES = "NERUS,LAURIE,ARVON"
-$!
-$ NODES = NODES + ","
-$ COPY_NODES = COPY_NODES + ","
-$ BULLCP_NODES = BULLCP_NODES + ","
-$!
-$! Check for any parameters passed to the command procedure.
-$!
-$ PARAMETER = P1 + P2 + P3
-$ OLD = 0
-$ IF F$LOCATE("OLD",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN OLD = 1
-$ TEST = 0
-$ IF F$LOCATE("TEST",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN TEST = 1
-$ COPYB = 0
-$ IF F$LOCATE("COPY",PARAMETER) .NE. F$LENGTH(PARAMETER) THEN COPYB = 1
-$!
-$! If TEST requested, see if nodes are accessible.
-$!
-$ IF .NOT. TEST THEN GOTO END_TEST
-$BEGIN_TEST:
-$ NODES1 = NODES
-$TEST:
-$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_TEST
-$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1)
-$ NODES1 = NODES1 - NODE - ","
-$ @REMOTE 'NODE' END
-$ GOTO TEST
-$END_TEST:
-$!
-$! If COPY requested, copy executable to nodes.
-$!
-$ IF .NOT. COPYB THEN GOTO END_COPY
-$COPY:
-$ IF F$LEN(COPY_NODES) .EQ. 0 THEN GOTO END_COPY
-$ NODE = F$EXTRACT(0,F$LOCATE(",",COPY_NODES),COPY_NODES)
-$ COPY_NODES = COPY_NODES - NODE - ","
-$ COPY BULLETIN.EXE 'NODE'::BULL_DIR:
-$ GOTO COPY
-$END_COPY:
-$!
-$! The procedure now goes to each node and disables bulletin and kills
-$! the BULLCP process if present. NOTE: If version is < 1.51, we assume
-$! that BULLCP is running under SYSTEM account. This is not necessary
-$! for older versions where the BULLETIN/STOP command can be used.
-$! If BULLCP is not running under the SYSTEM account for version 1.51
-$! or less, you will have to kill them manually before running this!
-$!
-$BEGIN_DISABLE:
-$ NODES1 = NODES
-$DISABLE:
-$ IF F$LEN(NODES1) .EQ. 0 THEN GOTO END_DISABLE
-$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1)
-$ NODES1 = NODES1 - NODE - ","
-$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL
-$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. -
- F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_STOP_BULLCP
-$ IF OLD THEN @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM]
-$ IF OLD THEN @REMOTE 'NODE' CONTINUE STOP BULLCP
-$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN
-$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE BULLETIN/STOP
-$SKIP_STOP_BULLCP:
-$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL
-$ IF OLD THEN @REMOTE 'NODE' END INS BULL_DIR:BULLETIN/DELETE
-$ IF .NOT. OLD THEN @REMOTE 'NODE' END DEF/SYSTEM BULL_DISABLE DISABLE
-$ GOTO DISABLE
-$END_DISABLE:
-$!
-$! The procedure now installs the new BULLETIN.
-$!
-$ NODES1 = NODES
-$INSTALL:
-$ IF F$LEN(NODES1) .EQ. 0 THEN EXIT
-$ NODE = F$EXTRACT(0,F$LOCATE(",",NODES1),NODES1)
-$ NODES1 = NODES1 - NODE - ","
-$ @REMOTE 'NODE' CONTINUE SET PROC/PRIV=ALL
-$ @REMOTE 'NODE' CONTINUE INS := $SYS$SYSTEM:INSTALL
-$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN
-$ IF OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/SHAR-
-/OPEN/HEAD/PRIV=(OPER,SYSPRV,CMKRNL,WORLD,DETACH,PRMMBX,SYSNAM)
-$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE INS BULL_DIR:BULLETIN/REPLACE
-$ IF .NOT. OLD THEN @REMOTE 'NODE' CONTINUE DEASS/SYSTEM BULL_DISABLE
-$ IF F$LOCATE(","+NODE+",",","+BULLCP_NODES) .EQ. -
- F$LENGTH(","+BULLCP_NODES) THEN GOTO SKIP_START_BULLCP
-$ @REMOTE 'NODE' CONTINUE SET UIC [SYSTEM]
-$ @REMOTE 'NODE' CONTINUE BULLETIN := $BULL_DIR:BULLETIN"
-$ @REMOTE 'NODE' CONTINUE BULLETIN/START
-$SKIP_START_BULLCP:
-$ @REMOTE 'NODE' END CONTINUE
-$ GOTO INSTALL
-$eod
-$copy/log sys$input INSTRUCT.COM
-$deck
-$ BULLETIN
-ADD/PERMANENT/SYSTEM INSTRUCT.TXT
-INFO ON HOW TO USE THE BULLETIN UTILITY.
-ADD/PERMANENT NONSYSTEM.TXT
-INFO ON BEING PROMPTED TO READ NON-SYSTEM BULLETINS.
-EXIT
-$eod
-$copy/log sys$input LOGIN.COM
-$deck
-$!
-$! The following line defines the BULLETIN command.
-$!
-$ BULL*ETIN :== $BULL_DIR:BULLETIN
-$!
-$! Note: The command prompt when executing the utility is named after
-$! the executable image. Thus, as it is presently set up, the prompt
-$! will be "BULLETIN>". DO NOT make the command that executes the
-$! image different from the image name, or certain things will break.
-$!
-$! If you would rather define the BULLETIN command using CDU rather than
-$! defining it using a symbol, use the BULLETIN.CLD file to do so.
-$!
-$! The following line causes new messages to be displayed upon logging in.
-$!
-$ BULLETIN/LOGIN/REVERSE
-$!
-$! If you wish bulletins to be displayed starting with
-$! the newest rather the oldest, omit the /REVERSE qualifier.
-$! Note that for totally new users, only permanent system messages and
-$! the first non-system general message is displayed (which, if you ran
-$! INSTURCT.COM, would describe what a non-system message is).
-$! This is done so as to avoid overwhelming a new user with lots of
-$! messages upon logging in for the first time.
-$! Users who have DISMAIL enabled in the authorzation table will automatically
-$! be set to "NOLOGIN" (see HELP SET NOLOGIN). If you wish to disable this
-$! feature, add /ALL to the /LOGIN command.
-$!
-$eod
-$copy/log sys$input MAKEFILE.
-$deck
-# Makefile for BULLETIN
-
-Bulletin : Bulletin.Exe Bull.Hlb
-
-Bulletin.Exe : Bull.Olb
- Link /NoTrace Bull.Olb/Lib /Inc=Bulletin$Main,Sys$System:Sys.Stb/Sel -
- /NoUserlib /Exe=Bulletin.Exe,Sys$Input/Opt
- ID="V2.06" $
-
-Bull.Olb : Bulletin.Obj Bulletin0.Obj Bulletin1.Obj Bulletin2.Obj \
- Bulletin3.Obj Bulletin4.Obj Bulletin5.Obj Bulletin6.Obj \
- Bulletin7.Obj Bulletin8.Obj Bulletin9.Obj Bulletin10.Obj \
- Bulletin11.Obj Bullcom.Obj Bullmain.Obj Allmacs.Obj
- Library /Create Bull.Olb *.Obj
- Purge /Log *.Obj,*.Exe
-
-Bulletin.Obj : Bulletin.For Bullfiles.Inc Bulldir.Inc Bullfolder.Inc \
- Bulluser.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin.For
-
-Bulletin0.Obj : Bulletin0.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin0.For
-
-Bulletin1.Obj : Bulletin1.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin1.For
-
-Bulletin2.Obj : Bulletin2.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin2.For
-
-Bulletin3.Obj : Bulletin3.For Bulldir.Inc Bullfolder.Inc Bulluser.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin3.For
-
-Bulletin4.Obj : Bulletin4.For Bullfolder.Inc Bulluser.Inc Bullfiles.Inc \
- Bulldir.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin4.For
-
-Bulletin5.Obj : Bulletin5.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin5.For
-
-Bulletin6.Obj : Bulletin6.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin6.For
-
-Bulletin7.Obj : Bulletin7.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin7.For
-
-Bulletin8.Obj : Bulletin8.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin8.For
-
-Bulletin9.Obj : Bulletin9.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin9.For
-
-Bulletin10.Obj : Bulletin10.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin10.For
-
-Bulletin11.Obj : Bulletin11.For Bulldir.Inc Bulluser.Inc Bullfolder.Inc \
- Bullfiles.Inc Bullnews.Inc
- Fortran /Extend /NoList Bulletin11.For
-
-Allmacs.Obj : Allmacs.mar
- Macro /NoList Allmacs.Mar
-
-Bullcom.Obj : Bullcom.cld
- Set Command /Obj Bullcom.Cld
-
-Bullmain.Obj : Bullmain.cld
- Set Command /Obj Bullmain.Cld
-
-Bull.Hlb : Bullcoms1.Hlp Bullcoms2.Hlp
- Library /Create /Help Bull.Hlb Bullcoms1.Hlp, Bullcoms2.Hlp
- Purge Bull.Hlb
-*.hlb :
- lib/help/cre $*
-$eod
-$copy/log sys$input OPTIMIZE_RMS.COM
-$deck
-$ SET NOON
-$ EXIT_STATUS = 1
-$ IF P1 .NES. "" THEN GOTO BATCH
-$!
-$GET_FILE:
-$ INQUIRE P1 "File to be optimized (^Y to quit)"
-$!
-$ FILENAME = P1
-$ SPEC = F$SEARCH(FILENAME)
-$!
-$GOT_NAME_INTERACTIVE:
-$ NAME = F$PARSE(FILENAME,,,"NAME")
-$!
-$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN-
- GOTO INTERACTIVE_CHECK_ADDS
-$ WRITE SYS$OUTPUT "File not indexed"
-$ GOTO GET_FILE
-$INTERACTIVE_CHECK_ADDS:
-$ INQUIRE P2 "Number of records to add after initial load"
-$ IF P2 .EQS. "" THEN P2 = 0
-$!
-$ IF P2 .GE. 0 THEN GOTO INTERACTIVE_CHECK_CONVERT
-$ WRITE SYS$OUTPUT "Added records must be >= 0 "
-$ GOTO GOT_NAME_INTERACTIVE
-$!
-$INTERACTIVE_CHECK_CONVERT:
-$ INQUIRE P3 "Turn OFF Data and Key compression? (N)"
-$ INQUIRE P4 "Turn OFF Index compression? (N)"
-$!
-$ GOTO ADD_OK
-$!
-$BATCH:
-$GOT_NAME:
-$ FILENAME = P1
-$ SPEC = F$SEARCH(FILENAME)
-$!
-$ IF SPEC .NES. "" THEN GOTO FILE_EXISTS
-$ WRITE SYS$OUTPUT "File does not exist"
-$ EXIT_STATUS = %X18292
-$ GOTO DONE
-$!
-$FILE_EXISTS:
-$ NAME = F$PARSE(FILENAME,,,"NAME")
-$ IF F$FILE_ATTRIBUTE(FILENAME,"ORG") .EQS. "IDX" THEN-
- GOTO TYPE_OK
-$ WRITE SYS$OUTPUT "File not indexed"
-$ EXIT_STATUS = 1000024
-$ GOTO DONE
-$!
-$TYPE_OK:
-$ IF P2 .EQS. "" THEN P2 = 0
-$ IF P2 .GE. 0 THEN GOTO ADD_OK
-$!
-$ WRITE SYS$OUTPUT "Added records must be >= 0 "
-$ EXIT_STATUS = %X38060
-$ GOTO DONE
-$!
-$ADD_OK:
-$ ADD_RECORDS = P2
-$!
-$ NUMBER_OF_KEYS == 'F$FILE_ATTRIBUTE(FILENAME,"NOK")
-$ TURN_DATA_COMPRESSION_OFF = P3
-$ TURN_INDEX_COMPRESSION_OFF = P4
-$ FDL_NAME = F$PARSE(".FDL;0",SPEC)
-$ TEMP_FILE = "''NAME'_TEMP_TEMP.COM"
-$ OPEN/WRITE/ERROR=OPEN_ERROR OUT 'TEMP_FILE
-$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT"
-$ WRITE OUT "$ ANALYZE/RMS/FDL/OUT=''FDL_NAME' ''FILENAME'"
-$ WRITE OUT "$ DEFINE/USER SYS$COMMAND SYS$INPUT"
-$ WRITE OUT "$ DEFINE/USER EDF$$PLAYBACK_INPUT KLUDGE"
-$ WRITE OUT "$ EDIT/FDL/SCRIPT=OPTIMIZE/ANALYZE=''FDL_NAME' ''FDL_NAME'"
-$ WRITE OUT ""
-$ WRITE OUT ""
-$ WRITE OUT ""
-$ WRITE OUT ""
-$ WRITE OUT 'ADD_RECORDS
-$ IF ADD_RECORDS .EQ. 0 THEN GOTO SKIP_NON_ZERO
-$ WRITE OUT ""
-$ WRITE OUT ""
-$SKIP_NON_ZERO:
-$ WRITE OUT ""
-$ IF TURN_INDEX_COMPRESSION_OFF
-$ THEN
-$ WRITE OUT "IC"
-$ WRITE OUT "NO"
-$ ENDIF
-$ IF TURN_DATA_COMPRESSION_OFF
-$ THEN
-$ WRITE OUT "RC"
-$ WRITE OUT "NO"
-$ WRITE OUT "KC"
-$ WRITE OUT "NO"
-$ ENDIF
-$ WRITE OUT "FD"
-$ WRITE OUT "Created from OPTIMIZE_RMS.COM, WITH SPACE/BUCKETSIZE for" +-
- " ''A DD_RECORDS' ADDED RECORDS"
-$ WRITE OUT ""
-$ WRITE OUT ""
-$LOOP:
-$ IF NUMBER_OF_KEYS .EQ. 1 THEN GOTO CLOSE_FILE
-$ WRITE OUT ""
-$ WRITE OUT ""
-$ WRITE OUT ""
-$ IF TURN_INDEX_COMPRESSION_OFF
-$ THEN
-$ WRITE OUT "IC"
-$ WRITE OUT "NO"
-$ ENDIF
-$ IF TURN_DATA_COMPRESSION_OFF
-$ THEN
-$ WRITE OUT "KC"
-$ WRITE OUT "NO"
-$ ENDIF
-$ WRITE OUT "FD"
-$ WRITE OUT ""
-$ WRITE OUT ""
-$ NUMBER_OF_KEYS = 'NUMBER_OF_KEYS - 1
-$ GOTO LOOP
-$!
-$CLOSE_FILE:
-$ WRITE OUT "E"
-$ CLOSE OUT
-$!
-$ @'TEMP_FILE
-$ DELETE 'TEMP_FILE;*
-$ WRITE SYS$OUTPUT ""
-$ WRITE SYS$OUTPUT "Starting CONVERT of ''FILENAME'"
-$ CONVERT /NOSORT /STAT /FDL='FDL_NAME 'FILENAME 'FILENAME
-$ WRITE SYS$OUTPUT ""
-$ GOTO DONE
-$OPEN_ERROR:
-$ WRITE SYS$OUTPUT "Unable to open ''TEMP_FILE'"
-$DONE:
-$ EXIT 'EXIT_STATUS
-$eod
-$copy/log sys$input REMOTE.COM
-$deck
-$! FILE: REMOTE.COM VERSION 1.3 EDIT 880513 - CAK
-$! DCL procedure to execute DCL commands on a remote decnet node.
-$! The remote DECNET object DCLREMOTE.COM must be defined as a known type 0
-$! object on the remote node or the file must be in the login directory
-$! of the account used on the remote system. Or the logical name DCLREMOTE
-$! can be defined to point at the object.
-$!
-$! Usage: REM*OTE :== @SYS$MANAGER:REMOTE [P1] [P2] ...
-$!
-$! P1 - Node name commands are to be executed on, including any access control.
-$! If no access control is specified then a proxy login is attempted.
-$! The you do not have an account on the remote system then the default
-$! DECNET account is used.
-$! P2 - DCL command to execute on the remote system. Optional.
-$! P3-P8 Additional parameters passed to the command (so quotes aren't needed)
-$
-$ ON WARNING THEN GOTO ERROR
-$ ON CONTROL_Y THEN GOTO ERROR
-$ COMMAND := 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8'
-$ IF P2 .EQS. "CONTINUE" THEN COMMAND = COMMAND - "CONTINUE"
-$ IF P2 .EQS. "END" THEN COMMAND = COMMAND - "END"
-$ NEXT_CMD = "NEXT_CMD"
-$ IF P2 .NES. "" THEN NEXT_CMD = "DONE"
-$ P1 = P1 - "::"
-$
-$ IF F$LOG ("NET") .EQS. "" THEN GOTO OPEN_LINK
-$ IF P2 .EQS. "CONTINUE" THEN GOTO NEXT_CMD
-$ IF P2 .EQS. "END" THEN GOTO NEXT_CMD
-$OPEN_LINK:
-$ WRITE SYS$OUTPUT "Establishing DECNET link to node ''P1'..."
-$ OPEN/WRITE/READ NET 'P1'::"TASK=DCLREMOTE"
-$
-$NEXT_CMD:
-$ IF P2 .EQS. "" THEN READ /ERR=ERROR/PROMPT="''P1'> " SYS$COMMAND COMMAND
-$ IF F$EDIT(F$EXTR(0,1,COMMAND),"UPCASE") .EQS. "E" THEN GOTO DONE
-$ WRITE NET COMMAND
-$LOOP:
-$ READ/ERR=ERROR/TIME_OUT=10 NET LINE
-$ IF F$EXTR (0,12,LINE) .EQS. "COMMAND$DONE" THEN GOTO 'NEXT_CMD'
-$ WRITE SYS$OUTPUT LINE
-$ GOTO LOOP
-$DONE:
-$ IF P2 .EQS. "CONTINUE" THEN EXIT
-$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET
-$ EXIT
-$ERROR:
-$ IF F$LOG ("NET") .NES. "" THEN CLOSE NET
-$ STOP
-$eod
-$copy/log sys$input SETUSER.MAR
-$deck
- .Title SETUSER
-;
-; Program Setuser
-;
-; This program will change the username and UIC of the running process
-;
-; To assemble: $ MACRO SETUSER
-; $ LINK SETUSER,SYS$SYSTEM:SYS.STB/SELECT
-;
- .LIBRARY /SYS$LIBRARY:LIB.MLB/
- $PCBDEF ;define PCB offsets
- $JIBDEF ;define JIB offsets
- $UAFDEF ;define user authorization file offsets
-INFAB: $FAB FAC=GET - ;only gets on input file
- FNM=<SYSUAF> - ;SYSUAF may be defined as logical name
- DNM=<SYS$SYSTEM:.DAT> - ;These are default directory & suffix
- SHR=<PUT,GET,DEL,UPD> ;allow full sharing
-INRAB: $RAB FAB=INFAB - ;FAB for this RAB
- KBF=COMMLD+8 - ;key value is typed in by user
- KRF=0 - ;primary key
- KSZ=12 - ;username is 12 bytes long
- RAC=KEY - ;key access on this file
- ROP=NLK - ;don't lock read records
- UBF=BUFFER - ;address of buffer for I/O
- USZ=2048 ;size of buffer
-BUFFER: .BLKB 2048 ;buffer for data
-COMMLD: .ASCID / / ;space for typed in username
-PROMPTD:.ASCID /Username: / ;prompt string
-COMMLDS:.WORD 0 ;space for number of bytes typed in
-FAODESC:.LONG 80
- .LONG FAOBUF
-FAOBUF: .BLKB 80
-FAOLEN: .BLKW 1
- .BLKW 1
-FORSTR: .ASCID /PID:!XL from:[!OW,!OW] !AD to:[!OW,!OW] !AD/
-TT: .ASCID /SYS$OUTPUT/
-CHANTT: .WORD 0 ;space for terminal channel number
-IOSB: .QUAD 0
-OLDUSER:.BLKB 12 ;space for old username
-OLDUIC: .BLKL 1 ;space for old uic
-ERRORB: JMP ERROR ;for branch out of range
-
-JPIUSER: .BLKB 12
-JPIUSER_LEN: .BLKL 1
-
- $DEFINI IT ;DEFINE ITEM LIST FOR GETJPI
-$DEF ITL .BLKW 1 ;LENGTH OF OUTPUT BUFFER
-$DEF ITM .BLKW 1 ;ITEM CODE (PROCESS NAME)
-$DEF ITA .BLKL 1 ;ADDR OF OUTPUT BUFFER
-$DEF ITAL .BLKL 1 ;ADDR OF WORD TO RECIEVE BYTES USED
-$DEF ITEND .BLKL 1 ;ZERO LONG WORD TO END LIST
-$DEF ITSIZE ;SIZE NEEDED FOR IT BLOCK
- $DEFEND IT
-
- .ENTRY START,^M<> ;start of program
- PUSHAW COMMLDS ;address of word to get read byte count
- PUSHAL PROMPTD ;address of prompt string descriptor
- PUSHAL COMMLD ;address of descriptor to get command
- CALLS #3,G^LIB$GET_FOREIGN ;use run time library to get command
- BLBC R0,ERRORB ;low bit clear error
- $OPEN FAB=INFAB ;open file
- BLBC R0,ERRORB ;low bit clear error
- $CONNECT RAB=INRAB ;connect file
- BLBC R0,ERRORB ;low bit clear error
- $GET RAB=INRAB ;read a record
- CMPL R0,#RMS$_RNF ;record not found?
- BEQL errorb ;that's all folks
- CMPL R0,#RMS$_NORMAL ;ok?
- BNEQ ERRORB ;no so quit
-
- SUBL #ITSIZE,SP ;GET SPACE FOR ITEM LIST
- MOVL SP,R2 ;POINT TO IT
- MOVW #12,ITL(R2) ;SET UP ITEM LIST
- MOVW #JPI$_USERNAME,ITM(R2)
- MOVAB JPIUSER,ITA(R2)
- MOVAW JPIUSER_LEN,ITAL(R2)
- CLRL ITEND(R2)
- $GETJPI_S ITMLST=(R2) ;GET PROCESS NAME
- ADDL #ITSIZE,SP ;RESTORE STACK POINTER
-
- MOVL INRAB+RAB$L_RBF,R7 ;put address of read record in R7
- MOVL UAF$L_UIC(R7),R8 ;R8 has UIC we want
- $CMKRNL_S TWEAK ;change mode to kernel to tweak UIC
- ;and username
- BLBC R0,ERROR ;low bit clear error
- ADDL3 #UAF$S_USERNAME,R7,R8
- ADDL3 #UAF$T_USERNAME,R7,R9
- $FAO_S CTRSTR=FORSTR,- ;format string
- OUTBUF=FAODESC,- ;char descript for formatted output
- OUTLEN=FAOLEN,- ;long word to hold length of output
- P1=R9,- ;PID
- P2=OLDUIC+2,- ;old UIC, group number
- P3=OLDUIC,- ;old UIC, member number
- P4=#12,- ;usernames are 12 bytes
- P5=#OLDUSER,- ;address of old username
- P6=UAF$L_UIC+2(R7),- ;UIC, group number
- P7=UAF$L_UIC(R7),- ;UIC, member number
- P8=R8,- ;usernames are 12 bytes
- P9=R9 ;address of username
- BLBC R0,ERROR ;low bit clear error
- MOVL FAOLEN,FAODESC
- PUSHAL FAODESC ;address of descriptor to get command
- CALLS #1,G^LIB$PUT_OUTPUT ;use run time library to get command
- BLBC R0,ERROR ;low bit clear error
-EXIT:
- $CLOSE FAB=INFAB - ;close file
- ERR=ERROR
-ERROR: $EXIT_S R0 ;exit with error if any
- .ENTRY TWEAK,^M<> ;beginning of kernel mode code
- MOVL @#CTL$GL_PCB,R11 ;put address of our PCB in R11
- MOVL PCB$L_PID(R11),R9 ;save PID
- MOVL PCB$L_UIC(R11),OLDUIC ;save old UIC
- MOVL R8,PCB$L_UIC(R11) ;change our UIC
- MOVL PCB$L_JIB(R11),R10 ;put address of Job Info Block in R10
- ;MOVC blats R0-R5
- MOVC3 #12,JIB$T_USERNAME(R10),OLDUSER ;save old username
- CMPC3 JPIUSER_LEN,JPIUSER,OLDUSER
- BEQL GOOD
- CLRL R0
- RET
-GOOD: MOVC3 #12,UAF$T_USERNAME(R7),JIB$T_USERNAME(R10) ;change username JIB
- MOVC3 #12,UAF$T_USERNAME(R7),CTL$T_USERNAME ;change username in P1
-EEXIT: MOVL #SS$_NORMAL,R0 ;set normal exit status
- RET ;end of exec mode code
- .END START ;end of program
-$eod
diff --git a/decus/vax91b/bulletin-net91b/bulletin.for b/decus/vax91b/bulletin-net91b/bulletin.for
deleted file mode 100644
index c123abc6bc9184ae27b78feefe18448e7f141549..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin.for
+++ /dev/null
@@ -1,1768 +0,0 @@
-C
-C BULLETIN.FOR, Version 6/24/91
-C Purpose: Bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE '($RMSDEF)'
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /READIT/ READIT
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
- LOGICAL PAGING /.FALSE./
-
- COMMON /CTRLY/ CTRLY
-
- COMMON /PROMPT/ COMMAND_PROMPT
- CHARACTER*39 COMMAND_PROMPT
-
- COMMON /ACCESS/ READ_ONLY
- LOGICAL READ_ONLY
-
- COMMON /DECNET/ DECNET_PROC,ERROR_UNIT
- LOGICAL DECNET_PROC
-
- EXTERNAL ERROR_TRAP
- EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT
- EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT
- EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED
-
- PARAMETER PCB$M_BATCH = '4000'X
- PARAMETER PCB$M_NETWRK = '200000'X
- PARAMETER LIB$M_CLI_CTRLY = '2000000'X
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25
-
- COMMON /EDIT/ EDIT_DEFAULT
- DATA EDIT_DEFAULT/.FALSE./
-
- COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH
- COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)
- COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE
- CHARACTER*1 SEPARATE
-
- COMMON /TAGS/ BULL_TAG,READ_TAG
-
- COMMON /DEF_PROT/ ORIGINAL_DEF_PROT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT
- CHARACTER*42 PROMPT
-
- CHARACTER DCL_CMD*132
-
- CALL LIB$GET_FOREIGN(INCMD)
- DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"'
-
- CALL LIB$ESTABLISH(ERROR_TRAP)
- IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN
- CALL LIB$REVERT
- CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN)
- INCMD = 'BULLETIN '//INCMD
- CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS)
- ELSE
- CALL LIB$REVERT
- END IF
-
- IF (DCL_COMMAND) THEN
- IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP)
- IF (LENP.GT.0) THEN
- IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1)
- IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:)
- END IF
- END IF
-
- READIT = 0
-
- LOGIN_SWITCH = CLI$PRESENT('LOGIN')
- SYSTEM_SWITCH = CLI$PRESENT('SYSTEM')
- REVERSE_SWITCH = CLI$PRESENT('REVERSE')
-
- IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER)
- IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN
- IF (.NOT.LOGIN_SWITCH) THEN
- WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')')
- END IF
- CALL EXIT
- END IF
-
- CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT)
- ! Save original default protection in case it gets changed
-
- CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler
-
-C
-C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y.
-C Disabling and enabling CONTROL Y is done so that a person can not break
-C while one of the data files is opened, as that would not allow anyone
-C else to modify the files. However, if CONTROL Y is already disabled,
-C this is not necessary, and should not be done!
-C
-
- CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C
- CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY
- CALL GETPRIV ! Check privileges
- CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O
- CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C
-
- IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit
-
- CALL GETUSER(USERNAME) ! Get the process's username
- IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME)
- ! Check if has bulletin privileges
-
- I = 1 ! Strip off folder name if specified
- DO WHILE (I.LE.ILEN)
- IF (COMMAND_PROMPT(I:I).EQ.' ') THEN
- COMMAND_PROMPT = COMMAND_PROMPT(:I-1)
- I = ILEN + 1
- ELSE
- I = I + 1
- END IF
- END DO
- ILEN = 1 ! Get executable name to use as prompt
- DO WHILE (ILEN.GT.0)
- ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']'))
- IF (ILEN.GT.0) THEN
- COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:)
- ELSE
- DO I=TRIM(COMMAND_PROMPT),1,-1
- IF (COMMAND_PROMPT(I:I).LT.'A'.OR.
- & COMMAND_PROMPT(I:I).GT.'Z') THEN
- COMMAND_PROMPT = COMMAND_PROMPT(:I-1)
- END IF
- END DO
- END IF
- END DO
- COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> '
- IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR.
- & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> '
-
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
-
- CALL CLI$GET_VALUE('SEPARATE',SEPARATE)
-
- IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test
-
- CALL FIND_BULLCP ! See if BULLCP is running
-
- IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch
- CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder #
- READ (BULL_PARAMETER,'(I<LEN_P>)') FOLDER_NUMBER
- CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder
- CALL CLEANUP_BULLFILE ! Cleanup empty blocks
- CALL EXIT ! all done with cleanup
- ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch
- CALL BBOARD ! look for BBOARD mail
- CALL EXIT ! all done with BBOARD
- ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control
- & CLI$PRESENT('STOP')) THEN
- CALL CREATE_BULLCP
- ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start
- IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER',
- & BULL_PARAMETER,LENP)) THEN
- CALL RUN_BULLCP ! doing what BULLCP does!
- ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN
- CALL NEWS2BULL
- END IF
- END IF
-
- CALL GETSTS(STS) ! Get process status word
-
- IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM
- IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit
- CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal
- END IF
-
- IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN
- DECNET_PROC = .FALSE.
- ERROR_UNIT = 6
-
- CALL ASSIGN_TERMINAL ! Assign terminal
-
- IF (.NOT.LOGIN_SWITCH) THEN
- INCMD = 'SELECT' ! Causes nearest folder name to be selected
- CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder
- IF (.NOT.IER) RETURN ! If can't access, exit
-
- IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED
- ! Delete expired messages
- END IF
-
-C
-C Get page size for the terminal.
-C
-
- CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH)
-
- IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) PAGE_WIDTH
- END IF
-
- IF (CLI$PRESENT('PAGE')) PAGING = .TRUE.
-
- IF (SYSTEM_SWITCH) THEN
- IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified?
- CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER)
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')')
- CALL EXIT
- END IF
- END IF
- IF (.NOT.LOGIN_SWITCH) THEN
- CALL MODIFY_SYSTEM_LIST(0)
- CALL SHOW_SYSTEM
- CALL EXIT
- END IF
- END IF
-
-C
-C Get user info stored in SYS$LOGIN. Currently, this simply stores
-C the time of the latest message read for each folder.
-C
-
- CALL OPEN_USERINFO
-
-C
-C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins.
-C
-
- IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present?
- CALL LOGIN ! Display SYSTEM bulletins
- IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit
- END IF
-
-C
-C If new bulletins have been added since the last time bulletins have been
-C read, position bulletin pointer so that next bulletin read is the first new
-C bulletin, and alert user. If READNEW set and no new bulletins, just exit.
-C
-
- IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION
-
- CALL OPEN_OLD_TAG
-
- ELSE
- IF (TEST_BULLCP()) CALL EXIT
- DECNET_PROC = .TRUE.
- ERROR_UNIT = 5
- END IF
-
-C
-C The MAIN loop for processing bulletin commands.
-C
-
- DIR_COUNT = 0 ! # directory entry to continue bulletin read from
- READ_COUNT = 0 ! # block that bulletin READ is to continue from
- FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from
- INDEX_COUNT = 0
-
- IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY)
- IF (IER.NE.1) THEN
- HELP_DIRECTORY = 'SYS$HELP:'
- HLEN = 9
- ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND.
- & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN
- HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':'
- HLEN = HLEN + 1
- END IF
-
- LPROMPT = TRIM(COMMAND_PROMPT)
- PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' '
- LPROMPT = LPROMPT + 2
-
- DO WHILE (1)
-
- IF (.NOT.DCL_COMMAND) THEN
- CALL COMMAND_INPUT(IER)
- ELSE
- IF (INDEX(DCL_CMD,';').GT.0) THEN
- INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1)
- DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:)
- ELSE
- INCMD = DCL_CMD
- DCL_CMD = ' '
- END IF
- IER = TRIM(INCMD)
- END IF
-
- IF (IER.EQ.-2) THEN
- IER = RMS$_EOF
- ELSE IF (IER.LE.0) THEN
- IER = %LOC(CLI$_NOCOMD)
- ELSE
- DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')
- INCMD = INCMD(2:IER)
- IER = IER - 1
- END DO
- IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN
- INCMD = 'READ '//INCMD
- END IF
- IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT)
- END IF
-
- IF (IER.EQ.RMS$_EOF) THEN
- CALL EXIT ! If no command, exit
- ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered
- INCMD = ' ' ! Make sure there is none
- LEN_P = 0 ! Indicate no parameter in command
- IF (DIR_COUNT.GT.0) THEN ! If still more dir entries
- CALL DIRECTORY(DIR_COUNT) ! continue outputting them
- ELSE IF (INDEX_COUNT.GT.0) THEN
- CALL FULL_DIR(INDEX_COUNT)
- ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries
- CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them
- ELSE ! Else try to read next bulletin
- CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one
- DIR_COUNT = 0
- FOLDER_COUNT = 0
- INDEX_COUNT = 0
- END IF
- GO TO 100 ! Loop to read new command
- ELSE IF (.NOT.IER) THEN ! If command has error
- GO TO 100 ! ask for new command
- END IF
-
- IER = MIN(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/'))
- IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers
- CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command.
-
- IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN
- DIR_COUNT = -1
- CALL DIRECTORY(DIR_COUNT)
- INCMD = ' '
-C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN
-C FOLDER_COUNT = -1
-C CALL DIRECTORY_FOLDERS(FOLDER_COUNT)
-C INCMD = ' '
- ELSE
- DIR_COUNT = 0 ! Reinit display pointers
- READ_COUNT = 0
- FOLDER_COUNT = 0
- INDEX_COUNT = 0
- END IF
-
- IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL'
- & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN
- ! FOLDER can only be read?
- WRITE (6,'('' ERROR: Access to folder limited to reading.'')')
- ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD?
- IF (REMOTE_SET.GE.3) THEN
- INCMD = 'POST'
- CALL RESPOND
- ELSE
- CALL ADD
- END IF
- ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH?
- CALL ATTACH
- ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK?
- IF (BULL_POINT.LE.1) THEN
- WRITE(6,1060)
- ELSE
- CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous
- END IF
- ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE?
- CALL REPLACE ! Replace old bulletin
- ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY?
- CALL MOVE(.FALSE.)
- ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE?
- CALL CREATE_FOLDER ! Go create the folder
- ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT?
- READ_COUNT = -1 ! Reread current message from beginning.
- CALL READ_MSG(READ_COUNT,BULL_POINT)
- ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE?
- CALL DELETE_MSG ! Go delete bulletin
- ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY?
- IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified?
- & CLI$PRESENT('NEWS')) THEN ! or /NEWS?
- CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders
- ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified?
- CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder
- IF (IER) THEN ! If successful
- CALL DIRECTORY(DIR_COUNT) ! Show messages
- END IF
- ELSE
- CALL DIRECTORY(DIR_COUNT) ! Show messages
- END IF
- ELSE IF (INCMD(:4).EQ.'FILE'.OR.
- & INCMD(:4).EQ.'EXTR') THEN ! FILE?
- CALL FILE ! Copy bulletin to file
- ELSE IF (INCMD(:1).EQ.'E'.OR.
- & INCMD(:4).EQ.'QUIT') THEN ! EXIT?
- CALL EXIT ! Exit from program
- ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST?
- READ_COUNT = -1
- BULL_READ = 1
- CALL READ_MSG(READ_COUNT,BULL_READ)
- ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP?
- CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help
- ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX?
- INDEX_COUNT = 1
- CALL FULL_DIR(INDEX_COUNT)
- ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST?
- READ_COUNT = -1
- BULL_READ = 99999
- CALL READ_MSG(READ_COUNT,BULL_READ)
- ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK?
- CALL TAG(.TRUE.,1)
- ELSE IF (INCMD(:4).EQ.'MAIL'.OR.
- & INCMD(:4).EQ.'FORW') THEN ! MAIL?
- CALL MAIL
- ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY?
- CALL MODIFY_FOLDER
- ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE?
- CALL MOVE(.TRUE.)
- ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS
- CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders
- ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT?
- CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin
- ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST?
- CALL RESPOND
- ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT?
- CALL PRINT(0,.TRUE.) ! Printout bulletin
- ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ?
- IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified?
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) BULL_READ ! Yes
- READ_COUNT = -1
- CALL READ_MSG(READ_COUNT,BULL_READ)
- ELSE
- CALL READ_MSG(READ_COUNT,BULL_POINT+1)
- END IF
- ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE?
- CALL REMOVE_FOLDER
- ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY?
- IF (REMOTE_SET.GE.3.OR.
- & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN
- CALL RESPOND
- ELSE
- CALL REPLY
- END IF
- ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND?
- CALL RESPOND
- ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH?
- CALL SEARCH(READ_COUNT)
- ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN?
- CALL TAG(.TRUE.,2)
- ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT?
- CALL SELECT_FOLDER(.TRUE.,IER)
- ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET?
- CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)
- IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER?
- CALL SELECT_FOLDER(.TRUE.,IER)
- ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS?
- CALL SET_PRIV
- ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE?
- PAGING = .TRUE.
- WRITE (6,'('' PAGE has been set.'')')
- ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD?
- CALL SET_KEYPAD
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD?
- CALL SET_NOKEYPAD
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE?
- PAGING = .FALSE.
- WRITE (6,'('' NOPAGE has been set.'')')
- ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN
- WRITE (6,'('' ERROR: Invalid command for remote folder.'')')
- ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM?
- CALL SET_SYSTEM(.TRUE.)
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM?
- CALL SET_SYSTEM(.FALSE.)
- ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD?
- CALL SET_BBOARD(.TRUE.)
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD?
- CALL SET_BBOARD(.FALSE.)
- ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP?
- CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP?
- CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP')
- ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP?
- CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP?
- CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP')
- ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST?
- CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST?
- CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST')
- ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS?
- CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS?
- CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(1,-1,-1)
- ELSE
- CALL SET_USER_FLAG(1,-1,-1)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE?
- IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)
- IF (LEN_P.LE.3) THEN
- READ (BULL_PARAMETER,'(I<LEN_P>)') LIMIT
- CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT)
- ELSE
- WRITE (6,'('' ERROR: Invalid expiration specified.'')')
- END IF
- ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE?
- CALL SET_NODE(.TRUE.)
- ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE?
- CALL SET_NODE(.FALSE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE?
- CALL SET_FOLDER_EXPIRE_LIMIT(0)
- ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(0,-1,-1)
- ELSE
- CALL SET_USER_FLAG(0,-1,-1)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,1)
- ELSE
- CALL SET_USER_FLAG(-1,0,1)
- END IF
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,0)
- ELSE
- CALL SET_USER_FLAG(-1,0,0)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,1,0)
- ELSE
- CALL SET_USER_FLAG(-1,1,0)
- END IF
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,0)
- ELSE
- CALL SET_USER_FLAG(-1,0,0)
- END IF
- ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,1,1)
- ELSE
- CALL SET_USER_FLAG(-1,1,1)
- END IF
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,0)
- ELSE
- CALL SET_USER_FLAG(-1,0,0)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS?
- CALL SET_ACCESS(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS?
- CALL SET_ACCESS(.FALSE.)
- ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF
- CALL SET_BRIEF_CONTINUOUS(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF
- CALL SET_BRIEF_CONTINUOUS(.FALSE.)
- ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC?
- CALL SET_GENERIC(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?
- CALL SET_GENERIC(.FALSE.)
- ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN?
- CALL SET_LOGIN(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN?
- CALL SET_LOGIN(.FALSE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE?
- CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE?
- CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE')
- ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE?
- CALL SET_DEFAULT_EXPIRE
- END IF
- ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW?
- CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P)
- IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS?
- CALL SHOW_FLAGS
- ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER?
- CALL SHOW_FOLDER
- ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD
- CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB')
- ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW?
- SAVE_FOLDER_NUMBER = FOLDER_NUMBER
- SAVE_FOLDER = FOLDER
- CALL NEW_MESSAGE_NOTIFICATION
- FOLDER1 = SAVE_FOLDER
- FOLDER_NUMBER = SAVE_FOLDER_NUMBER
- CALL SELECT_FOLDER(.FALSE.,IER)
- ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?
- CALL SHOW_PRIV
- ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER?
- CALL SHOW_USER
- ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION?
- CALL SHOW_VERSION
- END IF
- ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command?
- CALL SPAWN_PROCESS
- ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command?
- CALL SUBSCRIBE
- ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE?
- CALL UNDELETE
- ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK?
- CALL TAG(.FALSE.,1)
- ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN?
- CALL TAG(.FALSE.,2)
- ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command?
- CALL UNSUBSCRIBE
- END IF
-
-100 CONTINUE
-
- IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT
-
- END DO
-
-1010 FORMAT(Q,A)
-1060 FORMAT(' ERROR: There are no more preceding messages.')
-
- END
-
-
-
- SUBROUTINE COMMAND_INPUT(IER)
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT
- CHARACTER*42 PROMPT
-
- CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT))
-
- RETURN
-
- END
-
-
-
-
-
- SUBROUTINE ADD
-C
-C SUBROUTINE ADD
-C
-C FUNCTION: Adds bulletin to bulletin file.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
- & NODE_ERROR,POINT_NODE
- CHARACTER*32 NODES(10)
- LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
-
- COMMON /DECNET/ DECNET_PROC,ERROR_UNIT
- LOGICAL DECNET_PROC
-
- COMMON /EDIT/ EDIT_DEFAULT
- DATA EDIT_DEFAULT/.FALSE./
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /LAST_RECORD_WRITTEN/ OCOUNT
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /INDESCRIP/ INDESCRIP
- CHARACTER*(LINE_LENGTH) INDESCRIP
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
- CHARACTER NODENAME*8
-
- CHARACTER INEXDATE*11,INEXTIME*11
-
- CHARACTER INLINE*80,OLD_FOLDER*25,LOCAL_NODE*8
-
- EXTERNAL CLI$_ABSENT,CLI$_NEGATED
-
- EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND.
- & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))
-
- IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN
- WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')')
- RETURN
- END IF
-
- CALL DISABLE_CTRL ! Disable CTRL-Y & -C
-
- ALLOW = SETPRV_PRIV()
-
- OLD_FOLDER_NUMBER = FOLDER_NUMBER
- OLD_FOLDER = FOLDER
-
- LEN_P = 0
-
- IF (CLI$PRESENT('EXTRACT')) THEN
- BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'
- LEN_P = TRIM(BULL_PARAMETER)
- OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,
- & RECL=LINE_LENGTH,
- & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')
-
- IF (IER.NE.0) THEN
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- GO TO 910
- END IF
-
- CALL OPEN_BULLFIL_SHARED
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- IF (CLI$PRESENT('NOINDENT')) THEN
- WRITE (3,'(A)') INPUT(:ILEN)
- ELSE
- WRITE (3,'(A)') '>'//INPUT(:ILEN)
- END IF
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END DO
-
-90 CALL CLOSE_BULLFIL
- END IF
-
- IF (CLI$PRESENT('FILESPEC')) THEN
- IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)
- CALL DISABLE_PRIVS
- IF (.NOT.CLI$PRESENT('EXTRACT')) THEN
- OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',
- & READONLY,SHARED,ERR=920,FORM='FORMATTED')
- ELSE
- OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',
- & READONLY,SHARED,ERR=920,FORM='FORMATTED')
- IER = 0
- ICOUNT = 0
- DO WHILE (IER.EQ.0)
- READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- IF (IER.EQ.0) THEN
- IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' '
- ICOUNT = ICOUNT + 1
- WRITE (3,'(A)') INPUT(:ILEN)
- END IF
- END DO
- CLOSE (UNIT=4)
- BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'
- LEN_P = TRIM(BULL_PARAMETER)
- END IF
- CALL ENABLE_PRIVS ! Reset SYSPRV privileges
- END IF
-
- SELECT_FOLDERS = .FALSE.
- IF (CLI$PRESENT('SELECT_FOLDER')) THEN
- CALL GET_FOLDER_INFO(IER)
- IF (.NOT.IER) GO TO 910
- SELECT_FOLDERS = .TRUE.
- ELSE
- NODE_NUM = 1
- NODES(1) = OLD_FOLDER
- END IF
-
- IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and
- & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified?
- WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')')
- GO TO 910
- END IF
-
- IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND.
- & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present?
- & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?
- & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present?
- WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')')
- GO TO 910
- END IF
-
- IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present?
- IF (.NOT.ALLOW) THEN ! If no privileges
- WRITE(ERROR_UNIT,1070) ! Tell user
- GO TO 910 ! and abort
- END IF
- SYSTEM = 1 ! Set system bit
- ELSE
- SYSTEM = 0 ! Clear system bit
- END IF
-
- IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?
- IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges
- WRITE(ERROR_UNIT,1080) ! Tell user
- GO TO 910 ! and abort
- ELSE IF (CLI$PRESENT('CLUSTER')) THEN
- SYSTEM = SYSTEM.OR.8
- END IF
- END IF
-
- IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?
- IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present
- & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- WRITE(ERROR_UNIT,1083)
- GO TO 910
- ELSE
- SYSTEM = SYSTEM.OR.2 ! Set permanent bit
- INEXDATE = '5-NOV-2000'
- INEXTIME = '00:00:00.00'
- END IF
- END IF
-
- IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?
- IF (.NOT.ALLOW) THEN ! If no privileges
- WRITE(ERROR_UNIT,1082) ! Tell user
- GO TO 910 ! and abort
- ELSE
- IER = CLI$GET_VALUE('SHUTDOWN',INLINE)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- IF (REMOTE_SET) THEN ! Can't specify node name if
- WRITE (6,1090) ! remote folder, as no code
- GO TO 910 ! present to send the name.
- END IF
- CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE)
- IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name
- ELSE
- CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
- END IF
- SYSTEM = SYSTEM.OR.4 ! Set shutdown bit
- INEXDATE = '5-NOV-2000'
- WRITE (INEXTIME,'(I4)') NODE_NUMBER
- WRITE (INEXTIME(7:),'(I4)') NODE_AREA
- DO I=1,11
- IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0'
- END DO
- INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'//
- & INEXTIME(7:8)//'.'//INEXTIME(9:10)
- END IF
- END IF
-
- SELECT_NODES = .FALSE.
- IF (CLI$PRESENT('NODES')) THEN
- CALL GET_NODE_INFO
- IF (NODE_ERROR) GO TO 940
- SELECT_NODES = .TRUE.
- END IF
-
- IF ((SYSTEM.AND.7).LE.1) THEN ! Not permanent or shutdown
- CALL GET_EXPIRED(INPUT,IER)
- IF (.NOT.IER) GO TO 910
- INEXDATE = INPUT(:11)
- INEXTIME = INPUT(13:)
- END IF
-
- IF (INCMD(:3).EQ.'REP') THEN ! REPLY?
- LENDES = TRIM(INDESCRIP) ! filled in by main subroutine
- ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified
- CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)
- ELSE
- WRITE(6,1050) ! Request header for bulletin
- CALL GET_LINE(INDESCRIP,LENDES) ! Get input line
- IF (LENDES.LE.0) GO TO 910
- END IF
-
- LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: "
-
-C
-C If file specified in ADD command, read file to obtain bulletin.
-C Else, read the bulletin from the terminal.
-C
-
- IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified
- IF (LEN_P.EQ.0) THEN ! If no file param specified
- CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
- OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',
- & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')
- LEN_P = 1
- ELSE
- CLOSE (UNIT=3)
- CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')
- IF (CLI$PRESENT('EXTRACT')) THEN
- CONTEXT = 0
- CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT)
- VERSION = INDEX(INPUT,';') + 1
- IF (INPUT(VERSION:VERSION).EQ.'1') THEN
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- END IF
- END IF
- OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',
- & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')
- END IF
- END IF
-
- ICOUNT = 0 ! Line count for bulletin
-
- END = 0
- BLENGTH = 35
- IF (CLI$PRESENT('BELL')) BLENGTH = 37
- IF (LEN_P.GT.0) THEN ! If file param in ADD command
- DO WHILE(1) ! Read until end of file to
- READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count
- IF (ILEN.GT.LINE_LENGTH) GO TO 950
- ICOUNT = ICOUNT + 1 + MIN(ILEN,80)
- BLENGTH = BLENGTH + ILEN - 1 + 2
- IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with
- END DO ! 1 space for blank line
- ELSE ! If no input file
- OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR',
- & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message
- WRITE (6,1000) ! Request input from terminal
- ILEN = LINE_LENGTH + 1 ! Length of input line
- ICOUNT = 0 ! Character count counter
- DO WHILE (ILEN.GE.0) ! Input until no more input
- CALL GET_LINE(INPUT,ILEN) ! Get input line
- IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long
- WRITE(6,'('' ERROR: Input line length > '',I,
- & ''. Reinput:'')') LINE_LENGTH
- ELSE IF (ILEN.GE.0) THEN ! If good input line entered
- ICOUNT = ICOUNT + ILEN ! Update counter
- BLENGTH = BLENGTH + ILEN - 1 + 2
- WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file
- END IF
- END DO
- IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out
-10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out
- ENDIF
-
- REWIND (UNIT=3)
-
- BRDCST = .FALSE.
-
- IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN
- WRITE (6,'('' Message is too long for broadcasting.'',
- & '' A truncated message will be broadcast.'')')
- CALL GET_INPUT_PROMPT(INPUT,ILEN,
- & 'Type C to continue, A to only ADD message, or Q to Quit: ')
- IF (STREQ(INPUT(:1),'Q')) THEN
- GO TO 910
- ELSE IF (STREQ(INPUT(:1),'A')) THEN
- BRDCST = .TRUE.
- END IF
- END IF
-
- IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN
- INLINE = 'ADD'
- IF (CLI$PRESENT('SYSTEM'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM'
- IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST)
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST'
- IF (CLI$PRESENT('PERMANENT'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'
- IF (CLI$PRESENT('SHUTDOWN'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN'
- IF (CLI$PRESENT('BELL'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL'
-
- LEN_INLINE = STR$POSITION(INLINE,' ') - 1
-
- DO POINT_NODE=1,NODE_NUM ! Write out command to nodes
- INLINE = INLINE(:LEN_INLINE)
-
- WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE
- IF ((SYSTEM.AND.7).LE.1)
- ! If not permanent or shutdown specify date
- & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME
- WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES)
- IER = 0
- DO WHILE (IER.EQ.0)
- READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- ILEN = MIN(ILEN,LINE_LENGTH)
- IF (IER.EQ.0) THEN
- WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)
- END IF
- END DO
- WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26)
- READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT
- IF (INPUT.EQ.'END') THEN
- WRITE (6,'('' Message successfully sent to node '',A)')
- & NODES(POINT_NODE)
- ELSE
- WRITE (6,'('' Error while sending message to node '',A)')
- & NODES(POINT_NODE)
- WRITE (6,'(A)') INPUT(:80)
- GO TO 940
- END IF
- REWIND (UNIT=3)
- END DO
- END IF
-
- IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95
- ! Exit if local node not specified.
-
- IF (.NOT.SELECT_FOLDERS) THEN
- NODE_NUM = 1 ! No folders specified so just
- NODES(1) = FOLDER ! add to select folder
- END IF
-
- IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE)
- LNODE = TRIM(LOCAL_NODE)
- LUSER = TRIM(USERNAME)
-
-C
-C Add bulletin to bulletin file and directory entry for to directory file.
-C
-
- DO I = 1,NODE_NUM
-
- IF (FOLDER.NE.NODES(I)) THEN
- FOLDER_NUMBER = -1
- FOLDER1 = NODES(I)
- CALL SELECT_FOLDER(.FALSE.,IER)
- ELSE
- IER = 1
- END IF
-
- IF (IER) THEN
- CALL OPEN_BULLDIR ! Prepare to add dir entry
-
- DESCRIP=INDESCRIP(:LENDES) ! Description header
- EXDATE=INEXDATE ! Expiration date
- EXTIME=INEXTIME
- FROM = USERNAME ! Username
-
- CALL OPEN_BULLFIL ! Prepare to add bulletin
-
- CALL READDIR(0,IER) ! Get NBLOCK
- IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0
-
- REWIND (UNIT=3)
- OBLOCK = NBLOCK+1
- CALL STORE_BULL(LNODE+LUSER+6,'From: '//
- & LOCAL_NODE(:LNODE)//USERNAME(:LUSER),OBLOCK)
- IF (LENDES.GT.LEN(DESCRIP)) THEN
- CALL STORE_BULL(LENDES+6,
- & 'Subj: '//INDESCRIP(:LENDES),OBLOCK)
- END IF
- CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin
- IF (IER.NE.0) GO TO 930 ! Error in creating bulletin
- LENGTH = OCOUNT - (NBLOCK+1) + 1
-C
-C Broadcast the bulletin if requested.
-C
- IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND.
- & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN
- CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL'))
- BRDCST = .TRUE.
- IF (.NOT.CLI$PRESENT('LOCAL')) THEN
- CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),
- & CLI$PRESENT('CLUSTER'))
- END IF
-C
-C If the folder is remote, and local node is not the node which BULLCP is
-C on, don't broadcast, as it will be broadcasted by BULLCP. The remote
-C node will distribute the broadcast to nodes that are running BULLCP,
-C but not if the node that originated the message matches. However, it
-C has no way of knowing that the originating node is in the same cluster
-C as that of the BULLCP node.
-C
- IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME)
- & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET)
- & CALL BROADCAST(
- & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER'))
- END IF
-
- CALL CLOSE_BULLFIL ! Finished adding bulletin
-
- CALL ADD_ENTRY ! Add the new directory entry
-
- IF (FOLDER_NUMBER.GE.0) THEN
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- CALL UPDATE_FOLDER ! Update info in folder file
-C
-C If user is adding message, an no new messages, update last read time for
-C folder, so user is not alerted of new message which is owned by user.
-C
- IF (DIFF.GE.0) THEN
- LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)
- LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)
- END IF
- END IF
-
- CALL CLOSE_BULLDIR ! Totally finished with add
- ELSE
- WRITE (6,'('' ERROR: Unable to add message to '',A)')
- & NODES(I)
- END IF
- END DO
-
-95 CLOSE (UNIT=3) ! Close the input file
- IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked
-
-100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C
- DO I=10,NODE_NUM+9
- CLOSE (UNIT=I)
- END DO
-
- IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN
- FOLDER_NUMBER = OLD_FOLDER_NUMBER
- FOLDER1 = OLD_FOLDER
- CALL SELECT_FOLDER(.FALSE.,IER)
- END IF
-
- IF (CLI$PRESENT('EXTRACT')) THEN
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- END IF
-
- RETURN
-
-910 WRITE(ERROR_UNIT,1010)
- CLOSE (UNIT=3,ERR=100)
- GOTO 100
-
-920 WRITE(ERROR_UNIT,1020)
- CALL ENABLE_PRIVS
- GOTO 100
-
-930 WRITE (ERROR_UNIT,1025)
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- CLOSE (UNIT=3)
- GO TO 100
-
-940 WRITE (6,1015) NODES(POINT_NODE)
- WRITE (6,1018)
- CLOSE (UNIT=3)
- GO TO 100
-
-950 WRITE (6,1030) LINE_LENGTH
- CLOSE (UNIT=3)
- GO TO 100
-
-1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')
-1010 FORMAT (' No message was added.')
-1015 FORMAT (' ERROR: Unable to reach node ',A)
-1018 FORMAT (' Try using /FOLDER instead of /NODE.')
-1020 FORMAT (' ERROR: Unable to open specified file.')
-1025 FORMAT (' ERROR: Unable to add message to file.')
-1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')
-1050 FORMAT (' Enter description header.')
-1070 FORMAT (' ERROR: SETPRV privileges are needed for system
- & messages.')
-1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast
- & messages.')
-1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown
- & messages.')
-1083 FORMAT (' ERROR: Folder has expiration limit.')
-1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown
- & if folder is remote.')
-2010 FORMAT(A)
-2020 FORMAT(1X,A)
-
- END
-
-
- SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23
-
- INTEGER BTIM(2),TODAY_BTIM(2)
-
- IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)
- IF (.NOT.IER) RETURN
-
- BTIM(1) = -BTIM(1) ! Convert to negative delta time
- BTIM(2) = -BTIM(2)-1
-
- IER = SYS$ASCTIM(TLEN,TODAY_DATE,,)
- CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM)
-
- CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM)
-
- RETURN
- END
-
-
-
- SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- PARAMETER BRDCST_LIMIT = 82*12 + 2
- CHARACTER*(BRDCST_LIMIT) BMESSAGE
-
- COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
- CHARACTER NODENAME*8
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER LOCALNODE*8,RESPONSE*1
-
- IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN
-
- CALL OPEN_BULLUSER_SHARED
-
- REMOTE_FOUND = .FALSE.
- TEMP_USER = ':'
-
- DO WHILE (.NOT.REMOTE_FOUND)
- DO WHILE (REC_LOCK(IER))
- READ (4,KEYGT=TEMP_USER,IOSTAT=IER)
- & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG
- END DO
- IF (TEMP_USER(:1).NE.':') THEN
- CALL CLOSE(4)
- RETURN
- END IF
- REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER)
- END DO
-
- CALL CLOSE (4)
-
-100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,
- & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')
-
- IF (IER.EQ.0) THEN
- IER = 0
- I = 1
- DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)
- WRITE (17,'(4A)',IOSTAT=IER)
- & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))
- I = I + 128
- END DO
- IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER)
- & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER
- ELSE
- WRITE (6,'('' BULLCP not responding to request to'',
- & '' broadcast to other nodes.'')')
- CALL GET_INPUT_PROMPT(RESPONSE,LEN,
- & 'Want to try again? (Y/N with Y as default): ')
- IF (RESPONSE.NE.'n'.AND.RESPONSE.NE.'N') THEN
- WRITE (6,'('' Trying again...'')')
- GO TO 100
- ELSE
- WRITE (6,'('' Broadcast aborting. '',
- & ''Continuing with message addition.'')')
- END IF
- END IF
-
- CLOSE (UNIT=17)
-
- RETURN
- END
-
-
-
-
- INTEGER FUNCTION ERROR_TRAP
-
- ERROR_TRAP = 1
-
- RETURN
- END
-
-
-
- SUBROUTINE REPLY
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /INDESCRIP/ INDESCRIP
- CHARACTER*(LINE_LENGTH) INDESCRIP
-
- IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read
- WRITE(6,'('' ERROR: You have not read any message.'')')
- RETURN ! And return
- END IF
-
- CALL OPEN_BULLDIR_SHARED
-
- CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin
-
- IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found?
- WRITE(6,'('' ERROR: Bulletin was not found.'')')
- CALL CLOSE_BULLDIR ! If not, then error out
- RETURN
- END IF
-
- CALL OPEN_BULLFIL_SHARED
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- INDESCRIP = INPUT(7:)
- ELSE
- INDESCRIP = DESCRIP
- END IF
-
- CALL CLOSE_BULLFIL
-
- CALL CLOSE_BULLDIR
-
- WRITE (6,'('' Adding REPLY message with the subject:'')')
- IF (STREQ(INDESCRIP(:3),'RE:')) THEN
- INDESCRIP = 'RE:'//INDESCRIP(4:)
- ELSE
- INDESCRIP = 'RE: '//INDESCRIP
- END IF
- WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP))
-
- CALL ADD
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CRELNM(INPUT,OUTPUT)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PSLDEF)'
-
- INCLUDE '($LNMDEF)'
-
- CHARACTER*(*) INPUT,OUTPUT
-
- CALL INIT_ITMLST
- CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT))
- CALL END_ITMLST(CRELNM_ITMLST)
-
- IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER,
- & %VAL(CRELNM_ITMLST))
-
- RETURN
- END
-
-
-
- SUBROUTINE GETPRIV
-C
-C SUBROUTINE GETPRIV
-C
-C FUNCTION:
-C To get process privileges.
-C OUTPUTS:
-C PROCPRIV - Returned privileges
-C
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
-
- COMMON /REALPROC/ REALPROCPRIV(2)
-
- INCLUDE '($JPIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info
-
- REALPROCPRIV(1) = PROCPRIV(1)
- REALPROCPRIV(2) = PROCPRIV(2)
-
- RETURN
- END
-
-
-
-
- LOGICAL FUNCTION SETPRV_PRIV
- IMPLICIT INTEGER (A-Z)
-
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
- DATA NEEDPRIV/0,0/
-
- INCLUDE '($PRVDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN
- CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file
- CALL READ_USER_FILE_HEADER(IER)
- CALL CLOSE_BULLUSER
- NEEDPRIV(1) = USERPRIV(1)
- NEEDPRIV(2) = USERPRIV(2)
- END IF
-
- IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR.
- & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN
- SETPRV_PRIV = .TRUE.
- ELSE
- SETPRV_PRIV = .FALSE.
- END IF
-
- RETURN
- END
-
-
-
- LOGICAL FUNCTION OPER_PRIV
- IMPLICIT INTEGER (A-Z)
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
- INCLUDE '($PRVDEF)'
- OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER)
- RETURN
- END
-
-
-
- SUBROUTINE GETUSER(USERNAME)
-C
-C SUBROUTINE GETUSER
-C
-C FUNCTION:
-C To get username of present process.
-C OUTPUTS:
-C USERNAME - Username owner of present process.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PRVDEF)'
-
- CHARACTER*(*) USERNAME ! Limit is 12 characters
-
- INCLUDE '($JPIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info
-
- RETURN
- END
-
-
-
-
- LOGICAL FUNCTION CAPTIVE()
-
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE '($UAIDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- DATA READ_UAI/.FALSE./
-
- TYPE = 1
-
- IF (.NOT.READ_UAI) THEN
- CALL INIT_ITMLST
- CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))
- CALL END_ITMLST(GETUAI_ITMLST)
- IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)
- READ_UAI = .TRUE.
- END IF
-
- CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0
- & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SPAWN_PROCESS
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /KEYPAD/ KEYPAD_MODE
-
- CHARACTER*255 COMMAND
-
- IF (CAPTIVE()) THEN
- WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')
- RETURN
- END IF
-
- CALL DISABLE_PRIVS
-
- SAVE_KEYPAD_MODE = KEYPAD_MODE
- IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD
-
- IF (CLI$PRESENT('COMMAND')) THEN
- CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN)
- COMMAND = '$'//COMMAND(:CLEN)
- CALL LIB$SPAWN(COMMAND(:CLEN+1))
- ELSE
- CALL LIB$SPAWN()
- END IF
-
- IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD
-
- CALL ENABLE_PRIVS
-
- RETURN
- END
-
-
- SUBROUTINE ATTACH
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /KEYPAD/ KEYPAD_MODE
-
- COMMON /TERM_CHAN/ TERM_CHAN
-
- INCLUDE '($JPIDEF)'
-
- CHARACTER*15 PROCESS
-
- IF (CLI$PRESENT('PROCESS')) THEN
- CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN)
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)
- ELSE
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)
- END IF
-
- IER = SYS$CANCEL(%VAL(TERM_CHAN))
-
- SAVE_KEYPAD_MODE = KEYPAD_MODE
- IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD
-
- IF (IER) IER = LIB$ATTACH(PROCESS_ID)
- IF (.NOT.IER) CALL SYS_GETMSG(IER)
-
- IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE '($BRKDEF)'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
-C
-C The largest message that can be broadcasted is dependent on system
-C and user quotas. The following limit is 12 lines of ( 80 characters +
-C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts
-C shouldn't be too large anyway.
-C
-
- PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7)
-
- PARAMETER BRDCST_LIMIT = 82*12 + 2
- CHARACTER*(BRDCST_LIMIT) BROAD
-
- COMMON /BROAD_MESSAGE/ BROAD,BLENGTH
-
- IF (RING_BELL) THEN ! Include BELL in message?
- BROAD(:36) = ! Say who the bulletin is from
- & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM
- BLENGTH = 37 ! Start adding next line here
- ELSE
- BROAD(:34) = ! Say who the bulletin is from
- & CR//LF//LF//'NEW BULLETIN FROM: '//FROM
- BLENGTH = 35 ! Start adding next line here
- END IF
-
- IF (REMOTE_SET) REWIND (UNIT=3)
-
- END = 0
- ILEN = LINE_LENGTH + 1
- I = 0
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- IF (REMOTE_SET) THEN
- READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- IF (IER.NE.0) RETURN
- ELSE
- CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0) I = I + 1
- IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND.
- & INPUT(:6).NE.'Subj: '))) THEN
- END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be
- IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?
- BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input
- BLENGTH = END + 1 ! Reset pointer
- END IF
- END DO
-
- RETURN
-
- ENTRY BROADCAST(ALL,CLUSTER)
-
- CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast
-
- IF (ALL) THEN ! Should we broadcast to ALL?
- IF (CLUSTER) THEN
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,)
- ELSE
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLTERMS),,,,,,,)
- END IF
- ELSE ! Else just broadcast to users.
- IF (CLUSTER) THEN
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,)
- ELSE
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLUSERS),,,,,,,)
- END IF
- END IF
-
- CALL SYS$SETRWM(%VAL(0))
-
- RETURN
- END
-
-
- SUBROUTINE GET_FOLDER_INFO(IER)
-C
-C SUBROUTINE GET_FOLDER_INFO
-C
-C FUNCTION: Obtains & verifies folder names from command line.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- EXTERNAL CLI$_ABSENT
-
- COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
- & NODE_ERROR,POINT_NODE
- CHARACTER*32 NODES(10)
- LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
-
- COMMON /ACCESS/ READ_ONLY
- LOGICAL READ_ONLY
-
- CHARACTER NODE_TEMP*256
-
- NODE_NUM = 0 ! Initialize number of nodes
- DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',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) THEN
- NODES(NODE_NUM) = NODE_TEMP(:COMMA-1)
- NODE_TEMP = NODE_TEMP(COMMA+1:)
- ELSE
- NODES(NODE_NUM) = NODE_TEMP
- NODE_TEMP = ' '
- END IF
- NLEN = TRIM(NODES(NODE_NUM))
- IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN
- NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL'
- END IF
- FOLDER_NUMBER = -1
- FOLDER1 = NODES(NODE_NUM)
- CALL SELECT_FOLDER(.FALSE.,IER)
- IF (.NOT.IER) THEN
- WRITE (6,'('' Unable to access folder '',A)')
- & NODES(NODE_NUM)
- RETURN
- ELSE IF (READ_ONLY) THEN
- WRITE (6,'('' ERROR: No write access for folder '',A)')
- & NODES(NODE_NUM)
- IER = 0
- RETURN
- END IF
- END DO
- END DO
-
- IER = 1
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin.for_gcemod b/decus/vax91b/bulletin-net91b/bulletin.for_gcemod
deleted file mode 100644
index 349304b87ac780afea4f5e6c9e08c1725226b090..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin.for_gcemod
+++ /dev/null
@@ -1,1778 +0,0 @@
-C
-C BULLETIN.FOR, Version 6/24/91
-C Purpose: Bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE '($RMSDEF)'
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /READIT/ READIT
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
- LOGICAL PAGING /.FALSE./
-
- COMMON /CTRLY/ CTRLY
-
- COMMON /PROMPT/ COMMAND_PROMPT
- CHARACTER*39 COMMAND_PROMPT
-
- COMMON /ACCESS/ READ_ONLY
- LOGICAL READ_ONLY
-
- COMMON /DECNET/ DECNET_PROC,ERROR_UNIT
- LOGICAL DECNET_PROC
-
- EXTERNAL ERROR_TRAP
- EXTERNAL BULLETIN_SUBCOMMANDS,LIB$GET_INPUT
- EXTERNAL BULLETIN_MAINCOMMANDS,ENABLE_CTRL_EXIT
- EXTERNAL CLI$_ABSENT,CLI$_NOCOMD,CLI$_NEGATED
-
- PARAMETER PCB$M_BATCH = '4000'X
- PARAMETER PCB$M_NETWRK = '200000'X
- PARAMETER LIB$M_CLI_CTRLY = '2000000'X
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- CHARACTER HELP_DIRECTORY*64,SAVE_FOLDER*25
-
- COMMON /EDIT/ EDIT_DEFAULT
- DATA EDIT_DEFAULT/.FALSE./
-
- COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH
- COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)
- COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE
- CHARACTER*1 SEPARATE
-
- COMMON /TAGS/ BULL_TAG,READ_TAG
-
- COMMON /DEF_PROT/ ORIGINAL_DEF_PROT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT
- CHARACTER*42 PROMPT
-
- CHARACTER DCL_CMD*132
-
- CALL LIB$GET_FOREIGN(INCMD)
- DCL_COMMAND = INDEX(INCMD,' "').GT.0.OR.INCMD(:1).EQ.'"'
-
- CALL LIB$ESTABLISH(ERROR_TRAP)
- IF (.NOT.CLI$GET_VALUE('PROMPT',COMMAND_PROMPT,ILEN)) THEN
- CALL LIB$REVERT
- CALL CLI$GET_VALUE('$LINE',COMMAND_PROMPT,ILEN)
- INCMD = 'BULLETIN '//INCMD
- CALL CLI$DCL_PARSE(INCMD,BULLETIN_MAINCOMMANDS)
- ELSE
- CALL LIB$REVERT
- END IF
-
- IF (DCL_COMMAND) THEN
- IER = CLI$GET_VALUE('SELECT_FOLDER',DCL_CMD,LENP)
- IF (LENP.GT.0) THEN
- IF (DCL_CMD(LENP:LENP).EQ.'"') DCL_CMD = DCL_CMD(:LENP-1)
- IF (DCL_CMD(:1).EQ.'"') DCL_CMD = DCL_CMD(2:)
- END IF
- END IF
-
- READIT = 0
-
- LOGIN_SWITCH = CLI$PRESENT('LOGIN')
- SYSTEM_SWITCH = CLI$PRESENT('SYSTEM')
- REVERSE_SWITCH = CLI$PRESENT('REVERSE')
-
- IER = LIB$SYS_TRNLOG('BULL_DISABLE',LEN_P,BULL_PARAMETER)
- IF (IER.EQ.1.AND.LEN_P.GT.0.AND..NOT.CLI$PRESENT('STOP')) THEN
- IF (.NOT.LOGIN_SWITCH) THEN
- WRITE (6,'('' BULLETIN temporarily disabled. Try later.'')')
- END IF
- CALL EXIT
- END IF
-
- CALL SYS$SETDFPROT(,ORIGINAL_DEF_PROT)
- ! Save original default protection in case it gets changed
-
- CALL DCLEXH(%LOC(ENABLE_CTRL_EXIT)) ! Declare exit handler
-
-C
-C Check to see if CONTROL Y disabled. If so, then never disable CONTROL Y.
-C Disabling and enabling CONTROL Y is done so that a person can not break
-C while one of the data files is opened, as that would not allow anyone
-C else to modify the files. However, if CONTROL Y is already disabled,
-C this is not necessary, and should not be done!
-C
-
- CALL LIB$DISABLE_CTRL(LIB$M_CLI_CTRLY,CTRLY) ! Disable CTRL-Y & -C
- CTRLY = CTRLY .AND. LIB$M_CLI_CTRLY
- CALL GETPRIV ! Check privileges
- CALL CHECK_PRIV_IO(ERR) ! Check privileges on output I/O
- CALL LIB$ENABLE_CTRL(CTRLY,) ! Renable CTRLY-Y & -C
-
- IF (ERR.EQ.1) CALL EXIT ! I/O privilege error, so exit
-
- CALL GETUSER(USERNAME) ! Get the process's username
- IF (.NOT.LOGIN_SWITCH) CALL CHECK_BULLETIN_PRIV(USERNAME)
- ! Check if has bulletin privileges
-
- I = 1 ! Strip off folder name if specified
- DO WHILE (I.LE.ILEN)
- IF (COMMAND_PROMPT(I:I).EQ.' ') THEN
- COMMAND_PROMPT = COMMAND_PROMPT(:I-1)
- I = ILEN + 1
- ELSE
- I = I + 1
- END IF
- END DO
- ILEN = 1 ! Get executable name to use as prompt
- DO WHILE (ILEN.GT.0)
- ILEN = MAX(INDEX(COMMAND_PROMPT,':'),INDEX(COMMAND_PROMPT,']'))
- IF (ILEN.GT.0) THEN
- COMMAND_PROMPT = COMMAND_PROMPT(ILEN+1:)
- ELSE
- DO I=TRIM(COMMAND_PROMPT),1,-1
- IF (COMMAND_PROMPT(I:I).LT.'A'.OR.
- & COMMAND_PROMPT(I:I).GT.'Z') THEN
- COMMAND_PROMPT = COMMAND_PROMPT(:I-1)
- END IF
- END DO
- END IF
- END DO
- COMMAND_PROMPT = COMMAND_PROMPT(:TRIM(COMMAND_PROMPT))//'> '
- IF (COMMAND_PROMPT.EQ.'RUN> '.OR.COMMAND_PROMPT.EQ.'RU> '.OR.
- & COMMAND_PROMPT.EQ.'R> ') COMMAND_PROMPT = 'BULLETIN> '
-
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
-
- CALL CLI$GET_VALUE('SEPARATE',SEPARATE)
-
- IF (CLI$PRESENT('EDIT')) EDIT_DEFAULT = .TRUE. ! /EDIT switch test
-
- CALL FIND_BULLCP ! See if BULLCP is running
-
- IF (CLI$PRESENT('CLEANUP')) THEN ! Test for /CLEANUP switch
- CALL CLI$GET_VALUE('CLEANUP',BULL_PARAMETER,LEN_P) ! Get folder #
- READ (BULL_PARAMETER,'(I<LEN_P>)') FOLDER_NUMBER
- CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder
- CALL CLEANUP_BULLFILE ! Cleanup empty blocks
- CALL EXIT ! all done with cleanup
- ELSE IF (CLI$PRESENT('BBOARD')) THEN ! Test for /BBOARD switch
- CALL BBOARD ! look for BBOARD mail
- CALL EXIT ! all done with BBOARD
- ELSE IF (CLI$PRESENT('STARTUP').OR. ! BULLCP process control
- & CLI$PRESENT('STOP')) THEN
- CALL CREATE_BULLCP
- ELSE IF (CLI$PRESENT('BULLCP')) THEN ! This is BULLCP, so start
- IF (.NOT.CLI$GET_VALUE('SELECT_FOLDER',
- & BULL_PARAMETER,LENP)) THEN
- CALL RUN_BULLCP ! doing what BULLCP does!
- ELSE IF (BULL_PARAMETER(:LENP).EQ.'NEWS') THEN
- CALL NEWS2BULL
- END IF
- END IF
-
- CALL GETSTS(STS) ! Get process status word
-
- IF (SYSTEM_SWITCH.OR.LOGIN_SWITCH) THEN ! If BULLETIN/LOGIN or /SYSTEM
- IF ((STS.AND.PCB$M_BATCH).GT.0) CALL EXIT ! If BATCH, exit
- CALL CRELNM('SYS$INPUT','TT') ! Take input from terminal
- END IF
-
- IF ((STS.AND.PCB$M_NETWRK).EQ.0) THEN
- DECNET_PROC = .FALSE.
- ERROR_UNIT = 6
-
- CALL ASSIGN_TERMINAL ! Assign terminal
-
- IF (.NOT.LOGIN_SWITCH) THEN
- INCMD = 'SELECT' ! Causes nearest folder name to be selected
- CALL SELECT_FOLDER(.FALSE.,IER) ! Select GENERAL folder
- IF (.NOT.IER) RETURN ! If can't access, exit
-
- IF (.NOT.TEST_BULLCP()) CALL DELETE_EXPIRED
- ! Delete expired messages
- END IF
-
-C
-C Get page size for the terminal.
-C
-
- CALL GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH)
-
- IER = CLI$GET_VALUE('WIDTH',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) PAGE_WIDTH
- END IF
-
- IF (CLI$PRESENT('PAGE')) PAGING = .TRUE.
-
- IF (SYSTEM_SWITCH) THEN
- IER = CLI$GET_VALUE('SYSTEM',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Days specified?
- CALL SUBTIME(SYSTEM_LOGIN_BTIM,BULL_PARAMETER(:LEN_P),IER)
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Invalid parameter in /SYSTEM.'')')
- CALL EXIT
- END IF
- END IF
- IF (.NOT.LOGIN_SWITCH) THEN
- CALL MODIFY_SYSTEM_LIST(0)
- CALL SHOW_SYSTEM
- CALL EXIT
- END IF
- END IF
-
-C
-C Get user info stored in SYS$LOGIN. Currently, this simply stores
-C the time of the latest message read for each folder.
-C
-
- CALL OPEN_USERINFO
-
-C
-C If /LOGIN, display SYSTEM bulletins and subject of non-SYSTEM bulletins.
-C
-
- IF (LOGIN_SWITCH.OR.SYSTEM_SWITCH) THEN ! Is /LOGIN present?
- CALL LOGIN ! Display SYSTEM bulletins
- IF (READIT.EQ.0) CALL EXIT ! If no READNEWs not set, exit
- END IF
-
-C
-C If new bulletins have been added since the last time bulletins have been
-C read, position bulletin pointer so that next bulletin read is the first new
-C bulletin, and alert user. If READNEW set and no new bulletins, just exit.
-C
-
- IF (.NOT.DCL_COMMAND) CALL NEW_MESSAGE_NOTIFICATION
-
- CALL OPEN_OLD_TAG
-
- ELSE
- IF (TEST_BULLCP()) CALL EXIT
- DECNET_PROC = .TRUE.
- ERROR_UNIT = 5
- END IF
-
-C
-C The MAIN loop for processing bulletin commands.
-C
-
- DIR_COUNT = 0 ! # directory entry to continue bulletin read from
- READ_COUNT = 0 ! # block that bulletin READ is to continue from
- FOLDER_COUNT = 0 ! # folder entry to continue SHOW/ALL folder from
- INDEX_COUNT = 0
-
- IER = LIB$SYS_TRNLOG('BULL_HELP',HLEN,HELP_DIRECTORY)
- IF (IER.NE.1) THEN
- HELP_DIRECTORY = 'SYS$HELP:'
- HLEN = 9
- ELSE IF (HELP_DIRECTORY(HLEN:HLEN).NE.':'.AND.
- & HELP_DIRECTORY(HLEN:HLEN).NE.']') THEN
- HELP_DIRECTORY = HELP_DIRECTORY(:HLEN)//':'
- HLEN = HLEN + 1
- END IF
-
- LPROMPT = TRIM(COMMAND_PROMPT)
- PROMPT = CHAR(10)//COMMAND_PROMPT(:LPROMPT)//' '
- LPROMPT = LPROMPT + 2
-
- DO WHILE (1)
-
- IF (.NOT.DCL_COMMAND) THEN
- CALL COMMAND_INPUT(IER)
- ELSE
- IF (INDEX(DCL_CMD,';').GT.0) THEN
- INCMD = DCL_CMD(:INDEX(DCL_CMD,';')-1)
- DCL_CMD = DCL_CMD(INDEX(DCL_CMD,';')+1:)
- ELSE
- INCMD = DCL_CMD
- DCL_CMD = ' '
- END IF
- IER = TRIM(INCMD)
- END IF
-
- IF (IER.EQ.-2) THEN
- IER = RMS$_EOF
- ELSE IF (IER.LE.0) THEN
- IER = %LOC(CLI$_NOCOMD)
- ELSE
- DO WHILE (IER.GT.0.AND.INCMD(:1).EQ.' ')
- INCMD = INCMD(2:IER)
- IER = IER - 1
- END DO
- IF (IER.GT.0.AND.INCMD(:1).GE.'0'.AND.INCMD(:1).LE.'9') THEN
- INCMD = 'READ '//INCMD
- END IF
- IER=CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS,LIB$GET_INPUT)
- END IF
-
- IF (IER.EQ.RMS$_EOF) THEN
- CALL EXIT ! If no command, exit
- ELSE IF (IER.EQ.%LOC(CLI$_NOCOMD)) THEN ! If just RETURN entered
- INCMD = ' ' ! Make sure there is none
- LEN_P = 0 ! Indicate no parameter in command
- IF (DIR_COUNT.GT.0) THEN ! If still more dir entries
- CALL DIRECTORY(DIR_COUNT) ! continue outputting them
- ELSE IF (INDEX_COUNT.GT.0) THEN
- CALL FULL_DIR(INDEX_COUNT)
- ELSE IF (FOLDER_COUNT.GT.0) THEN ! If more folder entries
- CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! continue outputting them
- ELSE ! Else try to read next bulletin
- CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! or finish old one
- DIR_COUNT = 0
- FOLDER_COUNT = 0
- INDEX_COUNT = 0
- END IF
- GO TO 100 ! Loop to read new command
- ELSE IF (.NOT.IER) THEN ! If command has error
- GO TO 100 ! ask for new command
- END IF
-
- IER = MIN(INDEX(INCMD(:TRIM(INCMD)),' '),INDEX(INCMD,'/'))
- IF (IER.GT.0) INCMD = ' '//INCMD(IER:) ! Save qualifiers
- CALL CLI$GET_VALUE('$VERB',INCMD(:4)) ! Get user's command.
-
- IF (INCMD(:4).EQ.'BACK'.AND.DIR_COUNT.NE.0) THEN
- DIR_COUNT = -1
- CALL DIRECTORY(DIR_COUNT)
- INCMD = ' '
-C ELSE IF (INCMD(:4).EQ.'BACK'.AND.FOLDER_COUNT.NE.0) THEN
-C FOLDER_COUNT = -1
-C CALL DIRECTORY_FOLDERS(FOLDER_COUNT)
-C INCMD = ' '
- ELSE
- DIR_COUNT = 0 ! Reinit display pointers
- READ_COUNT = 0
- FOLDER_COUNT = 0
- INDEX_COUNT = 0
- END IF
-
- IF (READ_ONLY.AND.(INCMD(:3).EQ.'ADD'.OR.INCMD(:3).EQ.'DEL'
- & .OR.INCMD(:3).EQ.'CHA'.OR.INCMD(:3).EQ.'REP')) THEN
- ! FOLDER can only be read?
- WRITE (6,'('' ERROR: Access to folder limited to reading.'')')
- ELSE IF (INCMD(:3).EQ.'ADD') THEN ! ADD?
- IF (REMOTE_SET.GE.3) THEN
- INCMD = 'POST'
- CALL RESPOND
- ELSE
- CALL ADD
- END IF
- ELSE IF (INCMD(:3).EQ.'ATT') THEN ! ATTACH?
- CALL ATTACH
- ELSE IF (INCMD(:4).EQ.'BACK') THEN ! BACK?
- IF (BULL_POINT.LE.1) THEN
- WRITE(6,1060)
- ELSE
- CALL READ_MSG(READ_COUNT,BULL_POINT-1) ! Try to read previous
- END IF
- ELSE IF (INCMD(:4).EQ.'CHAN') THEN ! CHANGE?
- CALL REPLACE ! Replace old bulletin
- ELSE IF (INCMD(:4).EQ.'COPY') THEN ! COPY?
- CALL MOVE(.FALSE.)
- ELSE IF (INCMD(:4).EQ.'CREA') THEN ! CREATE?
- CALL CREATE_FOLDER ! Go create the folder
- ELSE IF (INCMD(:4).EQ.'CURR') THEN ! CURRENT?
- READ_COUNT = -1 ! Reread current message from beginning.
- CALL READ_MSG(READ_COUNT,BULL_POINT)
- ELSE IF (INCMD(:4).EQ.'DELE') THEN ! DELETE?
- CALL DELETE_MSG ! Go delete bulletin
- ELSE IF (INCMD(:4).EQ.'DIRE') THEN ! DIRECTORY?
- IF (CLI$PRESENT('FOLDER').OR. ! /FOLDER specified?
- & CLI$PRESENT('NEWS')) THEN ! or /NEWS?
- CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show all folders
- ELSE IF (CLI$PRESENT('SELECT_FOLDER')) THEN! Folder specified?
- CALL SELECT_FOLDER(.TRUE.,IER) ! Try to select folder
- IF (IER) THEN ! If successful
- CALL DIRECTORY(DIR_COUNT) ! Show messages
- END IF
- ELSE
- CALL DIRECTORY(DIR_COUNT) ! Show messages
- END IF
- ELSE IF (INCMD(:4).EQ.'FILE'.OR.
- & INCMD(:4).EQ.'EXTR') THEN ! FILE?
- CALL FILE ! Copy bulletin to file
- ELSE IF (INCMD(:1).EQ.'E'.OR.
- & INCMD(:4).EQ.'QUIT') THEN ! EXIT?
- CALL EXIT ! Exit from program
- ELSE IF (INCMD(:4).EQ.'FIRS') THEN ! FIRST?
- READ_COUNT = -1
- BULL_READ = 1
- CALL READ_MSG(READ_COUNT,BULL_READ)
- ELSE IF (INCMD(:4).EQ.'HELP') THEN ! HELP?
- CALL HELP(HELP_DIRECTORY(:HLEN)//'BULL.HLB') ! Get help
- ELSE IF (INCMD(:3).EQ.'IND') THEN ! INDEX?
- INDEX_COUNT = 1
- CALL FULL_DIR(INDEX_COUNT)
- ELSE IF (INCMD(:4).EQ.'LAST') THEN ! LAST?
- READ_COUNT = -1
- BULL_READ = 99999
- CALL READ_MSG(READ_COUNT,BULL_READ)
- ELSE IF (INCMD(:4).EQ.'MARK') THEN ! MARK?
- CALL TAG(.TRUE.,1)
- ELSE IF (INCMD(:4).EQ.'MAIL'.OR.
- & INCMD(:4).EQ.'FORW') THEN ! MAIL?
- CALL MAIL
- ELSE IF (INCMD(:3).EQ.'MOD') THEN ! MODIFY?
- CALL MODIFY_FOLDER
- ELSE IF (INCMD(:4).EQ.'MOVE') THEN ! MOVE?
- CALL MOVE(.TRUE.)
- ELSE IF (INCMD(:4).EQ.'NEWS') THEN ! NEWS
- CALL DIRECTORY_FOLDERS(FOLDER_COUNT) ! Show new folders
- ELSE IF (INCMD(:4).EQ.'NEXT'.OR.INCMD(:1).EQ.'N') THEN ! NEXT?
- CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin
- ELSE IF (INCMD(:4).EQ.'POST') THEN ! POST?
- CALL RESPOND
- ELSE IF (INCMD(:4).EQ.'PRIN') THEN ! PRINT?
- CALL PRINT(0,.TRUE.) ! Printout bulletin
- ELSE IF (INCMD(:4).EQ.'READ') THEN ! READ?
- IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Bulletin specified?
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) BULL_READ ! Yes
- READ_COUNT = -1
- CALL READ_MSG(READ_COUNT,BULL_READ)
- ELSE
- CALL READ_MSG(READ_COUNT,BULL_POINT+1)
- END IF
- ELSE IF (INCMD(:3).EQ.'REM') THEN ! REMOVE?
- CALL REMOVE_FOLDER
- ELSE IF (INCMD(:3).EQ.'REP') THEN ! REPLY?
- IF (REMOTE_SET.GE.3.OR.
- & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN
- CALL RESPOND
- ELSE
- CALL REPLY
- END IF
- ELSE IF (INCMD(:3).EQ.'RES') THEN ! RESPOND?
- CALL RESPOND
- ELSE IF (INCMD(:3).EQ.'SEA') THEN ! SEARCH?
- CALL SEARCH(READ_COUNT)
- ELSE IF (INCMD(:3).EQ.'SEE') THEN ! SEEN?
- CALL TAG(.TRUE.,2)
- ELSE IF (INCMD(:3).EQ.'SEL') THEN ! SELECT?
- CALL SELECT_FOLDER(.TRUE.,IER)
- ELSE IF (INCMD(:3).EQ.'SET') THEN ! SET?
- CALL CLI$GET_VALUE('SET_PARAM1',BULL_PARAMETER)
- IF (BULL_PARAMETER(:1).EQ.'F') THEN ! SET FOLDER?
- CALL SELECT_FOLDER(.TRUE.,IER)
- ELSE IF (BULL_PARAMETER(:3).EQ.'PRI') THEN ! SET PRIVS?
- CALL SET_PRIV
- ELSE IF (BULL_PARAMETER(:2).EQ.'PA') THEN ! SET PAGE?
- PAGING = .TRUE.
- WRITE (6,'('' PAGE has been set.'')')
- ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SET KEYPAD?
- CALL SET_KEYPAD
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOK') THEN ! SET NOKEYPAD?
- CALL SET_NOKEYPAD
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOPA') THEN ! SET NOPAGE?
- PAGING = .FALSE.
- WRITE (6,'('' NOPAGE has been set.'')')
- ELSE IF (FOLDER_NUMBER.EQ.-1.AND.REMOTE_SET.EQ.1) THEN
- WRITE (6,'('' ERROR: Invalid command for remote folder.'')')
- ELSE IF (BULL_PARAMETER(:2).EQ.'SY') THEN ! SET SYSTEM?
- CALL SET_SYSTEM(.TRUE.)
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOSY') THEN ! SET NOSYSTEM?
- CALL SET_SYSTEM(.FALSE.)
- ELSE IF (BULL_PARAMETER(:2).EQ.'BB') THEN ! SET BBOARD?
- CALL SET_BBOARD(.TRUE.)
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOBB') THEN ! SET NOBBOARD?
- CALL SET_BBOARD(.FALSE.)
- ELSE IF (BULL_PARAMETER(:2).EQ.'DU') THEN ! SET DUMP?
- CALL SET_FOLDER_FLAG(.TRUE.,1,'DUMP')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NODU') THEN ! SET NODUMP?
- CALL SET_FOLDER_FLAG(.FALSE.,1,'DUMP')
- ELSE IF (BULL_PARAMETER(:2).EQ.'ST') THEN ! SET STRIP?
- CALL SET_FOLDER_FLAG(.TRUE.,4,'STRIP')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOST') THEN ! SET NOSTRIP?
- CALL SET_FOLDER_FLAG(.FALSE.,4,'STRIP')
- ELSE IF (BULL_PARAMETER(:2).EQ.'DI') THEN ! SET DIGEST?
- CALL SET_FOLDER_FLAG(.TRUE.,5,'DIGEST')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NODI') THEN ! SET NODIGEST?
- CALL SET_FOLDER_FLAG(.FALSE.,5,'DIGEST')
- ELSE IF (BULL_PARAMETER(:2).EQ.'AL') THEN ! SET ALWAYS?
- CALL SET_FOLDER_FLAG(.TRUE.,7,'ALWAYS')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOAL') THEN ! SET NOALWAYS?
- CALL SET_FOLDER_FLAG(.FALSE.,7,'ALWAYS')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOTI') THEN ! SET NOTIFY?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(1,-1,-1)
- ELSE
- CALL SET_USER_FLAG(1,-1,-1)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'E') THEN ! SET EXPIRE?
- IER = CLI$GET_VALUE('EXPIRATION',BULL_PARAMETER,LEN_P)
- IF (LEN_P.LE.3) THEN
- READ (BULL_PARAMETER,'(I<LEN_P>)') LIMIT
- CALL SET_FOLDER_EXPIRE_LIMIT(LIMIT)
- ELSE
- WRITE (6,'('' ERROR: Invalid expiration specified.'')')
- END IF
- ELSE IF (BULL_PARAMETER(:4).EQ.'NODE') THEN ! SET NODE?
- CALL SET_NODE(.TRUE.)
- ELSE IF (BULL_PARAMETER(:6).EQ.'NONODE') THEN ! SET NONODE?
- CALL SET_NODE(.FALSE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOE') THEN ! SET NOEXPIRE?
- CALL SET_FOLDER_EXPIRE_LIMIT(0)
- ELSE IF (BULL_PARAMETER(:5).EQ.'NONOT') THEN ! SET NONOTIFY?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(0,-1,-1)
- ELSE
- CALL SET_USER_FLAG(0,-1,-1)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'S') THEN ! SET SHOWNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,1)
- ELSE
- CALL SET_USER_FLAG(-1,0,1)
- END IF
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOS') THEN ! SET NOSHOWNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,0)
- ELSE
- CALL SET_USER_FLAG(-1,0,0)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'R') THEN ! SET READNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,1,0)
- ELSE
- CALL SET_USER_FLAG(-1,1,0)
- END IF
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOR') THEN ! SET NOREADNEW?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,0)
- ELSE
- CALL SET_USER_FLAG(-1,0,0)
- END IF
- ELSE IF (BULL_PARAMETER(:2).EQ.'BR') THEN ! SET BRIEF?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,1,1)
- ELSE
- CALL SET_USER_FLAG(-1,1,1)
- END IF
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOBR') THEN ! SET NOBRIEF?
- IF (CLI$PRESENT('DEFAULT').OR.CLI$PRESENT('ALL').OR.
- & CLI$PRESENT('PERMANENT').OR.CLI$PRESENT('NOPERMANENT'))
- & THEN
- CALL SET_FOLDER_DEFAULT(-1,0,0)
- ELSE
- CALL SET_USER_FLAG(-1,0,0)
- END IF
- ELSE IF (BULL_PARAMETER(:1).EQ.'A') THEN ! SET ACCESS?
- CALL SET_ACCESS(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOA') THEN ! SET NOACCESS?
- CALL SET_ACCESS(.FALSE.)
- ELSE IF (BULL_PARAMETER(:1).EQ.'C') THEN ! SET CONTINUOUS_BRIEF
- CALL SET_BRIEF_CONTINUOUS(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOC') THEN ! SET NOCONTINUOUS_BRIEF
- CALL SET_BRIEF_CONTINUOUS(.FALSE.)
- ELSE IF (BULL_PARAMETER(:1).EQ.'G') THEN ! SET GENERIC?
- CALL SET_GENERIC(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOG') THEN ! SET NOGENERIC?
- CALL SET_GENERIC(.FALSE.)
- ELSE IF (BULL_PARAMETER(:1).EQ.'L') THEN ! SET LOGIN?
- CALL SET_LOGIN(.TRUE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'NOL') THEN ! SET NOLOGIN?
- CALL SET_LOGIN(.FALSE.)
- ELSE IF (BULL_PARAMETER(:3).EQ.'PRO') THEN ! SET PROMPT_EXPIRE?
- CALL SET_FOLDER_FLAG(.FALSE.,3,'PROMPT_EXPIRE')
- ELSE IF (BULL_PARAMETER(:4).EQ.'NOPR') THEN ! SET NOPROMPT_EXPIRE?
- CALL SET_FOLDER_FLAG(.TRUE.,3,'PROMPT_EXPIRE')
- ELSE IF (BULL_PARAMETER(:3).EQ.'DEF') THEN ! SET DEFAULT_EXPIRE?
- CALL SET_DEFAULT_EXPIRE
- END IF
- ELSE IF (INCMD(:4).EQ.'SHOW') THEN ! SHOW?
- CALL CLI$GET_VALUE('SHOW_PARAM1',BULL_PARAMETER,LEN_P)
- IF (BULL_PARAMETER(:2).EQ.'FL') THEN ! SHOW FLAGS?
- CALL SHOW_FLAGS
- ELSE IF (BULL_PARAMETER(:2).EQ.'FO') THEN ! SHOW FOLDER?
- CALL SHOW_FOLDER
- ELSE IF (BULL_PARAMETER(:1).EQ.'K') THEN ! SHOW KEYPAD
- CALL SHOW_KEYPAD(HELP_DIRECTORY(:HLEN)//'BULL.HLB')
- ELSE IF (BULL_PARAMETER(:1).EQ.'N') THEN ! SHOW NEW?
- SAVE_FOLDER_NUMBER = FOLDER_NUMBER
- SAVE_FOLDER = FOLDER
- CALL NEW_MESSAGE_NOTIFICATION
- FOLDER1 = SAVE_FOLDER
- FOLDER_NUMBER = SAVE_FOLDER_NUMBER
- CALL SELECT_FOLDER(.FALSE.,IER)
- ELSE IF (BULL_PARAMETER(:1).EQ.'P') THEN ! SHOW PRIVILEGES?
- CALL SHOW_PRIV
- ELSE IF (BULL_PARAMETER(:1).EQ.'U') THEN ! SHOW USER?
- CALL SHOW_USER
- ELSE IF (BULL_PARAMETER(:1).EQ.'V') THEN ! SHOW VERSION?
- CALL SHOW_VERSION
- END IF
- ELSE IF (INCMD(:4).EQ.'SPAW') THEN ! SPAWN command?
- CALL SPAWN_PROCESS
- ELSE IF (INCMD(:3).EQ.'SUB') THEN ! SUBSCRIBE command?
- CALL SUBSCRIBE
- ELSE IF (INCMD(:4).EQ.'UNDE') THEN ! UNDELETE?
- CALL UNDELETE
- ELSE IF (INCMD(:3).EQ.'UNM') THEN ! UNMARK?
- CALL TAG(.FALSE.,1)
- ELSE IF (INCMD(:4).EQ.'UNSE') THEN ! UNSEEN?
- CALL TAG(.FALSE.,2)
- ELSE IF (INCMD(:4).EQ.'UNSU') THEN ! UNSUBSCRIBE command?
- CALL UNSUBSCRIBE
- END IF
-
-100 CONTINUE
-
- IF (DCL_COMMAND.AND.TRIM(DCL_CMD).EQ.0) CALL EXIT
-
- END DO
-
-1010 FORMAT(Q,A)
-1060 FORMAT(' ERROR: There are no more preceding messages.')
-
- END
-
-
-
- SUBROUTINE COMMAND_INPUT(IER)
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /PROMPT_PROMPT/ PROMPT,LPROMPT
- CHARACTER*42 PROMPT
-
- CALL GET_INPUT_PROMPT(INCMD,IER,PROMPT(:LPROMPT))
-
- RETURN
-
- END
-
-
-
-
-
- SUBROUTINE ADD
-C
-C SUBROUTINE ADD
-C
-C FUNCTION: Adds bulletin to bulletin file.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
- & NODE_ERROR,POINT_NODE
- CHARACTER*32 NODES(10)
- LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
-
- COMMON /DECNET/ DECNET_PROC,ERROR_UNIT
- LOGICAL DECNET_PROC
-
- COMMON /EDIT/ EDIT_DEFAULT
- DATA EDIT_DEFAULT/.FALSE./
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /LAST_RECORD_WRITTEN/ OCOUNT
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /INDESCRIP/ INDESCRIP
- CHARACTER*(LINE_LENGTH) INDESCRIP
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
- CHARACTER NODENAME*8
-
- character*40 PERSUSR
- logical Perr
- CHARACTER INEXDATE*11,INEXTIME*11
-
- CHARACTER INLINE*80,OLD_FOLDER*25,LOCAL_NODE*8
-
- EXTERNAL CLI$_ABSENT,CLI$_NEGATED
-
- EDITIT = (CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND.
- & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))
-
- IF (CLI$PRESENT('EXTRACT').AND..NOT.EDITIT) THEN
- WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')')
- RETURN
- END IF
-
- CALL DISABLE_CTRL ! Disable CTRL-Y & -C
-
- ALLOW = SETPRV_PRIV()
-
- OLD_FOLDER_NUMBER = FOLDER_NUMBER
- OLD_FOLDER = FOLDER
-
- LEN_P = 0
-
- IF (CLI$PRESENT('EXTRACT')) THEN
- BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'
- LEN_P = TRIM(BULL_PARAMETER)
- OPEN(UNIT=3,FILE=BULL_PARAMETER(:LEN_P),IOSTAT=IER,
- & RECL=LINE_LENGTH,
- & STATUS='NEW',CARRIAGECONTROL='LIST',FORM='FORMATTED')
-
- IF (IER.NE.0) THEN
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- GO TO 910
- END IF
-
- CALL OPEN_BULLFIL_SHARED
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- IF (CLI$PRESENT('NOINDENT')) THEN
- WRITE (3,'(A)') INPUT(:ILEN)
- ELSE
- WRITE (3,'(A)') '>'//INPUT(:ILEN)
- END IF
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END DO
-
-90 CALL CLOSE_BULLFIL
- END IF
-
- IF (CLI$PRESENT('FILESPEC')) THEN
- IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)
- CALL DISABLE_PRIVS
- IF (.NOT.CLI$PRESENT('EXTRACT')) THEN
- OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',
- & READONLY,SHARED,ERR=920,FORM='FORMATTED')
- ELSE
- OPEN (UNIT=4,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',
- & READONLY,SHARED,ERR=920,FORM='FORMATTED')
- IER = 0
- ICOUNT = 0
- DO WHILE (IER.EQ.0)
- READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- IF (IER.EQ.0) THEN
- IF (ICOUNT.EQ.0) WRITE (3,'(A)') ' '
- ICOUNT = ICOUNT + 1
- WRITE (3,'(A)') INPUT(:ILEN)
- END IF
- END DO
- CLOSE (UNIT=4)
- BULL_PARAMETER = 'SYS$LOGIN:BULL.SCR'
- LEN_P = TRIM(BULL_PARAMETER)
- END IF
- CALL ENABLE_PRIVS ! Reset SYSPRV privileges
- END IF
-
- SELECT_FOLDERS = .FALSE.
- IF (CLI$PRESENT('SELECT_FOLDER')) THEN
- CALL GET_FOLDER_INFO(IER)
- IF (.NOT.IER) GO TO 910
- SELECT_FOLDERS = .TRUE.
- ELSE
- NODE_NUM = 1
- NODES(1) = OLD_FOLDER
- END IF
-
- IF (FOLDER_NUMBER.GT.0.AND. ! If folder set and
- & CLI$PRESENT('NODES')) THEN ! Decnet nodes specified?
- WRITE (6,'('' ERROR: /NODES cannot be used with folder set.'')')
- GO TO 910
- END IF
-
- IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0.AND.
- & (CLI$PRESENT('SYSTEM').OR. ! Is /SYSTEM switch present?
- & CLI$PRESENT('BROADCAST').OR. ! Is /BROADCAST swtich present?
- & CLI$PRESENT('SHUTDOWN'))) THEN ! Is /SHUTDOWN switch present?
- WRITE (6,'('' ERROR: Folder is not a SYSTEM folder.'')')
- GO TO 910
- END IF
-
- IF (CLI$PRESENT('SYSTEM')) THEN ! Is /SYSTEM switch present?
- IF (.NOT.ALLOW) THEN ! If no privileges
- WRITE(ERROR_UNIT,1070) ! Tell user
- GO TO 910 ! and abort
- END IF
- SYSTEM = 1 ! Set system bit
- ELSE
- SYSTEM = 0 ! Clear system bit
- END IF
-
- IF (CLI$PRESENT('BROADCAST')) THEN ! Is /BROADCAST switch present?
- IF (.NOT.(ALLOW.OR.OPER_PRIV())) THEN ! If no privileges
- WRITE(ERROR_UNIT,1080) ! Tell user
- GO TO 910 ! and abort
- ELSE IF (CLI$PRESENT('CLUSTER')) THEN
- SYSTEM = SYSTEM.OR.8
- END IF
- END IF
-
- IF (CLI$PRESENT('PERMANENT')) THEN ! Is /PERMANENT switch present?
- IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present
- & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- WRITE(ERROR_UNIT,1083)
- GO TO 910
- ELSE
- SYSTEM = SYSTEM.OR.2 ! Set permanent bit
- INEXDATE = '5-NOV-2000'
- INEXTIME = '00:00:00.00'
- END IF
- END IF
-
- IF (CLI$PRESENT('SHUTDOWN')) THEN ! Is /SHUTDOWN switch present?
- IF (.NOT.ALLOW) THEN ! If no privileges
- WRITE(ERROR_UNIT,1082) ! Tell user
- GO TO 910 ! and abort
- ELSE
- IER = CLI$GET_VALUE('SHUTDOWN',INLINE)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- IF (REMOTE_SET) THEN ! Can't specify node name if
- WRITE (6,1090) ! remote folder, as no code
- GO TO 910 ! present to send the name.
- END IF
- CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,INLINE)
- IF (NODE_AREA.EQ.0) GO TO 910 ! Invalid node name
- ELSE
- CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
- END IF
- SYSTEM = SYSTEM.OR.4 ! Set shutdown bit
- INEXDATE = '5-NOV-2000'
- WRITE (INEXTIME,'(I4)') NODE_NUMBER
- WRITE (INEXTIME(7:),'(I4)') NODE_AREA
- DO I=1,11
- IF (INEXTIME(I:I).EQ.' ') INEXTIME(I:I) = '0'
- END DO
- INEXTIME = INEXTIME(1:2)//':'//INEXTIME(3:4)//':'//
- & INEXTIME(7:8)//'.'//INEXTIME(9:10)
- END IF
- END IF
-
- SELECT_NODES = .FALSE.
- IF (CLI$PRESENT('NODES')) THEN
- CALL GET_NODE_INFO
- IF (NODE_ERROR) GO TO 940
- SELECT_NODES = .TRUE.
- END IF
-
- IF ((SYSTEM.AND.7).LE.1) THEN ! Not permanent or shutdown
- CALL GET_EXPIRED(INPUT,IER)
- IF (.NOT.IER) GO TO 910
- INEXDATE = INPUT(:11)
- INEXTIME = INPUT(13:)
- END IF
-
- IF (INCMD(:3).EQ.'REP') THEN ! REPLY?
- LENDES = TRIM(INDESCRIP) ! filled in by main subroutine
- ELSE IF (CLI$PRESENT('SUBJECT')) THEN ! /SUBJECT specified
- CALL CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)
- ELSE
- WRITE(6,1050) ! Request header for bulletin
- CALL GET_LINE(INDESCRIP,LENDES) ! Get input line
- IF (LENDES.LE.0) GO TO 910
- END IF
-
- LENDES = MIN(LEN(INDESCRIP)-6,LENDES) ! Make room for "Subj: "
-
-C
-C If file specified in ADD command, read file to obtain bulletin.
-C Else, read the bulletin from the terminal.
-C
-
- IF (EDITIT.AND..NOT.DECNET_PROC) THEN ! If /EDIT specified
- IF (LEN_P.EQ.0) THEN ! If no file param specified
- CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
- OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',
- & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')
- LEN_P = 1
- ELSE
- CLOSE (UNIT=3)
- CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')
- IF (CLI$PRESENT('EXTRACT')) THEN
- CONTEXT = 0
- CALL LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT)
- VERSION = INDEX(INPUT,';') + 1
- IF (INPUT(VERSION:VERSION).EQ.'1') THEN
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- END IF
- END IF
- OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',
- & DISPOSE='DELETE',ERR=910,FORM='FORMATTED')
- END IF
- END IF
-
- ICOUNT = 0 ! Line count for bulletin
-
- END = 0
- BLENGTH = 35
- IF (CLI$PRESENT('BELL')) BLENGTH = 37
- IF (LEN_P.GT.0) THEN ! If file param in ADD command
- DO WHILE(1) ! Read until end of file to
- READ (3,'(Q,A)',END=10) ILEN,INPUT! get record count
- IF (ILEN.GT.LINE_LENGTH) GO TO 950
- ICOUNT = ICOUNT + 1 + MIN(ILEN,80)
- BLENGTH = BLENGTH + ILEN - 1 + 2
- IF (ILEN.EQ.0) ICOUNT = ICOUNT + 1! COPY_BULL writes line with
- END DO ! 1 space for blank line
- ELSE ! If no input file
- OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR',
- & FORM='FORMATTED',RECL=LINE_LENGTH) ! Temp file to save message
- WRITE (6,1000) ! Request input from terminal
- ILEN = LINE_LENGTH + 1 ! Length of input line
- ICOUNT = 0 ! Character count counter
- DO WHILE (ILEN.GE.0) ! Input until no more input
- CALL GET_LINE(INPUT,ILEN) ! Get input line
- IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long
- WRITE(6,'('' ERROR: Input line length > '',I,
- & ''. Reinput:'')') LINE_LENGTH
- ELSE IF (ILEN.GE.0) THEN ! If good input line entered
- ICOUNT = ICOUNT + ILEN ! Update counter
- BLENGTH = BLENGTH + ILEN - 1 + 2
- WRITE(3,2010) INPUT(:ILEN) ! Save line in scratch file
- END IF
- END DO
- IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out
-10 IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out
- ENDIF
-
- REWIND (UNIT=3)
-
- BRDCST = .FALSE.
-
- IF (CLI$PRESENT('BROADCAST').AND.BLENGTH.GT.82*12+2) THEN
- WRITE (6,'('' Message is too long for broadcasting.'',
- & '' A truncated message will be broadcast.'')')
- CALL GET_INPUT_PROMPT(INPUT,ILEN,
- & 'Type C to continue, A to only ADD message, or Q to Quit: ')
- IF (STREQ(INPUT(:1),'Q')) THEN
- GO TO 910
- ELSE IF (STREQ(INPUT(:1),'A')) THEN
- BRDCST = .TRUE.
- END IF
- END IF
-
- IF (SELECT_NODES.AND.NODE_NUM.GT.0) THEN
- INLINE = 'ADD'
- IF (CLI$PRESENT('SYSTEM'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SYSTEM'
- IF (CLI$PRESENT('BROADCAST').AND..NOT.BRDCST)
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BROADCAST'
- IF (CLI$PRESENT('PERMANENT'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/PERMANENT'
- IF (CLI$PRESENT('SHUTDOWN'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/SHUTDOWN'
- IF (CLI$PRESENT('BELL'))
- & INLINE = INLINE(:STR$POSITION(INLINE,' ')-1)//'/BELL'
-
- LEN_INLINE = STR$POSITION(INLINE,' ') - 1
-
- DO POINT_NODE=1,NODE_NUM ! Write out command to nodes
- INLINE = INLINE(:LEN_INLINE)
-
- WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE
- IF ((SYSTEM.AND.7).LE.1)
- ! If not permanent or shutdown specify date
- & WRITE (POINT_NODE+9,'(A)',ERR=940) INEXDATE//' '//INEXTIME
- WRITE (POINT_NODE+9,'(A)',ERR=940) INDESCRIP(:LENDES)
- IER = 0
- DO WHILE (IER.EQ.0)
- READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- ILEN = MIN(ILEN,LINE_LENGTH)
- IF (IER.EQ.0) THEN
- WRITE (POINT_NODE+9,'(A)',ERR=940) INPUT(:ILEN)
- END IF
- END DO
- WRITE (POINT_NODE+9,'(A)',ERR=940) CHAR(26)
- READ (POINT_NODE+9,'(A)',ERR=940,END=940) INPUT
- IF (INPUT.EQ.'END') THEN
- WRITE (6,'('' Message successfully sent to node '',A)')
- & NODES(POINT_NODE)
- ELSE
- WRITE (6,'('' Error while sending message to node '',A)')
- & NODES(POINT_NODE)
- WRITE (6,'(A)') INPUT(:80)
- GO TO 940
- END IF
- REWIND (UNIT=3)
- END DO
- END IF
-
- IF (SELECT_NODES.AND..NOT.LOCAL_NODE_FOUND) GO TO 95
- ! Exit if local node not specified.
-
- IF (.NOT.SELECT_FOLDERS) THEN
- NODE_NUM = 1 ! No folders specified so just
- NODES(1) = FOLDER ! add to select folder
- END IF
-
- IER = SYS_TRNLNM('SYS$NODE',LOCAL_NODE)
- LNODE = TRIM(LOCAL_NODE)
- LUSER = TRIM(USERNAME)
- persusr=' '
- perr=lib$sys_trnlog('SYS$USERNAME',puser,persusr)
- if(.not.Perr) persusr = username
-C if a logical sys$username exists it is used in the FROM addres
-C of the added message. This makes it possible to tell who was
-C actually sending a message when logged into a common account
-C somewhere (assuming the login uses the sys$rem_id and sys$rem_node
-C logicals to construct the sys$username logical)
-C gce, 9/26/1991
-C
-C Add bulletin to bulletin file and directory entry for to directory file.
-C
-
- DO I = 1,NODE_NUM
-
- IF (FOLDER.NE.NODES(I)) THEN
- FOLDER_NUMBER = -1
- FOLDER1 = NODES(I)
- CALL SELECT_FOLDER(.FALSE.,IER)
- ELSE
- IER = 1
- END IF
-
- IF (IER) THEN
- CALL OPEN_BULLDIR ! Prepare to add dir entry
-
- DESCRIP=INDESCRIP(:LENDES) ! Description header
- EXDATE=INEXDATE ! Expiration date
- EXTIME=INEXTIME
- FROM = USERNAME ! Username
-
- CALL OPEN_BULLFIL ! Prepare to add bulletin
-
- CALL READDIR(0,IER) ! Get NBLOCK
- IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0
-
- REWIND (UNIT=3)
- OBLOCK = NBLOCK+1
- CALL STORE_BULL(LNODE+PUSER+6,'From: '//
- & LOCAL_NODE(:LNODE)//PersUsr(:PUSER),OBLOCK)
- IF (LENDES.GT.LEN(DESCRIP)) THEN
- CALL STORE_BULL(LENDES+6,
- & 'Subj: '//INDESCRIP(:LENDES),OBLOCK)
- END IF
- CALL COPY_BULL(3,1,OBLOCK,IER) ! Add the new bulletin
- IF (IER.NE.0) GO TO 930 ! Error in creating bulletin
- LENGTH = OCOUNT - (NBLOCK+1) + 1
-C
-C Broadcast the bulletin if requested.
-C
- IF (.NOT.BRDCST.AND.CLI$PRESENT('BROADCAST').AND.
- & (.NOT.REMOTE_SET.OR.FOLDER_NUMBER.GT.0)) THEN
- CALL GET_BROADCAST_MESSAGE(CLI$PRESENT('BELL'))
- BRDCST = .TRUE.
- IF (.NOT.CLI$PRESENT('LOCAL')) THEN
- CALL BROADCAST_ALL_NODES(CLI$PRESENT('ALL'),
- & CLI$PRESENT('CLUSTER'))
- END IF
-C
-C If the folder is remote, and local node is not the node which BULLCP is
-C on, don't broadcast, as it will be broadcasted by BULLCP. The remote
-C node will distribute the broadcast to nodes that are running BULLCP,
-C but not if the node that originated the message matches. However, it
-C has no way of knowing that the originating node is in the same cluster
-C as that of the BULLCP node.
-C
- IF ((REMOTE_SET.AND.LOCAL_NODE(:LNODE-2).EQ.NODENAME)
- & .OR.CLI$PRESENT('LOCAL').OR..NOT.REMOTE_SET)
- & CALL BROADCAST(
- & CLI$PRESENT('ALL'),CLI$PRESENT('CLUSTER'))
- END IF
-
- CALL CLOSE_BULLFIL ! Finished adding bulletin
-
- CALL ADD_ENTRY ! Add the new directory entry
-
- IF (FOLDER_NUMBER.GE.0) THEN
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- CALL UPDATE_FOLDER ! Update info in folder file
-C
-C If user is adding message, an no new messages, update last read time for
-C folder, so user is not alerted of new message which is owned by user.
-C
- IF (DIFF.GE.0) THEN
- LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)
- LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)
- END IF
- END IF
-
- CALL CLOSE_BULLDIR ! Totally finished with add
- ELSE
- WRITE (6,'('' ERROR: Unable to add message to '',A)')
- & NODES(I)
- END IF
- END DO
-
-95 CLOSE (UNIT=3) ! Close the input file
- IF (DECNET_PROC) WRITE(5,'(''END'')') ! DECNET operation worked
-
-100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C
- DO I=10,NODE_NUM+9
- CLOSE (UNIT=I)
- END DO
-
- IF (FOLDER_NUMBER.NE.OLD_FOLDER_NUMBER) THEN
- FOLDER_NUMBER = OLD_FOLDER_NUMBER
- FOLDER1 = OLD_FOLDER
- CALL SELECT_FOLDER(.FALSE.,IER)
- END IF
-
- IF (CLI$PRESENT('EXTRACT')) THEN
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- END IF
-
- RETURN
-
-910 WRITE(ERROR_UNIT,1010)
- CLOSE (UNIT=3,ERR=100)
- GOTO 100
-
-920 WRITE(ERROR_UNIT,1020)
- CALL ENABLE_PRIVS
- GOTO 100
-
-930 WRITE (ERROR_UNIT,1025)
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- CLOSE (UNIT=3)
- GO TO 100
-
-940 WRITE (6,1015) NODES(POINT_NODE)
- WRITE (6,1018)
- CLOSE (UNIT=3)
- GO TO 100
-
-950 WRITE (6,1030) LINE_LENGTH
- CLOSE (UNIT=3)
- GO TO 100
-
-1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')
-1010 FORMAT (' No message was added.')
-1015 FORMAT (' ERROR: Unable to reach node ',A)
-1018 FORMAT (' Try using /FOLDER instead of /NODE.')
-1020 FORMAT (' ERROR: Unable to open specified file.')
-1025 FORMAT (' ERROR: Unable to add message to file.')
-1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')
-1050 FORMAT (' Enter description header.')
-1070 FORMAT (' ERROR: SETPRV privileges are needed for system
- & messages.')
-1080 FORMAT (' ERROR: SETPRV privileges are needed to broadcast
- & messages.')
-1082 FORMAT (' ERROR: SETPRV privileges are needed to shutdown
- & messages.')
-1083 FORMAT (' ERROR: Folder has expiration limit.')
-1090 FORMAT (' ERROR: Nodename cannot be specified for shutdown
- & if folder is remote.')
-2010 FORMAT(A)
-2020 FORMAT(1X,A)
-
- END
-
-
- SUBROUTINE SUBTIME(BTIM,DAYS_BEFORE_TODAY,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER DAYS_BEFORE_TODAY*(*),TODAY_DATE*23
-
- INTEGER BTIM(2),TODAY_BTIM(2)
-
- IER = SYS$BINTIM(DAYS_BEFORE_TODAY,BTIM)
- IF (.NOT.IER) RETURN
-
- BTIM(1) = -BTIM(1) ! Convert to negative delta time
- BTIM(2) = -BTIM(2)-1
-
- IER = SYS$ASCTIM(TLEN,TODAY_DATE,,)
- CALL SYS$BINTIM(TODAY_DATE(:TLEN),TODAY_BTIM)
-
- CALL LIB$SUBX(TODAY_BTIM,BTIM,BTIM)
-
- RETURN
- END
-
-
-
- SUBROUTINE BROADCAST_ALL_NODES(ALL,CLUSTER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- PARAMETER BRDCST_LIMIT = 82*12 + 2
- CHARACTER*(BRDCST_LIMIT) BMESSAGE
-
- COMMON /BROAD_MESSAGE/ BMESSAGE,BLENGTH
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
- CHARACTER NODENAME*8
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER LOCALNODE*8,RESPONSE*1
-
- IF (.NOT.TEST_BULLCP().OR.REMOTE_SET) RETURN
-
- CALL OPEN_BULLUSER_SHARED
-
- REMOTE_FOUND = .FALSE.
- TEMP_USER = ':'
-
- DO WHILE (.NOT.REMOTE_FOUND)
- DO WHILE (REC_LOCK(IER))
- READ (4,KEYGT=TEMP_USER,IOSTAT=IER)
- & TEMP_USER,LOGIN_BTIM,READ_BTIM,NEW_FLAG
- END DO
- IF (TEMP_USER(:1).NE.':') THEN
- CALL CLOSE(4)
- RETURN
- END IF
- REMOTE_FOUND = TEST2(NEW_FLAG,FOLDER_NUMBER)
- END DO
-
- CALL CLOSE (4)
-
-100 OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,
- & FILE=NODENAME(:TRIM(NODENAME))//'::"TASK=BULLETIN1"')
-
- IF (IER.EQ.0) THEN
- IER = 0
- I = 1
- DO WHILE (IER.EQ.0.AND.I.LT.BLENGTH)
- WRITE (17,'(4A)',IOSTAT=IER)
- & 15,-1,I,BMESSAGE(I:MIN(BLENGTH,I+127))
- I = I + 128
- END DO
- IF (IER.EQ.0) WRITE (17,'(7A)',IOSTAT=IER)
- & 15,BLENGTH,I,ALL,CLUSTER,FOLDER_NUMBER,FOLDER
- ELSE
- WRITE (6,'('' BULLCP not responding to request to'',
- & '' broadcast to other nodes.'')')
- CALL GET_INPUT_PROMPT(RESPONSE,LEN,
- & 'Want to try again? (Y/N with Y as default): ')
- IF (RESPONSE.NE.'n'.AND.RESPONSE.NE.'N') THEN
- WRITE (6,'('' Trying again...'')')
- GO TO 100
- ELSE
- WRITE (6,'('' Broadcast aborting. '',
- & ''Continuing with message addition.'')')
- END IF
- END IF
-
- CLOSE (UNIT=17)
-
- RETURN
- END
-
-
-
-
- INTEGER FUNCTION ERROR_TRAP
-
- ERROR_TRAP = 1
-
- RETURN
- END
-
-
-
- SUBROUTINE REPLY
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /INDESCRIP/ INDESCRIP
- CHARACTER*(LINE_LENGTH) INDESCRIP
-
- IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read
- WRITE(6,'('' ERROR: You have not read any message.'')')
- RETURN ! And return
- END IF
-
- CALL OPEN_BULLDIR_SHARED
-
- CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin
-
- IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found?
- WRITE(6,'('' ERROR: Bulletin was not found.'')')
- CALL CLOSE_BULLDIR ! If not, then error out
- RETURN
- END IF
-
- CALL OPEN_BULLFIL_SHARED
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- INDESCRIP = INPUT(7:)
- ELSE
- INDESCRIP = DESCRIP
- END IF
-
- CALL CLOSE_BULLFIL
-
- CALL CLOSE_BULLDIR
-
- WRITE (6,'('' Adding REPLY message with the subject:'')')
- IF (STREQ(INDESCRIP(:3),'RE:')) THEN
- INDESCRIP = 'RE:'//INDESCRIP(4:)
- ELSE
- INDESCRIP = 'RE: '//INDESCRIP
- END IF
- WRITE (6,'(1X,A)') INDESCRIP(:TRIM(INDESCRIP))
-
- CALL ADD
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CRELNM(INPUT,OUTPUT)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PSLDEF)'
-
- INCLUDE '($LNMDEF)'
-
- CHARACTER*(*) INPUT,OUTPUT
-
- CALL INIT_ITMLST
- CALL ADD_2_ITMLST(LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT))
- CALL END_ITMLST(CRELNM_ITMLST)
-
- IER = SYS$CRELNM(,'LNM$PROCESS',INPUT,PSL$C_USER,
- & %VAL(CRELNM_ITMLST))
-
- RETURN
- END
-
-
-
- SUBROUTINE GETPRIV
-C
-C SUBROUTINE GETPRIV
-C
-C FUNCTION:
-C To get process privileges.
-C OUTPUTS:
-C PROCPRIV - Returned privileges
-C
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
-
- COMMON /REALPROC/ REALPROCPRIV(2)
-
- INCLUDE '($JPIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(8,JPI$_PROCPRIV,%LOC(PROCPRIV))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info
-
- REALPROCPRIV(1) = PROCPRIV(1)
- REALPROCPRIV(2) = PROCPRIV(2)
-
- RETURN
- END
-
-
-
-
- LOGICAL FUNCTION SETPRV_PRIV
- IMPLICIT INTEGER (A-Z)
-
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
- DATA NEEDPRIV/0,0/
-
- INCLUDE '($PRVDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- IF (NEEDPRIV(1).EQ.0.AND.NEEDPRIV(2).EQ.0) THEN
- CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file
- CALL READ_USER_FILE_HEADER(IER)
- CALL CLOSE_BULLUSER
- NEEDPRIV(1) = USERPRIV(1)
- NEEDPRIV(2) = USERPRIV(2)
- END IF
-
- IF ((PROCPRIV(1).AND.NEEDPRIV(1)).NE.0.OR.
- & (PROCPRIV(2).AND.NEEDPRIV(2)).NE.0) THEN
- SETPRV_PRIV = .TRUE.
- ELSE
- SETPRV_PRIV = .FALSE.
- END IF
-
- RETURN
- END
-
-
-
- LOGICAL FUNCTION OPER_PRIV
- IMPLICIT INTEGER (A-Z)
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
- INCLUDE '($PRVDEF)'
- OPER_PRIV = BTEST(PROCPRIV(1),PRV$V_OPER)
- RETURN
- END
-
-
-
- SUBROUTINE GETUSER(USERNAME)
-C
-C SUBROUTINE GETUSER
-C
-C FUNCTION:
-C To get username of present process.
-C OUTPUTS:
-C USERNAME - Username owner of present process.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PRVDEF)'
-
- CHARACTER*(*) USERNAME ! Limit is 12 characters
-
- INCLUDE '($JPIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info
-
- RETURN
- END
-
-
-
-
- LOGICAL FUNCTION CAPTIVE()
-
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE '($UAIDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- DATA READ_UAI/.FALSE./
-
- TYPE = 1
-
- IF (.NOT.READ_UAI) THEN
- CALL INIT_ITMLST
- CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))
- CALL END_ITMLST(GETUAI_ITMLST)
- IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)
- READ_UAI = .TRUE.
- END IF
-
- CAPTIVE = ((FLAGS.AND.(UAI$M_CAPTIVE.OR.UAI$M_RESTRICTED)).NE.0
- & .AND.1).OR.ISHFT(((FLAGS.AND.UAI$M_NOMAIL).NE.0).AND.1,1)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SPAWN_PROCESS
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /KEYPAD/ KEYPAD_MODE
-
- CHARACTER*255 COMMAND
-
- IF (CAPTIVE()) THEN
- WRITE (6,'('' ERROR: SPAWN not allowed from CAPTIVE account.'')')
- RETURN
- END IF
-
- CALL DISABLE_PRIVS
-
- SAVE_KEYPAD_MODE = KEYPAD_MODE
- IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD
-
- IF (CLI$PRESENT('COMMAND')) THEN
- CALL CLI$GET_VALUE('COMMAND',COMMAND,CLEN)
- COMMAND = '$'//COMMAND(:CLEN)
- CALL LIB$SPAWN(COMMAND(:CLEN+1))
- ELSE
- CALL LIB$SPAWN()
- END IF
-
- IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD
-
- CALL ENABLE_PRIVS
-
- RETURN
- END
-
-
- SUBROUTINE ATTACH
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /KEYPAD/ KEYPAD_MODE
-
- COMMON /TERM_CHAN/ TERM_CHAN
-
- INCLUDE '($JPIDEF)'
-
- CHARACTER*15 PROCESS
-
- IF (CLI$PRESENT('PROCESS')) THEN
- CALL CLI$GET_VALUE('PROCESS',PROCESS,PLEN)
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PROCESS_ID))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,PROCESS(:PLEN),%VAL(GETJPI_ITMLST),,,,)
- ELSE
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,JPI$_OWNER,%LOC(PROCESS_ID))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,)
- END IF
-
- IER = SYS$CANCEL(%VAL(TERM_CHAN))
-
- SAVE_KEYPAD_MODE = KEYPAD_MODE
- IF (KEYPAD_MODE.EQ.0) CALL SET_KEYPAD
-
- IF (IER) IER = LIB$ATTACH(PROCESS_ID)
- IF (.NOT.IER) CALL SYS_GETMSG(IER)
-
- IF (SAVE_KEYPAD_MODE.EQ.0) CALL SET_NOKEYPAD
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GET_BROADCAST_MESSAGE(RING_BELL)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE '($BRKDEF)'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
-C
-C The largest message that can be broadcasted is dependent on system
-C and user quotas. The following limit is 12 lines of ( 80 characters +
-C CR/LF ) + 2 bells. This should be more than enough room, as broadcasts
-C shouldn't be too large anyway.
-C
-
- PARAMETER CR=CHAR(13),LF=CHAR(10),BELL=CHAR(7)
-
- PARAMETER BRDCST_LIMIT = 82*12 + 2
- CHARACTER*(BRDCST_LIMIT) BROAD
-
- COMMON /BROAD_MESSAGE/ BROAD,BLENGTH
-
- IF (RING_BELL) THEN ! Include BELL in message?
- BROAD(:36) = ! Say who the bulletin is from
- & BELL//BELL//CR//LF//LF//'NEW BULLETIN FROM: '//FROM
- BLENGTH = 37 ! Start adding next line here
- ELSE
- BROAD(:34) = ! Say who the bulletin is from
- & CR//LF//LF//'NEW BULLETIN FROM: '//FROM
- BLENGTH = 35 ! Start adding next line here
- END IF
-
- IF (REMOTE_SET) REWIND (UNIT=3)
-
- END = 0
- ILEN = LINE_LENGTH + 1
- I = 0
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- IF (REMOTE_SET) THEN
- READ (3,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- IF (IER.NE.0) RETURN
- ELSE
- CALL GET_BULL_LINE(NBLOCK+1,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0) I = I + 1
- IF (ILEN.GT.0.AND.(I.GT.2.OR.(INPUT(:6).NE.'From: '.AND.
- & INPUT(:6).NE.'Subj: '))) THEN
- END = BLENGTH + ILEN - 1 + 2 ! Check how long string will be
- IF (END.GT.BRDCST_LIMIT) RETURN ! String too long?
- BROAD(BLENGTH:END) = CR//LF//INPUT(:ILEN)! Else add new input
- BLENGTH = END + 1 ! Reset pointer
- END IF
- END DO
-
- RETURN
-
- ENTRY BROADCAST(ALL,CLUSTER)
-
- CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast
-
- IF (ALL) THEN ! Should we broadcast to ALL?
- IF (CLUSTER) THEN
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLTERMS),,,%VAL(BRK$M_CLUSTER),,,,)
- ELSE
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLTERMS),,,,,,,)
- END IF
- ELSE ! Else just broadcast to users.
- IF (CLUSTER) THEN
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLUSERS),,,%VAL(BRK$M_CLUSTER),,,,)
- ELSE
- CALL SYS$BRKTHRU(,BROAD(:BLENGTH-1)//CR,,
- & %VAL(BRK$C_ALLUSERS),,,,,,,)
- END IF
- END IF
-
- CALL SYS$SETRWM(%VAL(0))
-
- RETURN
- END
-
-
- SUBROUTINE GET_FOLDER_INFO(IER)
-C
-C SUBROUTINE GET_FOLDER_INFO
-C
-C FUNCTION: Obtains & verifies folder names from command line.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- EXTERNAL CLI$_ABSENT
-
- COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
- & NODE_ERROR,POINT_NODE
- CHARACTER*32 NODES(10)
- LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
-
- COMMON /ACCESS/ READ_ONLY
- LOGICAL READ_ONLY
-
- CHARACTER NODE_TEMP*256
-
- NODE_NUM = 0 ! Initialize number of nodes
- DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',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) THEN
- NODES(NODE_NUM) = NODE_TEMP(:COMMA-1)
- NODE_TEMP = NODE_TEMP(COMMA+1:)
- ELSE
- NODES(NODE_NUM) = NODE_TEMP
- NODE_TEMP = ' '
- END IF
- NLEN = TRIM(NODES(NODE_NUM))
- IF (NODES(NODE_NUM)(NLEN-1:NLEN).EQ.'::') THEN
- NODES(NODE_NUM) = NODES(NODE_NUM)(:NLEN)//'GENERAL'
- END IF
- FOLDER_NUMBER = -1
- FOLDER1 = NODES(NODE_NUM)
- CALL SELECT_FOLDER(.FALSE.,IER)
- IF (.NOT.IER) THEN
- WRITE (6,'('' Unable to access folder '',A)')
- & NODES(NODE_NUM)
- RETURN
- ELSE IF (READ_ONLY) THEN
- WRITE (6,'('' ERROR: No write access for folder '',A)')
- & NODES(NODE_NUM)
- IER = 0
- RETURN
- END IF
- END DO
- END DO
-
- IER = 1
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin0.for b/decus/vax91b/bulletin-net91b/bulletin0.for
deleted file mode 100644
index dd77e7ce2140d535b3716b6d70529a10b0d56f72..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin0.for
+++ /dev/null
@@ -1,1746 +0,0 @@
-C
-C BULLETIN0.FOR, Version 7/11/91
-C Purpose: Bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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 DELETE_MSG
-C
-C SUBROUTINE DELETE_MSG
-C
-C FUNCTION: Deletes a bulletin entry from the bulletin file.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
- & NODE_ERROR,POINT_NODE
- CHARACTER*32 NODES(10)
- LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
-
- COMMON /DECNET/ DECNET_PROC,ERROR_UNIT
- LOGICAL DECNET_PROC
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- EXTERNAL CLI$_ABSENT
-
- CHARACTER ANSWER*1,REMOTE_USER*12,SUBJECT*53
-
- INTEGER NOW(2)
-
- IMMEDIATE = 0
- IF (CLI$PRESENT('IMMEDIATE')) IMMEDIATE = 1
-
- IF (CLI$PRESENT('NODES')) THEN ! Delete messages on DECNET node?
- CALL DELETE_NODE ! Yes...
- RETURN
- ELSE IF (DECNET_PROC) THEN ! Is this from remote node?
- IER = CLI$GET_VALUE('SUBJECT',SUBJECT,SLEN)
- CALL STR$UPCASE(SUBJECT,SUBJECT)
- CALL OPEN_BULLDIR
- CALL READDIR(0,IER)
- DEL_BULL = 0
- IER = 1
- DO WHILE (DEL_BULL+1.EQ.IER)
- DEL_BULL = DEL_BULL + 1
- CALL READDIR(DEL_BULL,IER)
- CALL STR$UPCASE(DESCRIP,DESCRIP)
- IF (DEL_BULL+1.EQ.IER.AND.USERNAME.EQ.FROM
- & .AND.INDEX(DESCRIP,SUBJECT(:SLEN)).GT.0) THEN
- CALL REMOVE_ENTRY(DEL_BULL,DEL_BULL,DEL_BULL,IMMEDIATE)
- CALL CLOSE_BULLDIR
- WRITE (5,'(''END'')') ! Tell DECNET that delete went ok.
- RETURN
- END IF
- END DO
- CALL CLOSE_BULLDIR ! Specified message not found,
- WRITE(ERROR_UNIT,1030) ! so error out.
- RETURN
- END IF
-
-C
-C Get the bulletin number to be deleted.
-C
-
- IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?
- CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)
- ELSE IF (CLI$PRESENT('ALL')) THEN
- SBULL = 1
- EBULL = F_NBULL
- IER = 0
- ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin?
- WRITE(6,1010) ! No, then error.
- RETURN
- ELSE
- SBULL = BULL_POINT ! Delete the file we are reading
- EBULL = SBULL
- IER = 0
- END IF
-
- IF (SBULL.LE.0.OR.IER.NE.0) THEN
- WRITE (6,1020)
- RETURN
- ELSE IF (EBULL.GT.F_NBULL.AND..NOT.REMOTE_SET.AND.
- & SBULL.NE.EBULL) THEN
- WRITE (6,'('' Last message specified > number in folder.'')')
- WRITE (6,'('' Do you want to delete to end of folder? '',$)')
- READ (5,'(A)',IOSTAT=IER) ANSWER
- CALL STR$UPCASE(ANSWER,ANSWER)
- IF (ANSWER.NE.'Y') THEN
- WRITE (6,'('' Deletion aborted.'')')
- RETURN
- ELSE
- EBULL = F_NBULL
- END IF
- END IF
-
-C
-C Check to see if specified bulletin is present, and if the user
-C is permitted to delete the bulletin.
-C
-
- IF (REMOTE_SET) THEN
- IF (SBULL.NE.EBULL) THEN
- WRITE (6,1025)
- RETURN
- END IF
- IF (SBULL.NE.BULL_POINT) CALL READDIR(SBULL,IER)
- CALL REMOTE_DELETE(SBULL,IMMEDIATE,DESCRIP,I,FOLDER1_COM,IER)
- IF (IER.EQ.0.AND.REMOTE_SET.NE.3) THEN
- IF (I.EQ.LEN(FOLDER1_COM)) THEN
- IER = SYS$ASCTIM(,INPUT,F1_NEWEST_BTIM,)
- NEWEST_EXDATE = INPUT(1:11)
- NEWEST_EXTIME = INPUT(13:)
- NBULL = F1_NBULL
- CALL UPDATE_FOLDER
- ELSE
- WRITE (6,'(1X,A)') FOLDER1_COM(:I)
- END IF
- ELSE IF (IER.NE.0) THEN
- CALL DISCONNECT_REMOTE
- END IF
- RETURN
- END IF
-
- CALL OPEN_BULLDIR
-
- CALL READDIR(0,IER)
-
- DO BULL_DELETE = SBULL,EBULL
- CALL READDIR(BULL_DELETE,IER) ! Get info for bulletin
-
- IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?
- WRITE(6,1030) ! If not, then error out
- CALL CLOSE_BULLDIR
- RETURN
- END IF
-
- IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,
- CALL STR$UPCASE(REMOTE_USER,FROM)
- IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges?
- & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)
- & .AND.FOLDER_SET)) THEN
- WRITE(6,1040) ! No, then error out.
- CALL CLOSE_BULLDIR
- RETURN
- ELSE IF (SBULL.EQ.EBULL) THEN
- IF (TRIM(FROM).EQ.1) THEN
- CALL OPEN_BULLFIL
- ILEN = LINE_LENGTH + 1
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- CALL CLOSE_BULLFIL
- ASK = ILEN.EQ.0.OR.INPUT(:6).NE.'From: '
- ELSE
- ASK = REMOTE_USER.EQ.FROM
- END IF
- IF (ASK) THEN
- CALL CLOSE_BULLDIR
- WRITE (6,1050) ! Make sure user wants to delete it
- READ (5,'(A)',IOSTAT=IER) ANSWER
- CALL STR$UPCASE(ANSWER,ANSWER)
- IF (ANSWER.NE.'Y') RETURN
- CALL OPEN_BULLDIR
- CALL READDIR(BULL_DELETE,IER)
- IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?
- WRITE(6,1030) ! If not, then error out
- CALL CLOSE_BULLDIR
- RETURN
- END IF
- END IF
- END IF
- END IF
-
-C
-C Delete the bulletin directory entry.
-C
- CALL REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE)
- END DO
-
- CALL CLOSE_BULLDIR
- RETURN
-
-1010 FORMAT(' ERROR: You are not reading any message.')
-1020 FORMAT(' ERROR: Specified message number has incorrect format.')
-1025 FORMAT(' ERROR: Cannot delete multiple messages in remote folder.')
-1030 FORMAT(' ERROR: Specified message was not found.')
-1040 FORMAT(' ERROR: Message was not deleted. Not owned by you.')
-1050 FORMAT(' Message is not owned by you.',
- & ' Are you sure you want to delete it? ',$)
-
- END
-
-
-
- SUBROUTINE REMOVE_ENTRY(BULL_DELETE,SBULL,EBULL,IMMEDIATE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /POINT/ BULL_POINT
-
- INTEGER NOW(2)
-
- IF (IMMEDIATE.EQ.1) THEN ! Delete it immediately
-
- CALL DELETE_ENTRY(BULL_DELETE) ! Delete the directory entry
-
- IF ((SYSTEM.AND.4).EQ.4) THEN ! Was entry shutdown bulletin?
- SHUTDOWN = SHUTDOWN - 1 ! Decrement shutdown count
- END IF
- ELSE ! Delete it eventually
-C
-C Change year of expiration date of message to 100 years less,
-C to indicate that message is to be deleted. Then, set expiration date
-C in header of folder to 15 minutes from now. Thus, the folder will be
-C checked in 15 minutes (or more), and will delete the messages then.
-C
-C NOTE: If some comic set their expiration date to > 1999, then
-C the deleted date will be set to 1899 since can't specify date <1859.
-C
-
- IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message
- EXDATE = EXDATE(1:7)//'18'//EXDATE(10:)
- IF (EXDATE(10:10).LT.'6') EXDATE(10:11) = '99'
- ELSE ! Permanent or Shutdown
- IF (EXDATE(2:2).EQ.'-') THEN
- EXDATE = EXDATE(1:6)//'19'//EXDATE(9:)
- ELSE
- EXDATE = EXDATE(1:7)//'19'//EXDATE(10:)
- END IF
- END IF
-
- CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date
-
- IER = SYS$BINTIM('0 0:15',EX_BTIM) ! Get time 15 minutes from now
- IER = SYS$GETTIM(NOW)
- IER = LIB$SUBX(NOW,EX_BTIM,EX_BTIM)
- IER = SYS$ASCTIM(,INPUT,EX_BTIM,)
-
- END IF
-
- IF (IMMEDIATE.NE.1.AND.BULL_DELETE.EQ.EBULL) THEN
- CALL READDIR(0,IER) ! Get header
-
- NEWEST_EXDATE = INPUT(1:11) ! and store new expiration date
- NEWEST_EXTIME = INPUT(13:)
-
- CALL WRITEDIR(0,IER)
- ELSE IF (BULL_DELETE.EQ.EBULL) THEN
- CALL CLEANUP_DIRFILE(SBULL) ! Reorder directory file
-
- CALL UPDATE_ALWAYS ! Somewhat a kludgey way of updating latest
- ! bulletin and expired dates.
-
- IF (SBULL.LE.BULL_POINT) THEN
- IF (BULL_POINT.GT.EBULL) THEN
- BULL_POINT = BULL_POINT - (EBULL - SBULL + 1)
- ELSE
- BULL_POINT = SBULL - 1
- END IF
- END IF ! Readjust where which bulletin to read next
- ! if deletion causes messages to be moved.
- END IF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GET_2_VALS(INPUT,ILEN,SVAL,EVAL,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /POINT/ BULL_POINT
-
- CHARACTER*(*) INPUT
-
- DELIM = MAX(INDEX(INPUT,':'),INDEX(INPUT,'-'))
-
- IF (DELIM.EQ.0) THEN
- DECODE(ILEN,'(I<ILEN>)',INPUT,IOSTAT=IER) SVAL
- EVAL = SVAL
- ELSE
- DECODE(DELIM-1,'(I<DELIM-1>)',INPUT,IOSTAT=IER) SVAL
- CALL STR$UPCASE(INPUT,INPUT)
- IF (IER.NE.0) THEN
- IF (INDEX('CURRENT',INPUT(:DELIM-1)).EQ.1) THEN
- SVAL = BULL_POINT
- IER = 0
- END IF
- END IF
- IF (IER.EQ.0) THEN
- ILEN = ILEN - DELIM
- DECODE(ILEN,'(I<ILEN>)',INPUT(DELIM+1:),IOSTAT=IER) EVAL
- IF (IER.NE.0) THEN
- IF (INDEX('LAST',INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN
- EVAL = F_NBULL
- IER = 0
- ELSE IF (INDEX('CURRENT',
- & INPUT(DELIM+1:TRIM(INPUT))).EQ.1) THEN
- EVAL = BULL_POINT
- IER = 0
- END IF
- END IF
- END IF
- IF (EVAL.LT.SVAL) IER = 2
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE DIRECTORY(DIR_COUNT)
-C
-C SUBROUTINE DIRECTORY
-C
-C FUNCTION: Display directory of messages.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
- LOGICAL PAGING
-
- DATA SCRATCH_D1/0/
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /CLOSE_FILES_INFO/ CLOSED_FILES
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- EXTERNAL CLI$_ABSENT,CLI$_NEGATED,CLI$_PRESENT,CLOSE_FILES
- EXTERNAL BULLETIN_SUBCOMMANDS
-
- CHARACTER DATETIME*23,SEARCH_STRING*80,HEADLINE*132
-
- INTEGER TODAY(2)
-
- CHARACTER*9 EXPIRES,DIR_TYPE
-
- CHARACTER TIMBUF*13
- DATA TIMBUF/'0 00:00:05.00'/
-
- INTEGER TIMADR(2) ! Buffer containing time
-
- DATA WAITEFN /0/
-
- IF (WAITEFN.EQ.0) CALL LIB$GET_EF(WAITEFN)
- IER=SYS$BINTIM(TIMBUF,TIMADR)
-
- CALL LIB$ERASE_PAGE(1,1) ! Clear the screen
-
- IF (INCMD(:3).EQ.'DIR') THEN
- IF (.NOT.CLI$PRESENT('SELECT_FOLDER')) THEN
- IF (CLI$PRESENT('MARKED')) THEN
- READ_TAG = 1 + IBSET(0,1)
- ELSE IF (CLI$PRESENT('SEEN')) THEN
- READ_TAG = 1 + IBSET(0,2)
- ELSE IF (CLI$PRESENT('UNMARKED')) THEN
- READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)
- ELSE IF (CLI$PRESENT('UNSEEN')) THEN
- READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)
- ELSE IF (CLI$PRESENT('ALL')) THEN
- READ_TAG = IBSET(0,1) + IBSET(0,2)
- IF (REMOTE_SET.EQ.3) THEN
- BULL_POINT = F_START - 1
- ELSE
- BULL_POINT = 0
- END IF
- END IF
- IF (READ_TAG) THEN
- IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN
- WRITE (6,'('' ERROR: Invalid qualifier'',
- & '' with remote folder.'')')
- READ_TAG = IBSET(0,1) + IBSET(0,2)
- RETURN
- END IF
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)
- END IF
- END IF
- IF (.NOT.READ_TAG) THEN
- SUBJECT = CLI$PRESENT('SUBJECT')
- REPLY = CLI$PRESENT('REPLY')
- REPLY_FIRST = REPLY
- SEARCH = CLI$PRESENT('SEARCH')
- END IF
- PRINTING = CLI$PRESENT('PRINT')
- ELSE
- PRINTING = .FALSE.
- END IF
-
-C
-C Directory 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 directory file, and to avoid the possibility of the user holding the screen,
-C and thus causing the directory 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.
-C
-
- CALL INIT_QUEUE(SCRATCH_D1,BULLDIR_ENTRY)
- SCRATCH_D = SCRATCH_D1
-
- CALL OPEN_BULLDIR_SHARED ! Get directory file
-
- CALL READDIR(0,IER) ! Does directory header exist?
- IF (IER.EQ.1.AND.NBULL.GT.0) THEN ! And are there messages?
- IF (DIR_COUNT.EQ.0) THEN
- EXPIRATION = CLI$PRESENT('EXPIRATION')
- IF (CLI$PRESENT('START')) THEN ! Start number specified?
- IER = CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) DIR_COUNT
- IF (DIR_COUNT.GT.NBULL) THEN
- DIR_COUNT = NBULL
- ELSE IF (DIR_COUNT.LT.1) THEN
- WRITE (6,'('' ERROR: Invalid starting message.'')')
- CALL CLOSE_BULLDIR
- DIR_COUNT = 0
- RETURN
- END IF
- ELSE IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')) THEN
- IF (CLI$PRESENT('SINCE')) THEN ! Was /SINCE specified?
- IER = CLI$GET_VALUE('SINCE',DATETIME)
- IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default.
- IER = SYS$BINTIM('-- 00:00:00.00',TODAY)
- CALL GET_MSGKEY(TODAY,MSG_KEY)
- ELSE
- CALL SYS_BINTIM(DATETIME,MSG_BTIM)
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- END IF
- CALL READDIR_KEYGE(IER)
- ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?
- IF (REMOTE_SET.NE.3) THEN
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- IF (DIFF.GE.0) THEN
- WRITE (6,'('' No new messages are present in'',
- & '' folder '',A,''.'')') FOLDER(:TRIM(FOLDER))
- CALL CLOSE_BULLDIR
- RETURN
- ELSE
- CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & MSG_KEY)
- END IF
- CALL READDIR_KEYGE(IER)
- ELSE
- CALL NEWS_GET_NEWEST_MESSAGE(IER)
- IF (IER.EQ.0) THEN
- WRITE (6,'('' No new messages are present in'',
- & '' folder '',A,''.'')')
- & FOLDER_NAME(:TRIM(FOLDER_NAME))
- RETURN
- END IF
- END IF
- END IF
-
- IF (IER.EQ.0) THEN
- WRITE (6,'('' No messages past specified date.'')')
- CALL CLOSE_BULLDIR
- RETURN
- ELSE
- DIR_COUNT = IER
- END IF
- ELSE
- DIR_COUNT = BULL_POINT
- IF (DIR_COUNT.EQ.0) DIR_COUNT = 1
- END IF
-
- IF (CLI$PRESENT('SEARCH')) THEN
- IER1 = CLI$GET_VALUE('SEARCH',SEARCH_STRING,SLEN)
- ELSE IF (CLI$PRESENT('SUBJECT')) THEN
- IER1 = CLI$GET_VALUE('SUBJECT',SEARCH_STRING,SLEN)
- ELSE IF (CLI$PRESENT('REPLY')) THEN
- SEARCH_STRING = ' '
- END IF
-
- IF (READ_TAG) THEN
- IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN
- WRITE (6,'('' ERROR: Qualifier not valid when '',
- & ''displaying only tagged messages.'')')
- SUBJECT = .FALSE.
- REPLY = .FALSE.
- SEARCH = .FALSE.
- CALL CLOSE_BULLDIR
- RETURN
- END IF
- IF (.NOT.(CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')
- & .OR.CLI$PRESENT('START'))) THEN
- DIR_COUNT = 1
- END IF
- CALL READDIR(DIR_COUNT,IER1)
- IF (IER1.EQ.DIR_COUNT+1) IER1 = 0
- IF (REMOTE_SET.EQ.3.OR.BTEST(READ_TAG,3)) THEN
- MSG_NUM = DIR_COUNT-1
- ELSE
- CALL DECREMENT_MSG_KEY
- END IF
- END IF
-
- IF (CLI$PRESENT('SINCE').OR.CLI$PRESENT('NEW')
- & .OR.CLI$PRESENT('START')) THEN
- SBULL = DIR_COUNT
- EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1
- IF (EBULL.GE.NBULL-2) EBULL = NBULL
- ELSE IF (NBULL-DIR_COUNT+1.LE.PAGE_LENGTH-5) THEN
- EBULL = NBULL
- SBULL = NBULL - (PAGE_LENGTH-5) + 1
- IF (SBULL.LT.1) SBULL = 1
- ELSE
- SBULL = DIR_COUNT
- EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1
- END IF
- ELSE IF (DIR_COUNT.EQ.-1.AND..NOT.READ_TAG) THEN
- SUBJECT = .FALSE.
- REPLY = .FALSE.
- SEARCH = .FALSE.
- SBULL = (SBULL - 1) - ((PAGE_LENGTH - 7) - 1)
- IF (SBULL.LT.1) SBULL = 1
- EBULL = SBULL + (PAGE_LENGTH - 7) - 1
- IF (NBULL-SBULL+1.LE.PAGE_LENGTH-5) THEN
- SBULL = NBULL - (PAGE_LENGTH-5) + 1
- EBULL = NBULL
- IF (SBULL.LT.1) SBULL = 1
- END IF
- ELSE IF (DIR_COUNT.EQ.-1.AND.READ_TAG) THEN
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL)
- FIRST_BULL = FIRST_BULL + 1
- IER1 = 0
- IER = 0
- FBULL = 0
- DO WHILE (SBULL.GT.FIRST_BULL.AND.IER.EQ.0)
- SBULL = SBULL - 1
- CALL READDIR(SBULL,IER)
- IF (IER.EQ.SBULL+1) THEN
- CALL GET_THIS_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY)
- IF (IER.EQ.0) THEN
- IF (FBULL.EQ.0) THEN
- EBULL = DIR_COUNT
- FBULL = EBULL + 1
- END IF
- FBULL = FBULL - 1
- IF (EBULL-FBULL.EQ.(PAGE_LENGTH-7)-1) THEN
- IER = 1
- END IF
- ELSE
- IER = 0
- END IF
- ELSE
- IER = 1
- END IF
- END DO
- IF (FBULL.EQ.FIRST_BULL) THEN
- CALL READDIR(EBULL,IER)
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY)
- DO WHILE (IER.EQ.0.AND.EBULL-FBULL.LT.(PAGE_LENGTH-7)-1)
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY)
- IF (IER.EQ.0) EBULL = EBULL + 1
- END DO
- DO I=1,3
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DIR_COUNT,DUMMY)
- END DO
- IF (IER.NE.0) EBULL = DIR_COUNT
- END IF
- CALL READDIR(EBULL,IER)
- IF (EBULL+1.NE.IER) THEN
- EBULL = EBULL + 1
- ELSE
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,DUMMY)
- IF (IER.NE.0) EBULL = EBULL + 1
- END IF
- CALL READDIR(SBULL,IER)
- CALL DECREMENT_MSG_KEY
- ELSE
- SBULL = DIR_COUNT
- EBULL = DIR_COUNT + (PAGE_LENGTH - 7) - 1
- IF (EBULL.GE.NBULL-2) EBULL = NBULL
- END IF
- IF (.NOT.PAGING.OR.PRINTING) EBULL = NBULL
- IF (INCMD(:3).EQ.'DIR') THEN
- IF (CLI$GET_VALUE('END',BULL_PARAMETER,LEN_P)) THEN
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) EBULL
- EBULL = MIN(EBULL,NBULL)
- END IF
- END IF
- IF (SUBJECT.OR.REPLY.OR.SEARCH) THEN
- CONTINUE
- ELSE IF (.NOT.REMOTE_SET.AND..NOT.READ_TAG) THEN
- DO I = SBULL,EBULL
- CALL READDIR(I,IER) ! Into the queue
- CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)
- END DO
- ELSE IF (READ_TAG) THEN
- I = 0
- DO WHILE (I.LE.EBULL.AND.IER1.EQ.0)
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DIR_COUNT,TAG_TYPE)
- IF (I.EQ.0.AND.IER1.EQ.0) THEN
- EBULL = EBULL - SBULL + DIR_COUNT
- SBULL = DIR_COUNT
- I = SBULL
- END IF
- SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)
- CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)
- I = I + 1
- END DO
- EBULL = I - 1
- IF (IER1.NE.0) THEN
- EBULL = EBULL - 1
- ELSE
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,DUMMY,TAG_TYPE)
- IF (IER1.EQ.0) THEN
- IER = 0
- EBULL_SAVE = EBULL
- DO I=1,2
- IF (IER.EQ.0) THEN
- SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)
- CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,
- & BULLDIR_ENTRY)
- EBULL = EBULL + 1
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,DUMMY,
- & TAG_TYPE)
- END IF
- END DO
- IF (IER.NE.0) THEN
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,FIRST_BULL)
- IF (SBULL.NE.FIRST_BULL+1) EBULL = EBULL_SAVE
- IER1 = 1
- ELSE
- EBULL = EBULL_SAVE
- END IF
- END IF
- END IF
- ELSE
- CALL REMOTE_DIRECTORY_COMMAND
- & (SBULL,EBULL,.FALSE.,SCRATCH_D,IER)
- IF (IER.NE.0) THEN
- CALL CLOSE_BULLDIR
- CALL DISCONNECT_REMOTE
- RETURN
- END IF
- END IF
- ELSE
- NBULL = 0
- END IF
-
- IF (NBULL.EQ.0.OR.EBULL.LT.SBULL) THEN
- CALL CLOSE_BULLDIR ! We don't need file anymore
- IF (READ_TAG) THEN
- IF (BTEST(READ_TAG,1)) THEN
- DIR_TYPE = 'marked'
- ELSE IF (BTEST(READ_TAG,2)) THEN
- DIR_TYPE = 'seen'
- ELSE IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,3)) THEN
- DIR_TYPE = 'unmarked'
- ELSE IF (BTEST(READ_TAG,2).AND.BTEST(READ_TAG,3)) THEN
- DIR_TYPE = 'unseen'
- END IF
- WRITE (6,'('' No '',A,'' messages are present in'',
- & '' folder '',A,''.'')')
- & DIR_TYPE(:TRIM(DIR_TYPE)),FOLDER_NAME(:TRIM(FOLDER_NAME))
- ELSE
- WRITE (6,'('' There are no messages present.'')')
- END IF
- DIR_COUNT = -1
- RETURN
- END IF
-
-C
-C Directory entries are now in queue. Output queue entries to screen.
-C
-
- IF (REMOTE_SET.EQ.3) THEN
- WRITE (HEADLINE,'('' ['',I,''-'',I,'']'')')
- & F_START,F_NBULL
- ELSE
- WRITE (HEADLINE,'('' [1-'',I,'']'')') F_NBULL
- END IF
- DO WHILE (INDEX(HEADLINE,'- ').GT.0)
- I = INDEX(HEADLINE,'- ')
- HEADLINE(I+1:) = HEADLINE(I+2:)
- END DO
- DO WHILE (INDEX(HEADLINE,'[ ').GT.0)
- I = INDEX(HEADLINE,'[ ')
- HEADLINE(I+1:) = HEADLINE(I+2:)
- END DO
- DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE))
- I = INDEX(HEADLINE,' ')
- HEADLINE(I:) = HEADLINE(I+1:)
- END DO
- HEADLINE = FOLDER_NAME(:TRIM(FOLDER_NAME))//HEADLINE
- BULL_PARAMETER = ' '
- IF (READ_TAG) THEN
- IF (BTEST(READ_TAG,1)) THEN
- BULL_PARAMETER = 'MARKED'
- ELSE
- BULL_PARAMETER = 'SEEN'
- END IF
- IF (BTEST(READ_TAG,3)) THEN
- BULL_PARAMETER = 'UN'//BULL_PARAMETER
- END IF
- END IF
- IF (PRINTING) THEN
- BULL_PARAMETER = 'PRINTING '//BULL_PARAMETER
- END IF
- WRITE (6,'(1X,A,<PAGE_WIDTH-TRIM(BULL_PARAMETER)-
- & TRIM(HEADLINE)>X,A)')
- & BULL_PARAMETER(:TRIM(BULL_PARAMETER)),
- & HEADLINE(:TRIM(HEADLINE))
- IF (EXPIRATION) THEN
- WRITE(6,1005)
- ELSE
- WRITE(6,1000)
- END IF
-
- TAG = (BULL_TAG.AND.REMOTE_SET.EQ.0).OR.
- & (BULL_NEWS_TAG.AND.REMOTE_SET.EQ.3)
-
- IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH).AND.TAG
- & .AND..NOT.READ_TAG) THEN
- IF (INCMD(1:3).NE.' ') THEN
- SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header
- CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)
- CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE)
- IF (IER.NE.0) NEXT_TAG = NBULL + 1
- END IF
- SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header
- DO I=SBULL,EBULL
- SAVE_SCRATCH_D = SCRATCH_D
- CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)
- IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN
- SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)
- CALL WRITE_QUEUE(%VAL(SAVE_SCRATCH_D),DUMMY,BULLDIR_ENTRY)
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,TAG_TYPE)
- IF (IER.NE.0) NEXT_TAG = NBULL + 1
- END IF
- END DO
- END IF
-
- CALL CLOSE_BULLDIR ! We don't need file anymore
-
- SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header
-
- I = SBULL
- START_SEARCH = I
- IF (.NOT.REPLY_FIRST) START_SEARCH = I - 1
- IF (SUBJECT.OR.REPLY.OR.SEARCH.OR.PRINTING) THEN
- CALL OPEN_BULLDIR_SHARED
- IF (SEARCH.OR.PRINTING) CALL OPEN_BULLFIL_SHARED
- CLOSED_FILES = .FALSE.
- END IF
- DO WHILE (I.LE.EBULL)
- IF (.NOT.(SUBJECT.OR.REPLY.OR.SEARCH)) THEN
- CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,BULLDIR_ENTRY)
- ELSE
- IF (CLOSED_FILES) THEN
- CLOSED_FILES = .FALSE.
- CALL OPEN_BULLDIR_SHARED
- IF (SEARCH.OR.PRINTING) CALL OPEN_BULLFIL_SHARED
- END IF
- CALL GET_SEARCH(FOUND,SEARCH_STRING,START_SEARCH,.FALSE.
- & ,SUBJECT,REPLY_FIRST,.FALSE.,.TRUE.)
- IF (INCMD(1:3).NE.' '.AND.TAG.AND.FOUND.GT.0) THEN
- CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,
- & TAG_TYPE)
- IF (IER.NE.0) NEXT_TAG = NBULL + 1
- CALL READDIR(FOUND,IER)
- END IF
- REPLY_FIRST = .FALSE.
- IF (FOUND.GT.0) THEN
- SEARCH_STRING = ' '
- START_SEARCH = FOUND
- IF (TAG.AND.MSG_NUM.EQ.NEXT_TAG) THEN
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER,NEXT_TAG,DUMMY)
- IF (IER.NE.0) NEXT_TAG = NBULL + 1
- CALL READDIR(FOUND,IER)
- SYSTEM = SYSTEM.OR.ISHFT(TAG_TYPE,28)
- TAG_TYPE = DUMMY
- END IF
- ELSE
- I = EBULL + 1
- END IF
- IER = SYS$SETIMR(%VAL(WAITEFN),TIMADR,CLOSE_FILES,)
- END IF
- IF (I.LE.EBULL) THEN
- CALL CONVERT_ENTRY_FROMBIN
- IF (BTEST(SYSTEM,30)) THEN
- WRITE (6,'('' >'',$)')
- ELSE
- WRITE (6,'('' '',$)')
- END IF
- IF (BTEST(SYSTEM,29)) THEN
- WRITE (6,'(''+*'',$)')
- ELSE
- WRITE (6,'(''+ '',$)')
- END IF
- N = MAX(INT(LOG10(REAL(MSG_NUM)))+1,3)
- IF ((EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0)
- & .AND.REMOTE_SET.NE.3) THEN
- WRITE(6,2010) MSG_NUM,DESCRIP(:54-N),FROM,'(DELETED)'
- ELSE IF (EXPIRATION) THEN
- IF (BTEST(SYSTEM,2)) THEN ! Shutdown bulletin?
- EXPIRES = 'Shutdown'
- ELSE IF (BTEST(SYSTEM,1)) THEN ! Permanent bulletin?
- EXPIRES = 'Permanent'
- ELSE IF (EXDATE(8:9).EQ.'18'.AND.REMOTE_SET.EQ.3) THEN
- EXPIRES = 'Unknown'
- ELSE
- EXPIRES = EXDATE(1:7)//EXDATE(10:11)
- END IF
- WRITE(6,2010) MSG_NUM,DESCRIP(:54-N),FROM,EXPIRES
- ELSE
- WRITE(6,2010) MSG_NUM,DESCRIP(:54-N),FROM,
- & DATE(1:7)//DATE(10:11)
- END IF
- IF (PRINTING) THEN
- FOUND_MSG = .TRUE.
- CALL SYS$SETAST(%VAL(0))
- CALL PRINT(MSG_NUM,CLOSED_FILES)
- CALL SYS$SETAST(%VAL(1))
- END IF
- END IF
- I = I + 1
- IF (SUBJECT.OR.REPLY.OR.SEARCH) IER = SYS$CANTIM(,)
- END DO
-
- DIR_COUNT = MSG_NUM + 1 ! Update directory counter
-
- IF (SEARCH.OR.REPLY.OR.SUBJECT.OR.PRINTING) THEN
- IF (SEARCH.OR.PRINTING) CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- IF (SEARCH.OR.REPLY.OR.SUBJECT) THEN
- IF (FOUND.GT.0) THEN
- DIR_COUNT = FOUND + 1
- ELSE
- DIR_COUNT = NBULL + 1
- END IF
- END IF
- END IF
-
- IF (DIR_COUNT.GT.NBULL.OR.(READ_TAG.AND.IER1.NE.0)) THEN
- ! Outputted all entries?
- DIR_COUNT = -1 ! Yes. Set counter to -1.
- IF (PRINTING.AND.CLI$PRESENT('NOW').AND.FOUND_MSG) THEN
- INCMD = 'PRINT/NOW'
- IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
- CALL PRINT(MSG_NUM,CLOSED_FILES)
- END IF
- ELSE
- WRITE(6,1010) ! Else say there are more
- END IF
-
- RETURN
-
-1000 FORMAT(' #',1X,'Description',43X,'From',9X,'Date',/)
-1005 FORMAT(' #',1X,'Description',43X,'From',8X,'Expires',/)
-1010 FORMAT(1X,/,' Press RETURN for more...',/)
-
-2010 FORMAT('+',I<N>,1X,A<54-N>,1X,A12,1X,A9)
-
- END
-
-
- SUBROUTINE CLOSE_FILES
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /CLOSE_FILES_INFO/ CLOSED_FILES
-
- INQUIRE(UNIT=1,OPENED=IER)
- IF (IER) CALL CLOSE_BULLFIL
-
- INQUIRE(UNIT=2,OPENED=IER)
- IF (IER) CALL CLOSE_BULLDIR
-
- CLOSED_FILES = .TRUE.
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_MSGKEY(BTIM,MSG_KEY)
-
- IMPLICIT INTEGER (A-Z)
-
- INTEGER BTIM(2)
-
- CHARACTER*8 MSG_KEY,INPUT
-
- CALL LIB$MOVC3(8,BTIM(1),%REF(INPUT))
-
- DO I=1,8
- MSG_KEY(I:I) = INPUT(9-I:9-I)
- END DO
-
- RETURN
- END
-
-
-
- SUBROUTINE FILE
-C
-C SUBROUTINE FILE
-C
-C FUNCTION: Copies a bulletin to a file.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /READ_DISPLAY/ LINE_OFFSET
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- EXTERNAL CLI$_ABSENT
-
- IF (CAPTIVE()) THEN
- WRITE (6,'('' ERROR: Command invalid from CAPTIVE account.'')')
- RETURN
- END IF
-
- IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?
- CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)
- IF (EBULL.GT.F_NBULL) EBULL = F_NBULL
- ELSE IF (CLI$PRESENT('ALL')) THEN
- SBULL = 1
- EBULL = F_NBULL
- IER = 0
- ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin?
- WRITE(6,1010) ! No, then error.
- RETURN
- ELSE
- SBULL = BULL_POINT
- EBULL = SBULL
- IER = 0
- END IF
-
- IF (SBULL.LE.0.OR.IER.NE.0) THEN
- WRITE (6,1015)
- RETURN
- END IF
-
- IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)
-
- IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN ! If no file name was specified
- WRITE(6,1020) ! Write error
- RETURN ! And return
- END IF
-
- CALL DISABLE_PRIVS
-
- IF (CLI$PRESENT('NEW')) THEN
- OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
- ELSE
- OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),IOSTAT=IER,
- & RECL=LINE_LENGTH,
- & STATUS='OLD',CARRIAGECONTROL='LIST',ACCESS='APPEND')
- IF (IER.NE.0) THEN
- OPEN(UNIT=3,FILE=BULL_PARAMETER(1:LEN_P),ERR=900,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
- ELSE IF (CLI$PRESENT('FF')) THEN
- WRITE (3,'(A)') CHAR(12)
- END IF
- END IF
-
- CALL ENABLE_PRIVS ! Reset SYSPRV privileges
-
- HEAD = CLI$PRESENT('HEADER')
-
- CALL OPEN_BULLDIR_SHARED
- CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file
-
- FIRST = .TRUE.
-
- DO FBULL = SBULL,EBULL
- FBULL1 = FBULL
- CALL READDIR(FBULL,IER) ! Get info for specified bulletin
-
- IF (IER.NE.FBULL+1.OR.FBULL.GT.EBULL.OR.(.NOT.CLI$PRESENT
- & ('ALL').AND.FBULL1.EQ.SBULL.AND.FBULL.NE.SBULL)) THEN
- IF (REMOTE_SET.NE.3.OR.FBULL1.EQ.SBULL) WRITE(6,1030) FBULL1
- IF (FBULL1.GT.SBULL) GO TO 100
- CLOSE (UNIT=3,STATUS='DELETE')
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- RETURN
- ELSE IF (REMOTE_SET) THEN
- CALL REMOTE_READ_MESSAGE(FBULL,IER1)
- IF (IER1.GT.0) THEN
- CALL DISCONNECT_REMOTE
- ELSE
- CALL GET_REMOTE_MESSAGE(IER1)
- END IF
- IF (IER1.NE.0) GO TO 100
- END IF
-
- IF (.NOT.FIRST.AND.CLI$PRESENT('FF')) THEN
- WRITE (3,'(A)') CHAR(12)
- ELSE IF (FIRST) THEN
- FIRST = .FALSE.
- END IF
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- IF (HEAD) WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- ELSE IF (HEAD) THEN
- WRITE(3,1060) FROM,DATE//' '//TIME(:8)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- IF (HEAD) WRITE(3,1050) INPUT(7:ILEN)
- ELSE
- IF (HEAD) WRITE(3,1050) DESCRIP
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)
- END DO
- END DO
-
-100 CLOSE (UNIT=3) ! Bulletin copy completed
-
- WRITE(6,1040) BULL_PARAMETER(1:LEN_P)
- ! Show name of file created.
-
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
-
- RETURN
-
-900 WRITE(6,1000)
- CALL ENABLE_PRIVS ! Reset BYPASS privileges
- RETURN
-
-1000 FORMAT(' ERROR: Error in opening file.')
-1010 FORMAT(' ERROR: You have not read any bulletin.')
-1015 FORMAT(' ERROR: Specified message number has incorrect format.')
-1020 FORMAT(' ERROR: No file name was specified.')
-1030 FORMAT(' ERROR: Following bulletin was not found: ',I)
-1040 FORMAT(' Message(s) written to ',A)
-1050 FORMAT('Description: ',A,/)
-1060 FORMAT(/,'From: ',A,/,'Date: ',A)
-
- END
-
-
-
- SUBROUTINE COPY2(OUT,IN)
-
- CALL LIB$MOVC3(8,IN,OUT)
-
- RETURN
- END
-
-
-
- SUBROUTINE LOGIN
-C
-C SUBROUTINE LOGIN
-C
-C FUNCTION: Alerts user of new messages upon logging in.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /READIT/ READIT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
- LOGICAL PAGING
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /PROMPT/ COMMAND_PROMPT
- CHARACTER*39 COMMAND_PROMPT
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2)
-
- COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH
- COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)
- COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE
- CHARACTER*1 SEPARATE
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER TODAY*23,INREAD*1
-
- LOGICAL*1 CTRL_G/7/
-
- DATA GEN_DIR1/0/ ! General directory link list header
- DATA SYS_DIR1/0/ ! System directory link list header
- DATA SYS_NUM1/0/ ! System message number link list header
- DATA SYS_BUL1/0/ ! System bulletin link list header
- DATA ALL_DIR1/0/ ! Full directory link list header (for remote)
-
- DATA PAGE/0/
-
- DATA FIRST_WRITE/.TRUE./
- LOGICAL FIRST_WRITE
-
- COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)
-
- DIMENSION NOLOGIN_BTIM(2),TODAY_BTIM(2)
- DIMENSION NEW_BTIM(2),PASSCHANGE(2),BULLCP_BTIM(2)
- DIMENSION LOGIN_BTIM_OLD(2),LOGIN_BTIM_NEW(2)
-
- FOLDER_NAME = 'GENERAL'
-
- CALL SYS$ASCTIM(,TODAY,,) ! Get the present time
- CALL SYS_BINTIM(TODAY,TODAY_BTIM)
-
- CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)
- CALL SYS_BINTIM('5-NOV-1956 11:05:56',NEW_BTIM)
-
-C
-C Find user entry in BULLUSER.DAT to update information and
-C to get the last date that messages were read.
-C
-
- CALL OPEN_BULLUSER_SHARED
-
- CALL READ_USER_FILE_HEADER(IER) ! Get the header
-
- IF (IER.EQ.0) THEN ! Header is present.
- UNLOCK 4
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER1)
- ! Find if there is an entry
- IF (NEW_FLAG(1).LT.143.OR.NEW_FLAG(1).GT.143) THEN
- NEW_FLAG(2)=0 ! If old version clear GENERIC value
- NEW_FLAG(1)=143 ! Set new version number
- END IF
- IF (IER1.EQ.0) THEN ! There is a user entry
- IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN
- ! DISMAIL or SET LOGIN set
- IF (CLI$PRESENT('ALL')) THEN
- CALL COPY2(LOGIN_BTIM,TODAY_BTIM(1))
- ELSE
- RETURN ! Don't notify
- END IF
- END IF
- CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM)
- CALL COPY2(LOGIN_BTIM,TODAY_BTIM)
- REWRITE (4) USER_ENTRY
- IF (SYSTEM_FLAG(1).NE.0.AND.SYSTEM_FLAG(1).NE.1) READIT = 1
- DO I = 1,FLONG
- IF (SET_FLAG(I).NE.0.OR.BRIEF_FLAG(I).NE.0.OR.
- & (I.GT.1.AND.SYSTEM_FLAG(I).NE.0)) READIT = 1
- END DO
- ELSE
- CALL CLEANUP_LOGIN ! Good time to delete dead users
- CALL COPY2(READ_BTIM,NEW_BTIM) ! Make new entry
- DO I = 1,FLONG
- SET_FLAG(I) = SET_FLAG_DEF(I)
- BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)
- NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)
- END DO
- NEW_FLAG(1) = 143
- NEW_FLAG(2) = 0
- CALL CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE)
- IF (DISMAIL.EQ.1) THEN
- CALL COPY2(LOGIN_BTIM,NOLOGIN_BTIM)
- CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM)
- ELSE
- CALL COPY2(LOGIN_BTIM_SAVE,NEW_BTIM)
- CALL COPY2(LOGIN_BTIM,TODAY_BTIM)
- DO I = 1,FLONG
- IF (SET_FLAG(I).NE.0) READIT = 1
- END DO
- IF (COMPARE_BTIM(PASSCHANGE,NEWEST_BTIM).LT.0) IER1 = 0
- ! Old password change indicates user is new to BULLETIN
- ! but not to system, so don't limit message viewing.
- END IF
- CALL WRITE_USER_FILE(IER)
- IF (IER.NE.0) THEN ! Error in writing to user file
- WRITE (6,1070) ! Tell user of the error
- CALL CLOSE_BULLUSER ! Close the user file
- CALL EXIT ! Go away...
- END IF
- IF (DISMAIL.EQ.1) RETURN ! Go away if DISMAIL set
- DIFF = -1 ! Force us to look at messages
- CALL OPEN_BULLINF_SHARED
- DO I=1,FOLDER_MAX
- CALL COPY2(LAST_READ_BTIM(1,I),READ_BTIM)
- END DO
- WRITE (9,IOSTAT=IER) USERNAME,
- & ((LAST_READ_BTIM(I,J),I=1,2),J=1,FOLDER_MAX)
- CALL CLOSE_BULLINF
- END IF
- CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE)
- CALL READ_USER_FILE_HEADER(IER2) ! Reset read back to header
- END IF
-
- IF (IER.EQ.0.AND.MINUTE_DIFF(TODAY_BTIM,BBOARD_BTIM)
- & .GT.BBOARD_UPDATE) THEN ! Update BBOARD mail?
- CALL COPY2(BBOARD_BTIM,TODAY_BTIM)
- REWRITE (4) USER_HEADER ! Rewrite header
- IF (.NOT.TEST_BULLCP()) CALL CREATE_PROCESS('BBOARD')
- ELSE IF (IER.NE.0) THEN
- CALL CLOSE_BULLUSER
- CALL EXIT ! If no header, no messages
- END IF
-
- IF (IER1.EQ.0) THEN ! Skip date comparison if new entry
-C
-C Compare and see if messages have been added since the last time
-C that the user has logged in or used the BULLETIN facility.
-C
- DIFF1 = COMPARE_BTIM(LOGIN_BTIM,READ_BTIM)
- IF (DIFF1.LT.0) THEN ! If read messages since last login,
- CALL COPY2(LOGIN_BTIM,READ_BTIM)
- ! then use read date to compare with latest bulletin date
- END IF ! to see if should alert user.
-
- IF (SYSTEM_SWITCH) THEN
- DIFF1 = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,NEWEST_BTIM)
- ELSE
- DIFF1 = COMPARE_BTIM(LOGIN_BTIM,NEWEST_BTIM)
- END IF
- END IF
-
- CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM) ! Destroyed in UPDATE_READ
-
- IF (NEW_FLAG(2).NE.0.AND.NEW_FLAG(2).NE.-1) THEN
- CALL LIB$MOVC3(4,NEW_FLAG(2),%REF(BULL_PARAMETER))
- CALL SUBTIME(LOGIN_BTIM,BULL_PARAMETER(1:4),IER)
- ELSE IF (DIFF1.GT.0) THEN
- BULL_POINT = -1
- IF (READIT.EQ.1) THEN
- CALL UPDATE_READ(1)
- CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM)
- CALL READ_IN_FOLDERS
- CALL MODIFY_SYSTEM_LIST(1)
- END IF
- CALL CLOSE_BULLUSER
- RETURN
- END IF
-
- CALL READ_IN_FOLDERS
- CALL MODIFY_SYSTEM_LIST(1)
-
- ENTRY LOGIN_FOLDER
-
- IF (NEW_FLAG(2).EQ.0.OR.NEW_FLAG(2).EQ.-1.OR.FOLDER_SET) THEN
- CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_SAVE)
- END IF
-
- IF (REMOTE_SET.EQ.1) THEN ! If system remote folder, use remote
- ! info, not local login time
- IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN
- CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1))
- LAST_SYS_BTIM(1,FOLDER_NUMBER+1) = 0
- LAST_SYS_BTIM(2,FOLDER_NUMBER+1) = 0
- ELSE
- DIFF1 = COMPARE_BTIM(LOGIN_BTIM,
- & LAST_READ_BTIM(1,FOLDER_NUMBER+1))
- IF (DIFF1.LT.0) THEN
- CALL COPY2(LOGIN_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1))
- ELSE
- DIFF = MINUTE_DIFF(LOGIN_BTIM,F_NEWEST_BTIM)
- IF (DIFF.GE.0.AND.DIFF.LE.15) THEN ! BULLCP updates every 15 min
- IER = SYS$BINTIM('0 00:15',BULLCP_BTIM)
- BULLCP_BTIM(1) = -BULLCP_BTIM(1) ! Convert to -delta time
- BULLCP_BTIM(2) = -BULLCP_BTIM(2)-1
- CALL LIB$SUBX(LOGIN_BTIM,BULLCP_BTIM,LOGIN_BTIM)
- END IF
- END IF
- END IF
- END IF
-
- ENTRY SHOW_SYSTEM
-
- JUST_SYSTEM = (.NOT.LOGIN_SWITCH.AND.SYSTEM_SWITCH).OR.
- & (BTEST(FOLDER_FLAG,2)
- & .AND..NOT.TEST_SET_FLAG(FOLDER_NUMBER)
- & .AND..NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))
-
- NGEN = 0 ! Number of general messages
- NSYS = 0 ! Number of system messages
- BULL_POINT = -1
-
- IF (IER1.NE.0.AND.FOLDER_NUMBER.GT.0) THEN
- IF (LOGIN_SWITCH) THEN
- IF (READIT.EQ.1) THEN
- CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM)
- CALL UPDATE_READ(1)
- CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM)
- END IF
- CALL CLOSE_BULLUSER
- END IF
- RETURN ! Don't overwhelm new user with lots of non-general msgs
- END IF
-
- IF (BTEST(FOLDER_FLAG,2).AND.SYSTEM_SWITCH) THEN
- ! Can folder have SYSTEM messages and /SYSTEM specified?
- CALL COPY2(LOGIN_BTIM,SYSTEM_LOGIN_BTIM) ! Use specified login time
- ! for system messages.
- END IF
-
- IF (LOGIN_SWITCH) THEN
- IF (READIT.EQ.1) THEN
- CALL COPY2(LOGIN_BTIM_OLD,LOGIN_BTIM)
- CALL UPDATE_READ(1)
- CALL COPY2(LOGIN_BTIM_NEW,LOGIN_BTIM)
- CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_OLD)
- END IF
- CALL CLOSE_BULLUSER
- END IF
-
- IF (READIT.EQ.1.AND.FOLDER_NUMBER.GE.0) THEN
- IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).NE.0) THEN
- DIFF1 = COMPARE_BTIM(LOGIN_BTIM,
- & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))
- IF (DIFF1.LT.0) THEN
- CALL COPY2(LOGIN_BTIM,LAST_SYS_BTIM(1,FOLDER_NUMBER+1))
- END IF
- CALL COPY2(LAST_SYS_BTIM(1,FOLDER_NUMBER+1),
- & LOGIN_BTIM_NEW)
- END IF
-
- IF (TEST2(BRIEF_FLAG,FOLDER_NUMBER)
- & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN
- IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) GO TO 9999
- END IF
- END IF
-
- CALL OPEN_BULLDIR_SHARED ! Get bulletin directory
- IF (.NOT.REMOTE_SET) THEN
- CALL READDIR(0,IER) ! Get header info
- ELSE
- NBULL = F_NBULL
- END IF
-
- CALL INIT_QUEUE(GEN_DIR1,BULLDIR_ENTRY)
- CALL INIT_QUEUE(SYS_DIR1,BULLDIR_ENTRY)
- CALL INIT_QUEUE(SYS_NUM1,%DESCR(ICOUNT))
- GEN_DIR = GEN_DIR1
- SYS_DIR = SYS_DIR1
- SYS_NUM = SYS_NUM1
- START = 1
- REVERSE = 0
- IF ((.NOT.TEST_SET_FLAG(FOLDER_NUMBER).OR.
- & .NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))
- & .AND..NOT.BTEST(FOLDER_FLAG,7)) THEN
- IF (REVERSE_SWITCH) REVERSE = 1
- IF (IER1.EQ.0) THEN
- CALL GET_NEWEST_MSG(LOGIN_BTIM,START)
- IF (START.EQ.-1) START = NBULL + 1
- END IF
- END IF
-
- IF (REMOTE_SET) THEN
- CALL INIT_QUEUE(ALL_DIR1,BULLDIR_ENTRY)
- ALL_DIR = ALL_DIR1
- CALL REMOTE_DIRECTORY_COMMAND(START,NBULL,
- & .NOT.REVERSE,ALL_DIR,IER)
- IF (IER.NE.0) THEN
- CALL CLOSE_BULLDIR
- CALL DISCONNECT_REMOTE
- GO TO 9999
- END IF
- LAST_DIR = ALL_DIR
- ALL_DIR = ALL_DIR1
- END IF
-
- DO ICOUNT1 = NBULL,START,-1
- IF (REVERSE) THEN
- ICOUNT = NBULL + START - ICOUNT1
- ELSE
- ICOUNT = ICOUNT1
- END IF
- IF (REMOTE_SET) THEN
- IF (ALL_DIR.EQ.LAST_DIR) GO TO 100
- CALL READ_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)
- IER = ICOUNT + 1
- ELSE
- CALL READDIR(ICOUNT,IER)
- END IF
- IF (IER1.EQ.0.AND.IER.EQ.ICOUNT+1) THEN ! Is this a totally new user?
- IF (.NOT.REVERSE.AND..NOT.BTEST(FOLDER_FLAG,7)) THEN
- DIFF = COMPARE_BTIM(LOGIN_BTIM,MSG_BTIM) ! No, so compare date
- IF (DIFF.GT.0) GO TO 100
- END IF
- IF (.NOT.BTEST(FOLDER_FLAG,2)) SYSTEM = SYSTEM.AND.(.NOT.1)
- ! Show system msg in non-system folder as general msg
- IF (USERNAME.NE.FROM.OR.SYSTEM) THEN
- ! Is bulletin system or from same user?
- IF (SYSTEM) THEN ! Is it system bulletin?
- NSYS = NSYS + 1
- CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)
- CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))
- ELSE IF (.NOT.JUST_SYSTEM) THEN
- IF (BTEST(FOLDER_FLAG,7)) THEN
- DIFF = COMPARE_BTIM
- & (LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)
- ELSE IF (.NOT.SYSTEM_SWITCH) THEN
- DIFF = -1
- ELSE
- DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,MSG_BTIM)
- END IF
- IF (DIFF.LT.0) THEN
- IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN
- BULL_POINT = ICOUNT - 1
- IF (.NOT.BTEST(FOLDER_FLAG,2).AND.
- & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.
- & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100
- END IF
- NGEN = NGEN + 1
- SYSTEM = ICOUNT
- CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY)
- END IF
- END IF
- END IF
- ELSE IF (IER.EQ.ICOUNT+1) THEN
- ! Totally new user, save only permanent system msgs
- IF ((SYSTEM.AND.7).EQ.3.OR.
- & (SYSTEM.AND.BTEST(FOLDER_FLAG,7))) THEN
- NSYS = NSYS + 1
- CALL WRITE_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)
- CALL WRITE_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))
- ELSE IF (NGEN.EQ.0.OR. ! And save only the first non-system msg
- & BTEST(FOLDER_FLAG,7)) THEN ! and SET ALWAYS folder messages
- SYSTEM = ICOUNT ! Save bulletin number for display
- IF (.NOT.REVERSE.OR.BULL_POINT.EQ.-1) THEN
- BULL_POINT = ICOUNT - 1
- IF (.NOT.BTEST(FOLDER_FLAG,2).AND.
- & TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.
- & TEST_SET_FLAG(FOLDER_NUMBER)) GO TO 100
- END IF
- NGEN = NGEN + 1
- CALL WRITE_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY)
- END IF
- END IF
- END DO
-100 CALL CLOSE_BULLDIR
-C
-C Review new directory entries. If there are system messages,
-C copy the system bulletin into GEN_DIR file BULLSYS.SCR for outputting
-C to the terminal. If there are simple messages, just output the
-C header information.
-C
- IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.
- & TEST_SET_FLAG(FOLDER_NUMBER)) NGEN = 0
-
- IF (NGEN.EQ.0.AND.NSYS.EQ.0) GO TO 9999
-
- IF (NSYS.GT.0) THEN ! Are there any system messages?
- IF (FIRST_WRITE) THEN
- PAGE = 4 ! Don't erase MAIL/PASSWORD notifies
- FIRST_WRITE = .FALSE. ! if this is first write to screen.
- END IF
- LENF = TRIM(FOLDER_NAME)
- S1 = (PAGE_WIDTH-(LENF+16))/2
- S2 = PAGE_WIDTH - S1 - (LENF + 16)
- WRITE (6,'(''+'',A,$)') CTRL_G
- WRITE (6,1026) FOLDER_NAME(:LENF) ! Yep...
- PAGE = PAGE + 1
- CTRL_G = 0 ! Don't ring bell for non-system bulls
- CALL OPEN_BULLFIL_SHARED
- CALL INIT_QUEUE(SYS_BUL1,INPUT)
- SYS_BUL = SYS_BUL1
- SYS_DIR = SYS_DIR1
- SYS_NUM = SYS_NUM1
- NSYS_LINE = 0
- DO J=1,NSYS
- CALL READ_QUEUE(%VAL(SYS_DIR),SYS_DIR,BULLDIR_ENTRY)
- IF (REMOTE_SET) THEN
- CALL READ_QUEUE(%VAL(SYS_NUM),SYS_NUM,%DESCR(ICOUNT))
- WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,ICOUNT
- IF (IER.GT.0) THEN
- CALL DISCONNECT_REMOTE
- ELSE
- CALL GET_REMOTE_MESSAGE(IER)
- END IF
- IF (IER.GT.0) THEN
- CALL CLOSE_BULLFIL
- GO TO 9999
- END IF
- END IF
- INPUT = ' '
- CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)
- NSYS_LINE = NSYS_LINE + 1
- ILEN = LINE_LENGTH + 1
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- DO WHILE (ILEN.GT.0) ! Copy bulletin to SYS_BUL link list
- CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)
- NSYS_LINE = NSYS_LINE + 1
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END DO
- IF (ILEN.LT.0) THEN
- CALL CLOSE_BULLFIL
- GO TO 9999
- END IF
- IF (J.LT.NSYS.AND.SEPARATE.NE.' ') THEN
- INPUT = ' '
- CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)
- DO I=1,PAGE_WIDTH
- INPUT(I:I) = SEPARATE
- END DO
- CALL WRITE_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)
- NSYS_LINE = NSYS_LINE + 2
- END IF
- END DO
- CALL CLOSE_BULLFIL
- SYS_BUL = SYS_BUL1
- ILEN = 0
- I = 1
- DO WHILE (I.LE.NSYS_LINE.OR.ILEN.GT.0) ! Write out system messages
- IF (ILEN.EQ.0) THEN
- CALL READ_QUEUE(%VAL(SYS_BUL),SYS_BUL,INPUT)
- ILEN = TRIM(INPUT)
- I = I + 1
- END IF
- IF (SYS_BUL.NE.0) THEN
- IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN
- ! If at end of screen
- WRITE(6,1080) ! Ask for input to proceed to next page
- CALL GET_INPUT_NOECHO_PROMPT(INREAD,! Get terminal input
- & 'HIT any key for next page....')
- WRITE (6,'(1X)')
- CALL LIB$ERASE_PAGE(1,1) ! Clear the screen
- PAGE = 1
- IF (ILEN.LE.PAGE_WIDTH) THEN
- WRITE(6,1060) '+'//INPUT(:ILEN)
- ILEN = 0
- ELSE
- WRITE(6,1060) '+'//INPUT(:PAGE_WIDTH)
- INPUT = INPUT(PAGE_WIDTH+1:)
- ILEN = ILEN - PAGE_WIDTH
- END IF
- ELSE
- PAGE = PAGE + 1
- IF (ILEN.LE.PAGE_WIDTH) THEN
- WRITE(6,1060) ' '//INPUT(:ILEN)
- ILEN = 0
- ELSE
- WRITE(6,1060) ' '//INPUT(:PAGE_WIDTH)
- INPUT = INPUT(PAGE_WIDTH+1:)
- ILEN = ILEN - PAGE_WIDTH
- END IF
- END IF
- END IF
- END DO
- IF (NGEN.EQ.0) THEN
- WRITE(6,'(A)') ! Write delimiting blank line
- END IF
- PAGE = PAGE + 1
- END IF
-
- ENTRY REDISPLAY_DIRECTORY
-
- GEN_DIR = GEN_DIR1
- IF (NGEN.GT.0) THEN ! Are there new non-system messages?
- LENF = TRIM(FOLDER_NAME)
- S1 = (PAGE_WIDTH-13-LENF)/2
- S2 = PAGE_WIDTH-S1-13-LENF
- IF (PAGE+5+NGEN.GT.PAGE_LENGTH.AND.PAGE.GT.0) THEN
- WRITE(6,1080) ! Ask for input to proceed to next page
- CALL GET_INPUT_NOECHO_PROMPT(INREAD, ! Get terminal input
- & 'HIT any key for next page....')
- WRITE (6,'(1X)')
- CALL LIB$ERASE_PAGE(1,1) ! Clear the screen
- WRITE (6,'(''+'',A,$)') CTRL_G
- WRITE(6,1028) 'New '//FOLDER_NAME(1:LENF)//' messages'
- PAGE = 1
- ELSE
- IF (FIRST_WRITE) THEN
- PAGE = 4 ! Don't erase MAIL/PASSWORD notifies
- FIRST_WRITE = .FALSE. ! if this is first write to screen.
- END IF
- WRITE (6,'(''+'',A,$)') CTRL_G
- WRITE(6,1027) 'New '//FOLDER_NAME(1:LENF)//' messages'
- PAGE = PAGE + 1
- END IF
- WRITE(6,1020)
- WRITE(6,1025)
- PAGE = PAGE + 2
- I = 0
- DO WHILE (I.LT.NGEN)
- I = I + 1
- CALL READ_QUEUE(%VAL(GEN_DIR),GEN_DIR,BULLDIR_ENTRY)
- CALL CONVERT_ENTRY_FROMBIN
- N = MAX(INT(LOG10(REAL(SYSTEM)))+1,3)
- N1 = MAX(1,6-N)
- IF (PAGE.EQ.PAGE_LENGTH-2.AND.PAGING) THEN ! If at end of screen
- WRITE(6,1080) ! Ask for input to proceed to next page
- CALL GET_INPUT_NOECHO_PROMPT(INREAD,
- & 'HIT Q(Quit listing) or any other key for next page....')
- CALL STR$UPCASE(INREAD,INREAD)
- WRITE (6,'(1X)')
- CALL LIB$ERASE_PAGE(1,1) ! Clear the screen
- PAGE = 1
- IF (INREAD.EQ.'Q') THEN
- I = NGEN ! Quit directory listing
- WRITE(6,'(''+Quitting directory listing.'')')
- ELSE
- WRITE(6,1040) '+'//DESCRIP(:53),FROM,DATE(:6),SYSTEM
- END IF
- ! Bulletin number is stored in SYSTEM
- ELSE
- PAGE = PAGE + 1
- WRITE(6,1040) ' '//DESCRIP(:53),FROM,DATE(:6),SYSTEM
- END IF
- END DO
- IF ((.NOT.FOLDER_SET.AND.BTEST(SET_FLAG(1),0).AND.DIFF1.LE.0)
- & .OR.(FOLDER_SET.AND.TEST_SET_FLAG(FOLDER_NUMBER))) THEN
- PAGE = 0 ! Don't reset page counter if READNEW not set,
- END IF ! as no prompt to read is generated.
- END IF
-C
-C Instruct users how to read displayed messages if READNEW not selected.
-C
- IF (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.
- & TEST_SET_FLAG(FOLDER_NUMBER)) THEN
- WRITE(6,1030)
- ELSE IF (NGEN.EQ.0) THEN
- ILEN = 57 + INDEX(COMMAND_PROMPT,'>') - 1
- S1 = (PAGE_WIDTH-ILEN)/2
- S2 = PAGE_WIDTH - S1 - ILEN
- WRITE(6,1035) 'The '//COMMAND_PROMPT(:ILEN-57)//
- & '/SYSTEM command can be used to reread these messages.'
- ELSE
- FLEN = TRIM(FOLDER_NAME)
- IF (FOLDER_NUMBER.EQ.0) FLEN = -1
- ILEN = 30 + INDEX(COMMAND_PROMPT,'>') - 1 + FLEN
- S1 = (PAGE_WIDTH-ILEN)/2
- S2 = PAGE_WIDTH - S1 - ILEN
- IF (FOLDER_NUMBER.EQ.0) THEN
- WRITE(6,1035) 'Type ' //COMMAND_PROMPT(:ILEN-29)//
- & ' to read these messages.'
- ELSE
- WRITE(6,1035) 'Type '//COMMAND_PROMPT(:ILEN-30-FLEN)
- & //' '//FOLDER_NAME(:FLEN)//
- & ' to read these messages.'
- END IF
- END IF
-
-9999 IF (LOGIN_SWITCH) THEN
- CALL COPY2(LOGIN_BTIM,LOGIN_BTIM_NEW)
- CALL COPY2(LOGIN_BTIM_SAVE,LOGIN_BTIM_OLD)
- END IF
- RETURN
-
-1020 FORMAT(' Description',43X,'From',9X,'Date',3X,'Number')
-1025 FORMAT(' -----------',43X,'----',9X,'----',3X,'------')
-1026 FORMAT(' ',<S1>('*'),A,' System Messages',<S2>('*'))
-1027 FORMAT(/,' ',<S1>('*'),A,<S2>('*'))
-1028 FORMAT('+',<S1>('*'),A,<S2>('*'))
-1030 FORMAT(' ',<PAGE_WIDTH>('*'))
-1035 FORMAT(' ',<S1>('*'),A,<S2>('*'))
-1040 FORMAT(A<53>,2X,A12,1X,A6,<N1>X,I<N>)
-1060 FORMAT(A)
-1070 FORMAT(' ERROR: Cannot add new entry to user file.')
-1080 FORMAT(' ',/)
-
- END
-
-
-
- SUBROUTINE GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($SYIDEF)'
-
- CHARACTER*(*) NODE_NAME
-
- CALL INIT_ITMLST ! Initialize item list
- ! Now add items to list
- CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA))
- CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER))
- CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETSYIW(,,NODE_NAME(:TRIM(NODE_NAME)),
- & %VAL(GETSYI_ITMLST),,,) ! Get Info command.
-
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Specified node name not found.'')')
- NODE_AREA = 0
- END IF
-
- RETURN
- END
-
diff --git a/decus/vax91b/bulletin-net91b/bulletin1.for b/decus/vax91b/bulletin-net91b/bulletin1.for
deleted file mode 100644
index 39ea677ed4d85d0f5f9ffe41eb1e547b94218dd1..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin1.for
+++ /dev/null
@@ -1,1925 +0,0 @@
-C
-C BULLETIN1.FOR, Version 7/11/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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 MAIL
-C
-C SUBROUTINE MAIL
-C
-C FUNCTION: Sends message which you have read to user via DEC mail.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*64 MAIL_SUBJECT
-
- INCLUDE 'BULLDIR.INC'
-
- EXTERNAL CLI$_ABSENT
-
- IF (BTEST(CAPTIVE(),1)) THEN
- WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')')
- RETURN
- END IF
-
- IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read
- WRITE(6,'('' ERROR: You have not read any message.'')')
- RETURN ! And return
- END IF
-
- MAIL_SUBJECT = DESCRIP
- IF (CLI$PRESENT('SUBJECT')) THEN
- IER = CLI$GET_VALUE('SUBJECT',MAIL_SUBJECT,LEN_D)
- IF (LEN_D.GT.LEN(MAIL_SUBJECT)-2) THEN
- WRITE(6,'('' ERROR: Subject limit is 64 characters.'')')
- RETURN
- END IF
- END IF
-
- CALL OPEN_BULLDIR_SHARED
-
- CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin
-
- IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found?
- WRITE(6,'('' ERROR: Specified message was not found.'')')
- CALL CLOSE_BULLDIR ! If not, then error out
- RETURN
- END IF
-
- CALL CLOSE_BULLDIR
-
- IF (CLI$PRESENT('EDIT')) THEN
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- END IF
-
- OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
-
- IF (IER.NE.0) THEN
- WRITE(6,'('' ERROR: Error in opening scratch file.'')')
- RETURN
- END IF
-
- IF (CLI$PRESENT('HEADER')) THEN ! Printout header?
- IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN
- IF (REMOTE_SET.NE.3) THEN
- INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)'
- ELSE
- INPUT = 'Date: '//DATE//' '//TIME(:5)
- END IF
- ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?
- INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown'
- ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin?
- INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent'
- ELSE
- INPUT = 'Date: '//DATE//' '//TIME(:5)//
- & ' Expires: '//EXDATE//' '//EXTIME(:5)
- END IF
- IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin?
- INPUT = INPUT(:TRIM(INPUT))//' / System'
- END IF
- WRITE (3,'(A)') INPUT(:TRIM(INPUT))
- END IF
-
- HEAD = CLI$PRESENT('HEADER')
-
- CALL OPEN_BULLFIL_SHARED ! Open BULLETIN file
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- IF (HEAD) WRITE(3,1060) INPUT(7:ILEN)
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- ELSE IF (HEAD) THEN
- WRITE(3,1060) FROM
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- IF (HEAD) WRITE(3,1050) INPUT(7:ILEN)
- ELSE
- IF (HEAD) WRITE(3,1050) DESCRIP
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
- END DO
-
- CLOSE (UNIT=3) ! Message copy completed
-
- CALL CLOSE_BULLFIL
-
- LEN_D = TRIM(MAIL_SUBJECT)
- IF (LEN_D.EQ.0) THEN
- MAIL_SUBJECT = 'BULLETIN message.'
- LEN_D = TRIM(MAIL_SUBJECT)
- END IF
-
- I = 1
- DO WHILE (I.LE.LEN_D)
- IF (MAIL_SUBJECT(I:I).EQ.'"') THEN
- IF (LEN_D.EQ.64) THEN
- MAIL_SUBJECT(I:I) = '`'
- ELSE
- MAIL_SUBJECT = MAIL_SUBJECT(:I)//'"'//MAIL_SUBJECT(I+1:)
- I = I + 1
- LEN_D = LEN_D + 1
- END IF
- END IF
- I = I + 1
- END DO
-
- LEN_P = 0
- DO WHILE (CLI$GET_VALUE('RECIPIENTS',BULL_PARAMETER(LEN_P+1:),I)
- & .NE.%LOC(CLI$_ABSENT)) ! Get all the usernames
- LEN_P = LEN_P + I + 1
- BULL_PARAMETER(LEN_P:LEN_P) = ','
- END DO
- LEN_P = LEN_P - 1
-
- I = 1 ! Must change all " to """ in MAIL recipients
- DO WHILE (I.LE.LEN_P)
- IF (BULL_PARAMETER(I:I).EQ.'"') THEN
- BULL_PARAMETER = BULL_PARAMETER(:I)//'""'//
- & BULL_PARAMETER(I+1:)
- I = I + 2
- LEN_P = LEN_P + 2
- END IF
- I = I + 1
- END DO
-
- IF (CLI$PRESENT('EDIT')) THEN
- CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
- CONTEXT = 0
- IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT)
- VERSION = INDEX(INPUT,';') + 1
- IF (INPUT(VERSION:VERSION).EQ.'1') THEN
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- WRITE (6,'('' ERROR: No message mailed.'')')
- RETURN
- END IF
- END IF
-
- CALL DISABLE_PRIVS
- CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR '//BULL_PARAMETER(:LEN_P)
- & //'/SUBJECT="'//MAIL_SUBJECT(:LEN_D)//'"',,,,,,STATUS)
- CALL ENABLE_PRIVS
-
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR')
-
- RETURN
-
-1050 FORMAT('Description: ',A,/)
-1060 FORMAT('From: ',A)
-
- END
-
-
-
- SUBROUTINE MODIFY_FOLDER
-C
-C SUBROUTINE MODIFY_FOLDER
-C
-C FUNCTION: Modifies a folder's information.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE '($SSDEF)'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER PASSWORD*31,DEFAULT_USER*12
-
- IF (FOLDER_NUMBER.EQ.0) THEN
- WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')')
- RETURN
- ELSE IF (.NOT.FOLDER_ACCESS
- & (USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- WRITE (6,'('' ERROR: No privileges to modify folder.'')')
- RETURN
- END IF
-
- IF (CLI$PRESENT('NAME')) THEN
- IF (REMOTE_SET) THEN
- WRITE (6,'('' ERROR: Cannot change name of'',
- & '' remote folder.'')')
- RETURN
- ELSE
- CALL CLI$GET_VALUE('NAME',FOLDER1,LEN_P)
- IF (LEN_P.GT.25) THEN
- WRITE (6,'('' ERROR: Folder name cannot be larger
- & than 25 characters.'')')
- RETURN
- END IF
- END IF
- ELSE
- FOLDER1 = FOLDER
- END IF
-
- IF (CLI$PRESENT('DESCRIPTION')) THEN
- WRITE (6,'('' Enter one line description of folder.'')')
- LENF = 81
- DO WHILE (LENF.GT.80)
- CALL GET_LINE(FOLDER1_DESCRIP,LENF) ! Get input line
- IF (LENF.LE.0) THEN
- WRITE (6,'('' ERROR: Folder modification aborted.'')')
- RETURN
- ELSE IF (LENF.GT.80) THEN ! If too many characters
- WRITE (6,'('' ERROR: Description must be < 80 characters.'')')
- ELSE
- FOLDER1_DESCRIP = FOLDER1_DESCRIP(:LENF) ! End fill with spaces
- END IF
- END DO
- ELSE
- FOLDER1_DESCRIP = FOLDER_DESCRIP
- END IF
-
- IF (CLI$PRESENT('OWNER')) THEN
- CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P)
- IF (LEN_P.GT.12) THEN
- WRITE (6,'('' ERROR: Owner name must be < 13 characters.'')')
- RETURN
- ELSE IF (CLI$PRESENT('ID')) THEN
- IER = CHKPRO(FOLDER1_OWNER)
- ELSE
- CALL GET_UAF
- & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)
- END IF
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Owner name is not valid username.'')')
- RETURN
- ELSE IF (LEN_P.GT.LEN(FOLDER1_OWNER)) THEN
- WRITE (6,'('' ERROR: Folder owner name too long.'')')
- RETURN
- ELSE IF (.NOT.SETPRV_PRIV()) THEN
- WRITE(6,'('' Enter password of new owner: '',A)') CHAR(10)
- CALL GET_INPUT_NOECHO(PASSWORD)
- IF (TRIM(PASSWORD).EQ.0) THEN
- WRITE (6,'('' ERROR: No password entered.'')')
- RETURN
- END IF
- WRITE (6,'('' Attempting to verify password name...'')')
- OPEN (UNIT=10,NAME='SYS$NODE"'//
- & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER))
- & //' '//PASSWORD(:TRIM(PASSWORD))//'"::',
- & TYPE='SCRATCH',IOSTAT=IER)
- CLOSE (UNIT=10)
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: Password is invalid.'')')
- RETURN
- ELSE
- WRITE (6,'('' Password was verified.'')')
- END IF
- ELSE
- FOLDER1_OWNER = FOLDER1_OWNER(:LEN_P)
- END IF
- ELSE
- FOLDER1_OWNER = FOLDER_OWNER
- END IF
-
- CALL OPEN_BULLFOLDER ! Open folder file
-
- IF (CLI$PRESENT('NAME')) THEN
- READ (7,IOSTAT=IER,KEY=FOLDER1,KEYID=0)
- ! See if folder exists
- IF (IER.EQ.0) THEN
- WRITE (6,'('' ERROR: Folder name already exists.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- END IF
- END IF
-
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
-
- IF (IER.EQ.0.AND.CLI$PRESENT('NAME')) THEN
- LEN_F = TRIM(FOLDER_DIRECTORY)
- IER = LIB$RENAME_FILE(FOLDER_DIRECTORY(:LEN_F)//
- & FOLDER(:TRIM(FOLDER))//'.*',FOLDER_DIRECTORY(:LEN_F)//
- & FOLDER1(:TRIM(FOLDER1))//'.*')
- IF (IER) THEN
- IER = 0
- FOLDER_FILE = FOLDER_DIRECTORY(:LEN_F)//FOLDER1
- END IF
- END IF
-
- IF (IER.EQ.0) THEN
- IF (CLI$PRESENT('OWNER')) THEN
- CALL CHKACL
- & (FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',IER)
- IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
- CALL ADD_ACL(FOLDER1_OWNER,'R+W+C',IER)
- CALL DEL_ACL(FOLDER_OWNER,'R+W+C',IER)
- END IF
- END IF
- FOLDER = FOLDER1
- FOLDER_OWNER = FOLDER1_OWNER
- FOLDER_DESCRIP = FOLDER1_DESCRIP
- DELETE (7)
- IF (CLI$PRESENT('ID')) THEN
- FOLDER_FLAG = IBSET(FOLDER_FLAG,6)
- ELSE
- FOLDER_FLAG = IBCLR(FOLDER_FLAG,6)
- END IF
- CALL WRITE_FOLDER_FILE(IER)
- IF (IER.EQ.0) WRITE (6,'('' Folder successfully modified.'')')
- END IF
-
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: Folder modification aborted.'')')
- END IF
-
- CALL CLOSE_BULLFOLDER
-
- RETURN
- END
-
-
-
- FUNCTION FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) USERNAME,FOLDER_OWNER
-
- IF (SETPRV_PRIV()) THEN
- FOLDER_ACCESS = .TRUE.
- ELSE IF (BTEST(FOLDER_FLAG,6)) THEN ! If folder owner is ID
- FOLDER_ACCESS = CHKPRO(FOLDER_OWNER)
- ELSE
- FOLDER_ACCESS = USERNAME.EQ.FOLDER_OWNER
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE MOVE(DELETE_ORIGINAL)
-C
-C SUBROUTINE MOVE
-C
-C FUNCTION: Moves message from one folder to another.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /ACCESS/ READ_ONLY
- LOGICAL READ_ONLY
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1
- DATA SCRATCH_R1 /0/
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /HEADER/ HEADER
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- EXTERNAL CLI$_ABSENT,BULLETIN_SUBCOMMANDS
-
- LOGICAL DELETE_ORIGINAL
-
- CHARACTER SAVE_FOLDER*25,POST_SUBJECT*255
-
- IF (CLI$PRESENT('ORIGINAL').AND..NOT.SETPRV_PRIV()) THEN
- WRITE (6,
- & '('' ERROR: You have no privileges to keep original owner.'')')
- RETURN
- END IF
-
- ALL = CLI$PRESENT('ALL')
-
- MERGE = CLI$PRESENT('MERGE')
-
- SAVE_BULL_POINT = BULL_POINT
-
- IER1 = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN
- IF (BULL_POINT.EQ.0) THEN ! If no message has been read
- WRITE(6,'('' ERROR: You are not reading any message.'')')
- RETURN ! and return
- END IF
-
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR(BULL_POINT,IER) ! Get message directory entry
- IF (IER.NE.BULL_POINT+1) THEN ! Was message found?
- WRITE(6,'('' ERROR: Specified message was not found.'')')
- CALL CLOSE_BULLDIR
- RETURN
- END IF
-
- NUM_COPY = 1
- ELSE
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR(0,IER) ! Get message directory entry
- IF (NBULL.EQ.0) THEN ! Were messages found?
- WRITE(6,'('' ERROR: No messages were found.'')')
- CALL CLOSE_BULLDIR
- RETURN
- END IF
-
- IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN
- CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1)
- IF (EBULL.GT.F_NBULL) EBULL = F_NBULL
- IF (SBULL.LE.0.OR.IER1.NE.0) THEN
- WRITE (6,'(A)')
- & ' ERROR: Specified message number has incorrect format.'
- CALL CLOSE_BULLDIR
- RETURN
- ELSE
- NUM_COPY = EBULL - SBULL + 1
- BULL_POINT = SBULL
- END IF
- IF (NUM_COPY.GT.1) ALL = .TRUE.
- ELSE IF (CLI$PRESENT('ALL')) THEN
- NUM_COPY = NBULL
- BULL_POINT = 1
- END IF
- END IF
-
- FROM_REMOTE = REMOTE_SET
-
- IF (REMOTE_SET) THEN
- OPEN (UNIT=12,FILE='REMOTE.BULLDIR',
- & STATUS='SCRATCH',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- IF (IER.EQ.0) THEN
- OPEN (UNIT=11,FILE='REMOTE.BULLFIL',
- & STATUS='SCRATCH',IOSTAT=IER,
- & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
- & FORM='UNFORMATTED')
- END IF
- IF (IER.EQ.0) THEN
- CALL OPEN_BULLFIL
- CALL READDIR(0,IER)
- IF (IER.EQ.1) WRITE (12,IOSTAT=IER1) BULLDIR_HEADER
- I = BULL_POINT - 1
- IER = I + 1
- NBLOCK = 1
- LAST = BULL_POINT+NUM_COPY-1
- NUM_COPY = 0
- DO WHILE (I.LT.LAST.AND.IER.EQ.I+1)
- I = I + 1
- I1 = I
- CALL READDIR(I,IER)
- IF ((I1.EQ.BULL_POINT.AND.I1.NE.I)
- & .AND..NOT.CLI$PRESENT('ALL')) THEN
- WRITE(6,'('' ERROR: Message not found: '',I)') I1
- CLOSE (UNIT=11)
- CLOSE (UNIT=12)
- CALL CLOSE_BULLDIR
- CALL CLOSE_BULLFIL
- RETURN
- END IF
- IF (IER.EQ.I+1.AND.I.LE.LAST) THEN
- BLOCK = NBLOCK
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- CALL REMOTE_READ_MESSAGE(I,IER1)
- IF (IER1.GT.0) THEN
- CALL DISCONNECT_REMOTE
- ELSE
- CALL GET_REMOTE_MESSAGE(IER1)
- END IF
- IF (LENGTH.EQ.0) IER = 1 ! Don't allow empty messages
- IF (IER1.EQ.0) THEN
- SCRATCH_R = SCRATCH_R1
- DO J=1,LENGTH
- CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT(:128))
- WRITE (11'NBLOCK,IOSTAT=IER1) INPUT(:128)
- IF (IER1.EQ.0) NBLOCK = NBLOCK + 1
- END DO
- END IF
- IF (IER1.EQ.0) WRITE (12,IOSTAT=IER1) BULLDIR_ENTRY
- IF (IER1.NE.0) THEN
- I = IER
- ELSE
- NUM_COPY = NUM_COPY + 1
- END IF
- END IF
- END DO
- END IF
- CALL CLOSE_BULLFIL
- IF (IER1.NE.0) THEN
- WRITE(6,'('' ERROR: Copy aborted. Remote folder problem.'')')
- CLOSE (UNIT=11)
- CLOSE (UNIT=12)
- CALL CLOSE_BULLDIR
- RETURN
- END IF
- END IF
-
- CALL CLOSE_BULLDIR
-
- SAVE_FOLDER = FOLDER
- SAVE_FOLDER_NUMBER = FOLDER_NUMBER
- CALL CLI$GET_VALUE('FOLDER',FOLDER1)
-
- FOLDER_NUMBER = -1 ! Use FOLDER as key rather than FOLDER_NUMBER
- CALL SELECT_FOLDER(.FALSE.,IER)
-
- IER1 = .TRUE.
-
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Cannot access specified folder.'')')
- ELSE IF (READ_ONLY.OR.(MERGE.AND.REMOTE_SET.GT.0)) THEN
- IF (READ_ONLY) THEN
- WRITE (6,'('' ERROR: No access to write into folder.'')')
- ELSE
- WRITE (6,'('' ERROR: /MERGE invalid into remote folder.'')')
- END IF
- IER1 = .FALSE.
- ELSE IF (REMOTE_SET.EQ.4) THEN
- IF (CLI$PRESENT('ORIGINAL')) THEN
- REMOTE_SET = 0
- ELSE
- SLIST = INDEX(FOLDER_DESCRIP,'<')
- FOLDER1_DESCRIP =
- & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)
- IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN
- WRITE(6,'('' ERROR: Multiple newsgroup feed'',
- & '' is present.'')')
- IER1 = .FALSE.
- END IF
- END IF
- END IF
-
- IF (.NOT.IER.OR..NOT.IER1) THEN
- FOLDER_NUMBER = SAVE_FOLDER_NUMBER
- IF (.NOT.IER) THEN
- FOLDER = SAVE_FOLDER
- BULL_POINT = SAVE_BULL_POINT
- ELSE
- FOLDER_NUMBER = SAVE_FOLDER_NUMBER
- FOLDER1 = SAVE_FOLDER
- CALL SELECT_FOLDER(.FALSE.,IER1)
- END IF
- BULL_POINT = SAVE_BULL_POINT
- CLOSE (UNIT=11)
- CLOSE (UNIT=12)
- RETURN
- END IF
-C
-C Add bulletin to bulletin file and directory entry for to directory file.
-C
- IF (REMOTE_SET.GE.3) THEN
- OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
- & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')
- ELSE
- CALL OPEN_BULLDIR ! Prepare to add dir entry
-
- CALL OPEN_BULLFIL ! Prepare to add bulletin
-
- CALL READDIR(0,IER) ! Get NBLOCK
- IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0
- END IF
-
- FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
- & //SAVE_FOLDER
-
- IF (.NOT.FROM_REMOTE) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=12,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))
- & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- END DO
-
- IF (IER.EQ.0) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=11,FILE=FOLDER1_FILE(:TRIM(FOLDER1_FILE))
- & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,
- & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
- & FORM='UNFORMATTED')
- END DO
- END IF
- ELSE
- IER= 0
- END IF
-
- IF (REMOTE_SET.GE.3) THEN
- SAVE_HEADER = HEADER
- IF (CLI$PRESENT('HEADER')) THEN
- HEADER = .TRUE.
- ELSE
- HEADER = .FALSE.
- END IF
- END IF
-
- IF (MERGE) CALL INITIALIZE_MERGE(IER)
-
- START_BULL_POINT = BULL_POINT
-
- IF (IER.EQ.0) THEN
- IF (FROM_REMOTE) THEN
- READ (12,KEYID=0,KEY=0,IOSTAT=IER)
- ELSE
- READ (12,KEYID=0,KEY=BULL_POINT-1,IOSTAT=IER)
- END IF
- END IF
-
- DO WHILE (NUM_COPY.GT.0.AND.IER.EQ.0)
- READ (12,IOSTAT=IER) BULLDIR_ENTRY
- NUM_COPY = NUM_COPY - 1
-
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- CALL CONVERT_ENTRY_FROMBIN
-
- IF (REMOTE_SET.GE.3) SYSTEM = 0
-
- IF (FROM_REMOTE.EQ.3) THEN
- SYSTEM = 0
- IF (FOLDER_BBEXPIRE.GT.0) THEN
- CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
- ELSE IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Permanent message
- EXDATE = '5-NOV-2000'
- SYSTEM = 2
- ELSE IF (EX_BTIM(1).EQ.0.AND.EX_BTIM(2).EQ.0) THEN
- CALL GET_EXDATE(EXDATE,14)
- END IF
- END IF
-
- IF (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder?
- & .NOT.SETPRV_PRIV()) THEN ! Or no privileges?
- SYSTEM = IBCLR(SYSTEM,0) ! Remove system bit
- END IF
-
- IF (BTEST(SYSTEM,2).AND. ! Shutdown message?
- & (.NOT.BTEST(FOLDER_FLAG,2).OR. ! Not system folder?
- & .NOT.SETPRV_PRIV())) THEN ! Or no privileges?
- SYSTEM = IBCLR(SYSTEM,2) ! Remove shutdown bit
- WRITE (6,'('' ERROR: No privileges to add'',
- & '' shutdown message.'')')
- IF (FOLDER_BBEXPIRE.GT.0) THEN
- CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
- WRITE (6,'('' Expiration will be '',I,'' days.'')')
- & FOLDER_BBEXPIRE
- ELSE
- CALL GET_EXDATE(EXDATE,14)
- WRITE (6,'('' Expiration will be '',I,'' days.'')') 14
- END IF
- EXTIME = '00:00:00.00'
- ELSE IF (BTEST(SYSTEM,1).AND. ! Permanent?
- & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present?
- & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- WRITE (6,'('' ERROR: No privileges to add'',
- & '' permanent message.'')')
- WRITE (6,'('' Expiration will be '',I,'' days.'')')
- & F_EXPIRE_LIMIT
- SYSTEM = IBCLR(SYSTEM,1)
- CALL GET_EXDATE(EXDATE,F_EXPIRE_LIMIT)
- EXTIME = '00:00:00.00'
- END IF
-
- IF (.NOT.CLI$PRESENT('ORIGINAL')) THEN ! If not /ORIGINAL
- FROM = USERNAME ! Specify owner
- END IF
-
- IF (REMOTE_SET.EQ.1) THEN
- WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2
- IF (IER.NE.0) CALL ERROR_AND_EXIT
- ELSE IF (REMOTE_SET.GE.3) THEN
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- POST_SUBJECT = INPUT(7:ILEN)
- ELSE
- POST_SUBJECT = DESCRIP
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(1:ILEN)
- END DO
-
- REWIND (UNIT=3)
-
- CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,POST_SUBJECT)
- END IF
-
- IF (REMOTE_SET.LT.3) THEN
- IF (MERGE) CALL ADD_MERGE_TO(IER)
-
- IF (IER.EQ.0) THEN
- NBLOCK = NBLOCK + 1
-
- DO I=BLOCK,BLOCK+LENGTH-1
- READ (11'I,IOSTAT=IER) INPUT(:128)
- IF (IER.EQ.0) THEN
- CALL WRITE_BULL_FILE(NBLOCK,INPUT(:128))
- END IF
- NBLOCK = NBLOCK + 1
- END DO
- END IF
-
- IF (IER.EQ.0) THEN
- IF (MERGE) THEN
- CALL ADD_MERGE_FROM(IER)
- ELSE IF (FROM_REMOTE) THEN
- CALL ADD_ENTRY
- ELSE
- CALL ADD_ENTRY ! Add the new directory entry
- END IF
- BULL_POINT = BULL_POINT + 1
- END IF
- END IF
- END DO
-
- IF (REMOTE_SET.GE.3) CLOSE (UNIT=3)
-
- IF (MERGE) CALL ADD_MERGE_REST(IER)
-
- IF (REMOTE_SET.LT.3) CALL CLOSE_BULLFIL
-
- CLOSE (UNIT=11)
-
- CLOSE (UNIT=12)
-
- IF (FOLDER_NUMBER.GE.0.AND.IER.EQ.0.AND.REMOTE_SET.LT.3) THEN
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- CALL UPDATE_FOLDER ! Update folder info
-C
-C If user is adding message, an no new messages, update last read time for
-C folder, so user is not alerted of new message which is owned by user.
-C
- IF (DIFF.GE.0) THEN
- CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),F_NEWEST_BTIM)
- END IF
- END IF
-
- IF (REMOTE_SET.LT.3) CALL CLOSE_BULLDIR ! Totally finished with add
-
- IF (IER.EQ.0) THEN
- WRITE (6,'('' Successful copy to folder '',A)')
- & FOLDER(:TRIM(FOLDER))//'.'
- IF (MERGE) THEN
- CALL LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
- & '.BULLDIR;-1')
- END IF
- ELSE IF (MERGE) THEN
- WRITE (6,'('' ERROR: Copy aborted. No files copied.'')')
- ELSE
- WRITE (6,'('' ERROR: Copy aborted. '',I,'' files copied.'')')
- & BULL_POINT - START_BULL_POINT
- END IF
-
- IF (REMOTE_SET.LT.3) HEADER = SAVE_HEADER
-
- FOLDER_NUMBER = SAVE_FOLDER_NUMBER
- FOLDER1 = SAVE_FOLDER
- CALL SELECT_FOLDER(.FALSE.,IER1)
-
- BULL_POINT = SAVE_BULL_POINT
-
- IF (DELETE_ORIGINAL.AND.IER.EQ.0) THEN
- IF (FROM_REMOTE.AND.ALL) THEN
- WRITE (6,'('' WARNING: Original messages not deleted.'')')
- WRITE (6,'('' Multiple deletions not possible for '',
- & ''remote folders.'')')
- ELSE
- IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
- CALL DELETE_MSG
- END IF
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE PRINT(PRINT_NUM,OPEN_IT)
-C
-C SUBROUTINE PRINT
-C
-C FUNCTION: Print header to queue.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($SJCDEF)'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- EXTERNAL CLI$_ABSENT
-
- CHARACTER*32 QUEUE
-
- INTEGER*2 FILE_ID(14)
- INTEGER*2 IOSB(4)
- EQUIVALENCE (IOSB(1),JBC_ERROR)
-
- CHARACTER*31 FORM
-
- PARAMETER FF = CHAR(12)
-
- DATA FIRST /.TRUE./
-
- IF (CLI$PRESENT('NOW').AND..NOT.FIRST.AND.
- & INCMD(:4).EQ.'PRIN') THEN
- WRITE (6,'('' Printing all previously queued messages.'')')
- GO TO 200
- END IF
-
- IF (PRINT_NUM.EQ.0) THEN
- IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?
- CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)
- IF (EBULL.GT.F_NBULL) EBULL = F_NBULL
- ELSE IF (CLI$PRESENT('ALL')) THEN
- SBULL = 1
- EBULL = F_NBULL
- IER = 0
- ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin?
- WRITE(6,1010) ! No, then error.
- RETURN
- ELSE
- SBULL = BULL_POINT
- EBULL = SBULL
- IER = 0
- END IF
- IF (SBULL.LE.0.OR.IER.NE.0) THEN
- WRITE (6,1015)
- RETURN
- END IF
- ELSE
- SBULL = PRINT_NUM
- EBULL = SBULL
- END IF
-
- IF (FIRST) THEN
- QLEN = 0
- IER = CLI$GET_VALUE('QUEUE',QUEUE,QLEN) ! Get queue name
- IF (QLEN.EQ.0) THEN
- QUEUE = 'SYS$PRINT'
- QLEN = TRIM(QUEUE)
- END IF
-
- NOTIFY = CLI$PRESENT('NOTIFY')
-
- FLEN = 0
- IER = CLI$GET_VALUE('FORM',FORM,FLEN) ! Get form name
-
- CALL DISABLE_PRIVS
-
- OPEN(UNIT=24,FILE='SYS$LOGIN:BULL.LIS',ERR=900,IOSTAT=IER,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
-
- CALL ENABLE_PRIVS
- END IF
-
- IF (OPEN_IT) THEN
- CALL OPEN_BULLDIR_SHARED
- CALL OPEN_BULLFIL_SHARED
- END IF
-
- HEAD = CLI$PRESENT('HEADER')
-
- DO I=SBULL,EBULL
- I1 = I
- CALL READDIR(I,IER) ! Get info for specified message
- IF (IER.NE.I+1.OR.I.GT.EBULL.OR.(.NOT.CLI$PRESENT
- & ('ALL').AND.I1.EQ.SBULL.AND.I.NE.SBULL)) THEN
- IF (REMOTE_SET.NE.3.OR.I1.EQ.SBULL) WRITE(6,1030) I1
- IF (I1.GT.SBULL) GO TO 100
- CLOSE (UNIT=24,STATUS='DELETE')
- IF (OPEN_IT) THEN
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- END IF
- RETURN
- ELSE IF (REMOTE_SET) THEN
- CALL REMOTE_READ_MESSAGE(I,IER1)
- IF (IER1.GT.0) THEN
- CALL DISCONNECT_REMOTE
- ELSE
- CALL GET_REMOTE_MESSAGE(IER1)
- END IF
- IF (IER1.NE.0) GO TO 100
- END IF
-
- IF (.NOT.FIRST) THEN
- WRITE (24,'(A)') FF
- ELSE
- FIRST = .FALSE.
- END IF
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- IF (HEAD) THEN
- WRITE(24,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)
- END IF
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- ELSE IF (HEAD) THEN
- WRITE(24,1060) FROM,DATE//' '//TIME(:8)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- IF (HEAD) WRITE(24,1050) INPUT(7:ILEN)
- ELSE
- IF (HEAD) WRITE(24,1050) DESCRIP
- IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(:ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0) WRITE (24,'(A)') INPUT(1:ILEN)
- END DO
- END DO
-
-100 IF (OPEN_IT) THEN
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- END IF
-
- IF (.NOT.CLI$PRESENT('NOW').OR.INCMD(:4).NE.'PRIN') RETURN
-
- ENTRY PRINT_NOW
-
-200 IF (FIRST) RETURN
-
- FIRST = .TRUE.
-
- CLOSE (UNIT=24)
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(18,SJC$_FILE_SPECIFICATION,
- & %LOC('SYS$LOGIN:BULL.LIS'))
-
- CALL ADD_2_ITMLST(QLEN,SJC$_QUEUE,%LOC(QUEUE))
- CALL ADD_2_ITMLST(0,SJC$_DELETE_FILE,0)
-
- IF (NOTIFY) CALL ADD_2_ITMLST(0,SJC$_NOTIFY,0)
-
- IF (FLEN.GT.0) THEN
- CALL ADD_2_ITMLST(FLEN,SJC$_FORM_NAME,%LOC(FORM))
- END IF
-
- CALL DISABLE_PRIVS
-
- CALL ADD_2_ITMLST(4,SJC$_ENTRY_NUMBER_OUTPUT,%LOC(JOBNUM))
-
- CALL END_ITMLST(SJC_ITMLST)
-
- IER=SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SJC_ITMLST),IOSB,,)
- IF (IER.AND.(.NOT.JBC_ERROR)) THEN
- CALL SYS_GETMSG(JBC_ERROR)
- IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;')
- ELSE IF (.NOT.IER) THEN
- CALL SYS_GETMSG(IER)
- IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.LIS;')
- ELSE
- IER = OTS$CVT_L_TI(JOBNUM,BULL_PARAMETER,,,)
- IF (IER) WRITE (6,'('' Job BULL (queue '',A,'', entry '',A,
- & '') started on '',A)') QUEUE(:QLEN),
- & BULL_PARAMETER(FIRST_ALPHA(BULL_PARAMETER):),QUEUE(:QLEN)
- END IF
-
- CALL ENABLE_PRIVS ! Reset SYSPRV privileges
-
- RETURN
-
-900 CALL ERRSNS(IDUMMY,IER)
- CALL ENABLE_PRIVS ! Reset SYSPRV privileges
- WRITE(6,1000)
- CALL SYS_GETMSG(IER)
- RETURN
-
-1000 FORMAT(' ERROR: Unable to open temporary file
- & SYS$LOGIN:BULL.LIS for printing.')
-1010 FORMAT(' ERROR: You have not read any message.')
-1015 FORMAT(' ERROR: Specified message number has incorrect format.')
-1030 FORMAT(' ERROR: Following bulletin was not found: ',I)
-1050 FORMAT('Description: ',A,/)
-1060 FORMAT('From: ',A,/,'Date: ',A)
-
- END
-
-
-
-
- SUBROUTINE READ_MSG(READ_COUNT,BULL_READ)
-C
-C SUBROUTINE READ_MSG
-C
-C FUNCTION: Reads a specified bulletin.
-C
-C PARAMETER:
-C READ_COUNT - Variable to store the record in the message file
-C that READ will read from. Must be set to 0 to indicate
-C that it is the first read of the message. If -1,
-C READ will search for the last message in the message file
-C and read that one. If -2, just display header information.
-C BULL_READ - Message number to be read.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /READIT/ READIT
-
- COMMON /PAGE/ PAGE_LENGTH,REAL_PAGE_WIDTH,PAGING
- LOGICAL PAGING
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /READ_DISPLAY/ LINE_OFFSET
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /HEADER/ HEADER
-
- COMMON /NEXT/ NEXT
- LOGICAL NEXT /.FALSE./
-
- DATA SCRATCH_B1/0/
-
- CHARACTER TODAY*11,DATETIME*23,BUFFER*(LINE_LENGTH)
- CHARACTER HEADLINE*132
-
- LOGICAL SINCE,PAGE
-
- EXTERNAL CLI$_NEGATED
-
- CALL LIB$ERASE_PAGE(1,1) ! Clear screen
- END = 0 ! Nothing outputted on screen
-
- IF (READ_COUNT.GT.0) GO TO 100 ! Skip init steps if this is
- ! not first page of bulletin
-
- IF (INCMD(:4).EQ.'READ'.OR.INCMD(:4).EQ.'LAST'.OR.
- & INCMD(:4).EQ.'BACK'.OR.INCMD(:3).EQ.'CUR'.OR.
- & INCMD(:4).EQ.'FIRS') THEN
- IF (CLI$PRESENT('HEADER')) THEN
- HEADER = .TRUE.
- ELSE IF (CLI$PRESENT('HEADER').EQ.%LOC(CLI$_NEGATED)) THEN
- HEADER = .FALSE.
- END IF
- END IF
-
- SINCE = .FALSE.
- NEW = .FALSE.
- PAGE = .TRUE.
-
- IER = 0
-
- IF (.NOT.PAGING) PAGE = .FALSE.
- IF (INCMD(:4).EQ.'READ') THEN ! If READ command...
- IF (CLI$PRESENT('MARKED')) THEN
- READ_TAG = 1 + IBSET(0,1)
- ELSE IF (CLI$PRESENT('SEEN')) THEN
- READ_TAG = 1 + IBSET(0,2)
- ELSE IF (CLI$PRESENT('UNMARKED').OR.
- & CLI$PRESENT('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN
- READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)
- ELSE IF (CLI$PRESENT('UNSEEN').OR.
- & CLI$PRESENT('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN
- READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)
- ELSE IF (CLI$PRESENT('ALL')) THEN
- READ_TAG = IBSET(0,1) + IBSET(0,2)
- IF (REMOTE_SET.EQ.3) THEN
- BULL_READ = F_START
- ELSE
- BULL_READ = 1
- END IF
- END IF
- IF (READ_TAG) THEN
- IF (.NOT.(FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3)) THEN
- WRITE (6,'('' ERROR: Invalid qualifier'',
- & '' with remote folder.'')')
- READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)
- RETURN
- END IF
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_POINT)
- END IF
-
- IF (.NOT.CLI$PRESENT('PAGE')) PAGE = .FALSE.
- IF (CLI$PRESENT('SINCE')) THEN ! was /SINCE specified?
- IER = CLI$GET_VALUE('SINCE',DATETIME)
- IF (DATETIME.EQ.'TODAY') THEN ! TODAY is the default.
- IER = SYS$BINTIM('-- 00:00:00.00',TODAY)
- CALL GET_MSGKEY(TODAY,MSG_KEY)
- ELSE
- CALL SYS_BINTIM(DATETIME,MSG_BTIM)
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- END IF
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR_KEYGE(IER)
- CALL CLOSE_BULLDIR
- ELSE IF (CLI$PRESENT('NEW')) THEN ! was /NEW specified?
- NEW = .TRUE.
- IF (REMOTE_SET.NE.3) THEN
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- IF (DIFF.GE.0) THEN
- WRITE (6,'('' No new messages are present.'')')
- RETURN
- ELSE
- CALL GET_MSGKEY(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & MSG_KEY)
- END IF
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR_KEYGE(IER)
- CALL CLOSE_BULLDIR
- ELSE
- CALL NEWS_GET_NEWEST_MESSAGE(IER)
- IF (IER.EQ.0) THEN
- WRITE (6,'('' No new messages are present.'')')
- RETURN
- END IF
- END IF
- BULL_READ = IER
- IER = IER + 1
- END IF
- IF (CLI$PRESENT('SINCE')) THEN
- IF (IER.EQ.0) THEN
- WRITE (6,'('' No messages past specified date.'')')
- RETURN
- ELSE
- BULL_READ = IER
- IER = IER + 1
- END IF
- SINCE = .TRUE.
- END IF
- END IF
-
- NEXT = .FALSE.
- IF (INCMD(:1).EQ.'N'.OR.INCMD.EQ.' ') THEN
- NEXT = .TRUE.
- ELSE IF (INCMD(:4).EQ.'READ'.AND..NOT.SINCE.AND..NOT.NEW
- & .AND..NOT.CLI$PRESENT('BULLETIN_NUMBER')
- & .AND..NOT.CLI$PRESENT('ALL')) THEN
- NEXT = .TRUE.
- END IF
-
- IF (READ_TAG) THEN
- IER = 0
- IF ((INCMD(:4).EQ.'BACK'.AND.REMOTE_SET.EQ.3).OR.
- & (INCMD(:4).EQ.'LAST'.AND.BTEST(READ_TAG,3))) THEN
- IF (BULL_POINT.EQ.0.OR.INCMD(:4).EQ.'LAST') THEN
- MSG_NUM = F_NBULL+1
- ELSE
- MSG_NUM = BULL_POINT
- END IF
- CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- IF (IER1.EQ.0) IER = BULL_READ + 1
- ELSE IF (INCMD(:4).EQ.'BACK') THEN
- CALL OPEN_BULLDIR_SHARED
- CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- CALL CLOSE_BULLDIR
- IF (IER1.EQ.0) IER = BULL_READ + 1
- ELSE IF (INCMD(:4).EQ.'LAST') THEN
- CALL OPEN_BULLDIR_SHARED
- IF (BULL_POINT.GT.0) THEN
- CALL READDIR(BULL_POINT,IER)
- IF (IER.NE.BULL_POINT+1) THEN
- BULL_POINT = 0
- ELSE
- CALL GET_THIS_OR_NEXT_TAG
- & (FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- IF (IER1.NE.0) BULL_POINT = 0
- END IF
- END IF
- IF (BULL_POINT.EQ.0) THEN
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- IF (IER1.EQ.0) IER = BULL_READ + 1
- END IF
- DO WHILE (IER1.EQ.0)
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- IF (IER1.EQ.0) IER = BULL_READ + 1
- END DO
- CALL CLOSE_BULLDIR
- ELSE IF (INCMD(:4).EQ.'FIRS') THEN
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- IF (IER1.EQ.0) IER = BULL_READ + 1
- ELSE IF (NEXT.OR.SINCE.OR.NEW) THEN
- OLD_NEXT = NEXT
- NEXT = .FALSE.
- IF (NEW) MSG_NUM = BULL_READ
- IF (.NOT.OLD_NEXT) THEN
- CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- ELSE
- IF (REMOTE_SET.EQ.3) THEN
- MSG_NUM = BULL_POINT
- ELSE IF (BULL_POINT.GT.0) THEN
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR(BULL_POINT,IER)
- CALL CLOSE_BULLDIR
- ELSE
- MSG_KEY = BULLDIR_HEADER
- MSG_NUM = 0
- END IF
- CALL GET_NEXT_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- END IF
- NEXT = OLD_NEXT
- IF (IER1.EQ.0) THEN
- IER = BULL_READ + 1
- ELSE
- IER = 0
- END IF
- END IF
- END IF
-
- IF (.NOT.SINCE.AND.(.NOT.READ_TAG.OR.(.NOT.NEXT.AND.
- & INCMD(:4).NE.'LAST'.AND.INCMD(:4).NE.'BACK'.AND.
- & INCMD(:4).NE.'FIRS'))) THEN
- IF (BULL_READ.GT.0) THEN ! Valid bulletin number?
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR(BULL_READ,IER) ! Get bulletin directory entry
- IF (IER.NE.BULL_READ+1.AND.REMOTE_SET.EQ.3
- & .AND.INCMD(:4).EQ.'READ') THEN
- IF (NEW) THEN
- NEXT = .TRUE.
- CALL READDIR(BULL_READ,IER)
- END IF
- END IF
- IF (REMOTE_SET.NE.3.AND.
- & READ_COUNT.EQ.-1.AND.IER.NE.BULL_READ+1) THEN
- READ_COUNT = 0
- IF (IER.NE.BULL_READ+1) THEN
- CALL READDIR(0,IER)
- IF (NBULL.GT.0) THEN
- BULL_READ = NBULL
- CALL READDIR(BULL_READ,IER)
- ELSE
- IER = 0
- END IF
- END IF
- ELSE IF (READ_TAG.AND.IER.EQ.BULL_READ+1) THEN
- CALL GET_THIS_TAG(FOLDER_NUMBER,IER1,BULL_READ,DUMMY)
- IF (IER1.NE.0) IER = 0
- END IF
- CALL CLOSE_BULLDIR
- ELSE
- IER = 0
- END IF
- END IF
-
- NEXT = .FALSE.
-
- IF (IER.NE.BULL_READ+1) THEN ! Was bulletin found?
- IF (REMOTE_SET.NE.3) THEN
- WRITE(6,1030) ! If not, then error out
- ELSE
- WRITE(6,1040)
- END IF
- RETURN
- END IF
-
- IF (REMOTE_SET.NE.3) THEN
- DIFF = COMPARE_BTIM(MSG_BTIM,LAST_READ_BTIM(1,FOLDER_NUMBER+1))
- IF (DIFF.GT.0) THEN
- CALL COPY2(LAST_READ_BTIM(1,FOLDER_NUMBER+1),MSG_BTIM)
- END IF
- IF (BULL_TAG.AND.BTEST(BULL_TAG,1)) CALL ADD_TAG(IER,2)
- ELSE
- CALL NEWS_UPDATE_NEWEST_MESSAGE(BULL_READ)
- IF (BULL_NEWS_TAG) CALL ADD_TAG(IER,2)
- END IF
-
- BULL_POINT = BULL_READ ! Update bulletin counter
-
- EDIT = .FALSE.
-
- PAGE_WIDTH = REAL_PAGE_WIDTH
-
- IF (INCMD(:1).NE.' '.AND.READIT.EQ.0) THEN
- IF (CLI$PRESENT('EDIT')) THEN
- OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
- IF (IER.NE.0) THEN
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- RETURN
- END IF
- EDIT = .TRUE.
- PAGE_WIDTH = LINE_LENGTH
- PAGE = .FALSE.
- END IF
- END IF
-
- IF (BULL_POINT.GT.F_NBULL) F_NBULL = BULL_POINT
-
- IF (REMOTE_SET.EQ.3) THEN
- WRITE (HEADLINE,'(1X,I,'' of '',I,''-'',I)')
- & BULL_POINT,F_START,F_NBULL
- DO WHILE (INDEX(HEADLINE,'- ').GT.0)
- I = INDEX(HEADLINE,'- ')
- HEADLINE(I+1:) = HEADLINE(I+2:)
- END DO
- ELSE
- WRITE (HEADLINE,'(1X,I,'' of '',I)') BULL_POINT,F_NBULL
- END IF
- DO WHILE (INDEX(HEADLINE,' ').LT.TRIM(HEADLINE))
- I = INDEX(HEADLINE,' ')
- HEADLINE(I:) = HEADLINE(I+1:)
- END DO
- I = TRIM(HEADLINE)
- HEADLINE = ' #'//HEADLINE(2:TRIM(HEADLINE))
- FLEN = TRIM(FOLDER_NAME)
- HEADLINE(REAL_PAGE_WIDTH-FLEN+1:) = FOLDER_NAME(:FLEN)
- IF (READIT.GT.0) THEN
- WRITE(6,'(A)') '+'//HEADLINE(:TRIM(HEADLINE))
- ELSE IF (EDIT) THEN
- WRITE(3,'(A)') HEADLINE(:TRIM(HEADLINE))
- ELSE
- WRITE(6,'(1X,A)') HEADLINE(:TRIM(HEADLINE))
- END IF
-
- END = 1 ! Outputted 1 line to screen
-
- IF (EXDATE(8:9).EQ.'18'.OR.INDEX(EXDATE,'1900').GT.0) THEN
- IF (REMOTE_SET.NE.3) THEN
- INPUT = 'Date: '//DATE//' '//TIME(:5)//' (DELETED)'
- ELSE
- INPUT = 'Date: '//DATE//' '//TIME(:5)
- END IF
- ELSE IF ((SYSTEM.AND.4).EQ.4) THEN ! Is entry shutdown bulletin?
- INPUT = 'Date: '//DATE//' '//TIME(:5)//' Expires on shutdown'
- ELSE IF ((SYSTEM.AND.2).EQ.2) THEN ! Is entry permanent bulletin?
- INPUT = 'Date: '//DATE//' '//TIME(:5)//' Permanent'
- ELSE
- INPUT = 'Date: '//DATE//' '//TIME(:5)//
- & ' Expires: '//EXDATE//' '//EXTIME(:5)
- END IF
- IF ((SYSTEM.AND.1).EQ.1) THEN ! System bulletin?
- INPUT = INPUT(:TRIM(INPUT))//' / System'
- END IF
- IF (EDIT) THEN
- WRITE (3,'(A)') INPUT(:TRIM(INPUT))
- ELSE
- WRITE (6,'(1X,A)') INPUT(:TRIM(INPUT))
- END IF
-
- END = END + 1
-
- CALL OPEN_BULLFIL_SHARED ! Get bulletin file
- LINE_OFFSET = 0
- CHAR_OFFSET = 0
- ILEN = LINE_LENGTH + 1
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- INPUT = 'From: '//INPUT(7:)
- DO WHILE (TRIM(INPUT).GT.0)
- I = MIN(PAGE_WIDTH,TRIM(INPUT))
- IF (EDIT) THEN
- WRITE(3,'(A)') INPUT(:I)
- ELSE
- WRITE(6,'(1X,A)') INPUT(:I)
- END IF
- INPUT = INPUT(I+1:)
- END = END + 1
- END DO
- LINE_OFFSET = 1
- ELSE
- IF (EDIT) THEN
- WRITE(3,'(''From: '',A)') FROM
- ELSE
- WRITE(6,'('' From: '',A)') FROM
- END IF
- END = END + 1
- END IF
- IF (INPUT(:6).NE.'Subj: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- LEN_TEMP = ILEN
- CALL CONVERT_TABS(INPUT,LEN_TEMP)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- INPUT = 'Subj: '//INPUT(7:)
- DO WHILE (TRIM(INPUT).GT.0)
- I = MIN(PAGE_WIDTH,TRIM(INPUT))
- IF (EDIT) THEN
- WRITE(3,'(A)') INPUT(:I)
- ELSE
- WRITE(6,'(1X,A)') INPUT(:I)
- END IF
- INPUT = INPUT(I+1:)
- END = END + 1
- END DO
- LINE_OFFSET = LINE_OFFSET + 1
- IF (EDIT) WRITE(3,'(1X)')
- ELSE
- END = END + 1
- IF (EDIT) THEN
- WRITE(3,'(''Subj: '',A)') DESCRIP
- WRITE(3,'(1X,/,A)') INPUT(:LEN_TEMP)
- ELSE
- WRITE(6,'('' Subj: '',A)') DESCRIP
- IF (LINE_OFFSET.EQ.1) THEN
- CHAR_OFFSET = 1 - PAGE_WIDTH
- LINE_OFFSET = 2
- END IF
- END IF
- END IF
- IF (LINE_OFFSET.EQ.0) ILEN = LINE_LENGTH + 1
- CALL CLOSE_BULLFIL ! End of bulletin file read
-
- IF (EDIT) GO TO 200
-
- WRITE(6,'(1X)')
-
- IF (READIT.GT.0) WRITE(6,'(1X)')
- END = END + 1
-C
-C Each page of the bulletin is buffered into temporary memory storage before
-C being outputted to the terminal. This is to be able to quickly close the
-C bulletin file, and to avoid the possibility of the user holding the screen,
-C and thus causing the bulletin file to stay open. The temporary memory
-C is structured as a linked-list queue, where SCRATCH_B1 points to the header
-C of the queue. See BULLSUBS.FOR for more description of the queue.
-C
-
- IF (SCRATCH_B1.NE.0) THEN ! Is queue empty?
- SCRATCH_B = SCRATCH_B1 ! No, set queue pointer to head
- ELSE ! Else if queue is empty
- CALL INIT_QUEUE(SCRATCH_B,INPUT)
- SCRATCH_B1 = SCRATCH_B ! Init header pointer
- END IF
-
- READ_ALREADY = 0 ! Number of lines already read
- ! from record.
- IF (READ_COUNT.EQ.-2) THEN ! Just output header first read
- READ_COUNT = BLOCK
- RETURN
- ELSE
- READ_COUNT = BLOCK ! Init bulletin record counter
- END IF
-
- GO TO 200
-
-100 IF (READIT.EQ.0) THEN ! If not 1st page of READ
- WRITE(6,'(1X,A,/)') HEADLINE(:TRIM(HEADLINE)) ! Output header info
- END = END + 2 ! Increase display counter
- END IF
-
- SCRATCH_B = SCRATCH_B1 ! Init queue pointer to header
-
-200 DISPLAY = 0
- IF (READIT.GT.0) END = END - 2 ! /READ can output 2 more lines
-
- CALL OPEN_BULLFIL_SHARED ! Get bulletin file
- MORE_LINES = .TRUE.
- DO WHILE (ILEN.GT.0.AND.MORE_LINES)
- IF (CHAR_OFFSET.EQ.0) THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- LINE_OFFSET = LINE_OFFSET + 1
- END IF
- IF (ILEN.LT.0) THEN ! Error, couldn't read record
- ILEN = 0 ! Fake end of reading file
- MORE_LINES = .FALSE.
- ELSE IF (ILEN.GT.0) THEN
- IF (EDIT) THEN
- WRITE(3,'(A)') INPUT(:ILEN)
- ELSE IF (CHAR_OFFSET.EQ.0) THEN
- LEN_TEMP = ILEN
- CALL CONVERT_TABS(INPUT,LEN_TEMP)
- IF (LEN_TEMP.GT.PAGE_WIDTH) THEN
- CHAR_OFFSET = 1
- BUFFER = INPUT(:PAGE_WIDTH)
- CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)
- ELSE
- CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,INPUT)
- END IF
- ELSE
- CHAR_OFFSET = CHAR_OFFSET + PAGE_WIDTH
- IF (LEN_TEMP.LE.CHAR_OFFSET+PAGE_WIDTH-1) THEN
- BUFFER = INPUT(CHAR_OFFSET:LEN_TEMP)
- CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)
- CHAR_OFFSET = 0
- ELSE
- BUFFER = INPUT(CHAR_OFFSET:CHAR_OFFSET+PAGE_WIDTH-1)
- CALL WRITE_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER)
- END IF
- END IF
- DISPLAY = DISPLAY + 1
- IF ((DISPLAY.EQ.PAGE_LENGTH-END-4).AND.PAGE) THEN
- MORE_LINES = .FALSE.
- END IF
- END IF
- END DO
-
- CALL CLOSE_BULLFIL ! End of bulletin file read
-
- IF (EDIT) THEN
- CLOSE (UNIT=3)
- CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- READ_COUNT = 0 ! init bulletin record counter
- RETURN
- END IF
-
-C
-C Bulletin page is now in temporary memory, so output to terminal.
-C Note that if this is a /READ, the first line will have problems with
-C the usual FORMAT statement. It will cause a blank line to be outputted
-C at the top of the screen. This is because of the input QIO at the
-C end of the previous page. The output gets confused and thinks it must
-C end the previous line. To prevent that, the first line of a new page
-C in a /READ must use a different FORMAT statement to surpress the CR/LF.
-C
-
- SCRATCH_B = SCRATCH_B1 ! Reinit queue pointer to head
- DO I=1,DISPLAY ! Output page to terminal
- CALL READ_QUEUE(%VAL(SCRATCH_B),SCRATCH_B,BUFFER) ! Get queue record
- IF (I.EQ.1.AND.READIT.GT.0) THEN
- WRITE(6,'(A)') '+'//BUFFER(:TRIM(BUFFER)) ! (See above comments)
- ELSE
- WRITE(6,'(1X,A)') BUFFER(:TRIM(BUFFER))
- END IF
- END DO
-
- IF (ILEN.EQ.0) THEN ! End of message?
- READ_COUNT = 0 ! init bulletin record counter
- ELSE ! Possibly end of message since end of page could be last line
- CALL TEST_MORE_RECORDS(BLOCK,LENGTH,IREC)
- IF (IREC.EQ.0) THEN ! Last record?
- CALL TEST_MORE_LINES(ILEN) ! More lines to read?
- IF (ILEN.GT.0) THEN ! Yes, there are still more
- IF (READIT.EQ.0) WRITE(6,1070) ! say there is more of bulletin
- ELSE ! Yes, last line anyway
- READ_COUNT = 0 ! init bulletin record counter
- END IF
- ELSE IF (READIT.EQ.0) THEN ! Not last record so
- WRITE(6,1070) ! say there is more of bulletin
- END IF
- END IF
-
- RETURN
-
-1030 FORMAT(' No more messages.')
-1040 FORMAT(' Message not found.')
-1070 FORMAT(1X,/,' Press RETURN for more...',/)
-
-2000 FORMAT(A)
-
- END
-
-
-
-
-
-
- SUBROUTINE READNEW(REDO)
-C
-C SUBROUTINE READNEW
-C
-C FUNCTION: Displays new non-system bulletins with prompts between bulletins.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /READ_DISPLAY/ LINE_OFFSET
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
- LOGICAL PAGING
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- EXTERNAL BULLETIN_SUBCOMMANDS
-
- CHARACTER INREAD*1,FILE_DEF*80,NUMREAD*6
-
- DATA LEN_FILE_DEF /0/, INREAD/0/
-
- LOGICAL SLOW,SLOW_TERMINAL
-
- FIRST_MESSAGE = BULL_POINT
-
- IF (ICHAR(INREAD).EQ.0) THEN ! If calling READNEW for first time
- SLOW = SLOW_TERMINAL() ! Check baud rate of terminal
- END IF ! to avoid gobs of output
-
- LEN_P = 0 ! Tells read subroutine there is
- ! no bulletin parameter
-
-1 WRITE(6,1000) ! Ask if want to read new bulletins
-
- CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input
- CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case
- READ (NUMREAD,'(I<NLEN>)',IOSTAT=IER) TEMP_READ
- IF (IER.NE.0) THEN
- INREAD = NUMREAD(:1)
- IF (INREAD.EQ.'N'.OR.INREAD.EQ.'Q'.OR.INREAD.EQ.'E') THEN
- IF (INREAD.EQ.'Q') THEN
- WRITE (6,'(''+uit'',$)')
- ELSE IF (INREAD.EQ.'E') THEN
- WRITE (6,'(''+xit'',$)')
- DO I=1,FLONG ! Just show SYSTEM folders
- NEW_MSG(I) = NEW_MSG(I).AND.SYSTEM_FLAG(I)
- END DO
- DO I=1,FLONG ! Test for new messages in SYSTEM folders
- IF (NEW_MSG(I).NE.0) RETURN
- END DO
- CALL EXIT
- ELSE
- WRITE (6,'(''+o'',$)')
- END IF
- RETURN ! If NO, exit
- ! Include QUIT to be consistent with next question
- ELSE
- CALL LIB$ERASE_PAGE(1,1)
- END IF
- END IF
-
-3 IF (TEMP_READ.GT.0) THEN
- IF (TEMP_READ.LT.FIRST_MESSAGE+1.OR.TEMP_READ.GT.NBULL) THEN
- WRITE (6,'('' ERROR: Specified new message not found.'')')
- GO TO 1
- ELSE
- BULL_POINT = TEMP_READ - 1
- END IF
- END IF
-
- READ_COUNT = 0 ! Initialize display pointer
-
-5 CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin
- BULL_POINT_READ = BULL_POINT
- IF (READ_COUNT.EQ.0) THEN ! Is full bulletin displayed?
- CALL OPEN_BULLDIR_SHARED ! If so, see if more new bulls
-10 CALL READDIR(BULL_POINT+1,IER_POINT)
- IF ((IER_POINT.EQ.BULL_POINT+2).AND. ! If system bulletin (and system
- & (SYSTEM.AND.BTEST(FOLDER_FLAG,2))) THEN ! folder) then skip it.
- BULL_POINT = BULL_POINT + 1
- GO TO 10
- END IF
- CALL CLOSE_BULLDIR
- END IF
-
- GO TO 12
-
-11 IF (READ_COUNT.GT.0) THEN
- CALL OPEN_BULLDIR_SHARED
- CALL OPEN_BULLFIL_SHARED
- CALL READDIR(BULL_POINT,IER)
- ILEN = LINE_LENGTH+1
- DO I=1,LINE_OFFSET
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END DO
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- END IF
-
- BULL_POINT = BULL_POINT_SAVE
- LENGTH = LENGTH_SAVE
- BLOCK = BLOCK_SAVE
-
-12 IF (READ_COUNT.EQ.0) THEN ! Prompt user in between
- WRITE(6,1020) ! full screens or end of bull.
- ELSE
- WRITE(6,1030)
- END IF
-
- CALL GET_INPUT_NOECHO(INREAD)
- CALL STR$UPCASE(INREAD,INREAD) ! Convert input to upper case
-
- BLOCK_SAVE = BLOCK
- LENGTH_SAVE = LENGTH
- BULL_POINT_SAVE = BULL_POINT
-
- IF (INREAD.EQ.'Q') THEN ! If Q , then QUIT
- WRITE (6,'(''+Quit'',$)')
- RETURN
- ELSE IF (INREAD.EQ.'D') THEN ! If D , then redisplay directory
- WRITE (6,'(''+Dir'',$)')
- REDO = .TRUE.
- RETURN
- ELSE IF (INREAD.EQ.'F'.AND..NOT.CAPTIVE()) THEN
- ! If F then copy bulletin to file
- WRITE (6,'(''+ '')') ! Move cursor from end of prompt line
- ! to beginning of next line.
- IF (LEN_FILE_DEF.EQ.0) THEN
- CALL LIB$SYS_TRNLOG('SYS$LOGIN',ILEN,FILE_DEF)
- IER = LIB$FIND_FILE(FILE_DEF//'BULL.DIR',
- & BULL_PARAMETER,CONTEXT)
- IF (IER) THEN
- FILE_DEF = BULL_PARAMETER(:ILEN-1)//'.BULL]'
- LEN_FILE_DEF = ILEN + 5
- ELSE
- FILE_DEF = 'SYS$LOGIN:'
- LEN_FILE_DEF = 10
- END IF
- END IF
-
- LEN_FOLDER = TRIM(FOLDER)
- CALL GET_INPUT_PROMPT(BULL_PARAMETER,LEN_P,
- & 'Name of file? (Default='//FILE_DEF(:LEN_FILE_DEF)//
- & FOLDER(:LEN_FOLDER)//'.LIS) ')
-
- IF (LEN_P.EQ.0) THEN
- BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//FOLDER(:LEN_FOLDER)
- & //'.LIS'
- LEN_P = LEN_FILE_DEF + LEN_FOLDER + 4
- ELSE
- IER = LIB$SYS_TRNLOG(BULL_PARAMETER(:LEN_P),ILEN,INPUT)
- IF (IER.NE.1.AND.INDEX(BULL_PARAMETER(:LEN_P),':').EQ.0
- & .AND.INDEX(BULL_PARAMETER(:LEN_P),'[').EQ.0) THEN
- BULL_PARAMETER = FILE_DEF(:LEN_FILE_DEF)//
- & BULL_PARAMETER(:LEN_P)
- LEN_P = LEN_P + LEN_FILE_DEF
- END IF
- END IF
-
- BULL_POINT = BULL_POINT_READ
- INCMD = 'FILE '//BULL_PARAMETER(:LEN_P)
- IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
- CALL FILE(READ_COUNT)
- GO TO 11
- ELSE IF (INREAD.EQ.'P') THEN
- WRITE (6,'(''+P'',$)')
- BULL_POINT = BULL_POINT_READ
- IF (REMOTE_SET.GE.3.OR.
- & INDEX(FOLDER_DESCRIP,'<').GT.0) THEN
- WRITE(6,1040)
- CALL GET_INPUT_NOECHO(INREAD)
- CALL STR$UPCASE(INREAD,INREAD)
- IF (INREAD.EQ.'P') THEN
- WRITE (6,'(''+P'',$)')
- INCMD = 'REPLY'
- ELSE IF (INREAD.EQ.'U') THEN
- WRITE (6,'(''+U'',$)')
- INCMD = 'RESPOND'
- ELSE IF (INREAD.EQ.'B') THEN
- WRITE (6,'(''+B'',$)')
- INCMD = 'RESPOND/LIST'
- ELSE
- GO TO 11
- END IF
- IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
- CALL RESPOND
- ELSE
- INCMD = 'REPLY'
- IER = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
- CALL REPLY
- END IF
- GO TO 11
- ELSE IF (INREAD.EQ.'N'.AND.READ_COUNT.GT.0) THEN
- ! If NEXT and last bulletins not finished
- READ_COUNT = 0 ! Reset read bulletin counter
- CALL OPEN_BULLDIR_SHARED ! Look for NEXT bulletin
-20 CALL READDIR(BULL_POINT+1,IER)
- IF (IER.NE.BULL_POINT+2) THEN ! If no NEXT bulletin
- CALL CLOSE_BULLDIR ! Exit
- WRITE(6,1010)
- RETURN
- ELSE IF (SYSTEM.AND.BTEST(FOLDER_FLAG,2)) THEN
- BULL_POINT = BULL_POINT + 1 ! If SYSTEM bulletin, skip it
- GO TO 20 ! Look for more bulletins
- END IF
- CALL CLOSE_BULLDIR
- ELSE IF (INREAD.EQ.'R') THEN
- WRITE (6,'(''+Read'')')
- WRITE (6,'('' Enter message number: '',$)')
- CALL GET_INPUT_NUM(NUMREAD,NLEN) ! Get input
- CALL STR$UPCASE(NUMREAD,NUMREAD) ! Make input upper case
- READ (NUMREAD,'(I<NLEN>)',IOSTAT=IER) TEMP_READ
- IF (IER.NE.0.OR.TEMP_READ.LE.0) THEN
- WRITE (6,'('' ERROR: Invalid message number specified.'')')
- GO TO 12
- ELSE
- GO TO 3
- END IF
- ELSE IF (IER_POINT.NE.BULL_POINT+2.AND.READ_COUNT.EQ.0) THEN
- WRITE(6,1010)
- RETURN
- END IF
- IF (READ_COUNT.EQ.0.AND.SLOW) READ_COUNT = -2
- GO TO 5
-
-1000 FORMAT(' Read messages? Type N(No),E(Exit),message
- & number, or any other key for yes: ',$)
-1010 FORMAT(' No more messages.')
-1020 FORMAT(1X,<PAGE_WIDTH>('-'),/,' Type Q(Quit),F(File),D(Dir),
- &R(Read msg #),P(Reply) or other for next message: ',$)
-1030 FORMAT(1X,<PAGE_WIDTH>('-'),/,' Type Q(Quit),F(File),N(Next),
- &D(Dir),R(Read msg #),P(Reply) or other for MORE: ',$)
-1040 FORMAT(' Type P to post reply, U to reply to user,
- & B to do both, or other to quit: ',$)
-
- END
-
-
-
-
- SUBROUTINE SET_DEFAULT_EXPIRE
-C
-C SUBROUTINE SET_DEFAULT_EXPIRE
-C
-C FUNCTION: Sets default expiration date.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- CHARACTER EXPIRE*3
-
- IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- IER = CLI$GET_VALUE('DEFAULT_EXPIRE',EXPIRE,EX_LEN)
- IF (EX_LEN.GT.3) EX_LEN = 3
- READ (EXPIRE,'(I<EX_LEN>)') TEMP
-
- CALL OPEN_BULLFOLDER ! Open folder file
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
- IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN
- WRITE (6,'('' ERROR: Expiration cannot be > '',
- & I3,'' days.'')') BBEXPIRE_LIMIT
- ELSE IF (TEMP.LT.-1) THEN
- WRITE (6,'('' ERROR: Expiration must be > -1.'')')
- ELSE
- FOLDER_BBEXPIRE = TEMP
- WRITE (6,'('' Default expiration modified.'')')
- END IF
- CALL REWRITE_FOLDER_FILE
- CALL CLOSE_BULLFOLDER
- ELSE
- WRITE (6,'('' You are not authorized to set expiration.'')')
- END IF
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin10.for b/decus/vax91b/bulletin-net91b/bulletin10.for
deleted file mode 100644
index c93bc8136b85c6aebed38d0457f6674e73456792..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin10.for
+++ /dev/null
@@ -1,2186 +0,0 @@
-C
-C BULLETIN10.FOR, Version 6/15/91
-C Purpose: Bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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
- INTEGER FUNCTION NEWS_READ()
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- PARAMETER CR = CHAR(13), LF = CHAR(10)
-
- COMMON /NEWS_INIT/ END_READ
-
- NEWS_READ = 1
-
- IF (END_READ.EQ.0) THEN
- IER = NEWS_READ_PACKET(BUFFER(:1024))
- IF (IER.LE.0) THEN
- CALL NEWS_LOGOUT
- NEWS_READ = 0
- RETURN
- END IF
- START_READ = 1
- END_READ = IER
- END IF
-
- IF (END_READ.EQ.0) THEN
- NEWS_READ = 0
- RETURN
- END IF
-
- DO WHILE (1)
- END_LINE = INDEX(BUFFER(START_READ:END_READ),LF)
- IF (END_LINE.GT.0) THEN
- SB = START_READ
- IF (END_LINE-2.LE.255) THEN
- END_LINE = END_LINE + SB - 1
- EB = END_LINE - 2
- ELSE
- EB = SB + 254
- IF (INDEX(BUFFER(SB:EB),' ').GT.0) THEN
- DO WHILE (BUFFER(EB:EB).NE.' ')
- EB = EB - 1
- END DO
- END IF
- END_LINE = EB
- END IF
- IF (END_LINE.LT.END_READ) THEN
- START_READ = END_LINE + 1
- ELSE
- END_READ = 0
- END IF
- RETURN
- ELSE IF (END_READ-START_READ.EQ.1023) THEN
- NEWS_READ = 0
- RETURN
- ELSE
- BUFFER = BUFFER(START_READ:END_READ)
- END_READ = END_READ - START_READ + 1
- IER = NEWS_READ_PACKET(BUFFER(END_READ+1:END_READ+1024))
- IF (IER.LE.0) THEN
- NEWS_READ = 0
- RETURN
- ELSE
- START_READ = 1
- END_READ = END_READ + IER
- END IF
- END IF
- END DO
-
- RETURN
- END
-
-
-
-
- INTEGER FUNCTION NEWS_WRITE(WRITE)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER CR = CHAR(13), LF = CHAR(10)
-
- COMMON /NEWS_INIT/ END_READ
-
- CHARACTER*(*) WRITE
-
- LOGICAL TRY_RECONNECT/.FALSE./
-
- END_READ = 0
-
- IF (WRITE.EQ.' ') THEN
- NEWS_WRITE = NEWS_WRITE_PACKET(CR//LF)
- ELSE
- NEWS_WRITE = NEWS_WRITE_PACKET(WRITE//CR//LF)
- END IF
-
- IF (.NOT.NEWS_WRITE.AND..NOT.TRY_RECONNECT) THEN
- TRY_RECONNECT = .TRUE.
- CALL NEWS_RECONNECT(WRITE)
- TRY_RECONNECT = .FALSE.
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE NEWS_RECONNECT(WRITE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /POINT/ BULL_POINT
-
- CHARACTER*(*) WRITE
-
- CHARACTER*6 NUMBER
-
- CHARACTER*(FOLDER_RECORD) FOLDER2_COM
-
- CALL NEWS_LOGOUT
-
- IF (.NOT.NEWS_LOGIN()) RETURN
-
- IF (FOLDER(:1).GE.'a'.AND.FOLDER(:1).LE.'z') THEN
- FOLDER2_COM = FOLDER1_COM
- FOLDER1 = FOLDER
- FOLDER1_DESCRIP = FOLDER_DESCRIP
- CALL NEWS_GROUP(IER)
- IF (IER.NE.0) RETURN
- FOLDER1_COM = FOLDER2_COM
-
- IF (.NOT.OTS$CVT_L_TI(BULL_POINT+1,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- END IF
-
- IF (.NOT.NEWS_WRITE(WRITE)) RETURN
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_LOGOUT
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /NEWS_CONNECTED/ NEWS_CONNECTED
-
- CALL NEWS_DISCONNECT
- NEWS_CONNECTED = .FALSE.
-
- RETURN
- END
-
-
-
- SUBROUTINE REMOTE_DELETE(SBULL,IMMEDIATE,SUBJ,I,FOLDER1_COM,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /PATH/ PATHNAME,LPATH
- CHARACTER*132 PATHNAME
-
- COMMON /MSGID/ MESSAGE_ID
- CHARACTER*255 MESSAGE_ID
-
- CHARACTER*12 HIGHFROM
-
- CHARACTER*(*) SUBJ,FOLDER1_COM
-
- IF (REMOTE_SET.EQ.1) THEN
- WRITE(REMOTE_UNIT,'(4A)',IOSTAT=IER)
- & 4,SBULL,IMMEDIATE,SUBJ
- IF (IER.EQ.0) THEN
- READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM
- END IF
- ELSE IF (REMOTE_SET.EQ.3) THEN
- CALL STR$UPCASE(HIGHFROM,FROM)
- IF (LPATH.EQ.0) CALL GET_PATHNAME
- IF (HIGHFROM.EQ.USERNAME.AND.
- & MESSAGE_ID(FIRST_INDEX(MESSAGE_ID,'@%'):
- & TRIM(MESSAGE_ID)-1).EQ.
- & PATHNAME(FIRST_INDEX(PATHNAME,'@%'):LPATH)) THEN
- CALL NEWS_POST('cancel',0,IER,'Delete news item.')
- ELSE
- WRITE (6,'('' ERROR: Not owner of message.'')')
- END IF
- IER = 0
- END IF
-
- RETURN
- END
-
-
-
-
- INTEGER FUNCTION FIRST_INDEX(INPUT,FIND)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INPUT,FIND
-
- FIRST_INDEX = 0
-
- DO I=1,LEN(FIND)
- J = INDEX(INPUT,FIND(I:I))
- IF (J.GT.0.AND.(FIRST_INDEX.EQ.0.OR.J.LT.FIRST_INDEX))
- & FIRST_INDEX = J
- END DO
-
- RETURN
- END
-
-
-
- SUBROUTINE REMOTE_DIRECTORY_COMMAND(START,END,REVERSE,ALL_DIR,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /XHDR/ XHDR
- LOGICAL XHDR /.FALSE./
-
- COMMON /POINT/ BULL_POINT
-
- CHARACTER*6 NUMBER,NUMBER1
-
- CHARACTER*1024 TEMP
-
- DATA QXHDR1 /0/
-
- IF (XHDR) THEN
- IF (QXHDR1.NE.0) THEN ! Is queue empty?
- QXHDR = QXHDR1 ! No, set queue pointer to head
- ELSE ! Else if queue is empty
- CALL INIT_QUEUE(QXHDR,TEMP)
- QXHDR1 = QXHDR ! Init header pointer
- END IF
- END IF
-
- SYSTEM = 0
-
- IF (REMOTE_SET.EQ.1) THEN
- IF (REVERSE) THEN
- WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,END,START
- ELSE
- WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER) 13,START,END
- END IF
- ELSE
- IER = 2
- NUMDIR = END - START + 1
- IF (START.LT.F_START) THEN
- START = F_START
- END = START + NUMDIR - 1
- END IF
- END IF
-
- IF (REMOTE_SET.EQ.3.AND.XHDR) THEN
- IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
- IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN
- DO WHILE (NUMBER1(1:1).EQ.' ')
- NUMBER1 = NUMBER1(2:)
- END DO
- NUMDIR1 = 0
- DO WHILE (NUMDIR1.LT.NUMDIR)
- IF (.NOT.NEWS_WRITE('XHDR DATE '//NUMBER//'-'//NUMBER1))
- & RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:2).NE.'22') THEN
- IF (NUMDIR1.EQ.0) THEN
- IER = 0
- END = START - 1
- RETURN
- ELSE
- NUMDIR = NUMDIR1
- END IF
- ELSE
- IF (.NOT.NEWS_READ()) RETURN
- IF (NUMDIR1.EQ.0.AND.BUFFER(SB:EB).NE.'.'.AND..NOT.
- & OTS$CVT_TI_L(BUFFER(SB:INDEX(BUFFER(SB:EB),' ')+SB-2)
- & ,START,,%VAL(1))) RETURN
- DO WHILE (BUFFER(SB:EB).NE.'.')
- IF (NUMDIR1.LT.NUMDIR) THEN
- NUMDIR1 = NUMDIR1 + 1
- TEMP = BUFFER(SB:EB)
- CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
- END IF
- IF (.NOT.NEWS_READ()) RETURN
- END DO
- IF (NUMDIR1.EQ.0) THEN
- IF (START.LE.F_START) RETURN
- START = MAX(F_START,START-NUMDIR)
- END = START + NUMDIR - 1
- IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
- IF (.NOT.OTS$CVT_L_TI(END,NUMBER1,,,)) RETURN
- DO WHILE (NUMBER1(1:1).EQ.' ')
- NUMBER1 = NUMBER1(2:)
- END DO
- ELSE IF (NUMDIR1.LT.NUMDIR) THEN
- IF (.NOT.NEWS_WRITE('STAT '//TEMP(:INDEX(TEMP,' ')-1)))
- & RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (.NOT.NEWS_WRITE('NEXT')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:2).NE.'22') THEN
- NUMDIR = NUMDIR1
- ELSE
- NUMBER = BUFFER(SB+4:INDEX(BUFFER(SB+4:),' ')+SB+2)
- IF (.NOT.OTS$CVT_TI_L(NUMBER,
- & MSG_NUM,,%VAL(1))) RETURN
- DO WHILE (NUMBER(LEN(NUMBER):).EQ.' ')
- NUMBER = ' '//NUMBER(1:)
- END DO
- MSG_NUM = MSG_NUM + (NUMDIR - NUMDIR1) - 1
- IF (.NOT.OTS$CVT_L_TI(MSG_NUM,NUMBER1,,,)) RETURN
- DO WHILE (NUMBER1(1:1).EQ.' ')
- NUMBER1 = NUMBER1(2:)
- END DO
- END IF
- END IF
- END IF
- END DO
- CALL OTS$CVT_L_TI(START,NUMBER,,,)
- NUMBER1 = TEMP(:INDEX(TEMP,' ')-1)
- END = START + NUMDIR - 1
- DO I=1,2
- IF (I.EQ.1.AND..NOT.NEWS_WRITE
- & ('XHDR SUBJECT '//NUMBER//'-'//NUMBER1)) RETURN
- IF (I.EQ.2.AND..NOT.NEWS_WRITE
- & ('XHDR FROM '//NUMBER//'-'//NUMBER1)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:2).EQ.'22') THEN
- QXHDR = QXHDR1
- IF (.NOT.NEWS_READ()) RETURN
- NUMDIR1 = 0
- DO WHILE (BUFFER(SB:EB).NE.'.'.AND.NUMDIR1.LT.NUMDIR)
- NUMDIR1 = NUMDIR1 + 1
- CALL READ_QUEUE(%VAL(QXHDR),DUMMY,TEMP)
- SB1 = INDEX(BUFFER(SB:EB),' ')+SB-1
- SB1 = FIRST_ALPHA(BUFFER(SB1:EB))+SB1-1
- TEMP(I*256+1:) = BUFFER(SB1:EB)
- CALL WRITE_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
- IF (.NOT.NEWS_READ()) RETURN
- END DO
- END IF
- END DO
- QXHDR = QXHDR1
- IER = 0
- ELSE IF (REMOTE_SET.EQ.3.AND..NOT.XHDR) THEN
- IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:2).NE.'22') THEN
- IF (.NOT.NEWS_WRITE('NEXT')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (.NOT.OTS$CVT_TI_L(BUFFER(SB+4:
- & INDEX(BUFFER(SB+4:),' ')+SB+2),I,,%VAL(1))) RETURN
- IF (BUFFER(:2).NE.'22'.OR.I.LT.START) THEN
- BUFFER(:3) = '500'
- DO WHILE (START.LE.F_NBULL.AND.BUFFER(:2).NE.'22')
- START = START + 1
- IF (.NOT.OTS$CVT_L_TI(START,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- END DO
- IF (BUFFER(:2).NE.'22') THEN
- IER = 0
- END = START - 1
- RETURN
- END IF
- END IF
- IF (.NOT.NEWS_WRITE('HEAD')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IER = OTS$CVT_TI_L(BUFFER(SB+4:
- & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
- END = START + NUMDIR - 1
- END IF
- IER = 0
- END IF
-
- IF (IER.EQ.0) THEN
- I = START
- DO WHILE (IER.EQ.0.AND.I.LE.END)
- IF (REMOTE_SET.EQ.1) THEN
- READ(REMOTE_UNIT,'(A)',IOSTAT=IER) BULLDIR_ENTRY
- ELSE IF (XHDR) THEN
- CALL READ_QUEUE(%VAL(QXHDR),QXHDR,TEMP)
- LTEMP = INDEX(TEMP,' ')
- CALL OTS$CVT_TI_L(TEMP(:LTEMP-1),MSG_NUM,,%VAL(1))
- CALL NEWS_TIME(TEMP(LTEMP+1:TRIM(TEMP(:256))),MSG_BTIM)
- DESCRIP = TEMP(257:512)
- CALL GET_FROM(TEMP(512:768),TRIM(TEMP(512:768)))
- ELSE
- IER = OTS$CVT_TI_L(BUFFER(SB+4:
- & INDEX(BUFFER(SB+4:),' ')+SB+2),MSG_NUM,,%VAL(1))
- CALL NEWS_HEADER(IER)
- IF (IER.NE.0) RETURN
- END IF
- CALL WRITE_QUEUE(%VAL(ALL_DIR),ALL_DIR,BULLDIR_ENTRY)
- I = I + 1
- IF (REMOTE_SET.EQ.3.AND..NOT.XHDR.AND.I.LE.END) THEN
- IER = 2
- IF (.NOT.NEWS_WRITE('NEXT')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:3).NE.'223') THEN
- END = I - 1
- IER = 0
- RETURN
- END IF
- IF (.NOT.NEWS_WRITE('HEAD')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IER = 0
- END IF
- END DO
- END IF
-
- IF (REMOTE_SET.EQ.3) THEN
- IER = 1
- IF (.NOT.OTS$CVT_L_TI(BULL_POINT,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IER = 0
- END IF
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION NEWS_LOGIN
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /NEWS_CONNECTED/ NEWS_CONNECTED
- LOGICAL NEWS_CONNECTED /.FALSE./
-
- COMMON /XHDR/ XHDR
- LOGICAL XHDR /.FALSE./
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- IF (.NOT.NEWS_CONNECTED) THEN
- NEWS_LOGIN = .FALSE.
- NEWS_CONNECTED = NEWS_CONNECT()
- IF (.NOT.NEWS_CONNECTED) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (.NOT.NEWS_WRITE('XHDR')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- XHDR = BUFFER(:3).NE.'500'
- END IF
-
- NEWS_LOGIN = .TRUE.
-
- RETURN
- END
-
-
-
-
- SUBROUTINE NEWS_HEADER(IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- EX_BTIM(1) = 0
- EX_BTIM(2) = 0
-
- DESCRIP = ' '
- FROM = ' '
-
- DO WHILE (BUFFER(SB:EB).NE.'.')
- IER = NEWS_READ()
- IF (.NOT.IER) RETURN
- IF (BUFFER(SB:EB).NE.'.') THEN
- IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.EB.GE.SB+9) THEN
- SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8
- DESCRIP = BUFFER(SB1:EB)
- ELSE IF (BUFFER(SB:SB+4).EQ.'Date:'.AND.EB.GE.SB+6) THEN
- CALL NEWS_TIME(BUFFER(SB+6:EB),MSG_BTIM)
- ELSE IF (BUFFER(SB:SB+7).EQ.'Expires:'.AND.EB.GE.SB+9) THEN
- CALL NEWS_TIME(BUFFER(SB+9:EB),EX_BTIM)
- ELSE IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GE.SB+6) THEN
- SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5
- CALL GET_FROM(BUFFER(SB1:EB),EB-SB1+1)
- END IF
- END IF
- END DO
-
- IER = 0
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION FIRST_ALPHA(INPUT)
-
- CHARACTER*(*) INPUT
-
- DO I=1,LEN(INPUT)
- IF (ICHAR(INPUT(I:I)).LT.32) INPUT(I:I) = ' '
- END DO
-
- DO FIRST_ALPHA=1,LEN(INPUT)
- IF (ICHAR(INPUT(FIRST_ALPHA:FIRST_ALPHA)).GT.32) RETURN
- END DO
-
- RETURN
- END
-
-
-
-
- SUBROUTINE REMOTE_READ_MESSAGE(BULL_SEARCH,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- CHARACTER*6 NUMBER
-
- IF (REMOTE_SET.EQ.1) THEN
- WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 5,BULL_SEARCH
- ELSE
- IER = 2
- IF (BULL_SEARCH.LT.F_START) BULL_SEARCH = F_START
- IF (.NOT.OTS$CVT_L_TI(BULL_SEARCH,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('HEAD '//NUMBER)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:2).NE.'22') RETURN
- IER = 0
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE REMOTE_GET_NEWEST_MSG(IN_BTIM,START)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /READIT/ READIT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- DIMENSION IN_BTIM(2)
-
- CHARACTER TIME*20,FIRST*80
-
- CHARACTER*6 NUMBER
-
- IF (REMOTE_SET.EQ.1) THEN
- WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 12,IN_BTIM(1),IN_BTIM(2)
- IF (IER.EQ.0) THEN
- READ (REMOTE_UNIT,'(A)',IOSTAT=IER) START
- END IF
- ELSE IF (READIT.EQ.1) THEN
- I = NEWS_FIND_SUBSCRIBE()
- START = (LAST_NEWS_READ2(2,I).AND.'3FFF'X) +
- & LAST_NEWS_READ(2,I) + 1
- IF (START.GT.F_NBULL) THEN
- START = -1
- ELSE
- LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-LAST_NEWS_READ(2,I))
- & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)
- END IF
- ELSE
- START = -1
- IER = SYS$ASCTIM(,TIME,IN_BTIM,)
- CALL DATE_TIME(TIME)
- SKIP = 0
- DO WHILE (1)
- IF (.NOT.NEWS_WRITE('NEWNEWS '//FOLDER_NAME(:TRIM(
- & FOLDER_NAME))//' '//TIME)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:2).EQ.'23') THEN
- IF (.NOT.NEWS_READ()) CALL EXIT
- DO I=1,SKIP
- IF (.NOT.NEWS_READ()) CALL EXIT
- END DO
- FIRST = BUFFER(SB:EB)
- IF (FIRST.EQ.'.') RETURN
- DO WHILE (BUFFER(SB:EB).NE.'.')
- IF (.NOT.NEWS_READ()) CALL EXIT
- END DO
- IF (.NOT.NEWS_WRITE('STAT '//FIRST(:TRIM(FIRST))))
- & CALL EXIT
- IF (.NOT.NEWS_READ()) CALL EXIT
- IF (BUFFER(:2).EQ.'22') THEN
- IF (BUFFER(5:INDEX(BUFFER(5:),' ')+3).EQ.'0') THEN
- I = F_NBULL + 1
- DO WHILE (I.GE.F_START.AND.(FIRST(:TRIM(FIRST)).NE.
- & BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))
- & .OR.I.GT.F_NBULL))
- I = I - 1
- IF (.NOT.OTS$CVT_L_TI(I,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('STAT '//NUMBER)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- END DO
- IF (I.GE.F_START) START = I
- ELSE
- IER = OTS$CVT_TI_L(BUFFER(SB+4:
- & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
- END IF
- RETURN
- END IF
- END IF
- SKIP = SKIP + 1
- END DO
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE REMOTE_COPY_BULL(IER)
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- IF (REMOTE_SET.EQ.1) THEN
- WRITE (REMOTE_UNIT,'(A)',IOSTAT=IER) 2
- ELSE
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE REMOTE_WRITE_BULL_FILE(OUTPUT)
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*(*) OUTPUT
-
- IF (REMOTE_SET.EQ.1) THEN
- WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 6,OUTPUT
- ELSE
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_REMOTE_MESSAGE(IER)
-C
-C SUBROUTINE GET_REMOTE_MESSAGE
-C
-C FUNCTION:
-C Gets remote message.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE '($RMSDEF)'
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1
- DATA SCRATCH_R1 /0/
-
- COMMON /REF/ REFERENCES,LREF
- CHARACTER*255 REFERENCES
-
- COMMON /NEWSGROUPS/ NEWSGROUPS
- CHARACTER*255 NEWSGROUPS
-
- CHARACTER*255 TEMP,FROM_LINE,SUBJECT_LINE
-
- CHARACTER*10 MSGNUM
-
- IF (SCRATCH_R1.NE.0) THEN ! Is queue empty?
- SCRATCH_R = SCRATCH_R1 ! No, set queue pointer to head
- ELSE ! Else if queue is empty
- CALL INIT_QUEUE(SCRATCH_R,INPUT)
- SCRATCH_R1 = SCRATCH_R ! Init header pointer
- END IF
-
- IF (REMOTE_SET.EQ.3) THEN
- MSGNUM = BUFFER(5:INDEX(BUFFER(5:),' ')-1+4)
-
- SUBJECT_LINE = ' '
- FROM_LINE = ' '
- NEWSGROUPS = ' '
- LREF = 0
- DO WHILE (BUFFER(SB:EB).NE.'.')
- IER = NEWS_READ()
- IF (.NOT.IER) RETURN
- IF (BUFFER(SB:EB).NE.'.') THEN
- IF (BUFFER(SB:SB+4).EQ.'From:'.AND.EB.GT.SB+5) THEN
- SB1 = FIRST_ALPHA(BUFFER(SB+6:EB))+SB+5
- FROM_LINE = 'From: '//BUFFER(SB1:EB)
- ELSE IF (BUFFER(SB:SB+7).EQ.'Subject:'.AND.
- & EB.GT.SB+8) THEN
- SB1 = FIRST_ALPHA(BUFFER(SB+9:EB))+SB+8
- SUBJECT_LINE = 'Subj: '//BUFFER(SB1:EB)
- ELSE IF (BUFFER(SB:SB+10).EQ.'Newsgroups:'.AND.
- & EB.GT.SB+11) THEN
- SB1 = FIRST_ALPHA(BUFFER(SB+12:EB))+SB+11
- NEWSGROUPS = BUFFER(SB1:EB)
- ELSE IF (BUFFER(SB:SB+10).EQ.'References:'.AND.
- & EB.GT.SB+11) THEN
- IF (LREF.EQ.0) THEN
- REFERENCES = BUFFER(SB+12:EB)
- ELSE
- REFERENCES = BUFFER(SB+12:EB)//' '//
- & REFERENCES(:LREF)
- END IF
- LREF = TRIM(REFERENCES)
- ELSE IF (BUFFER(SB:SB+10).EQ.'Message-ID:'.AND.
- & EB.GT.SB+11) THEN
- IF (LREF.EQ.0) THEN
- REFERENCES = BUFFER(SB+12:EB)
- ELSE
- REFERENCES = REFERENCES(:LREF)//' '//
- & BUFFER(SB+12:EB)
- END IF
- LREF = TRIM(REFERENCES)
- END IF
- END IF
- END DO
-
- LSUB = TRIM(SUBJECT_LINE)
- LFRO = TRIM(FROM_LINE)
- END IF
-
- ILEN = 128
- IER = 0
- LENGTH = 0
- LTEMP = 0
-
- DO WHILE (ILEN.GT.0.AND.IER.EQ.0)
- IF (REMOTE_SET.EQ.1) THEN
- READ (REMOTE_UNIT,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- ELSE
- IF (ILEN.EQ.128) ILEN = 0
- IF (LTEMP.GT.0) THEN
- ILEN = MIN(128,LTEMP)
- INPUT = TEMP(:ILEN)
- LTEMP = LTEMP - ILEN
- END IF
- IF (ILEN.LT.128) THEN
- IF (LFRO.GT.0) THEN
- BUFFER = FROM_LINE
- SB = 1
- EB = LFRO
- LFRO = 0
- IER = 1
- ELSE IF (LSUB.GT.0) THEN
- BUFFER = SUBJECT_LINE
- SB = 1
- EB = LSUB
- LSUB = 0
- IER = 1
- ELSE
- IF (LSUB.EQ.0) THEN
- IF (.NOT.NEWS_WRITE('ARTICLE '//MSGNUM)) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:2).NE.'22') THEN
- IER = 0
- RETURN
- END IF
- LSUB = -1
- END IF
- IER = NEWS_READ()
- END IF
- IF (IER.AND.BUFFER(SB:EB).NE.'.') THEN
- IER = 0
- LTEMP = MIN(255,EB-SB+1)
- IF (LTEMP.GT.0) THEN
- TEMP = CHAR(LTEMP)//BUFFER(SB:SB+LTEMP-1)
- ELSE
- TEMP = CHAR(1)//' '
- LTEMP = 1
- END IF
- LTEMP = LTEMP + 1
- LINP = MIN(LTEMP,128-ILEN)
- INPUT = INPUT(:ILEN)//TEMP(:LINP)
- ILEN = ILEN + LINP
- LTEMP = LTEMP - LINP
- TEMP = TEMP(LINP+1:)
- ELSE IF (IER) THEN
- IER = 0
- INPUT = INPUT(:ILEN)//CHAR(0)
- ILEN = -128
- ELSE
- ILEN = 128
- END IF
- ELSE
- TEMP = TEMP(129:)
- END IF
- END IF
- IF (IER.NE.0.AND.ILEN.GT.0) THEN
- CALL ERRSNS(IDUMMY,IER1)
- IF (IER1.EQ.RMS$_RER) THEN ! Ignore this error
- IER = 0
- ILEN = 0
- ELSE
- CALL SYS_GETMSG(IER1)
- LENGTH = 0
- IER1 = IER
- CALL DISCONNECT_REMOTE
- IER = IER1 ! IER is set to 0 by DISCONNECT_REMOTE
- END IF
- ELSE IF (ABS(ILEN).EQ.128) THEN
- CALL WRITE_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,INPUT)
- LENGTH = LENGTH + 1
- END IF
- END DO
-
- RETURN
- END
-
-
-
-
- SUBROUTINE REMOTE_REMOVE_FOLDER(IER)
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- RETURN
- END
-
-
-
- SUBROUTINE CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
-C
-C SUBROUTINE CONNECT_REMOTE_FOLDER
-C
-C FUNCTION: Connects to folder that is located on other DECNET node.
-C
- IMPLICIT INTEGER (A-Z)
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
- DATA REMOTE_UNIT /15/
-
- COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH
- COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)
- COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE
- CHARACTER*1 SEPARATE
-
- COMMON /READIT/ READIT
-
- COMMON /NEWS_INIT/ END_READ
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- CHARACTER*12 FOLDER_BBOARD_SAVE,FOLDER_OWNER_SAVE
- CHARACTER*25 FOLDER_SAVE
-
- DIMENSION DUMMY(4)
-
- IF (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z') THEN
- END_READ = 0
- IF (.NOT.NEWS_LOGIN()) THEN
- IER = 2
- RETURN
- END IF
- CALL NEWS_GROUP(IER)
- IF (IER.NE.0) RETURN
- IF (REMOTE_SET.EQ.1) CLOSE(UNIT=REMOTE_UNIT)
- RETURN
- END IF
-
- REMOTE_UNIT = 31 - REMOTE_UNIT
-
- SAME = .TRUE.
- LEN_BBOARD = TRIM(FOLDER1_BBOARD)
- IF (INDEX(FOLDER1_BBOARD,'*').GT.0) THEN ! Remote folder name different
- SAME = .FALSE. ! from local? Yes.
- LEN_BBOARD = LEN_BBOARD - 1
- END IF
-
- OPEN (UNIT=REMOTE_UNIT,STATUS='UNKNOWN',IOSTAT=IER,RECL=256,
- & FILE=FOLDER1_BBOARD(3:LEN_BBOARD)//'::"TASK=BULLETIN1"')
-
- IF (IER.EQ.0) THEN
- IF (.NOT.SAME) THEN
- FOLDER1_FILE = FOLDER_FILE
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
- & //FOLDER1
- REMOTE_SET_SAVE = REMOTE_SET
- REMOTE_SET = .FALSE.
- CALL OPEN_BULLDIR
- CALL READDIR(0,IER)
- CALL CLOSE_BULLDIR
- REMOTE_SET = REMOTE_SET_SAVE
- FOLDER_FILE = FOLDER1_FILE
- FOLDER_SAVE = FOLDER1
- FOLDER1 = BULLDIR_HEADER(13:)
- END IF
- SYSLOG = .FALSE.
- IF (READIT.EQ.1) THEN
- WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,'SYSTEM?'
- READ(REMOTE_UNIT,'(A)',IOSTAT=IER) IER1
- IF (IER1) THEN
- WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1//'+'
- SYSLOG = .TRUE.
- END IF
- END IF
- IF (.NOT.SYSLOG) THEN
- WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 1,FOLDER1
- END IF
- FOLDER_OWNER_SAVE = FOLDER1_OWNER
- FOLDER_BBOARD_SAVE = FOLDER1_BBOARD
- FOLDER_NUMBER_SAVE = FOLDER1_NUMBER
- IF (IER.EQ.0) THEN
- IF (SYSLOG) THEN
- READ(REMOTE_UNIT,'(7A)',IOSTAT=IER)IER1,READ_ONLY,
- & DUMMY(1),DUMMY(2),DUMMY(3),DUMMY(4),FOLDER1_COM
- ELSE
- READ(REMOTE_UNIT,'(5A)',IOSTAT=IER)IER1,READ_ONLY,
- & DUMMY(1),DUMMY(2),FOLDER1_COM
- END IF
- END IF
- IF (.NOT.SAME) FOLDER1 = FOLDER_SAVE
- FOLDER1_BBOARD = FOLDER_BBOARD_SAVE
- FOLDER1_NUMBER = FOLDER_NUMBER_SAVE
- FOLDER1_OWNER = FOLDER_OWNER_SAVE
- END IF
-
- 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.AND.
- & TEST_BULLCP().NE.2) THEN ! Not BULLCP process
- 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)
- CALL CLR2(BRIEF_FLAG,FOLDER_NUMBER_SAVE)
- CALL CLR2(SET_FLAG,FOLDER_NUMBER_SAVE)
- IF (IER.EQ.0) REWRITE (4) USER_ENTRY
- CALL CLOSE_BULLUSER
- END IF
- END IF
- IER = 2
- ELSE
- CLOSE (UNIT=31-REMOTE_UNIT)
-C
-C If remote folder has returned a last read time for the folder,
-C and if in /LOGIN mode, or last selected folder was a different
-C folder, or folder specified with "::", then update last read time.
-C
- IF (((FOLDER_NUMBER.NE.FOLDER1_NUMBER.OR.READIT.EQ.1)
- & .AND.(DUMMY(1).NE.0.OR.DUMMY(2).NE.0))
- & .OR.FOLDER1_NUMBER.EQ.-1) THEN
- CALL COPY2(LAST_READ_BTIM(1,FOLDER1_NUMBER+1),DUMMY)
- IF (SYSLOG) THEN
- CALL COPY2(LAST_SYS_BTIM(1,FOLDER1_NUMBER+1),DUMMY(3))
- END IF
- END IF
- IER = 0
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- COMMON /MSGID/ MESSAGE_ID
- CHARACTER*255 MESSAGE_ID
-
- COMMON /NEXT/ NEXT
- LOGICAL NEXT /.FALSE./
-
- COMMON /NEWGROUP/ NEWGROUP
-
- CHARACTER*6 NUMBER
-
- CHARACTER IN_BTIM(2)
-
- IF (REMOTE_SET.EQ.1) THEN
- IF (ICOUNT.GE.0) THEN
- WRITE (REMOTE_UNIT,'(2A)',IOSTAT=IER) 8,ICOUNT
- ELSE
- WRITE (REMOTE_UNIT,'(3A)',IOSTAT=IER) 8,-1,MSG_KEY
- END IF
- IF (IER.EQ.0) THEN
- IF (ICOUNT.EQ.0) THEN
- READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_HEADER
- ELSE IF (ICOUNT.EQ.-1) THEN
- READ (REMOTE_UNIT,'(2A)',IOSTAT=IER1) IER,BULLDIR_ENTRY
- IF (IER1.GT.0) THEN
- CALL ERROR_AND_EXIT
- ELSE IF (IER.NE.0) THEN
- CALL CONVERT_ENTRY_FROMBIN
- END IF
- RETURN
- ELSE
- READ (REMOTE_UNIT,'(2A)',IOSTAT=IER) ICOUNT,BULLDIR_ENTRY
- END IF
- END IF
- IF (IER.GT.0) THEN
- CALL ERROR_AND_EXIT
- ELSE IF (ICOUNT.EQ.1) THEN
- CALL CONVERT_HEADER_FROMBIN
- ELSE
- CALL CONVERT_ENTRY_FROMBIN
- END IF
- ELSE IF (REMOTE_SET.EQ.3) THEN
- IF (ICOUNT.EQ.0) THEN
- NBULL = F_NBULL
- ICOUNT = 1
- RETURN
- ELSE IF (ICOUNT.EQ.-1) THEN
- IER = 2
- CALL GET_MSGBTIM(MSG_KEY,IN_BTIM)
- CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)
- IF (START.EQ.-1) RETURN
- IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- ELSE
- IER = 2
- IF (NEXT.AND..NOT.NEWGROUP) THEN
- IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- IF (BUFFER(:3).NE.'223') RETURN
- IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- ELSE
- IF (ICOUNT.LT.F_START) ICOUNT = F_START
- IF (ICOUNT.GT.F_NBULL) ICOUNT = F_NBULL
- IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))
- & CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- END IF
- IF (BUFFER(:2).NE.'22') THEN
- DO WHILE (NEXT.AND.NEWGROUP.AND.ICOUNT.GT.F_START)
- ICOUNT = ICOUNT - 1
- IF (.NOT.OTS$CVT_L_TI(ICOUNT,NUMBER,,,)) RETURN
- IF (.NOT.NEWS_WRITE('HEAD '//NUMBER))
- & CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- IF (BUFFER(:2).EQ.'22') NEXT = .FALSE.
- END DO
- IF (INCMD(:4).EQ.'BACK'.AND.ICOUNT.GE.F_START) THEN
- IF (.NOT.NEWS_WRITE('LAST')) CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- IF (BUFFER(:3).NE.'223') RETURN
- IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- ELSE IF (INCMD(:4).NE.'READ'.AND..NOT.NEXT) THEN
- IF (.NOT.NEWS_WRITE('NEXT')) CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- IF (BUFFER(:3).NE.'223') RETURN
- IF (.NOT.NEWS_WRITE('HEAD')) CALL ERROR_AND_EXIT
- IF (.NOT.NEWS_READ()) CALL ERROR_AND_EXIT
- END IF
- END IF
- IF (BUFFER(:2).NE.'22') RETURN
- IER = OTS$CVT_TI_L(BUFFER(5:INDEX(BUFFER(5:),' ')+3),
- & ICOUNT,,%VAL(1))
- IF (.NOT.IER) RETURN
- START = ICOUNT
- BULLETIN_NUM = START
- END IF
- NEWGROUP = .FALSE.
- MESSAGE_ID = BUFFER(INDEX(BUFFER,'<'):INDEX(BUFFER,'>'))
- IER = 0
- CALL NEWS_HEADER(IER)
- IF (IER.GT.0) THEN
- CALL ERROR_AND_EXIT
- ELSE
- CALL CONVERT_ENTRY_FROMBIN
- END IF
- BLOCK = START
- MSG_NUM = START
- SYSTEM = 0
- IF (ICOUNT.NE.-1) THEN
- ICOUNT = ICOUNT + 1
- ELSE
- IER = START
- END IF
- END IF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GET_MSGBTIM(MSG_KEY,BTIM)
-
- IMPLICIT INTEGER (A-Z)
-
- INTEGER BTIM(2)
-
- CHARACTER*8 MSG_KEY,INPUT
-
- INPUT = MSG_KEY
-
- DO I=1,8
- INPUT(9-I:9-I) = MSG_KEY(I:I)
- END DO
-
- CALL LIB$MOVC3(8,%REF(INPUT),BTIM(1))
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_GROUP(IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- COMMON /NEWGROUP/ NEWGROUP
-
- IER = NEWS_WRITE('GROUP '//FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP)))
- IF (.NOT.IER) RETURN
-
- IER = NEWS_READ()
- IF (.NOT.IER) RETURN
-
- IF (BUFFER(:3).EQ.'411') RETURN
-
- NEWGROUP = .TRUE.
-
- BUFFER = BUFFER(5:)
-
- IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_END,,%VAL(1))
- IF (.NOT.IER) RETURN
- BUFFER = BUFFER(INDEX(BUFFER,' ')+1:)
- IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_START,,%VAL(1))
- IF (.NOT.IER) RETURN
- BUFFER = BUFFER(INDEX(BUFFER,' ')+1:)
- IER = OTS$CVT_TI_L(BUFFER(:INDEX(BUFFER,' ')-1),F1_NBULL,,%VAL(1))
- IF (.NOT.IER) RETURN
- BUFFER = BUFFER(INDEX(BUFFER,' ')+1:)
-
- IER = NEWS_WRITE('STAT')
- IF (.NOT.IER) RETURN
-
- IER = NEWS_READ()
- IF (.NOT.IER) RETURN
-
- IER = OTS$CVT_TI_L(BUFFER(SB+4:
- & INDEX(BUFFER(SB+4:),' ')+SB+2),START,,%VAL(1))
- IF (IER.AND.START.GT.F1_START) F1_START = START
-
- IF (F1_START.EQ.0) F1_NBULL = 0
-
- IER = 0
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_TIME(INTIME,BTIM)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INTIME
-
- CHARACTER*20 TIME
-
- I = 1
- LTIME = TRIM(INTIME)
- DO WHILE (I.LE.LTIME.AND.(ICHAR(INTIME(I:I)).LT.ICHAR('0').OR.
- & ICHAR(INTIME(I:I)).GT.ICHAR('9')))
- I = I + 1
- END DO
-
- IF (I.GT.LTIME) THEN
- CALL SYS_BINTIM('-',BTIM)
- RETURN
- END IF
-
- CALL STR$UPCASE(TIME,INTIME(I:))
-
- DO J = 1,2
- I = 1
- DO WHILE (TIME(I:I).NE.' '.AND.I.LT.LEN(TIME))
- I = I + 1
- END DO
- TIME(I:I) = '-'
- END DO
-
- IF (I.EQ.LEN(TIME)) RETURN
-
- IF (TIME(I+3:I+3).EQ.' ') THEN
- IF (TIME(I+1:I+1).EQ.'9'.OR.TIME(I+1:I+1).EQ.'8') THEN
- TIME = TIME(:I)//'19'//TIME(I+1:)
- ELSE
- TIME = TIME(:I)//'20'//TIME(I+1:)
- END IF
- END IF
-
- I = 1
- DO J = 1,2
- DO WHILE (TIME(I:I).NE.' '.AND.I.LE.LEN(TIME))
- I = I + 1
- END DO
- I = I + 1
- END DO
-
- IF (I-2.GT.LEN(TIME).OR.I-2.LE.0) RETURN
- CALL SYS_BINTIM(TIME(:I-2),BTIM)
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_LIST
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- CHARACTER*23 TODAY
-
- CALL LIB$DATE_TIME(TODAY)
-
- IF (.NOT.NEWS_LOGIN()) RETURN
-
- IF (.NOT.NEWS_WRITE('LIST')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:3).NE.'215') RETURN
-
- SPECIAL = SYS_TRNLNM('BULL_SPECIAL_NEWS_UPDATE','DEFINED').OR.
- & (INDEX(TODAY,' 03:').NE.0) ! Delete non-existant groups at 3
-
- CALL OPEN_BULLNEWS_SHARED ! Open folder file
-
- NEWS_FOLDER1_BBOARD = '::'
-
- CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)
- IF (IER1.NE.0) THEN
- NEWS_FOLDER1 = 'a'
- NEWS_FOLDER1_NUMBER = 1000
- NEWS_F1_END = 1001
- WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
- END IF
- IF (NEWS_F1_END.LT.1001) NEWS_F1_END = 1001
- NEWS_F_END = NEWS_F1_END
- DO WHILE (NEWS_READ().AND.BUFFER(SB:EB).NE.'.')
- FLEN = INDEX(BUFFER(SB:),' ') - 1
- NEWS_FOLDER1 = BUFFER(SB:MIN(25,FLEN)+SB-1)
- IF (IER1.EQ.0) THEN
- CALL READ_FOLDER_FILE_KEYNAME_TEMP(NEWS_FOLDER1,IER)
- END IF
- SP = FLEN+SB+1
- EP = INDEX(BUFFER(SP:),' ')+SP-2
- IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_NBULL,,%VAL(1))
- SP = EP + 2
- EP = INDEX(BUFFER(SP:),' ')+SP-2
- IER2 = OTS$CVT_TI_L(BUFFER(SP:EP),NEWS_F1_START,,%VAL(1))
- IF (NEWS_F1_START.EQ.0) NEWS_F1_NBULL = 0
- CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)
- IF (IER.NE.0.OR.IER1.NE.0) THEN
- IF (FLEN.GT.25) THEN
- NEWS_FOLDER1_DESCRIP = BUFFER(SB+25:FLEN+SB-1)
- ELSE
- NEWS_FOLDER1_DESCRIP = ' '
- END IF
- IER = 0
- DO WHILE (IER.EQ.0.AND.IER1.EQ.0)
- DO WHILE (REC_LOCK(IER))
- READ (7,KEY=NEWS_F_END,KEYID=1,IOSTAT=IER)
- END DO
- IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1
- END DO
- NEWS_FOLDER1_NUMBER = NEWS_F_END
- WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
- IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1
- ELSE IF (.NOT.SPECIAL.AND.(F1_START.NE.NEWS_F1_START.OR.
- & F1_NBULL.NE.NEWS_F1_NBULL)) THEN
- REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
- END IF
- END DO
-
- CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER1)
- NEWS_F1_END = NEWS_F_END
- REWRITE (7) NEWS_FOLDER1_COM
-
- IF (SPECIAL) THEN
- CALL READ_FOLDER_FILE_KEYNUM_TEMP(1000,IER)
- DO WHILE (IER.EQ.0)
- CALL READ_FOLDER_FILE_TEMP(IER)
- IF (IER.EQ.0) THEN
- NEWS_F1_NBULL = F1_NBULL
- NEWS_F1_START = F1_START
- CALL NEWS_GROUP(IER)
- IF (IER.EQ.0) THEN
- IF ((F1_START.NE.NEWS_F1_START.OR.
- & F1_NBULL.NE.NEWS_F1_NBULL)
- & .AND.F1_START.GT.0) THEN
- CALL SYS_BINTIM('-',F1_NEWEST_BTIM)
- CALL REWRITE_FOLDER_FILE_TEMP
- END IF
- ELSE
- DELETE (UNIT=7)
- IER = 0
- END IF
- END IF
- END DO
- END IF
-
- CALL CLOSE_BULLNEWS
-
- RETURN
- END
-
-
- SUBROUTINE LOWERCASE(INPUT)
-
- CHARACTER*(*) INPUT
-
- DO I=1,LEN(INPUT)
- IF (INPUT(I:I).GE.'A'.AND.INPUT(I:I).LE.'Z') THEN
- INPUT(I:I) = CHAR(ICHAR(INPUT(I:I)) - ICHAR('A') + ICHAR('a'))
- END IF
- END DO
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_POST(FILENAME,FILEOPEN,IER,SUBJECT)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLNEWS.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- COMMON /REF/ REFERENCES,LREF
- CHARACTER*255 REFERENCES
-
- COMMON /PATH/ PATHNAME,LPATH
- CHARACTER*132 PATHNAME
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /MSGID/ MESSAGE_ID
- CHARACTER*255 MESSAGE_ID
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /NEWSGROUPS/ NEWSGROUPS
- CHARACTER*255 NEWSGROUPS
-
- CHARACTER*(*) FILENAME,SUBJECT
-
- CHARACTER TODAY*23,MSGID*23,ZONE*5,GROUPS*255
-
- DIMENSION NOW(2),GMT(2)
-
- IER = 1
-
- IF (FILENAME.NE.'cancel') THEN
- IF (.NOT.FILEOPEN) THEN
- OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',IOSTAT=IER1)
- IF (IER1.NE.0) RETURN
- END IF
-
- IER1 = 0
- DO WHILE (IER1.EQ.0)
- READ (3,'(A)',IOSTAT=IER1) BUFFER
- IF (IER1.NE.0) GO TO 900
- IF (TRIM(BUFFER).GT.0) IER1 = 1
- END DO
-
- REWIND (UNIT=3)
- END IF
-
- IF (.NOT.NEWS_LOGIN()) GO TO 900
-
- IF (LPATH.EQ.0) CALL GET_PATHNAME
-
- IF (.NOT.NEWS_WRITE('POST')) GO TO 900
- IF (.NOT.NEWS_READ()) GO TO 900
- IF (BUFFER(:3).NE.'340') THEN
- WRITE (6,'('' ERROR: Posting not allowed.'')')
- GO TO 900
- END IF
-
- IF (REMOTE_SET.GE.3) THEN
- IF (TRIM(NEWSGROUPS).GT.0.AND.INCMD(:2).EQ.'RE') THEN
- GROUPS = 'Newsgroups: '//NEWSGROUPS
- ELSE IF (REMOTE_SET.EQ.4) THEN
- GROUPS = 'Newsgroups: '//FOLDER1_DESCRIP
- ELSE
- GROUPS = 'Newsgroups: '//FOLDER_DESCRIP
- END IF
- IF (FILENAME.NE.'cancel') THEN
- IF (CLI$PRESENT('GROUPS')) THEN
- CALL OPEN_BULLNEWS_SHARED
- FLEN = 0
- DO WHILE (CLI$GET_VALUE('GROUPS',FOLDER1_NAME,FLEN)
- & .AND.TRIM(GROUPS)+FLEN+1.LE.LEN(GROUPS))
- CALL LOWERCASE(FOLDER1_NAME)
- CALL READ_FOLDER_FILE_KEYNAME_TEMP
- & (FOLDER1_NAME(:FLEN),IER1)
- IF (IER1.EQ.0) GROUPS = GROUPS(:TRIM(GROUPS))//
- & ','//FOLDER1_NAME(:TRIM(FOLDER1_NAME))
- END DO
- CALL CLOSE_BULLNEWS
- END IF
- END IF
- IF (.NOT.NEWS_WRITE(GROUPS(:TRIM(GROUPS)))) GO TO 900
- END IF
- ATSIGN = INDEX(PATHNAME,'@')
- PCSIGN = INDEX(PATHNAME,'%')
- CALL LOWERCASE(USERNAME)
- IF (PCSIGN.GT.0) THEN
- IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'
- & //PATHNAME(PCSIGN+1:ATSIGN-1)//'!'
- & //USERNAME(:TRIM(USERNAME)))) GO TO 900
- ELSE
- IF (.NOT.NEWS_WRITE('Path: '//PATHNAME(ATSIGN+1:LPATH)//'!'
- & //USERNAME(:TRIM(USERNAME)))) GO TO 900
- END IF
- IF (.NOT.NEWS_WRITE('From: '//USERNAME(:TRIM(USERNAME))//
- & PATHNAME(:LPATH))) GO TO 900
- CALL STR$UPCASE(USERNAME,USERNAME)
- IF (.NOT.NEWS_WRITE('Subject: '//SUBJECT(:TRIM(SUBJECT))))
- & GO TO 900
-
- IF (INCMD(:2).EQ.'RE') THEN
- IF (.NOT.NEWS_WRITE('References: '//REFERENCES(:LREF)))
- & GO TO 900
- END IF
-
- CALL SYS$ASCTIM(,TODAY(:23),,)
-
- IF (LZONE.EQ.0) THEN
- IF (SYS_TRNLNM_SYSTEM('LISP$TIME_ZONE',ZONE)) THEN
- IER = OTS$CVT_TI_L(ZONE(:TRIM(ZONE)),DIFF,,%VAL(1))
- IF (DIFF.LT.0) THEN
- PAST = .TRUE.
- ZONE = ZONE(2:)
- ELSE IF (DIFF.GT.12) THEN
- PAST = .TRUE.
- DIFF = 24 - DIFF
- IER = OTS$CVT_L_TI(DIFF,ZONE(1:2),,,)
- IF (ZONE(1:1).EQ.' ') ZONE = ZONE(2:)
- ELSE
- PAST = .FALSE.
- END IF
- IER = SYS_BINTIM('0 '//ZONE(:TRIM(ZONE))//':00',GMT)
- IER = SYS$GETTIM(NOW)
- IF (PAST) THEN
- IER = LIB$ADDX(NOW,GMT,GMT)
- ELSE
- IER = LIB$SUBX(NOW,GMT,GMT)
- END IF
- IER = SYS$ASCTIM(,TODAY,GMT,)
- ZONE = 'GMT'
- ELSE IF (.NOT.SYS_TRNLNM_SYSTEM('MULTINET_TIMEZONE',ZONE)
- & .AND..NOT.SYS_TRNLNM_SYSTEM('PMDF_TIMEZONE',ZONE)) THEN
- ZONE = 'GMT'
- END IF
- LZONE = TRIM(ZONE)
- END IF
-
- MSGID = TODAY(:2)//TODAY(4:6)//TODAY(10:11)//'.'//
- & TODAY(13:14)//TODAY(16:17)//TODAY(19:20)//TODAY(22:23)
- IF (MSGID(1:1).EQ.' ') MSGID = MSGID(2:)
- IF (.NOT.NEWS_WRITE('Message-ID: <'//MSGID(:TRIM(MSGID))//
- & PATHNAME(:LPATH)//'>')) GO TO 900
-
- TODAY = TODAY(:2)//' '//TODAY(4:6)//' '//TODAY(10:20)
- IF (TODAY(1:1).EQ.' ') TODAY = TODAY(2:)
-
- IF (LORGAN.EQ.0) THEN
- IF (SYS_TRNLNM('BULL_NEWS_ORGANIZATION','DEFINED')) THEN
- IER1 = SYS_TRNLNM('BULL_NEWS_ORGANIZATION',ORGANIZATION)
- END IF
- LORGAN = TRIM(ORGANIZATION)
- END IF
-
- IF (LORGAN.GT.0) THEN
- IF (.NOT.NEWS_WRITE('Organization: '//ORGANIZATION(:LORGAN)))
- & GO TO 900
- END IF
-
- IF (.NOT.NEWS_WRITE('Date: '//TODAY(:TRIM(TODAY))//' '//
- & ZONE(:LZONE))) GO TO 900
-
- IF (FILENAME.EQ.'cancel') THEN
- IF (.NOT.NEWS_WRITE('Control: cancel '
- & //MESSAGE_ID(:TRIM(MESSAGE_ID)))) RETURN
- IF (.NOT.NEWS_WRITE('.')) RETURN
- IF (.NOT.NEWS_READ()) RETURN
- IF (BUFFER(:3).EQ.'240') IER = 0
- RETURN
- END IF
-
- IF (.NOT.NEWS_WRITE(' ')) GO TO 900
-
- IER1 = 0
- DO WHILE (IER1.EQ.0)
- READ (3,'(Q,A)',IOSTAT=IER1) ILEN,BUFFER
- IF (BUFFER(:ILEN).EQ.'.') THEN
- BUFFER = '..'
- ILEN = 2
- END IF
- IF (IER1.EQ.0.AND..NOT.NEWS_WRITE(BUFFER(:ILEN))) GO TO 900
- END DO
-
- IF (.NOT.NEWS_WRITE('.')) GO TO 900
- IF (.NOT.NEWS_READ()) GO TO 900
- IF (BUFFER(:3).EQ.'240') THEN
- IER = 0
- ELSE
- WRITE (6,'('' ERROR: Server rejected your posting:'')')
- WRITE (6,'(1X,A)') BUFFER(SB:EB)
- END IF
-
-900 IF (FILENAME.NE.'cancel'.AND..NOT.FILEOPEN) CLOSE (UNIT=3)
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_PATHNAME
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /PATH/ PATHNAME,LPATH
- CHARACTER*132 PATHNAME
-
- IF (NEWS_GETHOSTNAME(PATHNAME).EQ.-1) THEN
- IF (.NOT.SYS_TRNLNM_SYSTEM('ARPANET_HOST_NAME',PATHNAME).AND.
- & .NOT.SYS_TRNLNM_SYSTEM('INTERNET_HOST_NAME',PATHNAME).AND.
- & .NOT.SYS_TRNLNM_SYSTEM('MX_NODE_NAME',PATHNAME)) THEN
- WRITE (6,'('' ERROR: Cannot find local host name.'')')
- RETURN
- END IF
- END IF
-
- IF (ALPHA(PATHNAME(:1))) PATHNAME = '@'//PATHNAME
-
- CALL LOWERCASE(PATHNAME)
- LPATH = TRIM(PATHNAME)
-
- RETURN
- END
-
-
-
- LOGICAL FUNCTION TEST_NEWS(NAME)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) NAME
-
- TEST_NEWS = .FALSE.
-
- DO I=1,LEN(NAME)
- IF (NAME(I:I).NE.'.'.AND.
- & (NAME(I:I).LT.'a'.OR.NAME(I:I).GT.'z')) RETURN
- END DO
-
- TEST_NEWS = .TRUE.
-
- RETURN
- END
-
-
-
-
- SUBROUTINE NEWS2BULL
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /BUFFER/ BUFFER,SB,EB
- CHARACTER BUFFER*1280
-
- EXTERNAL BULLETIN_SUBCOMMANDS
-
- CHARACTER TIME*20,FIRST*80,FOLDER_SAVE*25
-
- CHARACTER*6 NUMBER
-
- DIMENSION SAVE_F_NEWEST_BTIM(2)
-
- CALL ALLPRIV
-
- CALL NEWS_LIST
-
- CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM)
-
- FOLDER_Q = FOLDER_Q1
-
- CALL OPEN_BULLFOLDER_SHARED ! Get folder file
-
- NUM_FOLDERS = 0
- IER = 0
- DO WHILE (IER.EQ.0) ! Find folders with news feed
- CALL READ_FOLDER_FILE(IER)
- IF (IER.EQ.0) THEN
- SLIST = INDEX(FOLDER_DESCRIP,'<')
- ELIST = INDEX(FOLDER_DESCRIP,'>')
- IF (SLIST.GT.0.AND.ELIST.GT.SLIST) THEN
- IF (FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@'.OR.
- & TEST_NEWS(FOLDER_DESCRIP(SLIST+1:ELIST-1))) THEN
- NUM_FOLDERS = NUM_FOLDERS + 1
- CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- END IF
- END IF
- END IF
- END DO
-
- CALL CLOSE_BULLFOLDER ! We don't need file anymore
-
- IF (NUM_FOLDERS.EQ.0.OR..NOT.NEWS_LOGIN()) CALL EXIT
-
- FOLDER_Q = FOLDER_Q1
- POINT_FOLDER = 0
- FILEOPEN = .FALSE.
- DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)
- IF (.NOT.FILEOPEN) THEN
- POINT_FOLDER = POINT_FOLDER + 1
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- CALL SELECT_FOLDER(.FALSE.,IER)
- CALL COPY2(SAVE_F_NEWEST_BTIM,F_NEWEST_BTIM)
- FOLDER_SAVE = FOLDER
- FOLDER_DESCRIP = FOLDER_DESCRIP(INDEX(FOLDER_DESCRIP,'<')+1:)
- FOLDER_DESCRIP = FOLDER_DESCRIP(:INDEX(FOLDER_DESCRIP,'>')-1)
- IF (FOLDER_DESCRIP(1:1).EQ.'@'.AND.IER) THEN
- OPEN (UNIT=3,FILE=FOLDER_DESCRIP(2:TRIM(FOLDER_DESCRIP))
- & ,STATUS='OLD',IOSTAT=IER1)
- IF (IER1.EQ.0) THEN
- READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP
- IF (IER1.NE.0) CLOSE (UNIT=3)
- IF (IER1.EQ.0) FILEOPEN = .TRUE.
- END IF
- ELSE
- IER1 = 0
- END IF
- END IF
- IF (IER.AND.IER1.EQ.0) THEN
- FOLDER_NUMBER = -1
- FOLDER1 = FOLDER_DESCRIP(:TRIM(FOLDER_DESCRIP))
- CALL SELECT_FOLDER(.FALSE.,IER)
- IF (IER) THEN
- CALL REMOTE_GET_NEWEST_MSG(SAVE_F_NEWEST_BTIM,START)
- IF (START.GE.F_START) THEN
- CALL OTS$CVT_L_TI(START,NUMBER,,,)
- INCMD = 'COPY/ORIGINAL '//FOLDER_SAVE(:TRIM(
- & FOLDER_SAVE))//' '//NUMBER//'-LAST'
- CALL CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
- CALL MOVE(.FALSE.)
- END IF
- END IF
- IF (FILEOPEN) THEN
- READ (3,'(A)',IOSTAT=IER1) FOLDER_DESCRIP
- IF (IER1.NE.0) CLOSE (UNIT=3)
- IF (IER1.NE.0) FILEOPEN = .FALSE.
- END IF
- END IF
- END DO
-
- CALL EXIT
- END
-
-
-
- SUBROUTINE DATE_TIME(TIME)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*36 MONTH
- DATA MONTH/'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'/
-
- CHARACTER*(*) TIME
-
- NMONTH = (INDEX(MONTH,TIME(4:6))+2)/3
-
- IF (TIME(1:1).EQ.' ') TIME(1:1) = '0'
-
- TIME = TIME(10:11)//CHAR(ICHAR('0')+NMONTH/10)//CHAR(ICHAR('0')+
- & MOD(NMONTH,10))//TIME(1:2)//' '//TIME(13:14)//
- & TIME(16:17)//TIME(19:20)
-
- RETURN
- END
-
-
-
- SUBROUTINE ALLPRIV
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
-
- PROCPRIV(1) = -1
- PROCPRIV(2) = -1
- NEEDPRIV(1) = -1
- NEEDPRIV(2) = -1
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_NEW_FOLDER
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER_COM
-
- NEWS_FOLDER1 = FOLDER1
- NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:)
-
- DO WHILE (IER.EQ.0)
- READ (7,IOSTAT=IER,KEYEQ=NEWS_F_END,KEYID=1)
- IF (IER.EQ.0) NEWS_F_END = NEWS_F_END + 1
- END DO
-
- NEWS_FOLDER1_NUMBER = NEWS_F_END
- CALL SYS_BINTIM('-',NEWS_F1_NEWEST_BTIM)
- WRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
-
- READ (7,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM
- NEWS_F1_END = NEWS_F_END
- REWRITE (7) NEWS_FOLDER1_COM
-
- RETURN
- END
-
-
-
- SUBROUTINE SUBSCRIBE
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- IF (REMOTE_SET.NE.3) THEN
- WRITE (6,'('' ERROR: Selected folder is not a news folder.'')')
- RETURN
- END IF
-
- I = 1
- DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER.AND.
- & LAST_NEWS_READ2(1,I).NE.0.AND.I.LE.FOLDER_MAX-1)
- I = I + 1
- END DO
-
- IF (I.GT.FOLDER_MAX-1) THEN
- WRITE (6,'('' ERROR: Cannot subscribe. You have '',
- & '' reached the news folder limit of '',I,''.'')')
- & FOLDER_MAX-1
- RETURN
- ELSE IF (LAST_NEWS_READ2(1,I).EQ.NEWS_FOLDER_NUMBER) THEN
- WRITE (6,'('' You are already subscribed to '',A,''.'')')
- & FOLDER_NAME(:TRIM(FOLDER_NAME))
- RETURN
- ELSE
- WRITE (6,'('' You are now subscribed to '',A,''.'')')
- & FOLDER_NAME(:TRIM(FOLDER_NAME))
- END IF
-
- LAST_NEWS_READ2(1,I) = NEWS_FOLDER_NUMBER
- IF (F_START.LE.F_NBULL) THEN
- LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-(F_START-1))
- LAST_NEWS_READ(2,I) = F_START - 1
- ELSE
- LAST_NEWS_READ2(2,I) = 0
- LAST_NEWS_READ(2,I) = F_NBULL
- END IF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE UNSUBSCRIBE
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- I = NEWS_FIND_SUBSCRIBE()
-
- IF (I.GT.FOLDER_MAX-1) THEN
- WRITE (6,'('' ERROR: You are not subscribed to '',A,''.'')')
- & FOLDER_NAME(:TRIM(FOLDER_NAME))
- RETURN
- ELSE
- WRITE (6,'('' You are now no longer subscribed to '',A,''.'')')
- & FOLDER_NAME(:TRIM(FOLDER_NAME))
- END IF
-
- DO J=I,FOLDER_MAX-2
- CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))
- END DO
-
- LAST_NEWS_READ(1,FOLDER_MAX-1) = 0
- LAST_NEWS_READ(2,FOLDER_MAX-1) = 0
-
- CALL FREE_TAGS(I)
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_GET_NEWEST_MESSAGE(IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- I = NEWS_FIND_SUBSCRIBE()
-
- IER = LAST_NEWS_READ(2,I) + 1
-
- IF (I.GT.FOLDER_MAX-1.OR.IER.GT.F_NBULL) THEN
- IER = 0
- RETURN
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_UPDATE_NEWEST_MESSAGE(NUMBER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- I = NEWS_FIND_SUBSCRIBE()
-
- IF (I.GT.FOLDER_MAX-1) RETURN
-
- IF (NUMBER.GT.LAST_NEWS_READ(2,I)) THEN
- LAST_NEWS_READ(2,I) = NUMBER
- LAST_NEWS_READ2(2,I) = MIN(8191,F_NBULL-NUMBER)
- & .OR.(LAST_NEWS_READ2(2,I).AND.'C000'X)
- END IF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE NEWS_GET_SUBSCRIBE(SUBNUM,SUBMSG)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- IF (SUBNUM.EQ.0) THEN
- COUNT = 0
- SUBMSG = LAST_NEWS_READ(2,1)
- RETURN
- ELSE IF (SUBNUM.EQ.-1) THEN
- DO J=COUNT,FOLDER_MAX-1
- CALL COPY2(LAST_NEWS_READ(1,J),LAST_NEWS_READ(1,J+1))
- END DO
-
- LAST_NEWS_READ(1,FOLDER_MAX-1) = 0
- LAST_NEWS_READ(2,FOLDER_MAX-1) = 0
- ELSE IF (SUBNUM.GT.0) THEN
- COUNT = COUNT + 1
- END IF
-
- IF (COUNT.LE.FOLDER_MAX-1) THEN
- SUBNUM = LAST_NEWS_READ2(1,COUNT)
- SUBMSG = LAST_NEWS_READ(2,COUNT)
- ELSE
- SUBNUM = 0
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE NEWS_NEW_NOTIFICATION(MESSAGES)
-C
-C SUBROUTINE NEW_NOTIFICATION
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /READIT/ READIT
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)
-
- MESSAGES = .FALSE.
-
- IF (.NOT.SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) RETURN
-
- CALL NEWS_GET_SUBSCRIBE(0,MSGNUM)
- IF (MSGNUM.EQ.0) RETURN
-
- CALL OPEN_BULLNEWS_SHARED
- SUBNUM = 1
-
- DO WHILE (SUBNUM.GT.0)
- IER = 1
- DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)
- CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)
- IF (SUBNUM.NE.0) THEN
- CALL READ_FOLDER_FILE_KEYNUM(SUBNUM,IER)
- IF (IER.EQ.0.AND.
- & MSGNUM.GT.F_NBULL.AND.F_START.LE.F_NBULL) THEN
- CALL NEWS_UPDATE_NEWEST_MESSAGE(F_START)
- ELSE IF (IER.NE.0) THEN
- SUBNUM = -1
- ELSE IF (MSGNUM.GE.F_NBULL.OR.F_NBULL.EQ.0.OR.
- & F_START.GT.F_NBULL) THEN
- IER = 1
- END IF
- END IF
- IF (IER.EQ.0.AND.SUBNUM.GT.0) THEN
- IF (READIT.EQ.1) THEN
- IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).AND.
- & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN
- IER = 1
- ELSE IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER).OR.
- & .NOT.TEST_SET_FLAG(NEWS_FOLDER_NUMBER).OR.
- & NEW_FLAG(2).NE.-1) THEN
- DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)
- IF (DIFF.GT.0) IER = 1
- END IF
- END IF
- END IF
- END DO
- IF (READIT.EQ.0.AND.SUBNUM.GT.0) THEN
- WRITE (6,'('' There are new messages in folder '',
- & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP))
- MESSAGES = .TRUE.
- ELSE IF (SUBNUM.GT.0) THEN
- IF (TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)
- & .AND.TEST_SET_FLAG(NEWS_FOLDER_NUMBER)) THEN
- WRITE (6,'('' There are new messages in folder ''
- & A,''.'',$)') FOLDER_DESCRIP(1:TRIM(FOLDER_DESCRIP))
- ELSE
- CALL CLOSE_BULLNEWS
- CALL SELECT_FOLDER(.FALSE.,IER1)
- IF (IER1) THEN
- CALL LOGIN_FOLDER
- IF (BULL_POINT.NE.-1) THEN
- IF (.NOT.TEST_BRIEF_FLAG(NEWS_FOLDER_NUMBER)) THEN
- SAVE_BULL_POINT = BULL_POINT
- REDO = .TRUE.
- DO WHILE (REDO)
- REDO = .FALSE.
- CALL READNEW(REDO)
- IF (REDO) CALL REDISPLAY_DIRECTORY
- BULL_POINT = SAVE_BULL_POINT
- END DO
- END IF
- END IF
- END IF
- CALL OPEN_BULLNEWS_SHARED
- END IF
- END IF
- END DO
-
- CALL CLOSE_BULLNEWS
-
- RETURN
- END
-
-
-
- LOGICAL FUNCTION TEST_SET_FLAG(NUMBER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN
- TEST_SET_FLAG = TEST2(SET_FLAG,NUMBER)
- RETURN
- END IF
-
- I = NEWS_FIND_SUBSCRIBE()
-
- TEST_SET_FLAG = BTEST(LAST_NEWS_READ2(2,I),14)
-
- RETURN
- END
-
-
-
-
- LOGICAL FUNCTION TEST_BRIEF_FLAG(NUMBER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- IF (NUMBER.GE.0.AND.NUMBER.LE.FOLDER_MAX-1) THEN
- TEST_BRIEF_FLAG = TEST2(BRIEF_FLAG,NUMBER)
- RETURN
- END IF
-
- I = NEWS_FIND_SUBSCRIBE()
-
- TEST_BRIEF_FLAG = BTEST(LAST_NEWS_READ2(2,I),15)
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION NEWS_FIND_SUBSCRIBE()
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- I = 1
- DO WHILE (LAST_NEWS_READ2(1,I).NE.NEWS_FOLDER_NUMBER
- & .AND.I.LE.FOLDER_MAX-1)
- I = I + 1
- END DO
-
- NEWS_FIND_SUBSCRIBE = I
-
- RETURN
- END
-
-
-
-
- SUBROUTINE NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- I = NEWS_FIND_SUBSCRIBE()
-
- IF (I.GT.FOLDER_MAX-1) THEN
- WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')')
- RETURN
- END IF
-
- IF (NOTIFY.EQ.1) THEN
- WRITE (6,'('' ERROR: NOTIFY cannot be set for news folder.'')')
- RETURN
- END IF
-
- IF (READNEW.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),14)
- IF (READNEW.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),14)
- IF (BRIEF.EQ.1) LAST_NEWS_READ2(2,I) = IBSET(LAST_NEWS_READ2(2,I),15)
- IF (BRIEF.EQ.0) LAST_NEWS_READ2(2,I) = IBCLR(LAST_NEWS_READ2(2,I),15)
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin11.for b/decus/vax91b/bulletin-net91b/bulletin11.for
deleted file mode 100644
index cab0ef066e11d2b3270c0e36bc08f4d1a408772c..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin11.for
+++ /dev/null
@@ -1,1385 +0,0 @@
-C
-C BULLETIN11.FOR, Version 8/25/91
-C Purpose: Bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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 TAG(ADD_OR_DEL,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
- DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,BULL_NEWS_TAG /.FALSE./
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- CHARACTER*12 TAG_KEY
-
- EXTERNAL CLI$_ABSENT,CLI$_NEGATED
-
- IF ((.NOT.BULL_TAG.AND.REMOTE_SET.NE.3)
- & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.EQ.3)) THEN
- CALL OPEN_NEW_TAG(IER)
- IF (.NOT.IER) RETURN
- END IF
-
- IF (REMOTE_SET.EQ.3) THEN
- IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX-1) THEN
- WRITE (6,'('' ERROR: NEWS group is not subscribed.'')')
- RETURN
- END IF
- END IF
-
- IF (ADD_OR_DEL.AND.
- & INCMD(:4).NE.'MARK'.AND.INCMD(:4).NE.'SEEN') THEN
- CALL ADD_TAG(IER,TAG_TYPE)
- RETURN
- END IF
-
- IF (INCMD(:4).EQ.'SEEN') THEN
- IF (CLI$PRESENT('READ').EQ.%LOC(CLI$_NEGATED)) THEN
- READ (13,KEYEQ=TAG_KEY(0,BULLDIR_HEADER,1),
- & IOSTAT=IER)
- IF (IER.EQ.0) DELETE (UNIT=13)
- BULL_TAG = IBCLR(BULL_TAG,1)
- RETURN
- END IF
- END IF
-
- IF (.NOT.CLI$PRESENT('NUMBER')) THEN
- IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin?
- WRITE(6,1010) ! No, then error.
- RETURN
- ELSE IF (ADD_OR_DEL) THEN
- CALL ADD_TAG(IER,TAG_TYPE)
- ELSE
- CALL DEL_TAG(IER,TAG_TYPE)
- IF (IER.NE.0) THEN
- IF (TAG_TYPE.EQ.1) THEN
- WRITE (6,'('' ERROR: Message was not marked.'')')
- ELSE
- WRITE (6,'('' ERROR: Message was not seen.'')')
- END IF
- END IF
- END IF
- RETURN
- END IF
-
- CALL OPEN_BULLDIR_SHARED
-
- IER1 = 0
- DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)
- & .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages
-
- CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER)
-
- IF (SBULL.LE.0.OR.IER.NE.0.OR.SBULL.GT.F_NBULL) THEN
- WRITE (6,'(A)')
- & ' ERROR: Specified message number has incorrect format.'
- GO TO 100
- END IF
-
- DO MESSAGE_NUMBER = SBULL,MIN(EBULL,F_NBULL)
-
- CALL READDIR(MESSAGE_NUMBER,IER)
- IF (IER.NE.MESSAGE_NUMBER+1 ! Was message found?
- & .AND.REMOTE_SET.NE.3) THEN ! Ignore if news
- WRITE(6,1030) MESSAGE_NUMBER ! No
- GO TO 100
- ELSE IF (ADD_OR_DEL) THEN
- CALL ADD_TAG(IER,TAG_TYPE)
- ELSE
- CALL DEL_TAG(IER,TAG_TYPE)
- END IF
- END DO
- END DO
-
-100 IF (REMOTE_SET.EQ.3) CALL READDIR(BULL_POINT,IER)
-
- CALL CLOSE_BULLDIR
-
- RETURN
-
-1010 FORMAT(' ERROR: You have not read any message.')
-1030 FORMAT(' ERROR: Message was not found: ',I)
-
- END
-
-
-
- SUBROUTINE ADD_TAG(IER,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($FORIOSDEF)'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- CHARACTER*12 TAG_KEY
-
- IF (REMOTE_SET.NE.3) THEN
- IF (TAG_TYPE.EQ.2.AND..NOT.BTEST(BULL_TAG,1)) THEN ! No SEEN tags
- WRITE (13,IOSTAT=IER) TAG_KEY(0,BULLDIR_HEADER,1)
- BULL_TAG = IBSET(BULL_TAG,1)
- END IF
- WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE)
- ELSE
- CALL ADD_NEWS_TAG(IER,TAG_TYPE)
- RETURN
- END IF
-
- IF (IER.NE.FOR$IOS_INCKEYCHG.AND.IER.NE.0) THEN
- WRITE (6,'('' ERROR: Unable to mark message.'')')
- CALL ERRSNS(IDUMMY,IER1)
- IF (IER1.EQ.0) THEN
- WRITE (6,'('' IOSTAT error = '',I)') IER
- ELSE
- CALL SYS_GETMSG(IER1)
- END IF
- ELSE
- IER = 0
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_FIRST_NEWS_TAG(IER,MESSAGE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
-
- COMMON /NEWS_MARK/ NEWS_MARK
- DIMENSION NEWS_MARK(128)
- INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
- EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
- EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
- EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)
- EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /NEXT/ NEXT
-
- IER = 36
-
- SUBNUM = NEWS_FIND_SUBSCRIBE()
-
- IF (SUBNUM.GT.FOLDER_MAX-1) RETURN
-
- DO J=1,2
- IF (BTEST(READ_TAG,J)) I = J
- END DO
-
- IF (NEWS_TAG(3,I,SUBNUM).EQ.0) RETURN
-
- OLD_NEXT = NEXT
-
- NEXT = .FALSE.
- J = F_START - 1
- IER1 = J
- DO WHILE (J.LE.F_NBULL.AND.J+1.NE.IER1)
- J = J + 1
- CALL READDIR(J,IER1)
- END DO
-
- IF (J+1.NE.IER1) THEN
- NEXT = OLD_NEXT
- RETURN
- END IF
-
- NEXT = .TRUE.
-
- DO MESSNUM = NEWS_TAG(1,I,SUBNUM),NEWS_TAG(2,I,SUBNUM)
- TEST = TEST_TAG(MESSNUM,%VAL(NEWS_TAG(3,I,SUBNUM)),
- & NEWS_TAG(1,I,SUBNUM))
- IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST
- IF (TEST) THEN
- HEADER = .TRUE.
- CALL GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,I,SUBNUM)
- IF (IER.EQ.0) MESSAGE = MESSNUM
- NEXT = OLD_NEXT
- RETURN
- END IF
- END DO
-
- NEXT = OLD_NEXT
-
- RETURN
-
- ENTRY GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE)
-
- IER = 36
-
- SUBNUM = NEWS_FIND_SUBSCRIBE()
-
- IF (SUBNUM.GT.FOLDER_MAX-1) RETURN
-
- TAG_TYPE = 0
-
- DO I=1,2
- IF ((BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3))
- & .AND.(NEWS_TAG(3,I,SUBNUM).GT.0).AND.
- & (MSG_NUM.LE.NEWS_TAG(2,I,SUBNUM))) THEN
- TEST = TEST_TAG(MSG_NUM,
- & %VAL(NEWS_TAG(3,I,SUBNUM)),NEWS_TAG(1,I,SUBNUM))
- IF (TEST) THEN
- IER = 0
- TAG_TYPE = IBSET(TAG_TYPE,I)
- END IF
- END IF
- END DO
-
- IF (BTEST(READ_TAG,3)) THEN
- IF ((.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.
- & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1))) THEN
- IER = 0
- ELSE
- IER = 36
- END IF
- END IF
-
- RETURN
-
- ENTRY GET_THIS_OR_NEXT_NEWS_TAG(NUM,IER,MESSAGE,TAG_TYPE)
-
- IER = 36
-
- SUBNUM = NEWS_FIND_SUBSCRIBE()
-
- IF (SUBNUM.GT.FOLDER_MAX-1) RETURN
-
- HEADER = .FALSE.
-
- TAG_TYPE = 0
-
- DO WHILE (IER.NE.0)
- I = 0
- DO J=1,2
- IF (NEWS_TAG(3,J,SUBNUM).GT.0.AND.BTEST(READ_TAG,J)) THEN
- IER = 36
- MNUM = MAX(NEWS_TAG(1,J,SUBNUM),NUM)
- DO WHILE (IER.NE.0.AND.MNUM.LE.NEWS_TAG(2,J,SUBNUM))
- TEST = TEST_TAG(MNUM,%VAL(NEWS_TAG(3,J,SUBNUM)),
- & NEWS_TAG(1,J,SUBNUM))
- IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST
- IF (TEST) THEN
- IER = 0
- ELSE
- MNUM = MNUM + 1
- END IF
- END DO
- IF (IER.EQ.0) THEN
- IF (J.EQ.1) THEN
- MESSAGE = MNUM
- I = 1
- ELSE IF (I.EQ.0.OR.MESSAGE.GT.MNUM) THEN
- MESSAGE = MNUM
- I = 2
- END IF
- END IF
- END IF
- END DO
- IF (I.EQ.0) RETURN
- CALL GET_NEXT_NEWS_TAG(IER,MESSAGE,HEADER,I,SUBNUM)
- IF (IER.EQ.0) THEN
- IF (.NOT.BTEST(READ_TAG,3)) TAG_TYPE = IBSET(TAG_TYPE,I)
- IF (NEWS_TAG(3,3-I,SUBNUM).GT.0.AND.
- & MESSAGE.LE.NEWS_TAG(2,3-I,SUBNUM).AND.
- & TEST_TAG(MESSAGE,%VAL(NEWS_TAG(3,3-I,SUBNUM)),
- & NEWS_TAG(1,3-I,SUBNUM))) THEN
- TAG_TYPE = IBSET(TAG_TYPE,3-I)
- END IF
- RETURN
- ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN
- RETURN
- END IF
- END DO
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_NEXT_NEWS_TAG(IER,MESSNUM,HEADER,J,SUBNUM)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /NEXT/ NEXT
-
- IER = 36
-
- OLD_NEXT = NEXT
-
- DO WHILE (MESSNUM.LE.NEWS_TAG(2,J,SUBNUM).AND.IER.NE.0)
- I = MAX(NEWS_TAG(1,J,SUBNUM),MESSNUM)
- DO WHILE (IER.NE.0.AND.I.LE.NEWS_TAG(2,J,SUBNUM))
- TEST = TEST_TAG(I,%VAL(NEWS_TAG(3,J,SUBNUM)),
- & NEWS_TAG(1,J,SUBNUM))
- IF (BTEST(READ_TAG,3)) TEST = .NOT.TEST
- IF (TEST) THEN
- IER = 0
- MESSNUM = I
- ELSE
- I = I + 1
- END IF
- END DO
- IF (IER.EQ.0) THEN
- SAVE_MESSNUM = MESSNUM
- NEXT = .FALSE.
- CALL READDIR(MESSNUM,IER1)
- IF (IER1.NE.MESSNUM+1) THEN
- NEXT = .TRUE.
- CALL READDIR(MESSNUM,IER1)
- END IF
- IF (IER1.NE.MESSNUM+1) THEN
- IER = 36
- IF (.NOT.BTEST(READ_TAG,3)) THEN
- CALL DEL_NEWS_TAG(J,MESSNUM,SUBNUM)
- ELSE
- NEXT = OLD_NEXT
- RETURN
- END IF
- IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) RETURN
- ELSE IF (MESSNUM.NE.SAVE_MESSNUM) THEN
- IER = 36
- IF (.NOT.BTEST(READ_TAG,3)) THEN
- CALL DEL_NEWS_TAG(J,SAVE_MESSNUM,SUBNUM)
- END IF
- END IF
- ELSE
- MESSNUM = NEWS_TAG(2,J,SUBNUM) + 1
- END IF
- END DO
-
- IF (IER.EQ.0.AND.HEADER) THEN
- MESSNUM = MESSNUM - 1
- MSG_NUM = MESSNUM
- END IF
-
- NEXT = OLD_NEXT
-
- RETURN
- END
-
-
-
-
- SUBROUTINE ADD_NEWS_TAG(IER,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
-
- IER = 0
-
- SUBNUM = NEWS_FIND_SUBSCRIBE()
- IF (SUBNUM.GT.FOLDER_MAX-1) RETURN
-
- IF (NEWS_TAG(3,TAG_TYPE,SUBNUM).EQ.0.AND.F_NBULL.GE.F_START) THEN
- NEWS_TAG(1,TAG_TYPE,SUBNUM) = F_START
- NEWS_TAG(2,TAG_TYPE,SUBNUM) = F_NBULL
- CALL LIB$GET_VM((F_NBULL-F_START)/8+1,
- & NEWS_TAG(3,TAG_TYPE,SUBNUM))
- CALL ZERO_VM((F_NBULL-F_START)/8+1,
- & %VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)))
- ELSE IF (F_NBULL.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) THEN
- DO I=1,2
- IF (NEWS_TAG(1,I,SUBNUM).GT.0) THEN
- CALL LIB$GET_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,TEMP)
- CALL ZERO_VM((F_NBULL-NEWS_TAG(1,I,SUBNUM))/8+1,
- & %VAL(TEMP))
- CALL LIB$MOVC3((NEWS_TAG(2,I,SUBNUM)-
- & NEWS_TAG(1,I,SUBNUM))/8+1,
- & %VAL(NEWS_TAG(3,I,SUBNUM)),%VAL(TEMP))
- CALL LIB$FREE_VM((NEWS_TAG(2,I,SUBNUM)-
- & NEWS_TAG(1,I,SUBNUM))/8+1,
- & NEWS_TAG(3,I,SUBNUM))
- NEWS_TAG(2,I,SUBNUM) = F_NBULL
- NEWS_TAG(3,I,SUBNUM) = TEMP
- END IF
- END DO
- END IF
-
- CALL SET_TAG(MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
- & NEWS_TAG(1,TAG_TYPE,SUBNUM))
- NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1
-
- RETURN
- END
-
-
-
- SUBROUTINE SET_TAG(NUM,TAGS,START)
-
- IMPLICIT INTEGER (A-Z)
-
- DIMENSION TAGS(1)
-
- I = (NUM-START)/32
- J = NUM - START - I*32
-
- TAGS(I+1) = IBSET(TAGS(I+1),J)
-
- RETURN
- END
-
-
-
- SUBROUTINE CLR_TAG(NUM,TAGS,START)
-
- IMPLICIT INTEGER (A-Z)
-
- DIMENSION TAGS(1)
-
- I = (NUM-START)/32
- J = NUM - START - I*32
-
- TAGS(I+1) = IBCLR(TAGS(I+1),J)
-
- RETURN
- END
-
-
-
- LOGICAL FUNCTION TEST_TAG(NUM,TAGS,START)
-
- IMPLICIT INTEGER (A-Z)
-
- DIMENSION TAGS(1)
-
- I = (NUM-START)/32
- J = NUM - START - I*32
-
- TEST_TAG = BTEST(TAGS(I+1),J)
-
- RETURN
- END
-
-
-
- SUBROUTINE DEL_TAG(IER,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*12 TAG_KEY
-
- IER = 0
-
- IF (REMOTE_SET.EQ.3) THEN
- SUBNUM = NEWS_FIND_SUBSCRIBE()
- CALL DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)
- RETURN
- END IF
-
- DO WHILE (REC_LOCK(IER1))
- READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE),
- & IOSTAT=IER1)
- END DO
- IF (IER1.NE.0) RETURN
-
- DELETE (UNIT=13,IOSTAT=IER1)
-
- RETURN
- END
-
-
-
- SUBROUTINE DEL_NEWS_TAG(TAG_TYPE,MSG_NUM,SUBNUM)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
-
- IF (MSG_NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR.
- & MSG_NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM).OR..NOT.TEST_TAG
- & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM))
- & ,NEWS_TAG(1,TAG_TYPE,SUBNUM))) THEN
- RETURN
- ELSE
- NEWS_TAG(4,TAG_TYPE,SUBNUM) = 1
- CALL CLR_TAG
- & (MSG_NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
- & NEWS_TAG(1,TAG_TYPE,SUBNUM))
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE OPEN_OLD_TAG
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($FORIOSDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /NEWS_MARK/ NEWS_MARK
- DIMENSION NEWS_MARK(128)
- INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
- EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
- EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
- EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)
- EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)
-
- CHARACTER*10 BULL_MARK_DIR
-
- CHARACTER*12 TAG_KEY
-
- IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)
- IF (IER) THEN
- BULL_MARK_DIR = 'BULL_MARK:'
- ELSE
- BULL_MARK_DIR = 'SYS$LOGIN:'
- END IF
-
- NTRIES = 0
-
- DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
- OPEN (UNIT=13,FILE=BULL_MARK_DIR//
- & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:12:CHARACTER))
- NTRIES = NTRIES + 1
- END DO
-
- IF (IER.EQ.0) THEN
- BULL_TAG = IBSET(BULL_TAG,0)
- DO WHILE (REC_LOCK(IER1))
- READ (13,KEY=TAG_KEY(0,BULLDIR_HEADER,1),IOSTAT=IER1)
- END DO
- IF (IER1.EQ.0) BULL_TAG = IBSET(BULL_TAG,1)
- END IF
-
- NTRIES = 0
-
- IF (IER.EQ.0.OR.IER.EQ.FOR$IOS_FILNOTFOU) THEN
- DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
- OPEN (UNIT=23,FILE=BULL_MARK_DIR//
- & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
- & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:4:INTEGER))
- NTRIES = NTRIES + 1
- END DO
-
- IF (IER.EQ.0) THEN
- IF (BULL_NEWS_TAG) RETURN
- BULL_NEWS_TAG = .TRUE.
- END IF
- END IF
-
- IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN
- WRITE (6,'('' Unable to open mark file.'')')
- IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
- IF (IER1.EQ.0) THEN
- WRITE (6,'('' IOSTAT error = '',I)') IER
- ELSE
- CALL SYS_GETMSG(IER1)
- END IF
- RETURN
- END IF
-
- IF (BULL_NEWS_TAG) THEN
- OLD_NEWS_NUMBER = 0
- FOLDER_NUMBER_SAVE = NEWS_FOLDER_NUMBER
- CALL OPEN_BULLNEWS_SHARED
- DO WHILE (IER.EQ.0)
- DO WHILE (REC_LOCK(IER))
- READ (23,IOSTAT=IER) NEWS_MARK
- END DO
- IF (IER.EQ.0) THEN
- IF (NEWS_NUMBER.NE.OLD_NEWS_NUMBER) THEN
- NEWS_FOLDER_NUMBER = NEWS_NUMBER
- SUBNUM = NEWS_FIND_SUBSCRIBE()
- IF (SUBNUM.GT.FOLDER_MAX-1) THEN
- DELETE (UNIT=23)
- ELSE
- OLD_NEWS_NUMBER = NEWS_NUMBER
- CALL READ_FOLDER_FILE_KEYNUM_TEMP
- & (NEWS_FOLDER_NUMBER,IER1)
- IF (IER1.NE.0) THEN
- SUBNUM = 0
- ELSE
- DO I=1,2
- NEWS_TAG(1,I,SUBNUM) = F1_START
- NEWS_TAG(2,I,SUBNUM) = F1_NBULL
- NEWS_TAG(4,I,SUBNUM) = 0
- CALL LIB$GET_VM((F1_NBULL-F1_START)/8+1,
- & NEWS_TAG(3,I,SUBNUM))
- CALL ZERO_VM((F1_NBULL-F1_START)/8+1,
- & %VAL(NEWS_TAG(3,I,SUBNUM)))
- END DO
- END IF
- END IF
- END IF
- IF (NEWS_NUMBER.EQ.OLD_NEWS_NUMBER) THEN
- IF (SUBNUM.EQ.0) THEN
- DELETE (UNIT=23)
- ELSE
- IF (NEWS_REC.GT.0) THEN
- TAG_TYPE = 1
- ELSE
- TAG_TYPE = 2
- END IF
- IF (NEWS_FORMAT.EQ.0) THEN ! 16 bit numbers
- DO I=5,256
- CALL SET_NEWS(INT(NEWS_MARK2(I)),SUBNUM,
- & TAG_TYPE)
- END DO
- ELSE
- DO I=3,128
- CALL SET_NEWS(NEWS_MARK(I),SUBNUM,TAG_TYPE)
- END DO
- END IF
- END IF
- END IF
- END IF
- END DO
- NEWS_FOLDER_NUMBER = FOLDER_NUMBER_SAVE
- CALL CLOSE_BULLNEWS
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE SET_NEWS(NUM,SUBNUM,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
-
- IF (NUM.GT.0) THEN
- LAST_NUM = NUM
- IF (NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM).OR.
- & NUM.GT.NEWS_TAG(2,TAG_TYPE,SUBNUM)) RETURN
- CALL SET_TAG(NUM,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
- & NEWS_TAG(1,TAG_TYPE,SUBNUM))
- ELSE IF (NUM.LT.0) THEN
- IF (-NUM.LT.NEWS_TAG(1,TAG_TYPE,SUBNUM)) RETURN
- DO J=MAX(NEWS_TAG(1,TAG_TYPE,SUBNUM),LAST_NUM+1),
- & MIN(NEWS_TAG(2,TAG_TYPE,SUBNUM),-NUM)
- CALL SET_TAG(J,%VAL(NEWS_TAG(3,TAG_TYPE,SUBNUM)),
- & NEWS_TAG(1,TAG_TYPE,SUBNUM))
- END DO
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE OPEN_NEW_TAG(IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*10 BULL_MARK_DIR
-
- IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)
- IF (IER) THEN
- BULL_MARK_DIR = 'BULL_MARK:'
- ELSE
- BULL_MARK_DIR = 'SYS$LOGIN:'
- END IF
-
- IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER)
- IF (.NOT.IER1) THEN
- IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)
- CALL DISABLE_PRIVS
- IER1 = .FALSE.
- END IF
- IF (REMOTE_SET.NE.3) THEN
- MARKUNIT = 13
- OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR//
- & USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW',
- & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
- & RECORDSIZE=3,
- & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:12:CHARACTER))
- ELSE
- MARKUNIT = 23
- OPEN (UNIT=MARKUNIT,FILE=BULL_MARK_DIR//
- & USERNAME(:TRIM(USERNAME))//'.NEWSMARK',STATUS='NEW',
- & ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
- & RECORDSIZE=128,
- & FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:4:INTEGER))
- END IF
- IF (.NOT.IER1) CALL ENABLE_PRIVS
- IF (IER.NE.0) THEN
- WRITE (6,'('' Cannot create mark file.'')')
- CALL ERRSNS(IDUMMY,IER1)
- IF (IER1.EQ.0) THEN
- WRITE (6,'('' IOSTAT error = '',I)') IER
- IER = 0
- ELSE
- CALL SYS_GETMSG(IER1)
- IER = IER1
- END IF
- ELSE
- IF (.NOT.IER1) THEN
- INQUIRE (UNIT=MARKUNIT,NAME=BULL_PARAMETER)
- WRITE (6,'('' Created MARK file: '',A)')
- & BULL_PARAMETER(:TRIM(BULL_PARAMETER))
- END IF
- IF (MARKUNIT.EQ.13) BULL_TAG = 1
- IF (MARKUNIT.EQ.23) BULL_NEWS_TAG = .TRUE.
- IER = 1
- END IF
-
- RETURN
- END
-
-
-
- CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) MSG_KEY
-
- IF (TAG_TYPE.EQ.1) THEN
- CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY))
- ELSE
- CALL LIB$MOVC3(4,-(1+FOLDER_NUMBER),%REF(TAG_KEY))
- END IF
-
- CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*12 TAG_KEY,INPUT_KEY
-
- CHARACTER*8 NEXT_MSG_KEY
-
- IF ((.NOT.BULL_TAG.AND.REMOTE_SET.NE.3)
- & .OR.(.NOT.BULL_NEWS_TAG.AND.REMOTE_SET.EQ.3)) THEN
- CALL OPEN_NEW_TAG(IER)
- IF (.NOT.IER) RETURN
- END IF
-
- IF (REMOTE_SET.EQ.3) THEN
- CALL GET_FIRST_NEWS_TAG(IER,MESSAGE)
- RETURN
- END IF
-
- IF (BTEST(READ_TAG,3)) THEN
- MSG_NUM = 0
- CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,DUMMY)
- IF (IER.EQ.0) THEN
- MESSAGE = MESSAGE - 1
- MSG_NUM = MESSAGE
- MSG_KEY = BULLDIR_HEADER
- END IF
- RETURN
- END IF
-
- MSG_KEY = BULLDIR_HEADER
-
- HEADER = .TRUE.
-
- DO J=1,2
- IF (BTEST(READ_TAG,J)) I = J
- END DO
-
- CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I)
-
- RETURN
-
- ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)
-
- IF (REMOTE_SET.EQ.3) THEN
- CALL GET_THIS_NEWS_TAG(IER,MESSAGE,TAG_TYPE)
- RETURN
- END IF
-
- TAG_TYPE = 0
-
- DO I=1,2
- IF (BTEST(READ_TAG,I).OR.BTEST(READ_TAG,3)) THEN
- DO WHILE (REC_LOCK(IER))
- READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,I),
- & IOSTAT=IER) INPUT_KEY
- END DO
- IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,I)
- END IF
- END DO
-
- IF ((TAG_TYPE.NE.0.AND..NOT.BTEST(READ_TAG,3)).OR.
- & (BTEST(READ_TAG,3).AND.
- & (.NOT.BTEST(TAG_TYPE,2).OR..NOT.BTEST(READ_TAG,2)).AND.
- & (.NOT.BTEST(TAG_TYPE,1).OR..NOT.BTEST(READ_TAG,1)))) THEN
- IF (IER.EQ.0) UNLOCK 13
- IER = 0
- MESSAGE = MSG_NUM
- ELSE
- IER = 36
- END IF
-
- RETURN
-
- ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)
-
- MSG_NUM = MSG_NUM - 1
-
- CALL DECREMENT_MSG_KEY
-
- ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)
-
- IF (REMOTE_SET.EQ.3) THEN
- MSG_NUM = ABS(MSG_NUM) + 1
- CALL GET_THIS_OR_NEXT_NEWS_TAG(MSG_NUM,IER,MESSAGE,TAG_TYPE)
- RETURN
- END IF
-
- IER = 36
-
- HEADER = .FALSE.
-
- TAG_TYPE = 0
-
- IF (BTEST(READ_TAG,3)) THEN
- CALL GET_NEXT_UNTAG(FOLDER_NUMBER,IER,MESSAGE,TAG_TYPE)
- RETURN
- END IF
-
- DO WHILE (IER.NE.0)
- I = 0
- DO J=1,2
- IF (BTEST(READ_TAG,J)) THEN
- DO WHILE (REC_LOCK(IER))
- READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),
- & IOSTAT=IER) INPUT_KEY
- END DO
- IF (IER.EQ.0) THEN
- CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)
- IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.
- & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER)))
- & IER = 36
- END IF
- IF (IER.EQ.0) THEN
- IF (J.EQ.1) THEN
- NEXT_MSG_KEY = INPUT_KEY(5:)
- I = 1
- ELSE IF (I.EQ.0.OR.COMPARE_MSG_KEY(NEXT_MSG_KEY,
- & INPUT_KEY(5:)).GT.0) THEN
- I = 2
- END IF
- END IF
- END IF
- END DO
- IF (I.EQ.0) RETURN
- NEXT_MSG_KEY = MSG_KEY
- CALL CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,I)
- IF (IER.EQ.0) THEN
- TAG_TYPE = IBSET(TAG_TYPE,I)
- DO WHILE (REC_LOCK(IER))
- READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY,3-I),
- & IOSTAT=IER) INPUT_KEY
- END DO
- IF (IER.EQ.0) TAG_TYPE = IBSET(TAG_TYPE,3-I)
- IER = 0
- RETURN
- ELSE IF (.NOT.BTEST(READ_TAG,3-I)) THEN
- MSG_KEY = NEXT_MSG_KEY
- RETURN
- ELSE
- MSG_KEY = NEXT_MSG_KEY
- END IF
- END DO
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_NEXT_UNTAG(FN,IER,MESSAGE,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- INQUIRE (UNIT=2,OPENED=CLOSE_IT)
- CLOSE_IT = .NOT.CLOSE_IT
- IF (CLOSE_IT) CALL OPEN_BULLDIR_SHARED
-
- DO MESSAGE = MSG_NUM+1,F_NBULL
- CALL READDIR(MESSAGE,IER)
- IF (IER.EQ.MESSAGE+1) THEN
- CALL GET_THIS_TAG(FN,IER,DUMMY,TAG_TYPE)
- IF (IER.EQ.0) THEN
- IER = 0
- IF (CLOSE_IT) CALL CLOSE_BULLDIR
- RETURN
- END IF
- END IF
- END DO
-
- IER = 36
- IF (CLOSE_IT) CALL CLOSE_BULLDIR
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION COMPARE_MSG_KEY(MSG_KEY1,MSG_KEY2)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*8 MSG_KEY1,MSG_KEY2
-
- DIMENSION BTIM1(2),BTIM2(2)
-
- CALL GET_MSGBTIM(MSG_KEY1,BTIM1)
- CALL GET_MSGBTIM(MSG_KEY2,BTIM2)
-
- COMPARE_MSG_KEY = COMPARE_BTIM(BTIM1,BTIM2)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CONFIRM_TAG(IER,FOLDER_NUMBER,MESSAGE,HEADER,J)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- CHARACTER*12 TAG_KEY,INPUT_KEY
-
- DO WHILE (REC_LOCK(IER))
- READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY,J),IOSTAT=IER)
- & INPUT_KEY
- END DO
-
- CLOSE_IT = .FALSE.
-
- DO WHILE (1)
- IF (IER.EQ.0) THEN
- CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)
- CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)
- END IF
-
- IF (IER.EQ.0) THEN
- IF ((J.EQ.1.AND.FOLDER1_NUMBER.NE.FOLDER_NUMBER).OR.
- & (J.EQ.2.AND.FOLDER1_NUMBER.NE.-(1+FOLDER_NUMBER)))
- & IER = 36
- END IF
- IF (IER.NE.0) THEN
- IER = 1
- UNLOCK 13
- IF (CLOSE_IT) CALL CLOSE_BULLDIR
- RETURN
- ELSE
- CALL DECREMENT_MSG_KEY
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- INQUIRE (UNIT=2,OPENED=IER)
- IF (.NOT.IER) THEN
- CALL OPEN_BULLDIR_SHARED
- CLOSE_IT = .TRUE.
- END IF
- CALL READDIR_KEYGE(IER)
- CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))
- IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN
- UNLOCK 13
- MESSAGE = MSG_NUM
- IF (HEADER) THEN
- MESSAGE = MESSAGE - 1
- MSG_NUM = MESSAGE
- MSG_KEY = BULLDIR_HEADER
- END IF
- IER = 0
- IF (CLOSE_IT) CALL CLOSE_BULLDIR
- RETURN
- ELSE
- DELETE (UNIT=13)
- IF (BTEST(READ_TAG,1).AND.BTEST(READ_TAG,2)) THEN
- IER = 36
- IF (CLOSE_IT) CALL CLOSE_BULLDIR
- RETURN
- END IF
- DO WHILE (REC_LOCK(IER))
- READ (13,IOSTAT=IER) INPUT_KEY
- END DO
- END IF
- END IF
-
- END DO
-
- END
-
-
-
- SUBROUTINE CLOSE_TAG
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /NEWS_MARK/ NEWS_MARK
- DIMENSION NEWS_MARK(128)
- INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
- EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
- EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
- EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)
- EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
-
- TAG_OPENED = .FALSE.
-
- IF (BULL_NEWS_TAG) THEN
- DO I=1,FOLDER_MAX-1
- DO M=1,2
- IF (NEWS_TAG(3,M,I).NE.0.AND.NEWS_TAG(4,M,I).EQ.1) THEN
- IF (.NOT.TAG_OPENED) THEN
- CALL OPEN_OLD_TAG
- TAG_OPENED = .TRUE.
- END IF
- IF (M.EQ.1) THEN
- NEWS_REC = 1
- ELSE
- NEWS_REC = -32767
- END IF
- NEWS_FORMAT = 0
- IF (NEWS_TAG(2,M,I).GT.32767) NEWS_FORMAT = 1
- LIMIT = 256/(NEWS_FORMAT+1)
- NEWS_NUMBER = LAST_NEWS_READ2(1,I)
- K = 5-NEWS_FORMAT*2
- SET_LIST = .FALSE.
- DO J=NEWS_TAG(1,M,I),NEWS_TAG(2,M,I)
- IF (TEST_TAG(J,%VAL(NEWS_TAG(3,M,I)),
- & NEWS_TAG(1,M,I))) THEN
- IF (.NOT.SET_LIST) THEN
- CALL SET_NEWS_MARK(K,J)
- LAST_SET = J
- K = K + 1
- SET_LIST = .TRUE.
- END IF
- ELSE IF (SET_LIST) THEN
- IF (LAST_SET.NE.J-1) THEN
- CALL SET_NEWS_MARK(K,-(J-1))
- K = K + 1
- END IF
- SET_LIST = .FALSE.
- END IF
- IF (J.EQ.NEWS_TAG(2,M,I)) THEN
- IF (SET_LIST.AND.LAST_SET.NE.J) THEN
- CALL SET_NEWS_MARK(K,-J)
- K = K + 1
- END IF
- DO L=K,LIMIT
- CALL SET_NEWS_MARK(L,0)
- END DO
- K = LIMIT + 1
- END IF
- IF (K.GT.LIMIT) THEN
- DO WHILE (REC_LOCK(IER))
- READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)
- END DO
- IF (IER.NE.0) THEN
- WRITE (23,IOSTAT=IER) NEWS_MARK
- ELSE
- REWRITE (23,IOSTAT=IER) NEWS_MARK
- END IF
- K = 5-NEWS_FORMAT*2
- NEWS_REC = NEWS_REC + 1
- IF (J.EQ.NEWS_TAG(2,M,I)) THEN
- DO WHILE (REC_LOCK(IER))
- READ (23,KEYEQ=NEWS_MARK(1),IOSTAT=IER)
- IF (IER.EQ.0) THEN
- DELETE (UNIT=23)
- NEWS_REC = NEWS_REC + 1
- L = REC_LOCK(IER)
- END IF
- END DO
- END IF
- END IF
- END DO
- END IF
- END DO
- END DO
- CLOSE (UNIT=23)
- END IF
-
- RETURN
- END
-
-
- SUBROUTINE SET_NEWS_MARK(I,J)
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /NEWS_MARK/ NEWS_MARK
- DIMENSION NEWS_MARK(128)
- INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
- EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
- EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
- EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)
- EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)
-
- IF (NEWS_FORMAT.EQ.0) THEN
- NEWS_MARK2(I) = J
- ELSE
- NEWS_MARK(I) = J
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE ZERO_VM(NUM,NEWS_TAG)
-
- IMPLICIT INTEGER (A-Z)
-
- LOGICAL*1 NEWS_TAG(1)
-
- DO I=1,NUM
- NEWS_TAG(I) = 0
- END DO
-
- RETURN
- END
-
-
-
-
- SUBROUTINE FREE_TAGS(ISUB)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /NEWS_TAGS/ NEWS_TAG(4,2,FOLDER_MAX-1)
- COMMON /NEWS_MARK/ NEWS_MARK
- DIMENSION NEWS_MARK(128)
- INTEGER*2 NEWS_MARK2(256),NEWS_NUMBER,NEWS_REC
- EQUIVALENCE (NEWS_MARK(1),NEWS_MARK2(1))
- EQUIVALENCE (NEWS_MARK2(1),NEWS_NUMBER)
- EQUIVALENCE (NEWS_MARK2(2),NEWS_REC)
- EQUIVALENCE (NEWS_MARK(2),NEWS_FORMAT)
-
- DO I=1,2
- IF (NEWS_TAG(3,I,ISUB).GT.0) THEN
- CALL LIB$FREE_VM(
- & (NEWS_TAG(2,I,ISUB)-NEWS_TAG(1,I,ISUB))/8+1,NEWS_TAG(3,I,ISUB))
- NEWS_TAG(3,I,ISUB) = 0
- NEWS_NUMBER = NEWS_FOLDER_NUMBER
- NEWS_REC = -32768
- DO WHILE (REC_LOCK(IER))
- READ (23,KEYGT=NEWS_MARK(1),IOSTAT=IER) NEWS_MARK
- IF (IER.EQ.0.AND.NEWS_NUMBER.EQ.NEWS_FOLDER_NUMBER) THEN
- DELETE (UNIT=23)
- L = REC_LOCK(IER)
- END IF
- END DO
- END IF
-
- DO J=I,FOLDER_MAX-2
- CALL LIB$MOVC3(16,NEWS_TAG(1,I,J+1),NEWS_TAG(1,I,J))
- END DO
-
- DO J=1,4
- NEWS_TAG(J,I,FOLDER_MAX-1) = 0
- END DO
- END DO
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_PREVIOUS_TAG(FN,IER,BULL_READ,TAG_TYPE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*8 PREV_MSG_KEY
-
- IER = 36
-
- IF (REMOTE_SET.EQ.3) THEN
- SUBNUM = NEWS_FIND_SUBSCRIBE()
- DO WHILE (IER.NE.0.AND.MSG_NUM.GT.F_START)
- MSG_NUM = MSG_NUM - 1
- CALL GET_THIS_TAG(FN,IER,MSG_NUM,TAG_TYPE)
- IF (IER.EQ.0) THEN
- TMP_MSG_NUM = MSG_NUM
- CALL READDIR(TMP_MSG_NUM,IER1)
- IF (IER1.NE.MSG_NUM+1) THEN
- IF (.NOT.BTEST(READ_TAG,3)) THEN
- CALL DEL_NEWS_TAG(TAG_TYPE,TMP_MSG_NUM,SUBNUM)
- END IF
- IER = 36
- END IF
- END IF
- END DO
- BULL_READ = MSG_NUM
- ELSE
- IF (MSG_NUM.EQ.0) RETURN
- SAVE_MSG_NUM = MSG_NUM
- PREV_MSG_NUM = MSG_NUM
- MSG_NUM = 0
- MSG_KEY = BULLDIR_HEADER
- IER = 0
- DO WHILE (IER.EQ.0.AND.MSG_NUM.LT.SAVE_MSG_NUM)
- IF (MSG_NUM.GT.0) THEN
- PREV_MSG_KEY = MSG_KEY
- PREV_MSG_NUM = MSG_NUM
- END IF
- CALL GET_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)
- END DO
- IF (PREV_MSG_NUM.LT.SAVE_MSG_NUM) THEN
- MSG_NUM = PREV_MSG_NUM
- MSG_KEY = PREV_MSG_KEY
- CALL GET_THIS_OR_NEXT_TAG(FN,IER,BULL_READ,TAG_TYPE)
- ELSE
- IER = 36
- END IF
- END IF
-
- RETURN
- END
-
-
- SUBROUTINE DECREMENT_MSG_KEY
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- I = 1
- DO WHILE (I.LT.9)
- ITEST = ICHAR(MSG_KEY(I:I))
- IF (ITEST.GT.0) THEN
- MSG_KEY(I:I) = CHAR(ITEST-1)
- I = 9
- ELSE
- I = I + 1
- END IF
- END DO
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin2.for b/decus/vax91b/bulletin-net91b/bulletin2.for
deleted file mode 100644
index 87861a490721d7bd20681bb2b1ee1f9f03fe4d84..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin2.for
+++ /dev/null
@@ -1,2147 +0,0 @@
-C
-C BULLETIN2.FOR, Version 6/15/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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 SET_BBOARD(BBOARD)
-C
-C SUBROUTINE SET_BBOARD
-C
-C FUNCTION: Set username for BBOARD for selected folder.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE '($UAIDEF)'
-
- EXTERNAL CLI$_ABSENT
-
- CHARACTER EXPIRE*3,INPUT_BBOARD*12,TODAY*23,RESPONSE*1
-
- IF (TRIM(BBOARD_DIRECTORY).EQ.0) THEN
- WRITE(6,'('' ERROR: System programmer has disabled BBOARD.'')')
- RETURN
- END IF
-
- IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
-
- CALL OPEN_BULLFOLDER ! Open folder file
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
-
- IF (FOLDER_BBOARD(:2).EQ.'::') THEN
- WRITE (6,'(
- & '' ERROR: Cannot set BBOARD for remote folder.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- END IF
-
- IF (BBOARD) THEN
- IER = CLI$GET_VALUE('BB_USERNAME',INPUT_BBOARD,INPUT_LEN)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- CALL GET_UAF
- & (INPUT_BBOARD,USERB,GROUPB,ACCOUNTB,FLAGS,IER1)
- CALL CLOSE_BULLFOLDER
- IF (IER1.AND..NOT.BTEST(FLAGS,UAI$V_DISACNT)) THEN ! DISUSER?
- WRITE (6,'('' ERROR: '',A,
- & '' account needs DISUSER flag set.'')')
- & INPUT_BBOARD(:INPUT_LEN)
- RETURN
- ELSE IF (IER1.AND.BTEST(USERB,31)) THEN
- WRITE (6,'('' ERROR: User number of UIC cannot '',
- & ''be greater than 7777777777.'')')
- RETURN
- END IF
- CALL OPEN_BULLFOLDER
- CALL READ_FOLDER_FILE_TEMP(IER)
- DO WHILE ((FOLDER1_BBOARD.NE.INPUT_BBOARD.OR.
- & FOLDER1_NUMBER.EQ.FOLDER_NUMBER).AND.IER.EQ.0)
- CALL READ_FOLDER_FILE_TEMP(IER)
- END DO
- IF (FOLDER1_BBOARD.EQ.INPUT_BBOARD.AND.
- & FOLDER1_NUMBER.NE.FOLDER_NUMBER) THEN
- WRITE (6,'(
- & '' ERROR: Account used by other folder.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- END IF
- IF (.NOT.IER1) THEN
- CALL CLOSE_BULLFOLDER
- WRITE (6,'('' WARNING: '',A,'' account not in SYSUAF'',
- & '' file.'')') INPUT_BBOARD(:INPUT_LEN)
- CALL GET_INPUT_PROMPT(RESPONSE,RLEN,
- & 'Is the name a mail forwarding entry? '//
- & '(Y/N with N as default): ')
- IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN
- WRITE (6,'('' Folder was not modified.'')')
- RETURN
- END IF
- CALL OPEN_BULLFOLDER
- USERB = 1 ! Fake userb/groupb, as old method of
- GROUPB = 1 ! indicating /SPECIAL used [0,0]
- END IF
- GROUPB1 = GROUPB
- USERB1 = USERB
- ACCOUNTB1 = ACCOUNTB
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
- GROUPB = GROUPB1
- USERB = USERB1
- ACCOUNTB = ACCOUNTB1
- FOLDER_BBOARD = INPUT_BBOARD
- CALL OPEN_BULLUSER
- CALL SYS$ASCTIM(,TODAY,,) ! Get the present time
- CALL READ_USER_FILE_HEADER(IER)
- CALL SYS_BINTIM(TODAY,BBOARD_BTIM)
- REWRITE (4) USER_HEADER
- CALL CLOSE_BULLUSER
- IF (CLI$PRESENT('SPECIAL')) THEN ! SPECIAL specified?
- USERB = IBSET(USERB,31) ! Set bit to show /SPECIAL
- IF (CLI$PRESENT('VMSMAIL')) THEN
- GROUPB = IBSET(GROUPB,31) ! Set bit to show /VMSMAIL
- END IF
- END IF
- ELSE IF (CLI$PRESENT('SPECIAL')) THEN
- USERB = IBSET(0,31) ! Set top bit to show /SPECIAL
- GROUPB = 0
- DO I=1,LEN(FOLDER_BBOARD)
- FOLDER_BBOARD(I:I) = ' '
- END DO
- ELSE IF (FOLDER_BBOARD.EQ.'NONE') THEN
- WRITE (6,'('' ERROR: No BBOARD specified for folder.'')')
- END IF
-
- IER = CLI$GET_VALUE('EXPIRATION',EXPIRE,EX_LEN)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- IF (EX_LEN.GT.3) EX_LEN = 3
- READ (EXPIRE,'(I<EX_LEN>)') TEMP
- IF (TEMP.GT.BBEXPIRE_LIMIT.AND..NOT.SETPRV_PRIV()) THEN
- WRITE (6,'('' ERROR: Expiration cannot be > '',
- & I3,'' days.'')') BBEXPIRE_LIMIT
- CALL CLOSE_BULLFOLDER
- RETURN
- ELSE IF (TEMP.LE.0) THEN
- WRITE (6,'('' ERROR: Expiration must be > 0.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- ELSE
- FOLDER_BBEXPIRE = TEMP
- END IF
- ELSE IF (.NOT.CLI$PRESENT('EXPIRATION')) THEN
- FOLDER_BBEXPIRE = -1
- END IF
- ELSE
- FOLDER_BBOARD = 'NONE'
- END IF
-
- CALL REWRITE_FOLDER_FILE
- CALL CLOSE_BULLFOLDER
- WRITE (6,'('' BBOARD has been modified for folder.'')')
- ELSE
- WRITE (6,'('' You are not authorized to modify BBOARD.'')')
- END IF
-
- RETURN
- END
-
-
-
-
-
-
- SUBROUTINE SET_SYSTEM(SYSTEM_SET)
-C
-C SUBROUTINE SET_SYSTEM
-C
-C FUNCTION: Set SYSTEM specification for selected folder.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- IF (FOLDER_NUMBER.EQ.0) THEN
- WRITE (6,'('' ERROR: Cannot modify GENERAL folder.'')')
- ELSE IF (FOLDER_NUMBER.LT.0) THEN
- WRITE (6,'('' ERROR: Cannot modify for remote folder.'')')
- ELSE IF (SETPRV_PRIV()) THEN
- CALL OPEN_BULLFOLDER ! Open folder file
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
- IF (SYSTEM_SET) THEN
- FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
- WRITE (6,'('' SYSTEM designation has been set.'')')
- ELSE
- FOLDER_FLAG = IBCLR(FOLDER_FLAG,2)
- WRITE (6,'('' SYSTEM designation has been removed.'')')
- END IF
- CALL REWRITE_FOLDER_FILE
- CALL MODIFY_SYSTEM_LIST(0)
- CALL CLOSE_BULLFOLDER
- CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
- ELSE
- WRITE (6,'('' You are not authorized to modify SYSTEM.'')')
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE MODIFY_SYSTEM_LIST(FILE_OPENED)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
- CHARACTER NODENAME*8
-
- COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
- COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
-
- INTEGER SHUTDOWN_BTIM(FLONG),VERSION(FLONG)
-
- CHARACTER UPDATE*11,UPTIME*8
-
- INTEGER UP_BTIM(2)
-
- IF (.NOT.FILE_OPENED) CALL OPEN_BULLUSER
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*SYSTEM',IOSTAT=IER)
- & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- END DO
-
- IF (IER.NE.0.OR.VERSION(1).NE.168) THEN
- DO I=1,FLONG
- SYSTEM_FLAG(I) = 0
- SHUTDOWN_FLAG(I) = 0
- END DO
- CALL SET2(SYSTEM_FLAG,0)
- CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
- NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)
- SHUTDOWN_BTIM(1) = 0
- SHUTDOWN_BTIM(2) = 0
- NODE_NUMBER = 0
- NODE_AREA = 0
- IF (IER.EQ.0) THEN
- DO WHILE (TEMP_USER(:7).EQ.'*SYSTEM'.AND.IER.EQ.0)
- DELETE (UNIT=4)
- DO WHILE (REC_LOCK(IER))
- READ (4,IOSTAT=IER) TEMP_USER
- END DO
- END DO
- IER = 2
- ELSE
- VERSION(1) = 168
- END IF
- END IF
-
- IF (VERSION(1).NE.168) THEN
- CALL CLOSE_BULLFOLDER
- CALL OPEN_BULLFOLDER
- NODE_AREA = 0
- DO I=1,FLONG
- SYSTEM_FLAG(I) = 0
- END DO
- IER1 = 0
- DO WHILE (IER1.EQ.0)
- CALL READ_FOLDER_FILE_TEMP(IER1)
- IF (BTEST(FOLDER1_FLAG,2).AND.IER1.EQ.0) THEN
- CALL SET2(SYSTEM_FLAG,FOLDER1_NUMBER)
- END IF
- END DO
- VERSION(1) = 168
- END IF
-
- IF (BTEST(FOLDER_FLAG,2)) THEN
- CALL SET2(SYSTEM_FLAG,FOLDER_NUMBER)
- ELSE
- CALL CLR2(SYSTEM_FLAG,FOLDER_NUMBER)
- END IF
-
- CALL SYS_BINTIM('-',UP_BTIM) ! Get today's date
- DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM)
- IF (DIFF.GE.0) THEN ! Must have been in a time wrap
- SHUTDOWN_BTIM(1) = UP_BTIM(1)
- SHUTDOWN_BTIM(2) = UP_BTIM(2)
- END IF
-
- IF (REMOTE_SET) THEN
- WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,BTEST(FOLDER_FLAG,2),
- & NODENAME
- IF (IER1.NE.0) THEN
- CALL DISCONNECT_REMOTE
- IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER
- RETURN
- END IF
- END IF
-
- CALL GET_UPTIME(UPDATE,UPTIME)
-
- CALL SYS_BINTIM(UPDATE//' '//UPTIME,UP_BTIM)
-
- IF (NODE_AREA.EQ.0) THEN
- IF (SHUTDOWN_BTIM(1).EQ.0) THEN
- DIFF = -1
- ELSE
- DIFF = COMPARE_BTIM(SHUTDOWN_BTIM,UP_BTIM)
- END IF
- IF (DIFF.EQ.-1) THEN
- CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
- SHUTDOWN_BTIM(1) = UP_BTIM(1)
- SHUTDOWN_BTIM(2) = UP_BTIM(2)
- DO I=1,FLONG
- SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)
- END DO
- END IF
- ELSE ! Test to make sure NODE_AREA is zero
- SEEN_FLAG = 0 ! if all of SHUTDOWN_FLAG is zero
- DO I=1,FLONG
- IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1
- END DO
- IF (SEEN_FLAG.EQ.0) NODE_AREA = 0
- END IF
-
- IF (IER.NE.0) THEN
- WRITE (4,IOSTAT=IER)
- & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,VERSION,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- ELSE
- REWRITE (4,IOSTAT=IER)
- & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,VERSION,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- END IF
-
- CALL READ_PERM
-
- IF (.NOT.FILE_OPENED) CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($SYIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- ! Now add items to list
- CALL ADD_2_ITMLST(4,SYI$_NODE_AREA,%LOC(NODE_AREA))
- CALL ADD_2_ITMLST(4,SYI$_NODE_NUMBER,%LOC(NODE_NUMBER))
- CALL END_ITMLST(GETSYI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETSYIW(,,,%VAL(GETSYI_ITMLST),,,) ! Get Info command.
-C
-C NODE_AREA is set to 0 after shutdown messages are deleted.
-C If node is not part of cluster, NODE_AREA will be 0,
-C so set it to 1 as a dummy value to cause messages to be deleted.
-C
- IF (NODE_AREA.EQ.0) NODE_AREA = 1
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SET_NODE(NODE_SET)
-C
-C SUBROUTINE SET_NODE
-C
-C FUNCTION: Set or reset remote node specification for selected folder.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- EXTERNAL CLI$_ABSENT
-
- CHARACTER RESPONSE*1,FOLDER_SAVE*25
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- IF (CLI$PRESENT('FOLDER')) THEN
- IER = CLI$GET_VALUE('FOLDER',FOLDER1) ! Get folder name
- FOLDER_SAVE = FOLDER
- CALL OPEN_BULLFOLDER_SHARED ! Open folder file
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER)
- IF (IER.EQ.0) THEN
- IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- WRITE (6,'('' ERROR: No privs to modify folder.'')')
- IER = 1
- END IF
- ELSE
- WRITE (6,'('' ERROR: Specified folder not found.'')')
- END IF
- IF (IER.NE.0) THEN
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)
- CALL CLOSE_BULLFOLDER
- RETURN
- END IF
- CALL CLOSE_BULLFOLDER
- END IF
-
- IF (FOLDER_NUMBER.EQ.0) THEN
- WRITE (6,'('' Cannot set remote node for GENERAL folder.'')')
- ELSE IF (FOLDER_NUMBER.LT.0) THEN
- WRITE (6,'('' Cannot set remote node for this folder.'')')
- ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- IF (.NOT.NODE_SET) THEN
- IF (INDEX(FOLDER_BBOARD,'*').GT.0) THEN
- REMOTE_SET_SAVE = REMOTE_SET
- REMOTE_SET = .FALSE.
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
- & FOLDER
- CALL OPEN_BULLDIR ! Remove directory file which
- CALL CLOSE_BULLDIR_DELETE ! contains remote folder name
- REMOTE_SET = REMOTE_SET_SAVE
- END IF
- FOLDER1_BBOARD = 'NONE'
- WRITE (6,'('' Remote node setting has been removed.'')')
- IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .FALSE.
- ELSE
- CALL GET_INPUT_PROMPT(RESPONSE,RLEN,
- & 'Are you sure you want to make folder '//
- & FOLDER(:TRIM(FOLDER))//
- & ' remote? (Y/N with N as default): ')
- IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN
- WRITE (6,'('' Folder was not modified.'')')
- RETURN
- END IF
- IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN
- FOLDER1 = FOLDER
- END IF
- IER = CLI$GET_VALUE('NODENAME',FOLDER1_BBOARD,FLEN)
- FOLDER1_BBOARD = '::'//FOLDER1_BBOARD(:FLEN)
- CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
- IF (IER.NE.0) THEN
- WRITE (6,'(
- & '' ERROR: Folder not accessible on remote node.'')')
- RETURN
- ELSE
- WRITE (6,'('' Folder has been converted to remote.'')')
- END IF
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
- & FOLDER
- REMOTE_SET_SAVE = REMOTE_SET
- REMOTE_SET = .FALSE.
- CALL OPEN_BULLDIR ! Remove directory file
- CALL OPEN_BULLFIL ! Remove bulletin file
- CALL CLOSE_BULLFIL_DELETE
- CALL CLOSE_BULLDIR_DELETE
- IF (FOLDER.NE.FOLDER1) THEN ! Different remote folder name?
- CALL OPEN_BULLDIR ! If so, put name in header
- BULLDIR_HEADER(13:) = FOLDER1 ! of directory file.
- CALL WRITEDIR_NOCONV(0,IER)
- CALL CLOSE_BULLDIR
- FOLDER1_BBOARD = FOLDER1_BBOARD(:FLEN+2)//'*'
- END IF
- REMOTE_SET = REMOTE_SET_SAVE
- IF (.NOT.CLI$PRESENT('FOLDER')) REMOTE_SET = .TRUE.
- END IF
- CALL OPEN_BULLFOLDER ! Open folder file
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
- IF (.NOT.NODE_SET.AND.FOLDER_BBOARD(:2).EQ.'::'
- & .AND.BTEST(FOLDER_FLAG,2)) THEN
- OPEN (UNIT=17,STATUS='UNKNOWN',IOSTAT=IER,
- & RECL=256,FILE=FOLDER_BBOARD(3:TRIM(FOLDER_BBOARD))
- & //'::"TASK=BULLETIN1"')
- IF (IER.EQ.0) THEN ! Disregister remote SYSTEM folder
- WRITE(17,'(2A)',IOSTAT=IER) 14,0
- CLOSE (UNIT=17)
- END IF
- END IF
- FOLDER_BBOARD = FOLDER1_BBOARD
- IF (NODE_SET) THEN
- F_NBULL = F1_NBULL
- F_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)
- F_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)
- F_NEWEST_NOSYS_BTIM(1) = F1_NEWEST_NOSYS_BTIM(1)
- F_NEWEST_NOSYS_BTIM(2) = F1_NEWEST_NOSYS_BTIM(2)
- FOLDER_FLAG = 0
- F_EXPIRE_LIMIT = F1_EXPIRE_LIMIT
- ELSE
- F_NBULL = 0
- END IF
- CALL REWRITE_FOLDER_FILE
- CALL CLOSE_BULLFOLDER
- ELSE
- WRITE (6,'('' You are not authorized to modify NODE.'')')
- END IF
-
- IF (CLI$PRESENT('FOLDER')) THEN
- CALL OPEN_BULLFOLDER_SHARED ! Open folder file
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER_SAVE,IER)
- CALL CLOSE_BULLFOLDER
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
- & FOLDER
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE RESPOND
-C
-C SUBROUTINE RESPOND
-C
-C FUNCTION: Sends a mail message in reply to a posted message.
-C
-C NOTE: Modify the last SPAWN statement to specify the command
-C you use to send mail to sites other than via MAIL.
-C If you always use a different command, modify both
-C spawn commands.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /EDIT/ EDIT_DEFAULT
- DATA EDIT_DEFAULT/.FALSE./
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
-
- COMMON /INDESCRIP/ INDESCRIP
- CHARACTER*(LINE_LENGTH) INDESCRIP
-
- CHARACTER FROM_TEST*5,INFROM*(LINE_LENGTH)
-
- EXTERNAL CLI$_NEGATED,CLI$_ABSENT
-
- MSG_OWN = .FALSE.
-
- IF (INCMD(:4).EQ.'REPLY') THEN
- BULL_PARAMETER = 'mailing list.'
- IF (CLI$PRESENT('ALL')) THEN
- BULL_PARAMETER = 'message owner and mailing list.'
- MSG_OWN = .TRUE.
- END IF
- ELSE IF (INCMD(:4).EQ.'RESP') THEN
- MSG_OWN = .TRUE.
- BULL_PARAMETER = 'message owner.'
- IF (CLI$PRESENT('LIST'))
- & BULL_PARAMETER = 'message owner and mailing list.'
- ELSE
- BULL_PARAMETER = 'mailing list.'
- END IF
-
- IF (MSG_OWN.AND.BTEST(CAPTIVE(),1)) THEN
- WRITE (6,'('' ERROR: MAIL invalid from DISMAIL account.'')')
- RETURN
- END IF
-
- WRITE (6,'('' Sending message to '',A)')
- & BULL_PARAMETER(:TRIM(BULL_PARAMETER))
-
- IF (INCMD(:4).NE.'POST') THEN
- IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read
- WRITE(6,'('' ERROR: You have not read any message.'')')
- RETURN ! And return
- END IF
-
- CALL OPEN_BULLDIR_SHARED
-
- CALL READDIR(BULL_POINT,IER) ! Get info for specified bulletin
-
- IF (IER.NE.BULL_POINT+1) THEN ! Was bulletin found?
- WRITE(6,'('' ERROR: Bulletin was not found.'')')
- CALL CLOSE_BULLDIR ! If not, then error out
- RETURN
- END IF
-
- CALL OPEN_BULLFIL_SHARED
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- INDESCRIP = INPUT(7:)
- ELSE
- INDESCRIP = DESCRIP
- END IF
-
- CALL CLOSE_BULLFIL
-
- CALL CLOSE_BULLDIR
-
- IF (STREQ(INDESCRIP(:3),'RE:')) THEN
- INDESCRIP = 'RE:'//INDESCRIP(4:)
- ELSE
- INDESCRIP = 'RE: '//INDESCRIP
- END IF
- END IF
-
- IF (CLI$PRESENT('SUBJECT')) THEN
- IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)
- IF (LENDES.GT.LEN(INDESCRIP)) THEN
- WRITE(6,'('' ERROR: Subject length exceeded.'')')
- RETURN
- END IF
- ELSE IF (INCMD(:4).EQ.'POST') THEN
- WRITE(6,'('' Enter subject of message:'')')
- CALL GET_LINE(INDESCRIP,LENDES)
- IF (LENDES.LE.0) THEN
- LENDES = 0
- WRITE(6,'('' ERROR: No subject specified.'')')
- RETURN
- END IF
- ELSE
- WRITE (6,'('' Message will have the subject:'')')
- WRITE (6,'(1X,A)') INDESCRIP(:MIN(TRIM(INDESCRIP),PAGE_WIDTH))
- END IF
-
- IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified
- & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN
- EDIT = .TRUE.
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- ELSE
- EDIT = .FALSE.
- END IF
-
- TEXT = CLI$PRESENT('EXTRACT')
-
- LIST = CLI$PRESENT('LIST')
-
- CALL DISABLE_PRIVS
-
- ILEN = 0
-
- FILESPEC = CLI$GET_VALUE('FILESPEC',INPUT,ILEN)
- IF (FILESPEC.NE.%LOC(CLI$_ABSENT)) THEN
- OPEN (UNIT=4,FILE=INPUT(:ILEN),STATUS='OLD',READONLY,
- & SHARED,IOSTAT=IER,FORM='FORMATTED')
- IF (IER.NE.0) FILESPEC = .FALSE.
- END IF
-
- IF (EDIT.AND.(TEXT.OR.FILESPEC)) THEN
- OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
-
- IF (IER.NE.0) THEN
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- GO TO 900
- END IF
- ELSE IF (TEXT.AND..NOT.EDIT) THEN
- WRITE (6,'('' ERROR: Cannot extract text without /EDIT.'')')
- GO TO 900
- END IF
-
- LENFRO = 0
- IF (CLI$GET_VALUE('CC',INPUT,ILEN)) THEN
- CALL ADD_PROTOCOL(INPUT,ILEN)
- INFROM = INPUT(:ILEN)
- LENFRO = ILEN
- IF (MSG_OWN) THEN
- INFROM = INFROM(:LENFRO)//','
- LENFRO = LENFRO + 1
- END IF
- END IF
-
- IF ((EDIT.AND.TEXT).OR.INCMD(:4).NE.'POST') THEN
- CALL ENABLE_PRIVS
- CALL OPEN_BULLFIL_SHARED
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- ILEN = TRIM(INPUT)
- IF (MSG_OWN) THEN
- CALL ADD_PROTOCOL(INPUT(7:),ILEN)
- INFROM = INFROM(:LENFRO)//INPUT(7:)
- LENFRO = LENFRO + ILEN - 6
- END IF
- IF (EDIT.AND.TEXT) THEN
- IF (INPUT(ILEN:ILEN).EQ.'"') ILEN = ILEN - 1
- INPUT = INPUT(7:ILEN)
- ILEN = ILEN - 6
- IF (INDEX(INPUT,'%"').GT.0) THEN
- INPUT = INPUT(INDEX(INPUT,'%"')+2:)
- ILEN = TRIM(INPUT)
- END IF
- WRITE (3,'(A)') 'In a previous article, '//
- & INPUT(:ILEN)//' wrote:'
- END IF
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- ELSE IF (MSG_OWN) THEN
- CALL ADD_PROTOCOL(FROM,0)
- INFROM = INFROM(:LENFRO)//FROM
- LENFRO = TRIM(FROM) + LENFRO
- END IF
-
- IF (EDIT.AND.TEXT) THEN
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- IF (CLI$PRESENT('NOINDENT')) THEN
- WRITE (3,'(A)') INPUT(:ILEN)
- ELSE
- WRITE (3,'(A)') '>'//INPUT(:ILEN)
- END IF
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END DO
-
- IF (FILESPEC) THEN
- WRITE (3,'(A)') ' '
- IER = 0
- DO WHILE (IER.EQ.0)
- READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- IF (IER.EQ.0) WRITE (3,'(A)') INPUT(:ILEN)
- END DO
- CLOSE (UNIT=4)
- FILESPEC = .FALSE.
- END IF
-
- CLOSE (UNIT=3) ! Bulletin copy completed
- END IF
-
- CALL CLOSE_BULLFIL
- CALL DISABLE_PRIVS
- END IF
-
- IF (EDIT.AND.FILESPEC.AND..NOT.TEXT) THEN
- IER = 0
- ICOUNT = 0
- DO WHILE (IER.EQ.0)
- READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- IF (IER.EQ.0) THEN
- WRITE (3,'(A)') INPUT(:ILEN)
- ICOUNT = ICOUNT + 1
- END IF
- END DO
- CLOSE (UNIT=4)
- FILESPEC = .FALSE.
- IF (ICOUNT.EQ.0) THEN
- CLOSE (UNIT=3,STATUS='DELETE')
- ELSE
- CLOSE (UNIT=3)
- END IF
- END IF
-
- IF (LIST.AND.REMOTE_SET.NE.3) THEN
- SLIST = INDEX(FOLDER_DESCRIP,'<')
- IF (SLIST.GT.0) THEN
- IF (REMOTE_SET.NE.4) THEN
- INPUT = FOLDER_DESCRIP(SLIST+1:)
- ILEN = INDEX(INPUT,'>') - 1
- IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)
- INPUT = INPUT(:ILEN)
- CALL ADD_PROTOCOL(INPUT,ILEN)
- IF (LENFRO.GT.0.AND.INFROM(LENFRO:LENFRO).NE.',') THEN
- INFROM = INFROM(:LENFRO)//','
- LENFRO = LENFRO + 1
- END IF
- INFROM = INFROM(:LENFRO)//INPUT(:ILEN)
- LENFRO = LENFRO + ILEN
- ELSE
- FOLDER1_DESCRIP =
- & FOLDER_DESCRIP(SLIST+1:TRIM(FOLDER_DESCRIP)-1)
- IF (FOLDER1_DESCRIP(1:1).EQ.'@') THEN
- WRITE(6,'('' ERROR: Multiple newsgroup feed'',
- & '' is present.'')')
- GO TO 900
- END IF
- END IF
- ELSE
- WRITE (6,'('' ERROR: No list address'',
- & '' found in folder description.'')')
- GO TO 900
- END IF
- END IF
-
- I = 1 ! Must change all " to "" in FROM field
- DO WHILE (I.LE.LENFRO)
- IF (INFROM(I:I).EQ.'"') THEN
- INFROM = INFROM(:I)//'"'//INFROM(I+1:)
- I = I + 1
- LENFRO = LENFRO + 1
- END IF
- I = I + 1
- END DO
-
- LENDES = TRIM(INDESCRIP)
- I = 1 ! Must change all " to "" in SUBJECT field
- DO WHILE (I.LE.LENDES)
- IF (INDESCRIP(I:I).EQ.'"') THEN
- IF (LENDES.EQ.LINE_LENGTH) THEN
- INDESCRIP(I:I) = '`'
- ELSE
- INDESCRIP = INDESCRIP(:I)//'"'
- & //INDESCRIP(I+1:)
- I = I + 1
- LENDES = LENDES + 1
- END IF
- END IF
- I = I + 1
- END DO
-
- STATUS = .TRUE.
-
- IF (EDIT) THEN
- CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
- CONTEXT = 0
- IER = LIB$FIND_FILE('SYS$LOGIN:BULL.SCR',INPUT,CONTEXT)
- IF (TEXT) THEN
- VERSION = INDEX(INPUT,';') + 1
- IF (INPUT(VERSION:VERSION).EQ.'1') THEN
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
- ELSE
- IER = 0
- END IF
- ELSE IF (IER) THEN
- IER = 0
- END IF
- IF (IER.EQ.0) THEN
- CALL ADD_SIGNATURE(0,'SYS$LOGIN:BULL.SCR',FOLDER_NAME)
- IF (REMOTE_SET.GE.3.AND.LIST) THEN
- CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.FALSE.,IER,
- & INDESCRIP)
- STATUS = IER.EQ.0
- IF (IER.EQ.0) THEN
- WRITE (6,'('' Message successfully posted.'')')
- END IF
- END IF
- IF (IER.EQ.0.AND.LENFRO.GT.0) THEN
- CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM(:LENFRO),
- & INDESCRIP(:LENDES),STATUS)
- END IF
- END IF
- ELSE
- OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
- IF (.NOT.FILESPEC) THEN
- WRITE (6,'('' Enter message: End with ctrl-z,'',
- & '' cancel with ctrl-c'')')
- ILEN = LINE_LENGTH + 1 ! Length of input line
- ICOUNT = 0 ! Character count counter
- DO WHILE (ILEN.GE.0) ! Input until no more input
- CALL GET_LINE(INPUT,ILEN) ! Get input line
- IF (ILEN.GT.LINE_LENGTH) THEN ! Input line too long
- WRITE(6,'('' ERROR: Input line length > '',I,
- & ''. Reinput:'')') LINE_LENGTH
- ELSE IF (ILEN.GE.0) THEN ! If good input line entered
- ICOUNT = ICOUNT + ILEN ! Update counter
- WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file
- END IF
- END DO
- ELSE
- IER = 0
- ICOUNT = 0
- DO WHILE (IER.EQ.0)
- READ (4,'(Q,A)',IOSTAT=IER) ILEN,INPUT
- IF (IER.EQ.0) THEN
- ICOUNT = ICOUNT + 1
- WRITE (3,'(A)') INPUT(:ILEN)
- END IF
- END DO
- CLOSE (UNIT=4)
- FILESPEC = .FALSE.
- END IF
- IF (ILEN.EQ.-1.OR.ICOUNT.EQ.0) THEN ! CTRL_C or No lines
- CLOSE (UNIT=3)
- IER = 1
- ELSE
- CALL ADD_SIGNATURE(3,' ',FOLDER_NAME)
- REWIND (UNIT=3)
- IF (REMOTE_SET.GE.3.AND.LIST) THEN
- CALL NEWS_POST('SYS$LOGIN:BULL.SCR',.TRUE.,IER,
- & INDESCRIP)
- STATUS = IER.EQ.0
- IF (IER.EQ.0) WRITE (6,'('' Message successfully posted.'')')
- ELSE
- IER = 0
- END IF
- CLOSE (UNIT=3)
- IF (IER.EQ.0.AND.LENFRO.GT.0) THEN
- CALL RESPOND_MAIL('SYS$LOGIN:BULL.SCR',INFROM(:LENFRO),
- & INDESCRIP(:LENDES),STATUS)
- END IF
- END IF
- END IF
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: No message added.'')')
- IF (.NOT.STATUS) THEN
- CALL GET_INPUT_PROMPT(INPUT,ILEN,'Do you want to'//
- & ' save message? (Y/N with N as default): ')
- IF (STREQ(INPUT(:1),'Y')) THEN
- CALL LIB$RENAME_FILE('SYS$LOGIN:BULL.SCR',
- & 'SYS$LOGIN:BULL.SAV')
- WRITE (6,'(A)') ' Message saved in SYS$LOGIN:BULL.SAV.'
- END IF
- END IF
- END IF
-
-900 CALL ENABLE_PRIVS
- IF (FILESPEC) CLOSE (UNIT=4)
- CALL LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;*')
-
- RETURN
- END
-
-
-
- SUBROUTINE ADD_SIGNATURE(FILEUNIT,FILENAME,FOLDER_NAME)
-C
-C SUBROUTINE ADD_SIGNATURE
-C
-C FUNCTION: Adds signature to message being mailed/posted.
-C
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) FOLDER_NAME
-
- CHARACTER*128 BULL_SIGNATURE
- DATA BULL_SIGNATURE /'SYS$LOGIN:BULL_SIGNATURE.TXT'/
-
- CHARACTER*255 INPUT
-
- OPEN (UNIT=4,FILE=BULL_SIGNATURE,STATUS='OLD',READONLY,
- & SHARED,IOSTAT=IER,FORM='FORMATTED')
-
- IF (IER.NE.0) THEN
- OPEN (UNIT=4,FILE='BULL_SIGNATURE',STATUS='OLD',READONLY,
- & SHARED,IOSTAT=IER,FORM='FORMATTED')
- END IF
-
- IF (IER.NE.0) RETURN
-
- IF (FILEUNIT.EQ.0) THEN
- OPEN (UNIT=3,FILE=FILENAME,STATUS='OLD',ACCESS='APPEND',
- & IOSTAT=IER,FORM='FORMATTED')
- END IF
-
- ICOUNT = 0
- MATCH = .FALSE.
- DO WHILE (IER.EQ.0)
- READ (4,'(A)',IOSTAT=IER) INPUT
- ILEN = TRIM(INPUT)
- DO WHILE (.NOT.MATCH.AND.STREQ(INPUT(:6),'START ').AND.IER.EQ.0)
- MATCH = STREQ(INPUT(7:ILEN),FOLDER_NAME(:TRIM(FOLDER_NAME)))
- READ (4,'(A)',IOSTAT=IER) INPUT
- ILEN = TRIM(INPUT)
- IF (.NOT.MATCH) THEN
- DO WHILE (.NOT.STREQ(INPUT(:ILEN),'END').AND.IER.EQ.0)
- READ (4,'(A)',IOSTAT=IER) INPUT
- ILEN = TRIM(INPUT)
- END DO
- READ (4,'(A)',IOSTAT=IER) INPUT
- ILEN = TRIM(INPUT)
- END IF
- END DO
- IF (IER.EQ.0) THEN
- IF (MATCH.AND.STREQ(INPUT(:ILEN),'END')) THEN
- MATCH = .FALSE.
- ELSE
- ICOUNT = ICOUNT + 1
- IF (ICOUNT.EQ.1) WRITE (3,'(A)',IOSTAT=IER) ' '
- WRITE (3,'(A)',IOSTAT=IER) INPUT(:ILEN)
- END IF
- END IF
- END DO
-
- CLOSE (UNIT=4)
- IF (FILEUNIT.EQ.0) CLOSE (UNIT=3)
-
- RETURN
- END
-
-
-
-
- LOGICAL FUNCTION STREQ(INPUT,INPUT1)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INPUT,INPUT1
-
- STREQ = .FALSE.
-
- IF (LEN(INPUT).NE.LEN(INPUT1)) RETURN
-
- DO I=1,LEN(INPUT)
- DIFF = ABS(ICHAR(INPUT(I:I))-ICHAR(INPUT1(I:I)))
- IF (DIFF.NE.0.AND.DIFF.NE.32) RETURN
- END DO
-
- STREQ = .TRUE.
-
- RETURN
- END
-
-
-
-
-
-
- SUBROUTINE RESPOND_MAIL(FILE,SENDTO,SUBJECT,STATUS)
-C
-C SUBROUTINE RESPOND_MAIL
-C
-C FUNCTION: Sends mail to address.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- CHARACTER*(*) FILE,SENDTO,SUBJECT
-
- CHARACTER MAILER*128
-
- LISTSERV = INDEX(FOLDER_DESCRIP,'LISTSERV').GT.0
-
- IF (LISTSERV) THEN
- CALL SETUSER(FOLDER_BBOARD)
- IF (SYS_TRNLNM('MX_NODE_NAME',MAILER)) THEN
- REPLY_TO = .NOT.SYS_TRNLNM('MX_REPLY_TO',MAILER)
- IF (REPLY_TO) IER = LIB$SET_LOGICAL
- & ('MX_REPLY_TO',USERNAME(:TRIM(USERNAME)))
- ELSE
- REPLY_TO = .NOT.SYS_TRNLNM('PMDF_REPLY_TO',MAILER)
- IF (REPLY_TO) IER = LIB$SET_LOGICAL
- & ('PMDF_REPLY_TO',USERNAME(:TRIM(USERNAME)))
- END IF
- END IF
-
- IF (SYS_TRNLNM('BULL_MAILER',MAILER)) THEN
- IF (LISTSERV) THEN
- IF (SYS_TRNLNM_SYSTEM('BULL_MAILER',MAILER)) THEN
- CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))//
- & ' SYS$LOGIN:BULL.SCR """'//SENDTO//'""" """'
- & //SUBJECT//'""" '
- & //USERNAME(:TRIM(USERNAME)),,,,,,STATUS)
- END IF
- ELSE
- CALL LIB$SPAWN('@'//MAILER(:TRIM(MAILER))//
- & ' SYS$LOGIN:BULL.SCR """'//SENDTO//
- & '""" """'//SUBJECT//'"""',,,,,,STATUS)
- END IF
- ELSE
- CALL LIB$SPAWN('$MAIL SYS$LOGIN:BULL.SCR "'//SENDTO//
- & '" /SUBJECT="'//SUBJECT//'"',,,,,,STATUS)
- END IF
-
- IF (LISTSERV) THEN
- CALL SETUSER(USERNAME)
- IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('PMDF_REPLY_TO')
- IF (REPLY_TO) IER = LIB$DELETE_LOGICAL('MX_REPLY_TO')
- END IF
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION CONFIRM_USER(USERNAME)
-C
-C FUNCTION CONFIRM_USER
-C
-C FUNCTION: Confirms that username is valid user.
-C
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) USERNAME
-
- CALL OPEN_SYSUAF_SHARED
-
- READ (8,KEY=USERNAME,IOSTAT=CONFIRM_USER)
-
- CALL CLOSE_SYSUAF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE REPLACE
-C
-C SUBROUTINE REPLACE
-C
-C FUNCTION: CHANGE command subroutine.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /EDIT/ EDIT_DEFAULT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /LAST_RECORD_WRITTEN/ OCOUNT
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- CHARACTER INEXDATE*11,INEXTIME*11
- CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH)
- CHARACTER*1 ANSWER
-
- CHARACTER DATE_SAVE*11,TIME_SAVE*11
-
- INTEGER TIMADR(2)
-
- EXTERNAL CLI$_ABSENT,CLI$_NEGATED
-
- LOGICAL*1 DOALL
-
- IF (REMOTE_SET.EQ.3) THEN
- WRITE (6,'('' Cannot CHANGE messages in this folder.'')')
- RETURN
- END IF
-
-C
-C Get the bulletin number to be replaced.
-C
-
- ALL = CLI$PRESENT('ALL')
-
- IER1 = CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER1.EQ.%LOC(CLI$_ABSENT).AND..NOT.ALL) THEN
- IF (BULL_POINT.EQ.0) THEN ! If no bulletin has been read
- WRITE (6,1005) ! Tell user of the error
- RETURN ! and return
- END IF
- SBULL = BULL_POINT ! Replace the bulletin we are reading
- EBULL = SBULL
-
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR(BULL_POINT,IER) ! Get message directory entry
- CALL CLOSE_BULLDIR
- IF (IER.NE.BULL_POINT+1) THEN ! Was message found?
- WRITE(6,'('' ERROR: Specified message was not found.'')')
- RETURN
- END IF
- ELSE
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR(0,IER) ! Get message directory entry
- CALL CLOSE_BULLDIR
- IF (NBULL.EQ.0) THEN ! Were messages found?
- WRITE(6,'('' ERROR: No messages were found.'')')
- RETURN
- END IF
-
- IF (IER1.NE.%LOC(CLI$_ABSENT)) THEN
- CALL GET_2_VALS(BULL_PARAMETER,LEN_P,SBULL,EBULL,IER1)
- IF (SBULL.LE.0.OR.IER1.NE.0) THEN
- WRITE (6,'(A)')
- & ' ERROR: Specified message number has incorrect format.'
- RETURN
- END IF
- ALL = .TRUE.
- ELSE IF (CLI$PRESENT('ALL')) THEN
- SBULL = 1
- EBULL = NBULL
- END IF
- END IF
-
- IF (CLI$PRESENT('SYSTEM')) THEN
- IF (.NOT.SETPRV_PRIV()) THEN
- WRITE (6,'(
- & '' ERROR: Not enough privileges to change to system.'')')
- RETURN
- ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN
- WRITE (6,'(
- & '' ERROR: /SYSTEM cannot be set with selected folder.'')')
- RETURN
- END IF
- END IF
-
- IF (CLI$PRESENT('SHUTDOWN')) THEN
- IF (.NOT.SETPRV_PRIV()) THEN
- WRITE (6,'(
- & '' ERROR: Not enough privileges to change to shutdown.'')')
- RETURN
- ELSE IF (.NOT.BTEST(FOLDER_FLAG,2).AND.FOLDER_NUMBER.NE.0) THEN
- WRITE (6,'(
- & '' ERROR: /SHUTDOWN cannot be set with selected folder.'')')
- RETURN
- ELSE IF (CLI$GET_VALUE('SHUTDOWN',BULL_PARAMETER).NE.
- & %LOC(CLI$_ABSENT).AND.REMOTE_SET) THEN
- WRITE (6,'('' ERROR: Shutdown node name not'',
- & '' permitted for remote folder.'')')
- RETURN
- END IF
- END IF
-
- IF (CLI$PRESENT('PERMANENT').AND.
- & F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present
- & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- WRITE (6,'(
- & '' ERROR: Not enough privileges to change to permanent.'')')
- RETURN
- END IF
-C
-C Check to see if specified bulletin is present, and if the user
-C is permitted to replace the bulletin.
-C
-
- CALL OPEN_BULLDIR_SHARED
-
- SAME_OWNER = .TRUE.
- DO I=SBULL,EBULL
- CALL READDIR(I,IER) ! Get info for specified messages
- IF (USERNAME.NE.FROM) SAME_OWNER = .FALSE.
- END DO
- CALL READDIR(SBULL,IER)
-
- CALL CLOSE_BULLDIR
-
- IF (.NOT.SAME_OWNER) THEN ! If doesn't match owner of bulletin,
- IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or
- & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)
- & .AND.FOLDER_SET)) THEN ! folder owner?
- WRITE(6,1090) ! If not, then error out.
- RETURN
- ELSE
- WRITE (6,1100) ! Make sure user wants to delete it
- READ (5,'(A)',IOSTAT=IER) ANSWER ! Get his answer
- CALL STR$UPCASE(ANSWER,ANSWER) ! Convert input to uppercase
- IF (ANSWER.NE.'Y') RETURN ! If not Yes, then exit
- END IF
- END IF
-
-C
-C If no switches were given, replace the full bulletin
-C
-
- DOALL = .FALSE.
-
- TEXT = CLI$PRESENT('TEXT')
-
- IF ((.NOT.CLI$PRESENT('EXPIRATION')).AND.
- & (.NOT.CLI$PRESENT('GENERAL')).AND.
- & (.NOT.CLI$PRESENT('SYSTEM')).AND.
- & (.NOT.CLI$PRESENT('HEADER')).AND.
- & (.NOT.CLI$PRESENT('SUBJECT')).AND.
- & (.NOT.TEXT).AND.
- & (.NOT.CLI$PRESENT('SHUTDOWN')).AND.
- & (.NOT.CLI$PRESENT('PERMANENT'))) THEN
- DOALL = .TRUE.
- END IF
-
- IF (SBULL.NE.EBULL.AND.(DOALL.OR.TEXT)) THEN
- WRITE (6,'('' ERROR: Cannot change text when replacing'',
- & '' more than one messsage.'')')
- RETURN
- END IF
-
- CALL DISABLE_CTRL ! Disable CTRL-Y & -C
-
- PERMANENT = .FALSE.
- IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN
- SYSTEM = 0
- CALL GET_EXPIRED(INPUT,IER)
- PERMANENT = BTEST(SYSTEM,1)
- IF (.NOT.IER) GO TO 910
- INEXDATE = INPUT(:11)
- INEXTIME = INPUT(13:)
- END IF
-
-8 LENDES = 0
- IF (CLI$PRESENT('HEADER').OR.DOALL) THEN
- WRITE(6,1050) ! Request header for bulletin
- READ(5,'(Q,A)',END=910,ERR=910) LENDES,INDESCRIP
- IF (LENDES.EQ.0) GO TO 910 ! If no header, don't add bull
- ELSE IF (CLI$PRESENT('SUBJECT')) THEN
- IER = CLI$GET_VALUE('SUBJECT',INDESCRIP,LENDES)
- END IF
-
- IF (LENDES.GT.0) THEN
- INDESCRIP = 'Subj: '//INDESCRIP
- LENDES = MIN(LENDES+6,LEN(INDESCRIP))
- END IF
-
- IF (SBULL.NE.EBULL) CALL OPEN_BULLDIR
-
- DO NUMBER=SBULL,EBULL
- NUMBER_PARAM = NUMBER
- IF (SBULL.NE.EBULL) THEN
- CALL READDIR(NUMBER_PARAM,IER)
- IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message
- CALL CLOSE_BULLDIR
- WRITE(6,'('' ERROR: Message '',I6,'' cannot be found.'')')
- & NUMBER_PARAM
- WRITE(6,'('' All messages up to that message were modified.'')')
- RETURN
- END IF
- END IF
-
- REC1 = 0
-
- LENFROM = 0
-
- IF (LENDES.GT.0.OR.TEXT.OR.DOALL) THEN
- OPEN(UNIT=3,FILE='SYS$LOGIN:BULL.SCR',IOSTAT=IER,
- & RECL=LINE_LENGTH,STATUS='SCRATCH',CARRIAGECONTROL='LIST')
-
- IF (IER.NE.0) THEN
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- GO TO 910
- END IF
-
- CALL OPEN_BULLFIL_SHARED
-
- REC1 = 1
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- INFROM = INPUT(:ILEN)
- LENFROM = ILEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- IF (LENDES.EQ.0.AND..NOT.DOALL) THEN
- INDESCRIP = INPUT(:ILEN)
- LENDES = ILEN
- END IF
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0) ! Copy bulletin into file
- WRITE (3,'(A)') INPUT(:ILEN)
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END DO
-
- CALL CLOSE_BULLFIL
-
- IF (TEXT.OR.DOALL) CLOSE(UNIT=3)
- END IF
-
- IF (TEXT.OR.DOALL) THEN
-C
-C If file specified in REPLACE command, read file to obtain bulletin.
-C Else, read the bulletin from the terminal.
-C
-
- ICOUNT = 0 ! Line count for bulletin
- LAST_NOBLANK = 0 ! Last line with data
- REC1 = 1
-
- IER = CLI$GET_VALUE('FILESPEC',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT).OR. ! If file param in ADD command
- & ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! or /EDIT specified
- & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED)))) THEN
-
- IF ((CLI$PRESENT('EDIT').OR.EDIT_DEFAULT).AND. ! If /EDIT specified
- & (CLI$PRESENT('EDIT').NE.%LOC(CLI$_NEGATED))) THEN
- IF (LEN_P.EQ.0) THEN ! If no file param specified
- IF (.NOT.CLI$PRESENT('NEW')) THEN
- OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='NEW',
- & RECL=LINE_LENGTH,
- & ERR=920,FORM='FORMATTED',CARRIAGECONTROL='LIST')
- CALL OPEN_BULLFIL_SHARED ! Prepare to copy message
- ILEN = LINE_LENGTH + 1
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END IF
- DO WHILE (ILEN.GT.0) ! Copy message into file
- WRITE (3,'(A)') INPUT(:ILEN)
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- END DO
- CALL CLOSE_BULLFIL
- CLOSE (UNIT=3) ! Bulletin copy completed
- END IF
- CALL MAILEDIT('SYS$LOGIN:BULL.SCR',' ')
- ELSE
- CALL DISABLE_PRIVS
- CALL MAILEDIT(BULL_PARAMETER(:LEN_P),'SYS$LOGIN:BULL.SCR')
- END IF
- IER = LIB$DELETE_FILE('SYS$LOGIN:BULL.SCR;-1')
- OPEN (UNIT=3,FILE='SYS$LOGIN:BULL.SCR',STATUS='OLD',
- & DISPOSE='DELETE',ERR=920,FORM='FORMATTED')
- ELSE IF (LEN_P.GT.0) THEN
- CALL DISABLE_PRIVS
- OPEN (UNIT=3,FILE=BULL_PARAMETER(:LEN_P),STATUS='OLD',
- & READONLY,SHARED,ERR=920,FORM='FORMATTED') ! Try opening the file
- END IF
-
- CALL ENABLE_PRIVS ! Reset SYSPRV privileges
-
- DO WHILE(1) ! Read until end of file to
- READ (3,'(Q,A)',END=10) ILEN,INPUT ! get record count
- IF (ILEN.GT.LINE_LENGTH) GO TO 950
- CALL STR$TRIM(INPUT,INPUT,ILEN)
- IF (ILEN.GT.0) THEN ! If good input line entered
- ICOUNT = ICOUNT + ILEN + 1 ! Increment record count
- LAST_NOBLANK = ICOUNT
- ELSE IF (ILEN.EQ.0) THEN
- IF (ICOUNT.GT.0) THEN
- ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with
- ELSE ! 1 space for a blank line.
- REC1 = REC1 + 1
- END IF
- END IF
- END DO
- ELSE ! If no input file
- OPEN (UNIT=3,STATUS='NEW',FILE='SYS$LOGIN:BULL.SCR',ERR=920,
- & DISPOSE='DELETE',FORM='FORMATTED',RECL=LINE_LENGTH,
- & CARRIAGECONTROL='LIST') ! Scratch file to save bulletin
- WRITE (6,1000) ! Request bulletin input from terminal
- ILEN = LINE_LENGTH ! Length of input line
- DO WHILE (ILEN.GE.0) ! Input until no more input
- CALL GET_LINE(INPUT,ILEN) ! Get input line
- IF (ILEN.GT.LINE_LENGTH) THEN ! Line too long.
- WRITE(6,'('' ERROR: Input line length > '',I,
- & ''. Reinput::'')') LINE_LENGTH
- ELSE IF (ILEN.GT.0) THEN ! If good input line entered
- ICOUNT = ICOUNT + 1 + ILEN ! Increment character count
- WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file
- LAST_NOBLANK = ICOUNT
- ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.0) THEN
- WRITE(3,'(A)') INPUT(:ILEN) ! Save line in scratch file
- ICOUNT = ICOUNT + 2 ! COPY_BULL writes a line with
- END IF ! 1 space for a blank line.
- END DO
- IF (ILEN.EQ.-1) GO TO 910 ! CTRL_C entered, error out
-10 ICOUNT = LAST_NOBLANK
- IF (ICOUNT.EQ.0) GO TO 910 ! No lines entered, error out
- ENDIF
-
- END IF
-
-C
-C Add bulletin to bulletin file and directory entry for to directory file.
-C
-
- DATE_SAVE = DATE
- TIME_SAVE = TIME
- INPUT = DESCRIP
-
- IF (SBULL.EQ.EBULL) THEN
- CALL OPEN_BULLDIR ! Prepare to add dir entry
- CALL READDIR(NUMBER_PARAM,IER) ! Get info for message
-
- IF (IER.NE.NUMBER_PARAM+1.OR.DATE.NE.DATE_SAVE.OR.
- & TIME.NE.TIME_SAVE.OR.INPUT.NE.DESCRIP) THEN
- ! If message disappeared, try to find it.
- IF (IER.NE.NUMBER_PARAM+1) DATE = ' '
- NUMBER_PARAM = 0
- IER = 1
- DO WHILE (IER.EQ.NUMBER_PARAM+1.AND.
- & (DATE.NE.DATE_SAVE.OR.TIME.NE.TIME_SAVE.OR.DESCRIP.NE.INPUT))
- NUMBER_PARAM = NUMBER_PARAM + 1
- CALL READDIR(NUMBER_PARAM,IER)
- END DO
-
- IF (IER.NE.NUMBER_PARAM+1) THEN ! Couldn't find message
- CALL CLOSE_BULLDIR
- CLOSE (UNIT=3,STATUS='SAVE')
- WRITE(6,'('' ERROR: Message has been deleted'',
- & '' by another user.'')')
- IF (DOALL.OR.TEXT) THEN
- WRITE (6,'('' New text has been saved in'',
- & '' SYS$LOGIN:BULL.SCR.'')')
- END IF
- GO TO 100
- END IF
- END IF
- END IF
-
- CALL READDIR(0,IER) ! Get directory header
-
- IF (REC1.GT.0) THEN ! If text has been replaced
-
- CALL OPEN_BULLFIL ! Prepare to add bulletin
-
- BLOCK = NBLOCK + 1
- BLOCK_SAVE = BLOCK
- NEMPTY = NEMPTY + LENGTH
-
- OBLOCK = BLOCK
- IF (LENFROM.GT.0) THEN
- CALL STORE_BULL(LENFROM,INFROM(:LENFROM),OBLOCK)
- END IF
- IF (LENDES.GT.0) THEN
- CALL STORE_BULL(LENDES,INDESCRIP(:LENDES),OBLOCK)
- END IF
- REWIND (UNIT=3)
- CALL COPY_BULL(3,REC1,OBLOCK,IER) ! Add the new bulletin
- IF (IER.NE.0) THEN ! Error in creating bulletin
- WRITE (6,'(A)') ' ERROR: Unable to replace message.'
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- CLOSE (UNIT=3)
- GO TO 100
- END IF
-
- LENGTH_SAVE = OCOUNT - BLOCK + 1
- NBLOCK = NBLOCK + LENGTH_SAVE
-
- IF (.NOT.REMOTE_SET) CALL WRITEDIR(0,IER)
-
- CALL CLOSE_BULLFIL
-
- IF (.NOT.REMOTE_SET) THEN
- CALL READDIR(NUMBER_PARAM,IER) ! Get directory entry
- LENGTH = LENGTH_SAVE ! Update size
- BLOCK = BLOCK_SAVE
- CALL WRITEDIR(NUMBER_PARAM,IER) ! Write new directory entry
- END IF
- ELSE
- CALL READDIR(NUMBER_PARAM,IER)
- END IF
-
- IF (.NOT.REMOTE_SET) THEN
-
- IF (LENDES.GT.0.OR.DOALL) THEN
- DESCRIP=INDESCRIP(7:59) ! Update description header
- END IF
- CALL UPDATE_DIR_HEADER((CLI$PRESENT('EXPIRATION').OR.DOALL).AND.
- & .NOT.PERMANENT,CLI$PRESENT('PERMANENT').OR.PERMANENT,
- & CLI$PRESENT('SHUTDOWN'),INEXDATE,INEXTIME)
- IF (CLI$PRESENT('SYSTEM')) THEN
- SYSTEM = IBSET(SYSTEM,0)
- ELSE IF (CLI$PRESENT('GENERAL')) THEN
- SYSTEM = IBCLR(SYSTEM,0)
- END IF
- CALL WRITEDIR(NUMBER_PARAM,IER)
- ELSE
- MSGTYPE = 0
- IF (CLI$PRESENT('SYSTEM').OR.
- & (BTEST(SYSTEM,0).AND..NOT.CLI$PRESENT('GENERAL'))) THEN
- MSGTYPE = IBSET(MSGTYPE,0)
- END IF
- IF (CLI$PRESENT('PERMANENT').OR.PERMANENT) THEN
- MSGTYPE = IBSET(MSGTYPE,1)
- ELSE IF (CLI$PRESENT('SHUTDOWN')) THEN
- MSGTYPE = IBSET(MSGTYPE,2)
- ELSE IF ((CLI$PRESENT('EXPIRATION').OR.DOALL)
- & .AND..NOT.PERMANENT) THEN
- MSGTYPE = IBSET(MSGTYPE,3)
- END IF
- IF (LENDES.EQ.0.AND..NOT.DOALL) INDESCRIP(7:) = DESCRIP
- IF (CLI$PRESENT('EXPIRATION').OR.DOALL) THEN
- EXDATE = INEXDATE
- EXTIME = INEXTIME
- END IF
- WRITE (REMOTE_UNIT,'(7A)',IOSTAT=IER)
- & 10,DESCRIP,NUMBER_PARAM,INDESCRIP(7:59),MSGTYPE,
- & EXDATE,EXTIME
- IF (IER.EQ.0) THEN
- READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM
- END IF
- IF (IER.EQ.0) THEN
- IF (I.NE.LEN(FOLDER1_COM)) THEN
- WRITE (6,'(1X,A)') FOLDER1_COM(:I)
- END IF
- ELSE
- CALL DISCONNECT_REMOTE
- END IF
- END IF
- END DO
-
- CALL CLOSE_BULLDIR ! Totally finished with replace
-
- CLOSE (UNIT=3)
-
-100 CALL ENABLE_CTRL ! Enable CTRL-Y & -C
- RETURN
-
-910 WRITE(6,1010)
- CLOSE (UNIT=3,ERR=100)
- GOTO 100
-
-920 WRITE(6,1020)
- CALL ENABLE_PRIVS ! Reset SYSPRV privileges
- GOTO 100
-
-950 WRITE (6,1030) LINE_LENGTH
- CLOSE (UNIT=3)
- GO TO 100
-
-1000 FORMAT (' Enter message: End with ctrl-z, cancel with ctrl-c')
-1005 FORMAT (' ERROR: You are not reading any message.')
-1010 FORMAT (' No message was replaced.')
-1015 FORMAT (' ERROR: Specified message was not found.')
-1020 FORMAT (' ERROR: Unable to open specified file.')
-1030 FORMAT (' ERROR: Line length in file exceeds '',I,'' characters.')
-1050 FORMAT (' Enter description header.')
-1090 FORMAT(' ERROR: Specified message is not owned by you.')
-1100 FORMAT(' Message(s) is not owned by you.',
- & ' Are you sure you want to replace it? ',$)
-2020 FORMAT(1X,A)
-
- END
-
-
-
- SUBROUTINE UPDATE_DIR_HEADER(EXPIRE,PERM,SHUT,INEXDATE,INEXTIME)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- EXTERNAL CLI$_ABSENT
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- CHARACTER TODAY*23,INEXDATE*11,INEXTIME*11
-
- IF (EXPIRE) THEN
- SYSTEM = IBCLR(SYSTEM,1)
- SYSTEM = IBCLR(SYSTEM,2)
- EXDATE=INEXDATE ! Update expiration date
- EXTIME=INEXTIME
- DIFF = COMPARE_DATE(EXDATE,NEWEST_EXDATE) ! Compare expiration
- IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,NEWEST_EXTIME)
- IF (DIFF.LT.0) THEN ! If it's oldest expiration bull
- NEWEST_EXDATE = EXDATE ! Update the header in
- NEWEST_EXTIME = EXTIME ! the directory file
- CALL WRITEDIR(0,IER)
- END IF
- ELSE IF (PERM.AND.(.NOT.BTEST(SYSTEM,1))) THEN
- IF (BTEST(SYSTEM,2)) THEN
- SYSTEM = IBCLR(SYSTEM,2)
- SHUTDOWN = SHUTDOWN - 1
- CALL WRITEDIR(0,IER)
- END IF
- SYSTEM = IBSET(SYSTEM,1)
- EXDATE = '5-NOV-2000'
- EXTIME = '00:00:00.00'
- ELSE IF (SHUT.AND.(.NOT.BTEST(SYSTEM,2))) THEN
- SYSTEM = IBSET(SYSTEM,2)
- SYSTEM = IBCLR(SYSTEM,1)
- EXDATE = '5-NOV-2000'
- NODE_AREA = 0
- IF (INCMD(:4).EQ.'REPL') THEN
- IF (CLI$GET_VALUE('SHUTDOWN',NODE_NAME)
- & .NE.%LOC(CLI$_ABSENT)) THEN
- CALL GET_NODE_NUMBER_OTHER(NODE_NUMBER,NODE_AREA,NODE_NAME)
- IF (NODE_AREA.EQ.0) THEN
- WRITE (6,'('' ERROR: Shutdown node name ignored.'',
- & '' Invalid node name specified.'')')
- END IF
- END IF
- END IF
- IF (NODE_AREA.EQ.0) CALL GET_NODE_NUMBER(NODE_NUMBER,NODE_AREA)
- WRITE (EXTIME,'(I4)') NODE_NUMBER
- WRITE (EXTIME(7:),'(I4)') NODE_AREA
- DO I=1,11
- IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'
- END DO
- EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//
- & EXTIME(7:8)//'.'//EXTIME(9:10)
- SHUTDOWN = SHUTDOWN + 1
- CALL SYS$ASCTIM(,TODAY,,) ! Get the present time
- SHUTDOWN_DATE = TODAY(:11)
- SHUTDOWN_TIME = TODAY(13:)
- CALL WRITEDIR(0,IER)
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SEARCH(READ_COUNT)
-C
-C SUBROUTINE SEARCH
-C
-C FUNCTION: Search for bulletin with specified string
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- CHARACTER*132 SEARCH_STRING
-
- EXTERNAL CLI$_ABSENT
-
- IF (INCMD.NE.'SEAR') NFOLDER = 1
-
- IF (CLI$PRESENT('SELECT_FOLDER')) THEN
- CALL INIT_QUEUE(SCRATCH_F1,FOLDER1_NAME)
- SCRATCH_F = SCRATCH_F1
- NFOLDER = 0
- END IF
-
- DO WHILE (CLI$GET_VALUE('SELECT_FOLDER',FOLDER1_NAME)
- & .NE.%LOC(CLI$_ABSENT)) ! Get the specified folders
- IF (TRIM(FOLDER1_NAME).EQ.0) FOLDER1_NAME = FOLDER_NAME
- NFOLDER = NFOLDER + 1
- CALL WRITE_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME)
- END DO
-
- IF (CLI$PRESENT('SELECT_FOLDER')) SCRATCH_F = SCRATCH_F1
-
- START_BULL = BULL_POINT
-
- IF (CLI$PRESENT('START')) THEN ! Starting message specified
- CALL CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) START_BULL
- IF (.NOT.CLI$PRESENT('REPLY')) START_BULL = START_BULL - 1
- END IF
-
- IER = CLI$GET_VALUE('SEARCH_STRING',SEARCH_STRING,SEARCH_LEN)
-
- IF (NFOLDER.GT.0) FOUND = 0
-
- DO WHILE (NFOLDER.GT.0.AND.FOUND.LE.0)
- IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR.
- & SCRATCH_F.NE.SCRATCH_F1)
- & CALL GET_SEARCH(FOUND,SEARCH_STRING,START_BULL,
- & CLI$PRESENT('REVERSE'),CLI$PRESENT('SUBJECT'),
- & CLI$PRESENT('REPLY'),.TRUE.,CLI$PRESENT('START'))
- IF (FOUND.EQ.-1) THEN
- NFOLDER = 0
- ELSE IF (FOUND.LE.0) THEN
- IF (.NOT.CLI$PRESENT('SELECT_FOLDER').OR.
- & SCRATCH_F.NE.SCRATCH_F1) NFOLDER = NFOLDER - 1
- IF (NFOLDER.GT.0) THEN
- CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,FOLDER1_NAME)
- OLD_FOLDER_NUMBER = FOLDER_NUMBER
- FOLDER_NUMBER = -1
- IER = 0
- DO WHILE (.NOT.IER.AND.NFOLDER.GT.0)
- FOLDER1 = FOLDER1_NAME
- CALL SELECT_FOLDER(.FALSE.,IER)
- IF (.NOT.IER) THEN
- FOLDER_NUMBER = OLD_FOLDER_NUMBER
- WRITE (6,'('' ERROR: Cannot find folder '',A,
- & ''.'')') FOLDER1_NAME(:TRIM(FOLDER1_NAME))
- CALL GET_INPUT_PROMPT(FOLDER1_NAME,ILEN,
- & 'Type new folder name or hit RETURN to continue: ')
- IF (ILEN.LE.0.AND.NFOLDER.GT.0) THEN
- NFOLDER = NFOLDER - 1
- CALL READ_QUEUE(%VAL(SCRATCH_F),SCRATCH_F,
- & FOLDER1_NAME)
- END IF
- END IF
- END DO
- END IF
- END IF
- END DO
-
- IF (FOUND.GT.0) THEN
- BULL_POINT = FOUND - 1
- CALL READ_MSG(READ_COUNT,BULL_POINT+1) ! Read next bulletin
- ELSE IF (FOUND.EQ.0) THEN
- WRITE (6,'('' No messages found with given search string.'')')
- ELSE IF (FOUND.EQ.-2) THEN
- WRITE (6,'('' ERROR: No more messages.'')')
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_SEARCH(FOUND,SEARCH_STRING,START_BULL,REVERSE,
- & SUBJECT,REPLY,FILES,START)
-C
-C SUBROUTINE GET_SEARCH
-C
-C FUNCTION: Search for bulletin with specified string
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /TAGS/ BULL_TAG,READ_TAG,BULL_NEWS_TAG
-
- COMMON /CTRLC_FLAG/ FLAG
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /NEXT/ NEXT
-
- CHARACTER*(*) SEARCH_STRING
-
- CHARACTER*132 SAVE_STRING
- DATA SAVE_STRING/' '/
-
- CHARACTER*53 DESCRIP1
-
- FOUND = -1
-
- CALL DISABLE_CTRL
-
- CALL DECLARE_CTRLC_AST
-
- IF (TRIM(SEARCH_STRING).EQ.0) THEN
- IER1 = .FALSE.
- ELSE
- IER1 = .TRUE.
- END IF
-
- IF (.NOT.IER1.AND..NOT.REPLY.AND.
- & (SUBJECT.OR.SEARCH_MODE.NE.1)) THEN
- ! If no search string entered
- SEARCH_STRING = SAVE_STRING ! use saved search string
- IF (TRIM(SAVE_STRING).EQ.0) THEN
- WRITE (6,'('' No search string present.'')')
- CALL CANCEL_CTRLC_AST
- CALL ENABLE_CTRL
- RETURN
- END IF
- IF (STEP_BULL.EQ.-1) START_BULL = START_BULL - 2
- ELSE IF (.NOT.IER1.AND.SEARCH_MODE.EQ.1) THEN
- SEARCH_STRING = SAVE_STRING ! use saved search string
- END IF
-
- IF (FILES) CALL OPEN_BULLDIR_SHARED
-
- CALL READDIR(0,IER)
-
- OLD_SEARCH_MODE = SEARCH_MODE
- IF (IER1) THEN ! If string entered
- IF (SUBJECT) THEN
- SEARCH_MODE = 3
- ELSE
- SEARCH_MODE = 2
- END IF
- ELSE IF (SUBJECT.AND.SEARCH_MODE.NE.3) THEN
- SEARCH_MODE = 3
- ELSE IF (REPLY) THEN
- CALL READDIR(START_BULL,IER)
- IF (START_BULL+1.NE.IER) THEN
- WRITE (6,'('' ERROR: No message being read.'')')
- IF (FILES) CALL CLOSE_BULLDIR
- CALL CANCEL_CTRLC_AST
- CALL ENABLE_CTRL
- RETURN
- ELSE
- SEARCH_MODE = 1
- SEARCH_STRING = DESCRIP
- IF (REVERSE) START_BULL = START_BULL - 2
- END IF
- END IF
-
- SAVE_STRING = SEARCH_STRING
- SEARCH_LEN = TRIM(SAVE_STRING)
-
- CALL STR$UPCASE(SEARCH_STRING,SEARCH_STRING) ! Make upper case
-
- IF (IER1.OR.SEARCH_MODE.NE.OLD_SEARCH_MODE.OR.
- & REVERSE.OR.REPLY) THEN
- IF (.NOT.START.AND.SEARCH_MODE.NE.1) THEN
- START_BULL = 0 ! If starting message not specified, use first
- IF (REVERSE) START_BULL = NBULL - 1 ! or last
- END IF
- IF (REVERSE) THEN
- END_BULL = 1
- STEP_BULL = -1
- ELSE
- END_BULL = NBULL
- STEP_BULL = 1
- END IF
- END IF
-
- IF ((START_BULL+1.GT.NBULL.AND.STEP_BULL.EQ.1).OR.
- & (START_BULL+1.EQ.0)) THEN
- FOUND = -2
- IF (FILES) CALL CLOSE_BULLDIR
- CALL CANCEL_CTRLC_AST
- CALL ENABLE_CTRL
- RETURN
- END IF
-
- IF (FILES) CALL OPEN_BULLFIL_SHARED
-
- SAVE_BULL_SEARCH = 0
- DO BULL_SEARCH = START_BULL+1, END_BULL, STEP_BULL
- CALL READDIR(BULL_SEARCH,IER) ! Get bulletin directory entry
- IF (READ_TAG) THEN
- IF (STEP_BULL.EQ.-1) THEN
- CALL GET_THIS_TAG(FOLDER_NUMBER,IER,BULL_SEARCH,DUMMY)
- IF (IER.NE.0) THEN
- CALL GET_PREVIOUS_TAG(FOLDER_NUMBER,IER,
- & BULL_SEARCH,DUMMY)
- END IF
- ELSE
- CALL GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,
- & BULL_SEARCH,DUMMY)
- END IF
- IF (IER.EQ.0) THEN
- IER = BULL_SEARCH + 1
- ELSE
- GO TO 800
- END IF
- END IF
- IF (REMOTE_SET.EQ.3.AND.SAVE_BULL_SEARCH.EQ.BULL_SEARCH) GO TO 800
- SAVE_BULL_SEARCH = BULL_SEARCH
- IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.NE.2) THEN
- CALL STR$UPCASE(DESCRIP1,DESCRIP) ! Make upper case
- IF ((SEARCH_MODE.EQ.3.AND.
- & INDEX(DESCRIP1,SEARCH_STRING(:SEARCH_LEN)).GT.0).OR.
- & (SEARCH_MODE.EQ.1.AND.(DESCRIP1.EQ.SEARCH_STRING.OR.
- & INDEX(SEARCH_STRING,DESCRIP1(5:)).EQ.1))) THEN
- FOUND = BULL_SEARCH
- GO TO 900
- ELSE IF (FLAG.EQ.1) THEN
- WRITE (6,'('' Search aborted.'')')
- GO TO 900
- END IF
- END IF
- IF (IER.EQ.BULL_SEARCH+1.AND.SEARCH_MODE.EQ.2) THEN
- IF (REMOTE_SET) THEN
- CALL REMOTE_READ_MESSAGE(BULL_SEARCH,IER)
- IF (IER.GT.0) THEN
- CALL DISCONNECT_REMOTE
- GO TO 900
- ELSE
- CALL GET_REMOTE_MESSAGE(IER)
- IF (IER.GT.0) GO TO 900
- END IF
- END IF
- ILEN = LINE_LENGTH + 1
- DO WHILE (ILEN.GT.0)
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- CALL STR$UPCASE(INPUT,INPUT) ! Make upper case
- IF (INDEX(INPUT,SEARCH_STRING(:SEARCH_LEN)).GT.0) THEN
- FOUND = BULL_SEARCH
- GO TO 900
- ELSE IF (FLAG.EQ.1) THEN
- WRITE (6,'('' Search aborted.'')')
- GO TO 900
- END IF
- END DO
- END IF
- END DO
-
-800 FOUND = 0
-
-900 IF (FILES) CALL CLOSE_BULLFIL ! End of bulletin file read
- IF (FILES) CALL CLOSE_BULLDIR
- CALL CANCEL_CTRLC_AST
- CALL ENABLE_CTRL
-
- RETURN
- END
-
-
-
-
- SUBROUTINE UNDELETE
-C
-C SUBROUTINE UNDELETE
-C
-C FUNCTION: Undeletes deleted message.
-C
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- EXTERNAL CLI$_ABSENT
-
- IF (REMOTE_SET.EQ.3) THEN
- WRITE (6,'('' Cannot UNDELETE messages in this folder.'')')
- RETURN
- END IF
-C
-C Get the bulletin number to be undeleted.
-C
-
- IER = CLI$GET_VALUE('BULLETIN_NUMBER',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN ! Was bulletin specified?
- DECODE(LEN_P,5,BULL_PARAMETER,ERR=920) BULL_DELETE ! Yes
-5 FORMAT(I<LEN_P>)
- ELSE IF (BULL_POINT.EQ.0) THEN ! No. Have we just read a bulletin?
- GO TO 910 ! No, then error.
- ELSE
- BULL_DELETE = BULL_POINT ! Delete the file we are reading
- END IF
-
- IF (BULL_DELETE.LE.0) GO TO 920
-
-C
-C Check to see if specified bulletin is present, and if the user
-C is permitted to delete the bulletin.
-C
-
- CALL OPEN_BULLDIR
-
- CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin
-
- IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?
- WRITE(6,1030) ! If not, then error out
- GOTO 100
- END IF
-
- IF (USERNAME.NE.FROM) THEN ! If doesn't match owner of bulletin,
- IF ((.NOT.SETPRV_PRIV().AND..NOT.FOLDER_SET).OR. ! Privileges or
- & (.NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)
- & .AND.FOLDER_SET)) THEN ! folder owner?
- WRITE(6,1040) ! Then error out.
- GO TO 100
- ELSE
- CALL READDIR(BULL_DELETE,IER) ! Get info for specified bulletin
- IF (IER.NE.BULL_DELETE+1) THEN ! Was bulletin found?
- WRITE(6,1030) ! If not, then error out
- GOTO 100
- END IF
- END IF
- END IF
-
- IF ((SYSTEM.AND.7).LE.1) THEN ! General or System message
- EXDATE = EXDATE(:7)//'19'//EXDATE(10:)
- ELSE ! Permanent or Shutdown
- IF (EXDATE(2:2).EQ.'-') THEN
- EXDATE = EXDATE(:6)//'20'//EXDATE(9:)
- ELSE
- EXDATE = EXDATE(:7)//'20'//EXDATE(10:)
- END IF
- END IF
-
- IF (.NOT.REMOTE_SET) THEN
- CALL WRITEDIR(BULL_DELETE,IER) ! Update message expiration date
- WRITE (6,'('' Message was undeleted.'')')
- ELSE
- WRITE (REMOTE_UNIT,'(5A)',IOSTAT=IER)
- & 11,BULL_DELETE,DESCRIP,EXDATE,EXTIME
- IF (IER.EQ.0) THEN
- READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM
- END IF
- IF (IER.EQ.0) THEN
- IF (I.NE.LEN(FOLDER1_COM)) THEN
- WRITE (6,'(1X,A)') FOLDER1_COM(:I)
- ELSE
- WRITE (6,'('' Message was undeleted.'')')
- END IF
- ELSE
- CALL DISCONNECT_REMOTE
- END IF
- END IF
-
-100 CALL CLOSE_BULLDIR
-
-900 RETURN
-
-910 WRITE(6,1010)
- GO TO 900
-
-920 WRITE(6,1020)
- GO TO 900
-
-1010 FORMAT(' ERROR: You are not reading any message.')
-1020 FORMAT(' ERROR: Specified message number has incorrect format.')
-1030 FORMAT(' ERROR: Specified message was not found.')
-1040 FORMAT(' ERROR: Message was not undeleted. Not owned by you.')
-
- END
-
-
-
- SUBROUTINE ADD_PROTOCOL(INPUT,ILEN)
-
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLNEWS.INC'
-
- CHARACTER*20 MAIL_PROTOCOL
-
- CHARACTER*(*) INPUT
-
- DATA LMAIL/0/
-
- IF (LMAIL.EQ.-1) RETURN
-
- IF (INDEX(INPUT,'@').EQ.0.OR.INDEX(INPUT,'%"').GT.0) RETURN
-
- IF (LMAIL.EQ.0) THEN
- IF (.NOT.SYS_TRNLNM('BULL_NEWS_MAILER',MAIL_PROTOCOL)) THEN
- MAIL_PROTOCOL = MAILER
- END IF
- LMAIL = TRIM(MAIL_PROTOCOL)
- IF (LMAIL.GT.0.AND.MAIL_PROTOCOL(LMAIL:LMAIL).NE.'%') THEN
- MAIL_PROTOCOL = MAIL_PROTOCOL(:LMAIL)//'%'
- LMAIL = LMAIL + 1
- END IF
- IF (LMAIL.EQ.0) THEN
- LMAIL = -1
- RETURN
- END IF
- END IF
-
- INPUT = MAIL_PROTOCOL(:LMAIL)//'"'//INPUT(:TRIM(INPUT))//'"'
-
- IF (ILEN.NE.0) ILEN = ILEN + LMAIL + 2
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin3.for b/decus/vax91b/bulletin-net91b/bulletin3.for
deleted file mode 100644
index 73cde8bf1d95e525a93a77ab6d151e1d78a6918f..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin3.for
+++ /dev/null
@@ -1,1921 +0,0 @@
-C
-C BULLETIN3.FOR, Version 5/3/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Usage: Invoked by the BULLETIN command.
-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 UPDATE
-C
-C SUBROUTINE UPDATE
-C
-C FUNCTION: Searches for bulletins that have expired and deletes them.
-C
-C NOTE: Assumes directory file is already opened.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
- COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
-
- CHARACTER*107 DIRLINE
-
- CHARACTER*11 TEMP_DATE,TEMP_EXDATE,TEMP_NOSYSDATE
- CHARACTER*11 TEMP_TIME,TEMP_EXTIME,TEMP_NOSYSTIME
-
- IF (REMOTE_SET.AND.
- & NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN
- CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
- END IF
-
- IF (TEST_BULLCP().OR.REMOTE_SET) RETURN
- ! BULLCP cleans up expired bulletins
-
- ENTRY UPDATE_ALWAYS ! Entry to skip BULLCP test
-
- TEMP_EXDATE = '5-NOV-2000' ! If a bulletin gets deleted, and there are
- TEMP_EXTIME = '00:00:00.00' ! are no more bulletins, this is the value
- ! assigned to the latest expiration date
-
- TEMP_DATE = '5-NOV-1956' ! Storage for computing newest
- TEMP_TIME = '00:00:00.00' ! bulletin date if deletion occurs
-
- TEMP_NOSYSDATE = '5-NOV-1956' ! Storage for computing newest
- TEMP_NOSYSTIME = '00:00:00.00' ! non-system bulletin date
-
- BULL_ENTRY = 1 ! Init bulletin pointer
- UPDATE_DONE = 0 ! Flag showing bull has been deleted
-
- NEW_SHUTDOWN = 0
- OLD_SHUTDOWN = SHUTDOWN
-
- DO WHILE (1)
- CALL READDIR(BULL_ENTRY,IER) ! Get next directory entry
- IF (IER.EQ.BULL_ENTRY) GO TO 100 ! ERROR: Not found
- IF ((SYSTEM.AND.7).LE.3.OR.(OLD_SHUTDOWN.EQ.0
- ! If not shutdown, or time
- & .AND.(SYSTEM.AND.4).EQ.4)) THEN ! to delete shutdowns?
- IF ((SYSTEM.AND.4).EQ.4) THEN ! Shutdown bulletin?
- IF (NODE_AREA.GT.0) THEN
- EXTIME(3:4) = EXTIME(4:5)
- READ (EXTIME(1:4),'(I4)') NODE_NUMBER_MSG
- EXTIME(9:10) = EXTIME(10:11)
- READ (EXTIME(7:10),'(I4)') NODE_AREA_MSG
- IF (NODE_NUMBER_MSG.EQ.NODE_NUMBER.AND.
- & NODE_AREA_MSG.EQ.NODE_AREA) THEN
- DIFF = 0
- ELSE
- DIFF = 1
- END IF
- ELSE
- DIFF = COMPARE_DATE(EXDATE,' ')
- IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ')
- END IF
- IF (DIFF.GT.0) NEW_SHUTDOWN = NEW_SHUTDOWN + 1
- ELSE
- DIFF = COMPARE_DATE(EXDATE,' ') ! Has expiration date passed?
- IF (DIFF.EQ.0) DIFF = COMPARE_TIME(EXTIME,' ')
- END IF
- IF (DIFF.LE.0) THEN ! If so then delete bulletin
- CALL DELETE_ENTRY(BULL_ENTRY) ! Delete bulletin entry
- IF (UPDATE_DONE.EQ.0) THEN ! If this is first deleted file
- UPDATE_DONE = BULL_ENTRY ! store it to use for reordering
- END IF ! directory file.
- ELSE IF ((SYSTEM.AND.7).LE.3) THEN ! Expiration date hasn't passed
- ! If a bulletin is deleted, we'll have to update the latest
- ! expiration date. The following does that.
- DIFF = COMPARE_DATE(EXDATE,TEMP_EXDATE)
- IF (DIFF.LT.0.OR.(DIFF.EQ.0.AND.
- & COMPARE_TIME(EXTIME,TEMP_EXTIME).LT.0)) THEN
- TEMP_EXDATE = EXDATE ! If this is the latest exp
- TEMP_EXTIME = EXTIME ! date seen so far, save it.
- END IF
- TEMP_DATE = DATE ! Keep date after search
- TEMP_TIME = TIME ! we have the last message date
- IF (.NOT.BTEST(SYSTEM,0)) THEN
- TEMP_NOSYSDATE = DATE
- TEMP_NOSYSTIME = TIME
- END IF
- END IF
- ELSE
- TEMP_DATE = DATE
- TEMP_TIME = TIME
- IF (.NOT.BTEST(SYSTEM,0)) THEN
- TEMP_NOSYSDATE = DATE
- TEMP_NOSYSTIME = TIME
- END IF
- END IF
- BULL_ENTRY = BULL_ENTRY + 1
- END DO
-
-100 IF (UPDATE_DONE.GT.0) THEN ! Reorder directory file
- CALL CLEANUP_DIRFILE(UPDATE_DONE) ! due to deleted entries
- END IF
-
- DATE = NEWEST_DATE
- TIME = NEWEST_TIME
- CALL READDIR(0,IER)
- SHUTDOWN = NEW_SHUTDOWN
- NEWEST_EXDATE = TEMP_EXDATE
- DIFF = COMPARE_DATE(NEWEST_EXDATE,' ')
- IF (DIFF.GT.20*356) NEWEST_EXDATE = '5-NOV-2000'
- NEWEST_EXTIME = TEMP_EXTIME
- NEWEST_DATE = TEMP_DATE
- NEWEST_TIME = TEMP_TIME
- CALL WRITEDIR(0,IER)
- SYSTEM = 0 ! Updating last non-system date/time
- NEWEST_DATE = TEMP_NOSYSDATE
- NEWEST_TIME = TEMP_NOSYSTIME
- CALL UPDATE_FOLDER
- SYSTEM = 1 ! Now update latest date/time
- NEWEST_DATE = TEMP_DATE
- NEWEST_TIME = TEMP_TIME
- CALL UPDATE_FOLDER
-
- IF (NODE_AREA.GT.0.AND.BTEST(FOLDER_FLAG,2)) THEN ! Shutdowns deleted?
- CALL UPDATE_SHUTDOWN(FOLDER_NUMBER) ! Save that info
- END IF
-
-C
-C If newest message date has been changed, must change it in BULLUSER.DAT
-C and also see if it affects notification of new messages to users
-C
- IF (TEMP_DATE.NE.DATE.OR.TEMP_TIME.NE.TIME) THEN
- CALL UPDATE_LOGIN(.FALSE.)
- END IF
-
- RETURN
-
- END
-
-
-
- SUBROUTINE UPDATE_READ(USERFILE_OPEN)
-C
-C SUBROUTINE UPDATE_READ
-C
-C FUNCTION:
-C Store the latest date that user has used the BULLETIN facility.
-C If new bulletins have been added, alert user of the fact.
-C
-
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE '($PRVDEF)'
-
- CHARACTER TODAY*23
-
- DIMENSION TODAY_BTIM(2),READ_BTIM_SAVE(2)
-
- LOGICAL MODIFY_SYSTEM /.TRUE./
-
-C
-C Update user's latest read time in his entry in BULLUSER.DAT.
-C
- IF (.NOT.USERFILE_OPEN) THEN
- CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file
- END IF
-
- CALL READ_USER_FILE_HEADER(IER)
-
- IF (IER.NE.0) THEN ! If header not present, exit
- IF (.NOT.USERFILE_OPEN) CALL CLOSE_BULLUSER
- RETURN
- ELSE IF (USERPRIV(1).EQ.-1.AND.USERPRIV(2).EQ.-1) THEN
- ! If header present, but no
- DO I=1,FLONG ! SET_FLAG and NOTIFY_FLAG
- SET_FLAG_DEF(I) = 0 ! information, write default
- NOTIFY_FLAG_DEF(I) = 0 ! flags.
- BRIEF_FLAG_DEF(I) = 0
- END DO
- SET_FLAG_DEF(1) = 1
- USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV
- USERPRIV(2) = 0
- REWRITE (4) USER_HEADER
- END IF
-
- CALL SYS$ASCTIM(,TODAY,,) ! Get today's time
- CALL SYS_BINTIM(TODAY,TODAY_BTIM)
-
- UNLOCK 4
-
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER1)
-
- IF (IER1.EQ.0) THEN ! If entry found, update it
- READ_BTIM_SAVE(1) = READ_BTIM(1)
- READ_BTIM_SAVE(2) = READ_BTIM(2)
- READ_BTIM(1) = TODAY_BTIM(1)
- READ_BTIM(2) = TODAY_BTIM(2)
- REWRITE (4) USER_ENTRY
- READ_BTIM(1) = READ_BTIM_SAVE(1)
- READ_BTIM(2) = READ_BTIM_SAVE(2)
- ELSE ! If no entry create a new entry
- NEW_FLAG(1) = 143
- NEW_FLAG(2) = 0
- LOGIN_BTIM(1) = TODAY_BTIM(1)
- LOGIN_BTIM(2) = TODAY_BTIM(2)
- READ_BTIM(1) = TODAY_BTIM(1)
- READ_BTIM(2) = TODAY_BTIM(2)
- CALL WRITE_USER_FILE_NEW(IER)
- END IF
-
- IF (MODIFY_SYSTEM) THEN
- CALL MODIFY_SYSTEM_LIST(1)
- MODIFY_SYSTEM = .FALSE.
- END IF
-
- IF (.NOT.USERFILE_OPEN) THEN
- CALL CLOSE_BULLUSER ! All finished with BULLUSER
- END IF
-
- RETURN ! to go home...
-
- END
-
-
-
-
- SUBROUTINE FIND_NEWEST_BULL
-C
-C SUBROUTINE FIND_NEWEST_BULL
-C
-C If new bulletins have been added, alert user of the fact and
-C set the next bulletin to be read to the first new bulletin.
-C
-C OUTPUTS:
-C BULL_POINT - If -1, no new bulletins to read, else there are.
-C
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /POINT/ BULL_POINT
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INTEGER DIR_BTIM(2)
-
-C
-C Now see if bulletins have been added since the user's previous
-C read time. If they have, then search for the first new bulletin.
-C Ignore new bulletins that are owned by the user or system notices
-C that have not been added since the user has logged in.
-C
- BULL_POINT = -1 ! Init bulletin pointer
-
- CALL OPEN_BULLDIR_SHARED ! Yep, so get directory file
- CALL READDIR(0,IER) ! Get # bulletins from header
- IF (IER.EQ.1) THEN
- CALL GET_NEWEST_MSG(LAST_READ_BTIM(1,FOLDER_NUMBER+1),START)
- IF (START.LE.0) THEN
- BULL_POINT = START
- CALL CLOSE_BULLDIR
- RETURN
- END IF
- DO WHILE (START.LE.NBULL.AND.(FROM.EQ.USERNAME.OR.SYSTEM))
- IF (FROM.NE.USERNAME) THEN ! Ignore bull if owner is user
- IF (SYSTEM) THEN ! If system bulletin
- CALL SYS_BINTIM(DATE//' '//TIME,DIR_BTIM)
- DIFF = COMPARE_BTIM(LOGIN_BTIM,DIR_BTIM)
- IF (DIFF.GT.0) THEN
- START = START + 1
- CALL READDIR(START,IER)
- ELSE ! SYSTEM bulletin was not seen
- SYSTEM = 0 ! so force exit to read it.
- END IF
- END IF
- ELSE
- START = START + 1
- CALL READDIR(START,IER)
- IF (IER.NE.START+1) START = NBULL + 1
- END IF
- END DO
- IF (START.LE.NBULL) BULL_POINT = START - 1
- END IF
-
- CALL CLOSE_BULLDIR
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_EXPIRED(EXPDAT,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*23 EXPDAT
- CHARACTER*23 TODAY
-
- DIMENSION EXTIME(2),NOW(2)
-
- EXTERNAL CLI$_ABSENT
-
- IER = SYS$ASCTIM(,TODAY,,) ! Get today's date
-
- IERC = CLI$GET_VALUE('EXPIRATION',EXPDAT,ILEN)
-
- PROMPT = .TRUE.
-
-5 IF (PROMPT) THEN
- IF (IERC.NE.%LOC(CLI$_ABSENT)) THEN ! Was value specified?
- PROMPT = .FALSE.
- ELSE
- DEFAULT_EXPIRE = FOLDER_BBEXPIRE
- IF ((DEFAULT_EXPIRE.GT.F_EXPIRE_LIMIT.OR.DEFAULT_EXPIRE
- & .EQ.0).AND.F_EXPIRE_LIMIT.GT.0.AND..NOT.
- & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- DEFAULT_EXPIRE = F_EXPIRE_LIMIT
- END IF
- IF (BTEST(FOLDER_FLAG,3)) THEN ! NOPROMPT was set
- IF (DEFAULT_EXPIRE.LE.0) THEN ! If no expiration date
- SYSTEM = SYSTEM.OR.2 ! make permanent
- EXPDAT = '5-NOV-2000 00:00:00.00'
- ELSE ! Else set expiration
- CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)
- EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'
- END IF
- ILEN = TRIM(EXPDAT)
- ELSE
- IF (DEFAULT_EXPIRE.EQ.0) THEN ! Get expiration date
- WRITE(6,1030) TODAY(:INDEX(TODAY,'.')-4)
- ELSE IF (DEFAULT_EXPIRE.EQ.-1) THEN
- WRITE(6,1031) TODAY(:INDEX(TODAY,'.')-4)
- ELSE
- WRITE(6,1032) TODAY(:INDEX(TODAY,'.')-4),
- & DEFAULT_EXPIRE
- END IF
- WRITE (6,1035)
- CALL GET_LINE(EXPDAT,ILEN) ! Get EXPDAT line
- IF (ILEN.EQ.0.AND.DEFAULT_EXPIRE.NE.0) THEN
- IF (DEFAULT_EXPIRE.EQ.-1) THEN
- EXPDAT = '5-NOV-2000 00:00:00.00'
- SYSTEM = IBSET(SYSTEM,1) ! Indicate permanent message
- ELSE
- CALL GET_EXDATE(EXPDAT,DEFAULT_EXPIRE)
- EXPDAT = EXPDAT(:TRIM(EXPDAT))//' 00:00:00.00'
- END IF
- ILEN = TRIM(EXPDAT)
- END IF
- END IF
- END IF
- ELSE
- RETURN
- END IF
-
- IF (ILEN.LE.0) THEN
- IER = 0
- RETURN
- END IF
-
- EXPDAT = EXPDAT(:ILEN) ! Change trailing zeros 2 spaces
-
- IF (INDEX(EXPDAT,'-').EQ.0.AND.INDEX(EXPDAT,':').GT.0.AND.
- & INDEX(EXPDAT(:ILEN),' ').EQ.0) THEN ! Only time specified?
- EXPDAT = TODAY(:INDEX(TODAY(2:),' ')+1)//EXPDAT ! Add date
- ELSE IF (INDEX(EXPDAT(6:),'-').EQ.0.AND. ! Date specified
- & INDEX(EXPDAT,'-').GT.0) THEN ! but no year?
- SPACE = INDEX(EXPDAT,' ') - 1 ! Add year
- IF (SPACE.EQ.-1) SPACE = TRIM(EXPDAT)
- YEAR = INDEX(TODAY(6:),'-')
- EXPDAT = EXPDAT(:SPACE)//TODAY(5+YEAR:9+YEAR)//EXPDAT(SPACE+1:)
- END IF
-
- CALL STR$UPCASE(EXPDAT,EXPDAT) ! Convert to upper case
- IER = SYS_BINTIM(EXPDAT,EXTIME)
- IF (IER.NE.1) THEN ! If not able to do so
- WRITE(6,1040) ! tell user is wrong
- IER = 0 ! Set error for return value
- GO TO 5 ! Re-request date (if prompting)
- END IF
- IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)
- IF (TIMLEN.EQ.16) THEN
- CALL SYS$GETTIM(NOW)
- CALL LIB$SUBX(NOW,EXTIME,EXTIME)
- IER = SYS$ASCTIM(TIMLEN,EXPDAT,EXTIME,)
- END IF
-
- IF (EXPDAT(2:2).EQ.'-') EXPDAT = '0'//EXPDAT
- IER = COMPARE_DATE(EXPDAT(:11),TODAY(:11)) ! Compare date with today's
- IF (IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0.AND.
- & .NOT.FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- WRITE(6,1050) F_EXPIRE_LIMIT ! Expiration date > limit
- IER = 0 ! Set error for return value
- GO TO 5 ! Re-request date (if prompting)
- END IF
- IF (IER.EQ.0) IER = COMPARE_TIME(EXPDAT(13:),TODAY(13:))
- IF (IER.LE.0) THEN ! If expiration date not future
- WRITE(6,1045) ! tell user
- IER = 0 ! Set error for return value
- GO TO 5 ! Re-request date (if prompting)
- END IF
-
- IF (PROMPT) THEN
- IF (BTEST(SYSTEM,1)) THEN ! Permanent message
- WRITE (6,'('' Message will be permanent.'')')
- ELSE
- WRITE (6,'('' Expiration date will be '',A,''.'')')
- & EXPDAT(:TRIM(EXPDAT))
- END IF
- END IF
-
- IER = 1
-
- RETURN
-
-1030 FORMAT(' It is ',A,'. Specify when message expires.')
-1031 FORMAT(' It is ',A,'. Specify when message expires.',
- & ' Default is permanent.')
-1032 FORMAT(' It is ',A,'. Specify when message expires.',
- & ' Default is ',I3,' days.')
-1035 Format(' Enter absolute time: [dd-mmm-yyyy] hh:mm:ss ',
- & 'or delta time: dddd hh:mm:ss')
-1040 FORMAT(' ERROR: Invalid date format specified.')
-1045 FORMAT(' ERROR: Specified time has already passed.')
-1050 FORMAT(' ERROR: Specified expiration period too large.'
- & ' Limit is ',I3,' days.')
-
- END
-
-
- SUBROUTINE MAILEDIT(INFILE,OUTFILE)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($SSDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- EXTERNAL BULLETIN_SUBCOMMANDS
-
- CHARACTER*(*) INFILE,OUTFILE
-
- CHARACTER*80 MAIL_EDIT,OUT
- DATA MAIL_EDIT /' '/
-
- CHARACTER*132 INPUT
-
- CHARACTER*255 SPAWN_COMMAND
-
- IF (CAPTIVE()) THEN
- WRITE (6,'('' ERROR: /EDIT not allowed from CAPTIVE account.'')')
- RETURN
- END IF
-
- IF (MAIL_EDIT.EQ.' ') THEN
- IF (.NOT.SYS_TRNLNM('MAIL$EDIT',MAIL_EDIT)) THEN
- OPEN (UNIT=10,FILE='VMSMAIL_PROFILE',
- & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA',
- & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
- & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)
- IF (IER.EQ.0) THEN
- DO WHILE (REC_LOCK(IER))
- READ(10,'(A)',KEY=USERNAME,IOSTAT=IER) INPUT
- END DO
- CLOSE (UNIT=10)
- IF (IER.EQ.0) THEN
- INPUT = INPUT(32:)
- DO WHILE (TRIM(INPUT).GT.0)
- IF (ICHAR(INPUT(1:1)).EQ.8) THEN
- MAIL_EDIT = 'CALLABLE_'//INPUT(5:4+ICHAR(INPUT(3:3)))
- INPUT = ' '
- ELSE
- INPUT = INPUT(ICHAR(INPUT(3:3))+5:)
- END IF
- END DO
- END IF
- END IF
- END IF
- CALL STR$UPCASE(MAIL_EDIT,MAIL_EDIT)
- END IF
-
- OUT = OUTFILE
- IF (TRIM(OUT).EQ.0) THEN
- OUT = INFILE
- END IF
-
- CALL DISABLE_PRIVS
- CALL DECLARE_CTRLC_AST
- IF (TRIM(MAIL_EDIT).GT.0
- & .AND.INDEX(MAIL_EDIT,'CALLABLE_').EQ.0) THEN
- IF (OUT.EQ.INFILE) THEN
- SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))
- & //' "" '//OUT(:TRIM(OUT))
- ELSE
- SPAWN_COMMAND = '$@'//MAIL_EDIT(:TRIM(MAIL_EDIT))
- & //' '//INFILE//' '//OUT(:TRIM(OUT))
- END IF
- CALL LIB$SPAWN(SPAWN_COMMAND)
- ELSE IF (INDEX(MAIL_EDIT,'TPU').GT.0) THEN
- CONTEXT = 0
- IER1 = LIB$FIND_FILE(INFILE,INPUT,CONTEXT)
- IF (.NOT.IER1) THEN
- CALL TPU$EDIT(' ',OUT)
- ELSE
- CALL TPU$EDIT(INFILE,OUT)
- END IF
- IER1 = CLI$DCL_PARSE(INCMD,BULLETIN_SUBCOMMANDS)
- ! TPU does CLI$ stuff which wipes our parsed command line
- ELSE
- CALL EDT$EDIT(INFILE,OUT)
- END IF
- CALL CANCEL_CTRLC_AST
- CALL ENABLE_PRIVS
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE CREATE_BULLCP
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PRCDEF)'
-
- INCLUDE '($SSDEF)'
-
- INCLUDE '($PQLDEF)'
-
- INCLUDE '($PRVDEF)'
-
- INCLUDE 'BULLFILES.INC'
-
- COMMON /REALPROC/ REALPROCPRIV(2)
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- EXTERNAL CLI$_ABSENT
-
- DIMENSION IMAGEPRIV(2)
-
- CHARACTER IMAGENAME*132,ANSWER*1
-
- STRUCTURE /QUOTA_ITMLST/
- BYTE ITEM
- INTEGER VALUE
- END STRUCTURE
-
- RECORD /QUOTA_ITMLST/ QUOTA(3)
-
- IF (.NOT.SETPRV_PRIV()) THEN
- WRITE (6,'('' ERROR: You do not have the privileges '',
- & ''to execute the command.'')')
- CALL EXIT
- END IF
-
- JUST_STOP = CLI$PRESENT('STOP')
-
- IF (JUST_STOP.AND..NOT.BTEST(REALPROCPRIV(1),PRV$V_SETPRV)) THEN
- WRITE (6,'('' ERROR: You need SETPRV to execute /STOP.'')')
- CALL EXIT
- ELSE IF (.NOT.JUST_STOP.AND.
- & .NOT.BTEST(REALPROCPRIV(1),PRV$V_SYSNAM)) THEN
- CALL SYS$SETPRV(,,,IMAGEPRIV)
- IF (.NOT.BTEST(IMAGEPRIV(1),PRV$V_SYSNAM)) THEN
- WRITE (6,'('' ERROR: This new version of BULLETIN'',
- & '' needs to be installed with SYSNAM.'')')
- CALL EXIT
- END IF
- END IF
-
- IF (TEST_BULLCP()) THEN
- IF (.NOT.JUST_STOP) THEN
- WRITE (6,'('' BULLCP process running.
- & Do you wish to kill it and restart a new one? '',$)')
- READ (5,'(A)') ANSWER
- IF (ANSWER.NE.'Y'.AND.ANSWER.NE.'y') CALL EXIT
- END IF
-
- CALL DELPRC('BULLCP',IER)
-
- IF (.NOT.IER) THEN
- CALL SYS_GETMSG(IER)
- CALL EXIT
- ELSE IF (JUST_STOP) THEN
- WRITE (6,'('' BULLCP process has been terminated.'')')
- CALL EXIT
- END IF
- ELSE IF (JUST_STOP) THEN
- WRITE (6,'('' BULLCP is not presently running.'')')
- CALL EXIT
- END IF
-
- CALL GETIMAGE(IMAGENAME,ILEN)
-
- LEN_B = TRIM(FOLDER_DIRECTORY)
-
- CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW)
-C
-C Generate a new BULLCP.COM each time. This is done in case the BULLETIN
-C executeable is moved, or a new version of BULLETIN is being installed that
-C has changes to BULLCP.COM. (It's also a security risk to execute the old
-C copy, as someone might have been able to write into that directory and
-C replace BULLCP.COM, and the command procedure is executed under the
-C SYSTEM account, so it has all privileges.)
-C
- OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM',
- & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')
- IF (IER.NE.0) RETURN
- WRITE(11,'(A)') '$SET NOON'
- WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN)
- WRITE(11,'(A)') '$LOOP:'
- WRITE(11,'(A)') '$PURGE '//FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG'
- WRITE(11,'(A)') '$DEF/USER SYS$OUTPUT '
- & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.LOG'
- WRITE(11,'(A)') '$DEF/USER SYS$ERROR '
- & //FOLDER_DIRECTORY(:LEN_B)//'BULLCP.ERR'
- WRITE(11,'(A)') '$B/BULLCP'
- WRITE(11,'(A)') '$WAIT 00:01:00'
- WRITE(11,'(A)') '$GOTO LOOP' ! File open timed out
- CLOSE(UNIT=11)
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
-
- I = 1
- IER = CLI$GET_VALUE('PGFLQUOTA',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) PGFLQUOTA
- QUOTA(I).ITEM = PQL$_PGFLQUOTA
- QUOTA(I).VALUE = PGFLQUOTA
- I = I + 1
- END IF
- IER = CLI$GET_VALUE('WSEXTENT',BULL_PARAMETER,LEN_P)
- IF (IER.NE.%LOC(CLI$_ABSENT)) THEN
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) WSEXTENT
- QUOTA(I).ITEM = PQL$_WSEXTENT
- QUOTA(I).VALUE = WSEXTENT
- I = I + 1
- END IF
- QUOTA(I).ITEM = PQL$_LISTEND
- QUOTA(I).VALUE = 0
-
- IER = 0
- DO WHILE (IER.EQ.0.OR.(IER.EQ.SS$_DUPLNAM.AND.PID.GT.0))
- IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',FOLDER_DIRECTORY(:LEN_B)
- & //'BULLCP.COM','NL:',,,QUOTA,'BULLCP',%VAL(4),
- & ,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))
- END DO
-
- IF (IER) THEN
- OPEN(UNIT=11,FILE=FOLDER_DIRECTORY(:LEN_B)//'BULLCP.COM;-1',
- & STATUS='OLD',IOSTAT=IER1)
- IF (IER1.EQ.0) CLOSE(UNIT=11,STATUS='DELETE',IOSTAT=IER1)
- END IF
-
- IF (.NOT.IER) THEN
- CALL SYS_GETMSG(IER)
- ELSE
- IF (CONFIRM_USER('DECNET').NE.0) THEN
- WRITE (6,'('' WARNING: Account with username DECNET'',
- & '' does not exist.'')')
- WRITE (6,'('' BULLCP will be owned by present account.'')')
- END IF
- WRITE (6,'('' Successfully created BULLCP detached process.'')')
- END IF
- CALL EXIT
-
- END
-
-
-
-
-
-
- SUBROUTINE FIND_BULLCP
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /BCP/ BULLCP
- DATA BULLCP /0/
-
- IER = SYS_TRNLNM('BULL_BULLCP','DEFINED')
- IF (IER) BULLCP = 1
-
- RETURN
- END
-
-
-
-
- LOGICAL FUNCTION TEST_BULLCP
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /BCP/ BULLCP
- LOGICAL BULLCP
-
- TEST_BULLCP = BULLCP
-
- RETURN
- END
-
-
-
-
- SUBROUTINE RUN_BULLCP
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /BCP/ BULLCP
- LOGICAL BULLCP
-
- COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- CHARACTER*23 OLD_TIME,NEW_TIME
-
- IF (TEST_BULLCP()) CALL EXIT ! BULLCP already running, so exit.
-
- CALL LIB$DATE_TIME(OLD_TIME)
-
- BULLCP = 2 ! Enable process to do BULLCP functions
-
- IER = SYS$CREMBX(%VAL(1),CHAN,,,,,'BULL_BULLCP')
- IF (.NOT.IER) THEN ! Can't create mailbox, so exit.
- CALL SYS_GETMSG(IER)
- CALL EXIT
- END IF
-
- IER = SYS$DELMBX(%VAL(CHAN)) ! If process dies, mailbox is deleted.
-
- CALL REGISTER_BULLCP
-
- CALL SET_REMOTE_SYSTEM
-
- CALL START_DECNET
-
- CALL SYS$SETAST(%VAL(0))
-
- UPDATEBBOARD = 1
- IF (SYS_TRNLNM('BULL_BBOARD_UPDATE',BULL_PARAMETER)) THEN
- LEN_P = TRIM(BULL_PARAMETER)
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER,IOSTAT=IER)
- & UPDATEBBOARD
- IF (IER.EQ.0) UPDATEBBOARD = (UPDATEBBOARD+14) / 15
- END IF
-
- UPDATENEWS = 4
- IF (SYS_TRNLNM('BULL_NEWS_UPDATE',BULL_PARAMETER)) THEN
- LEN_P = TRIM(BULL_PARAMETER)
- DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER,IOSTAT=IER)
- & UPDATENEWS
- IF (IER.EQ.0) UPDATENEWS = (UPDATENEWS+14) / 15
- END IF
-
- CALL SYS$SETAST(%VAL(1))
-
- BBOARD_LOOP = 0
- NEWS_LOOP = 0
-
- DO WHILE (1) ! Loop once every 15 minutes
- CALL SYS$SETAST(%VAL(0))
- CALL LIB$DATE_TIME(NEW_TIME)
- CALL GET_PROXY_ACCOUNTS ! Proxy info for incoming connections
- CALL SYS$SETAST(%VAL(1))
-
- IF (BBOARD_LOOP.EQ.0) CALL BBOARD ! Look for BBOARD messages.
-
- BBOARD_LOOP = BBOARD_LOOP + 1
- IF (BBOARD_LOOP.EQ.UPDATEBBOARD) BBOARD_LOOP = 0
-
- FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header
- POINT_FOLDER = 0
- DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)
- POINT_FOLDER = POINT_FOLDER + 1
- CALL SYS$SETAST(%VAL(0))
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- IF (FOLDER_BBOARD(:2).NE.'::') THEN
- CALL SELECT_FOLDER(.FALSE.,IER) ! Select folder
- IF (IER) THEN
- CALL DELETE_EXPIRED ! Delete expired messages
- IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Do empty block
- & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! cleanup at 3 a.m.
- IF (NEMPTY.GT.200) THEN
- CALL CLEANUP_BULLFILE ! Cleanup empty blocks
- END IF
- END IF
- END IF
- END IF
- CALL SYS$SETAST(%VAL(1))
- END DO
-
- CALL SYS$SETAST(%VAL(0))
- IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.
- & NEWS_LOOP.EQ.0) CALL CREATE_PROCESS('BULLCP NEWS')
- CALL SYS$SETAST(%VAL(1))
-
- NEWS_LOOP = NEWS_LOOP + 1
- IF (NEWS_LOOP.EQ.UPDATENEWS) NEWS_LOOP = 0
-
- IF (INDEX(NEW_TIME,' 03:').NE.0.AND. ! Cleanup deleted users from
- & INDEX(OLD_TIME,' 03:').EQ.0) THEN ! data files at 3 a.m.
- CALL SYS$SETAST(%VAL(0))
- CALL TOTAL_CLEANUP_LOGIN
- CALL SYS$SETAST(%VAL(1))
- END IF
-
- OLD_TIME = NEW_TIME
- CALL HIBER('15') ! Wait for 15 minutes
-C
-C Look at remote folders and update local info to reflect new messages.
-C Do here after waiting in case problem with connecting to remote folder
-C which requires killing process.
-C
-
- FOLDER_Q = FOLDER_Q1
- POINT_FOLDER = 0
- DO WHILE (POINT_FOLDER.LT.NUM_FOLDERS)
- POINT_FOLDER = POINT_FOLDER + 1
- CALL SYS$SETAST(%VAL(0))
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- IF (FOLDER_BBOARD(:2).EQ.'::') THEN
- CALL SELECT_FOLDER(.FALSE.,IER)
- END IF
- CALL SYS$SETAST(%VAL(1))
- END DO
- CALL SYS$SETAST(%VAL(0))
- FOLDER_NUMBER = 0 ! Reset to GENERAL folder
- CALL SELECT_FOLDER(.FALSE.,IER)
- CALL REGISTER_BULLCP
- CALL SYS$SETAST(%VAL(1))
- END DO
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE SET_REMOTE_SYSTEM
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER NODENAME*8
-
- CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
- NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)
-
- CALL OPEN_BULLFOLDER_SHARED
-
- IER = 0
- DO WHILE (IER.EQ.0)
- CALL READ_FOLDER_FILE(IER)
- IF (FOLDER_BBOARD(:2).EQ.'::'.AND.BTEST(FOLDER_FLAG,2)
- & .AND.IER.EQ.0) THEN
- CALL SELECT_FOLDER(.FALSE.,IER1)
- IF (IER1) THEN
- WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER1) 14,
- & BTEST(FOLDER_FLAG,2),NODENAME
- END IF
- END IF
- END DO
-
- CALL CLOSE_BULLFOLDER
-
- FOLDER_NUMBER = 0 ! Reset to GENERAL folder
- CALL SELECT_FOLDER(.FALSE.,IER)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE REGISTER_BULLCP
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INTEGER SHUTDOWN_BTIM(FLONG)
-
- EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
- CHARACTER NODENAME*8
-
- COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
- COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
-
- CALL OPEN_BULLUSER
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*SYSTEM',IOSTAT=IER)
- & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- END DO
-
- IF (IER.NE.0) THEN
- DO I=1,FLONG
- SYSTEM_FLAG(I) = 0
- SHUTDOWN_FLAG(I) = 0
- END DO
- CALL SET2(SYSTEM_FLAG,0)
- NODE_AREA = 0
- END IF
-
- CALL LIB$SYS_TRNLOG('SYS$NODE',,NODENAME)
- NODENAME = NODENAME(2:INDEX(NODENAME,':')-1)
-
- DO I=1,FLONG
- SHUTDOWN_FLAG(I) = SYSTEM_FLAG(I)
- END DO
-
- IF (IER.NE.0) THEN
- WRITE (4,IOSTAT=IER)
- & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- ELSE
- REWRITE (4,IOSTAT=IER)
- & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- END IF
-
- CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE UPDATE_SHUTDOWN(FOLDER_NUMBER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INTEGER SHUTDOWN_BTIM(FLONG)
-
- EQUIVALENCE (SHUTDOWN_BTIM,BRIEF_FLAG)
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),NODENAME
- CHARACTER NODENAME*8
-
- COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
- COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
-
- CALL OPEN_BULLUSER
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*SYSTEM',IOSTAT=IER)
- & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- END DO
-
- CALL CLR2(SHUTDOWN_FLAG,FOLDER_NUMBER)
-
- SEEN_FLAG = 0
- DO I=1,FLONG
- IF (SHUTDOWN_FLAG(I).NE.0) SEEN_FLAG = 1
- END DO
- IF (SEEN_FLAG.EQ.0) NODE_AREA = 0 ! All done with that node
-
- IF (IER.NE.0) THEN
- WRITE (4,IOSTAT=IER)
- & '*SYSTEM ',NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- ELSE
- REWRITE (4,IOSTAT=IER)
- & TEMP_USER,NODENAME,NODE_NUMBER,NODE_AREA,NEW_FLAG,
- & SYSTEM_FLAG,SHUTDOWN_BTIM,SHUTDOWN_FLAG
- END IF
-
- CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE HIBER(MIN)
-C
-C SUBROUTINE HIBER
-C
-C FUNCTION: Waits for specified time period in minutes.
-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'/
-
- TIMBUF(6:7) = MIN
-
- IER=SYS$BINTIM(TIMBUF,TIMADR)
- IER=SYS$SCHDWK(,,TIMADR,) ! Set timer.
- IER=SYS$HIBER()
-
- RETURN
- END
-
-
-
- SUBROUTINE WAIT_SEC(PARAM)
-C
-C SUBROUTINE WAIT_SEC
-C
-C FUNCTION: Waits for specified time period in seconds.
-C
- IMPLICIT INTEGER (A-Z)
- INTEGER TIMADR(2) ! Buffer containing time
- ! in desired system format.
- CHARACTER TIMBUF*13,PARAM*2
- DATA TIMBUF/'0 00:00:00.00'/
- DATA WAIT_EF /0/
-
- IF (WAIT_EF.EQ.0) CALL LIB$GET_EF(WAIT_EF)
-
- TIMBUF(9:10) = PARAM
-
- IER=SYS$BINTIM(TIMBUF,TIMADR)
- IER=SYS$SETIMR(%VAL(WAIT_EF),TIMADR,,%VAL(3)) ! Set timer.
- IER=SYS$WAITFR(%VAL(WAIT_EF)) ! Wait for EFN to be set.
-
- RETURN
- END
-
-
-
-
- SUBROUTINE DELETE_EXPIRED
-
-C
-C SUBROUTINE DELETE_EXPIRED
-C
-C FUNCTION:
-C
-C Delete any expired bulletins (normal or shutdown ones).
-C (NOTE: If bulletin files don't exist, they get created now by
-C OPEN_FILE_SHARED. Also, if new format has been defined for files,
-C they get converted now. The directory file has had it's record size
-C lengthened in the past to include more info, and the bulletin file
-C was lengthened from 80 to 81 characters to include byte which indicated
-C start of bulletin message. However, that scheme was removed and
-C was replaced with a 128 byte record compressed format).
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
- COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
-
- CHARACTER UPTIME_DATE*11,UPTIME_TIME*11
-
- CALL OPEN_BULLDIR_SHARED ! Open directory file
- CALL OPEN_BULLFIL_SHARED ! Open bulletin file
- CALL CLOSE_BULLFIL
- CALL READDIR(0,IER) ! Get directory header
- IF (IER.EQ.1) THEN ! Is header present?
- IER = COMPARE_DATE(NEWEST_EXDATE,' ') ! Yes. Any expired bulls?
- IF (IER.GT.20*356) IER = -1 ! Check if latest expiration date valid.
- IF (IER.EQ.0) IER = COMPARE_TIME(NEWEST_EXTIME,' ')
- IF (SHUTDOWN.GT.0.AND.NODE_AREA.GT.0.AND.
- & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2)).AND.
- & TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
- ! Do shutdown messages exist and need to be checked?
- SHUTDOWN = 0
- IER1 = -1
- ELSE
- IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
- CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
- END IF
- IER1 = 1
- END IF
- IF (IER.LE.0.OR.IER1.LE.0) THEN
- CALL CLOSE_BULLDIR
- CALL OPEN_BULLDIR ! Reopen without sharing
- CALL UPDATE ! Need to update
- END IF
- ELSE ! If header not there, then first time running BULLETIN
- CALL OPEN_BULLUSER ! Create user file to be able to set
- CALL CLOSE_BULLUSER ! defaults, privileges, etc.
- END IF
- CALL CLOSE_BULLDIR
-
- RETURN
- END
-
-
-
-
- SUBROUTINE BBOARD
-C
-C SUBROUTINE BBOARD
-C
-C FUNCTION: Converts mail to BBOARD into non-system bulletins.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE '($RMSDEF)'
-
- COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS
- DATA FOLDER_Q1/0/
-
- CHARACTER*11 INEXDATE
- CHARACTER INDESCRIP*(LINE_LENGTH),INFROM*(LINE_LENGTH),INTO*76
- CHARACTER ACCOUNT_SAVE*8,USERNAME_SAVE*12
- CHARACTER F_BBOARD*64,BBOARD_NAME*64
-
- DIMENSION NEW_MAIL(FOLDER_MAX)
-
- DATA SPAWN_EF/0/,HEADER_Q1/0/
-
- CALL SYS$SETAST(%VAL(0))
-
- IF (SPAWN_EF.EQ.0) CALL LIB$GET_EF(SPAWN_EF)
-
- CALL DISABLE_CTRL
-
- CALL INIT_QUEUE(HEADER_Q1,INPUT)
-
- CALL INIT_QUEUE(FOLDER_Q1,FOLDER_COM)
-
- FOLDER_Q = FOLDER_Q1
-
- CALL OPEN_BULLFOLDER_SHARED ! Get folder file
-
- NUM_FOLDERS = 0
- IER = 0
- DO WHILE (IER.EQ.0) ! Copy all bulletins from file
- CALL READ_FOLDER_FILE(IER)
- IF (IER.EQ.0) THEN
- NUM_FOLDERS = NUM_FOLDERS + 1
- CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- END IF
- END DO
-
- CALL CLOSE_BULLFOLDER ! We don't need file anymore
- CALL SYS$SETAST(%VAL(1))
-
- CALL SYS$SETAST(%VAL(0))
- CALL CHECK_MAIL(NEW_MAIL)
- CALL SYS$SETAST(%VAL(1))
-
- FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header
-
- NBBOARD_FOLDERS = 0
-
- POINT_FOLDER = 0
-
-1 POINT_FOLDER = POINT_FOLDER + 1
- IF (POINT_FOLDER.GT.NUM_FOLDERS) GO TO 900
-
- CALL SYS$SETAST(%VAL(0))
-
- FOLDER_Q_SAVE = FOLDER_Q
-
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
-
- IF (FOLDER_BBOARD.EQ.'NONE'.OR.
- & FOLDER_BBOARD(:2).EQ.'::') GO TO 1
-
- NBBOARD_FOLDERS = NBBOARD_FOLDERS + 1
-
- IF (.NOT.NEW_MAIL(POINT_FOLDER)) GO TO 1
-C
-C The process is set to the BBOARD uic and username in order to create
-C a spawned process that is able to read the BBOARD mail (a real kludge).
-C
-
- CALL GETUSER(USERNAME_SAVE) ! Get present username
- CALL GETACC(ACCOUNT_SAVE) ! Get present account
- CALL GETUIC(GROUP_SAVE,USER_SAVE) ! Get present uic
-
- IF (TRIM(FOLDER_BBOARD).GT.0) THEN ! BBOARD name present?
- IER = SETUSER(FOLDER_BBOARD,USERNAME_SAVE)! Set to BBOARD username
- IF (IER.EQ.2) GO TO 910 ! Can't set username. New VMS version?
- CALL SETACC(ACCOUNTB) ! Set to BBOARD account
- CALL SETUIC(IBCLR(GROUPB,31),IBCLR(USERB,31)) ! Set to BBOARD uic
- END IF
-
- LEN_B = TRIM(BBOARD_DIRECTORY)
- IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:LEN_B)//
- & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.TXT;*')
- ! Delete old TXT files left due to errors
-
- IF (.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)) THEN
- ! If normal BBOARD user
- IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)
- & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)
- CALL SYS$SETAST(%VAL(1))
- IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))
- CALL SYS$SETAST(%VAL(0))
- IF (((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR.
- & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN
- CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW)
- OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'READ_BOARD.COM',
- & STATUS='NEW',ERR=910,CARRIAGECONTROL='LIST')
- WRITE(11,'(A)') '$ SET PROTECT=(W:RWED)/DEFAULT'
- WRITE(11,'(A)') '$ SET PROC/PRIV=SYSPRV'
- WRITE(11,'(A)')
- & '$ DEFINE/USER EXTRACT_FILE '//BBOARD_DIRECTORY(:LEN_B)//
- & '''F$GETJPI("","USERNAME")'''
- WRITE(11,'(A)') '$ MAIL'
- WRITE(11,'(A)') 'SELECT MAIL'
- WRITE(11,'(A)') 'READ'
- WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'
- WRITE(11,'(A)') 'DELETE/ALL'
- WRITE(11,'(A)') 'READ/NEW'
- WRITE(11,'(A)') 'EXTRACT/ALL/APPEND EXTRACT_FILE'
- WRITE(11,'(A)') 'DELETE/ALL'
- WRITE(11,'(A)') 'SELECT/NEW'
- CLOSE(UNIT=11)
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
- IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)
- & //'READ_BOARD.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)
- CALL SYS$SETAST(%VAL(1))
- IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))
- CALL SYS$SETAST(%VAL(0))
- END IF
- ELSE
- CONTEXT = 0
- IER = LIB$FIND_FILE(BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD
- & (:TRIM(FOLDER_BBOARD))//'.COM',INPUT,CONTEXT)
- IF (IER) THEN
- IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//
- & FOLDER_BBOARD(:TRIM(FOLDER_BBOARD))//'.COM','NL:',
- & 'NL:',1,,,STATUS,SPAWN_EF)
- CALL SYS$SETAST(%VAL(1))
- IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))
- CALL SYS$SETAST(%VAL(0))
- END IF
- IF (.NOT.IER.OR.((STATUS.AND.'1FFFF'X).EQ.RMS$_FNF) .OR.
- & ((STATUS .AND. '1FFF0'X).EQ. (RMS$_SPL .AND. '1FFF0'X))) THEN
- IER = LIB$SPAWN('$@'//BBOARD_DIRECTORY(:LEN_B)//
- & 'BOARD_SPECIAL.COM','NL:','NL:',1,,,STATUS,SPAWN_EF)
- CALL SYS$SETAST(%VAL(1))
- IF (IER) CALL SYS$WAITFR(%VAL(SPAWN_EF))
- CALL SYS$SETAST(%VAL(0))
- END IF
- END IF
-
- CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),FOLDER_Q,FOLDER_COM)
-
- NBULL = F_NBULL
-
- CALL SETACC(ACCOUNT_SAVE) ! Reset to original account
- CALL SETUSER(USERNAME_SAVE) ! Reset to original username
- CALL SETUIC(GROUP_SAVE,USER_SAVE) ! Reset to original uic
-
- OPEN (UNIT=14,FILE=BBOARD_DIRECTORY(:LEN_B)//FOLDER_BBOARD
- & (:TRIM(FOLDER_BBOARD))//'.TXT',STATUS='OLD',ERR=100)
- READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read first line
- CALL SYS$SETAST(%VAL(1))
-
-5 CALL SYS$SETAST(%VAL(0))
-
- CALL READ_QUEUE(%VAL(FOLDER_Q_SAVE),IDUMMY,FOLDER_COM)
-
- DO WHILE (LEN_INPUT.GT.0)
- IF (INPUT(:5).EQ.'From:') THEN
- INFROM = INPUT(7:) ! Store username
- ELSE IF (INPUT(:5).EQ.'Subj:') THEN
- INDESCRIP = INPUT(7:) ! Store subject
- ELSE IF (INPUT(:3).EQ.'To:') THEN
- INTO = INPUT(5:) ! Store address
- END IF
- READ (14,'(Q,A)',END=100) LEN_INPUT,INPUT ! Read next line from mail
- END DO
-
- INTO = INTO(:TRIM(INTO))
- CALL STR$TRIM(INTO,INTO)
- CALL STR$UPCASE(INTO,INTO)
- FLEN = TRIM(FOLDER1_BBOARD)
- HEADER_Q = 0
- IF (.NOT.DETECT_BBOARD(INTO,FOLDER1_BBOARD(:FLEN))) THEN
- HEADER_Q = HEADER_Q1
- IER = 0
- NHEAD = 0
- CALL STRIP_HEADER(' ',0,STRIP)
- STRIP = .TRUE.
- DO WHILE (IER.EQ.0.AND.STRIP)
- READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
- IF (IER.EQ.0) THEN
- CALL STRIP_HEADER(INPUT,LEN_INPUT,STRIP)
- CALL WRITE_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
- NHEAD = NHEAD + 1
- END IF
- END DO
-
- FOUND = .FALSE.
- J = 0
- DO WHILE (J.LT.2.AND..NOT.FOUND)
- J = J + 1
- POINT_FOLDER1 = 0
- FOLDER_Q2 = FOLDER_Q1
- FOUND = .FALSE.
- DO WHILE (.NOT.FOUND.AND.POINT_FOLDER1.LT.NUM_FOLDERS)
- FOLDER_Q2_SAVE = FOLDER_Q2
- CALL READ_QUEUE(%VAL(FOLDER_Q2),FOLDER_Q2,FOLDER1_COM)
- POINT_FOLDER1 = POINT_FOLDER1 + 1
- IF (POINT_FOLDER1.LE.NUM_FOLDERS.AND.
- & FOLDER1_BBOARD(:2).NE.'::'.AND.
- & FOLDER1_BBOARD.NE.'NONE') THEN
- IF (J.EQ.1) THEN
- F_BBOARD = FOLDER1_BBOARD
- ELSE
- F_BBOARD = BBOARD_NAME(FOLDER1_BBOARD,FOLDER1_DESCRIP)
- END IF
- IF (J.EQ.1.OR.F_BBOARD.NE.FOLDER1_BBOARD) THEN
- FLEN = TRIM(F_BBOARD)
- FOUND = DETECT_BBOARD(INTO,F_BBOARD(:FLEN))
- IF (.NOT.FOUND.AND.NHEAD.GT.1) THEN
- HEADER_Q = HEADER_Q1
- I = 1
- DO WHILE (I.LT.NHEAD.AND..NOT.FOUND)
- CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
- FOUND = DETECT_BBOARD(INPUT,F_BBOARD(:FLEN))
- I = I + 1
- END DO
- END IF
- END IF
- END IF
- END DO
- END DO
- IF (FOUND) THEN
- FOLDER_COM = FOLDER1_COM
- FOLDER_Q_SAVE = FOLDER_Q2_SAVE
- END IF
- END IF
-
- IF (NHEAD.EQ.0) THEN
- READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT ! Read first line
- ELSE
- HEADER_Q = HEADER_Q1
- CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
- LEN_INPUT = TRIM(INPUT)
- NHEAD = NHEAD - 1
- END IF
-
- DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12).AND.IER.EQ.0)
- READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
- IF (INPUT(:5).EQ.'From:') GO TO 5
- END DO ! If line is just form feed, the message is empty
- IF (IER.NE.0) GO TO 100 ! If end of file, exit
-
- EFROM = 2
- I = TRIM(INFROM)
- DO WHILE (EFROM.GT.0.AND.I.GT.0) ! Strip off the date
- IF (INFROM(I:I).EQ.' ') EFROM = EFROM - 1 ! From the "From:" line
- I = I - 1
- END DO
- IF (I.GT.0) INFROM = INFROM(:I)
-
- CALL INIT_MESSAGE_ADD_BBOARD(INFROM,INDESCRIP,IER)
-
- ISTART = 0
- NBLANK = 0
- IER = 0
- DO WHILE (IER.EQ.0) ! Move text to bulletin file
- IF (LEN_INPUT.EQ.0) THEN
- IF (ISTART.EQ.1) THEN
- NBLANK = NBLANK + 1
- END IF
- ELSE
- ISTART = 1
- DO I=1,NBLANK
- CALL WRITE_MESSAGE_LINE(' ')
- END DO
- NBLANK = 0
- CALL WRITE_MESSAGE_LINE(INPUT)
- END IF
- IF (NHEAD.EQ.0) THEN
- READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
- ELSE
- CALL READ_QUEUE(%VAL(HEADER_Q),HEADER_Q,INPUT)
- LEN_INPUT = TRIM(INPUT)
- NHEAD = NHEAD - 1
- END IF
- IF (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)) THEN
- DO WHILE (LEN_INPUT.EQ.1.AND.INPUT(:1).EQ.CHAR(12)
- & .AND.IER.EQ.0)
- READ (14,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
- END DO
- IF (IER.EQ.0.AND.INPUT(:5).EQ.'From:') THEN
- IER = 1
- ELSE
- NBLANK = NBLANK + 1
- END IF
- END IF
- END DO
-
- CALL FINISH_MESSAGE_ADD ! Totally finished with add
-
- CALL SYS$SETAST(%VAL(1))
-
- GO TO 5 ! See if there is more mail
-
-100 CLOSE (UNIT=14,STATUS='DELETE') ! Close the input file
- CALL SYS$SETAST(%VAL(1))
- GO TO 1
-
-900 CALL SYS$SETAST(%VAL(0))
-
- FOLDER_NUMBER = 0
- CALL OPEN_BULLFOLDER_SHARED
- CALL READ_FOLDER_FILE_KEYNUM(0,IER)
- CALL CLOSE_BULLFOLDER
- CALL ENABLE_CTRL
- FOLDER_SET = .FALSE.
-
- IF (NBBOARD_FOLDERS.EQ.0) THEN
- CALL OPEN_BULLUSER
- CALL READ_USER_FILE_HEADER(IER)
- CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',BBOARD_BTIM)
- REWRITE (4) USER_HEADER ! Rewrite header
- CALL CLOSE_BULLUSER
- END IF
- CALL SYS$SETAST(%VAL(1))
-
- CALL SYS$SETAST(%VAL(0))
- IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED').AND.
- & .NOT.TEST_BULLCP().AND.TEST_BULLCP().NE.2) CALL NEWS2BULL
- CALL SYS$SETAST(%VAL(1))
-
- RETURN
-
-910 WRITE (6,1010)
- GO TO 100
-
-930 CLOSE (UNIT=14)
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- WRITE (6,1030)
- GO TO 100
-
-1010 FORMAT(' ERROR:Install program with CMKRNL privileges or relink.')
-1030 FORMAT(' ERROR:Alert system programmer. Data file problems.')
-
- END
-
-
-
-
- LOGICAL FUNCTION DETECT_BBOARD(INPUT,BBOARD)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INPUT,BBOARD
-
- DETECT_BBOARD = .TRUE.
-
- LEN_BBOARD = LEN(BBOARD) - 1
-
- DO I=1,TRIM(INPUT)-LEN_BBOARD
- IF (.NOT.STREQ(INPUT(:4),'Subj').AND.
- & STREQ(INPUT(I:I+LEN_BBOARD),BBOARD).AND.
- & (I.EQ.1.OR..NOT.ALPHA(INPUT(I-1:I-1))).AND.
- & (I.EQ.LEN(INPUT)-LEN_BBOARD.OR.
- & INDEX(' .@%!',INPUT(I+LEN_BBOARD+1:I+LEN_BBOARD+1)).GT.0))
- & RETURN
- END DO
-
- DETECT_BBOARD = .FALSE.
-
- RETURN
- END
-
-
-
- LOGICAL FUNCTION ALPHA(IN)
-
- CHARACTER*1 IN
-
- ALPHA = (ICHAR(IN).GE.ICHAR('A').AND.ICHAR(IN).LE.ICHAR('Z'))
- & .OR.(ICHAR(IN).GE.ICHAR('a').AND.ICHAR(IN).LE.ICHAR('z'))
-
- RETURN
- END
-
-
-
- CHARACTER*(*) FUNCTION BBOARD_NAME(FOLDER_BBOARD,FOLDER_DESCRIP)
-
- CHARACTER*(*) FOLDER_BBOARD,FOLDER_DESCRIP
-
- BBOARD_NAME = FOLDER_BBOARD
-
- I = INDEX(FOLDER_DESCRIP,'<')
- IF (I.EQ.0) RETURN
-
- BBOARD_NAME = FOLDER_DESCRIP(I+1:)
-
- I = INDEX(BBOARD_NAME,'%"')
- IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(I+2:)
-
- I = INDEX(BBOARD_NAME,'!')
- DO WHILE (I.GT.0)
- BBOARD_NAME = BBOARD_NAME(I+1:)
- I = INDEX(BBOARD_NAME,'!')
- END DO
-
- I = INDEX(BBOARD_NAME,'>')
- IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1)
- I = INDEX(BBOARD_NAME,'@')
- IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1)
- I = INDEX(BBOARD_NAME,'%')
- IF (I.GT.0) BBOARD_NAME = BBOARD_NAME(:I-1)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CREATE_PROCESS(COMMAND)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PRCDEF)'
-
- INCLUDE 'BULLFILES.INC'
-
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
-
- CHARACTER*132 IMAGENAME
-
- CHARACTER*(*) COMMAND
-
- CALL GETIMAGE(IMAGENAME,ILEN)
-
- LEN_B = TRIM(BBOARD_DIRECTORY)
-
- OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM',
- & STATUS='OLD',IOSTAT=IER)
- IF (IER.EQ.0) CLOSE(UNIT=11,STATUS='DELETE')
-
- CALL SYS$SETDFPROT('AA00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD:RW,GROUP:RW)
- OPEN(UNIT=11,FILE=BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM',
- & STATUS='NEW',IOSTAT=IER,CARRIAGECONTROL='LIST')
- IF (IER.NE.0) RETURN
- WRITE(11,'(A)') '$B:=$'//IMAGENAME(:ILEN)
- WRITE(11,'(A)') '$ON ERROR THEN GOTO EXIT'
- WRITE(11,'(A)') '$ON SEVERE THEN GOTO EXIT'
- WRITE(11,'(A)') '$ON WARNING THEN GOTO EXIT'
- WRITE(11,'(A)') '$B/'//'''F$PROCESS()'''
- WRITE(11,'(A)') '$EXIT:'
- WRITE(11,'(A)') '$LOGOUT'
- CLOSE(UNIT=11)
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
-
- DEL = .FALSE.
- IER = .FALSE.
-
- DO WHILE (.NOT.IER)
- IER = SYS$CREPRC(,'SYS$SYSTEM:LOGINOUT',
- & BBOARD_DIRECTORY(:LEN_B)//'BULL_COMMAND.COM','NL:',,
- & PROCPRIV,,COMMAND(:TRIM(COMMAND))
- & ,%VAL(4),,,%VAL(PRC$M_NOUAF+PRC$M_DETACH))
- IF (.NOT.IER.AND..NOT.DEL) THEN
- CALL DELPRC('BULLCP NEWS',DEL)
- IER = .NOT.DEL
- ELSE
- IER = .TRUE.
- END IF
- END DO
-
- RETURN
- END
-
-
-
- SUBROUTINE GETUIC(GRP,MEM)
-C
-C SUBROUTINE GETUIC(UIC)
-C
-C FUNCTION:
-C To get UIC of process submitting the job.
-C OUTPUT:
-C GRP - Group number of UIC
-C MEM - Member number of UIC
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($JPIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- ! Now add items to list
- CALL ADD_2_ITMLST(4,JPI$_GRP,%LOC(GRP))
- CALL ADD_2_ITMLST(4,JPI$_MEM,%LOC(MEM))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command.
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_UPTIME(UPTIME_DATE,UPTIME_TIME)
-C
-C SUBROUTINE GET_UPTIME
-C
-C FUNCTION: Gets time of last reboot.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($SYIDEF)'
-
- INTEGER UPTIME(2)
- CHARACTER*(*) UPTIME_TIME,UPTIME_DATE
- CHARACTER ASCSINCE*23
-
- CALL INIT_ITMLST
- CALL ADD_2_ITMLST(8,SYI$_BOOTTIME,%LOC(UPTIME))
- CALL END_ITMLST(GETSYI_ITMLST)
-
- IER = SYS$GETSYI(,,,%VAL(GETSYI_ITMLST),,,)
-
- CALL SYS$ASCTIM(,ASCSINCE,UPTIME,)
-
- UPTIME_DATE = ASCSINCE(:11)
- UPTIME_TIME = ASCSINCE(13:)
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION GET_L_VAL(I)
- INTEGER I
- GET_L_VAL = I
- RETURN
- END
-
-
-
- SUBROUTINE CHECK_MAIL(NEW_MAIL)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /KNOWN_FOLDERS/ FOLDER_Q1,NUM_FOLDERS
- DATA FOLDER_Q1/0/
-
- DIMENSION NEW_MAIL(1)
-
- CHARACTER INPUT*132
-
- INTEGER*2 COUNT
-
- FOLDER_Q = FOLDER_Q1 ! so reinit queue pointer
-
- OPEN (UNIT=10,FILE='VMSMAIL_PROFILE',
- & DEFAULTFILE='SYS$SYSTEM:VMSMAIL_PROFILE.DATA',
- & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
- & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)
-
- DO I=1,NUM_FOLDERS
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
-
- IF (((.NOT.BTEST(USERB,31).AND.(USERB.NE.0.OR.GROUPB.NE.0)).OR.
- & BTEST(GROUPB,31)).AND.FOLDER_BBOARD(:2).NE.'::'.AND.
- & FOLDER_BBOARD.NE.'NONE') THEN ! If normal BBOARD or /VMSMAIL
- DO WHILE (REC_LOCK(IER1))
- READ(10,'(A)',KEY=FOLDER_BBOARD,IOSTAT=IER1) INPUT
- END DO
- COUNT = 0
- IF (IER1.EQ.0) THEN
- INPUT = INPUT(32:)
- DO WHILE (TRIM(INPUT).GT.0)
- IF (ICHAR(INPUT(1:1)).EQ.1) THEN
- CALL LIB$MOVC3(2,%REF(INPUT(5:)),COUNT)
- INPUT = ' '
- ELSE
- INPUT = INPUT(ICHAR(INPUT(3:3))+5:)
- END IF
- END DO
- END IF
- IF (IER1.EQ.0.AND.(COUNT.GT.0.OR.IER.NE.0)) THEN
- NEW_MAIL(I) = .TRUE.
- ELSE
- NEW_MAIL(I) = .FALSE.
- END IF
- ELSE
- NEW_MAIL(I) = .TRUE.
- END IF
- END DO
-
- CLOSE (10)
-
- RETURN
- END
-
-
-
- SUBROUTINE GETIMAGE(IMAGNAME,ILEN)
-C
-C SUBROUTINE GETIMAGE(IMAGNAME,ILEN)
-C
-C FUNCTION:
-C To get image name of process.
-C OUTPUT:
-C IMAGNAME - Image name of process
-C ILEN - Length of imagename
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($JPIDEF)'
-
- CHARACTER*(*) IMAGNAME
-
- CALL INIT_ITMLST ! Initialize item list
- ! Now add items to list
- CALL ADD_2_ITMLST_WITH_RET(LEN(IMAGNAME),JPI$_IMAGNAME,
- & %LOC(IMAGNAME),%LOC(ILEN))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get Info command.
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_NEWEST_MSG(IN_BTIM,START)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- DIMENSION IN_BTIM(2)
-
- IF (REMOTE_SET) THEN
- CALL REMOTE_GET_NEWEST_MSG(IN_BTIM,START)
- ELSE
- CALL GET_MSGKEY(IN_BTIM,MSG_KEY)
- CALL READDIR_KEYGE(START)
- IF (START.EQ.0) THEN
- START = -1
- END IF
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE NOTIFY_REMOTE_USERS(IN_BTIM)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- DIMENSION IN_BTIM(2)
-
- CALL GET_MSGKEY(IN_BTIM,MSG_KEY)
- CALL READDIR_KEYGE(START)
-
- IF (START.EQ.0) RETURN
-
- CALL OPEN_BULLUSER_SHARED
-
- IER = START + 1
- DO WHILE (START+1.EQ.IER)
- IF (.NOT.BTEST(SYSTEM,3)) CALL NOTIFY_USERS(0)
- START = START + 1
- CALL READDIR(START,IER)
- END DO
-
- CALL CLOSE_BULLDIR
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE READ_NOTIFY
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG)
-
- CALL OPEN_BULLUSER_SHARED
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE
- END DO
-
- IF (IER.NE.0) THEN
- DO I=1,FLONG
- NOTIFY_REMOTE(I) = 0
- END DO
- WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE
- END IF
-
- CALL CLOSE_BULLDIR
-
- RETURN
- END
-
-
-
- SUBROUTINE DELPRC(DELNAM,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($JPIDEF)'
-
- CHARACTER*(*) DELNAM
-
- CHARACTER PRCNAM*15
-
- WILDCARD = -1
-
- CALL INIT_ITMLST ! Initialize item list
- ! Now add items to list
- CALL ADD_2_ITMLST(LEN(PRCNAM),JPI$_PRCNAM,%LOC(PRCNAM))
- CALL ADD_2_ITMLST(4,JPI$_PID,%LOC(PID))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
- IER = 1
- DO WHILE (IER.AND.PRCNAM(:LEN(DELNAM)).NE.DELNAM)
- ! Get next interactive process
- IER = SYS$GETJPIW(,WILDCARD,,%VAL(GETJPI_ITMLST),,,,)
- ! Get next process.
- END DO
- IF (IER.AND.PID.NE.0) IER = SYS$DELPRC(PID,)
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin4.for b/decus/vax91b/bulletin-net91b/bulletin4.for
deleted file mode 100644
index 4cc27940ecdf95668f7c3fb7d757bbe2637b803d..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin4.for
+++ /dev/null
@@ -1,1807 +0,0 @@
-C
-C BULLETIN4.FOR, Version 5/4/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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
-C
-C SUBROUTINE ITMLST_SUBS
-C
-C FUNCTION:
-C A set of routines to easily create item lists. It allows one
-C to easily create item lists without the need for declaring arrays
-C or itemlist size. Thus, the code can be easily changed to add or
-C delete item list codes.
-C
-C Here is an example of how to use the routines (prints file to a queue):
-C
-C CALL INIT_ITMLST ! Initialize item list
-C ! Now add items to list
-C CALL ADD_2_ITMLST(LEN,SJC$_FILE_SPECIFICATION,%LOC(FILENAME))
-C CALL ADD_2_ITMLST(9,SJC$_QUEUE,%LOC(QUEUE))
-C CALL END_ITMLST(SNDJBC_ITMLST) ! Get address of itemlist
-C IER = SYS$SNDJBCW(,%VAL(SJC$_ENTER_FILE),,%VAL(SNDJBC_ITMLST),IOSB,,)
-C
- SUBROUTINE ITMLST_SUBS
-
- IMPLICIT INTEGER (A-Z)
-
- DATA SAVE_ITMLST_ADDRESS/0/,NUM_ITEMS/0/,QUEUE_HEADER/0/
-
- ENTRY INIT_ITMLST
-
- IF (QUEUE_HEADER.EQ.0) THEN ! First time INIT_ITMLST ever called?
- CALL LIB$GET_VM(8,QUEUE_HEADER) ! Yes, create queue header pointer
- CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER)) ! Zero out header
- CALL LIB$MOVC3(4,0,%VAL(QUEUE_HEADER+4)) ! Zero out header
- ELSE IF (SAVE_ITMLST_ADDRESS.GT.0) THEN ! Clean out old item list
- CALL LIB$FREE_VM((NUM_ITEMS+1)*12,SAVE_ITMLST_ADDRESS)
- NUM_ITEMS = 0 ! Release old itemlist memory
- SAVE_ITMLST_ADDRESS = 0
- ELSE ! ITMLST calls cannot be nested.
- WRITE (6,'('' ERROR: INIT_ITMLST called before previous'',$)')
- WRITE (6,'(''+ ITMLST terminated with END_ITMLST.'')')
- CALL EXIT
- END IF
-
- RETURN
-
-
- ENTRY ADD_2_ITMLST(BUFLEN,CODE,BUFADR)
-C
-C ITMLST entries are initially stored in a queue. Each queue entry
-C needs 8 bytes for pointer + 12 bytes for itemlist info.
-C
- CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry
-
- CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,0)
- ! Store data in itemlist format
- CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER))
- ! Insert entry into queue
- NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count
-
- RETURN
-
-
- ENTRY ADD_2_ITMLST_WITH_RET(BUFLEN,CODE,BUFADR,RETADR)
-C
-C ITMLST entries are initially stored in a queue. Each queue entry
-C needs 8 bytes for pointer + 12 bytes for itemlist info.
-C
- CALL LIB$GET_VM(20,INPUT_ITMLST) ! Get memory for entry
-
- CALL STORE_ITMLST_ENTRY(%VAL(INPUT_ITMLST+8),BUFLEN,CODE,BUFADR,
- & RETADR)
- ! Store data in itemlist format
- CALL LIB$INSQTI(%VAL(INPUT_ITMLST),%VAL(QUEUE_HEADER))
- ! Insert entry into queue
- NUM_ITEMS = NUM_ITEMS + 1 ! Increment item count
-
- RETURN
-
-
- ENTRY END_ITMLST(ITMLST_ADDRESS)
-
- CALL LIB$GET_VM((NUM_ITEMS+1)*12,ITMLST_ADDRESS)
- ! Get memory for itemlist
- SAVE_ITMLST_ADDRESS = ITMLST_ADDRESS ! Save address to remove memory
-
- DO I=1,NUM_ITEMS ! Place entries into itemlist
- CALL LIB$REMQHI(%VAL(QUEUE_HEADER),INPUT_ITMLST)
- CALL LIB$MOVC3(12,%VAL(INPUT_ITMLST+8),
- & %VAL(ITMLST_ADDRESS+(I-1)*12))
- CALL LIB$FREE_VM(20,INPUT_ITMLST)
- END DO
-
- CALL LIB$MOVC3(4,0,%VAL(ITMLST_ADDRESS+NUM_ITEMS*12))
- ! Place terminating 0 at end of itemlist
-
- RETURN
- END
-
-
-
- SUBROUTINE STORE_ITMLST_ENTRY(INPUT_ITMLST,BUFLEN,CODE,BUFADR,
- & RETADR)
-
- IMPLICIT INTEGER (A-Z)
-
- STRUCTURE /ITMLST/
- UNION
- MAP
- INTEGER*2 BUFLEN,CODE
- INTEGER BUFADR,RETADR
- END MAP
- END UNION
- END STRUCTURE
-
- RECORD /ITMLST/ INPUT_ITMLST(1)
-
- INPUT_ITMLST(1).BUFLEN = BUFLEN
- INPUT_ITMLST(1).CODE = CODE
- INPUT_ITMLST(1).BUFADR = BUFADR
- INPUT_ITMLST(1).RETADR = RETADR
-
- RETURN
- END
-
-
- SUBROUTINE CLEANUP_LOGIN
-C
-C SUBROUTINE CLEANUP_LOGIN
-C
-C FUNCTION: Removes entry in user file of user that no longer exist.
-C It creates empty space for new user.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- CHARACTER*12 LOGIN_USER
-
- CHARACTER TODAY*23
-
- DIMENSION TODAY_BTIM(2)
-
- MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED')
-
- CALL SYS$ASCTIM(,TODAY,,) ! Get the present time
- CALL SYS_BINTIM(TODAY,TODAY_BTIM)
-
- CALL OPEN_SYSUAF_SHARED
-
- LOGIN_USER = USERNAME
- READ (4,IOSTAT=IER1,KEYGT=USERNAME) USER_ENTRY ! Look forward one
- TEMP_USER = USERNAME
- USERNAME = LOGIN_USER
- DO WHILE (REC_LOCK(IER))
- READ (8,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER ! See if user exists
- END DO
-
- IF (IER.NE.0.AND.IER1.EQ.0.AND.TEMP_USER.NE.USER_HEADER_KEY) THEN
- ! If no UAF entry and last login was
- ! more than 6 months old, delete entry
- IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN
- DELETE(UNIT=4) ! Delete non-existant user
- CALL OPEN_BULLINF
- READ (9,KEY=TEMP_USER,IOSTAT=IER)
- IF (IER.EQ.0) DELETE(UNIT=9)
- LU = TRIM(TEMP_USER)
- IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'//
- & TEMP_USER(:LU)//'.*MARK;*')
- TEMP_USER(LU:LU) = CHAR(ICHAR(TEMP_USER(LU:LU)).OR.128)
- READ (9,KEY=TEMP_USER,IOSTAT=IER)
- IF (IER.EQ.0) DELETE(UNIT=9)
- IF (LU.GT.1) THEN
- TEMP_USER(LU-1:LU-1) =
- & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))
- ELSE
- TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2)))
- END IF
- READ (9,KEY=TEMP_USER,IOSTAT=IER)
- IF (IER.EQ.0) DELETE(UNIT=9)
- CALL CLOSE_BULLINF
- END IF
- END IF
-
- CALL CLOSE_SYSUAF ! All done...
-
- RETURN
- END
-
-
- SUBROUTINE TOTAL_CLEANUP_LOGIN
-C
-C SUBROUTINE TOTAL_CLEANUP_LOGIN
-C
-C FUNCTION: Removes all entries in user file of usesr that no longer exist
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG)
-
- CHARACTER TODAY*23
-
- DIMENSION TODAY_BTIM(2)
-
- CALL SYS$ASCTIM(,TODAY,,) ! Get the present time
- CALL SYS_BINTIM(TODAY,TODAY_BTIM)
-
- MARK = SYS_TRNLNM_SYSTEM('BULL_MARK','DEFINED')
-
- CALL OPEN_SYSUAF_SHARED
- CALL OPEN_BULLUSER
- CALL OPEN_BULLINF
-
- TEMP_USER = USERNAME
-
- IER = 0
-
- DO WHILE (IER.EQ.0) ! Clean out BULLUSER.DAT
- READ (4,IOSTAT=IER) USER_ENTRY
- IF (IER.EQ.0.AND.USERNAME(:1).NE.'*'.AND.
- & USERNAME(:1).NE.':'.AND.
- & USERNAME.NE.USER_HEADER_KEY) THEN ! See if user exists
- DO WHILE (REC_LOCK(IER))
- READ (8,KEY=USERNAME,IOSTAT=IER)
- END DO
- IF (IER.NE.0) THEN ! If no UAF entry and last login was
- ! more than 6 months old, delete entry
- IF (MINUTE_DIFF(TODAY_BTIM,LOGIN_BTIM).GT.6*30*24*60) THEN
- DELETE (UNIT=4)
- READ (9,KEY=USERNAME,IOSTAT=IER)
- IF (IER.EQ.0) DELETE (UNIT=9)
- LU = TRIM(USERNAME)
- IF (MARK) CALL LIB$DELETE_FILE('BULL_MARK:'//
- & USERNAME(:LU)//'.*MARK;*')
- USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).OR.128)
- READ (9,KEY=USERNAME,IOSTAT=IER)
- IF (IER.EQ.0) DELETE (UNIT=9)
- IF (LU.GT.1) THEN
- USERNAME(LU-1:LU-1) =
- & CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1)))
- ELSE
- USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2)))
- END IF
- READ (9,KEY=USERNAME,IOSTAT=IER)
- IF (IER.EQ.0) DELETE (UNIT=9)
- END IF
- IER = 0
- ELSE
- DO I=0,FOLDER_MAX-1
- IF (TEST2(NOTIFY_FLAG,I)) THEN
- CALL SET2(NOTIFY_REMOTE,I)
- END IF
- END DO
- END IF
- END IF
- END DO
-
- CALL CLOSE_SYSUAF ! All done...
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER
- END DO
-
- IF (IER.NE.0) THEN
- WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE
- ELSE
- REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE
- END IF
-
- READ (9,KEYGT=' ',IOSTAT=IER) USERNAME
-
- DO WHILE (IER.EQ.0) ! Clean out BULLINF.DAT
- LU = TRIM(USERNAME)
- USERNAME(LU:LU) = CHAR(ICHAR(USERNAME(LU:LU)).AND.127)
- IF (LU.GT.1) THEN
- USERNAME(LU-1:LU-1) =
- & CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))
- ELSE
- USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))
- END IF
- READ (4,KEYEQ=USERNAME,IOSTAT=IER)
- IF (IER.NE.0) DELETE (UNIT=9)
- READ (9,IOSTAT=IER) USERNAME
- END DO
-
- CALL CLOSE_BULLINF
- CALL CLOSE_BULLUSER
-
- USERNAME = TEMP_USER
-
- RETURN
- END
-
-
- SUBROUTINE COPY_BULL(INLUN,IBLOCK,OBLOCK,IER)
-C
-C SUBROUTINE COPY_BULL
-C
-C FUNCTION: To copy data to the bulletin file.
-C
-C INPUT:
-C INLUN - Input logical unit number
-C IBLOCK - Input block number in input file to start at
-C OBLOCK - Output block number in output file to start at
-C
-C OUTPUT:
-C IER - If error in writing to bulletin, IER will be <> 0.
-C
-C NOTES: Input file is accessed using sequential access. This is
-C to allow files which have variable records to be read. The
-C bulletin file is assumed to be opened on logical unit 1.
-C
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /LAST_RECORD_WRITTEN/ OCOUNT
-
- INCLUDE 'BULLDIR.INC'
-
- IF (REMOTE_SET) THEN
- CALL REMOTE_COPY_BULL(IER)
- IF (IER.NE.0) CALL ERROR_AND_EXIT
- END IF
-
- DO I=1,IBLOCK-1
- READ(INLUN,'(A)')
- END DO
-
- OCOUNT = OBLOCK
- ICOUNT = IBLOCK
-
- NBLANK = 0
- LENGTH = 0
- DO WHILE (1)
- ILEN = 0
- DO WHILE (ILEN.EQ.0)
- READ(INLUN,'(Q,A)',END=100) ILEN,INPUT
- ILEN = MIN(ILEN,TRIM(INPUT),LINE_LENGTH)
- IF (ILEN.GT.1.AND.ICHAR(INPUT(ILEN:ILEN)).EQ.10) THEN
- INPUT(ILEN-1:ILEN-1) = CHAR(32) ! Remove imbedded
- INPUT(ILEN:ILEN) = CHAR(32) ! CR/LFs at end of file.
- ILEN = ILEN - 2
- END IF
- IF (ILEN.GT.0) THEN
- IF (ICOUNT.EQ.IBLOCK) THEN
- IF (INPUT(:6).EQ.'From: ') THEN
- INPUT(:4) = 'FROM'
- END IF
- END IF
- ICOUNT = ICOUNT + 1
- ELSE IF (ILEN.EQ.0.AND.ICOUNT.GT.IBLOCK) THEN
- NBLANK = NBLANK + 1
- END IF
- END DO
- IF (NBLANK.GT.0) THEN
- DO I=1,NBLANK
- CALL STORE_BULL(1,' ',OCOUNT)
- END DO
- LENGTH = LENGTH + NBLANK*2
- NBLANK = 0
- END IF
- CALL STORE_BULL(ILEN,INPUT,OCOUNT)
- LENGTH = LENGTH + ILEN + 1
- END DO
-
-100 LENGTH = (LENGTH+127)/128
- IF (LENGTH.EQ.0) THEN
- IER = 1
- ELSE
- IER = 0
- END IF
-
- CALL FLUSH_BULL(OCOUNT)
-
- RETURN
- END
-
-
-
- SUBROUTINE STORE_BULL(ILEN,INPUT,OCOUNT)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER BRECLEN=128
-
- CHARACTER INPUT*(*),OUTPUT*256
-
- DATA POINT/0/
-
- IF (ILEN+POINT+1.GT.BRECLEN) THEN
- IF (POINT.EQ.BRECLEN) THEN
- CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT))
- OUTPUT = CHAR(ILEN)//INPUT
- POINT = ILEN + 1
- ELSE IF (POINT.EQ.BRECLEN-1) THEN
- CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN))
- OUTPUT = INPUT
- POINT = ILEN
- ELSE
- CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:POINT)//CHAR(ILEN)
- & //INPUT(:BRECLEN-1-POINT))
- OUTPUT = INPUT(BRECLEN-POINT:)
- POINT = ILEN - (BRECLEN-1-POINT)
- END IF
- OCOUNT = OCOUNT + 1
- DO WHILE (POINT.GE.BRECLEN)
- CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN))
- OCOUNT = OCOUNT + 1
- OUTPUT = OUTPUT(BRECLEN+1:)
- POINT = POINT - BRECLEN
- END DO
- ELSE
- OUTPUT(POINT+1:) = CHAR(ILEN)//INPUT(:ILEN)
- POINT = POINT + ILEN + 1
- END IF
-
- RETURN
-
- ENTRY FLUSH_BULL(OCOUNT)
-
- IF (POINT.LT.BRECLEN) OUTPUT(POINT+1:POINT+1) = CHAR(0)
- CALL WRITE_BULL_FILE(OCOUNT,OUTPUT(:BRECLEN))
- POINT = 0
-
- RETURN
-
- END
-
-
- SUBROUTINE WRITE_BULL_FILE(OCOUNT,OUTPUT)
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*(*) OUTPUT
-
- IF (REMOTE_SET) THEN
- CALL REMOTE_WRITE_BULL_FILE(OUTPUT)
- ELSE
- WRITE (1'OCOUNT) OUTPUT
- END IF
-
- RETURN
- END
-
-
- SUBROUTINE GET_BULL_LINE(SBLOCK,BLENGTH,BUFFER,ILEN)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*(*) BUFFER
-
- COMMON /HEADER/ HEADER
- LOGICAL HEADER /.TRUE./
-
- COMMON /DATE/ DATE_LINE
- CHARACTER*(LINE_LENGTH) DATE_LINE
-
- IF (ILEN.GT.LINE_LENGTH) THEN ! First read?
- CALL STRIP_HEADER(BUFFER,0,IER)
- STRIP = .NOT.HEADER
- IBLOCK = SBLOCK ! Initialize pointers.
- BULL_HEADER = .TRUE.
- CALL GET_BULL(IBLOCK,BUFFER,ILEN)
- IF (ILEN.LE.0) IBLOCK = IBLOCK + 1
- MSG_SENT = .FALSE.
- ELSE ! Else set ILEN to zero
- ILEN = 0 ! to request next line
- END IF
-
- IF (MSG_SENT) THEN
- BUFFER = ' '
- ILEN = 1
- MSG_SENT = .FALSE.
- RETURN
- END IF
-
- DO WHILE (1)
- DO WHILE (ILEN.EQ.0) ! Read until line created
- CALL GET_BULL(IBLOCK,BUFFER,ILEN)
- IF (ILEN.LE.0) IBLOCK = IBLOCK + 1 ! Need to read new record.
- IF (IBLOCK.GE.SBLOCK+BLENGTH) RETURN ! No more records.
- END DO
-
- IF (STRIP) THEN
- IF (BULL_HEADER) THEN
- IF (BUFFER(:5).EQ.'From:'.OR.BUFFER(:5).EQ.'Subj:') THEN
- RETURN
- ELSE IF (BUFFER(:13).EQ.'Message sent:') THEN
- MSG_SENT = .TRUE.
- RETURN
- ELSE
- BULL_HEADER = .FALSE.
- END IF
- END IF
- IF (DATE_LINE.NE.' ') DATE_LINE = ' '
- CALL STRIP_HEADER(BUFFER,ILEN,STRIP)
- IF (DATE_LINE.NE.' ') THEN
- BUFFER = DATE_LINE
- ILEN = TRIM(DATE_LINE)
- MSG_SENT = .TRUE.
- RETURN
- END IF
- IF (STRIP.OR.(.NOT.STRIP.AND.TRIM(BUFFER).EQ.0)) ILEN = 0
- ELSE
- RETURN
- END IF
- END DO
-
- RETURN
-
- ENTRY TEST_MORE_RECORDS(SBLOCK,BLENGTH,IREC)
-
- IREC = (SBLOCK+BLENGTH-1) - IBLOCK
-
- RETURN
- END
-
-
- SUBROUTINE GET_BULL(IBLOCK,BUFFER,ILEN)
-C
-C SUBROUTINE GET_BULL
-C
-C FUNCTION: Outputs line from folder file.
-C
-C INPUT:
-C IBLOCK - Input block number in input file to read from.
-C
-C OUTPUT:
-C BUFFER - Character string containing output line.
-C ILEN - Length of character string. If 0, signifies that
-C new record needs to be read, -1 signifies error.
-C
-C NOTE: Since message file is stored as a fixed length (128) record file,
-C but message lines are variable, message lines may span one or
-C more record. This routine takes a record and outputs as many
-C lines as it can from the record. When no more lines can be
-C outputted, it returns ILEN=0 requesting the calling program to
-C increment the record counter.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /REMOTE_READ_MESSAGE/ SCRATCH_R1
- DATA SCRATCH_R1 /0/
-
- PARAMETER BRECLEN=128
-
- CHARACTER BUFFER*(*),TEMP*(BRECLEN), LEFT*(LINE_LENGTH)
-
- DATA POINT /1/, LEFT_LEN /0/
-
- IF (ILEN.GT.LINE_LENGTH) THEN ! First read?
- POINT = 1 ! Initialize pointers.
- LEFT_LEN = 0
- END IF
-
- IF (POINT.EQ.1) THEN ! Need to read new line?
- IF (INCMD(:4).EQ.'MOVE'.OR.INCMD(:4).EQ.'COPY') THEN
- DO WHILE (REC_LOCK(IER)) ! Read from file
- READ (11'IBLOCK,IOSTAT=IER) TEMP
- END DO
- ELSE IF (REMOTE_SET) THEN ! Remote folder?
- IF (IBLOCK.EQ.BLOCK) SCRATCH_R = SCRATCH_R1 ! Read lines
- CALL READ_QUEUE(%VAL(SCRATCH_R),SCRATCH_R,TEMP) ! from queue
- ELSE ! Local folder
- DO WHILE (REC_LOCK(IER)) ! Read from file
- READ (1'IBLOCK,IOSTAT=IER) TEMP
- END DO
- END IF
- ELSE IF (POINT.EQ.BRECLEN+1) THEN ! Read all of line
- ILEN = 0 ! so indicate need to read
- POINT = 1 ! new line to calling routine.
- RETURN
- END IF
-
- IF (IER.GT.0) THEN ! Error in reading file.
- ILEN = -1 ! ILEN = -1 signifies error
- POINT = 1
- LEFT_LEN = 0
- RETURN
- END IF
-
- IF (LEFT_LEN.GT.0) THEN ! Part of line is left from
- ILEN = ICHAR(LEFT(:1)) ! previous record read.
- IF (LEFT_LEN.LE.BRECLEN) THEN ! Rest of it is in next record.
- BUFFER = LEFT(2:ILEN-LEFT_LEN+1)//TEMP(:LEFT_LEN) ! Output line.
- POINT = LEFT_LEN + 1 ! Update pointers.
- LEFT_LEN = 0
- ELSE ! Rest of line is longer than
- LEFT(ILEN-LEFT_LEN+2:) = TEMP ! a record, so store record
- LEFT_LEN = LEFT_LEN - BRECLEN ! and request another read.
- ILEN = 0 ! Request new record read.
- END IF
- ELSE ! Else nothing left over.
- ILEN = ICHAR(TEMP(POINT:POINT)) ! Get line length
- IF (ILEN.GT.BRECLEN-POINT) THEN ! If it extends to next record
- LEFT = TEMP(POINT:) ! Store it in leftover buffer
- LEFT_LEN = ILEN - (BRECLEN-POINT) ! Store leftover length
- ILEN = 0 ! Request new record read
- POINT = 1 ! Update record pointer.
- ELSE IF (ILEN.EQ.0) THEN ! Empty line signifies
- POINT = 1 ! end of message.
- ELSE ! Else message line fully read
- BUFFER = TEMP(POINT+1:POINT+ILEN) ! So output it
- POINT = POINT+ILEN+1 ! and update pointer.
- END IF
- END IF
-
- RETURN
-
- ENTRY TEST_MORE_LINES(ILEN) ! Test for more lines in record.
- ! Returns length of next line.
- IF (POINT.EQ.BRECLEN+1) THEN ! If pointer greater than
- ILEN = 0 ! record, no more lines.
- ELSE ! Else there is another line.
- ILEN = ICHAR(TEMP(POINT:POINT)) ! Output it's length.
- END IF
-
- RETURN
-
- END
-
-
-
-
-
-
-
- SUBROUTINE DELETE_ENTRY(BULL_ENTRY)
-C
-C SUBROUTINE DELETE_ENTRY
-C
-C FUNCTION:
-C To delete a directory entry.
-C
-C INPUTS:
-C BULL_ENTRY - Bulletin entry number to delete
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- IF (NBULL.GT.0) THEN
- CALL READDIR(0,IER)
- NBULL = -NBULL
- CALL WRITEDIR(0,IER)
- END IF
-
- IF (BTEST(FOLDER_FLAG,1)) THEN
- OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',IOSTAT=IER,STATUS='OLD',
- & RECL=LINE_LENGTH,CARRIAGECONTROL='LIST',ACCESS='APPEND')
- IF (IER.NE.0) THEN
- OPEN(UNIT=3,FILE=FOLDER_FILE//'.LOG',ERR=900,
- & RECL=LINE_LENGTH,STATUS='NEW',CARRIAGECONTROL='LIST')
- ELSE
- WRITE (3,'(A)') CHAR(12)
- END IF
-
- CALL OPEN_BULLFIL
-
- ILEN = LINE_LENGTH + 1
-
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'From: ') THEN
- WRITE(3,1060) INPUT(7:ILEN),DATE//' '//TIME(:8)
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- ELSE
- WRITE(3,1060) FROM,DATE//' '//TIME(:8)
- END IF
- IF (ILEN.GT.0.AND.INPUT(:6).EQ.'Subj: ') THEN
- WRITE(3,1050) INPUT(7:ILEN)
- ELSE
- WRITE(3,1050) DESCRIP
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
- END IF
-
- DO WHILE (ILEN.GT.0)
- CALL GET_BULL_LINE(BLOCK,LENGTH,INPUT,ILEN)
- IF (ILEN.GT.0) WRITE (3,'(A)') INPUT(:ILEN)
- END DO
-
- CLOSE (UNIT=3) ! Bulletin copy completed
-
- CALL CLOSE_BULLFIL
- END IF
-
-900 CALL READDIR(BULL_ENTRY,IER)
- DELETE(UNIT=2)
-
- NEMPTY = NEMPTY + LENGTH
- CALL WRITEDIR(0,IER)
-
-1050 FORMAT('Description: ',A,/)
-1060 FORMAT(/,'From: ',A,' Date: ',A11)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_EXDATE(EXDATE,NDAYS)
-C
-C SUBROUTINE GET_EXDATE
-C
-C FUNCTION: Computes expiration date giving number of days to expire.
-C
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*11 EXDATE
-
- CHARACTER*3 MONTHS(12)
- DIMENSION LENGTH(12)
- DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP',
- & 'OCT','NOV','DEC'/
- DATA LENGTH/31,27,31,30,31,30,31,31,30,31,30,31/
-
- CALL SYS$ASCTIM(,EXDATE,,) ! Get the present date
-
- DECODE(2,'(I2)',EXDATE(:2)) DAY ! Get day
- DECODE(4,'(I4)',EXDATE(8:11)) YEAR ! Get year
-
- MONTH = 1
- DO WHILE (MONTHS(MONTH).NE.EXDATE(4:6)) ! Get month
- MONTH = MONTH + 1
- END DO
-
- IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length
- LENGTH(2) = 28 ! if we're in a leap year
- ELSE
- LENGTH(2) = 27
- END IF
-
- NUM_DAYS = NDAYS ! Put number of days into buffer variable
-
- DO WHILE (NUM_DAYS.GT.0)
- IF (NUM_DAYS+DAY.GT.LENGTH(MONTH)) THEN
- ! If expiration date exceeds end of month
- NUM_DAYS = NUM_DAYS - (LENGTH(MONTH) - DAY + 1)
- ! Decrement # of days by days left in month
- DAY = 1 ! Reset day to first of month
- MONTH = MONTH + 1 ! Increment month pointer
- IF (MONTH.EQ.13) THEN ! Moved into next year?
- MONTH = 1 ! Reset month pointer
- YEAR = YEAR + 1 ! Increment year pointer
- IF (MOD(YEAR,4).EQ.0) THEN ! Correct February length
- LENGTH(2) = 28 ! if we're in a leap year
- ELSE
- LENGTH(2) = 27
- END IF
- END IF
- ELSE ! If expiration date is within the month
- DAY = DAY + NUM_DAYS ! Find expiration day
- NUM_DAYS = 0 ! Force loop exit
- END IF
- END DO
-
- ENCODE(2,'(I2)',EXDATE(:2)) DAY ! Put day into new date
- ENCODE(4,'(I4)',EXDATE(8:11)) YEAR ! Put year into new date
- EXDATE(4:6) = MONTHS(MONTH) ! Put month into new date
-
- RETURN
- END
-
-
-
- SUBROUTINE GET_LINE(INPUT,LEN_INPUT)
-C
-C SUBROUTINE GET_LINE
-C
-C FUNCTION:
-C Gets line of input from terminal.
-C
-C OUTPUTS:
-C LEN_INPUT - Length of input line. If = -1, CTRLC entered.
-C if = -2, CTRLZ entered.
-C
-C NOTES:
-C Also, on first call, set LEN_INPUT to 1+LENGTH OF INPUT CHARCTER
-C for initializing the CTRLC AST.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- LOGICAL*1 DESCRIP(8),DTYPE,CLASS
- INTEGER*2 LENGTH
- CHARACTER*(*) INPUT
- EQUIVALENCE (DESCRIP(1),LENGTH),(DESCRIP(3),DTYPE)
- EQUIVALENCE (DESCRIP(4),CLASS),(DESCRIP(5),POINTER)
-
- DATA LENGTH/0/,DTYPE/0/,CLASS/2/,POINTER/0/
-
- EXTERNAL SMG$_EOF
-
- COMMON /DECNET/ DECNET_PROC,ERROR_UNIT
- LOGICAL DECNET_PROC
-
- COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID
-
- COMMON /CTRLC_FLAG/ FLAG
-
- CHARACTER PROMPT*(*),NULLPROMPT*1
- LOGICAL*1 USE_PROMPT
-
- USE_PROMPT = .FALSE.
-
- GO TO 5
-
- ENTRY GET_INPUT_PROMPT(INPUT,LEN_INPUT,PROMPT)
-
- USE_PROMPT = .TRUE.
-
-5 LIMIT = LEN(INPUT) ! Get input line size limit
- INPUT = ' ' ! Clean out input buffer
-
-C
-C Initialize CTRL-C AST with AST routine CTRLC_ROUTINE and
-C AST parameter FLAG. When CTRLC occurs, FLAG is set to 1
-C
-
- CALL DECLARE_CTRLC_AST
-
- LEN_INPUT = 0 ! Nothing inputted yet
-
-C
-C LIB$GET_INPUT is nice way of getting input from terminal,
-C as it handles such thing as accidental wrap around to next line.
-C
-
- IF (DECNET_PROC) THEN
- READ (5,'(Q,A)',IOSTAT=IER) LEN_INPUT,INPUT
- IF (IER.NE.0) LEN_INPUT = -2
- RETURN
- ELSE IF (USE_PROMPT) THEN
- IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
- & DESCRIP,PROMPT) ! Get line from terminal with prompt
- ELSE
- IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
- & DESCRIP,NULLPROMPT) ! Get line from terminal with no prompt
- END IF
-
- IF (.NOT.IER.AND.IER.NE.%LOC(SMG$_EOF)) CALL EXIT(IER)
-
- CALL STR$TRIM(DESCRIP,DESCRIP,LEN_INPUT)
-
- IF (FLAG.EQ.0) THEN ! If no CTRL-C has occurred
- CALL CANCEL_CTRLC_AST ! Cancel CTRL-C AST
- IF (IER.NE.%LOC(SMG$_EOF)) THEN ! End of input?
- LEN_INPUT = MIN(LIMIT,LENGTH) ! No. Get length of line
- DO I=0,LEN_INPUT-1 ! Extract from descriptor
- CALL GET_VAL(INPUT(I+1:I+1),%VAL(POINTER+I))
- END DO
- CALL CONVERT_TABS(INPUT,LEN_INPUT)
- LEN_INPUT = MAX(LEN_INPUT,LENGTH)
- ELSE
- LEN_INPUT = -2 ! If CTRL-Z, say so
- END IF
- ELSE
- LEN_INPUT = -1 ! If CTRL-C, say so
- END IF
- RETURN
- END
-
-
-
- SUBROUTINE CONVERT_TABS(INPUT,LEN_INPUT)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INPUT
-
- PARAMETER TAB = CHAR(9)
-
- LIMIT = LEN(INPUT)
-
- DO WHILE (INDEX(INPUT,TAB).GT.0.AND.LEN_INPUT.LT.LIMIT)
- TAB_POINT = INDEX(INPUT,TAB) ! Remove tabs
- MOVE = ((TAB_POINT-1)/8)*8 + 9
- ADD = MOVE - TAB_POINT
- IF (MOVE-1.LE.LIMIT) THEN
- INPUT(MOVE:) = INPUT(TAB_POINT+1:)
- DO I = TAB_POINT,MOVE-1
- INPUT(I:I) = ' '
- END DO
- LEN_INPUT = LEN_INPUT + ADD - 1
- ELSE
- DO I = TAB_POINT,LIMIT
- INPUT(I:I) = ' '
- END DO
- LEN_INPUT = LIMIT+1
- END IF
- END DO
-
- CALL FILTER (INPUT, LEN_INPUT)
-
- RETURN
- END
-
-
- SUBROUTINE FILTER (INCHAR, LENGTH)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INCHAR
-
- DO I = 1,LENGTH
- IF ((INCHAR(I:I).LT.' '.AND.
- & INCHAR(I:I).NE.CHAR(13).AND.INCHAR(I:I).NE.CHAR(10)))
- & INCHAR(I:I) = '.'
- END DO
-
- RETURN
- END
-
-
- SUBROUTINE GET_VAL(OUTPUT,INPUT) ! Used to convert logical
- CHARACTER*(*) OUTPUT ! byte to character value
- LOGICAL*1 INPUT
- OUTPUT = CHAR(INPUT)
- RETURN
- END
-
- SUBROUTINE CTRLC_ROUTINE ! CTRL-C AST routine
- IMPLICIT INTEGER (A-Z) ! If CTRL-C, come here
-
- COMMON /CTRLY/ CTRLY
-
- COMMON /CTRLC_FLAG/ FLAG
-
- COMMON /DEF_PROT/ ORIGINAL_DEF_PROT
-
- IF (FLAG.EQ.2) THEN
- CALL LIB$PUT_OUTPUT('Bulletin aborting...')
- CALL SYS$CANEXH()
- CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,)
- CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C
- CALL EXIT
- END IF
- FLAG = 1 ! to set flag
- RETURN
- END
-
-
-
- SUBROUTINE DECLARE_CTRLC_AST
-C
-C SUBROUTINE DECLARE_CTRLC_AST
-C
-C FUNCTION:
-C Declares a CTRLC ast.
-C NOTES:
-C Assumes terminal assigned to TERM_CHAN in common /TERM_CHAN/.
-C
- IMPLICIT INTEGER (A-Z)
-
- EXTERNAL IO$_SETMODE,IO$M_CTRLCAST,CTRLC_ROUTINE
- COMMON /TERM_CHAN/ TERM_CHAN
-
- COMMON /CTRLC_FLAG/ FLAG
-
- FLAG = 0 ! Init CTRL-C flag
- IO_CTRLC = %LOC(IO$_SETMODE)+%LOC(IO$M_CTRLCAST) ! Set AST code
- IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO
- & CTRLC_ROUTINE,,,,,) ! Enable the AST
-
- RETURN
-
- ENTRY CANCEL_CTRLC_AST
-
- IER = SYS$CANCEL(%VAL(TERM_CHAN))
-
- FLAG = 2 ! Indicates that a CTRLC will cause an exit
- IER=SYS$QIOW(,%VAL(TERM_CHAN),%VAL(IO_CTRLC),,,, ! for QIO
- & CTRLC_ROUTINE,,,,,) ! Enable the AST
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_INPUT_NOECHO(DATA)
-C
-C SUBROUTINE GET_INPUT_NOECHO
-C
-C FUNCTION: Reads data in from terminal without echoing characters.
-C Also contains entry to assign terminal.
-C
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) DATA,PROMPT
-
- COMMON /TERM_CHAN/ TERM_CHAN
-
- COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID
-
- COMMON /CTRLC_FLAG/ FLAG
-
- COMMON /READIT/ READIT
-
- INCLUDE '($TRMDEF)'
-
- INTEGER TERMSET(2)
-
- INTEGER MASK(4)
- DATA MASK/4*'FFFFFFFF'X/
-
- DATA PURGE/.TRUE./
-
- DO I=1,LEN(DATA)
- DATA(I:I) = ' '
- END DO
-
- IF (PURGE) THEN
- CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),
- & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE)
- PURGE = .FALSE.
- ELSE
- CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),
- & TRM$M_TM_NOECHO)
- END IF
-
- RETURN
-
- ENTRY GET_INPUT_NOECHO_PROMPT(DATA,PROMPT)
-
- DO I=1,LEN(DATA)
- DATA(I:I) = ' '
- END DO
-
- IF (PURGE) THEN
- CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),
- & TRM$M_TM_NOECHO.OR.TRM$M_TM_PURGE)
- PURGE = .FALSE.
- ELSE
- CALL SMG$READ_STRING(KEYBOARD_ID,DATA,PROMPT,LEN(DATA),
- & TRM$M_TM_NOECHO)
- END IF
-
- RETURN
-
- ENTRY GET_INPUT_NUM(DATA,NLEN)
-
- DO I=1,LEN(DATA)
- DATA(I:I) = ' '
- END DO
-
- IF (PURGE) THEN
- CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),
- & TRM$M_TM_PURGE,,TERMSET,NLEN,TERM)
- PURGE = .FALSE.
- ELSE
- CALL SMG$READ_STRING(KEYBOARD_ID,DATA,,LEN(DATA),,,
- & TERMSET,NLEN,TERM)
- END IF
-
- IF (TERM.NE.13.AND.TERM.NE.510.AND.NLEN.EQ.0) THEN
- ! Input did not end with CR or buffer full
- NLEN = 1
- DATA(:1) = CHAR(TERM)
- END IF
-
- RETURN
-
- ENTRY ASSIGN_TERMINAL
-
- IER = SYS$ASSIGN('TT',TERM_CHAN,,) ! Assign terminal
-
- CALL DECLARE_CTRLC_AST
-
- FLAG = 2 ! Indicates that a CTRLC will cause an exit
-
- IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)
-
- IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)
-
- IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)
-
- IF (CLI$PRESENT('KEYPAD')) THEN
- CALL SET_KEYPAD
- ELSE IF (READIT.EQ.0) THEN
- CALL SET_NOKEYPAD
- END IF
-
- TERMSET(1) = 16
- TERMSET(2) = %LOC(MASK)
-
- DO I=ICHAR('0'),ICHAR('9')
- MASK(2) = IBCLR(MASK(2),I-32)
- END DO
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GETPAGSIZ(PAGE_LENGTH,PAGE_WIDTH)
-C
-C SUBROUTINE GETPAGSIZ
-C
-C FUNCTION:
-C Gets page size of the terminal.
-C
-C OUTPUTS:
-C PAGE_LENGTH - Page length of the terminal.
-C PAGE_WIDTH - Page size of the terminal.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($DVIDEF)'
-
- LOGICAL*1 DEVDEPEND(4)
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,DVI$_DEVDEPEND,%LOC(DEVDEPEND(1)))
- CALL ADD_2_ITMLST(4,DVI$_DEVBUFSIZ,%LOC(PAGE_WIDTH))
- CALL END_ITMLST(GETDVI_ITMLST) ! Get address of itemlist
-
- CALL SYS$GETDVIW(,,'TT',%VAL(GETDVI_ITMLST),,,,)
-
- PAGE_LENGTH = ZEXT(DEVDEPEND(4))
-
- PAGE_WIDTH = MIN(PAGE_WIDTH,132)
-
- RETURN
- END
-
-
-
-
-
- LOGICAL FUNCTION SLOW_TERMINAL
-C
-C FUNCTION SLOW_TERMINAL
-C
-C FUNCTION:
-C Indicates that terminal has a slow speed (2400 baud or less).
-C
-C OUTPUTS:
-C SLOW_TERMINAL = .true. if slow, .false. if not.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- EXTERNAL IO$_SENSEMODE
-
- COMMON /TERM_CHAN/ TERM_CHAN
-
- COMMON CHAR_BUF(2)
-
- LOGICAL*1 IOSB(8)
-
- INCLUDE '($TTDEF)'
-
- IER = SYS$QIOW(,%VAL(TERM_CHAN),IO$_SENSEMODE,IOSB,,,
- & CHAR_BUF,%VAL(8),,,,)
-
- IF (IOSB(3).LE.TT$C_BAUD_2400) THEN
- SLOW_TERMINAL = .TRUE.
- ELSE
- SLOW_TERMINAL = .FALSE.
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SHOW_PRIV
-C
-C SUBROUTINE SHOW_PRIV
-C
-C FUNCTION:
-C To show privileges necessary for managing bulletin board.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE '($PRVDEF)'
-
- INCLUDE '($SSDEF)'
-
- COMMON /PRVDEF/ PRIVS
- CHARACTER*8 PRIVS(0:38)
-
- CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file
-
- CALL READ_USER_FILE_HEADER(IER)
-
- IF (IER.EQ.0) THEN ! If header is present, exit
- IF (NEW_FLAG(1).EQ.-1.AND.NEW_FLAG(2).EQ.-1) THEN ! Info not present
- CALL CLOSE_BULLUSER
- CALL OPEN_BULLUSER ! Get BULLUSER.DAT file
- CALL READ_USER_FILE_HEADER(IER)
- USERPRIV(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV
- USERPRIV(2) = 0
- REWRITE (4) USER_HEADER
- END IF
- WRITE (6,'('' Following privileges are needed for privileged
- & commands:'')')
- DO I=0,38
- IF ((I.LT.32.AND.BTEST(USERPRIV(1),I)).OR.
- & (I.GT.31.AND.BTEST(USERPRIV(2),I-32))) THEN
- WRITE (6,'(1X,A)') PRIVS(I)
- END IF
- END DO
- ELSE
- WRITE (6,'('' ERROR: Cannot show privileges.'')')
- END IF
-
- CALL CLOSE_BULLUSER ! All finished with BULLUSER
-
- CALL CHKACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)),IER)
- IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN
- CALL SHOWACL(BULLUSER_FILE(:TRIM(BULLUSER_FILE)))
- END IF
-
- RETURN
-
- END
-
-
-
-
- SUBROUTINE SET_PRIV
-C
-C SUBROUTINE SET_PRIV
-C
-C FUNCTION:
-C To set privileges necessary for managing bulletin board.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PRVDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /PRIVILEGES/ PROCPRIV(2),NEEDPRIV(2)
-
- COMMON /PRVDEF/ PRIVS
- CHARACTER*8 PRIVS(0:38)
- DATA PRIVS
- & /'CMKRNL','CMEXEC','SYSNAM','GRPNAM','ALLSPOOL','DETACH',
- & 'DIAGNOSE','LOG_IO','GROUP','ACNT','PRMCEB','PRMMBX','PSWAPM',
- & 'ALTPRI','SETPRV','TMPMBX','WORLD','MOUNT','OPER','EXQUOTA',
- & 'NETMBX','VOLPRO','PHY_IO','BUGCHK','PRMGBL','SYSGBL','PFNMAP',
- & 'SHMEM','SYSPRV','BYPASS','SYSLCK','SHARE','UPGRADE','DOWNGRADE',
- & 'GRPPRV','READALL',' ',' ','SECURITY'/
-
- EXTERNAL CLI$_ABSENT,CLI$_NEGATED
-
- DIMENSION ONPRIV(2),OFFPRIV(2)
-
- CHARACTER*32 INPUT_PRIV
-
- IF (.NOT.SETPRV_PRIV().OR..NOT.BTEST(PROCPRIV(1),PRV$V_SETPRV)) THEN
- WRITE (6,'('' ERROR: This command requires SETPRV privileges.'')')
- RETURN
- END IF
-
- IF (CLI$PRESENT('ID').OR.
- & CLI$PRESENT('ID').EQ.%LOC(CLI$_NEGATED)) THEN
- DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN)
- & .NE.%LOC(CLI$_ABSENT)) ! Get the IDs
- IF (CLI$PRESENT('ID')) THEN
- CALL ADD_ACL(INPUT_PRIV(:PLEN),'R+C',IER)
- ELSE
- CALL DEL_ACL(INPUT_PRIV(:PLEN),'R+C',IER)
- END IF
- IF (.NOT.IER) CALL SYS_GETMSG(IER)
- END DO
- RETURN
- END IF
-
- OFFPRIV(1) = 0
- OFFPRIV(2) = 0
- ONPRIV(1) = 0
- ONPRIV(2) = 0
-
- DO WHILE (CLI$GET_VALUE('PRIVILEGES',INPUT_PRIV,PLEN)
- & .NE.%LOC(CLI$_ABSENT)) ! Get the privileges
- PRIV_FOUND = -1
- I = 0
- DO WHILE (I.LT.39.AND.PRIV_FOUND.EQ.-1)
- IF (INPUT_PRIV(:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I
- IF (INPUT_PRIV(3:PLEN).EQ.PRIVS(I)) PRIV_FOUND = I
- I = I + 1
- END DO
- IF (PRIV_FOUND.EQ.-1) THEN
- WRITE(6,'('' ERROR: Incorrectly specified privilege = '',
- & A)') INPUT_PRIV(:PLEN)
- RETURN
- ELSE IF (INPUT_PRIV(:2).EQ.'NO') THEN
- IF (INPUT_PRIV.EQ.'NOSETPRV') THEN
- WRITE(6,'('' ERROR: Cannot remove SETPRV privileges.'')')
- RETURN
- ELSE IF (PRIV_FOUND.LT.32) THEN
- OFFPRIV(1) = IBSET(OFFPRIV(1),PRIV_FOUND)
- ELSE
- OFFPRIV(2) = IBSET(OFFPRIV(2),PRIV_FOUND-32)
- END IF
- ELSE
- IF (PRIV_FOUND.LT.32) THEN
- ONPRIV(1) = IBSET(ONPRIV(1),PRIV_FOUND)
- ELSE
- ONPRIV(2) = IBSET(ONPRIV(2),PRIV_FOUND-32)
- END IF
- END IF
- END DO
-
- CALL OPEN_BULLUSER ! Get BULLUSER.DAT file
-
- CALL READ_USER_FILE_HEADER(IER)
-
- IF (IER.EQ.0) THEN ! If header is present, exit
- USERPRIV(1) = USERPRIV(1).OR.ONPRIV(1)
- USERPRIV(2) = USERPRIV(2).OR.ONPRIV(2)
- USERPRIV(1) = USERPRIV(1).AND.(.NOT.OFFPRIV(1))
- USERPRIV(2) = USERPRIV(2).AND.(.NOT.OFFPRIV(2))
- REWRITE (4) USER_HEADER
- WRITE (6,'('' Privileges successfully modified.'')')
- ELSE
- WRITE (6,'('' ERROR: Cannot modify privileges.'')')
- END IF
-
- CALL CLOSE_BULLUSER ! All finished with BULLUSER
-
- RETURN
-
- END
-
-
-
- SUBROUTINE ADD_ACL(ID,ACCESS,IER)
-C
-C SUBROUTINE ADD_ACL
-C
-C FUNCTION: Adds ACL to bulletin files.
-C
-C PARAMETERS:
-C ID - Character string containing identifier to add to ACL.
-C ACCESS - Character string containing access controls to give to ID.
-C IER - Return error from attempting to set ACL.
-C
-C NOTE: The ID must be in the RIGHTS data base.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- CHARACTER ACLENT*255,ID*(*),ACCESS*(*)
-
- INCLUDE '($ACLDEF)'
-
- INCLUDE '($SSDEF)'
-
- IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='
- & //ACCESS//')',ACLENT,,)
- IF (.NOT.IER) THEN
- IF (IER.EQ.SS$_NOSUCHID.AND.ADDID.AND.
- & INDEX(ACCESS,'C').EQ.0) THEN
- CALL GET_UAF(ID,USER,GROUP,ACCOUNT,FLAGS,IER)
- IF (.NOT.IER) THEN
- CALL ERRSNS(IDUMMY,IER)
- WRITE (6,'(
- & '' ERROR: Specified username cannot be verified.'')')
- CALL SYS_GETMSG(IER)
- RETURN
- END IF
- IDENT = USER + ISHFT(GROUP,16)
- IER = SYS$ADD_IDENT(ID,%VAL(IDENT),,)
- IF (IER) THEN
- IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='
- & //ACCESS//')',ACLENT,,)
- END IF
- END IF
- END IF
- IF (.NOT.IER) RETURN
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_ADDACLENT,%LOC(ACLENT))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
-
- IF (INDEX(ACCESS,'C').GT.0.AND.INDEX(ACCESS,'W').EQ.0) THEN
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(
- & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)
- RETURN
- END IF
-
- FLEN = TRIM(FOLDER1_FILE)
-
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//
- & '.BULLDIR',%VAL(ACL_ITMLST),,,)
- IF (.NOT.IER) RETURN
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//
- & '.BULLFIL',%VAL(ACL_ITMLST),,,)
- IF (.NOT.IER) RETURN
-
- RETURN
- END
-
-
-
- SUBROUTINE DEL_ACL(ID,ACCESS,IER)
-C
-C SUBROUTINE DEL_ACL
-C
-C FUNCTION: Adds ACL to bulletin files.
-C
-C PARAMETERS:
-C ID - Character string containing identifier to add to ACL.
-C ACCESS - Character string containing access controls to give to ID.
-C IER - Return error from attempting to set ACL.
-C
-C NOTE: The ID must be in the RIGHTS data base.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- CHARACTER ACLENT*255,ID*(*),ACCESS*(*)
-
- INCLUDE '($ACLDEF)'
-
- IF (ID.NE.' ') THEN
- IER = SYS$PARSE_ACL('(IDENTIFIER='//ID//',ACCESS='
- & //ACCESS//')',ACLENT,,)
- IF (.NOT.IER) RETURN
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ICHAR(ACLENT(:1)),ACL$C_DELACLENT,%LOC(ACLENT))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
- ELSE
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(255,ACL$C_DELETEACL,%LOC(ACLENT))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
- END IF
-
- IF (INDEX(ACCESS,'C').GT.0) THEN
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,BULLUSER_FILE(:TRIM(
- & BULLUSER_FILE)),%VAL(ACL_ITMLST),,,)
- RETURN
- END IF
-
- FLEN = TRIM(FOLDER1_FILE)
-
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//
- & '.BULLDIR',%VAL(ACL_ITMLST),,,)
- IF (.NOT.IER) RETURN
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,FOLDER1_FILE(:FLEN)//
- & '.BULLFIL',%VAL(ACL_ITMLST),,,)
- IF (.NOT.IER) RETURN
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CREATE_FOLDER
-C
-C SUBROUTINE CREATE_FOLDER
-C
-C FUNCTION: Creates a new bulletin folder.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
- DATA REMOTE_SET /.FALSE./
-
- IF (.NOT.SETPRV_PRIV().AND.CLI$PRESENT('NEEDPRIV')) THEN
- WRITE(6,'('' ERROR: CREATE is a privileged command.'')')
- RETURN
- END IF
-
- IER = CLI$GET_VALUE('CREATE_FOLDER',FOLDER,LEN_T) ! Get folder name
-
- IF (LEN_T.GT.25) THEN
- WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')
- RETURN
- END IF
-
- IF (.NOT.SETPRV_PRIV().AND.(CLI$PRESENT('ALWAYS').OR.
- & CLI$PRESENT('NOTIFY').OR.CLI$PRESENT('READNEW').OR.
- & CLI$PRESENT('BRIEF').OR.CLI$PRESENT('SYSTEM'))) THEN
- WRITE (6,'('' ERROR: Privileged qualifier specified.'')')
- RETURN
- END IF
-
- IF (CLI$PRESENT('NODE')) THEN ! Remote node specified?
- IER = CLI$GET_VALUE('NODE',FOLDER_BBOARD,LEN_B) ! Get node name
- FOLDER_BBOARD = '::'//FOLDER_BBOARD(:LEN_B)
- FOLDER1_BBOARD = FOLDER_BBOARD
- IF (.NOT.CLI$GET_VALUE('REMOTENAME',FOLDER1)) THEN
- FOLDER1 = FOLDER
- END IF
- CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER)
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: Folder not accessible on remote node.'')')
- RETURN
- ELSE IF (CLI$PRESENT('SYSTEM').AND.
- & .NOT.BTEST(FOLDER1_FLAG,2)) THEN
- WRITE (6,'('' ERROR: /SYSTEM not allowed as remote node'',
- & '' is not SYSTEM folder.'')')
- RETURN
- END IF
- END IF
-
- LENDES = 0
- DO WHILE (LENDES.EQ.0)
- IF (CLI$PRESENT('DESCRIPTION')) THEN ! DESCRIPTION specified?
- IER = CLI$GET_VALUE('DESCRIPTION',FOLDER_DESCRIP,LENDES)
- ELSE
- WRITE (6,'('' Enter one line description of folder.'')')
- CALL GET_LINE(FOLDER_DESCRIP,LENDES) ! Get input line
- FOLDER_DESCRIP = FOLDER_DESCRIP(:LENDES) ! End fill with spaces
- END IF
- IF (LENDES.LE.0) THEN
- WRITE (6,'('' Aborting folder creation.'')')
- RETURN
- ELSE IF (LENDES.GT.80) THEN ! If too many characters
- WRITE(6,'('' ERROR: folder must be < 80 characters.'')')
- LENDES = 0
- END IF
- END DO
-
- CALL OPEN_BULLFOLDER ! Open folder file
- READ (7,IOSTAT=IER,KEY=FOLDER,KEYID=0)
- ! See if folder exists
-
- IF (IER.EQ.0) THEN
- WRITE (6,'('' ERROR: Specified folder already exists.'')')
- GO TO 1000
- END IF
-
- IF (CLI$PRESENT('OWNER')) THEN
- IF (.NOT.SETPRV_PRIV().AND..NOT.CLI$PRESENT('ID')) THEN
- WRITE (6,'('' ERROR: /OWNER requires privileges.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- ELSE
- CALL CLI$GET_VALUE('OWNER',FOLDER1_OWNER,LEN_P)
- IF (LEN_P.GT.12) THEN
- WRITE (6,'('' ERROR: Folder owner name must be'',
- & '' no more than 12 characters long.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- ELSE IF (CLI$PRESENT('ID')) THEN
- IER = CHKPRO(FOLDER1_OWNER)
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: ID not valid.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- END IF
- ELSE
- CALL GET_UAF
- & (FOLDER1_OWNER,USERB1,GROUPB1,ACCOUNTB1,FLAGS,IER)
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Owner not valid username.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- END IF
- END IF
- FOLDER_OWNER = FOLDER1_OWNER
- END IF
- ELSE
- FOLDER_OWNER = USERNAME ! Get present username
- FOLDER1_OWNER = FOLDER_OWNER ! Save for later
- END IF
-
- FOLDER_SET = .TRUE.
-
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
-
-C
-C Folder file is placed in the directory FOLDER_DIRECTORY.
-C The file prefix is the name of the folder.
-C
-
- FD_LEN = TRIM(FOLDER_DIRECTORY)
- IF (FD_LEN.EQ.0) THEN
- WRITE (6,'('' ERROR: System programmer has disabled folders.'')')
- GO TO 910
- ELSE
- FOLDER_FILE = FOLDER_DIRECTORY(:FD_LEN)//FOLDER
- END IF
-
- OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
-
- IF (IER.NE.0) THEN
- WRITE(6,'('' ERROR: Cannot create folder directory file.'')')
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- GO TO 910
- END IF
-
- OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
- 1 //'.BULLFIL',STATUS='NEW',
- 1 ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
- 1 FORM='UNFORMATTED',IOSTAT=IER)
-
- IF (IER.NE.0) THEN
- WRITE(6,'('' ERROR: Cannot create folder message file.'')')
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- GO TO 910
- END IF
-
- FOLDER_FLAG = 0
-
- IF (CLI$PRESENT('PRIVATE').OR.CLI$PRESENT('SEMIPRIVATE')) THEN
- ! Will folder have access limitations?
- FOLDER1_FILE = FOLDER_FILE
- CLOSE (UNIT=1)
- CLOSE (UNIT=2)
- IF (CLI$PRESENT('SEMIPRIVATE')) THEN
- CALL ADD_ACL('*','R',IER)
- ELSE
- CALL ADD_ACL('*','NONE',IER)
- END IF
- CALL ADD_ACL(FOLDER_OWNER,'R+W+C',IER)
- OPEN (UNIT=2,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
- 1 //'.BULLDIR',STATUS='OLD',IOSTAT=IER1)
- OPEN (UNIT=1,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
- 1 //'.BULLFIL',STATUS='OLD',IOSTAT=IER1)
- IF (.NOT.IER) THEN
- WRITE(6,
- & '('' ERROR: Cannot create private folder using ACLs.'')')
- CALL SYS_GETMSG(IER)
- GO TO 910
- END IF
- FOLDER_FLAG = IBSET(FOLDER_FLAG,0)
- END IF
-
- IER = 0
- LAST_NUMBER = 1
- DO WHILE (IER.EQ.0.AND.LAST_NUMBER.LT.FOLDER_MAX-1)
- READ (7,IOSTAT=IER,KEY=LAST_NUMBER,KEYID=1)
- LAST_NUMBER = LAST_NUMBER + 1
- END DO
-
- IF (IER.EQ.0) THEN
- WRITE (6,'('' ERROR: Folder limit of '',I,'' has been reached.'')')
- & FOLDER_MAX
- WRITE (6,'('' Unable to add specified folder.'')')
- GO TO 910
- ELSE
- FOLDER1_NUMBER = LAST_NUMBER - 1
- END IF
-
- IF (.NOT.CLI$PRESENT('NODE')) THEN
- FOLDER_BBOARD = 'NONE'
- IF (REMOTE_SET) CLOSE (UNIT=REMOTE_UNIT)
- REMOTE_SET = .FALSE.
- FOLDER_BBEXPIRE = 14
- F_NBULL = 0
- NBULL = 0
- F_NEWEST_BTIM(1) = 0
- F_NEWEST_BTIM(2) = 0
- F_NEWEST_NOSYS_BTIM(1) = 0
- F_NEWEST_NOSYS_BTIM(2) = 0
- F_EXPIRE_LIMIT = 0
- FOLDER_NUMBER = FOLDER1_NUMBER
- ELSE
- CLOSE (UNIT=1,STATUS='DELETE')
- CLOSE (UNIT=2,STATUS='DELETE')
- IF (FOLDER1.NE.FOLDER) THEN ! Different remote folder name?
- REMOTE_SET = .FALSE.
- CALL OPEN_BULLDIR ! If so, store name in directory file
- BULLDIR_HEADER(13:) = FOLDER1
- CALL WRITEDIR_NOCONV(0,IER)
- CALL CLOSE_BULLDIR
- FOLDER1_BBOARD = FOLDER1_BBOARD(:LEN_B+2)//'*'
- FOLDER1 = FOLDER
- END IF
- REMOTE_SET = .TRUE.
- IF (BTEST(FOLDER1_FLAG,0)) FOLDER_FLAG = IBSET(FOLDER_FLAG,0)
- FOLDER1_FLAG = FOLDER_FLAG
- FOLDER1_DESCRIP = FOLDER_DESCRIP
- FOLDER_COM = FOLDER1_COM
- NBULL = F_NBULL
- END IF
-
- FOLDER_OWNER = FOLDER1_OWNER
-
- IF (CLI$PRESENT('SYSTEM')) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
- IF (CLI$PRESENT('ID')) FOLDER_FLAG = IBSET(FOLDER_FLAG,6)
- IF (CLI$PRESENT('ALWAYS')) FOLDER_FLAG = IBSET(FOLDER_FLAG,7)
-
- CALL WRITE_FOLDER_FILE(IER)
- CALL MODIFY_SYSTEM_LIST(0)
-
- CLOSE (UNIT=1)
- CLOSE (UNIT=2)
-
- NOTIFY = 0
- READNEW = 0
- BRIEF = 0
- IF (CLI$PRESENT('NOTIFY')) NOTIFY = 1
- IF (CLI$PRESENT('READNEW')) READNEW = 1
- IF (CLI$PRESENT('SHOWNEW')) BRIEF = 1
- IF (CLI$PRESENT('BRIEF')) THEN
- BRIEF = 1
- READNEW = 1
- END IF
- CALL SET_FOLDER_DEFAULT(NOTIFY,READNEW,BRIEF)
-
- WRITE (6,'('' Folder is now set to '',A)')
- & FOLDER(:TRIM(FOLDER))//'.'
-
- GO TO 1000
-
-910 WRITE (6,'('' Aborting folder creation.'')')
- IF (FOLDER_NUMBER.EQ.0) FOLDER_SET = .FALSE.
- CLOSE (UNIT=1,STATUS='DELETE')
- CLOSE (UNIT=2,STATUS='DELETE')
-
-1000 CALL CLOSE_BULLFOLDER
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
-
- RETURN
-
- END
-
-
-
- INTEGER FUNCTION CHKPRO(INPUT)
-C
-C Description:
-C Parse given identify into binary ACL format.
-C Call SYS$CHKPRO to check if present process has read
-C access to an object if the object's protection is the ACL.
-C
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER ACL*255
- CHARACTER*(*) INPUT
-
- INCLUDE '($CHPDEF)'
-
- CHKPRO = SYS$PARSE_ACL('(IDENTIFIER='//INPUT(:TRIM(INPUT))//
- & ',ACCESS=R)',ACL,,) ! Convert to ACL into binary format
- IF (.NOT.CHKPRO) RETURN ! Exit if can't
-
- FLAGS = CHP$M_READ ! Specify read access checking
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ICHAR(ACL(:1)),CHP$_ACL,%LOC(ACL(1:1)))
- CALL ADD_2_ITMLST(4,CHP$_FLAGS,%LOC(FLAGS))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
-
- CHKPRO = SYS$CHKPRO(%VAL(ACL_ITMLST)) ! Check if process has the
- ! rights-id assigned to it
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin5.for b/decus/vax91b/bulletin-net91b/bulletin5.for
deleted file mode 100644
index 84f16aab3d88092c3be6acb47f0df69205ebcedc..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin5.for
+++ /dev/null
@@ -1,2139 +0,0 @@
-C
-C BULLETIN5.FOR, Version 9/15/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Usage: Invoked by the BULLETIN command.
-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
-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 (FOLDER_NUMBER.LT.0) THEN
- WRITE (6,'('' ERROR: Cannot set modify for remote folder.'')')
- RETURN
- END IF
-
- ALL = .FALSE.
- DEFAULT = 0
-
- IF (INCMD(:3).EQ.'SET') THEN
- IF (.NOT.SETPRV_PRIV()) THEN
- WRITE (6,'(
- & '' ERROR: Privileges needed for changing defaults.'')')
- RETURN
- END IF
- ALL = CLI$PRESENT('ALL')
- DEFAULT = CLI$PRESENT('DEFAULT')
- CALL OPEN_BULLUSER_SHARED
- IF (CLI$PRESENT('PERMANENT')) THEN
- CALL SET_PERM(NOTIFY,READNEW,BRIEF)
- ELSE IF (CLI$PRESENT('NOPERMANENT')) THEN
- IF (NOTIFY.GE.0) CALL SET_PERM(0,-1,-1)
- IF (READNEW.GE.0.OR.BRIEF.GE.0) CALL SET_PERM(-1,0,0)
- END IF
- ELSE
- CALL OPEN_BULLUSER_SHARED
- END IF
-
- CALL READ_USER_FILE_HEADER(IER)
- IF (DEFAULT.EQ.0.OR.DEFAULT) THEN
- 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
- END IF
-
- IF (ALL.OR.(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:)
- END IF
- CALL READ_USER_FILE(IER)
- END DO
- END IF
-
- CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
-
-
- SUBROUTINE READ_PERM
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG
- DIMENSION SET_PERM_FLAG(FLONG)
- DIMENSION BRIEF_PERM_FLAG(FLONG)
- DIMENSION NOTIFY_PERM_FLAG(FLONG)
-
- COMMON /FLAG_ACCESS/ FLAG_ACCESS
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER,
- & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG
- END DO
-
- IF (IER.NE.0) THEN
- DO I=1,FLONG
- SET_PERM_FLAG(I) = 0
- BRIEF_PERM_FLAG(I) = 0
- NOTIFY_PERM_FLAG(I) = 0
- END DO
- BRIEF_PERM_FLAG(1) = 1 ! SHOWNEW permanent for GENERAL folder
- WRITE (4,IOSTAT=IER)
- & '*PERM ',
- & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG
- CALL READ_USER_FILE_HEADER(IER)
- IF (.NOT.TEST2(SET_FLAG_DEF,0)) THEN
- CALL SET2(BRIEF_FLAG_DEF,0)
- REWRITE(4) USER_HEADER
- END IF
- CALL READ_USER_FILE(IER)
- DO WHILE (IER.EQ.0)
- IF (TEMP_USER(:1).NE.'*'.AND.TEMP_USER(:1).NE.':') THEN
- IF (.NOT.TEST2(SET_FLAG,0)) THEN
- CALL SET2(BRIEF_FLAG,0)
- REWRITE(4) TEMP_USER//USER_ENTRY(13:)
- END IF
- END IF
- CALL READ_USER_FILE(IER)
- END DO
- ELSE
- UNLOCK 4
- END IF
-
- RETURN
-
- ENTRY SET_PERM(NOTIFY,READNEW,BRIEF)
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER,
- & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG
- END DO
-
- IF (NOTIFY.EQ.0) CALL CLR2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)
- IF (NOTIFY.EQ.1) CALL SET2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)
- IF (READNEW.EQ.0) CALL CLR2(SET_PERM_FLAG,FOLDER_NUMBER)
- IF (READNEW.EQ.1) CALL SET2(SET_PERM_FLAG,FOLDER_NUMBER)
- IF (BRIEF.EQ.0) CALL CLR2(BRIEF_PERM_FLAG,FOLDER_NUMBER)
- IF (BRIEF.EQ.1) CALL SET2(BRIEF_PERM_FLAG,FOLDER_NUMBER)
-
- REWRITE (4,IOSTAT=IER) TEMP_USER,
- & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG
-
- RETURN
-
- ENTRY SET_USER_FLAG(NOTIFY,READNEW,BRIEF)
-
- IF (.NOT.FLAG_ACCESS) THEN
- WRITE (6,'('' ERROR: Cannot set flags for protected'',
- & '' folder without explicit access granted'',/,
- & '' via SET ACCESS. See HELP SET ACCESS for further''
- & '' information.'')')
- RETURN
- END IF
-
- IF (FOLDER_NUMBER.LT.0.AND.NEWS_FOLDER_NUMBER.GT.0) THEN
- CALL NEWS_SET_USER_FLAG(NOTIFY,READNEW,BRIEF)
- RETURN
- END IF
-
- CALL OPEN_BULLUSER_SHARED
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*PERM',IOSTAT=IER) TEMP_USER,
- & SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG
- END DO
-
- CALL CLOSE_BULLUSER
-
- IER = .TRUE.
- IF (NOTIFY.EQ.0) THEN
- IF (TEST2(NOTIFY_PERM_FLAG,FOLDER_NUMBER)) THEN
- WRITE (6,'('' ERROR: NOTIFY is permanent for this folder.'')')
- RETURN
- ELSE
- CALL CHANGE_FLAG(0,4)
- END IF
- ELSE IF (NOTIFY.EQ.1) THEN
- CALL CHANGE_FLAG(1,4)
- RETURN
- ELSE IF (BRIEF.EQ.0.AND.READNEW.EQ.0.AND.
- & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).OR.
- & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN
- IER = .FALSE.
- ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.0.AND.
- & TEST2(SET_PERM_FLAG,FOLDER_NUMBER).AND.
- & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN
- IER = .FALSE.
- ELSE IF (BRIEF.EQ.1.AND.READNEW.EQ.1.AND.
- & (TEST2(SET_PERM_FLAG,FOLDER_NUMBER).XOR.
- & TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER))) THEN
- IER = .FALSE.
- END IF
-
- IF (IER) THEN
- IF (READNEW.GE.0) CALL CHANGE_FLAG(READNEW,2)
- IF (BRIEF.GE.0) CALL CHANGE_FLAG(BRIEF,3)
- ELSE
- WRITE (6,'('' ERROR: PERMANENT flags exist for this folder.'')')
- WRITE (6,'('' Flags will be set to those permanent settings.'')')
-
- IF (TEST2(SET_PERM_FLAG,FOLDER_NUMBER)) THEN
- CALL CHANGE_FLAG(1,2)
- ELSE
- CALL CHANGE_FLAG(0,2)
- END IF
-
- IF (TEST2(BRIEF_PERM_FLAG,FOLDER_NUMBER)) THEN
- CALL CHANGE_FLAG(1,3)
- ELSE
- CALL CHANGE_FLAG(0,3)
- END IF
- END IF
-
- 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
-
- IF (INDEX(FOLDER1,'.').GT.0) THEN
- CALL OPEN_BULLNEWS_SHARED
- ELSE
- CALL OPEN_BULLFOLDER
- END IF
-
- 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
- ELSE IF (INDEX(FOLDER1,'.').GT.0) THEN
- CALL REMOTE_REMOVE_FOLDER(IER)
- IF (.NOT.IER) GO TO 1000
- END IF
-
- IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER).OR.
- & FOLDER1.EQ.'GENERAL') 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 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
-
- COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM
-
- COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG)
-
- COMMON /HEADER/ HEADER
-
- COMMON /READIT/ READIT
-
- COMMON /FLAG_ACCESS/ FLAG_ACCESS
-
- EXTERNAL CLI$_ABSENT,CLI$_NEGATED
-
- CHARACTER*80 LOCAL_FOLDER1_DESCRIP
-
- CHARACTER*25 FOLDER1_SAVE
-
- DIMENSION FIRST_TIME(FLONG) ! Bit set for folder if folder has
- DATA FIRST_TIME /FLONG*0/ ! been selected before this.
-
- DIMENSION OLD_NEWEST_BTIM(2)
-
- DATA LAST_NEWS_GROUP/0/
-
- COMMAND = (INCMD(:3).EQ.'ADD').OR.(INCMD(:3).EQ.'DEL').OR.
- & (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_NAME)
- FOLDER1 = FOLDER1_NAME
- 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.'::') THEN
- 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
-
- REMOTE_TEST = 0
-
- IF (SAVE_FOLDER_Q1.NE.0) THEN ! Have folder info
- FOLDER1_COM = FOLDER_COM
- IER = 0
- NEWS = INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND.
- & FOLDER1(:1).LE.'z')
- ELSE
- NEWS = (INDEX(FOLDER1,'.').GT.0.OR.(FOLDER1(:1).GE.'a'.AND.
- & FOLDER1(:1).LE.'z')).AND.(FOLDER_NUMBER.LE.-1.OR.OUTPUT)
- IF (NEWS.AND.
- & SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN
- CALL OPEN_BULLNEWS_SHARED ! Go find folder
- READ (7,IOSTAT=IER,KEYEQ=1000,KEYID=1) NEWS_FOLDER1_COM
- IF (IER.NE.0) THEN
- WRITE (6,'('' Fetching NEWS groups from remote node.''
- & ,'' This will take several minutes.'')')
- WRITE (6,'('' This is the only time this will have''
- & ,'' to be done.'')')
- CALL CLOSE_BULLFOLDER
- FOLDER1_SAVE = FOLDER1
- CALL NEWS_LIST
- CALL OPEN_BULLFOLDER_SHARED
- FOLDER1 = FOLDER1_SAVE
- ELSE IF (NEWS_F1_END.GT.LAST_NEWS_READ(1,FOLDER_MAX).AND.
- & OUTPUT.AND.NEWS_F1_END.GT.LAST_NEWS_GROUP) THEN
- IF (LAST_NEWS_READ(1,FOLDER_MAX).GT.0) THEN
- WRITE (6,'('' Type NEWS/NEWGROUP to see recently'',
- & '' added news groups.'')')
- ELSE
- LAST_NEWS_READ(1,FOLDER_MAX) = NEWS_F1_END
- END IF
- LAST_NEWS_GROUP = NEWS_F1_END
- END IF
- CALL LOWERCASE(FOLDER1)
- ELSE
- CALL OPEN_BULLFOLDER_SHARED ! Go find folder
- END IF
-
- 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))
- FOLDER1_NUMBER = -1
- IER = 0
- ELSE IF (INCMD(:2).EQ.'SE') THEN
- CALL READ_FOLDER_FILE_KEYNAME_TEMP
- & (FOLDER1(:TRIM(FOLDER1)),IER)
- 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 IF
-
- IF (REMOTE_TEST.EQ.0) THEN
- IF (BTEST(FOLDER1_FLAG,29)) THEN ! Error in folder flag!!
- FOLDER1_FLAG = FOLDER1_FLAG.AND.3
- F1_EXPIRE_LIMIT = 0
- CALL REWRITE_FOLDER_FILE_TEMP
- END IF
- END IF
-
- CALL CLOSE_BULLFOLDER
- END IF
-
- IF ((IER.EQ.0.OR.NEWS).AND.
- & FOLDER1_BBOARD(:2).EQ.'::') THEN
- IF (FOLDER_NUMBER.EQ.-2) RETURN ! Don't allow
- IF (IER.NE.0) FOLDER1_DESCRIP = FOLDER1_NAME
- LOCAL_FOLDER1_FLAG = FOLDER1_FLAG
- LOCAL_FOLDER1_DESCRIP = FOLDER1_DESCRIP
- CALL CONNECT_REMOTE_FOLDER(READ_ONLY,IER1)
- IF (IER1.NE.0) THEN
- IF (OUTPUT) THEN
- WRITE (6,'('' ERROR: Unable to select the folder.'')')
- IF (.NOT.NEWS) THEN
- LENB = TRIM(FOLDER1_BBOARD)
- IF (FOLDER1_BBOARD(LENB:LENB).EQ.'*') LENB = LENB - 1
- WRITE (6,'('' Cannot connect to node '',A,''.'')')
- & FOLDER1_BBOARD(3:LENB)
- ELSE IF (.NOT.IER1) THEN
- WRITE (6,'('' Cannot connect to remote NEWS node.'')')
- END IF
- END IF
- RETURN
- END IF
- IF (REMOTE_TEST.GT.0) THEN ! Folder specified with "::"
- FOLDER1 = FOLDER1_BBOARD(3:TRIM(FOLDER1_BBOARD))//'::'//
- & FOLDER1
- FOLDER1_NUMBER = -1
- REMOTE_SET = 1
- ELSE IF (NEWS) THEN
- REMOTE_SET = 3
- CALL OPEN_BULLNEWS_SHARED ! Update local folder information
- IF (IER.NE.0) CALL NEWS_NEW_FOLDER
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER)
- IF ((F1_START.NE.F_START.OR.F1_NBULL.NE.F_NBULL).AND.
- & F1_START.GT.0) THEN
- IF (F1_NBULL.NE.F_NBULL) CALL SYS_BINTIM('-',F_NEWEST_BTIM)
- F_NBULL = F1_NBULL
- F_START = F1_START
- CALL REWRITE_FOLDER_FILE
- END IF
- CALL CLOSE_BULLFOLDER
- 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)
- END IF
- FOLDER1_FLAG = LOCAL_FOLDER1_FLAG ! Use local flag info
- CALL OPEN_BULLFOLDER ! Update local folder information
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER1,IER)
- OLD_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)
- OLD_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)
- FOLDER_COM = FOLDER1_COM
- CALL REWRITE_FOLDER_FILE
- CALL CLOSE_BULLFOLDER
- REMOTE_SET = 1
- DIFF = COMPARE_BTIM(OLD_NEWEST_BTIM,F_NEWEST_BTIM)
- IF (DIFF.LT.0) THEN
- CALL READ_NOTIFY
- IF (TEST2(NOTIFY_REMOTE,FOLDER_NUMBER)) THEN
- CALL NOTIFY_REMOTE_USERS(OLD_NEWEST_BTIM)
- END IF
- END IF
- END IF
- END IF
-
- IF (IER.EQ.0) THEN ! Folder found
- FLAG1_ACCESS = .TRUE.
- FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
- & //FOLDER1
- IF (BTEST(FOLDER1_FLAG,0).AND. ! Folder protected
- & FOLDER1_BBOARD(:2).NE.'::') THEN ! 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
- CALL CHECK_ACCESS
- & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',
- & USERNAME,READ_ACCESS,WRITE_ACCESS)
- IF (SETPRV_PRIV().AND.READIT.EQ.0) THEN
- IF (.NOT.READ_ACCESS) FLAG1_ACCESS = .FALSE.
- READ_ACCESS = 1
- WRITE_ACCESS = 1
- END IF
- IF (.NOT.READ_ACCESS.AND..NOT.WRITE_ACCESS) THEN
- IF (OUTPUT) THEN
- WRITE(6,'('' You are not allowed to access folder.'')')
- WRITE(6,'('' See '',A,'' if you wish to access folder.'')')
- & FOLDER1_OWNER(:TRIM(FOLDER1_OWNER))
- ELSE IF (TEST2(BRIEF_FLAG,FOLDER1_NUMBER).OR.
- & TEST2(SET_FLAG,FOLDER1_NUMBER)) THEN
- CALL OPEN_BULLUSER_SHARED
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER)
- CALL CLR2(BRIEF_FLAG,FOLDER1_NUMBER)
- CALL CLR2(SET_FLAG,FOLDER1_NUMBER)
- IF (IER.EQ.0) REWRITE (4) USER_ENTRY
- CALL CLOSE_BULLUSER
- END IF
- IER = 0
- RETURN
- END IF
- ELSE IF (BTEST(FOLDER1_FLAG,0).AND.
- & IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
- CALL OPEN_BULLFOLDER
- CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER1)
- FOLDER1_FLAG = IBCLR(FOLDER1_FLAG,0)
- CALL REWRITE_FOLDER_FILE_TEMP
- CALL CLOSE_BULLFOLDER
- END IF
- ELSE ! Folder not protected
- 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.
- END IF
-
- IF (IER) THEN
- FLAG_ACCESS = FLAG1_ACCESS ! Can set flags?
-
- FOLDER_COM = FOLDER1_COM ! Folder successfully set so
- FOLDER_FILE = FOLDER1_FILE ! update folder parameters
-
- IF (FOLDER_NUMBER.NE.0) THEN
- FOLDER_SET = .TRUE.
- ELSE
- FOLDER_SET = .FALSE.
- END IF
-
- IF (REMOTE_SET.LT.3) THEN
- FOLDER_NAME = FOLDER
- HEADER = .NOT.BTEST(FOLDER_FLAG,4)
- ELSE
- HEADER = .FALSE.
- FOLDER_NAME = FOLDER_DESCRIP
- FOLDER_NUMBER = -1
- END IF
-
- IF (REMOTE_SET.EQ.0) THEN
- SLIST = INDEX(FOLDER_DESCRIP,'<')
- IF (SLIST.GT.0.AND.
- & FOLDER_DESCRIP(SLIST+1:SLIST+1).EQ.'@') THEN
- REMOTE_SET = 4
- ELSE IF (SLIST.GT.0) THEN
- I = SLIST + 1
- FLEN = TRIM(FOLDER_DESCRIP)
- DO WHILE (I.LE.FLEN)
- IF ((FOLDER_DESCRIP(I:I).GE.'a'.AND.
- & FOLDER_DESCRIP(I:I).LE.'z').OR.
- & FOLDER_DESCRIP(I:I).EQ.'.') THEN
- I = I + 1
- ELSE IF (FOLDER_DESCRIP(I:I).EQ.'>') THEN
- I = FLEN + 1
- ELSE
- I = FLEN + 2
- END IF
- END DO
- IF (I.EQ.FLEN+1) REMOTE_SET = 4
- END IF
- IF (OUTPUT.AND.INCMD(:3).NE.'DIR'.AND.
- & REMOTE_SET.EQ.0.AND.SLIST.GT.0) THEN
- WRITE (6,'('' Use the POST command to send a '',
- & ''message to this folder''''s mailing list.'')')
- END IF
- END IF
-
- IF (OUTPUT.AND.INCMD(:3).NE.'DIR') THEN
- WRITE (6,'('' Folder has been set to '',A)')
- & FOLDER_NAME(:TRIM(FOLDER_NAME))//'.'
- END IF
-
- IF (OUTPUT) THEN
- IF (REMOTE_SET.EQ.3) THEN
- BULL_POINT = F_START - 1
- ELSE
- BULL_POINT = 0 ! Reset pointer to first bulletin
- END IF
- 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'.AND.SLIST.EQ.0) THEN
- WRITE (6,'('' Folder only accessible for reading.'')')
- END IF
- READ_ONLY = .TRUE.
- ELSE
- READ_ONLY = .FALSE.
- END IF
- ELSE
- READ_ONLY = .FALSE.
- END IF
-
- IF (FOLDER_NUMBER.GT.0) THEN
- IF (TEST_BULLCP().GT.0.OR.REMOTE_SET) THEN
- CALL SET2(FIRST_TIME,FOLDER_NUMBER)
- ELSE IF (.NOT.TEST2(FIRST_TIME,FOLDER_NUMBER)) THEN
- ! 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.
- & (FOLDER_NUMBER.EQ.0.OR.BTEST(FOLDER_FLAG,2))
- & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
- ! Do shutdown bulletins exist?
- SHUTDOWN = 0
- IER1 = -1
- ELSE
- IF (TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
- CALL UPDATE_SHUTDOWN(FOLDER_NUMBER)
- END IF
- IER1 = 1
- END IF
- IF (IER.LE.0.OR.IER.GT.20*356.OR.IER1.LE.0) THEN
- CALL UPDATE ! Need to update
- END IF
- ELSE
- NBULL = 0
- END IF
- CALL CLOSE_BULLDIR
- CALL SET2(FIRST_TIME,FOLDER_NUMBER)
- END IF
- END IF
-
- IF (OUTPUT) THEN
- IF (CLI$PRESENT('MARKED')) THEN
- READ_TAG = 1 + IBSET(0,1)
- BULL_PARAMETER = 'MARKED'
- ELSE IF (CLI$PRESENT('SEEN')) THEN
- READ_TAG = 1 + IBSET(0,2)
- BULL_PARAMETER = 'SEEN'
- ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT
- & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN
- READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)
- BULL_PARAMETER = 'UNMARKED'
- ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT
- & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN
- READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)
- BULL_PARAMETER = 'UNSEEN'
- ELSE
- READ_TAG = IBSET(0,1) + IBSET(0,2)
- END IF
- IF (READ_TAG) THEN
- IF (FOLDER_NUMBER.GE.0.OR.REMOTE_SET.EQ.3) THEN
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)
- ELSE
- WRITE (6,'('' ERROR: Invalid qualifier'',
- & '' with remote folder.'')')
- READ_TAG = IBSET(0,1) + IBSET(0,2)
- END IF
- END IF
- IF (READ_TAG.AND.INCMD(:3).NE.'DIR') THEN
- IF (IER.EQ.0) THEN
- WRITE(6,'('' NOTE: Only '',A,'' messages'',
- & '' will be shown.'')')
- & BULL_PARAMETER(:TRIM(BULL_PARAMETER))
- ELSE
- WRITE(6,'('' WARNING: No '',A,
- & '' messages found.'')')
- & BULL_PARAMETER(:TRIM(BULL_PARAMETER))
- END IF
- END IF
- END IF
-
- IF (REMOTE_SET.EQ.3.AND.OUTPUT.AND..NOT.READ_TAG) THEN
- CALL NEWS_GET_NEWEST_MESSAGE(IER)
- IF (IER.GT.0.AND.IER.LE.F_NBULL) THEN
- BULL_POINT = IER - 1
- WRITE(6,'('' Type READ to read new messages.'')')
- END IF
- ELSE IF (FOLDER_NUMBER.NE.0.AND..NOT.READ_TAG.AND.
- & REMOTE_SET.NE.3) THEN
- 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 it
- IF (BULL_POINT.NE.-1) THEN
- WRITE(6,'('' Type READ to read new messages.'')')
- NEW_COUNT = F_NBULL - BULL_POINT
- DIG = 0
- DO WHILE (NEW_COUNT.GT.0)
- NEW_COUNT = NEW_COUNT / 10
- DIG = DIG + 1
- END DO
- WRITE(6,'('' There are '',I<DIG>,'' new messages.'')')
- & F_NBULL - BULL_POINT ! Alert user if new bulletins
- ELSE
- BULL_POINT = 0
- END IF
- END IF
- END IF
- END IF
- IER = 1
- ELSE IF (OUTPUT) THEN
- WRITE (6,'('' Cannot access specified folder.'')')
- CALL SYS_GETMSG(IER)
- END IF
- ELSE ! Folder not found
- IF (OUTPUT) WRITE (6,'('' ERROR: Folder does not exist.'')')
- IER = 0
- END IF
-
- RETURN
-
- END
-
-
-
-
-
- SUBROUTINE UPDATE_FOLDER
-C
-C SUBROUTINE UPDATE_FOLDER
-C
-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) RETURN
-
- CALL OPEN_BULLFOLDER_SHARED ! Open folder file
-
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
-
- CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)
-
- F_NBULL = NBULL
-
- IF (FOLDER_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
-
- IF (.NOT.BTEST(SYSTEM,0)) THEN ! Is non-system message?
- 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
-
- RETURN
- END
-
-
-
- SUBROUTINE SHOW_FOLDER
-C
-C SUBROUTINE SHOW_FOLDER
-C
-C FUNCTION: Shows the information on any folder.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- COMMON /BULL_PERM/ SET_PERM_FLAG,BRIEF_PERM_FLAG,NOTIFY_PERM_FLAG
- DIMENSION SET_PERM_FLAG(FLONG)
- DIMENSION BRIEF_PERM_FLAG(FLONG)
- DIMENSION NOTIFY_PERM_FLAG(FLONG)
-
- INCLUDE '($SSDEF)'
-
- INCLUDE '($RMSDEF)'
-
- EXTERNAL CLI$_ABSENT
-
- IF (INDEX(INCMD,'/A').GT.0.OR.INDEX(INCMD,'/a').GT.0) THEN
- WRITE (6,'('' ERROR: /ALL is invalid qualifier.'')')
- RETURN
- END IF
-
- IF (CLI$GET_VALUE('SHOW_FOLDER',FOLDER1).EQ.%LOC(CLI$_ABSENT))
- & FOLDER1 = FOLDER
-
- IF (INDEX(FOLDER1,'::').NE.0.OR.REMOTE_SET.EQ.3) THEN
- WRITE (6,'('' ERROR: Invalid command for remote folder.'')')
- RETURN
- END IF
-
- CALL OPEN_BULLFOLDER_SHARED ! Open folder file
-
- CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
- FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
- & FOLDER1
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: Specified folder was not found.'')')
- CALL CLOSE_BULLFOLDER
- RETURN
- ELSE IF (FOLDER.EQ.FOLDER1) THEN
- WRITE (6,1000) FOLDER1,FOLDER1_OWNER,
- & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))
- ELSE
- WRITE (6,1010) FOLDER1,FOLDER1_OWNER,
- & FOLDER1_DESCRIP(:TRIM(FOLDER1_DESCRIP))
- END IF
-
- 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)) THEN
- IF (FOLDER1_BBOARD(:2).EQ.'::'.AND. ! Is folder remote
- & BTEST(FOLDER1_FLAG,0)) THEN ! and private?
- WRITE (6,'('' Folder is a private folder.'')')
- ELSE
- WRITE (6,'('' Folder is not a private folder.'')')
- END IF
- ELSE
- IF (SETPRV_PRIV()) THEN
- READ_ACCESS = 1
- WRITE_ACCESS = 1
- ELSE
- CALL CHECK_ACCESS
- & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',
- & USERNAME,READ_ACCESS,WRITE_ACCESS)
- END IF
- IF (WRITE_ACCESS)
- & CALL SHOWACL(FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL')
- END IF
- IF (FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN
- IF (FOLDER1_BBOARD(:2).EQ.'::') THEN
- FLEN = TRIM(FOLDER1_BBOARD)
- IF (INDEX(FOLDER1_BBOARD,'*').EQ.0) THEN
- WRITE (6,'('' Folder is located on node '',
- & 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_BULLDIR
- CALL READDIR(0,IER)
- CALL CLOSE_BULLDIR
- REMOTE_SET = REMOTE_SET_SAVE
- WRITE (6,'('' Folder is located on node '',
- & A,''. Remote folder name is '',A,''.'')')
- & 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 IF
- IF ((USERB1.EQ.0.AND.GROUPB1.EQ.0).OR.BTEST(USERB1,31)) THEN
- WRITE (6,'('' BBOARD was specified with /SPECIAL.'')')
- IF (BTEST(GROUPB1,31)) THEN
- WRITE (6,'('' BBOARD was specified with /VMSMAIL.'')')
- END IF
- END IF
- ELSE
- 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 IF
- 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.'')')
- END IF
- IF (BTEST(FOLDER1_FLAG,4)) THEN
- WRITE (6,'('' STRIP has been set.'')')
- END IF
- IF (BTEST(FOLDER1_FLAG,5)) THEN
- WRITE (6,'('' DIGEST has been set.'')')
- END IF
- IF (BTEST(FOLDER1_FLAG,7)) THEN
- WRITE (6,'('' ALWAYS has been set.'')')
- END IF
- 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)
- CALL READ_PERM
- PERM = .FALSE.
- IF (TEST2(SET_FLAG_DEF,FOLDER1_NUMBER)) THEN
- IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN
- IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.
- & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN
- PERM = .TRUE.
- WRITE (6,'('' Default is BRIEF, which is permanent.'')')
- ELSE
- WRITE (6,'('' Default is BRIEF.'')')
- END IF
- ELSE
- IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.
- & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN
- PERM = .TRUE.
- WRITE (6,'('' Default is READNEW, which is permanent.'')')
- ELSE
- WRITE (6,'('' Default is READNEW.'')')
- END IF
- END IF
- ELSE
- IF (TEST2(BRIEF_FLAG_DEF,FOLDER1_NUMBER)) THEN
- IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.
- & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN
- PERM = .TRUE.
- WRITE (6,'('' Default is SHOWNEW, which is permanent.'')')
- ELSE
- WRITE (6,'('' Default is SHOWNEW.'')')
- END IF
- END IF
- END IF
- IF (.NOT.PERM) THEN
- IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.
- & TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN
- WRITE (6,'('' BRIEF is the permanent setting.'')')
- ELSE IF (TEST2(SET_PERM_FLAG,FOLDER1_NUMBER).AND.
- & .NOT.TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER)) THEN
- WRITE (6,'('' READNEW is the permanent setting.'')')
- ELSE IF (TEST2(BRIEF_PERM_FLAG,FOLDER1_NUMBER).AND.
- & .NOT.TEST2(SET_PERM_FLAG,FOLDER1_NUMBER)) THEN
- WRITE (6,'('' SHOWNEW is the permanent setting.'')')
- END IF
- END IF
- IF (TEST2(NOTIFY_FLAG_DEF,FOLDER1_NUMBER)) THEN
- IF (TEST2(NOTIFY_PERM_FLAG,FOLDER1_NUMBER)) THEN
- WRITE (6,'('' Default is NOTIFY, which is permanent.'')')
- ELSE
- WRITE (6,'('' Default is NOTIFY.'')')
- END IF
- ELSE
- WRITE (6,'('' Default is NONOTIFY.'')')
- END IF
- CALL CLOSE_BULLUSER
- END IF
- END IF
-
- CALL CLOSE_BULLFOLDER
-
- RETURN
-
-1000 FORMAT(' Current folder is: ',A25,' Owner: ',A12,
- & ' Description: ',/,1X,A)
-1010 FORMAT(' Folder name is: ',A25,' Owner: ',A12,
- & ' Description: ',/,1X,A)
- END
-
-
- SUBROUTINE DIRECTORY_FOLDERS(FOLDER_COUNT)
-C
-C SUBROUTINE DIRECTORY_FOLDERS
-C
-C FUNCTION: Display all FOLDER entries.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
- LOGICAL PAGING
-
- COMMON /CTRLC_FLAG/ FLAG
-
- DATA SCRATCH_D1/0/
-
- CHARACTER*80 FOLDER_MATCH
-
- CHARACTER*17 DATETIME
-
- INTEGER*2 MLEN,FLEN
-
- IF (CLI$PRESENT('NEWS')) THEN
- IF (SYS_TRNLNM('BULL_NEWS_SERVER','DEFINED')) THEN
- CALL OPEN_BULLNEWS_SHARED
- ELSE
- WRITE (6,'('' ERROR: NEWS connection is not present.'')')
- RETURN
- END IF
- ELSE
- CALL OPEN_BULLFOLDER_SHARED ! Get folder file
- END IF
-
- IF (FOLDER_COUNT.EQ.0) THEN
- SUBSCRIBE = .FALSE.
- NEW = .FALSE.
- FOLDER_COUNT = 1 ! Init folder number counter
- NLINE = 1
- START = .FALSE.
- IF (.NOT.CLI$PRESENT('NEWS')) THEN
- NEWS = .FALSE.
- IF (CLI$PRESENT('DESCRIBE')) THEN
- NLINE = 2 ! Include folder descriptor if /DESCRIBE
- END IF
- ELSE
- NEWS = .TRUE.
- CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)
- IF (IER.NE.0) THEN
- WRITE (6,'('' Fetching NEWS groups from remote node.''
- & ,'' This will take several minutes.'')')
- WRITE (6,'('' This is the only time this will have''
- & ,'' to be done.'')')
- CALL CLOSE_BULLFOLDER
- CALL NEWS_LIST
- CALL OPEN_BULLNEWS_SHARED
- CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER)
- END IF
- SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')
- NEW = CLI$PRESENT('NEWGROUPS')
- IF (NEW) NEW_NEWS = LAST_NEWS_READ(1,FOLDER_MAX)
- IF (SUBSCRIBE) THEN
- CALL NEWS_GET_SUBSCRIBE(0,F1_END)
- SUBNUM = 1
- END IF
- END IF
- IF (CLI$GET_VALUE('START',FOLDER1,FLEN)) THEN
- IF (NEWS) CALL LOWERCASE(FOLDER1)
- CALL READ_FOLDER_FILE_KEYNAMEGE_TEMP(FOLDER1(:FLEN),IER)
- IF (IER.NE.0) THEN
- WRITE (6,'('' There are no folders.'')')
- CALL CLOSE_BULLFOLDER
- FOLDER_COUNT = -1
- RETURN
- ELSE
- START = .TRUE.
- END IF
- END IF
- MATCH = CLI$GET_VALUE('MATCH_FOLDER',FOLDER_MATCH,MLEN)
- IF (MATCH.AND.NEWS) CALL LOWERCASE(FOLDER_MATCH)
- IF (MATCH.AND.INDEX(FOLDER_MATCH,'*').EQ.0) THEN
- FOLDER_MATCH = '*'//FOLDER_MATCH(:MLEN)//'*'
- MLEN = MLEN + 2
- END IF
- ELSE IF (SUBSCRIBE.AND.PAGING.AND.MORE) THEN
- SUBNUM = -2
- ELSE
- CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
- END IF
-
-C
-C Folder listing is first buffered into temporary memory storage before
-C being outputted to the terminal. This is to be able to quickly close the
-C folder file, and to avoid the possibility of the user holding the screen,
-C and thus causing the folder file to stay open. The temporary memory
-C is structured as a linked-list queue, where SCRATCH_D1 points to the header
-C of the queue.
-C
- CALL INIT_QUEUE(SCRATCH_D1,FOLDER1_COM)
- SCRATCH_D = SCRATCH_D1
-
- CALL DECLARE_CTRLC_AST
-
- NUM_FOLDER = 0
- IER = 0
- IER1 = 0
- MORE = .FALSE.
- DO WHILE (IER.EQ.0.AND.IER1.EQ.0)
- IF (SUBSCRIBE) THEN
- IER = 1
- DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)
- CALL NEWS_GET_SUBSCRIBE(SUBNUM,MSGNUM)
- IF (SUBNUM.NE.0) THEN
- CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)
- IF (IER.NE.0) SUBNUM = -1
- END IF
- END DO
- F1_END = MSGNUM
- IF (SUBNUM.EQ.0) IER = 1
- ELSE IF (START) THEN
- START = .FALSE.
- ELSE IF (NEW) THEN
- CALL READ_FOLDER_FILE_KEYNUM_GT_TEMP(NEW_NEWS,IER)
- IF (IER.EQ.0) THEN
- NEW_NEWS = FOLDER1_NUMBER
- ELSE
- CALL READ_FOLDER_FILE_KEYNAME_TEMP('a',IER2)
- NEW_NEWS = NEWS_F1_END
- END IF
- ELSE
- CALL READ_FOLDER_FILE_TEMP(IER)
- END IF
- IF (IER.EQ.0) THEN
- IF (INDEX(FOLDER1_BBOARD,'::').EQ.0.AND.
- & BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN
- FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
- & //FOLDER1
- CALL CHECK_ACCESS
- & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',
- & USERNAME,READ_ACCESS,-1)
- ELSE
- READ_ACCESS = 1
- END IF
- IF (READ_ACCESS) THEN
- IF (.NOT.MATCH) THEN
- NUM_FOLDER = NUM_FOLDER + 1
- CALL WRITE_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)
- ELSE IF (STR$MATCH_WILD(FOLDER1_DESCRIP
- & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN))) THEN
- GO TO 100
- END IF
- END IF
- IF (PAGING.AND.NUM_FOLDER*NLINE+2.GT.PAGE_LENGTH-4) THEN
- IER1 = 1
- MORE = .TRUE.
- END IF
- END IF
- IF (FLAG.EQ.1) IER1 = 1
- END DO
-
- IF (MATCH) MATCH = .FALSE.
-
- CALL CANCEL_CTRLC_AST
- CALL CLOSE_BULLFOLDER ! We don't need file anymore
-
- IF (FLAG.EQ.1) THEN
- WRITE (6,'('' Folder search aborted.'')')
- FOLDER_COUNT = -1
- RETURN
- END IF
-
- IF (NUM_FOLDER.EQ.0) THEN
- WRITE (6,'('' There are no folders.'')')
- FOLDER_COUNT = -1
- IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS
- RETURN
- END IF
-
-C
-C Folder entries are now in queue. Output queue entries to screen.
-C
-
- SCRATCH_D = SCRATCH_D1 ! Init queue pointer to header
-
-100 CALL LIB$ERASE_PAGE(1,1) ! Clear the screen
-
- IF (.NOT.NEWS) THEN
- WRITE (6,'(1X,''Folder'',22X,''Last message'',7X,''Messages'',
- & 2X,''Owner'',/,1X,80(''-''))')
- ELSE
- WRITE (6,'(1X,''Folder'',<PAGE_WIDTH-80+56>X,
- & ''First Last'',/,1X,<PAGE_WIDTH>(''-''))')
- END IF
-
- IF (PAGING.AND.MORE) NUM_FOLDER = NUM_FOLDER - 1
-
- I = 1
- DO WHILE ((I.LE.NUM_FOLDER.OR.MATCH).AND.FLAG.NE.1)
- IF (.NOT.MATCH) THEN
- CALL READ_QUEUE(%VAL(SCRATCH_D),SCRATCH_D,FOLDER1_COM)
- I = I + 1
- END IF
- IF (.NOT.NEWS) THEN
- DIFF = COMPARE_BTIM
- & (LAST_READ_BTIM(1,FOLDER1_NUMBER+1),F1_NEWEST_BTIM)
- IF (F1_NBULL.GT.0) THEN
- CALL SYS$ASCTIM(,DATETIME,F1_NEWEST_BTIM,)
- 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
- ELSE
- FLEN = MIN(80,PAGE_WIDTH-80+56)
- IF (SUBSCRIBE) FLEN = MIN(81,PAGE_WIDTH-80+55)
- IF (F1_START.LE.F1_NBULL) THEN
- IF (SUBSCRIBE) THEN
- IF (F1_END.LT.F1_NBULL.AND.F1_NBULL.GT.0) THEN
- WRITE (6,1005) '*'//FOLDER1_DESCRIP(:FLEN-1)
- & ,F1_START,F1_NBULL
- ELSE
- WRITE (6,1005) ' '//FOLDER1_DESCRIP(:FLEN-1)
- & ,F1_START,F1_NBULL
- END IF
- ELSE
- WRITE (6,1005) FOLDER1_DESCRIP(:FLEN)
- & ,F1_START,F1_NBULL
- END IF
- ELSE IF (SUBSCRIBE) THEN
- WRITE (6,1005) ' '//FOLDER1_DESCRIP(:FLEN-1),0,0
- ELSE
- WRITE (6,1005) FOLDER1_DESCRIP(:FLEN),0,0
- END IF
- END IF
- IF (NLINE.EQ.2) WRITE (6,'(1X,A)') FOLDER1_DESCRIP
- IF (MATCH.AND.FLAG.NE.1) THEN
- NUM_FOLDER = NUM_FOLDER + 1
- IF (PAGING.AND.
- & NUM_FOLDER*NLINE+2.GE.PAGE_LENGTH-4) MORE = .TRUE.
- FOUND = .FALSE.
- DO WHILE (FLAG.NE.1.AND.IER.EQ.0.AND..NOT.FOUND)
- CALL READ_FOLDER_FILE_TEMP(IER)
- IF (IER.EQ.0.AND.STR$MATCH_WILD(FOLDER1_DESCRIP
- & (:TRIM(FOLDER1_DESCRIP)),FOLDER_MATCH(:MLEN))) THEN
- FOUND = .TRUE.
- END IF
- END DO
- MORE = MORE.AND.FOUND
- FOUND = FOUND.AND..NOT.MORE
- IF (.NOT.FOUND) FLAG = 1
- END IF
- END DO
-
- IF (MATCH) THEN
- CALL CANCEL_CTRLC_AST
- CALL CLOSE_BULLFOLDER
- END IF
-
- IF (IER.NE.0.AND..NOT.MORE) THEN ! Outputted all entries?
- FOLDER_COUNT = -1 ! Yes. Set counter to -1.
- IF (NEW) LAST_NEWS_READ(1,FOLDER_MAX) = NEW_NEWS
- ELSE
- WRITE(6,1100) ! Else say there are more
- END IF
-
- RETURN
-
-1000 FORMAT(1X,A26,2X,A17,2X,I8,2X,A12)
-1005 FORMAT(1X,A<FLEN>,<PAGE_WIDTH-FLEN-22-1>X,I10,' ',I10)
-1100 FORMAT(1X,/,' Press RETURN for more...',/)
-
- END
-
-
- SUBROUTINE SET_ACCESS(ACCESS)
-C
-C SUBROUTINE SET_ACCESS
-C
-C FUNCTION: Set access on folder for specified ID.
-C
-C PARAMETERS:
-C ACCESS - Logical: If .true., grant access, if .false. deny access
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE '($SSDEF)'
-
- LOGICAL ACCESS,ALL,READONLY
-
- EXTERNAL CLI$_ABSENT
-
- CHARACTER ID*64,RESPONSE*1
-
- CHARACTER INPUT*132
-
- IF (CLI$PRESENT('ALL')) THEN
- ALL = .TRUE.
- ELSE
- ALL = .FALSE.
- END IF
-
- IF (CLI$PRESENT('READONLY')) THEN
- READONLY = .TRUE.
- ELSE
- READONLY = .FALSE.
- END IF
-
- IER = CLI$GET_VALUE('ACCESS_FOLDER',FOLDER1,LEN) ! Get folder name
-
- IF (IER.EQ.%LOC(CLI$_ABSENT)) THEN
- FOLDER1 = FOLDER
- ELSE IF (LEN.GT.25) THEN
- WRITE(6,'('' ERROR: Folder name must be < 26 characters.'')')
- RETURN
- END IF
-
- CALL OPEN_BULLFOLDER ! Open folder file
- CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER) ! See if it exists
- OLD_FOLDER1_FLAG = FOLDER1_FLAG
- CALL CLOSE_BULLFOLDER
-
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: No such folder exists.'')')
- ELSE IF (.NOT.FOLDER_ACCESS(USERNAME,FOLDER1_FLAG,FOLDER1_OWNER)) THEN
- WRITE (6,
- & '('' ERROR: You are not able to modify access to the folder.'')')
- ELSE
- FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
- & FOLDER1
- CALL CHKACL
- & (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,
- & 'Folder is not private. Do you want to make it so? (Y/N): ')
- IF (RESPONSE.NE.'y'.AND.RESPONSE.NE.'Y') THEN
- 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)
- 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) THEN
- 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 IF
- ELSE
- CALL DEL_ACL('*','R',IER)
- END IF
- IF (.NOT.IER) THEN
- WRITE(6,'('' Cannot modify access.'')')
- CALL SYS_GETMSG(IER)
- END IF
- 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.'@') THEN
- ILEN = INDEX(INPUT,',') - 1
- IF (ILEN.EQ.-1) ILEN = TRIM(INPUT)
- OPEN (UNIT=3,STATUS='OLD',FILE=INPUT(2:ILEN),
- & DEFAULTFILE='.DIS',IOSTAT=IER)
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: Cannot find file '',A)')
- & INPUT(2:ILEN)
- RETURN
- END IF
- READ (3,'(A)',IOSTAT=IER) INPUT
- IF (IER.NE.0) THEN
- 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,']') + 1
- IF (INPUT(:1).EQ.'"') COMMA = INDEX(INPUT(2:),'"') + 2
- IF (COMMA.GT.0) THEN
- ID = INPUT(1:COMMA-1)
- INPUT = INPUT(COMMA+1:)
- ELSE
- ID = INPUT
- INPUT = ' '
- END IF
- ILEN = TRIM(ID)
- IF (ID.EQ.FOLDER1_OWNER) THEN
- WRITE (6,'('' ERROR: Cannot modify access'',
- & '' for owner of folder.'')')
- ELSE
- IF (ACCESS) THEN
- IF (READONLY) THEN
- CALL ADD_ACL(ID,'R',IER)
- ELSE
- CALL ADD_ACL(ID,'R+W',IER)
- END IF
- ELSE
- CALL DEL_ACL(ID,'R+W',IER)
- IF (.NOT.IER) CALL DEL_ACL(ID,'R',IER)
- END IF
- IF (.NOT.IER) THEN
- WRITE(6,'('' Cannot modify access for '',A,
- & ''.'')') ID(:ILEN)
- 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) INPUT
- IF (IER.NE.0) THEN
- CLOSE (UNIT=3)
- INPUT = ' '
- FILE_OPEN = .FALSE.
- END IF
- END IF
- END DO
- END DO
-
-100 IF (OLD_FOLDER1_FLAG.NE.FOLDER1_FLAG) THEN
- CALL OPEN_BULLFOLDER ! Open folder file
- 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)
-C
-C SUBROUTINE CHKACL
-C
-C FUNCTION: Checks ACL of given file.
-C
-C PARAMETERS:
-C FILENAME - Name of file to check.
-C IERACL - Error returned for attempt to open file.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) FILENAME
-
- INCLUDE '($ACLDEF)'
- INCLUDE '($SSDEF)'
-
- 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) THEN
- IERACL = SS$_NORMAL.OR.IERACL
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE CHECK_ACCESS(FILENAME,USERNAME,READ_ACCESS,WRITE_ACCESS)
-C
-C SUBROUTINE CHECK_ACCESS
-C
-C FUNCTION: Checks ACL of given file.
-C
-C PARAMETERS:
-C FILENAME - Name of file to check.
-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.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- 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,
- & %VAL(ACL_ITMLST))
-
-
- IF (ICHAR(ACE(:1)).NE.0) THEN
- 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) THEN
- READ_ACCESS = 0
- END IF
-
- IF (WRITE_ACCESS.EQ.-1) THEN ! Only check read access
- RETURN
- ELSE IF (READ_ACCESS.EQ.0) THEN ! If no read access, then of
- WRITE_ACCESS = 0 ! course there is no write access.
- RETURN
- END IF
-
- ACCESS = ARM$M_WRITE ! Check if user has write access
- WRITE_ACCESS=SYS$CHECK_ACCESS(ACL$C_FILE,FILENAME,USERNAME,
- & %VAL(ACL_ITMLST))
-
- IF (ICHAR(ACE(:1)).NE.0) THEN
- CALL SYS$FORMAT_ACL(ACE,,OUTPUT,,,,)
- IF (INDEX(OUTPUT,'=*').NE.0.AND.
- & INDEX(OUTPUT,'WRITE').EQ.0) WRITE_ACCESS = 0
- ELSE IF (ICHAR(ACE(:1)).EQ.0.AND.WRITE_ACCESS) THEN
- WRITE_ACCESS = 0
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SHOWACL(FILENAME)
-C
-C SUBROUTINE SHOWACL
-C
-C FUNCTION: Shows users who are allowed to read private bulletin.
-C
-C PARAMETERS:
-C FILENAME - Name of file to check.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($ACLDEF)'
-
- CHARACTER*(*) FILENAME
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
-
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)
-
- CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR)
- CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH)
-
- CALL READACL(FILENAME,%VAL(ACLSTR),ACLLENGTH)
-
- RETURN
- END
-
-
-
- SUBROUTINE FOLDER_FILE_ROUTINES
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) KEY_NAME
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /NEWS_OPEN/ NEWS_OPEN
-
- ENTRY WRITE_FOLDER_FILE(IER)
-
- IF (NEWS_OPEN) CALL FOLDER_TO_NEWS
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- WRITE (7,IOSTAT=IER) NEWS_FOLDER_COM
- ELSE
- WRITE (7,IOSTAT=IER) FOLDER_COM
- END IF
- END DO
-
- RETURN
-
- ENTRY REWRITE_FOLDER_FILE
-
- IF (NEWS_OPEN) THEN
- CALL FOLDER_TO_NEWS
- REWRITE (7,IOSTAT=IER) NEWS_FOLDER_COM
- ELSE
- REWRITE (7,IOSTAT=IER) FOLDER_COM
- END IF
-
- RETURN
-
- ENTRY REWRITE_FOLDER_FILE_TEMP
-
- IF (NEWS_OPEN) THEN
- CALL FOLDER1_TO_NEWS
- REWRITE (7,IOSTAT=IER) NEWS_FOLDER1_COM
- ELSE
- REWRITE (7,IOSTAT=IER) FOLDER1_COM
- END IF
-
- RETURN
-
- ENTRY READ_FOLDER_FILE(IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,IOSTAT=IER) NEWS_FOLDER_COM
- ELSE
- READ (7,IOSTAT=IER) FOLDER_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_TEMP(IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,IOSTAT=IER) NEWS_FOLDER1_COM
- ELSE
- READ (7,IOSTAT=IER) FOLDER1_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_KEYNUM(KEY_NUMBER,IER)
-
- SAVE_FOLDER_NUMBER = FOLDER_NUMBER
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM
- ELSE
- READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER
-
- FOLDER_NUMBER = SAVE_FOLDER_NUMBER
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_KEYNUM_GT(KEY_NUMBER,IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER_COM
- ELSE
- READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_KEYNUM_TEMP(KEY_NUMBER,IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM
- ELSE
- READ (7,KEY=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_KEYNUM_GT_TEMP(KEY_NUMBER,IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) NEWS_FOLDER1_COM
- ELSE
- READ (7,KEYGT=KEY_NUMBER,KEYID=1,IOSTAT=IER) FOLDER1_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_KEYNAME_TEMP(KEY_NAME,IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM
- ELSE
- READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_KEYNAMEGE_TEMP(KEY_NAME,IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER1_COM
- ELSE
- READ (7,KEYGE=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER1_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER1
-
- RETURN
-
- ENTRY READ_FOLDER_FILE_KEYNAME(KEY_NAME,IER)
-
- DO WHILE (REC_LOCK(IER))
- IF (NEWS_OPEN) THEN
- READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) NEWS_FOLDER_COM
- ELSE
- READ (7,KEY=KEY_NAME,KEYID=0,IOSTAT=IER) FOLDER_COM
- END IF
- END DO
-
- IF (NEWS_OPEN.AND.IER.EQ.0) CALL NEWS_TO_FOLDER
-
- RETURN
-
- END
-
-
- SUBROUTINE USER_FILE_ROUTINES
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PRVDEF)'
-
- INCLUDE '($FORIOSDEF)'
-
- CHARACTER*(*) KEY_NAME
-
- INCLUDE 'BULLUSER.INC'
-
- CHARACTER*12 SAVE_USERNAME
-
- ENTRY READ_USER_FILE(IER)
-
- SAVE_USERNAME = USERNAME
-
- DO WHILE (REC_LOCK(IER))
- READ (4,IOSTAT=IER) USER_ENTRY
- END DO
-
- TEMP_USER = USERNAME
- USERNAME = SAVE_USERNAME
-
- RETURN
-
- ENTRY READ_USER_FILE_KEYNAME(KEY_NAME,IER)
-
- SAVE_USERNAME = USERNAME
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY=KEY_NAME,IOSTAT=IER) USER_ENTRY
- END DO
-
- USERNAME = SAVE_USERNAME
- TEMP_USER = KEY_NAME
-
- RETURN
-
- ENTRY READ_USER_FILE_HEADER(IER)
-
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY=' ',IOSTAT=IER) USER_HEADER
- IF (IER.EQ.FOR$IOS_ATTACCNON) THEN
- WRITE (4,FMT=USER_FMT,IOSTAT=IER)
- & USER_HEADER_KEY,NEWEST_BTIM,
- & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR.
- & PRV$M_SETPRV,(0,I=1,FLONG*4-1)
- IER = FOR$IOS_SPERECLOC
- END IF
- END DO
-
- RETURN
-
- ENTRY WRITE_USER_FILE_NEW(IER)
-
- DO I=1,FLONG
- SET_FLAG(I) = SET_FLAG_DEF(I)
- BRIEF_FLAG(I) = BRIEF_FLAG_DEF(I)
- NOTIFY_FLAG(I) = NOTIFY_FLAG_DEF(I)
- END DO
-
- ENTRY WRITE_USER_FILE(IER)
-
- DO WHILE (REC_LOCK(IER))
- WRITE (4,IOSTAT=IER) USER_ENTRY
- END DO
-
- RETURN
-
- END
-
-
-
-
-
- SUBROUTINE SET_GENERIC(GENERIC)
-C
-C SUBROUTINE SET_GENERIC
-C
-C FUNCTION: Enables or disables "GENERIC" display, i.e. displaying
-C general bulletins continually for a certain amount of days.
-C
- IMPLICIT INTEGER (A-Z)
-
- 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) THEN
- 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 IF
- ELSE
- NEW_FLAG(2) = 0
- END IF
- REWRITE (4) TEMP_USER//USER_ENTRY(13:)
- ELSE
- WRITE (6,'('' ERROR: Specified username not found.'')')
- END IF
-
- CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
- SUBROUTINE SET_BRIEF_CONTINUOUS(BRIEF_CONTINUOUS)
-C
-C SUBROUTINE SET_BRIEF_CONTINUOUS
-C
-C FUNCTION: Enables or disables "BRIEF_CONTINUOUS" display, i.e. displaying
-C the brief message continually until the new messages have been read.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- CALL OPEN_BULLUSER_SHARED
-
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER)
-
- IF (BRIEF_CONTINUOUS) THEN
- NEW_FLAG(2) = -1
- ELSE
- NEW_FLAG(2) = 0
- END IF
-
- IF (IER.EQ.0) REWRITE (4) USER_ENTRY
-
- CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
- SUBROUTINE SET_LOGIN(LOGIN)
-C
-C SUBROUTINE SET_LOGIN
-C
-C FUNCTION: Enables or disables bulletin display at login.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- CHARACTER TODAY*23
-
- 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)
- 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:)
- ELSE
- WRITE (6,'('' ERROR: Specified username not found.'')')
- END IF
-
- CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GET_UAF(USERNAME,USER,GROUP,ACCOUNT,FLAGS,IER)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER USERNAME*(*),ACCOUNT*(*)
-
- 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)
-
- IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)
-
- USER = UIC(1)
- GROUP = UIC(2)
-
- RETURN
- END
-
-
-
- SUBROUTINE DCLEXH(EXIT_ROUTINE)
-
- IMPLICIT INTEGER (A-Z)
-
- INTEGER*4 EXBLK(4)
-
- EXBLK(2) = EXIT_ROUTINE
- EXBLK(3) = 1
- EXBLK(4) = %LOC(EXBLK(4))
-
- CALL SYS$DCLEXH(EXBLK(1))
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin6.for b/decus/vax91b/bulletin-net91b/bulletin6.for
deleted file mode 100644
index 7af811ac9d9c9cc97ec859f296e7ea1906b5a01a..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin6.for
+++ /dev/null
@@ -1,1700 +0,0 @@
-C
-C BULLETIN6.FOR, Version 7/17/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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 CLOSE_FILE
-C
-C SUBROUTINE CLOSE_FILE
-C
-C FUNCTION: To close out the bulletin files and enable CTRL-C & -Y
-C
- DATA LUN /0/
-
- ENTRY CLOSE_BULLINF
- LUN = LUN + 1 ! Unit = 9
-
- ENTRY CLOSE_SYSUAF
- LUN = LUN + 1 ! Unit = 8
-
- ENTRY CLOSE_BULLNEWS
- ENTRY CLOSE_BULLFOLDER
- LUN = LUN + 3 ! Unit = 7
-
- ENTRY CLOSE_BULLUSER
- LUN = LUN + 2 ! Unit = 4
-
- ENTRY CLOSE_BULLDIR
- LUN = LUN + 1 ! Unit = 2
-
- ENTRY CLOSE_BULLFIL
- LUN = LUN + 1 ! Unit = 1
-
- CALL ENABLE_CTRL
-
- CLOSE (UNIT=LUN)
-
- LUN = 0
-
- RETURN
- END
-
-
- SUBROUTINE CLOSE_FILE_DELETE
-
- IMPLICIT INTEGER (A-Z)
-
- DATA LUN /0/
-
- ENTRY CLOSE_BULLDIR_DELETE
- LUN = LUN + 1 ! Unit = 2
-
- ENTRY CLOSE_BULLFIL_DELETE
- LUN = LUN + 1 ! Unit = 1
-
- CALL ENABLE_CTRL
-
- CLOSE (UNIT=LUN,STATUS='DELETE')
-
- LUN = 0
-
- RETURN
- END
-
-
- SUBROUTINE OPEN_FILE(UNIT)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE '($FORIOSDEF)'
-
- INCLUDE '($PRVDEF)'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /DIR_POSITION/ DIR_NUM
-
- COMMON /NEWS_OPEN/ NEWS_OPEN
-
- DATA LUN /0/
-
- LUN = UNIT - 14 ! 14 gets added to LUN
-
- ENTRY OPEN_BULLNEWS
- LUN = LUN + 5 ! Unit = 14
-
- ENTRY OPEN_BULLINF
- LUN = LUN + 1 ! Unit = 9
-
- ENTRY OPEN_SYSUAF
- LUN = LUN + 1 ! Unit = 8
-
- ENTRY OPEN_BULLFOLDER
- LUN = LUN + 3 ! Unit = 7
-
- ENTRY OPEN_BULLUSER
- LUN = LUN + 2 ! Unit = 4
-
- ENTRY OPEN_BULLDIR
- LUN = LUN + 1 ! Unit = 2
-
- ENTRY OPEN_BULLFIL
- LUN = LUN + 1 ! Unit = 1
-
- IER = 0
-
- NTRIES = 0
-
- CALL DISABLE_CTRL ! No breaks while file is open
-
- IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
-
- OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
-
- IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
- OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- ELSE IF (IER.EQ.0) THEN
- INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)
- IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN
- CLOSE (UNIT=2)
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_BULLFILES
- NTRIES = 0
- END IF
- ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_BULLDIRS
- NTRIES = 0
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
- END DO
- DIR_NUM = -1
- END IF
-
- IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLFIL',STATUS='UNKNOWN',IOSTAT=IER,
- & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
- & FORM='UNFORMATTED')
- IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_BULLFILE
- NTRIES = 0
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
- END DO
- END IF
-
- IF (LUN.EQ.4) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:12:CHARACTER))
- IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
- OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='UNKNOWN',
- & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
- & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:12:CHARACTER))
- WRITE (4,FMT=USER_FMT) USER_HEADER_KEY,NEWEST_BTIM,
- & BBOARD_BTIM,PRV$M_OPER.OR.PRV$M_CMKRNL.OR.
- & PRV$M_SETPRV,(0,I=1,FLONG*4-1)
- CLOSE (UNIT=4)
- IDUMMY = FILE_LOCK(IER,IER1)
- ELSE IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
- IDUMMY = FILE_LOCK(IER,IER1)
- CALL CONVERT_USERFILE
- NTRIES = 0
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
- END DO
- END IF
-
- IF (LUN.EQ.7) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:25:CHARACTER,26:29:INTEGER))
- IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
- FOLDER1 = 'GENERAL'
- FOLDER1_OWNER = 'SYSTEM'
- FOLDER1_DESCRIP = 'Default general bulletin folder.'
- FOLDER1_BBOARD = 'NONE'
- FOLDER1_BBEXPIRE = 14
- NBULL = 0
- OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='UNKNOWN',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & RECORDSIZE=FOLDER_RECORD,
- & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,
- & KEY=(1:25:CHARACTER,26:29:INTEGER))
- WRITE (7,FMT=FOLDER_FMT,IOSTAT=IER2)
- & FOLDER1,0,FOLDER1_OWNER,FOLDER1_DESCRIP
- & ,FOLDER1_BBOARD,FOLDER1_BBEXPIRE,USERB,GROUPB,ACCOUNTB
- & ,NBULL,F_NEWEST_BTIM,4,0,F_NEWEST_NOSYS_BTIM
- ! 4 means system folder
- CLOSE (UNIT=7)
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
- END DO
- IF (IER.EQ.0) NEWS_OPEN = .FALSE.
- END IF
-
- IF (LUN.EQ.14) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:25:CHARACTER,26:29:INTEGER))
- IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
- OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='UNKNOWN',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & RECORDSIZE=NEWS_FOLDER_RECORD,
- & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER2,
- & KEY=(1:25:CHARACTER,26:29:INTEGER))
- CLOSE (UNIT=7)
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
- END DO
- IF (IER.EQ.0) NEWS_OPEN = .TRUE.
- END IF
-
- IF (LUN.EQ.9) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='UNKNOWN',
- & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3,
- & IOSTAT=IER,ORGANIZATION='INDEXED',
- & KEY=(1:12:CHARACTER))
- IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_INFFILE
- NTRIES = 0
- END IF
- NTRIES = 0
- IF (NTRIES.GT.30) CALL TIMER_ERR(LUN)
- END DO
- END IF
-
- IF (IER.NE.0) THEN
- WRITE (6,'(
- & '' Cannot open file in OPEN_FILE, unit = '',I)') LUN
- IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
- IF (IER1.EQ.0) THEN
- WRITE (6,'('' IOSTAT error = '',I)') IER
- ELSE
- CALL SYS_GETMSG(IER1)
- END IF
- CALL ENABLE_CTRL_EXIT ! Enable CTRL-Y & -C & EXIT
- END IF
-
- LUN = 0
-
- RETURN
- END
-
-
-
- SUBROUTINE TIMER_ERR(UNIT)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*14 NAMES(6)
- DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT',
- & 'BULLINF.DAT','BULLNEWS.DAT'/
- INTEGER NAME(14)
- DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/
-
- IF (TEST_BULLCP().NE.2) THEN ! If BULLCP process, don't log error
- WRITE(6,'('' ERROR: Unable to open '',A,
- & '' file after 30 secs.'')')
- & NAMES(NAME(UNIT))(:TRIM(NAMES(NAME(UNIT))))
- WRITE (6,'('' Please try again later.'')')
- END IF
-
- CALL ENABLE_CTRL_EXIT ! No breaks while file is open
- END
-
-
-
- SUBROUTINE OPEN_FILE_SHARED
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($FORIOSDEF)'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /DIR_POSITION/ DIR_NUM
-
- COMMON /NEWS_OPEN/ NEWS_OPEN
-
- EXTERNAL LNM_MODE_EXEC,ENABLE_CTRL_EXIT
-C
-C The following 2 files were used prior to V1.1.
-C
- CHARACTER*80 BULLDIR_FILE /'BULL_DIR:BULLDIR.DAT'/
- CHARACTER*80 BULLETIN_FILE /'BULL_DIR:BULLETIN.DAT'/
-
- CHARACTER*25 SAVE_FOLDER
- DATA SAVE_BLOCK/-1/
-
- CHARACTER*14 NAMES(6)
- DATA NAMES/'directory','message','BULLUSER.DAT','BULLFOLDER.DAT',
- & 'BULLINF.DAT','BULLNEWS.DAT'/
- INTEGER NAME(14)
- DATA NAME/1,2,0,3,0,0,4,0,5,0,0,0,0,6/
-
- DATA LUN /0/
-
- ENTRY OPEN_BULLNEWS_SHARED
- LUN = LUN + 5 ! Unit = 14
-
- ENTRY OPEN_BULLINF_SHARED
- LUN = LUN + 1 ! Unit = 9
-
- ENTRY OPEN_SYSUAF_SHARED
- LUN = LUN + 1 ! Unit = 8
-
- ENTRY OPEN_BULLFOLDER_SHARED
- LUN = LUN + 3 ! Unit = 7
-
- ENTRY OPEN_BULLUSER_SHARED
- LUN = LUN + 2 ! Unit = 4
-
- ENTRY OPEN_BULLDIR_SHARED
- LUN = LUN + 1 ! Unit = 2
-
- ENTRY OPEN_BULLFIL_SHARED
- LUN = LUN + 1 ! Unit = 1
-
- IER = 0
-
- NTRIES = 0
-
- CALL DISABLE_CTRL
-
- IF (LUN.EQ.2.AND..NOT.REMOTE_SET) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
-
- OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,SHARED,READONLY,
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.(FOLDER_NUMBER.EQ.0
- & .OR.FOLDER.EQ.'GENERAL')) THEN
- IER2 = LIB$RENAME_FILE(BULLETIN_FILE,'GENERAL.BULLFIL')
- IER2 = LIB$RENAME_FILE(BULLDIR_FILE,'GENERAL.BULLDIR')
- IF (IER2) IDUMMY = FILE_LOCK(IER,IER1) ! Don't break out of loop
- ELSE IF (IER.EQ.0) THEN
- INQUIRE(UNIT=2,RECORDSIZE=ASK_SIZE)
- IF (ASK_SIZE.NE.DIR_RECORD_LENGTH/4) THEN
- CLOSE (UNIT=2)
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_BULLFILES
- NTRIES = 0
- END IF
- ELSE IF (IER.EQ.FOR$IOS_INCFILORG) THEN
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_BULLDIRS
- NTRIES = 0
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
- END DO
- DIR_NUM = -1
- END IF
-
- IF (LUN.EQ.1.AND.REMOTE_SET.AND.(SAVE_BLOCK.NE.BLOCK.OR.
- & SAVE_FOLDER.NE.FOLDER)) THEN
- CALL REMOTE_READ_MESSAGE(BULL_POINT,IER)
- IF (IER.GT.0) THEN
- CALL ERROR_AND_EXIT
- ELSE
- SAVE_BLOCK = BLOCK
- SAVE_FOLDER = FOLDER
- CALL GET_REMOTE_MESSAGE(IER)
- IER = 0
- END IF
- ELSE IF (LUN.EQ.1.AND..NOT.REMOTE_SET) THEN
- SAVE_BLOCK = -1
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLFIL',STATUS='OLD',
- & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
- & FORM='UNFORMATTED',IOSTAT=IER,SHARED,READONLY)
- IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_BULLFILE
- NTRIES = 0
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
- END DO
- END IF
-
- IF (LUN.EQ.4) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=7+FLONG*4,
- & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
- & KEY=(1:12:CHARACTER))
- IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
- IDUMMY = FILE_LOCK(IER,IER1)
- CALL CONVERT_USERFILE
- NTRIES = 0
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
- END DO
- END IF
-
- IF (LUN.EQ.7) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=7,FILE=BULLFOLDER_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
- & KEY=(1:25:CHARACTER,26:29:INTEGER))
-
- IF (IER.EQ.0) THEN
- INQUIRE(UNIT=7,RECORDSIZE=ASK_SIZE)
- IF (ASK_SIZE.NE.FOLDER_RECORD/4) THEN
- CLOSE (UNIT=7)
- IDUMMY = FILE_LOCK(IER,IER1)
- CALL CONVERT_BULLFOLDER(BULLFOLDER_FILE,ASK_SIZE)
- NTRIES = 0
- END IF
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
- END DO
- IF (IER.EQ.0) NEWS_OPEN = .FALSE.
- END IF
-
- IF (LUN.EQ.14) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=7,FILE=BULLNEWS_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
- & KEY=(1:25:CHARACTER,26:29:INTEGER))
-
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
- END DO
- IF (IER.EQ.0) NEWS_OPEN = .TRUE.
- END IF
-
- IF (LUN.EQ.8) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=8,FILE='SYSUAF',DEFAULTFILE='SYS$SYSTEM:SYSUAF.DAT',
- & ACCESS='KEYED',FORM='UNFORMATTED',ORGANIZATION='INDEXED',
- & STATUS='OLD',READONLY,IOSTAT=IER,SHARED,
- & USEROPEN=LNM_MODE_EXEC)
- END DO
- END IF
-
- IF (LUN.EQ.9) THEN
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & RECORDSIZE=FOLDER_MAX*2+3,
- & IOSTAT=IER,ORGANIZATION='INDEXED',SHARED,
- & KEY=(1:12:CHARACTER))
- IF (IER.EQ.FOR$IOS_INCRECLEN) THEN
- IDUMMY = FILE_LOCK(IER,IER1) ! Avoid breaking out of DO loop
- CALL CONVERT_INFFILE
- NTRIES = 0
- END IF
- NTRIES = NTRIES + 1
- IF (NTRIES.GT.30) CALL ENABLE_CTRL_EXIT
- END DO
- END IF
-
- IF (IER.EQ.FOR$IOS_FILNOTFOU.AND.LUN.NE.8) THEN
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
- CALL OPEN_FILE(LUN)
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
- ELSE IF (IER.NE.0) THEN
- WRITE(6,'('' ERROR: Cannot open '',A)')
- & NAMES(NAME(LUN))(:TRIM(NAMES(NAME(LUN))))
- IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
- IF (IER1.EQ.0) THEN
- WRITE (6,'('' IOSTAT error = '',I)') IER
- ELSE
- CALL SYS_GETMSG(IER1)
- END IF
- CALL ENABLE_CTRL_EXIT
- END IF
-
- LUN = 0
-
- RETURN
- END
-
-
-
-
- SUBROUTINE FOLDER_TO_NEWS
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- NEWS_FOLDER = FOLDER
- NEWS_FOLDER_NUMBER = FOLDER_NUMBER
- NEWS_FOLDER_DESCRIP = FOLDER_DESCRIP(26:)
- NEWS_FOLDER_BBOARD = FOLDER_BBOARD
- NEWS_F_NBULL = F_NBULL
- NEWS_F_NEWEST_BTIM(1) = F_NEWEST_BTIM(1)
- NEWS_F_NEWEST_BTIM(2) = F_NEWEST_BTIM(2)
-
- RETURN
-
- ENTRY FOLDER1_TO_NEWS
-
- NEWS_FOLDER1 = FOLDER1
- NEWS_FOLDER1_NUMBER = FOLDER1_NUMBER
- NEWS_FOLDER1_DESCRIP = FOLDER1_DESCRIP(26:)
- NEWS_FOLDER1_BBOARD = FOLDER1_BBOARD
- NEWS_F1_NBULL = F1_NBULL
- NEWS_F1_NEWEST_BTIM(1) = F1_NEWEST_BTIM(1)
- NEWS_F1_NEWEST_BTIM(2) = F1_NEWEST_BTIM(2)
-
- RETURN
-
- ENTRY NEWS_TO_FOLDER
-
- FOLDER = NEWS_FOLDER
- FOLDER_NUMBER = NEWS_FOLDER_NUMBER
- FOLDER_DESCRIP = NEWS_FOLDER//NEWS_FOLDER_DESCRIP
- FOLDER_BBOARD = NEWS_FOLDER_BBOARD
- F_NBULL = NEWS_F_NBULL
- F_NEWEST_BTIM(1) = NEWS_F_NEWEST_BTIM(1)
- F_NEWEST_BTIM(2) = NEWS_F_NEWEST_BTIM(2)
- FOLDER_FLAG = 0
-
- RETURN
-
- ENTRY NEWS_TO_FOLDER1
-
- FOLDER1 = NEWS_FOLDER1
- FOLDER1_NUMBER = NEWS_FOLDER1_NUMBER
- FOLDER1_DESCRIP = NEWS_FOLDER1//NEWS_FOLDER1_DESCRIP
- FOLDER1_BBOARD = NEWS_FOLDER1_BBOARD
- F1_NBULL = NEWS_F1_NBULL
- F1_NEWEST_BTIM(1) = NEWS_F1_NEWEST_BTIM(1)
- F1_NEWEST_BTIM(2) = NEWS_F1_NEWEST_BTIM(2)
- FOLDER1_FLAG = 0
-
- RETURN
-
- END
-
-
-
-
- SUBROUTINE CONVERT_BULLDIRS
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- CHARACTER BUFFER*115
-
- WRITE (6,'('' Converting data files to new format. Please wait.'')')
-
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
-
- OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',ACCESS='DIRECT',
- & ORGANIZATION='RELATIVE',DISPOSE='KEEP',
- & IOSTAT=IER)
-
- IF (IER.NE.0) GO TO 900 ! No BULLDIR file found.
-
- READ (2'1,IOSTAT=IER1) BUFFER
-
- CALL LIB$MOVC3(4,%REF(BUFFER(39:)),NBULL)
-
- OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',
- & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+5 )
-
- IF (IER.NE.0) THEN
- OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- END IF
-
- IF (IER1.NE.0) GO TO 800
-
- CALL SYS_BINTIM(BUFFER(1:11)//' '//BUFFER(12:19),NEWEST_EXBTIM)
- CALL SYS_BINTIM(BUFFER(20:30)//' '//BUFFER(31:38),NEWEST_MSGBTIM)
- BULLDIR_HEADER(29:40) = BUFFER(39:)
- CALL SYS_BINTIM(BUFFER(51:61)//' '//BUFFER(62:69),SHUTDOWN_BTIM)
- BULLDIR_HEADER(49:52) = BUFFER(70:)
- IF (IER.EQ.0) WRITE (9,IOSTAT=IER) BULLDIR_HEADER
-
- ICOUNT = 2
- DO WHILE (IER.EQ.0)
- READ (2'ICOUNT,IOSTAT=IER) BUFFER
- IF (IER.EQ.0) THEN
- MSG_NUM = ICOUNT - 1
- DESCRIP = BUFFER(1:)
- FROM = BUFFER(54:)
- BULLDIR_ENTRY(78:81) = BUFFER(85:)
- BULLDIR_ENTRY(90:97) = BUFFER(108:)
- CALL SYS_BINTIM(BUFFER(89:99)//' '//BUFFER(100:107),EX_BTIM)
- CALL SYS_BINTIM(BUFFER(66:76)//' '//BUFFER(77:84),MSG_BTIM)
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- WRITE (9,IOSTAT=IER) BULLDIR_ENTRY
- ICOUNT = ICOUNT + 1
- END IF
- END DO
-
-800 CLOSE (UNIT=9,DISPOSE='KEEP')
- CLOSE (UNIT=2)
-
-900 CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
-
- RETURN
-
- END
-
-
-
- SUBROUTINE CONVERT_BULLFILES
-C
-C SUBROUTINE CONVERT_BULLFILES
-C
-C FUNCTION: Converts bulletin files to new format file.
-C Add expiration time to directory file, add extra byte to bulletin
-C file to show where each bulletin starts (for redunancy sake in
-C case crash occurs).
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- CHARACTER*81 BUFFER
-
- WRITE (6,'('' Converting data files to new format. Please wait.'')')
-
- OPEN (UNIT=9,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='OLD',
- & RECORDTYPE='FIXED',RECORDSIZE=107,ACCESS='DIRECT',
- & ORGANIZATION='RELATIVE',DISPOSE='KEEP',FORM='FORMATTED',
- & SHARED,READONLY,IOSTAT=IER)
-
- IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why?
-
- OPEN (UNIT=10,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLFIL',STATUS='OLD',
- & RECORDTYPE='FIXED',RECORDSIZE=80,
- & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)
-
- IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why?
-
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
-
- OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLFIL',STATUS='NEW',IOSTAT=IER,
- & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=81,
- & FORM='FORMATTED')
-
- OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='NEW',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='KEEP',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
-
- NEWEST_EXTIME = '00:00:00.00'
- READ (9'1,1000,IOSTAT=IER)
- & NEWEST_EXDATE,NEWEST_DATE,NEWEST_TIME(:8),
- & NBULL,NBLOCK,SHUTDOWN,SHUTDOWN_DATE,SHUTDOWN_TIME(:8)
- NEMPTY = 0
- IF (IER.EQ.0) CALL WRITEDIR(0,IER1)
-
- EXTIME = '00:00:00.00'
- ICOUNT = 2
- DO WHILE (IER.EQ.0)
- READ(9'ICOUNT,1010,IOSTAT=IER)
- & DESCRIP,FROM,DATE,TIME(:8),LENGTH,EXDATE,SYSTEM,BLOCK
- IF (IER.EQ.0) THEN
- READ(10,'(A)') BUFFER
- WRITE(1,'(A)') BUFFER(1:80)//CHAR(1)
- DO I=2,LENGTH
- READ(10,'(A)') BUFFER
- WRITE(1,'(A)') BUFFER
- END DO
- CALL WRITEDIR(ICOUNT-1,IER1)
- ICOUNT = ICOUNT + 1
- END IF
- END DO
-
- CLOSE (UNIT=9)
- CLOSE (UNIT=2)
- CLOSE (UNIT=10)
- CLOSE (UNIT=1)
-
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
- RETURN
-
-1000 FORMAT(A11,A11,A8,A4,A4,A4,A11,A8)
-1010 FORMAT(A53,A12,A11,A8,A4,A11,A4,A4)
-
- END
-
- SUBROUTINE CONVERT_BULLFILE
-C
-C SUBROUTINE CONVERT_BULLFILE
-C
-C FUNCTION: Converts bulletin data file to new format file.
-C
-C NOTE: CONVERT_BULLFILES converts from 80 to 81 byte length.
-C This converts from 81 byte length to 128 compressed format.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- CHARACTER*80 BUFFER,NEW_FILE
-
- WRITE (6,'('' Converting data files to new format. Please wait.'')')
-
- CALL CLOSE_BULLDIR
-
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
-
- CALL OPEN_BULLFOLDER
-
-100 READ (7,FMT=FOLDER_FMT,ERR=200)
- & FOLDER,FOLDER_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
- & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
-
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
- & //FOLDER(:TRIM(FOLDER))
- NEW_FILE = FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFILOLD'
- OPEN (UNIT=10,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL'
- & ,STATUS='OLD',
- & RECORDTYPE='FIXED',RECORDSIZE=81,ACCESS='DIRECT',
- & FORM='FORMATTED',IOSTAT=IER,SHARED,READONLY)
-
- IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why?
-
- OPEN (UNIT=1,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLFIL',STATUS='NEW',IOSTAT=IER,
- & ACCESS='DIRECT',RECORDTYPE='FIXED',RECORDSIZE=32,
- & FORM='UNFORMATTED')
- IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))
- & //'.BULLFIL;-1',NEW_FILE)
-
- CALL OPEN_BULLDIR
-
- CALL READDIR(0,IER)
-
- IF (IER.EQ.1) THEN
- NBLOCK = 0
- DO I=1,NBULL
- CALL READDIR(I,IER)
- NBLOCK = NBLOCK + 1
- SBLOCK = NBLOCK
- DO J=BLOCK,LENGTH+BLOCK-1
- READ(10'J,'(A)') BUFFER
- ILEN = TRIM(BUFFER)
- IF (ILEN.EQ.0) ILEN = 1
- CALL STORE_BULL(ILEN,BUFFER,NBLOCK)
- END DO
- CALL FLUSH_BULL(NBLOCK)
- LENGTH = NBLOCK - SBLOCK + 1
- BLOCK = SBLOCK
- CALL WRITEDIR(I,IER)
- END DO
-
- NEMPTY = 0
- CALL WRITEDIR(0,IER)
- END IF
-
- CLOSE (UNIT=10)
- CLOSE (UNIT=1)
-
- CALL CLOSE_BULLDIR
- GOTO 100
-
-200 CALL OPEN_BULLDIR_SHARED
-
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
-
- RETURN
-
- END
-
-
-
- SUBROUTINE CONVERT_BULLFOLDER(FILENAME,ASK_SIZE)
-C
-C SUBROUTINE CONVERT_BULLFOLDER
-C
-C FUNCTION: Converts bulletin folder file to new format.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE '($SSDEF)'
-
- INCLUDE '($FORIOSDEF)'
-
- CHARACTER*(*) FILENAME
-
- CHARACTER*80 NEW_FILE
-
- WRITE (6,'('' Converting data files to new format. Please wait.'')')
-
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
-
- EODIR = MAX(INDEX(FILENAME,':'),INDEX(FILENAME,']'))
- SUFFIX = INDEX(FILENAME(EODIR:),'.') + EODIR - 1
- NEW_FILE = FILENAME(:SUFFIX)//'OLD'
-
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=7,FILE=FILENAME,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:25:CHARACTER,26:29:INTEGER))
- END DO
-
- IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why?
-
- OPEN (UNIT=19,FILE=NEW_FILE,STATUS='NEW',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & RECORDSIZE=FOLDER_RECORD,
- & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:25:CHARACTER,26:29:INTEGER),DISPOSE='DELETE')
-
- IF (IER.NE.0) CALL ERROR_AND_EXIT ! Error. Why?
-
- IF (ASK_SIZE.EQ.173/4) THEN
- F_NUMBER = 0
- DO WHILE (IER.EQ.0)
- READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8,5A4)',
- & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)
- & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
- & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
- & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET
- IF (IER.EQ.0) THEN
- WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)
- & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
- & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
- & ,F_NBULL,F_NEWEST_BTIM,FOLDER_FLAG,FOLDER_SET
- & ,F_NEWEST_BTIM
- F_NUMBER = F_NUMBER + 1
- END IF
- END DO
- ELSE
- F_NUMBER = 0
- DO WHILE (IER.EQ.0)
- READ (7,FMT='(A25,A4,A12,A80,A12,3A4,A8)',
- & KEYGE=F_NUMBER,KEYID=1,IOSTAT=IER)
- & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
- & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
- IF (IER.EQ.0) THEN
- FOLDER_FLAG = 0
- IF (F_NUMBER.EQ.0) FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
- & //FOLDER(:TRIM(FOLDER))
- CALL CHKACL
- & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER)
- IF (IER.NE.(SS$_ACLEMPTY.OR.SS$_NORMAL).AND.IER) THEN
- FOLDER_FLAG = IBSET(FOLDER_FLAG,0)
- END IF
- DO WHILE (FILE_LOCK(IER,IER1))
- OPEN (UNIT=2,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.BULLDIR',STATUS='OLD',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- IF (IER.EQ.FOR$IOS_INCFILORG) THEN
- IDUMMY = FILE_LOCK(IER,IER1)
- CALL CONVERT_BULLDIRS
- END IF
- END DO
- IF (IER.EQ.FOR$IOS_FILNOTFOU) THEN
- F_NEWEST_BTIM(1) = 0
- F_NEWEST_BTIM(2) = 0
- ELSE
- CALL READDIR(0,IER)
- IF (NEWEST_DATE.EQ.'5-NOV-1956 ') THEN
- IF (NBULL.GT.0) THEN
- CALL READDIR(NBULL,IER)
- NEWEST_DATE = DATE
- NEWEST_TIME = TIME
- CALL WRITEDIR(0,IER)
- END IF
- END IF
- CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,F_NEWEST_BTIM)
- CLOSE (UNIT=2)
- END IF
- WRITE (19,FMT=FOLDER_FMT,IOSTAT=IER)
- & FOLDER,F_NUMBER,FOLDER_OWNER,FOLDER_DESCRIP
- & ,FOLDER_BBOARD,FOLDER_BBEXPIRE,USERB,GROUPB,ACCOUNTB
- & ,NBULL,F_NEWEST_BTIM,FOLDER_FLAG,0,F_NEWEST_BTIM
- F_NUMBER = F_NUMBER + 1
- END IF
- END DO
- END IF
-
- CLOSE (UNIT=7)
- CLOSE (UNIT=19,STATUS='SAVE')
-
- IER = LIB$RENAME_FILE(NEW_FILE,FILENAME)
- IER = LIB$RENAME_FILE(BULLFOLDER_FILE//';-1',NEW_FILE)
-
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
-
- IER = LIB$DELETE_FILE(BBOARD_DIRECTORY(:TRIM(BBOARD_DIRECTORY))
- & //'BOARD.COM;*') ! BULLETIN$ is referenced in old file
-
- RETURN
- END
-
- SUBROUTINE CONVERT_USERFILE
-C
-C SUBROUTINE CONVERT_USERFILE
-C
-C FUNCTION: Converts user file to new format which has 8 bytes added.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- CHARACTER BUFFER*74,NEW_FILE*80
-
- CHARACTER*11 LOGIN_DATE,READ_DATE
- CHARACTER*8 LOGIN_TIME,READ_TIME
-
- WRITE (6,'('' Converting data files to new format. Please wait.'')')
-
- EODIR = MAX(INDEX(BULLUSER_FILE,':'),INDEX(BULLUSER_FILE,']'))
- SUFFIX = INDEX(BULLUSER_FILE(EODIR:),'.') + EODIR - 1
- NEW_FILE = BULLUSER_FILE(:SUFFIX)//'OLD'
- IER = LIB$RENAME_FILE(BULLUSER_FILE,NEW_FILE)
-
- OPEN (UNIT=9,FILE=NEW_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:12:CHARACTER))
- INQUIRE (UNIT=9,RECORDSIZE=RECL)
-
- IF ((RECL-28)/16.GT.FLONG) THEN
- WRITE (6,'('' ERROR: Old data files have more folders'',
- & '' than was specified with BULLUSER.INC.'')')
- WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')
- IER = LIB$RENAME_FILE(NEW_FILE,BULLUSER_FILE)
- IF (USERNAME.EQ.'DECNET') THEN
- CALL SYS$DELPRC(,)
- ELSE
- CALL SYS$CANEXH()
- CALL EXIT
- END IF
- END IF
-
- IF (IER.EQ.0) THEN
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,WORLD,GROUP)
- OPEN (UNIT=4,FILE=BULLUSER_FILE,STATUS='NEW',
- & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=28+FLONG*16,
- & FORM='FORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
- & KEY=(1:12:CHARACTER))
- END IF
-
- IF (IER.NE.0) THEN
- WRITE (6,'('' Cannot convert user file.'')')
- IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)
- CALL SYS_GETMSG(IER1)
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
- CALL ENABLE_CTRL_EXIT
- END IF
-
- DO I=1,FLONG
- NEW_FLAG(I) = 'FFFFFFFF'X
- NOTIFY_FLAG(I) = 0
- BRIEF_FLAG(I) = 0
- SET_FLAG(I) = 0
- END DO
-
- IF (RECL.EQ.42.OR.RECL.EQ.50.OR.RECL.EQ.58.OR.RECL.EQ.66.OR.
- & RECL.EQ.74) THEN ! Old format
- IF (RECL.LE.58) RECL = 50
- IER = 0
- DO WHILE (IER.EQ.0)
- READ (9,'(A<RECL>)',IOSTAT=IER) BUFFER
- IF (IER.EQ.0) THEN
- TEMP_USER = BUFFER(1:12)
- LOGIN_DATE = BUFFER(13:23)
- LOGIN_TIME = BUFFER(24:31)
- READ_DATE = BUFFER(32:42)
- READ_TIME = BUFFER(43:50)
- IF (RECL.EQ.58)
- & CALL LIB$MOVC3(8,%REF(BUFFER(51:)),SET_FLAG(1))
- IF (RECL.EQ.66)
- & CALL LIB$MOVC3(8,%REF(BUFFER(59:)),NEW_FLAG(1))
- IF (RECL.EQ.74)
- & CALL LIB$MOVC3(8,%REF(BUFFER(67:)),NOTIFY_FLAG(1))
- CALL SYS_BINTIM(LOGIN_DATE//' '//LOGIN_TIME,LOGIN_BTIM)
- CALL SYS_BINTIM(READ_DATE//' '//READ_TIME,READ_BTIM)
- WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
- & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
- END IF
- END DO
- IF (RECL.LT.66) THEN
- READ (4,KEY=USER_HEADER_KEY,FMT=USER_FMT) TEMP_USER,
- & LOGIN_BTIM,
- & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
- NEW_FLAG(1) = PRV$M_OPER.OR.PRV$M_CMKRNL.OR.PRV$M_SETPRV
- WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
- & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
- END IF
- ELSE ! Folder maxmimum increase
- OFLONG = (RECL - 28) / 16 ! Old #longwords/flag
- DO WHILE (IER.EQ.0)
- READ (9,FMT='(A12,<4+OFLONG*4>A4)',IOSTAT=IER)
- & TEMP_USER,LOGIN_BTIM,READ_BTIM,
- & (NEW_FLAG(I),I=1,OFLONG),(SET_FLAG(I),I=1,OFLONG),
- & (BRIEF_FLAG(I),I=1,OFLONG),(NOTIFY_FLAG(I),I=1,OFLONG)
- IF (IER.EQ.0) THEN
- WRITE (4,FMT=USER_FMT) TEMP_USER,LOGIN_BTIM,
- & READ_BTIM,NEW_FLAG,SET_FLAG,BRIEF_FLAG,NOTIFY_FLAG
- END IF
- END DO
- END IF
-
- IER = 0
-
- CLOSE (UNIT=9)
- CLOSE (UNIT=4)
-
- CALL SYS$SETDFPROT(CUR_DEF_PROT,) ! Reset default protection
-
- RETURN
- END
-
-
- SUBROUTINE READDIR(BULLETIN_NUM,ICOUNT)
-C
-C SUBROUTINE READDIR
-C
-C FUNCTION: Finds the entry for the specified bulletin in the
-C directory file and returns the information for that entry.
-C
-C INPUTS:
-C BULLETIN_NUM - Bulletin number. Starts with 1.
-C If 0, gives header info, i.e number of bulls,
-C number of blocks in bulletin file, etc.
-C OUTPUTS:
-C ICOUNT - The last record read by this routine.
-C
-
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /PROMPT/ COMMAND_PROMPT
- CHARACTER*39 COMMAND_PROMPT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /DIR_POSITION/ DIR_NUM
-
- CHARACTER*3 CFOLDER_NUMBER
-
- ICOUNT = BULLETIN_NUM
-
- IF (ICOUNT.EQ.0) THEN
- IF (.NOT.REMOTE_SET) THEN
- DO WHILE (REC_LOCK(IER))
- READ (2,KEYID=0,KEY=0,IOSTAT=IER) BULLDIR_HEADER
- END DO
- IF (IER.EQ.0) THEN
- CALL CONVERT_HEADER_FROMBIN
- DIR_NUM = 0
- END IF
- ELSE
- CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)
- RETURN
- END IF
- IF (IER.EQ.0) THEN
- IF (NBULL.LT.0) THEN ! This indicates bulletin deletion
- ! was incomplete.
- CALL CLOSE_BULLDIR
- CALL OPEN_BULLDIR
- CALL CLEANUP_DIRFILE(1)
- CALL UPDATE_FOLDER
- END IF
- IF (NEMPTY.EQ.' ') NEMPTY = 0
-C
-C Check to see if cleanup of empty file space is necessary, which is
-C defined here as being 50 blocks (200 128byte records). Also check
-C to see if cleanup was in progress but didn't properly finish.
-C
- IF (NEMPTY.GT.200.AND.TEST_BULLCP().EQ.0) THEN
- WRITE (CFOLDER_NUMBER,'(I3)') FOLDER_NUMBER
- IER1 = LIB$SPAWN('$'//COMMAND_PROMPT(1:INDEX(
- & COMMAND_PROMPT,'>')-1)//'/CLEANUP='//CFOLDER_NUMBER,
- & 'NL:','NL:',1,'BULL_CLEANUP')
- ELSE IF (NEMPTY.EQ.-1) THEN
- CALL CLEANUP_BULLFILE
- END IF
- END IF
- ELSE
- IF (.NOT.REMOTE_SET) THEN
- DO WHILE (REC_LOCK(IER))
- IF (DIR_NUM.EQ.ICOUNT-1) THEN
- READ(2,IOSTAT=IER) BULLDIR_ENTRY
- IF (MSG_NUM.NE.ICOUNT) IER = 36
- ELSE
- READ(2,KEYID=0,KEY=ICOUNT,IOSTAT=IER) BULLDIR_ENTRY
- END IF
- END DO
- IF (IER.EQ.0) THEN
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- CALL CONVERT_ENTRY_FROMBIN
- DIR_NUM = MSG_NUM
- ELSE
- DIR_NUM = -1
- END IF
- ELSE
- CALL REMOTE_GET_HEADER(BULLETIN_NUM,ICOUNT,IER)
- RETURN
- END IF
- END IF
-
- IF (IER.EQ.0) ICOUNT = ICOUNT + 1
-
- UNLOCK 2
-
- RETURN
-
- END
-
-
-
-
-
- SUBROUTINE READDIR_KEYGE(IER)
-C
-C SUBROUTINE READDIR_KEYGE
-C
-C FUNCTION: Finds the entry for the specified bulletin in the
-C directory file corresponding to or later than the date specified.
-C
-C INPUTS:
-C MSG_KEY - Message key (passed via BULLDIR.INC common block).
-C OUTPUTS:
-C IER - If not 0, no entry found. Else contains message number.
-C
-
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /DIR_POSITION/ DIR_NUM
-
- IF (.NOT.REMOTE_SET) THEN
- DO WHILE (REC_LOCK(IER))
- READ(2,KEYID=1,KEYGT=MSG_KEY,IOSTAT=IER) BULLDIR_ENTRY
- END DO
- IF (IER.EQ.0) THEN
- IER = MSG_NUM
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- CALL CONVERT_ENTRY_FROMBIN
- DIR_NUM = MSG_NUM
- ELSE
- IER = 0
- DIR_NUM = -1
- END IF
- UNLOCK 2
- ELSE
- CALL REMOTE_GET_HEADER(DUMMY,-1,IER)
- END IF
-
- RETURN
-
- END
-
-
-
- SUBROUTINE CONVERT_HEADER_FROMBIN
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*23 DATETIME
-
- CALL SYS$ASCTIM(,DATETIME,NEWEST_EXBTIM,)
-
- NEWEST_EXDATE = DATETIME
- NEWEST_EXTIME = DATETIME(13:)
-
- CALL SYS$ASCTIM(,DATETIME,NEWEST_MSGBTIM,)
-
- NEWEST_DATE = DATETIME
- NEWEST_TIME = DATETIME(13:)
-
- CALL SYS$ASCTIM(,DATETIME,SHUTDOWN_BTIM,)
-
- SHUTDOWN_DATE = DATETIME
- SHUTDOWN_TIME = DATETIME(13:)
-
- RETURN
- END
-
-
-
- SUBROUTINE CONVERT_ENTRY_FROMBIN
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*23 DATETIME
-
- CALL SYS$ASCTIM(,DATETIME,EX_BTIM,)
-
- EXDATE = DATETIME
- EXTIME = DATETIME(13:)
-
- CALL SYS$ASCTIM(,DATETIME,MSG_BTIM,)
-
- DATE = DATETIME
- TIME = DATETIME(13:)
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE WRITEDIR(BULLETIN_NUM,IER)
-C
-C SUBROUTINE WRITEDIR
-C
-C FUNCTION: Writes the entry for the specified bulletin in the
-C directory file.
-C
-C INPUTS:
-C BULLETIN_NUM - Bulletin number. Starts with 1.
-C If 0, write the header of the directory file.
-C OUTPUTS:
-C IER - Error status from WRITE.
-C
-
- IMPLICIT INTEGER (A - Z)
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /DIR_POSITION/ DIR_NUM
-
- INCLUDE 'BULLDIR.INC'
-
- CONV = .TRUE.
-
- GO TO 10
-
- ENTRY WRITEDIR_NOCONV(BULLETIN_NUM,IER)
-
- CONV = .FALSE.
-
-10 IF (BULLETIN_NUM.EQ.0) THEN
- IF (CONV) CALL CONVERT_HEADER_TOBIN
- IF (REMOTE_SET) THEN
- WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,0,BULLDIR_HEADER
- ELSE
- IER = -1
- IF (DIR_NUM.EQ.0) THEN
- REWRITE (2,IOSTAT=IER) BULLDIR_HEADER
- END IF
- IF (IER.NE.0) THEN
- READ (2,KEYID=0,KEY=0,IOSTAT=IER)
- IF (IER.EQ.0) THEN
- REWRITE (2,IOSTAT=IER) BULLDIR_HEADER
- END IF
- END IF
- IF (IER.NE.0) THEN
- WRITE (2,IOSTAT=IER) BULLDIR_HEADER
- END IF
- END IF
- ELSE
- IF (CONV) CALL CONVERT_ENTRY_TOBIN
- MSG_NUM = BULLETIN_NUM
- IF (REMOTE_SET) THEN
- WRITE(REMOTE_UNIT,'(3A)',IOSTAT=IER)9,BULLETIN_NUM,BULLDIR_ENTRY
- ELSE
- IER = -1
- IF (DIR_NUM.EQ.MSG_NUM) THEN
- REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY
- END IF
- IF (IER.NE.0) THEN
- READ (2,KEYID=0,KEY=BULLETIN_NUM,IOSTAT=IER)
- IF (IER.EQ.0) THEN
- REWRITE (2,IOSTAT=IER) BULLDIR_ENTRY
- ELSE
- WRITE (2,IOSTAT=IER) BULLDIR_ENTRY
- END IF
- END IF
- END IF
- END IF
-
- IF (REMOTE_SET.AND.IER.GT.0) CALL ERROR_AND_EXIT
-
- DIR_NUM = -1
-
- RETURN
-
- END
-
-
-
- SUBROUTINE CONVERT_HEADER_TOBIN
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- CALL SYS_BINTIM(NEWEST_EXDATE//' '//NEWEST_EXTIME,NEWEST_EXBTIM)
-
- CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_MSGBTIM)
-
- CALL SYS_BINTIM(SHUTDOWN_DATE//' '//SHUTDOWN_TIME,SHUTDOWN_BTIM)
-
- RETURN
- END
-
-
-
- SUBROUTINE CONVERT_ENTRY_TOBIN
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- CALL SYS_BINTIM(EXDATE//' '//EXTIME,EX_BTIM)
-
- CALL SYS_BINTIM(DATE//' '//TIME,MSG_BTIM)
-
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE READACL(FILENAME,ACLENT,ACLLENGTH)
-C
-C SUBROUTINE READACL
-C
-C FUNCTION: Reads the ACL of a file.
-C
-C PARAMETERS:
-C FILENAME - Name of file to check.
-C ACLENT - String which will be large enough to hold ACL information.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE '($ACLDEF)'
-
- CHARACTER ACLENT*(*),OUTPUT*80,ACLSTR*255,FILENAME*(*)
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
-
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST),,,)
-
- BIG = .NOT.IER
- IF (BIG) THEN
- IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,)
- ACLLENGTH = ACL$S_ADDACLENT
- CTXT = 0
- END IF
-
- DO ACC_TYPE=1,2
- POINT = 1
- OUTLEN = 0
- DO WHILE ((POINT.LT.ACLLENGTH).AND.IER)
- IF (.NOT.BIG) THEN
- IER = SYS$FORMAT_ACL(ACLENT(POINT:POINT-1+
- & ICHAR(ACLENT(POINT:POINT))),ACLLEN,ACLSTR,,,,)
- ELSE
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,FILENAME,%VAL(ACL_ITMLST)
- & ,,,CTXT,,)
- IER = SYS$FORMAT_ACL(ACLENT(:ICHAR(ACLENT(1:1))),
- & ACLLEN,ACLSTR,,,,)
- CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS)
- IF (ACCESS.EQ.0) IER = .FALSE.
- END IF
- AC = INDEX(ACLSTR,',ACCESS')
- IF ((ACC_TYPE.EQ.1.AND.INDEX(ACLSTR(AC:),'WRITE').GT.0).OR.
- & (ACC_TYPE.EQ.2.AND.INDEX(ACLSTR(AC:),'READ').GT.0.AND.
- & INDEX(ACLSTR(AC:),'WRITE').EQ.0)) THEN
- START_ID = INDEX(ACLSTR,'=') + 1
- END_ID = INDEX(ACLSTR,',ACCESS') - 1
- IF (ACLSTR(END_ID:END_ID).EQ.']') THEN
- START_ID = END_ID - 1
- ASCII = .FALSE.
- DO WHILE (ACLSTR(START_ID:START_ID).NE.'['.AND.
- & ACLSTR(START_ID:START_ID).NE.'='.AND.
- & (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII))
- IF (ACLSTR(START_ID:START_ID).NE.','.AND.
- & (ACLSTR(START_ID:START_ID).LT.'0'.OR.
- & ACLSTR(START_ID:START_ID).GT.'9')) ASCII = .TRUE.
- IF (ACLSTR(START_ID:START_ID).NE.','.OR..NOT.ASCII) THEN
- START_ID = START_ID - 1
- END IF
- END DO
- IF (ASCII) THEN
- START_ID = START_ID + 1
- END_ID = END_ID - 1
- IF (ACLSTR(START_ID:START_ID).EQ.'*') THEN
- START_ID = INDEX(ACLSTR,'=') + 1
- END_ID = INDEX(ACLSTR,'ACCESS') - 2
- END IF
- END IF
- END IF
- IF (OUTLEN.EQ.0) THEN
- IF (FILENAME.NE.BULLUSER_FILE) THEN
- IF (ACC_TYPE.EQ.1) THEN
- WRITE (6,'(
- & '' These users can read and write to this folder:'')')
- ELSE
- WRITE (6,'(
- & '' These users can only read this folder:'')')
- END IF
- ELSE
- WRITE (6,'('' The following are rights identifiers'',
- & '' which will give privileges.'')')
- END IF
- OUTLEN = 1
- END IF
- IDLEN = END_ID - START_ID + 1
- IF (OUTLEN+IDLEN-1.GT.80) THEN
- WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-1)
- OUTPUT = ACLSTR(START_ID:END_ID)//','
- OUTLEN = IDLEN + 2
- ELSE IF (OUTLEN+IDLEN-1.EQ.80) THEN
- WRITE (6,'(1X,A)')
- & OUTPUT(:OUTLEN-1)//ACLSTR(START_ID:END_ID)
- OUTLEN = 1
- ELSE
- OUTPUT(OUTLEN:) = ACLSTR(START_ID:END_ID)//','
- OUTLEN = OUTLEN + IDLEN + 1
- END IF
- END IF
- POINT = POINT + ICHAR(ACLENT(POINT:POINT))
- END DO
- IF (OUTLEN.GT.1) WRITE (6,'(1X,A)') OUTPUT(:OUTLEN-2)
- END DO
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CONVERT_INFFILE
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- OPEN (UNIT=10,FILE=BULLINF_FILE,STATUS='OLD',
- & ACCESS='KEYED',RECORDTYPE='FIXED',
- & IOSTAT=IER,ORGANIZATION='INDEXED',
- & KEY=(1:12:CHARACTER))
-
- INQUIRE (UNIT=10,RECORDSIZE=RECL)
-
- IF ((RECL-28)/16.GT.FLONG) THEN
- WRITE (6,'('' ERROR: Old data files have more folders'',
- & '' than was specified with BULLUSER.INC.'')')
- WRITE (6,'('' Recompile with correct FOLDER_MAX.'')')
- IF (USERNAME.EQ.'DECNET') THEN
- CALL SYS$DELPRC(,)
- ELSE
- CALL SYS$CANEXH()
- CALL EXIT
- END IF
- END IF
-
- RECL = RECL/8
-
- OPEN (UNIT=9,FILE=BULLINF_FILE,STATUS='NEW',
- & ACCESS='KEYED',RECORDTYPE='FIXED',RECORDSIZE=FOLDER_MAX*2+3,
- & IOSTAT=IER,ORGANIZATION='INDEXED',
- & KEY=(1:12:CHARACTER))
-
- DO WHILE (IER.EQ.0)
- READ (10,IOSTAT=IER) TEMP_USER,((LAST_READ_BTIM(J,I),J=1,2),I=1,RECL)
- IF (IER.EQ.0) WRITE (9) TEMP_USER,
- & ((LAST_READ_BTIM(J,I),J=1,2),I=1,FOLDER_MAX)
- END DO
-
- CLOSE (UNIT=10,STATUS='DELETE')
-
- CLOSE (UNIT=9)
-
- RETURN
- END
-
-
- SUBROUTINE ERROR_AND_EXIT
-
- IMPLICIT INTEGER (A-Z)
-
- CALL ERRSNS(IDUMMY,IER)
- CALL SYS_GETMSG(IER)
- CALL ENABLE_CTRL_EXIT
-
- RETURN
- END
-
-
-
-
- SUBROUTINE COPY_ACL(INFILE,OUTFILE)
-C
-C SUBROUTINE COPY_ACL
-C
-C FUNCTION:
-C Copy ACLs from one file to another file
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($ACLDEF)'
-
- CHARACTER*(*) INFILE,OUTFILE
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,ACL$C_ACLLENGTH,%LOC(ACLLENGTH))
- ! Get length needed to store acl output
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
-
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)
-
- CALL LIB$GET_VM(ACLLENGTH+8,ACLSTR) ! Create character string to
- CALL MAKE_CHAR(%VAL(ACLSTR),ACLLENGTH,ACLLENGTH) ! store acl
-
- CALL COPY_ACL1(INFILE,OUTFILE,%VAL(ACLSTR),ACLLENGTH)
- ! Pass location of string
- CALL LIB$FREE_VM(ACLLENGTH+8,ACLSTR)
-
- RETURN
- END
-
-
- SUBROUTINE COPY_ACL1(INFILE,OUTFILE,ACLENT,ACLLENGTH)
-C
-C SUBROUTINE COPY_ACL1
-C
-C FUNCTION: Called by COPY_ACL to actually do the copy. Need 2 routines
-C since must convert location of string into a character string.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($ACLDEF)'
-
- CHARACTER ACLENT*(*),INFILE*(*),OUTFILE*(*)
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_READACL,%LOC(ACLENT))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST),,,,,)
- ! Read input file acl
-
- IF (.NOT.IER) THEN
- IER = SYS$PARSE_ACL('(ID=*,ACCESS=NONE)',ACLENT,,)
- IF (.NOT.IER) RETURN
- ACLLENGTH = ACL$S_ADDACLENT
- CTXT = 0
- DO WHILE (IER)
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ICHAR(ACLENT(1:1)),ACL$C_ADDACLENT,
- & %LOC(ACLENT))
- CALL END_ITMLST(ACL1_ITMLST) ! Get address of itemlist
- IER = SYS$CHANGE_ACL
- & (,ACL$C_FILE,OUTFILE,%VAL(ACL1_ITMLST),,,)
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(ACLLENGTH,ACL$C_FNDACETYP,%LOC(ACLENT))
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,INFILE,%VAL(ACL_ITMLST)
- & ,,,CTXT,,)
- CALL LIB$MOVC3(4,%REF(ACLENT(5:)),ACCESS)
- IF (ACCESS.EQ.0) RETURN ! ID=*, ACCESS=NONE, which has
- ! (and must) be applied first
- END DO
- RETURN
- END IF
-
- CALL INIT_ITMLST ! Initialize item list
-
- POINT = 1
- DO WHILE (POINT.LT.ACLLENGTH) ! Transfer all acls to output file
- CALL ADD_2_ITMLST(ICHAR(ACLENT(POINT:POINT)),ACL$C_ADDACLENT,
- & %LOC(ACLENT(POINT:)))
- POINT = POINT + ICHAR(ACLENT(POINT:POINT))
- END DO
-
- CALL END_ITMLST(ACL_ITMLST) ! Get address of itemlist
- IER = SYS$CHANGE_ACL(,ACL$C_FILE,OUTFILE,%VAL(ACL_ITMLST),,,)
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin7.for b/decus/vax91b/bulletin-net91b/bulletin7.for
deleted file mode 100644
index 4b3f0e192757f18d8fedf0f60be30d86d914b247..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin7.for
+++ /dev/null
@@ -1,2044 +0,0 @@
-C
-C BULLETIN7.FOR, Version 5/27/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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 UPDATE_LOGIN(ADD_BULL)
-C
-C SUBROUTINE UPDATE_LOGIN
-C
-C FUNCTION: Updates the login file when a bulletin has been deleted
-C or added.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE '($SSDEF)'
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- DIMENSION READ_BTIM_SAVE(2),TEMP_BTIM(2)
-
-C
-C We want to keep the last read date for comparison when selecting new
-C folders, so save it for later restoring.
-C
-
- READ_BTIM_SAVE(1) = READ_BTIM(1)
- READ_BTIM_SAVE(2) = READ_BTIM(2)
-
- CALL OPEN_BULLUSER_SHARED
-
-C
-C Newest date/time in user file only applies to general bulletins.
-C This was present before adding folder capability.
-C We set flags in user entry to show new folder added for folder bulletins.
-C However, the newest bulletin for each folder is not continually updated,
-C As it is only used when comparing to the last bulletin read time, and to
-C store this for each folder would be too expensive.
-C
-
- TEMP_BTIM(1) = NEWEST_BTIM(1)
- TEMP_BTIM(2) = NEWEST_BTIM(2)
- CALL READ_USER_FILE_HEADER(IER)
- NEWEST_BTIM(1) = TEMP_BTIM(1)
- NEWEST_BTIM(2) = TEMP_BTIM(2)
-
- IF (IER.NE.0) THEN
- CALL CLOSE_BULLUSER
- RETURN
- ELSE IF (FOLDER_NUMBER.EQ.0) THEN
- CALL SYS_BINTIM(NEWEST_DATE//' '//NEWEST_TIME,NEWEST_BTIM)
- REWRITE (4,IOSTAT=IER) USER_HEADER
- END IF
-
- BROAD_MSG = .FALSE.
- IF (ADD_BULL.AND.FOLDER_NUMBER.GE.0) THEN ! Message added?
- IF (INCMD(1:3).NE.'ADD') THEN
- BROAD_MSG = .TRUE.
- ELSE IF (.NOT.CLI$PRESENT('BROADCAST')) THEN
- BROAD_MSG = .TRUE.
- END IF
- END IF
-
- IF (BROAD_MSG) THEN
- IF (FOLDER_BBOARD(:2).NE.'::'.AND.
- & FOLDER_NUMBER.GT.0) THEN ! Folder private?
- CALL CHKACL
- & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',IER)
- IF (IER.EQ.(SS$_ACLEMPTY.OR.SS$_NORMAL)) THEN
- CHECK_ACL = 0
- ELSE
- CHECK_ACL = 1
- END IF
- ELSE
- CHECK_ACL = 0
- END IF
-
- CALL NOTIFY_USERS(CHECK_ACL)
- END IF
-
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER)
- ! Reobtain present values as calling programs still uses them
-
- READ_BTIM(1) = READ_BTIM_SAVE(1)
- READ_BTIM(2) = READ_BTIM_SAVE(2)
-
- CALL CLOSE_BULLUSER
-
- RETURN
-
- END
-
-
-
-
- SUBROUTINE NOTIFY_USERS(CHECK_ACL)
-C
-C SUBROUTINE NOTIFY_USERS
-C
-C FUNCTION: Notify users with SET NOTIFY set of new message.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE '($BRKDEF)'
-
- CHARACTER OUTPUT*160,TERMINAL*7,FLAGS*1
- CHARACTER*1 CR/13/,LF/10/,BELL/7/
- CHARACTER*12 SENT_TEMP_USER,TEMP_USERNAME
-
- OUTPUT = BELL//CR//LF//LF//
- & 'New bulletin added to folder '//FOLDER(1:TRIM(FOLDER))
- & //'. From: '//FROM(1:TRIM(FROM))//CR//LF//
- & 'Description: '//DESCRIP(1:TRIM(DESCRIP))
-
- IER = SYS_TRNLNM('BULL_SYSTEM_FLAGS',FLAGS)
- IF (.NOT.IER) THEN
- IER = SYS_TRNLNM('MAIL$SYSTEM_FLAGS',FLAGS)
- END IF
-
- BFLAG = 0
- READ (FLAGS(:1),'(I1)',IOSTAT=IER) FLAG
- IF (BTEST(FLAG,1).AND.IER.EQ.0) BFLAG = BRK$M_CLUSTER
-
- CALL SYS$SETRWM(%VAL(1)) ! Don't wait if can't broadcast
-
- CALL INIT_QUEUE(TEMP_USER_QUEUE,TEMP_USERNAME)
- WRITE_TEMP_USER = TEMP_USER_QUEUE
-
- DO WHILE (GETUSERS(TEMP_USERNAME,TERMINAL))
- READ_TEMP_USER = TEMP_USER_QUEUE
- SENT_TEMP_USER = ' '
- DO WHILE (TEMP_USERNAME.NE.SENT_TEMP_USER.AND.
- & READ_TEMP_USER.NE.WRITE_TEMP_USER)
- CALL READ_QUEUE(%VAL(READ_TEMP_USER),READ_TEMP_USER,
- & SENT_TEMP_USER)
- END DO
- IF (TEMP_USERNAME.NE.SENT_TEMP_USER) THEN
- CALL READ_USER_FILE_KEYNAME(TEMP_USERNAME,IER)
- CALL WRITE_QUEUE(%VAL(WRITE_TEMP_USER),WRITE_TEMP_USER,
- & TEMP_USERNAME)
- ELSE
- IER = 2
- END IF
- IF (IER.EQ.0.AND.TEMP_USERNAME.NE.FROM.AND.
- & TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN
- IF (CHECK_ACL) THEN
- CALL CHECK_ACCESS
- & (FOLDER_FILE(1:TRIM(FOLDER_FILE))//'.BULLFIL',
- & TEMP_USERNAME,IER,WRITE_ACCESS)
- ELSE
- IER = 1
- END IF
- IF (IER) THEN
- CALL SYS$BRKTHRU(,OUTPUT(1:TRIM(OUTPUT))//CR,
- & TEMP_USERNAME(:TRIM(TEMP_USERNAME)),
- & %VAL(BRK$C_USERNAME),,,%VAL(BFLAG),,,,)
- ELSE
- CALL CLR2(NOTIFY_FLAG,FOLDER_NUMBER)
- REWRITE (4,IOSTAT=IER) TEMP_USERNAME//USER_ENTRY(13:)
- END IF
- END IF
- END DO
- CALL SYS$SETRWM(%VAL(0))
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE ADD_ENTRY
-C
-C SUBROUTINE ADD_ENTRY
-C
-C FUNCTION: Enters a new directory entry in the directory file.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER TODAY_TIME*32
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- IF (REMOTE_SET) THEN
- LOCAL = .TRUE.
- IF (INCMD(:3).EQ.'ADD') LOCAL = CLI$PRESENT('LOCAL')
- IF (LOCAL) THEN
- WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER)
- & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,0,0,0,0
- ELSE
- WRITE (REMOTE_UNIT,'(9A)',IOSTAT=IER)
- & 3,DESCRIP,EXDATE,EXTIME,SYSTEM,CLI$PRESENT('BROADCAST'),
- & CLI$PRESENT('BELL'),CLI$PRESENT('ALL'),
- & CLI$PRESENT('CLUSTER')
- END IF
- IF (IER.EQ.0) THEN
- READ(REMOTE_UNIT,'(Q,A)',IOSTAT=IER) I,FOLDER1_COM
- END IF
- IF (IER.EQ.0) THEN
- IF (I.EQ.LEN(FOLDER1_COM)) THEN
- IER = SYS$ASCTIM(,TODAY_TIME,F1_NEWEST_BTIM,)
- NEWEST_DATE = TODAY_TIME(1:11)
- NEWEST_TIME = TODAY_TIME(13:)
- NBULL = F1_NBULL
- CALL UPDATE_FOLDER
- ELSE
- WRITE (6,'(1X,A)') FOLDER1_COM(:I)
- END IF
- ELSE
- CALL DISCONNECT_REMOTE
- IF (INCMD(:4).EQ.'MOVE') CALL EXIT
- END IF
- CALL UPDATE_LOGIN(.TRUE.)
- RETURN
- END IF
-
- NEW_DATE = .TRUE.
-
- GO TO 10
-
- ENTRY NEWS2BULL_ADD_ENTRY
-
- NEW_DATE = .FALSE.
-
-10 CALL READDIR(0,IER)
-
- IF (IER.NE.1) THEN
- NEWEST_EXDATE = '5-NOV-2000'
- NEWEST_EXTIME = '00:00:00.00'
- NEWEST_DATE = '5-NOV-1956'
- NEWEST_TIME = '00:00:00.00'
- NBULL = 0
- NBLOCK = 0
- SHUTDOWN = 0
- NEMPTY = 0
- END IF
-
- IF (.NOT.NEW_DATE) THEN
- DIFF = COMPARE_DATE(NEWEST_DATE,DATE)
- IF (DIFF.EQ.0) THEN
- DIFF = COMPARE_TIME(NEWEST_TIME,TIME)
- END IF
- IF (DIFF.GE.0) NEW_DATE = .TRUE.
- END IF
-
- IF (NEW_DATE) THEN
- CALL SYS$ASCTIM(,TODAY_TIME,,)
- DATE = TODAY_TIME(1:11)
- TIME = TODAY_TIME(13:)
- END IF
-
- NEWEST_DATE = DATE
- NEWEST_TIME = TIME
-
- DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)
- IF (DIFF.GT.0) THEN
- NEWEST_EXDATE = EXDATE
- NEWEST_EXTIME = EXTIME
- ELSE IF (DIFF.EQ.0) THEN
- DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)
- IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME
- END IF
-
- NBULL = NBULL + 1
- BLOCK = NBLOCK + 1
- NBLOCK = NBLOCK + LENGTH
-
- IF ((SYSTEM.AND.4).EQ.4) THEN
- SHUTDOWN = SHUTDOWN + 1
- SHUTDOWN_DATE = DATE
- SHUTDOWN_TIME = TIME
- END IF
-
- CALL UPDATE_LOGIN(.TRUE.)
-
- CALL WRITEDIR(NBULL,IER)
-
- CALL WRITEDIR(0,IER)
-
- RETURN
- END
-
-
-
-
- INTEGER FUNCTION COMPARE_BTIM(BTIM1,BTIM2)
-C
-C FUNCTION COMPARE_BTIM
-C
-C FUCTION: Compares times in binary format to see which is farther in future.
-C
-C INPUTS:
-C BTIM1 - First time in binary format
-C BTIM2 - Second time in binary format
-C OUTPUT:
-C Returns +1 if first time is farther in future
-C Returns -1 if second time is farther in future
-C Returns 0 if equal time
-C
- IMPLICIT INTEGER (A - Z)
-
- DIMENSION BTIM1(2),BTIM2(2),DIFF(2)
-
- CALL LIB$SUBX(BTIM1,BTIM2,DIFF)
-
- IF (DIFF(2).LT.0) THEN
- COMPARE_BTIM = -1
- ELSE IF (DIFF(2).GE.0) THEN
- COMPARE_BTIM = +1
- END IF
-
- RETURN
- END
-
-
-
-
-
- INTEGER FUNCTION MINUTE_DIFF(DATE2,DATE1)
-C
-C FUNCTION MINUTE_DIFF
-C
-C FUNCTION: Finds difference in minutes between 2 binary times.
-C
-C
- IMPLICIT INTEGER (A-Z)
-
- DIMENSION DATE1(2),DATE2(2)
-
- CALL LIB$DAY(DAYS1,DATE1,MSECS1)
- CALL LIB$DAY(DAYS2,DATE2,MSECS2)
-
- MINUTE_DIFF = (DAYS2-DAYS1)*24*60 + (MSECS2-MSECS1)/6000
-
- RETURN
- END
-
-
-
-
-
-
- INTEGER FUNCTION COMPARE_DATE(DATE1,DATE2)
-C
-C FUNCTION COMPARE_DATE
-C
-C FUCTION: Compares dates to see which is farther in future.
-C
-C INPUTS:
-C DATE1 - First date (dd-mm-yy)
-C DATE2 - Second date (If is equal to ' ', then use present date)
-C OUTPUT:
-C Returns the difference in days between the two dates.
-C If the DATE1 is farther in the future, the output is positive,
-C else it is negative.
-C
- IMPLICIT INTEGER (A - Z)
-
- CHARACTER*(*) DATE1,DATE2
- INTEGER USER_TIME(2)
-
- CALL SYS_BINTIM(DATE1,USER_TIME)
-
- CALL VERIFY_DATE(USER_TIME)
-C
-C LIB$DAY crashes if date invalid, which happened once due to an unknown
-C hardware or software error which created a date very far in the future.
-C
- CALL LIB$DAY(DAY1,USER_TIME)
-
- IF (DATE2.NE.' ') THEN
- CALL SYS_BINTIM(DATE2,USER_TIME)
- CALL VERIFY_DATE(USER_TIME)
- ELSE
- CALL SYS$GETTIM(USER_TIME)
- END IF
-
- CALL LIB$DAY(DAY2,USER_TIME)
-
- COMPARE_DATE = DAY1 - DAY2
-
- RETURN
- END
-
-
-
- SUBROUTINE VERIFY_DATE(BTIM)
-
- IMPLICIT INTEGER (A-Z)
-
- DIMENSION BTIM(2),TEMP(2)
-
- CALL SYS_BINTIM(' 5-NOV-2011 00:00:00.00',TEMP)
-
- IER = COMPARE_BTIM(BTIM,TEMP)
-
- IF (IER.GT.0) THEN ! Date invalid
- BTIM(1) = TEMP(1)
- BTIM(2) = TEMP(2)
- END IF
-
- CALL SYS_BINTIM(' 5-NOV-1955 00:00:00.00',TEMP)
-
- IER = COMPARE_BTIM(BTIM,TEMP)
-
- IF (IER.LT.0) THEN ! Date invalid
- BTIM(1) = TEMP(1)
- BTIM(2) = TEMP(2)
- END IF
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION COMPARE_TIME(TIME1,TIME2)
-C
-C FUNCTION COMPARE_TIME
-C
-C FUCTION: Compares times to see which is farther in future.
-C
-C INPUTS:
-C TIME1 - First time (hh:mm:ss.xx)
-C TIME2 - Second time
-C OUTPUT:
-C Outputs (TIME1-TIME2) in seconds. Thus, if TIME1 is further
-C in the future, outputs positive number, else negative.
-C
-
- IMPLICIT INTEGER (A-Z)
- CHARACTER*(*) TIME1,TIME2
- CHARACTER*23 TODAY_TIME
- CHARACTER*11 TEMP2
-
- IF (TIME2.EQ.' ') THEN
- CALL SYS$ASCTIM(,TODAY_TIME,,)
- TEMP2 = TODAY_TIME(13:)
- ELSE
- TEMP2 = TIME2
- END IF
-
- COMPARE_TIME = 3600*10*(ICHAR(TIME1(1:1))-ICHAR(TEMP2(1:1)))
- & +3600*(ICHAR(TIME1(2:2))-ICHAR(TEMP2(2:2)))
- & +60*10*(ICHAR(TIME1(4:4))-ICHAR(TEMP2(4:4)))
- & +60*(ICHAR(TIME1(5:5))-ICHAR(TEMP2(5:5)))
- & +10*(ICHAR(TIME1(7:7))-ICHAR(TEMP2(7:7)))
- & +(ICHAR(TIME1(8:8))-ICHAR(TEMP2(8:8)))
-
- IF (COMPARE_TIME.EQ.0) THEN
- COMPARE_TIME = 10*(ICHAR(TIME1(10:10))-ICHAR(TEMP2(10:10)))
- & +(ICHAR(TIME1(11:11))-ICHAR(TEMP2(11:11)))
- IF (COMPARE_TIME.GT.0) THEN
- COMPARE_TIME = 1
- ELSE IF (COMPARE_TIME.LT.0) THEN
- COMPARE_TIME = -1
- END IF
- END IF
-
- RETURN
- END
-
-C-------------------------------------------------------------------------
-C
-C The following are subroutines to create a linked-list queue for
-C temporary buffer storage of data that is read from files to be
-C outputted to the terminal. This is done so as to be able to close
-C the file as soon as possible.
-C
-C Each record in the queue has the following format. The first two
-C words are used for creating a character variable. The first word
-C contains the length of the character variable, the second contains
-C the address. The address is simply the address of the 3rd word of
-C the record. The last word in the record contains the address of the
-C next record. Every time a record is written, if that record has a
-C zero link, it adds a new record for the next write operation.
-C Therefore, there will always be an extra record in the queue. To
-C check for the end of the queue, the last word (link to next record)
-C is checked to see if it is zero.
-C
-C-------------------------------------------------------------------------
- SUBROUTINE INIT_QUEUE(HEADER,DATA)
- CHARACTER*(*) DATA
- INTEGER HEADER
- IF (HEADER.NE.0) RETURN ! Queue already initialized
- LENGTH = LEN(DATA)
- IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4)
- CALL LIB$GET_VM(LENGTH+12,HEADER)
- CALL MAKE_CHAR(%VAL(HEADER),LEN(DATA),LENGTH)
- RETURN
- END
-
-
- SUBROUTINE WRITE_QUEUE(RECORD,NEXT,DATA)
- INTEGER RECORD(1)
- CHARACTER*(*) DATA
- LENGTH = RECORD(1)
- CALL COPY_CHAR(LENGTH,DATA,%VAL(%LOC(RECORD)))
- IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4)
- NEXT = RECORD((LENGTH+12)/4)
- IF (NEXT.NE.0) RETURN
- CALL LIB$GET_VM(LENGTH+12,NEXT)
- CALL MAKE_CHAR(%VAL(NEXT),RECORD(1),LENGTH)
- RECORD((LENGTH+12)/4) = NEXT
- RETURN
- END
-
- SUBROUTINE READ_QUEUE(RECORD,NEXT,DATA)
- CHARACTER*(*) DATA
- INTEGER RECORD(1)
- LENGTH = RECORD(1)
- CALL COPY_CHAR(LENGTH,%VAL(%LOC(RECORD)),DATA)
- IF (MOD(LENGTH,4).NE.0) LENGTH = LENGTH + 4 - MOD(LENGTH,4)
- NEXT = RECORD((LENGTH+12)/4)
- RETURN
- END
-
- SUBROUTINE COPY_CHAR(LENGTH,INCHAR,OUTCHAR)
- CHARACTER*(*) INCHAR,OUTCHAR
- OUTCHAR = INCHAR(:LENGTH)
- RETURN
- END
-
- SUBROUTINE MAKE_CHAR(IARRAY,CHAR_LEN,REAL_LEN)
- IMPLICIT INTEGER (A-Z)
- DIMENSION IARRAY(1)
- IARRAY(1) = CHAR_LEN
- IARRAY(2) = %LOC(IARRAY(3))
- IARRAY(REAL_LEN/4+3) = 0
- RETURN
- END
-
-
-
- SUBROUTINE DISABLE_PRIVS
-C
-C SUBROUTINE DISABLE_PRIVS
-C
-C FUNCTION: Disable image high privileges.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($PRVDEF)'
-
- COMMON /PRIVS/ SETPRV,PRV_DEPTH
- DIMENSION SETPRV(2)
-
- DATA PRV_DEPTH /0/
-
- COMMON /REALPROC/ REALPROCPRIV(2)
-
- PRV_DEPTH = PRV_DEPTH + 1
-
- IF (PRV_DEPTH.GT.1) RETURN
-
- CALL SYS$SETPRV(%VAL(0),,,SETPRV) ! Get privileges
-
- SETPRV(1) = SETPRV(1).AND..NOT.REALPROCPRIV(1)
-
- CALL SYS$SETPRV(%VAL(0),SETPRV,,) ! Disable installed privs
-
- RETURN
- END
-
-
-
- SUBROUTINE ENABLE_PRIVS
-C
-C SUBROUTINE ENABLE_PRIVS
-C
-C FUNCTION: Enable image high privileges.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /PRIVS/ SETPRV,PRV_DEPTH
- DIMENSION SETPRV(2)
-
- PRV_DEPTH = PRV_DEPTH - 1
-
- IF (PRV_DEPTH.GT.1) RETURN
-
- CALL SYS$SETPRV(%VAL(1),SETPRV,,) ! Enable image privs
-
- RETURN
- END
-
-
-
- SUBROUTINE CHECK_PRIV_IO(ERROR)
-C
-C SUBROUTINE CHECK_PRIV_IO
-C
-C FUNCTION: Checks SYS$OUTPUT and SYS$ERROR to see if they need
-C privileges to output to.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- CALL DISABLE_PRIVS ! Disable SYSPRV
-
- OPEN (UNIT=6,FILE='SYS$OUTPUT',IOSTAT=IER,STATUS='NEW')
- CLOSE (UNIT=6,STATUS='DELETE')
-
- OPEN (UNIT=4,FILE='SYS$ERROR',IOSTAT=IER1,STATUS='NEW')
- IF (IER.NE.0.OR.IER1.NE.0) THEN
- IF (IER1.EQ.0) WRITE (4,100)
- IF (IER.EQ.0) WRITE (6,200)
- ERROR = 1
- ELSE
- CLOSE (UNIT=4,STATUS='DELETE')
- ERROR = 0
- END IF
-
- CALL ENABLE_PRIVS ! Enable SYSPRV
-
-100 FORMAT(1X,'ERROR: SYS$OUTPUT cannot be opened.')
-200 FORMAT(1X,'ERROR: SYS$ERROR cannot be opened.')
-
- RETURN
- END
-
-
- SUBROUTINE CHANGE_FLAG(CMD,FLAG)
-C
-C SUBROUTINE CHANGE_FLAG
-C
-C FUNCTION: Sets flags for specified folder.
-C
-C INPUTS:
-C CMD - LOGICAL*4 value. If TRUE, set flag.
-C If FALSE, clear flag.
-C FLAG - If 1, modify NEW_FLAG, if 2, modify SET_FLAG
-C If 3, modify BRIEF_FLAG, 4, modify NOTIFY_FLAG
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /BULL_NOTIFY/ NOTIFY_REMOTE(FLONG)
-
- DIMENSION FLAGS(FLONG,4)
- EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))
-
- LOGICAL CMD
-
- DIMENSION READ_BTIM_SAVE(2)
-
- DATA CHANGE_FOLDER /.FALSE./
-
- IF (CLI$PRESENT('FOLDER')) THEN
- IER = CLI$GET_VALUE('FOLDER',FOLDER1)
- IF (IER) THEN
- FOLDER_NUMBER_SAVE = FOLDER_NUMBER
- CALL OPEN_BULLFOLDER_SHARED
- CALL READ_FOLDER_FILE_KEYNAME_TEMP(FOLDER1,IER)
- CALL CLOSE_BULLFOLDER
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: No such folder found.'')')
- RETURN
- ELSE IF (INDEX(FOLDER1,'.').GT.0.OR.
- & (FOLDER1(:1).GE.'a'.AND.FOLDER1(:1).LE.'z')) THEN
- WRITE (6,'('' ERROR: Command not valid for folder.'')')
- RETURN
- END IF
- END IF
- FOLDER_NUMBER = FOLDER1_NUMBER
- CHANGE_FOLDER = .TRUE.
- ELSE IF (REMOTE_SET.EQ.3) THEN
- WRITE (6,'('' ERROR: Command not valid for folder.'')')
- RETURN
- END IF
-
-C
-C Find user entry in BULLUSER.DAT to update information.
-C
-
- ENTRY CHANGE_FLAG_NOCMD(CMD,FLAG)
-
- CALL OPEN_BULLUSER_SHARED ! Open user file
-
- READ_BTIM_SAVE(1) = READ_BTIM(1)
- READ_BTIM_SAVE(2) = READ_BTIM(2)
-
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry
-
- IF (IER.GT.0) THEN ! No entry (how did this happen??)
- CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's today
- CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM) ! Fake new entry
- CALL READ_USER_FILE_HEADER(IER)
- IF (CMD) THEN
- CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)
- ELSE
- CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)
- END IF
- NEW_FLAG(1) = 143
- NEW_FLAG(2) = 0
- CALL WRITE_USER_FILE_NEW(IER)
- ELSE
- IF (CMD) THEN
- CALL SET2(FLAGS(1,FLAG),FOLDER_NUMBER)
- ELSE
- CALL CLR2(FLAGS(1,FLAG),FOLDER_NUMBER)
- END IF
- NEW_FLAG(1) = 143
- REWRITE (4,IOSTAT=IER) USER_ENTRY
- READ_BTIM(1) = READ_BTIM_SAVE(1)
- READ_BTIM(2) = READ_BTIM_SAVE(2)
- END IF
-
- IF (CMD.AND.FLAG.EQ.4.AND.FOLDER_BBOARD(:2).EQ.'::') THEN
- DO WHILE (REC_LOCK(IER))
- READ (4,KEY='*NOTIFY',IOSTAT=IER) TEMP_USER,NOTIFY_REMOTE
- END DO
-
- IF (IER.NE.0) THEN
- DO I=1,FLONG
- NOTIFY_REMOTE(I) = 0
- END DO
- CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER)
- WRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE
- ELSE
- CALL SET2(NOTIFY_REMOTE,FOLDER_NUMBER)
- REWRITE (4,IOSTAT=IER) '*NOTIFY ',NOTIFY_REMOTE
- END IF
- END IF
-
- CALL CLOSE_BULLUSER
-
- IF (CHANGE_FOLDER) THEN
- FOLDER_NUMBER = FOLDER_NUMBER_SAVE
- CHANGE_FOLDER = .FALSE.
- END IF
-
- RETURN
-
- END
-
-
-
-
- SUBROUTINE SET_VERSION
-C
-C SUBROUTINE SET_VERSION
-C
-C FUNCTION: Sets version number.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- DIMENSION FLAGS(FLONG,4)
- EQUIVALENCE (NEW_FLAG(1),FLAGS(1,1))
-
- LOGICAL CMD
-
- DIMENSION READ_BTIM_SAVE(2)
-
-C
-C Find user entry in BULLUSER.DAT to update information.
-C
-
- CALL OPEN_BULLUSER_SHARED ! Open user file
-
- READ_BTIM_SAVE(1) = READ_BTIM(1)
- READ_BTIM_SAVE(2) = READ_BTIM(2)
-
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry
-
- IF (IER.EQ.0) THEN
- NEW_FLAG(1) = 143
- REWRITE (4,IOSTAT=IER) USER_ENTRY ! Write modified entry
- READ_BTIM(1) = READ_BTIM_SAVE(1)
- READ_BTIM(2) = READ_BTIM_SAVE(2)
- END IF
-
- CALL CLOSE_FILE (4)
- RETURN
-
- END
-
-
-
-
-
- SUBROUTINE CHECK_NEWUSER(USERNAME,DISMAIL,PASSCHANGE)
-C
-C SUBROUTINE CHECK_NEWUSER
-C
-C FUNCTION: Checks flags for a new: Whether DISMAIL is set,
-C and what the last password change was.
-C
-C INPUTS:
-C USERNAME - Username
-C OUTPUTS:
-C DISMAIL - Returns 1 if account has DISMAIL.
-C returns 0 if account has no DISMAIL.
-C PASSCHANGE - Date of last password change.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) USERNAME
-
- INTEGER PASSCHANGE(2)
-
- INCLUDE '($UAIDEF)'
-
- CALL INIT_ITMLST
- CALL ADD_2_ITMLST(4,UAI$_FLAGS,%LOC(FLAGS))
- CALL ADD_2_ITMLST(8,UAI$_PWD_DATE,%LOC(PASSCHANGE))
- CALL END_ITMLST(GETUAI_ITMLST)
-
- DISMAIL = 0 ! Set return false
- IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,) ! Read Record
- IF (IER) THEN ! If username found
- IF (BTEST(FLAGS,UAI$V_NOMAIL)) THEN ! DISMAIL SET?
- DISMAIL = 1 ! Yep
- END IF
- END IF
-
- RETURN ! Return
- END ! End
-
-
-
- INTEGER FUNCTION SYS_TRNLNM(INPUT,OUTPUT)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INPUT,OUTPUT
-
- PARAMETER LNM$_STRING = '2'X
-
- CALL INIT_ITMLST ! Initialize item list
- IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET
- & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))
- CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist
-
- SYS_TRNLNM = SYS$TRNLNM(,'LNM$FILE_DEV',INPUT(:TRIM(INPUT)),,
- & %VAL(TRNLNM_ITMLST))
-
- IF (SYS_TRNLNM.AND.OUTPUT.NE.'DEFINED') OUTPUT = OUTPUT(:OLEN)
-
- RETURN
- END
-
-
-
-
- INTEGER FUNCTION SYS_TRNLNM_SYSTEM(INPUT,OUTPUT)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) INPUT,OUTPUT
-
- PARAMETER LNM$_STRING = '2'X
-
- CALL INIT_ITMLST ! Initialize item list
- IF (OUTPUT.NE.'DEFINED') CALL ADD_2_ITMLST_WITH_RET
- & (LEN(OUTPUT),LNM$_STRING,%LOC(OUTPUT),%LOC(OLEN))
- CALL END_ITMLST(TRNLNM_ITMLST) ! Get address of itemlist
-
- SYS_TRNLNM_SYSTEM = SYS$TRNLNM(,'LNM$SYSTEM',
- & INPUT(:TRIM(INPUT)),,%VAL(TRNLNM_ITMLST))
-
- IF (SYS_TRNLNM_SYSTEM.AND.OUTPUT.NE.'DEFINED') THEN
- OUTPUT = OUTPUT(:OLEN)
- END IF
-
- RETURN
- END
-
-
-
- INTEGER FUNCTION FILE_LOCK(IER,IER1)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($RMSDEF)'
-
- DATA INIT /.TRUE./
-
- IF (INIT) THEN
- FILE_LOCK = 1
- INIT = .FALSE.
- ELSE
- IF (IER.GT.0) THEN
- CALL ERRSNS(IDUMMY,IER1)
- IF (IER1.EQ.RMS$_FLK) THEN
- FILE_LOCK = 1
- CALL WAIT_SEC('01')
- ELSE
- FILE_LOCK = 0
- INIT = .TRUE.
- END IF
- ELSE
- FILE_LOCK = 0
- IER1 = 0
- INIT = .TRUE.
- END IF
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE ENABLE_CTRL
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /CTRLY/ CTRLY
-
- COMMON /CTRL_LEVEL/ LEVEL
-
- COMMON /DEF_PROT/ ORIGINAL_DEF_PROT
-
- COMMON /KEYPAD/ KEYPAD_MODE
-
- QUIT = 1
-
- ENTRY ENABLE_CTRL_EXIT
-
- QUIT = QUIT.AND.1 ! If called via entry, QUIT = 0
- IF (QUIT.EQ.1) LEVEL = LEVEL - 1
-
- IF (LEVEL.LT.0.AND.QUIT.EQ.1) THEN
- WRITE (6,'('' ERROR: Error in CTRL.'')')
- END IF
-
- IF (LEVEL.EQ.0.OR.QUIT.EQ.0) THEN
- CALL LIB$ENABLE_CTRL(CTRLY,) ! Enable CTRL-Y & -C
- END IF
-
- IF (QUIT.EQ.0) THEN
- IF (KEYPAD_MODE.EQ.0) THEN
- IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,)
- IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)
- END IF
- CALL CLOSE_TAG
- CALL UPDATE_USERINFO
- CALL PRINT_NOW
- CALL SYS$SETDFPROT(ORIGINAL_DEF_PROT,)
- CALL EXIT
- END IF
- QUIT = 0 ! Reinitialize
-
- RETURN
- END
-
-
- SUBROUTINE DISABLE_CTRL
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /CTRLY/ CTRLY
-
- COMMON /CTRL_LEVEL/ LEVEL
- DATA LEVEL /0/
-
- IF (LEVEL.EQ.0) CALL LIB$DISABLE_CTRL(CTRLY,)
- LEVEL = LEVEL + 1
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CLEANUP_BULLFILE
-C
-C SUBROUTINE CLEANUP_BULLFILE
-C
-C FUNCTION: Searches for empty space in bulletin file and deletes it.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- CHARACTER FILENAME*132,BUFFER*128
-
- CALL OPEN_BULLDIR_SHARED
-
-C
-C NOTE: Can't use READDIR for reading header since it'll spawn a
-C BULL/CLEANUP. (Fooey).
-C
-
- DO WHILE (REC_LOCK(IER))
- READ (2,KEYID=0,KEY=HEADER_KEY,IOSTAT=IER) BULLDIR_HEADER
- END DO
-
- IF (NEMPTY.EQ.0) THEN ! No cleanup necessary
- CALL CLOSE_BULLDIR
- RETURN
- ELSE IF (NEMPTY.GT.0) THEN
-
- CALL SYS$SETDFPROT('FF00'X,CUR_DEF_PROT)
- ! Set protection to (SYSTEM:RWED,OWNER:RWED,,)
-
- OPEN (UNIT=11,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',
- 1 STATUS='UNKNOWN',IOSTAT=IER,DISPOSE='DELETE',
- 1 RECORDTYPE='FIXED',RECORDSIZE=32,
- 1 FORM='UNFORMATTED',INITIALSIZE=((NBLOCK-NEMPTY)*128)/512)
- ! Compressed version is number 1
-
- IF (IER.NE.0) THEN
- WRITE (6,'('' Cannot open temporary file for''
- & ,'' compressing '',A)') FOLDER(:TRIM(FOLDER))
- CALL ERRSNS(IDUMMY,IER)
- IF (IER1.EQ.0) THEN
- WRITE (6,'('' IOSTAT error = '',I)') IER
- ELSE
- CALL SYS_GETMSG(IER1)
- END IF
- CALL CLOSE_BULLDIR
- CALL SYS$SETDFPROT(CUR_DEF_PROT,)
- END IF
-
- CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLFIL',
- & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL')
-
- CALL OPEN_BULLFIL_SHARED ! Open bulletin file
-
- NBLOCK = 0
-
- DO I=1,NBULL ! Copy bulletins to new file
- CALL READDIR(I,IER)
- ICOUNT = BLOCK
- DO J=1,LENGTH
- NBLOCK = NBLOCK + 1
- DO WHILE (REC_LOCK(IER1))
- READ(1'ICOUNT,IOSTAT=IER1) BUFFER
- END DO
- IF (IER1.NE.0) THEN ! This file is corrupt
- NBLOCK = NBLOCK - 1
- NBULL = I - 1
- GO TO 100
- END IF
- WRITE(11) BUFFER
- ICOUNT = ICOUNT + 1
- END DO
- END DO
-
-100 CALL CLOSE_BULLFIL
- ELSE IF (NEMPTY.EQ.-1) THEN
- CALL CLOSE_BULLDIR
- CALL OPEN_BULLDIR ! Open with no sharing
- IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',
- & '*.BULLFIL')
- IER = 1
- DO WHILE (IER)
- IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
- & '.BULLFIL;-1')
- END DO
- IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',
- & '*.BULLDIR')
- CALL CLOSE_BULLDIR_DELETE
- IER = 1
- DO WHILE (IER)
- IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
- & '.BULLDIR;-1')
- END DO
- IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',
- & '*.*;1')
- RETURN
- END IF
-
- OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED',
- & INITIALSIZE=(((NBULL+1)*DIR_RECORD_LENGTH)/512)+1 )
-
- IF (IER.NE.0) THEN
- OPEN (UNIT=12,FILE=FOLDER_FILE(1:TRIM(FOLDER_FILE))
- & //'.TMPDIR',STATUS='UNKNOWN',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- IF (IER.NE.0) THEN
- CLOSE (UNIT=11)
- CALL CLOSE_BULLDIR
- CALL SYS$SETDFPROT(CUR_DEF_PROT,)
- RETURN
- END IF
- END IF
-
- CALL COPY_ACL(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR',
- & FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR')
-
- NEMPTY = 0
- WRITE (12,IOSTAT=IER) BULLDIR_HEADER ! Write directory header
-
- NBLOCK = 0 ! Update directory entry pointers
- DO I=1,NBULL
- CALL READDIR(I,IER)
- BLOCK = NBLOCK + 1
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- WRITE (12,IOSTAT=IER) BULLDIR_ENTRY
- NBLOCK = NBLOCK + LENGTH
- END DO
-
- CLOSE (UNIT=12,STATUS='KEEP')
- CLOSE (UNIT=11,STATUS='KEEP')
-
- CALL CLOSE_BULLDIR
- CALL OPEN_BULLDIR ! Open with no sharing
-
- NEMPTY = -1 ! Copying done, indicate that in case of crash
- WRITE (2,IOSTAT=IER) BULLDIR_HEADER ! Write new directory header
-
- IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPFIL',
- & '*.BULLFIL')
- IER = 1
- DO WHILE (IER)
- IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
- & '.BULLFIL;-1')
- END DO
- IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.TMPDIR',
- & '*.BULLDIR')
- CALL CLOSE_BULLDIR_DELETE
- IER = 1
- DO WHILE (IER)
- IER = LIB$DELETE_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
- & '.BULLDIR;-1')
- END DO
- IER = LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULL*',
- & '*.*;1')
-
- CALL SYS$SETDFPROT(CUR_DEF_PROT,)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE CLEANUP_DIRFILE(DELETE_ENTRY)
-C
-C SUBROUTINE CLEANUP_DIRFILE
-C
-C FUNCTION: Reorder directory file after deletions.
-C Is called either directly after a deletion, or is
-C called if it is detected that a deletion was not fully
-C completed due to the fact that the deleting process
-C was abnormally terminated.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE
-
- CHARACTER*11 DATE_SAVE,EXDATE_SAVE
- CHARACTER*11 TIME_SAVE,EXTIME_SAVE
-
- BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY
- DATE_SAVE = DATE
- TIME_SAVE = TIME
- EXDATE_SAVE = EXDATE
- EXTIME_SAVE = EXTIME
-
- NBULL = -NBULL ! Negative # Bulls signals deletion in progress
- MOVE_TO = 0 ! Moving directory entries starting here
- MOVE_FROM = 0 ! Moving directory entries from here
- I = DELETE_ENTRY ! Start search point for first deleted entries
- DO WHILE (MOVE_TO.EQ.0.AND.I.LE.NBULL)
- CALL READDIR(I,IER)
- IF (IER.NE.I+1) THEN ! Have we found a deleted entry?
- MOVE_TO = I ! If so, start moving entries to here
- J=I+1 ! Search for next entry in file
- DO WHILE (MOVE_FROM.EQ.0.AND.J.LE.NBULL)
- CALL READDIR(J,IER)
- IF (IER.EQ.J+1) MOVE_FROM = J
- J = J + 1
- END DO
- IF (MOVE_FROM.EQ.0) THEN ! There are no more entries
- NBULL = I - 1 ! so just update number of bulletins
- CALL WRITEDIR(0,IER)
- RETURN
- END IF
- LENGTH = -LENGTH ! Indicate starting point by writing
- CALL WRITEDIR(I,IER) ! next entry into deleted entry
- FIRST_DELETE = I ! with negative length
- MOVE_FROM = MOVE_FROM + 1 ! Set up pointers to move rest of
- MOVE_TO = MOVE_TO + 1 ! the entries
- ELSE IF (LENGTH.LT.0) THEN ! If negative length found, deletion
- FIRST_DELETE = I ! was previously in progress
- J = I ! Try to find where entry came from
- CALL INIT_QUEUE(ENTRY_Q1,BULLDIR_ENTRY)
- ENTRY_Q = ENTRY_Q1
- DO K=J,NBULL
- CALL READDIR(K,IER)
- IF (IER.EQ.K+1) THEN
- CALL WRITE_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY)
- END IF
- END DO
- ENTRY_QLAST = ENTRY_Q
- ENTRY_Q2 = ENTRY_Q1
- DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q2.NE.ENTRY_QLAST)
- CALL READ_QUEUE(%VAL(ENTRY_Q2),ENTRY_Q,BULLDIR_ENTRY)
- ENTRY_Q2 = ENTRY_Q
- BLOCK_SAVE = BLOCK
- MSG_NUM_SAVE = MSG_NUM
- DO WHILE (MOVE_FROM.EQ.0.AND.ENTRY_Q.NE.ENTRY_QLAST)
- ! Search for duplicate entries
- CALL READ_QUEUE(%VAL(ENTRY_Q),ENTRY_Q,BULLDIR_ENTRY)
- IF (BLOCK_SAVE.EQ.BLOCK) THEN
- MOVE_TO = MSG_NUM_SAVE + 1
- MOVE_FROM = MSG_NUM + 1
- END IF
- END DO
- ! If no duplicate entry found for this
- ! entry, see if one exists for any
- END DO ! of the other entries
- END IF
- I = I + 1
- END DO
-
- IF (I.LE.NBULL) THEN ! Move reset of entries if necessary
- IF (MOVE_FROM.GT.0) THEN
- DO J=MOVE_FROM,NBULL
- CALL READDIR(J,IER)
- IF (IER.EQ.J+1) THEN ! Skip any other deleted entries
- CALL WRITEDIR(MOVE_TO,IER)
- MOVE_TO = MOVE_TO + 1
- END IF
- END DO
- END IF
- DO J=MOVE_TO,NBULL ! Delete empty records at end of file
- CALL READDIR(J,IER)
- DELETE(UNIT=2,IOSTAT=IER)
- END DO
- NBULL = MOVE_TO - 1 ! Update # bulletin count
- END IF
-
- CALL READDIR(FIRST_DELETE,IER)
- IF (IER.EQ.FIRST_DELETE+1.AND.LENGTH.LT.0) THEN
- LENGTH = -LENGTH ! Fix entry which has negative length
- CALL WRITEDIR(FIRST_DELETE,IER)
- END IF
-
- CALL WRITEDIR(0,IER)
-
- BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE
- DATE = DATE_SAVE
- TIME = TIME_SAVE
- EXDATE = EXDATE_SAVE
- EXTIME = EXTIME_SAVE
-
- RETURN
- END
-
-
- SUBROUTINE SHOW_FLAGS
-C
-C SUBROUTINE SHOW_FLAGS
-C
-C FUNCTION: Show user flags.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
-C
-C Find user entry in BULLUSER.DAT to obtain flags.
-C
- IF (REMOTE_SET.NE.3) THEN
- CALL OPEN_BULLUSER_SHARED ! Open user file
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Read old entry
- ELSE IF (NEWS_FIND_SUBSCRIBE().GT.FOLDER_MAX) THEN
- WRITE (6,'('' ERROR: NEWS FOLDER is not subscribed.'')')
- RETURN
- END IF
-
- WRITE (6,'('' For the selected folder '',A)')
- & FOLDER_NAME(1:TRIM(FOLDER_NAME))
-
- IF (REMOTE_SET.NE.3.AND.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN
- WRITE (6,'('' NOTIFY is set.'')')
- END IF
-
- IF (TEST_SET_FLAG(FOLDER_NUMBER).AND.
- & (.NOT.TEST_BRIEF_FLAG(FOLDER_NUMBER))) THEN
- WRITE (6,'('' READNEW is set.'')')
- ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.
- & TEST_SET_FLAG(FOLDER_NUMBER)) THEN
- WRITE (6,'('' BRIEF is set.'')')
- ELSE IF (TEST_BRIEF_FLAG(FOLDER_NUMBER).AND.
- & .NOT.TEST_SET_FLAG(FOLDER_NUMBER)) THEN
- WRITE (6,'('' SHOWNEW is set.'')')
- ELSE IF (REMOTE_SET.EQ.3.OR.
- & .NOT.TEST2(NOTIFY_FLAG,FOLDER_NUMBER)) THEN
- WRITE (6,'('' No flags are set.'')')
- END IF
-
- IF (REMOTE_SET.NE.3) CALL CLOSE_BULLUSER
-
- RETURN
- END
-
-
- SUBROUTINE SET2(FLAG,NUMBER)
-
- IMPLICIT INTEGER (A-Z)
-
- INTEGER FLAG(2)
-
- F_POINT = NUMBER/32 + 1
- FLAG(F_POINT) = IBSET(FLAG(F_POINT),NUMBER-32*(F_POINT-1))
-
- RETURN
- END
-
-
- SUBROUTINE CLR2(FLAG,NUMBER)
-
- IMPLICIT INTEGER (A-Z)
-
- INTEGER FLAG(3)
-
- F_POINT = NUMBER/32 + 1
- FLAG(F_POINT) = IBCLR(FLAG(F_POINT),NUMBER-32*(F_POINT-1))
-
- RETURN
- END
-
-
-
- LOGICAL FUNCTION TEST2(FLAG,NUMBER)
-
- IMPLICIT INTEGER (A-Z)
-
- INTEGER FLAG(3)
-
- F_POINT = NUMBER/32 + 1
- TEST2 = BTEST(FLAG(F_POINT),NUMBER-32*(F_POINT-1))
-
- RETURN
- END
-
-
-
-
- INTEGER FUNCTION GETUSERS(USERNAME,TERMINAL)
-C
-C FUNCTION GETUSERS
-C
-C FUNCTION:
-C To get names of all users that are logged in.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($JPIDEF)'
-
-!*** MODULE $PSCANDEF ***
- PARAMETER pscan$_BEGIN = '00000000'X
- PARAMETER pscan$_ACCOUNT = '00000001'X
- PARAMETER pscan$_AUTHPRI = '00000002'X
- PARAMETER pscan$_CURPRIV = '00000003'X
- PARAMETER pscan$_GRP = '00000004'X
- PARAMETER pscan$_HW_MODEL = '00000005'X
- PARAMETER pscan$_HW_NAME = '00000006'X
- PARAMETER pscan$_JOBPRCCNT = '00000007'X
- PARAMETER pscan$_JOBTYPE = '00000008'X
- PARAMETER pscan$_MASTER_PID = '00000009'X
- PARAMETER pscan$_MEM = '0000000A'X
- PARAMETER pscan$_MODE = '0000000B'X
- PARAMETER pscan$_NODE_CSID = '0000000C'X
- PARAMETER pscan$_NODENAME = '0000000D'X
- PARAMETER pscan$_OWNER = '0000000E'X
- PARAMETER pscan$_PRCCNT = '0000000F'X
- PARAMETER pscan$_PRCNAM = '00000010'X
- PARAMETER pscan$_PRI = '00000011'X
- PARAMETER pscan$_PRIB = '00000012'X
- PARAMETER pscan$_STATE = '00000013'X
- PARAMETER pscan$_STS = '00000014'X
- PARAMETER pscan$_TERMINAL = '00000015'X
- PARAMETER pscan$_UIC = '00000016'X
- PARAMETER pscan$_USERNAME = '00000017'X
- PARAMETER pscan$_GETJPI_BUFFER_SIZE = '00000018'X
- PARAMETER pscan$_END = '00000019'X
- PARAMETER pscan$k_type = '00000081'X
- PARAMETER pscan$M_OR = '00000001'X
- PARAMETER pscan$M_BIT_ALL = '00000002'X
- PARAMETER pscan$M_BIT_ANY = '00000004'X
- PARAMETER pscan$M_GEQ = '00000008'X
- PARAMETER pscan$M_GTR = '00000010'X
- PARAMETER pscan$M_LEQ = '00000020'X
- PARAMETER pscan$M_LSS = '00000040'X
- PARAMETER pscan$M_PREFIX_MATCH = '00000080'X
- PARAMETER pscan$M_WILDCARD = '00000100'X
- PARAMETER pscan$M_CASE_BLIND = '00000200'X
- PARAMETER pscan$M_EQL = '00000400'X
- PARAMETER pscan$M_NEQ = '00000800'X
- STRUCTURE /item_specific_flags/
- PARAMETER pscan$S_OR = 1
- PARAMETER pscan$V_OR = 0
- PARAMETER pscan$S_BIT_ALL = 1
- PARAMETER pscan$V_BIT_ALL = 1
- PARAMETER pscan$S_BIT_ANY = 1
- PARAMETER pscan$V_BIT_ANY = 2
- PARAMETER pscan$S_GEQ = 1
- PARAMETER pscan$V_GEQ = 3
- PARAMETER pscan$S_GTR = 1
- PARAMETER pscan$V_GTR = 4
- PARAMETER pscan$S_LEQ = 1
- PARAMETER pscan$V_LEQ = 5
- PARAMETER pscan$S_LSS = 1
- PARAMETER pscan$V_LSS = 6
- PARAMETER pscan$S_PREFIX_MATCH = 1
- PARAMETER pscan$V_PREFIX_MATCH = 7
- PARAMETER pscan$S_WILDCARD = 1
- PARAMETER pscan$V_WILDCARD = 8
- PARAMETER pscan$S_CASE_BLIND = 1
- PARAMETER pscan$V_CASE_BLIND = 9
- PARAMETER pscan$S_EQL = 1
- PARAMETER pscan$V_EQL = 10
- PARAMETER pscan$S_NEQ = 1
- PARAMETER pscan$V_NEQ = 11
- BYTE %FILL (2)
- END STRUCTURE
-
- CHARACTER USERNAME*(*),TERMINAL*(*)
-
- DATA CONTEXT/0/
-
- IF (CONTEXT.EQ.0) THEN
- CALL INIT_ITMLST ! Initialize item list
- ! Now add items to list
- CALL ADD_2_ITMLST_WITH_RET(0,PSCAN$_NODE_CSID,0,PSCAN$M_NEQ)
- CALL ADD_2_ITMLST(0,PSCAN$_MODE,JPI$K_INTERACTIVE)
- CALL END_ITMLST(PSCAN_ITMLST) ! Get address of itemlist
-
- IER = SYS$PROCESS_SCAN(CONTEXT,%VAL(PSCAN_ITMLST))
- END IF
-
- CALL INIT_ITMLST ! Initialize item list
- ! Now add items to list
- CALL ADD_2_ITMLST(LEN(USERNAME),JPI$_USERNAME,%LOC(USERNAME))
- CALL ADD_2_ITMLST(LEN(TERMINAL),JPI$_TERMINAL,%LOC(TERMINAL))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = 1
- TERMINAL(1:1) = CHAR(0)
- DO WHILE (IER.AND.TERMINAL(1:1).EQ.CHAR(0))
- ! Get next interactive process
- IER = SYS$GETJPIW(,CONTEXT,,%VAL(GETJPI_ITMLST),,,,)
- ! Get next process.
- END DO
-
- IF (.NOT.IER) CONTEXT = 0
-
- GETUSERS = IER
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE OPEN_USERINFO
-C
-C SUBROUTINE OPEN_USERINFO
-C
-C FUNCTION: Opens the file in SYS$LOGIN which contains user information.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)
- COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX)
- COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)
- DATA USERINFO_READ /.FALSE./
-
- EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1))
- DIMENSION LAST(2,FOLDER_MAX)
-
- INTEGER TODAY_BTIM(2)
-
- CALL OPEN_BULLINF_SHARED
-
- READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST
-
- IF (IER.EQ.0) THEN ! Check to see if dates all in future
- CALL SYS_BINTIM('-',TODAY_BTIM) ! Get today's date
- DO I=1,FOLDER_MAX
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,I),TODAY_BTIM)
- IF (DIFF.GE.0) THEN ! Must have been in a time wrap
- LAST_READ_BTIM(1,I) = TODAY_BTIM(1)
- LAST_READ_BTIM(2,I) = TODAY_BTIM(2)
- END IF
- END DO
- END IF
-
- IF (IER.NE.0.AND.TEST_BULLCP().EQ.2 ! Is this BULLCP process?
- & .AND.CONFIRM_USER(USERNAME).NE.0) THEN ! Not real user?
- USERNAME = 'DECNET'
- READ (9,KEY=USERNAME,IOSTAT=IER) USERNAME,LAST
- END IF
-
- IF (IER.NE.0) THEN
- OPEN (UNIT=10,FILE='SYS$LOGIN:BULLETIN.INF',STATUS='OLD',
- & RECORDTYPE='FIXED',FORM='UNFORMATTED',IOSTAT=IER)
- INQUIRE(UNIT=10,RECORDSIZE=INF_SIZE)
- IF (IER.EQ.0) THEN
- READ (10)
- & ((LAST_READ_BTIM(1,I),LAST_READ_BTIM(2,I)),I=1,INF_SIZE/2)
- CLOSE (UNIT=10,STATUS='DELETE')
- ELSE
- CALL OPEN_BULLUSER_SHARED ! Get BULLUSER.DAT file
- CALL READ_USER_FILE_KEYNAME(USERNAME,IER) ! Find user's info
- CALL CLOSE_BULLUSER
- IF (IER.NE.0.AND.TEST_BULLCP().EQ.2) THEN ! BULLCP process?
- CALL SYS_BINTIM('-',LOGIN_BTIM) ! Get today's date
- CALL SYS_BINTIM('5-NOV-1956 11:05:56',READ_BTIM)
- CALL READ_USER_FILE_HEADER(IER)
- NEW_FLAG(1) = 143
- NEW_FLAG(2) = 0
- CALL WRITE_USER_FILE_NEW(IER)
- END IF
- IF (IER.EQ.0) THEN
- DO I=1,FOLDER_MAX
- LAST_READ_BTIM(1,I) = READ_BTIM(1)
- LAST_READ_BTIM(2,I) = READ_BTIM(2)
- END DO
- END IF
- END IF
- IF (IER.EQ.0) WRITE (9,IOSTAT=IER) USERNAME,LAST
- END IF
-
- LU = TRIM(USERNAME)
- USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))
- READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_SYS_BTIM
- USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))
- IF (IER1.NE.0) THEN
- DO I=1,FOLDER_MAX
- LAST_SYS_BTIM(1,I) = 0
- LAST_SYS_BTIM(2,I) = 0
- END DO
- END IF
-
- USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))
- IF (LU.GT.1) THEN
- USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1)))
- ELSE
- USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2)))
- END IF
- READ (9,KEY=USERNAME,IOSTAT=IER1) USERNAME,LAST_NEWS_READ
- USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))
- IF (LU.GT.1) THEN
- USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))
- ELSE
- USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))
- END IF
- IF (IER1.NE.0) THEN
- DO I=1,FOLDER_MAX
- LAST_NEWS_READ(1,I) = 0
- LAST_NEWS_READ(2,I) = 0
- END DO
- END IF
-
- CALL CLOSE_BULLINF
-
- CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_READ_BTIM,OLD_LAST_READ_BTIM)
- CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_SYS_BTIM,OLD_LAST_SYS_BTIM)
- CALL LIB$MOVC3(FOLDER_MAX*2*4,LAST_NEWS_READ,OLD_LAST_NEWS_READ)
-
- USERINFO_READ = .TRUE.
-
- RETURN
- END
-
-
-
- SUBROUTINE UPDATE_USERINFO
-C
-C SUBROUTINE UPDATE_USERINFO
-C
-C FUNCTION: Updates the latest message read times for each folder.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /USERINFO/ USERINFO_READ,OLD_LAST_READ_BTIM(2,FOLDER_MAX)
- COMMON /USERINFO/ OLD_LAST_SYS_BTIM(2,FOLDER_MAX)
- COMMON /USERINFO/ OLD_LAST_NEWS_READ(2,FOLDER_MAX)
-
- EQUIVALENCE (LAST_READ_BTIM(1,1),LAST(1,1))
- DIMENSION LAST(2,FOLDER_MAX)
-
- IF (.NOT.USERINFO_READ) RETURN
-
- DIFF = .FALSE.
- FNUM = 1
-
- DO WHILE (.NOT.DIFF.AND.FNUM.LE.FOLDER_MAX)
- DIFF = LAST_READ_BTIM(1,FNUM).NE.OLD_LAST_READ_BTIM(1,FNUM)
- IF (.NOT.DIFF) THEN
- DIFF = LAST_READ_BTIM(2,FNUM).NE.OLD_LAST_READ_BTIM(2,FNUM)
- END IF
- FNUM = FNUM + 1
- END DO
-
- DIFF1 = .FALSE.
- FNUM = 1
-
- DO WHILE (.NOT.DIFF1.AND.FNUM.LE.FOLDER_MAX)
- DIFF1 = LAST_SYS_BTIM(1,FNUM).NE.OLD_LAST_SYS_BTIM(1,FNUM)
- IF (.NOT.DIFF1) THEN
- DIFF1 = LAST_SYS_BTIM(2,FNUM).NE.OLD_LAST_SYS_BTIM(2,FNUM)
- END IF
- FNUM = FNUM + 1
- END DO
-
- DIFF2 = .FALSE.
- FNUM = 1
-
- DO WHILE (.NOT.DIFF2.AND.FNUM.LE.FOLDER_MAX)
- DIFF2 = LAST_NEWS_READ(1,FNUM).NE.OLD_LAST_NEWS_READ(1,FNUM)
- IF (.NOT.DIFF2) THEN
- DIFF2 = LAST_NEWS_READ(2,FNUM).NE.OLD_LAST_NEWS_READ(2,FNUM)
- END IF
- FNUM = FNUM + 1
- END DO
-
- IF (.NOT.(DIFF.OR.DIFF1.OR.DIFF2)) RETURN
-
- CALL OPEN_BULLINF_SHARED
-
- IF (DIFF) THEN
- READ (9,KEY=USERNAME,IOSTAT=IER)
- IF (IER.EQ.0) REWRITE (9,IOSTAT=IER) USERNAME,LAST
- END IF
-
- IF (DIFF1) THEN
- LU = TRIM(USERNAME)
- USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))
- READ (9,KEY=USERNAME,IOSTAT=IER)
- IF (IER.EQ.0) THEN
- REWRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM
- ELSE
- WRITE (9,IOSTAT=IER) USERNAME,LAST_SYS_BTIM
- END IF
- USERNAME(LU:LU) = CHAR(127.AND.ICHAR(USERNAME(LU:LU)))
- END IF
-
- IF (DIFF2) THEN
- LU = TRIM(USERNAME)
- USERNAME(LU:LU) = CHAR(128.OR.ICHAR(USERNAME(LU:LU)))
- IF (LU.GT.1) THEN
- USERNAME(LU-1:LU-1) = CHAR(128.OR.ICHAR(USERNAME(LU-1:LU-1)))
- ELSE
- USERNAME(2:2) = CHAR(128.OR.ICHAR(USERNAME(2:2)))
- END IF
- READ (9,KEY=USERNAME,IOSTAT=IER)
- IF (IER.EQ.0) THEN
- REWRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ
- ELSE
- WRITE (9,IOSTAT=IER) USERNAME,LAST_NEWS_READ
- END IF
- IF (LU.GT.1) THEN
- USERNAME(LU-1:LU-1) = CHAR(127.AND.ICHAR(USERNAME(LU-1:LU-1)))
- ELSE
- USERNAME(2:2) = CHAR(127.AND.ICHAR(USERNAME(2:2)))
- END IF
- END IF
-
- CALL CLOSE_BULLINF
-
- RETURN
- END
-
-
- INTEGER FUNCTION SYS_BINTIM(TIME,BTIM)
-
- IMPLICIT INTEGER (A-Z)
-
- INTEGER BTIM(2)
-
- CHARACTER*(*) TIME
-
- IF (TRIM(TIME).EQ.20) THEN
- SYS_BINTIM = SYS$BINTIM(TIME//'.00',BTIM)
- ELSE
- SYS_BINTIM = SYS$BINTIM(TIME,BTIM)
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE NEW_MESSAGE_NOTIFICATION
-C
-C SUBROUTINE NEW_MESSAGE_NOTIFICATION
-C
-C FUNCTION:
-C
-C Update user's last read bulletin date. If new bulletins have been
-C added since the last time bulletins have been read, position bulletin
-C pointer so that next bulletin read is the first new bulletin, and
-C alert user. If READNEW set and no new bulletins, just exit.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /READIT/ READIT
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2)
-
- COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
- COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
-
- COMMON /COMMAND_SWITCHES/ LOGIN_SWITCH,SYSTEM_SWITCH
- COMMON /COMMAND_SWITCHES/ SYSTEM_LOGIN_BTIM(2)
- COMMON /COMMAND_SWITCHES/ REVERSE_SWITCH,SEPARATE
- CHARACTER*1 SEPARATE
-
- COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM
-
- COMMON /LOGIN_BTIM/ LOGIN_BTIM_SAVE(2)
-
- COMMON /COMMAND_LINE/ INCMD
- CHARACTER*132 INCMD
-
- IF (INCMD(:4).EQ.'SHOW') THEN
- CALL READ_IN_FOLDERS ! Read folder info
- ELSE IF (.NOT.LOGIN_SWITCH) THEN
- LOGIN_BTIM_SAVE(1) = LOGIN_BTIM(1)
- LOGIN_BTIM_SAVE(2) = LOGIN_BTIM(2)
- CALL UPDATE_READ(0) ! Update login time
- IF (CLI$PRESENT('SELECT_FOLDER')) THEN
- CALL SELECT_FOLDER(.TRUE.,IER)
- IF (IER) RETURN
- END IF
- CALL READ_IN_FOLDERS ! Read folder info
- ELSE
- LOGIN_SWITCH = .FALSE. ! So LOGIN_FOLDER entry doesn't
- END IF ! think it's called via LOGIN
-
- FOLDER_Q = SAVE_FOLDER_Q1
-
- DO I = 1,SAVE_FOLDER_NUM
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- CALL CLR2(NEW_MSG,FOLDER_NUMBER) ! Clear new message flag
- IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1
- & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
- CALL SET2(NEW_MSG,FOLDER_NUMBER)
- ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR.
- & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.
- & (FOLDER_NUMBER.GT.0.AND.
- & TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.READIT.EQ.1)) THEN
- IF (READIT.EQ.1.AND.SYSTEM_SWITCH.AND.
- & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN
- DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,
- & F_NEWEST_BTIM)
- ELSE
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- IF (DIFF.LT.0.AND.READIT.EQ.1) THEN
- IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.
- & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER).OR.
- & NEW_FLAG(2).NE.-1) THEN
- DIFF = COMPARE_BTIM(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)
- END IF
- IF (FOLDER_BBOARD(:2).EQ.'::'.AND.DIFF.GE.0) THEN
- IER = MINUTE_DIFF(LOGIN_BTIM_SAVE,F_NEWEST_BTIM)
- IF (IER.LE.15) DIFF = -1
- END IF
- END IF
- END IF
- IF (F_NBULL.GT.0.AND.(DIFF.LT.0.OR.(READIT.EQ.1.AND.
- & BTEST(FOLDER_FLAG,7)))) THEN ! If new unread messages
- CALL SET2(NEW_MSG,FOLDER_NUMBER) ! Set new message flag
- END IF
- END IF
- END DO
-
- FOLDER_Q = SAVE_FOLDER_Q1
-
- IF (READIT.EQ.0) THEN ! If not in READNEW mode
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- NEW_MESS = .FALSE.
- DO I = 1,SAVE_FOLDER_NUM-1
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- IF (DIFF.LT.0) THEN ! Are there unread messages?
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_NOSYS_BTIM)
- IF (DIFF.GT.0) THEN ! Unread non-system messages?
- DIFF = COMPARE_BTIM(LOGIN_BTIM,F_NEWEST_BTIM)
- ! No. Unread system messages?
- IF (DIFF.GT.0) THEN ! No, update last read time.
- LAST_READ_BTIM(1,FOLDER_NUMBER+1) =
- & F_NEWEST_BTIM(1)
- LAST_READ_BTIM(2,FOLDER_NUMBER+1) =
- & F_NEWEST_BTIM(2)
- END IF
- END IF
- IF (DIFF.LT.0) THEN
- WRITE (6,'('' There are new messages in '',
- & ''folder '',A,''.'',$)') FOLDER(1:TRIM(FOLDER))
- NEW_MESS = .TRUE.
- END IF
- END IF
- END IF
- END DO
- CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)
- IF (INCMD(:4).EQ.'SHOW') THEN
- SAVE_FOLDER_Q1 = 0
- RETURN
- END IF
- IF (NEW_MESS.OR.NEWS_MESS) THEN
- WRITE (6,'('' Type SELECT followed by foldername to'',
- & '' read above messages.'')')
- END IF
- SAVE_FOLDER_Q1 = 0
- FOLDER_NUMBER = 0
- CALL SELECT_FOLDER(.FALSE.,IER)
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- IF (DIFF.LT.0.AND.F_NBULL.GT.0) THEN
- CALL FIND_NEWEST_BULL ! See if there are new messages
- IF (BULL_POINT.NE.-1) THEN
- WRITE(6,'('' Type READ to read new GENERAL messages.'')')
- NEW_COUNT = F_NBULL - BULL_POINT
- DIG = 0
- DO WHILE (NEW_COUNT.GT.0)
- NEW_COUNT = NEW_COUNT / 10
- DIG = DIG + 1
- END DO
- WRITE(6,'('' There are '',I<DIG>,'' new messages.'')')
- & F_NBULL - BULL_POINT ! Alert user if new bulletins
- ELSE
- BULL_POINT = 0
- LAST_READ_BTIM(1,FOLDER_NUMBER+1) = F_NEWEST_BTIM(1)
- LAST_READ_BTIM(2,FOLDER_NUMBER+1) = F_NEWEST_BTIM(2)
- END IF
- END IF
- ELSE ! READNEW mode.
- DO I = 1,SAVE_FOLDER_NUM
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- IF (TEST2(NEW_MSG,FOLDER_NUMBER)) THEN
- CALL SELECT_FOLDER(.FALSE.,IER)
- IF (IER) THEN
- IF (SYSTEM_SWITCH.AND.
- & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)) THEN
- DIFF = COMPARE_BTIM(SYSTEM_LOGIN_BTIM,F_NEWEST_BTIM)
- ELSE
- DIFF = COMPARE_BTIM(LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & F_NEWEST_BTIM)
- IF (BTEST(FOLDER_FLAG,7)) DIFF = -1
- IF (DIFF.LT.0.AND.TEST2(BRIEF_FLAG,FOLDER_NUMBER)
- & .AND.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN
- IF (DIFF.LT.0) THEN
- IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER
- IF (BULL_POINT.NE.-1.OR.NEW_FLAG(2).EQ.-1.OR.
- & .NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER))
- & WRITE (6,'('' There are new messages in folder ''
- & ,A,''.'')') FOLDER(1:TRIM(FOLDER))
- ELSE
- WRITE (6,'('' There are new messages in folder ''
- & ,A,''.'')') FOLDER(1:TRIM(FOLDER))
- END IF
- DIFF = 0
- END IF
- END IF
- IF (DIFF.LT.0) THEN
- IF (FOLDER_NUMBER.GT.0) CALL LOGIN_FOLDER
- IF (BULL_POINT.NE.-1) THEN
- IF (.NOT.TEST2(BRIEF_FLAG,FOLDER_NUMBER)) THEN
- SAVE_BULL_POINT = BULL_POINT
- REDO = .TRUE.
- DO WHILE (REDO)
- REDO = .FALSE.
- CALL READNEW(REDO)
- IF (REDO) CALL REDISPLAY_DIRECTORY
- BULL_POINT = SAVE_BULL_POINT
- END DO
- END IF
- END IF
- END IF
- END IF
- END IF
- END DO
- CALL NEWS_NEW_NOTIFICATION(NEWS_MESS)
- CALL EXIT
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE READ_IN_FOLDERS
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- COMMON /SAVE_FOLDERS/ SAVE_FOLDER_Q1,SAVE_FOLDER_NUM
- DATA SAVE_FOLDER_Q1/0/
-
- COMMON /READIT/ READIT
-
- COMMON /SYSTEM_FOLDERS/ SYSTEM_FLAG(FLONG),DUMMY(2)
-
- COMMON /SHUTDOWN/ NODE_NUMBER,NODE_AREA
- COMMON /SHUTDOWN/ SHUTDOWN_FLAG(FLONG)
-
- CALL INIT_QUEUE(SAVE_FOLDER_Q1,FOLDER_COM)
- FOLDER_Q = SAVE_FOLDER_Q1
-
- CALL OPEN_BULLFOLDER_SHARED ! Go find folders
-
- SAVE_FOLDER_NUM = 0
-
- FOLDER_NUMBER = 0
- CALL READ_FOLDER_FILE_KEYNUM(FOLDER_NUMBER,IER)
- DO WHILE (IER.EQ.0)
- SAVE_FOLDER_NUM = SAVE_FOLDER_NUM + 1
- IF (.NOT.TEST_BULLCP().AND.NODE_AREA.GT.0.AND.READIT.EQ.1
- & .AND.TEST2(SHUTDOWN_FLAG,FOLDER_NUMBER)) THEN
- ELSE IF ((NEW_FLAG(1).LT.142.OR.NEW_FLAG(1).GT.143).AND.
- & TEST2(BRIEF_FLAG,FOLDER_NUMBER).AND.
- & .NOT.TEST2(SET_FLAG,FOLDER_NUMBER)) THEN
- CALL CHANGE_FLAG_NOCMD(0,3)
- CALL SET_VERSION
- ELSE IF (TEST2(SET_FLAG,FOLDER_NUMBER).OR.
- & TEST2(BRIEF_FLAG,FOLDER_NUMBER).OR.
- & (FOLDER_NUMBER.GT.0.AND.(BTEST(FOLDER_FLAG,2).OR.
- & TEST2(SYSTEM_FLAG,FOLDER_NUMBER)).AND.READIT.EQ.1)) THEN
-C
-C Unknown problem caused system folder flag in folder file to disappear
-C so this tests to see if the flag has disappeared and resets if needed.
-C
- IF (TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.
- & .NOT.BTEST(FOLDER_FLAG,2)) THEN
- FOLDER_FLAG = IBSET(FOLDER_FLAG,2)
- CALL REWRITE_FOLDER_FILE
- ELSE IF (.NOT.TEST2(SYSTEM_FLAG,FOLDER_NUMBER).AND.
- & BTEST(FOLDER_FLAG,2)) THEN
- CALL MODIFY_SYSTEM_LIST(1)
- END IF
- END IF
- CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
- CALL READ_FOLDER_FILE_KEYNUM_GT(FOLDER_NUMBER,IER)
- END DO
-
- CALL CLOSE_BULLFOLDER
-
- FOLDER_Q = SAVE_FOLDER_Q1
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER_COM)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE DISCONNECT_REMOTE
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- WRITE (6,'('' ERROR: Connection to remote folder disconnected.'')')
-
- FOLDER_NUMBER = -1
- FOLDER1 = 'GENERAL'
-
- CALL SELECT_FOLDER(.FALSE.,IER)
-
- WRITE (6,'('' Resetting to GENERAL folder.'')')
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin8.for b/decus/vax91b/bulletin-net91b/bulletin8.for
deleted file mode 100644
index 11bd33009797f911e48343fe808d38d4d96357ab..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin8.for
+++ /dev/null
@@ -1,1884 +0,0 @@
-C
-C BULLETIN8.FOR, Version 6/22/91
-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)
-
- 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 = 10
-
- COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,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(1024,MAXLINK)
- COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
- INTEGER*2 WRITE_IOSB
- LOGICAL*1 WRITE_BUF
-
- CHARACTER NAMEDESC*9 /'BULLETIN1'/
- CHARACTER NAMEDESC1*4 /'NNTP'/
-
- DIMENSION NFBDESC(2)
- LOGICAL*1 NFB(5)
-
- EXTERNAL IO$_ACPCONTROL
-
- 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
-
- IF (.NOT.GATEWAY_ONLY) THEN
- 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)
-
- IER = SYS$QIOW(,%VAL(DCL_CHAN),IO$_ACPCONTROL,,,,
- & NFBDESC,NAMEDESC,,,,)
- IF (.NOT.IER) CALL EXIT(IER)
-
- 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 EXIT(IER)
-
- IER = SYS$ASSIGN('_NET:',DCL_CHAN1,,'BULL_MBX1')
- IF (.NOT.IER) CALL EXIT(IER)
-
- IER = SYS$QIOW(,%VAL(DCL_CHAN1),IO$_ACPCONTROL,,,,
- & NFBDESC,NAMEDESC1,,,,)
- IF (.NOT.IER) CALL EXIT(IER)
-
- CALL SYS$SETAST(%VAL(0))
- CALL READ_MBX(DCL_CHAN1)
- CALL SYS$SETAST(%VAL(1))
- END IF
-
- DO I=1,MAXLINK
- CALL LIB$GET_EF(READ_EFS(I))
- CALL LIB$GET_EF(WRITE_EFS(I))
- END DO
-
- IF (GATEWAY_ONLY) CALL SYS$HIBER()
-
- RETURN
- END
-
-
- SUBROUTINE SETDEFAULT(USERNAME)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($LNMDEF)'
-
- INCLUDE '($PSLDEF)'
-
- INCLUDE '($UAIDEF)'
-
- CHARACTER DEFDIR*64,DEFDEV*16,USERNAME*(*),ACCOUNT*9
- 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 EXIT(IER)
-
- RETURN
-
- END
-
-
-
-
- SUBROUTINE MBX_AST(DCL_CHAN_NUM)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($MSGDEF)'
-
- INCLUDE 'BULLUSER.INC'
-
- PARAMETER MAXLINK = 10
-
- COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,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
-
- 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+1).NE.' '.AND.
- & MBX_BUF(I+LUSER+1).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 BULL_CONNECT(NODENAME,USERNAME,FROMNAME,%LOC(DCL_CHAN_NUM))
- ELSE IF ((MBXMSG.EQ.MSG$_INTMSG.OR.MBXMSG.EQ.MSG$_REJECT.OR.
- & MBXMSG.EQ.MSG$_CONFIRM).AND.MBX_IOSB(1)) THEN
- CALL READ_MBX(%LOC(DCL_CHAN_NUM))
- 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(%LOC(DCL_CHAN_NUM))
- 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(1024,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(1024),,,,)
-
- RETURN
-
- END
-
-
-
-
- SUBROUTINE WRITE_AST(ASTPRM)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER MAXLINK = 10
-
- COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,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),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*25,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)
- 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)
- ELSE IF (NNTP_CHANS(UNIT_INDEX).GT.0) THEN
- IER = SYS$QIO(%VAL(WRITE_EFS(UNIT_INDEX)),
- & %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)
- END IF
- IF (.NOT.IER) CALL DISCONNECT(UNIT_INDEX)
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE READ_AST(ASTPRM)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER MAXLINK = 10
-
- COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,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)
-
- COMMON /NNTP/ NNTP_CHANS(MAXLINK)
-
- EXTERNAL NEWS_WRITE_AST
-
- EXTERNAL IO$_WRITEVBLK
-
- UNIT_INDEX = %LOC(ASTPRM)
-
- IF (.NOT.READ_IOSB(1,UNIT_INDEX)) RETURN
-
-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.15) THEN
- CALL NEWS_SET_CHAN(NNTP_CHANS(UNIT_INDEX))
- IER = NEWS_WRITE_PACKET_BULLCP(READ_EFS(UNIT_INDEX),
- & READ_IOSB(1,UNIT_INDEX),NEWS_WRITE_AST,UNIT_INDEX,
- & 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)
- ELSE
- CALL EXECUTE_COMMAND(UNIT_INDEX)
- CALL READ_CHAN(DEVS(UNIT_INDEX),UNIT_INDEX)
- END IF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE NEWS_WRITE_AST(ASTPRM)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER MAXLINK = 10
-
- COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,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(1024,MAXLINK)
- COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
- INTEGER*2 WRITE_IOSB
- 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)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE NEWS_READ_AST(ASTPRM)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER MAXLINK = 10
-
- COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)
- COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
- INTEGER*2 WRITE_IOSB
- LOGICAL*1 WRITE_BUF
-
- UNIT_INDEX = %LOC(ASTPRM)
-
- IF (WRITE_IOSB(1,UNIT_INDEX)) THEN
- NUM = WRITE_IOSB(2,UNIT_INDEX)
- CALL WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)
- IF (IER) RETURN
- END IF
-
- CALL DISCONNECT(UNIT_INDEX)
-
- 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(1024,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(1024,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))
-
- ENTRY WRITE_CHAN_BUF(NUM,UNIT_INDEX,IER)
-
- 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 BULL_CONNECT(NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER MAXLINK = 10
-
- COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)
- COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
- INTEGER*2 WRITE_IOSB
- LOGICAL*1 WRITE_BUF
-
- COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)
- COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(MAXLINK),COUNT
- INTEGER*2 READ_IOSB
- LOGICAL*1 READ_BUF
-
- COMMON /ANY_ACTIVITY/ CONNECT_COUNT
- DATA CONNECT_COUNT /0/
-
- COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1
-
- COMMON /NNTP/ NNTP_CHANS(MAXLINK)
-
- CHARACTER*(*) USERNAME,FROMNAME
-
- EXTERNAL IO$_ACCESS,IO$M_ABORT,NEWS_SOCKET_AST
-
- CONNECT_COUNT = CONNECT_COUNT + 1
-
- 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_ASSIGN()
- IF (IER) THEN
- NNTP_CHANS(UNIT_INDEX) = NEWS_GET_CHAN()
- WRITE_IOSB(1,UNIT_INDEX) = 1
- IER = NEWS_SOCKET_BULLCP(WRITE_EFS(UNIT_INDEX),
- & 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 READ_CHAN(CHAN,UNIT_INDEX)
- END IF
- END IF
-
- CALL READ_MBX(DCL_CHAN_NUM)
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_SOCKET_AST(ASTPRM)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER MAXLINK = 10
-
- COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)
- COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
- INTEGER*2 WRITE_IOSB
- 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(WRITE_EFS(UNIT_INDEX),
- & WRITE_IOSB(1,UNIT_INDEX),NEWS_CREATE_AST,UNIT_INDEX)
- IF (IER) RETURN
- END IF
-
- CALL DISCONNECT(UNIT_INDEX)
-
- RETURN
- END
-
-
-
- SUBROUTINE NEWS_CREATE_AST(ASTPRM)
-
- IMPLICIT INTEGER (A-Z)
-
- PARAMETER MAXLINK = 10
-
- COMMON /PROCBUF/ WRITE_IOSB(4,MAXLINK),WRITE_BUF(1024,MAXLINK)
- COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
- INTEGER*2 WRITE_IOSB
- LOGICAL*1 WRITE_BUF
-
- COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,MAXLINK)
- COMMON /READBUF/ DEVS(MAXLINK),UNITS(MAXLINK),READ_EFS(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)
- ELSE
- CALL DISCONNECT(UNIT_INDEX)
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE CONNECT_ACCEPT(REJECT,CHAN,UNIT_INDEX,
- & NODENAME,USERNAME,FROMNAME,DCL_CHAN_NUM)
-
- IMPLICIT INTEGER (A-Z)
-
- 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(1024,MAXLINK)
- COMMON /PROCBUF/ WRITE_EFS(MAXLINK)
- INTEGER*2 WRITE_IOSB
- LOGICAL*1 WRITE_BUF
-
- COMMON /READBUF/ READ_IOSB(4,MAXLINK),READ_BUF(1024,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),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*25,FROM_SAVE*12,NODE_SAVE*12
-
- COMMON /CHANNEL/ MBX_CHAN,DCL_CHAN,MBX_CHAN1,DCL_CHAN1
-
- 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_NUM
- ELSE
- IF (DCL_CHAN_NUM.EQ.DCL_CHAN) THEN
- IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX')
- ELSE
- IER = SYS$ASSIGN('_NET:',DEV_CHAN,,'BULL_MBX1')
- END IF
-
- 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_NUM
- 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(1024,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
-
- COMMON /NNTP/ NNTP_CHANS(MAXLINK)
-
- 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
-
- 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 IF
-
- 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(1024,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)
-
- CHARACTER USERNAME*(*)
-
- INCLUDE '($UAIDEF)'
-
- INTEGER*2 UIC(2)
-
- CALL INIT_ITMLST
- CALL ADD_2_ITMLST(8,UAI$_PRIV,%LOC(PRIV))
- CALL END_ITMLST(GETUAI_ITMLST)
-
- IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)
-
- IF (.NOT.IER) THEN
- USERNAME = 'DECNET'
- IER = SYS$GETUAI(,,USERNAME,%VAL(GETUAI_ITMLST),,,)
- END IF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GET_PROXY_USERNAME(NODE,USERNAME)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER NODE*(*),USERNAME*(*)
-
- CHARACTER NETUAF*100,USERTEMP*12
-
- 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 + 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(33:32+LUSER).EQ.USERNAME) THEN
- IF (NETUAF(65:65).NE.'*') USERNAME = NETUAF(65:)
- RETURN
- END IF
- IF (NETUAF(65:65).NE.'*') THEN
- USERTEMP = NETUAF(65:)
- ELSE
- USERTEMP = USERNAME
- END IF
- END IF
- END DO
-
- USERNAME = USERTEMP
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GET_PROXY_ACCOUNTS
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER NETUAF*656
-
- COMMON /NETUAF/ NETUAF_QUEUE,NETUAF_NUM
- DATA NETUAF_QUEUE/0/
-
- CALL INIT_QUEUE(NETUAF_QUEUE,NETUAF(:100))
-
- OPEN (UNIT=7,FILE='NETPROXY',DEFAULTFILE='SYS$SYSTEM:NETPROXY.DAT',
- & ACCESS='KEYED',FORM='FORMATTED',ORGANIZATION='INDEXED',
- & STATUS='OLD',READONLY,SHARED,IOSTAT=IER)
-
- FORMAT = 0
-
- 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)
- FORMAT = 1
- END IF
-
- NETUAF_NUM = 0
- NENTRY = NETUAF_QUEUE
- DO WHILE (IER.EQ.0)
- READ (7,'(Q,A)',IOSTAT=IER) NLEN,NETUAF
- IF (IER.EQ.0) THEN
- NETUAF_NUM = NETUAF_NUM + 1
- IF (FORMAT.EQ.0) THEN
- NETUAF = NETUAF(13:)
- NLEN = NLEN - 12
- DO WHILE (NETUAF(67:67).NE.CHAR(1).AND.NLEN.GT.64)
- SKIP = 4 + ICHAR(NETUAF(65:65))
- NETUAF(65:) = NETUAF(65+SKIP:)
- NLEN = NLEN - SKIP
- END DO
- IF (NLEN.GT.64) THEN
- ULEN = ICHAR(NETUAF(65:65))
- NETUAF(65:) = NETUAF(69:)
- DO I=65+ULEN,76
- NETUAF(I:I) = ' '
- END DO
- ELSE
- NETUAF(65:) = 'DECNET'
- END IF
- END IF
- CALL WRITE_QUEUE(%VAL(NENTRY),NENTRY,NETUAF(:100))
- 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(1024,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),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*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)
- DATA SCRATCH/MAXLINK*0/,OUT_HEAD/MAXLINK*0/
-
- EXTERNAL SS$_NOSUCHNODE,SS$_NOSUCHOBJ
-
- CHARACTER BUFFER*(FOLDER_RECORD+16),DESCRIP_TEMP*53
- CHARACTER NODENAME*6,BULLCP_USER*12,INQUEUE*128
-
- EQUIVALENCE (BUFFER,CMD_TYPE),(BUFFER,INQUEUE)
-
- INTEGER BULLCP_PRIV(2)
-
- BULLCP_PRIV(1) = PROCPRIV(1)
- BULLCP_PRIV(2) = PROCPRIV(2)
-
- ILEN = READ_IOSB(2,UNIT_INDEX)
- CALL LIB$MOVC3(ILEN,READ_BUF(1,UNIT_INDEX),%REF(BUFFER))
-
- REC_SAVE(UNIT_INDEX) = 0
- USERNAME = USER_SAVE(UNIT_INDEX)
- FOLDER = FOLDERNAME(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)
-
- 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) 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)
- IF ( (PROCPRIV(1).AND.NEEDPRIV(1)).EQ.0.AND.
- & (PROCPRIV(2).AND.NEEDPRIV(2)).EQ.0) THEN
- CALL CHECK_BULLETIN_PRIV(USERNAME)
- PRIV_SAVE(1,UNIT_INDEX) = PROCPRIV(1)
- PRIV_SAVE(2,UNIT_INDEX) = PROCPRIV(2)
- END IF
- END IF
- END IF
-
- IF (CMD_TYPE.EQ.1.AND.BUFFER(ILEN:ILEN).EQ.'?') THEN
- IF (BUFFER(5:ILEN).EQ.'SYSTEM?') THEN
- CALL LIB$MOVC3(4,1,%REF(BUFFER(1:1)))
- CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1)
- ELSE
- CALL LIB$MOVC3(4,0,%REF(BUFFER(1:1)))
- CALL WRITE_CHAN(4,BUFFER,UNIT_INDEX,IER1)
- END IF
- ELSE IF (CMD_TYPE.EQ.1) THEN ! Select folder
- IF (BUFFER(ILEN:ILEN).EQ.'+') THEN
- SYSLOG = .TRUE.
- ILEN = ILEN - 1
- ELSE
- SYSLOG = .FALSE.
- END IF
- FOLDER1 = BUFFER(5:ILEN)
- FOLDER_NUMBER = -2
- CALL SELECT_FOLDER(.FALSE.,IER)
- CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1)))
- CALL LIB$MOVC3(4,READ_ONLY,%REF(BUFFER(5:5)))
- IF (USERNAME.NE.'DECNET'.AND.IER) THEN
- CALL OPEN_USERINFO
- IF (USERNAME.EQ.'DECNET') THEN ! User wasn't real.
- USER_SAVE(UNIT_INDEX) = USERNAME
- CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9)))
- CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13)))
- ELSE
- CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & %REF(BUFFER(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)
- END IF
- ELSE
- CALL LIB$MOVC3(4,0,%REF(BUFFER(9:9)))
- CALL LIB$MOVC3(4,0,%REF(BUFFER(13:13)))
- END IF
- LINFO = 16
- IF (SYSLOG) THEN
- LINFO = 24
- 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:17)))
- IF (LAST_SYS_SAVE(1,UNIT_INDEX).EQ.0) THEN
- CALL LIB$MOVC3(8,LAST_READ_BTIM(1,FOLDER_NUMBER+1),
- & LAST_SYS_BTIM(1,FOLDER_NUMBER+1))
- END IF
- END IF
- BUFFER = BUFFER(:LINFO)//FOLDER_COM
- CALL WRITE_CHAN(LINFO+LEN(FOLDER_COM),BUFFER,UNIT_INDEX,IER1)
- IF (IER.AND.IER1) THEN
- IF (SYSLOG) THEN
- CALL SAVE_LAST_SYS_BTIM(UNIT_INDEX)
- ELSE
- LAST_SYS_SAVE(1,UNIT_INDEX) = 0
- LAST_SYS_SAVE(2,UNIT_INDEX) = 0
- END IF
- 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) + 1
- 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(53,%REF(BUFFER(5:5)),%REF(DESCRIP))
- CALL LIB$MOVC3(11,%REF(BUFFER(58:58)),%REF(EXDATE))
- CALL LIB$MOVC3(11,%REF(BUFFER(69:69)),%REF(EXTIME))
- CALL LIB$MOVC3(4,%REF(BUFFER(80:80)),SYSTEM)
- FOLDER1 = FOLDER
- FOLDER_NUMBER = -1
- CALL SELECT_FOLDER(.FALSE.,IER)
- IF (READ_ONLY.AND.
- & FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
- BUFFER = 'ERROR: Insufficient privileges to add message.'
- CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
- GO TO 1000
- ELSE IF ((SYSTEM.AND.7).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.AND.7).NE.0.AND..NOT.SETPRV_PRIV()) THEN
- ! Priv test
- IF (F_EXPIRE_LIMIT.GT.0.AND..NOT. ! Expiration limit present
- & FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- SYSTEM = 0
- 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)
- WRITE (EXTIME,'(I4)') NODE_NUMBER
- WRITE (EXTIME(7:),'(I4)') NODE_AREA
- DO I=1,11
- IF (EXTIME(I:I).EQ.' ') EXTIME(I:I) = '0'
- END DO
- EXTIME = EXTIME(1:2)//':'//EXTIME(3:4)//':'//
- & EXTIME(7:8)//'.'//EXTIME(9:10)
- END IF
- END IF
- CALL LIB$MOVC3(4,%REF(BUFFER(84:84)),BROAD)
- IF (BROAD.AND..NOT.SETPRV_PRIV().AND..NOT.OPER_PRIV()) THEN
- BROAD = 0
- END IF
- CALL LIB$MOVC3(4,%REF(BUFFER(88:88)),BELL)
- CALL LIB$MOVC3(4,%REF(BUFFER(92:92)),ALL)
- CALL LIB$MOVC3(4,%REF(BUFFER(97:97)),CLUSTER)
- FOLDER_FILE =
- & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
- CALL OPEN_BULLDIR
- CALL READDIR(0,IER) ! Get NBLOCK
- IF (IER.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0
- CALL OPEN_BULLFIL
- 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,INQUEUE)
- WRITE (1'NBLOCK+I) INQUEUE
- END DO
- IF (BROAD) THEN
- CALL GET_BROADCAST_MESSAGE(BELL)
- CALL BROADCAST(ALL,CLUSTER)
- END IF
- CALL CLOSE_BULLFIL ! Finished adding bulletin
- 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 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: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 that
- END IF ! originated the message
- END DO
- IF (TEMP_USER(:1).NE.':') THEN
- 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 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
- END DO
- ELSE IF (CMD_TYPE.EQ.8) THEN ! Read directory entry
- CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),ICOUNT)
- FOLDER_FILE =
- & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
- CALL OPEN_BULLDIR_SHARED
- IF (ICOUNT.GE.0) THEN
- CALL READDIR(ICOUNT,IER)
- ELSE
- CALL LIB$MOVC3(8,%REF(BUFFER(9:9)),%REF(MSG_KEY(1:1)))
- CALL READDIR_KEYGE(IER)
- END IF
- CALL CLOSE_BULLDIR
- CALL LIB$MOVC3(4,IER,%REF(BUFFER(1:1)))
- IF (ICOUNT.NE.0) THEN
- BUFFER(5:) = BULLDIR_ENTRY
- 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)
- END IF
- ELSE IF (CMD_TYPE.EQ.13) THEN ! Read directory entry
- CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),SBULL)
- CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),EBULL)
- FOLDER_FILE =
- & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
- 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)
- REC_SAVE(UNIT_INDEX) = LEN(BULLDIR_ENTRY)
- 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(BUFFER(5:5)),ICOUNT)
- FOLDER_FILE =
- & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
- CALL OPEN_BULLDIR
- IF (ICOUNT.GT.0) THEN
- BULLDIR_ENTRY = BUFFER(9:)
- CALL WRITEDIR_NOCONV(ICOUNT,IER)
- ELSE
- BULLDIR_HEADER = BUFFER(9:)
- CALL WRITEDIR_NOCONV(ICOUNT,IER)
- END IF
- CALL CLOSE_BULLDIR
- ELSE IF (CMD_TYPE.EQ.4) THEN
- CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BULL_DELETE)
- CALL LIB$MOVC3(4,%REF(BUFFER(9:9)),IMMEDIATE)
- DESCRIP_TEMP = BUFFER(13:ILEN)
- FOLDER1 = FOLDER
- FOLDER_NUMBER = -1
- CALL SELECT_FOLDER(.FALSE.,IER)
- CALL OPEN_BULLDIR
- CALL READDIR(BULL_DELETE,IER)
- IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN
- CALL CLOSE_BULLDIR
- BUFFER = 'ERROR: Cannot find message to delete.'
- CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
- GO TO 1000
- ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM
- & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
- CALL CLOSE_BULLDIR
- BUFFER = 'ERROR: Insufficient privileges to delete message.'
- CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
- GO TO 1000
- END IF
- CALL REMOVE_ENTRY
- & (BULL_DELETE,BULL_DELETE,BULL_DELETE,IMMEDIATE)
- CALL CLOSE_BULLDIR
- 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(BUFFER(5:5)),ICOUNT)
- FOLDER_FILE =
- & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
- 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)
- END DO
- CALL CLOSE_BULLFIL
- CALL CLOSE_BULLDIR
- 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_BULLDIR
- CALL LIB$MOVC3(53,%REF(BUFFER(5:5)),%REF(DESCRIP_TEMP))
- CALL LIB$MOVC3(4,%REF(BUFFER(58:58)),ICOUNT)
- CALL READDIR(ICOUNT,IER)
- IF (IER.EQ.ICOUNT.OR.DESCRIP_TEMP.NE.DESCRIP) THEN
- CALL CLOSE_BULLDIR
- BUFFER = 'ERROR: Cannot find message to replace.'
- CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
- GO TO 1000
- END IF
- CALL LIB$MOVC3(53,%REF(BUFFER(62:62)),%REF(DESCRIP))
- CALL LIB$MOVC3(4,%REF(BUFFER(115:115)),%REF(MSGTYPE))
- CALL LIB$MOVC3(11,%REF(BUFFER(119:119)),%REF(EXDATE))
- CALL LIB$MOVC3(11,%REF(BUFFER(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_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)
- 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_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)
- 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_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:5)),BULL_DELETE)
- DESCRIP_TEMP = BUFFER(9:61)
- FOLDER1 = FOLDER
- FOLDER_NUMBER = -1
- CALL SELECT_FOLDER(.FALSE.,IER)
- CALL OPEN_BULLDIR
- CALL READDIR(BULL_DELETE,IER)
- IF (IER.EQ.BULL_DELETE.OR.DESCRIP.NE.DESCRIP_TEMP) THEN
- CALL CLOSE_BULLDIR
- BUFFER = 'ERROR: Cannot find message to undelete.'
- CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
- GO TO 1000
- ELSE IF (USERNAME.NE.FROM.AND.FROM_SAVE(UNIT_INDEX).NE.FROM
- & .AND.FOLDER_OWNER.NE.USERNAME.AND..NOT.SETPRV_PRIV()) THEN
- CALL CLOSE_BULLDIR
- BUFFER = 'ERROR: Insufficient privileges to undelete message.'
- CALL WRITE_CHAN(TRIM(BUFFER),BUFFER,UNIT_INDEX,IER)
- GO TO 1000
- END IF
- CALL LIB$MOVC3(11,%REF(BUFFER(62:62)),%REF(EXDATE))
- CALL LIB$MOVC3(11,%REF(BUFFER(73:73)),%REF(EXTIME))
- 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
- FOLDER_FILE =
- & FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//FOLDER
- CALL OPEN_BULLDIR_SHARED
- CALL READDIR(0,IER)
- CALL GET_NEWEST_MSG(%REF(BUFFER(5: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:5)),FLAG)
- FOLDER1 = FOLDER
- FOLDER_NUMBER = -1
- CALL SELECT_FOLDER(.FALSE.,IER)
- CALL OPEN_BULLUSER_SHARED
- 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_BULLUSER
- ELSE IF (CMD_TYPE.EQ.15) THEN ! Broadcast message
- CALL LIB$MOVC3(4,%REF(BUFFER(5:5)),BLENGTH)
- CALL LIB$MOVC3(4,%REF(BUFFER(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(BUFFER(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(BUFFER(13:13)),ALL)
- CALL LIB$MOVC3(4,%REF(BUFFER(17:17)),CLUSTER)
- CALL LIB$FREE_VM(BRDCST_LIMIT,SCRATCH(UNIT_INDEX))
- IF (ILEN.GT.20) THEN
- CALL LIB$MOVC3(4,%REF(BUFFER(21:21)),FOLDER_NUMBER)
- FOLDER = BUFFER(25:)
- GO TO 100
- ELSE IF (SETPRV_PRIV().OR.OPER_PRIV()) THEN
- CALL BROADCAST(ALL,CLUSTER)
- END IF
- END IF
- END IF
-
-1000 PROCPRIV(1) = BULLCP_PRIV(1)
- PROCPRIV(2) = BULLCP_PRIV(2)
-
- 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),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*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.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)
- END IF
-
- IF (LAST_SYS_BTIM(1,FOLDER_NUMBER+1).EQ.0.AND.
- & LAST_SYS_BTIM(2,FOLDER_NUMBER+1).EQ.0.AND.
- & LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.
- & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN
- DIFF1 = -1
- ELSE IF (LAST_SYS_SAVE(1,UNIT_INDEX).NE.0.AND.
- & LAST_SYS_SAVE(2,UNIT_INDEX).NE.0) THEN
- DIFF1 = COMPARE_BTIM(LAST_SYS_BTIM(1,FOLDER_NUMBER+1),
- & LAST_SYS_SAVE(1,UNIT_INDEX))
- ELSE
- DIFF1 = 0
- END IF
-
- IF (DIFF1.LT.0) THEN
- 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 IF
-
- IF (DIFF1.LT.0.OR.DIFF.LT.0) 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
-
- ENTRY SAVE_LAST_SYS_BTIM(UNIT_INDEX)
-
- CALL SYS_BINTIM('-',SAVE_BTIM) ! Get today's date
-
- LAST_SYS_SAVE(1,UNIT_INDEX) = SAVE_BTIM(1)
- LAST_SYS_SAVE(2,UNIT_INDEX) = SAVE_BTIM(2)
-
- RETURN
-
- END
-
-
-
-
- SUBROUTINE CHECK_BULLETIN_PRIV(USERNAME)
-
- IMPLICIT INTEGER (A-Z)
-
- 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) THEN
- PROCPRIV(1) = NEEDPRIV(1)
- PROCPRIV(2) = NEEDPRIV(2)
- END IF
- END IF
-
- RETURN
- END
-
-
-
- SUBROUTINE GETACC(ACCOUNT)
-C
-C SUBROUTINE GETACC
-C
-C FUNCTION:
-C To get account of present process.
-C OUTPUTS:
-C ACCOUNT - ACCOUNT owner of present process.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*(*) ACCOUNT ! Limit is 12 characters
-
- INCLUDE '($JPIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(LEN(ACCOUNT),JPI$_ACCOUNT,%LOC(ACCOUNT))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE GETSTS(STS)
-C
-C SUBROUTINE GETSTS
-C
-C FUNCTION:
-C To get status of present process. This tells if its a batch process.
-C OUTPUTS:
-C STS - Status word of present process.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($JPIDEF)'
-
- CALL INIT_ITMLST ! Initialize item list
- CALL ADD_2_ITMLST(4,JPI$_STS,%LOC(STS))
- CALL END_ITMLST(GETJPI_ITMLST) ! Get address of itemlist
-
- IER = SYS$GETJPIW(,,,%VAL(GETJPI_ITMLST),,,,) ! Get info
-
- RETURN
- END
-
-
-
-
-
- INTEGER FUNCTION LNM_MODE_EXEC(FAB,RAB,LUN)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($FABDEF)'
- INCLUDE '($RABDEF)'
-
- RECORD /FABDEF/ FAB
- RECORD /RABDEF/ RAB
-
- FAB.FAB$B_ACMODES = ISHFT(1,FAB$V_LNM_MODE)
-
- STATUS = SYS$OPEN(FAB)
- IF (STATUS) STATUS = SYS$CONNECT(RAB)
-
- LNM_MODE_EXEC = STATUS
-
- END
-
-
-
- INTEGER FUNCTION REC_LOCK(IER)
-
- INCLUDE '($FORIOSDEF)'
-
- DATA INIT /.TRUE./
-
- IF (INIT) THEN
- REC_LOCK = 1
- INIT = .FALSE.
- ELSE
- IF (IER.EQ.FOR$IOS_SPERECLOC) THEN
- CALL WAIT_SEC('01')
- REC_LOCK = 1
- ELSE
- REC_LOCK = 0
- INIT = .TRUE.
- END IF
- END IF
-
- RETURN
- END
-
- INTEGER FUNCTION TRIM(INPUT)
- CHARACTER*(*) INPUT
- DO TRIM=LEN(INPUT),1,-1
- IF (INPUT(TRIM:TRIM).NE.' '.AND.INPUT(TRIM:TRIM).NE.CHAR(0)) RETURN
- END DO
- RETURN
- END
-
- SUBROUTINE SYS_GETMSG(IER)
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER*80 MESSAGE
-
- CALL LIB$SYS_GETMSG(IER,,MESSAGE)
- WRITE (6,'(A)') MESSAGE
-
- RETURN
- END
-
-
-
- SUBROUTINE HELP(LIBRARY)
-
- IMPLICIT INTEGER (A-Z)
-
- 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 = ' '
-
- CALL OUTPUT_HELP(BULL_PARAMETER(1:LEN_P),LIBRARY)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE GET_NODE_INFO
-C
-C SUBROUTINE GET_NODE_INFO
-C
-C FUNCTION: Gets local node name and obtains node names from
-C command line.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- EXTERNAL CLI$_ABSENT
-
- COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
- & NODE_ERROR,POINT_NODE
- CHARACTER*32 NODES(10)
- LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
-
- CHARACTER LOCAL_NODE*32,NODE_TEMP*256,PASSWORD*31,TEMP_USER*12
-
- NODE_ERROR = .FALSE.
-
- LOCAL_NODE_FOUND = .FALSE.
- CALL LIB$SYS_TRNLOG('SYS$NODE',L_NODE,LOCAL_NODE)
- L_NODE = L_NODE - 2 ! Remove '::'
- IF (LOCAL_NODE(1:1).EQ.'_') THEN
- LOCAL_NODE = LOCAL_NODE(2:)
- L_NODE = L_NODE - 1
- END IF
-
- 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) THEN
- NODES(NODE_NUM) = NODE_TEMP(1:COMMA-1)
- NODE_TEMP = NODE_TEMP(COMMA+1:)
- ELSE
- NODES(NODE_NUM) = NODE_TEMP
- NODE_TEMP = ' '
- END IF
- NLEN = TRIM(NODES(NODE_NUM))
- I = INDEX(NODES(NODE_NUM),'::')
- TEMP_USER = ' '
- IF (I.GT.0.AND.NLEN-I.EQ.1) THEN
- 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)
- POINT_NODE = NODE_NUM
- IER = 1
- DO WHILE (IER.NE.0)
- WRITE(6,'('' Enter password for node '',2A)')
- & NODES(NODE_NUM)(:NLEN),CHAR(10)
- CALL GET_INPUT_NOECHO(PASSWORD)
- IF (TRIM(PASSWORD).EQ.0) THEN
- DO WHILE (NODE_NUM.GT.0)
- CLOSE(UNIT=9+NODE_NUM)
- NODE_NUM = NODE_NUM - 1
- END DO
- NODE_ERROR = .TRUE.
- RETURN
- END IF
- OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//
- & '"'//TEMP_USER(:TRIM(TEMP_USER))//' '//
- & PASSWORD(:TRIM(PASSWORD))//'"::'//'"TASK=BULLETIN"',
- & 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 IF
- 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_NUM
- OPEN (UNIT=9+NODE_NUM,NAME=NODES(NODE_NUM)(:NLEN)//
- & '::"TASK=BULLETIN"',ACCESS='SEQUENTIAL',FORM='FORMATTED',
- & CARRIAGECONTROL='NONE',TYPE='NEW',IOSTAT=IER)
- IF (IER.NE.0) THEN
- DO WHILE (NODE_NUM.GT.0)
- CLOSE(UNIT=9+NODE_NUM)
- NODE_NUM = NODE_NUM - 1
- END DO
- NODE_ERROR = .TRUE.
- RETURN
- END IF
- END IF
- END DO
- END DO
- ELSE
- LOCAL_NODE_FOUND = .TRUE.
- END IF
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/bulletin9.for b/decus/vax91b/bulletin-net91b/bulletin9.for
deleted file mode 100644
index 072dfb844c105001749011e0fdce05051da95685..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/bulletin9.for
+++ /dev/null
@@ -1,1802 +0,0 @@
-C
-C BULLETIN9.FOR, Version 6/18/91
-C Purpose: Contains subroutines for the bulletin board utility program.
-C Environment: VAX/VMS
-C Usage: Invoked by the BULLETIN command.
-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 DELETE_NODE
-C
-C SUBROUTINE DELETE_NODE
-C
-C FUNCTION: Deletes files sent via ADD/NODES at remote hosts.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
- & NODE_ERROR,POINT_NODE
- CHARACTER*32 NODES(10)
- LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
-
- CHARACTER INLINE*80
-
- CALL GET_NODE_INFO
-
- IF (NODE_ERROR) GO TO 940
-
- IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN
- WRITE (6,'('' ERROR: Cannot specify local node.'')')
- GO TO 999
- END IF
-
- IER = CLI$GET_VALUE('SUBJECT',DESCRIP)
-
- DO POINT_NODE=1,NODE_NUM ! Write out command to nodes
- NLEN = TRIM(NODES(POINT_NODE)) ! Length of node name
- INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))
- WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE
- READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE
- IF (INLINE.EQ.'END') THEN
- WRITE (6,'('' Message successfully deleted from node '',A)')
- & NODES(POINT_NODE)
- ELSE
- WRITE (6,'('' Error while deleting message to node '',A)')
- & NODES(POINT_NODE)
- WRITE (6,'(A)') INLINE
- END IF
- END DO
-
- GO TO 999
-
-910 WRITE (6,1010)
- GO TO 999
-
-940 WRITE (6,1015) NODES(POINT_NODE)
-
-999 DO WHILE (NODE_NUM.GT.0)
- CLOSE(UNIT=9+NODE_NUM)
- NODE_NUM = NODE_NUM - 1
- END DO
-
- RETURN
-
-1010 FORMAT (' ERROR: Deletion aborted.')
-1015 FORMAT (' ERROR: Unable to reach node ',A)
-
- END
-
-
-
-
- SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME)
-C
-C SUBROUTINE SET_FOLDER_FLAG
-C
-C FUNCTION: Sets or clears specified flag for folder
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*(*) FLAGNAME
-
- IF (REMOTE_SET.EQ.3) THEN
- WRITE (6,'('' ERROR: Command invalid for folder.'')')
- ELSE IF (FLAG.EQ.7.AND..NOT.SETPRV_PRIV()) THEN
- WRITE (6,'('' ERROR: Privileges required for this command.'')')
- ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- CALL OPEN_BULLFOLDER ! Open folder file
-
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
-
- IF (SETTING) THEN
- FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG)
- ELSE
- FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG)
- END IF
-
- CALL REWRITE_FOLDER_FILE
-
- CALL CLOSE_BULLFOLDER
-
- WRITE (6,'(1X,A,'' has been modified for folder.'')')
- & FLAGNAME
- ELSE
- WRITE (6,'(1X,'' You are not authorized to modify '',A)')
- & FLAGNAME//'.'
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT)
-C
-C SUBROUTINE SET_FOLDER_EXPIRE_LIMIT
-C
-C FUNCTION: Sets folder expiration limit.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLFILES.INC'
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- IF (REMOTE_SET.EQ.3) THEN
- WRITE (6,'('' ERROR: Command invalid for folder. '')')
- ELSE IF (LIMIT.LT.0) THEN
- WRITE (6,'('' ERROR: Invalid expiration length specified.'')')
- ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
- CALL OPEN_BULLFOLDER ! Open folder file
-
- CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
-
- F_EXPIRE_LIMIT = LIMIT
-
- CALL REWRITE_FOLDER_FILE
-
- CALL CLOSE_BULLFOLDER
- WRITE (6,'('' Folder expiration date modified.'')')
- ELSE
- WRITE (6,'('' You are not allowed to modify folder.'')')
- END IF
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE MERGE
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE
-
- ENTRY INITIALIZE_MERGE(IER1)
-
- DO WHILE (FILE_LOCK(IER1,IER2))
- OPEN (UNIT=24,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
- & //'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED',
- & RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
- & ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
- & KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
- END DO
-
- IF (IER1.NE.0) RETURN
-
- NBULL = 0
-
- WRITE(24,IOSTAT=IER1) BULLDIR_HEADER
- CALL CONVERT_HEADER_FROMBIN
-
- TO_POINTER = 1
-
- RETURN
-
- ENTRY ADD_MERGE_TO(IER1)
-
- IER1 = 0
-
- DO WHILE (IER1.EQ.0)
-
- BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY
-
- CALL READDIR(TO_POINTER,IER)
-
- DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM)
- IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN
- BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE
- CALL CONVERT_ENTRY_FROMBIN
- RETURN
- END IF
-
- NBULL = NBULL + 1
- MSG_NUM = NBULL
-
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY
-
- NEWEST_DATE = DATE
- NEWEST_TIME = TIME
-
- TO_POINTER = TO_POINTER + 1
-
- BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE
- END DO
-
- CLOSE (UNIT=24)
-
- RETURN
-
- ENTRY ADD_MERGE_FROM(IER1)
-
- NEWEST_DATE = DATE
- NEWEST_TIME = TIME
-
- DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)
- IF (DIFF.GT.0) THEN
- NEWEST_EXDATE = EXDATE
- NEWEST_EXTIME = EXTIME
- ELSE IF (DIFF.EQ.0) THEN
- DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)
- IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME
- END IF
-
- IF ((SYSTEM.AND.4).EQ.4) THEN
- SHUTDOWN = SHUTDOWN + 1
- SHUTDOWN_DATE = DATE
- SHUTDOWN_TIME = TIME
- END IF
-
- BLOCK = NBLOCK - LENGTH
-
- NBULL = NBULL + 1
- MSG_NUM = NBULL
-
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY
-
- RETURN
-
- ENTRY ADD_MERGE_REST(IER1)
-
- CALL UPDATE_LOGIN(.TRUE.)
-
- DO WHILE (IER1.EQ.0)
-
- CALL READDIR(TO_POINTER,IER)
- IF (TO_POINTER+1.NE.IER) THEN
- READ (24,KEYID=0,KEY=0,IOSTAT=IER1)
- CALL CONVERT_HEADER_TOBIN
- REWRITE(24,IOSTAT=IER1) BULLDIR_HEADER
- IF (IER1.EQ.0) THEN
- CLOSE (UNIT=24,DISPOSE='KEEP')
- CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
- & '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR')
- ELSE
- CLOSE (UNIT=24)
- END IF
- RETURN
- END IF
-
- NBULL = NBULL + 1
- MSG_NUM = NBULL
-
- CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
- WRITE(24,IOSTAT=IER1) BULLDIR_ENTRY
-
- NEWEST_DATE = DATE
- NEWEST_TIME = TIME
-
- TO_POINTER = TO_POINTER + 1
- END DO
-
- CLOSE (UNIT=24)
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SET_NOKEYPAD
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID
-
- COMMON /KEYPAD/ KEYPAD_MODE
-
- INCLUDE '($SMGDEF)'
-
- KEYPAD_MODE = 0
-
- TERM = SMG$M_KEY_TERMINATE
-
- IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)
-
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',)
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE SET_KEYPAD
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID
-
- COMMON /KEYPAD/ KEYPAD_MODE
-
- INCLUDE '($SMGDEF)'
-
- KEYPAD_MODE = 1
-
- TERM = SMG$M_KEY_TERMINATE
-
- IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)
-
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD')
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM,
- & 'SHOW KEYPAD/PRINT',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM,
- & 'SHOW FOLDER/FULL',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',)
- IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',)
-
- RETURN
- END
-
-
-
- SUBROUTINE SHOW_KEYPAD(LIBRARY)
-
- IMPLICIT INTEGER (A-Z)
- EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUT
- CHARACTER*(*) LIBRARY
-
- INCLUDE '($HLPDEF)'
-
- IF (CLI$PRESENT('PRINT')) THEN
- OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT',
- & IOSTAT=IER)
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')')
- ELSE
- CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD'
- & ,LIBRARY,HLP$M_HELP)
- CLOSE (UNIT=8,DISP='PRINT/DELETE')
- END IF
- ELSE
- CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD'
- & ,LIBRARY,HLP$M_HELP)
- END IF
-
- RETURN
- END
-
- INTEGER FUNCTION PRINT_OUTPUT(INPUT)
- IMPLICIT INTEGER (A-Z)
- CHARACTER*(*) INPUT
- WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT))
- IF (IER.EQ.0) PRINT_OUTPUT = 1
- RETURN
- END
-
-
-
- SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY)
-C
-C SUBROUTINE OUTPUT_HELP
-C
-C FUNCTION:
-C To create interactive help session. Prompting is enabled.
-C INPUTS:
-C PARAMETER - Character string. Optional input parameter
-C containing a list of help keys.
-C LIBRARY - Character string. Name of help library.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($LBRDEF)'
-
- COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN
- COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO
- CHARACTER*80 HELP_INPUT
-
- COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT
- CHARACTER*20 KEY(10)
- DIMENSION KEYL(10)
-
- EXTERNAL PUT_OUTPUT
-
- CHARACTER*(*) LIBRARY,PARAMETER
-
- CHARACTER*80 PROMPT
-
- DATA DISPLAY_ID/0/,KEYBOARD_ID/0/
-
- IF (KEYBOARD_ID.EQ.0) THEN
- IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)
- IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)
- END IF
-
- CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN) ! Trim input
-
- CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ) ! Init library read
- CALL LBR$OPEN(LINDEX,LIBRARY) ! Specify library name
-
- DO I=1,10 ! Initialize key lengths
- KEYL(I) = 0
- END DO
-
- NKEY = 0 ! Number of help keys
-
- DO WHILE (1) ! Do until CTRL-Z entered or no more keys
-
- HELP_PAGE = 0 ! Init line counter
- NEED_ERASE = .TRUE. ! Need to erase screen
-
- OLD_NKEY = NKEY ! Save old key count
- EXACT = .TRUE. ! Exact key match
-
- DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND.
- & HELP_INPUT(:1).NE.'?')
- ! Break input into keys
- NKEY = NKEY + 1 ! Increment key counter
-
- DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0)
- HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN) ! Strip spaces
- HELP_INPUT_LEN = HELP_INPUT_LEN - 1 ! at start of input
- END DO
-
- NEXT_KEY = 2
-
- DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN ! Search for
- & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' ' ! space or
- & .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/') ! backslash
- NEXT_KEY = NEXT_KEY + 1 ! indicating start of next key
- END DO
-
- IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN ! Found the last key
- KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN) ! Key string
- KEYL(NKEY) = HELP_INPUT_LEN ! Key length
- HELP_INPUT_LEN = 0
- ELSE ! Found the next key
- KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1)
- HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN)
- KEYL(NKEY) = NEXT_KEY - 1
- HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1
- END IF
- END DO
- HELP_INPUT_LEN = 0
- IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,, ! Display help
- & KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)),
- & KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)),
- & KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)),
- & KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10)))
-
- IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1
- ! IER = 0 special case means input given to full screen prompt
-
- IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN ! If not exact match
- DO I=OLD_NKEY+1,NKEY ! then don't update
- KEYL(I) = 0 ! new keys
- END DO
- NKEY = OLD_NKEY
- END IF
-
- IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics?
- KEYL(NKEY) = 0 ! Back up one key level
- NKEY = NKEY - 1
- END IF
-
- DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0)
- IF (NKEY.EQ.0) THEN ! If top level, prompt for topic
- IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
- & HELP_INPUT,'Topic? ',HELP_INPUT_LEN)
- ELSE ! If not top level, prompt for subtopic
- LPROMPT = 0 ! Create subtopic prompt line
- DO I=1,NKEY ! Put spaces in between keys
- PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' '
- LPROMPT = LPROMPT + KEYL(I) + 1
- END DO
- PROMPT = PROMPT(:LPROMPT)//'Subtopic? '
- LPROMPT = LPROMPT + 10
- IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
- & HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN)
- END IF
- CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN)
- IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN ! If RETURN entered
- KEYL(NKEY) = 0 ! Back up one key level
- NKEY = NKEY - 1
- END IF
- END DO
-
- IF (.NOT.IER.OR.NKEY.LT.0) THEN ! If CTRL-Z above top level,
- CALL LIB$PUT_OUTPUT(' ') ! Skip line
- CALL LBR$CLOSE(LINDEX) ! then close library,
- RETURN ! and end help session.
- END IF
-
- END DO
-
- END
-
-
-
- INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL)
-C
-C FUNCTION PUT_OUTPUT
-C
-C FUNCTION:
-C Output routine for input from LBR$GET_HELP. Displays
-C help text on terminal with full screen prompting.
-C INPUTS:
-C INPUT - Character string. Line of input text.
-C INFO - Longword. Contains help flag bits.
-C DATA - Longword. Not presently used.
-C LEVEL - Longword. Contains current key level.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE '($HLPDEF)'
-
- COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT
- CHARACTER*20 KEY(10)
- DIMENSION KEYL(10)
-
- COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN
- COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO
- CHARACTER*80 HELP_INPUT
-
- COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
-
- CHARACTER INPUT*(*)
-
- CHARACTER SPACES*20
- DATA SPACES /' '/
-
- OTHERINFO = INFO.AND.HLP$M_OTHERINFO
-
- IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN ! Key cannot be found
- NEED_ERASE = .FALSE. ! Don't erase screen
- IF (HELP_PAGE.EQ.0) THEN ! If first line of help text
- DO I=OLD_NKEY+1,NKEY ! remove any new keys that
- KEYL(I) = 0 ! were inputted, as they are
- END DO ! not valid, as no match
- NKEY = OLD_NKEY ! could be found.
- END IF
- ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND.
- & LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND.
- & %LOC(INPUT).NE.0) THEN ! If text contains key names
- ! Update if not wildcard search and they are new keys
- IF (KEYL(LEVEL).GT.0) THEN ! If key already updated
- EXACT = .FALSE. ! Must be more than one match possible
- END IF ! so indicate not exact match.
- START_KEY = 1 ! String preceeding spaces.
- DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ')
- START_KEY = START_KEY + 1
- END DO
- KEY(LEVEL) = INPUT(START_KEY:) ! Store new key
- CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL)) ! & key length
- ELSE IF (HELP_PAGE.EQ.0) THEN ! If first line of text,
- DO I=OLD_NKEY+1,NKEY ! remove any new keys that
- KEYL(I) = 0 ! were just inputted, allowing
- END DO ! this routine to fill them.
- END IF
-
- IF (NEED_ERASE) THEN ! Need to erase screen?
- IER = LIB$ERASE_PAGE(1,1) ! i.e. start of new topic.
- NEED_ERASE = .FALSE.
- END IF
-
- HELP_PAGE = HELP_PAGE + 1 ! Increment screen counter
- IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN ! End of page?
- HELP_PAGE = 0 ! Reinitialize screen counter
- CALL LIB$PUT_OUTPUT(' ') ! Skip line and prompt for next screen
- IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
- & HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN)
- CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN) ! Trim input
- IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN ! CTRL-Z or Text input?
- EXACT = .TRUE. ! If more than one match was found and being
- ! displayed, text input specifies that the
- ! current displayed match is desired.
- PUT_OUTPUT = 0 ! Stop any more of current help display.
- ELSE ! Else if RETURN entered
- IER = LIB$ERASE_PAGE(1,1) ! Erase display
- NSPACES = LEVEL*2 ! Number of spaces to indent output
- IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2
- ! Key name lines are indented 2 less than help description.
- IF (NSPACES.GT.0) THEN ! Add spaces if present to output
- PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)
- ELSE ! Else just output text.
- PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)
- END IF
- HELP_PAGE = 1 ! Increment page counter.
- END IF
- ELSE ! Else if not end of page
- NSPACES = LEVEL*2 ! Just output text line
- IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2
- IF (NSPACES.GT.0) THEN
- PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)
- ELSE
- PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)
- END IF
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE SHOW_VERSION
-
- IMPLICIT INTEGER (A-Z)
-
- CHARACTER VERSION*10,DATE*23
-
- CALL READ_HEADER(VERSION,DATE)
-
- WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION))
-
- WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE))
-
- RETURN
- END
-
-
-
-
- SUBROUTINE FULL_DIR(INDEX_COUNT)
-C
-C Add INDEX command to BULLETIN, display directories of ALL
-C folders. Added per request of a faculty member for his private
-C board. Changes to BULLETIN.FOR should be fairly obvious.
-C
-C Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2)
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
- INCLUDE 'BULLFILES.INC'
- INCLUDE 'BULLFOLDER.INC'
- INCLUDE 'BULLUSER.INC'
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /TAGS/ BULL_TAG,READ_TAG
-
- DATA FOLDER_Q1/0/
-
- BULL_POINT = 0
-
- IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART')
- & .AND.INDEX_COUNT.EQ.1) THEN
- INDEX_COUNT = 2
- DIR_COUNT = 0
- END IF
-
- IF (INDEX_COUNT.EQ.1) THEN
- CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM)
-
- FOLDER_Q = FOLDER_Q1
-
- SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')
- IF (SUBSCRIBE) THEN
- CALL NEWS_GET_SUBSCRIBE(0,F1_END)
- SUBNUM = 1
- CALL OPEN_BULLNEWS_SHARED
- ELSE
- CALL OPEN_BULLFOLDER_SHARED
- END IF
-
- NUM_FOLDERS = 0
- IER = 0
- DO WHILE (IER.EQ.0) ! Copy all bulletins from file
- IF (SUBSCRIBE) THEN
- IER = 1
- DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)
- CALL NEWS_GET_SUBSCRIBE(SUBNUM,F1_END)
- IF (SUBNUM.NE.0) THEN
- CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)
- IF (IER.NE.0) SUBNUM = -1
- END IF
- END DO
- IF (SUBNUM.EQ.0) IER = 1
- ELSE
- CALL READ_FOLDER_FILE_TEMP(IER)
- END IF
- IF (IER.EQ.0) THEN
- IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THEN
- FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))
- & //FOLDER1
- CALL CHECK_ACCESS
- & (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',
- & USERNAME,READ_ACCESS,-1)
- ELSE
- READ_ACCESS = 1
- END IF
- IF (READ_ACCESS) THEN
- NUM_FOLDERS = NUM_FOLDERS + 1
- CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
- END IF
- END IF
- END DO
-
- CALL CLOSE_BULLFOLDER ! We don't need file anymore
-
- FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header
- WRITE (6,1000)
- IF (SUBSCRIBE) THEN
- WRITE (6,1025)
- ELSE
- WRITE (6,1020)
- END IF
- DO J = 1,NUM_FOLDERS
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
- IF (SUBSCRIBE) THEN
- WRITE (6,1035) FOLDER1_DESCRIP(:72),F1_NBULL
- ELSE
- WRITE (6,1030) FOLDER1,F1_NBULL,
- & FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),46))
- END IF
- END DO
- WRITE (6,1060)
- FOLDER_Q = FOLDER_Q1 ! Init queue pointer to header
- INDEX_COUNT = 2
- DIR_COUNT = 0
- READ_TAG = .FALSE.
- IF (CLI$PRESENT('MARKED')) THEN
- READ_TAG = 1 + IBSET(0,1)
- ELSE IF (CLI$PRESENT('SEEN')) THEN
- READ_TAG = 1 + IBSET(0,2)
- ELSE IF (CLI$PRESENT('UNMARKED').OR.CLI$PRESENT
- & ('MARKED').EQ.%LOC(CLI$_NEGATED)) THEN
- READ_TAG = 1 + IBSET(0,1) + IBSET(0,3)
- ELSE IF (CLI$PRESENT('UNSEEN').OR.CLI$PRESENT
- & ('SEEN').EQ.%LOC(CLI$_NEGATED)) THEN
- READ_TAG = 1 + IBSET(0,2) + IBSET(0,3)
- END IF
- RETURN
- ELSE IF (INDEX_COUNT.EQ.2) THEN
- IF (DIR_COUNT.LE.0) THEN
- F1_NBULL = 0
- DIR_COUNT = 0
- DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0)
- NUM_FOLDERS = NUM_FOLDERS - 1
- CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
- IF (F1_NBULL.GT.0) THEN
- FOLDER_NUMBER = -1
- CALL SELECT_FOLDER(.FALSE.,IER)
- IF (.NOT.IER) F1_NBULL = 0
- END IF
- END DO
-
- IF (F1_NBULL.EQ.0) THEN
- WRITE (6,1050)
- INDEX_COUNT = 0
- RETURN
- END IF
- END IF
-
- IF (READ_TAG) THEN
- CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)
- END IF
-
- CALL DIRECTORY(DIR_COUNT)
- IF (DIR_COUNT.GT.0) RETURN
-
- IF (NUM_FOLDERS.GT.0) THEN
- WRITE (6,1040)
- ELSE
- INDEX_COUNT = 0
- END IF
- END IF
-
- RETURN
-
-1000 FORMAT (' The following folders are present'/)
-1020 FORMAT (' Name Count Description'/)
-1025 FORMAT (' Name',70X,'Count'/)
-1030 FORMAT (1X,A,1X,I6,1X,A)
-1035 FORMAT (1X,A,1X,I6)
-1040 FORMAT (' Type Return to continue to the next folder...')
-1050 FORMAT (' End of folder search.')
-1060 FORMAT (' Type Return to continue...')
-
- END
-
-
-
-
-
- SUBROUTINE SHOW_USER
-C
-C SUBROUTINE SHOW_USER
-C
-C FUNCTION: Shows information for specified users.
-C
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLUSER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /POINT/ BULL_POINT
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
- CHARACTER*64 BULL_PARAMETER
-
- COMMON /CTRLC_FLAG/ FLAG
-
- DIMENSION NOLOGIN_BTIM(2),START_BTIM(2)
-
- CHARACTER DATETIME*17
-
- DIMENSION LAST(2,FOLDER_MAX)
- INTEGER*2 LAST2(4,FOLDER_MAX)
- EQUIVALENCE (LAST,LAST2)
-
- ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')
- & .OR.CLI$PRESENT('LOGIN')
-
- SETPRV = SETPRV_PRIV() ! SETPRV_PRIV rewrites TEMP_USER
-
- IF (.NOT.ALL) THEN
- IER = CLI$GET_VALUE('USERNAME',TEMP_USER)
- IF (.NOT.IER) TEMP_USER = USERNAME
- END IF
-
- IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THEN
- WRITE (6,'('' ERROR: No privs to use command.'')')
- RETURN
- END IF
-
- CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)
-
- FOLDER_PRESENT = CLI$PRESENT('FOLDER')
-
- IF (FOLDER_PRESENT) THEN
- IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME)
- IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME
- NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1)
- & .GE.'a'.AND.FOLDER1_NAME(:1).LE.'z')
- IF (.NOT.NEWS) THEN
- CALL OPEN_BULLFOLDER_SHARED
- ELSE
- CALL OPEN_BULLNEWS_SHARED
- CALL LOWERCASE(FOLDER1_NAME)
- END IF
- CALL READ_FOLDER_FILE_KEYNAME_TEMP
- & (FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER)
- CALL CLOSE_BULLFOLDER
- IF (IER.NE.0) THEN
- WRITE (6,'('' ERROR: Folder not found.'')')
- RETURN
- END IF
- END IF
-
- SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START')
- IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN
- IF (.NOT.NEWS) THEN
- IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM)
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Invalid date specified.'')')
- RETURN
- END IF
- ELSE
- WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')')
- RETURN
- END IF
- ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN
- IF (NEWS) THEN
- IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P),
- & STARTMSG,,%VAL(1))
- IF (.NOT.IER) THEN
- WRITE (6,'('' ERROR: Invalid number specified.'')')
- RETURN
- END IF
- ELSE
- WRITE (6,'('' ERROR: /START not valid with folder.'')')
- RETURN
- END IF
- ELSE IF (SINCE) THEN
- IF (BULL_POINT.EQ.0) THEN
- WRITE (6,'('' ERROR: No current message.'')')
- RETURN
- ELSE IF (NEWS) THEN
- STARTMSG = BULL_POINT
- ELSE
- START_BTIM(1) = MSG_BTIM(1)
- START_BTIM(2) = MSG_BTIM(2)
- END IF
- ELSE IF (.NOT.NEWS) THEN
- CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM)
- ELSE
- STARTMSG = 1
- END IF
-
- CALL DISABLE_CTRL
- CALL DECLARE_CTRLC_AST
- IF (FOLDER_PRESENT) THEN
- CALL OPEN_BULLINF_SHARED
- IER = 0
- DO WHILE (IER.EQ.0.AND.FLAG.NE.1)
- IF (ALL) THEN
- DO WHILE (REC_LOCK(IER))
- READ (9,IOSTAT=IER) TEMP_USER,LAST
- END DO
- ELSE
- IF (NEWS) THEN
- LU = TRIM(TEMP_USER)
- TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU)))
- IF (LU.GT.1) THEN
- TEMP_USER(LU-1:LU-1) =
- & CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))
- ELSE
- TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2)))
- END IF
- END IF
- DO WHILE (REC_LOCK(IER))
- READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LAST
- END DO
- END IF
- UNLOCK 9
- IF (IER.EQ.0) THEN
- LU = TRIM(TEMP_USER)
- I = MAX(LU,2)
- DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7))
- I = I - 1
- END DO
- IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND.
- & BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN
- TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127)
- TEMP_USER(I-1:I-1) =
- & CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127)
- I = 0
- NEWSMSG = 1
- DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBER
- & .AND.NEWSMSG.LE.FOLDER_MAX)
- NEWSMSG = NEWSMSG + 1
- END DO
- IF (NEWSMSG.LE.FOLDER_MAX) THEN
- FOUND = LAST(2,NEWSMSG).GE.STARTMSG
- ELSE
- FOUND = .FALSE.
- END IF
- ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN
- FOUND = COMPARE_BTIM
- & (START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0
- ELSE
- FOUND = .FALSE.
- END IF
- IF (FOUND.AND.NEWS) THEN
- WRITE (6,'(1X,A,'' latest message read '',
- & I<LOG10(REAL(LAST(2,NEWSMSG)))+1>,''.'')')
- & TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG)
- ELSE IF (FOUND) THEN
- CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),)
- WRITE (6,'(1X,A,'' latest message read '',A,''.'')')
- & TEMP_USER(:TRIM(TEMP_USER)),DATETIME
- ELSE IF (.NOT.ALL) THEN
- WRITE (6,'('' User has never read or not subscribed'',
- & '' to specified folder.'')')
- END IF
- END IF
- IF (.NOT.ALL) THEN
- IF (IER.NE.0) THEN
- WRITE (6,'('' User info does not exist.'')')
- END IF
- IER = 2
- END IF
- END DO
- CALL CLOSE_BULLINF
- ELSE IF (.NOT.ALL) THEN
- CALL OPEN_BULLUSER_SHARED
- CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)
- IF (IER.EQ.0) THEN
- IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN
- WRITE (6,'('' NOLOGIN set for specified user.'')')
- ELSE
- CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)
- WRITE (6,'('' User last logged in at '',A,''.'')')
- & DATETIME
- END IF
- ELSE
- WRITE (6,'('' Entry for specified user not found.'')')
- END IF
- CALL CLOSE_BULLUSER
- ELSE
- CALL OPEN_BULLUSER_SHARED
- CALL READ_USER_FILE(IER)
- DO WHILE (IER.EQ.0.AND.FLAG.NE.1)
- CALL READ_USER_FILE(IER)
- IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.
- & TEMP_USER(:1).NE.'*') THEN
- IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)
- IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN
- WRITE (6,'('' NOLOGIN set for '',A,''.'')')
- & TEMP_USER(:TRIM(TEMP_USER))
- ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND.
- & COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THEN
- CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)
- WRITE (6,'(1X,A,'' last logged in at '',A,''.'')')
- & TEMP_USER(:TRIM(TEMP_USER)),DATETIME
- END IF
- END IF
- END DO
- CALL CLOSE_BULLUSER
- END IF
- CALL CANCEL_CTRLC_AST
- CALL ENABLE_CTRL
-
- RETURN
- END
-
-
-
-
- SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER)
-C
-C SUBROUTINE INIT_MESSAGE_ADD
-C
-C FUNCTION: Opens specified folder in order to add message.
-C
-C INPUTS:
-C IN_FOLDER - Character string containing folder name
-C IN_FROM - Character string containing name of owner of message.
-C If empty, the message is searched for either a
-C Reply-to: field or a From: field. If none, then
-C the owner of the process is used. If IN_FROM
-C ends with a %, it is assumed that it is simply
-C the prefix that should be when responding to the
-C address via MAIL. I.e. the PMDF interface sends
-C IN%, so when the From: field is found, the message
-C owner becomes IN%"from-address".
-C IN_DESCRIP - Character string containing subject of message.
-C If empty, the message is searched for a line
-C which starts with "Subj:" or "Subject:".
-C OUTPUTS:
-C IER - Error status. True if properly connected to folder.
-C False if folder not found.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLFILES.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- INCLUDE 'BULLDIR.INC'
-
- COMMON /BCP/ BULLCP
- LOGICAL BULLCP
-
- COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO
- CHARACTER*12 PROTOCOL
- DATA LPRO/0/
-
- COMMON /DIGEST/ LDESCR,FIRST_BREAK
-
- CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP
-
- COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP
- COMMON /MAIN_HEADER_INFO/ INEXDATE
- CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP
-
- COMMON /TEXT_PRESENT/ TEXT
-
- COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
- CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM
-
- COMMON /LAST_BUFFER/ OLD_BUFFER
- CHARACTER*(LINE_LENGTH) OLD_BUFFER
-
- COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ
- DATA OLD_BUFFER_FROM /.FALSE./, OLD_BUFFER_SUBJ /.FALSE./
-
- BULLCP = 1 ! Inhibit folder cleanup subprocess
-
- CALL OPEN_BULLFOLDER ! Get folder file
-
- CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER)
-
- CALL CLOSE_BULLFOLDER
-
- IF (IER.NE.0) THEN
- CALL ERRSNS(IDUMMY,IER)
- RETURN
- ELSE
- IER = 1
- END IF
-
- ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER)
-
- TEXT = .FALSE. ! No text written, as of yet
-
- FIRST_BREAK = .TRUE.
-
- IF (FOLDER_NUMBER.EQ.0) THEN ! If GENERAL folder
- FOLDER_SET = .FALSE. ! indicate it
- ELSE ! Else it's another folder
- FOLDER_SET = .TRUE. ! indicate it
- END IF
-
- FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
- & FOLDER ! set folder file names
-
- ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER)
-
- CALL OPEN_BULLDIR ! Open directory file
-
- CALL OPEN_BULLFIL ! Open data file
-
- CALL READDIR(0,IER1) ! Get NBLOCK
- IF (IER1.EQ.0) NBLOCK = 0 ! If new file, NBLOCK is 0
-
- NBLOCK = NBLOCK + 1
- LENGTH = NBLOCK ! Initialize line count
-
- LEN_FROM = TRIM(IN_FROM)
-
- IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN ! Just protocol
- PROTOCOL = IN_FROM(:LEN_FROM)//'"'
- LPRO = LEN_FROM + 1
- LEN_FROM = 0
- END IF
-
- IF (LEN_FROM.GT.0) THEN
- INFROM = IN_FROM
- IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
- CALL STORE_FROM(INFROM,LEN_FROM)
- ELSE IF (INDEX(INFROM,'%"').GT.0) THEN ! Store any protocol
- LPRO = INDEX(INFROM,'%"') + 1
- PROTOCOL = INFROM(:LPRO)
- END IF
- LEN_DESCRP = TRIM(IN_DESCRIP)
- IF (LEN_DESCRP.GT.0) THEN
- INDESCRIP = IN_DESCRIP
- IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
- CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
- END IF
- ELSE
- DESCRIP = ' '
- END IF
- ELSE
- OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR',
- & FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1)
- IF (IER1.NE.0) THEN
- OPEN (UNIT=3,STATUS='SCRATCH',FILE='BULL.SCR',
- & FORM='FORMATTED',RECL=LINE_LENGTH)
- END IF
- SAVE_IN_DESCRIP = IN_DESCRIP
- SAVE_IN_FROM = ' '
- END IF
-
- OLD_BUFFER = ' '
-
- OLD_BUFFER_SUBJ = .FALSE.
- OLD_BUFFER_FROM = .FALSE.
-
- INEXDATE = .FALSE.
-
- RETURN
- END
-
-
-
- SUBROUTINE WRITEOUT_STORED
-
- CHARACTER*255 BUFFER
-
- REWIND (UNIT=3)
-
- IER = 0
- DO WHILE (IER.EQ.0)
- READ (3,'(A)',IOSTAT=IER) BUFFER
- IF (IER.EQ.0) THEN
- CALL WRITE_MESSAGE_LINE(BUFFER)
- END IF
- END DO
-
- CLOSE (UNIT=3)
-
- RETURN
- END
-
-
-
- SUBROUTINE WRITE_MESSAGE_LINE(BUFFER)
-C
-C SUBROUTINE WRITE_MESSAGE_LINE
-C
-C FUNCTION: Writes one line of message into folder.
-C
-C INPUTS:
-C BUFFER - Character string containing line to be put into message.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO
- CHARACTER*12 PROTOCOL
-
- COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP
- COMMON /MAIN_HEADER_INFO/ INEXDATE
- CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP
-
- COMMON /DIGEST/ LDESCR,FIRST_BREAK
- DATA FIRST_BREAK/.TRUE./
-
- COMMON /TEXT_PRESENT/ TEXT
-
- COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
- CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM
-
- CHARACTER*(*) BUFFER
-
- COMMON /LAST_BUFFER/ OLD_BUFFER
- CHARACTER*(LINE_LENGTH) OLD_BUFFER
-
- COMMON /OLD_BUFFER/ OLD_BUFFER_FROM,OLD_BUFFER_SUBJ
-
- COMMON /DATE/ DATE_LINE
- CHARACTER*(LINE_LENGTH) DATE_LINE
-
- CHARACTER*23 TODAY
-
- LEN_BUFFER = TRIM(BUFFER)
-
- IF (LEN_FROM.EQ.0) THEN
- WRITE (3,'(A)') BUFFER(:LEN_BUFFER)
- IF (OLD_BUFFER_FROM.AND.((BUFFER(:1).EQ.' '.AND.
- & LEN_BUFFER.GT.1).OR.INDEX(BUFFER,': ').EQ.0)) THEN
- SAVE_IN_FROM =
- & SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER(:LEN_BUFFER)
- RETURN
- ELSE IF (OLD_BUFFER_SUBJ.AND.((BUFFER(:1).EQ.' '.AND.
- & LEN_BUFFER.GT.1).OR.INDEX(BUFFER,': ').EQ.0)) THEN
- INDESCRIP =
- & INDESCRIP(:TRIM(INDESCRIP))//BUFFER(:LEN_BUFFER)
- LDESCR = LDESCR + LEN_BUFFER
- RETURN
- ELSE IF (BUFFER(:5).EQ.'From:') THEN
- IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)
- OLD_BUFFER_FROM = .TRUE.
- OLD_BUFFER_SUBJ = .FALSE.
- RETURN
- ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN
- LDESCR = LEN_BUFFER - 9
- INDESCRIP = BUFFER(10:)
- OLD_BUFFER_SUBJ = .TRUE.
- OLD_BUFFER_FROM = .FALSE.
- RETURN
- ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN
- IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)
- OLD_BUFFER_FROM = .TRUE.
- OLD_BUFFER_SUBJ = .FALSE.
- RETURN
- ELSE IF (LEN_BUFFER.EQ.0) THEN
- IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM)
- LEN_FROM = TRIM(SAVE_IN_FROM)
- IF (LEN_FROM.GT.0) THEN
- OLD_BUFFER_FROM = .FALSE.
- INFROM = SAVE_IN_FROM
- IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
- CALL STORE_FROM(INFROM,LEN_FROM)
- ELSE IF (INDEX(INFROM,'%"').GT.0) THEN
- LPRO = INDEX(INFROM,'%"') + 1
- PROTOCOL = INFROM(:LPRO)
- END IF
- IF (LDESCR.GT.0) THEN
- LEN_DESCRP = LDESCR
- CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
- ELSE
- LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)
- IF (LEN_DESCRP.GT.0) THEN
- INDESCRIP = SAVE_IN_DESCRIP
- IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
- CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
- END IF
- ELSE
- DESCRIP = ' '
- END IF
- END IF
- CALL WRITEOUT_STORED
- END IF
- END IF
- OLD_BUFFER_FROM = .FALSE.
- OLD_BUFFER_SUBJ = .FALSE.
- RETURN
- END IF
- IF (BTEST(FOLDER_FLAG,5)) THEN
- IF (INDEX(BUFFER,'-------------').EQ.1) THEN
- BREAK = .TRUE.
- DO I=1,LEN_BUFFER
- IF (BUFFER(I:I).NE.'-') BREAK = .FALSE.
- END DO
- ELSE
- BREAK = .FALSE.
- END IF
- IF (BREAK) THEN
- IF (.NOT.FIRST_BREAK) THEN
- CALL FINISH_MESSAGE_ADD
- CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER)
- ELSE
- FIRST_BREAK = .FALSE.
- END IF
- LFROM = 0
- LDESCR = 0
- RETURN
- ELSE IF (.NOT.FIRST_BREAK) THEN
- IF (LDESCR.EQ.0) THEN
- IF (BUFFER(:9).EQ.'Subject: ') THEN
- LDESCR = LEN_BUFFER - 9
- CALL STORE_DESCRP(BUFFER(10:),LDESCR)
- IF (LFROM.EQ.0) THEN
- LFROM = LEN_FROM
- CALL STORE_FROM(INFROM,LFROM)
- END IF
- ELSE IF (BUFFER(:6).EQ.'From: ') THEN
- LFROM = LEN_BUFFER - 6
- IF (LFROM.LE.0) THEN
- LFROM = TRIM(SAVE_IN_FROM)
- IF (LPRO.GT.0) THEN
- LFROM = LFROM + LPRO + 1
- CALL STORE_FROM(PROTOCOL(:LPRO)//
- & SAVE_IN_FROM//'"',LFROM)
- ELSE
- CALL STORE_FROM(SAVE_IN_FROM,LFROM)
- END IF
- ELSE IF (LPRO.GT.0) THEN
- LFROM = LFROM + LPRO + 1
- CALL STORE_FROM(PROTOCOL(:LPRO)//
- & BUFFER(7:LEN_BUFFER)//'"',LFROM)
- ELSE
- CALL STORE_FROM(BUFFER(7:),LFROM)
- END IF
- END IF
- RETURN
- END IF
- ELSE
- RETURN
- END IF
- END IF
-
- IF (LEN_BUFFER.EQ.0) THEN ! If empty line
- CALL STORE_BULL(1,' ',NBLOCK) ! just store one space
- ELSE
- IF (LEN_DESCRP.EQ.0) THEN
- IF (BUFFER(:9).EQ.'Subject: ') THEN
- DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)
- LEN_DESCRP = LEN_BUFFER
- END IF
- END IF
- IF (.NOT.INEXDATE) THEN
- IF (BUFFER(:9).EQ.'Expires: '.OR.
- & BUFFER(:11).EQ.'X-Expires: ') THEN
- I = INDEX(BUFFER,' ')+1
- NODATE = .FALSE.
- DO J=I,LEN_BUFFER
- IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN
- BUFFER(J:J) = ' '
- END IF
- END DO
- CALL STR$UPCASE(BUFFER(I:),BUFFER(I:))
- NODATE = .TRUE.
- I = INDEX(BUFFER,' ')+1
- EXDATE(3:3) = '-'
- EXDATE(7:7) = '-'
- DO WHILE (I.LE.LEN_BUFFER)
- IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN
- IF (NODATE) THEN
- IF (INDEX(BUFFER(I:),' ').EQ.2) THEN
- EXDATE(1:2) = '0'//BUFFER(I:I)
- I = I + 1
- ELSE
- EXDATE(1:2) = BUFFER(I:I+1)
- I = I + 2
- END IF
- NODATE = .FALSE.
- ELSE
- IF (LEN_BUFFER-I.EQ.1.OR.
- & INDEX(BUFFER(I:),' ').EQ.3) THEN ! No century?
- IER = SYS$ASCTIM(,TODAY,,) ! Get today's date
- YEAR = INDEX(TODAY(6:),'-')
- EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1)
- I = I + 2
- ELSE
- EXDATE(8:) = BUFFER(I:I+3)
- I = I + 4
- END IF
- END IF
- ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN
- EXDATE(4:6) = BUFFER(I:I+2)
- I = I + 3
- ELSE
- I = I + 1
- END IF
- END DO
- INEXDATE = .TRUE.
- END IF
- END IF
- CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK)
- TEXT = .TRUE.
- END IF
-
- RETURN
- END
-
-
-
-
- SUBROUTINE FINISH_MESSAGE_ADD
-C
-C SUBROUTINE FINISH_MESSAGE_ADD
-C
-C FUNCTION: Writes message entry into directory file and closes folder
-C
-C NOTE: Only should be run if INIT_MESSAGE_ADD was successful.
-C
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /DIGEST/ LDESCR,FIRST_BREAK
-
- COMMON /TEXT_PRESENT/ TEXT
-
- COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRP
- COMMON /MAIN_HEADER_INFO/ INEXDATE
- CHARACTER*(LINE_LENGTH) INFROM,INDESCRIP
-
- COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
- CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM
-
- CHARACTER*23 TODAY
-
- DIMENSION BIN_EXTIME(2)
-
- IF (LEN_FROM.EQ.0) THEN
- CALL GETUSER(FROM)
- INFROM = FROM
- LEN_FROM = TRIM(INFROM)
- LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)
- IF (LEN_DESCRP.GT.0) THEN
- INDESCRIP = SAVE_IN_DESCRIP
- IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
- CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
- END IF
- ELSE
- DESCRIP = ' '
- END IF
- CALL WRITEOUT_STORED
- END IF
-
- CALL FLUSH_BULL(NBLOCK)
-
- CALL CLOSE_BULLFIL ! Finished adding bulletin
-
- IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR. ! End of digest msg
- & .NOT.TEXT) THEN ! or no message text found
- CALL CLOSE_BULLDIR ! then don't add message entry
- RETURN
- END IF
-
- EXTIME = '00:00:00.00'
- IF (INEXDATE) THEN
- IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME)
- IF (IER) THEN ! If good date format
- IER = SYS$ASCTIM(,TODAY,,) ! Get today's date
- IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's
- IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great?
- & .OR.IER.LE.0) THEN ! or expiration date not future
- INEXDATE = .FALSE. ! Don't use it
- END IF
- ELSE
- INEXDATE = .FALSE. ! Don't use it
- END IF
- END IF
-
- IF (.NOT.INEXDATE) THEN
- IF (FOLDER_BBEXPIRE.EQ.-1) THEN ! Folder has expiration time?
- EXDATE = '5-NOV-2000' ! no, so set date far in future
- SYSTEM = 2 ! indicate permanent message
- ELSE ! Else set expiration date
- CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
- SYSTEM = 0
- END IF
- END IF
-
- LENGTH = NBLOCK - LENGTH + 1 ! Number of records
-
- CALL ADD_ENTRY ! Add the new directory entry
-
- CALL CLOSE_BULLDIR ! Totally finished with add
-
- CALL UPDATE_FOLDER
-
- RETURN
- END
-
-
-
-
- SUBROUTINE STORE_FROM(IFROM,LEN_INFROM)
-
- IMPLICIT INTEGER (A-Z)
-
- COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO
- CHARACTER*12 PROTOCOL
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*(*) IFROM
-
- CHARACTER*(LINE_LENGTH) INFROM
-
- INFROM = IFROM
-
- IF (LPRO.GT.0) THEN ! Protocol present?
- I = INDEX(INFROM,'%"') + 2 ! Make usable for VMS MAIL
- IF (I.EQ.2) THEN
- INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"'
- I = LPRO + 1
- LEN_INFROM = LEN_INFROM + LPRO + 1
- END IF
- DO WHILE (I.LT.LEN_INFROM)
- IF (INFROM(I:I).EQ.'"') THEN
- INFROM(I:I) = ''''
- ELSE IF (INFROM(I:I).EQ.'\') THEN
- INFROM(I+1:) = '\'//INFROM(I+1:)
- LEN_INFROM = LEN_INFROM + 1
- I = I + 1
- ELSE IF (INFROM(I:I).EQ.''''.AND.
- & INDEX(INFROM,'@').GT.I) THEN
- INFROM(I:) = '\s'//INFROM(I+1:)
- LEN_INFROM = LEN_INFROM + 1
- I = I + 2
- END IF
- I = I + 1
- END DO
- END IF
-
- DO I=1,LEN_INFROM ! Remove control characters
- IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' '
- END DO
-
- DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ')
- INFROM = INFROM(2:)
- LEN_INFROM = LEN_INFROM - 1
- END DO
-
- TWO_SPACE = INDEX(INFROM,' ')
- DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM)
- INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:)
- LEN_INFROM = LEN_INFROM - 1
- TWO_SPACE = INDEX(INFROM,' ')
- END DO
-
- CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM),
- & NBLOCK)
-
- IF (INDEX(INFROM,'%"').GT.0) ! Strip off protocol program
- & INFROM = INFROM(INDEX(INFROM,'%"')+2:)
-
- IF (INDEX(INFROM,'::').GT.0) ! Strip off node name
- & INFROM = INFROM(INDEX(INFROM,'::')+2:) ! I.e. HOST::USER
-
- CALL GET_FROM(INFROM,LEN_INFROM)
-
- RETURN
- END
-
-
- SUBROUTINE GET_FROM(INFROM,LEN_INFROM)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*(*) INFROM
-
- DO WHILE (INDEX(INFROM,'!').GT.0.AND. ! Unix address go backwards.
- & INDEX(INFROM,'!').LT.INDEX(INFROM,'@'))
- INFROM = INFROM(INDEX(INFROM,'!')+1:) ! I.e. host!user
- END DO
-
- DO WHILE (INDEX(INFROM,'<').GT.0.AND. ! Name may be of form
- & INDEX(INFROM,'@').GT.INDEX(INFROM,'<'))
- INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name <net-name>
- END DO
-
- DO WHILE (INDEX(INFROM,'(').GT.0.AND. ! personal-name (net-name)
- & INDEX(INFROM,'@').GT.INDEX(INFROM,'('))
- INFROM = INFROM(INDEX(INFROM,'(')+1:)
- END DO
-
- I = 1 ! Trim username to start at first alpha character
- DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR.
- & INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR.
- & INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR.
- & INFROM(I:I).EQ.'\'.OR.
- & INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.''''))
- I = I + 1
- END DO
- INFROM = INFROM(I:)
-
- I = 1 ! Trim username to end at a alpha character
- DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND.
- & INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND.
- & INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND.
- & INFROM(I:I).NE.'\'.AND.
- & INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''')
- I = I + 1
- END DO
- FROM = INFROM(:I-1)
-
- DO J=2,I-1
- IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND.
- & ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR.
- & (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THEN
- FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a'))
- END IF
- END DO
-
- RETURN
- END
-
-
-
-
- SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP)
-
- IMPLICIT INTEGER (A-Z)
-
- INCLUDE 'BULLDIR.INC'
-
- CHARACTER*(*) INDESCRIP
-
- CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP)
-
- DO I=1,LEN_DESCRP ! Remove control characters
- IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' '
- END DO
-
- DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ')
- INDESCRIP = INDESCRIP(2:)
- LEN_DESCRP = LEN_DESCRP - 1
- END DO
-
- IF (LEN_DESCRP.GT.LEN(DESCRIP)) THEN
- ! Is length > allowable subject length?
- CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//
- & INDESCRIP(:LEN_DESCRP),NBLOCK)
- END IF
-
- DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP)))
-
- RETURN
- END
-
-
-
-
-
- SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER)
-C
-C SUBROUTINE STRIP_HEADER
-C
-C FUNCTION: Indicates whether line is part of mail message header.
-C
-C INPUTS:
-C BUFFER - Character string containing input line of message.
-C BLEN - Length of character string. If = 0, initialize subroutine.
-C
-C OUTPUTS:
-C IER - If true, line should be stripped. Else, end of header.
-C
- IMPLICIT INTEGER (A - Z)
-
- INCLUDE 'BULLDIR.INC'
-
- INCLUDE 'BULLFOLDER.INC'
-
- COMMON /DATE/ DATE_LINE
- CHARACTER*(LINE_LENGTH) DATE_LINE
-
- COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
-
- CHARACTER*(*) BUFFER
-
- IF (TRIM(BUFFER).EQ.0) THEN
- ! If STRIP not set for folder or empty line
- IER = .FALSE.
- CONT_LINE = .FALSE.
- RETURN
- END IF
-
- IF (BLEN.EQ.0) THEN
- DATE_LINE = ' '
- CONT_LINE = .FALSE.
- END IF
-
- IER = .TRUE.
-
- IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR. ! If line is continuation
- & BUFFER(:1).EQ.CHAR(9))) RETURN ! of previous header line
-
- I = 1
- DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ')
- IF (BUFFER(I:I).EQ.':') THEN ! Header line found
- CONT_LINE = .TRUE. ! Next line might be continuation
- IF (REMOTE_SET.NE.3.AND.BUFFER(:5).EQ.'Date:') THEN
- DATE_LINE = 'Message sent'//BUFFER(5:BLEN)
- IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN
- DATE_LINE(TRIM(DATE_LINE)+1:) = '.'
- END IF
- END IF
- RETURN
- ELSE
- I = I + 1
- END IF
- END DO
-
- IER = .FALSE.
- CONT_LINE = .FALSE.
-
- RETURN
- END
diff --git a/decus/vax91b/bulletin-net91b/mx.com b/decus/vax91b/bulletin-net91b/mx.com
deleted file mode 100644
index 991d7a64101451f0825df26163b4fa8dfc051092..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/mx.com
+++ /dev/null
@@ -1,958 +0,0 @@
-$set nover
-$copy/log sys$input BUILD_MX_BULL.COM
-$deck
-$ save_verify = 'f$verify(0)'
-$!
-$! Command file to build MX_BULL (MX SITE transport for BULLETIN)
-$!
-$ say := write sys$output
-$ if f$trnlnm("BULL_SOURCE") .eqs. ""
-$ then say "BULL_SOURCE logical not defined; must point to BULL.OLB directory"
-$ exit
-$ endif
-$ say "Compiling MX_BULL...."
-$ cc mx_bull
-$ say "Linking MX_BULL...."
-$ link/notrace mx_bull,bull_source:BULL.OLB/LIB,sys$input/option
-SYS$SHARE:VAXCRTL.EXE/SHARE
-$ say "Build of MX_BULL.EXE completed"
-$ exit f$verify(save_verify).or.1
-$eod
-$copy/log sys$input MX_BULL.C
-$deck
-#module MX_BULL "01-001"
-/*
- *
- * Program: MX_BULL
- *
- * Author: Hunter Goatley
- * Academic Computing, STH 226
- * Western Kentucky University
- * Bowling Green, KY 42101
- * goathunter@wkuvx1.bitnet
- * 502-745-5251
- *
- * Date: March 8, 1991
- *
- * Functional description:
- *
- * This program serves as an MX SITE transport to transfer incoming
- * mail files to UALR's BULLETIN.
- *
- * The MX_SITE delivery agent takes messages routed to a SITE path and
- * feeds them into a subprocess that executes a command procedure named
- * MX_EXE:SITE_DELIVER.COM. There are three parameters passed to the
- * the command procedure:
- *
- * P1 - The name of a temporary file containing the message
- * text, including all of the RFC822 headers
- * (corresponding to the DATA part of an SMTP
- * transaction).
- * P2 - The name of a temporary file containing a list of
- * a messages recipients, which corresponds to the
- * RCPT_TO addresses of an SMTP transaction.
- * P3 - The RFC822 address of the sender of the message,
- * which corresponds to the MAIL FROM address of an
- * SMTP transaction.
- *
- * This program expects the same parameters, except that the third
- * parameter is optional. If the third parameter is omitted, BULLETIN
- * will scan the RFC822 headers in the message for a "From:" line.
- * If the third parameter is specified, it is expected to be a file
- * specification. It is assumed that SITE_DELIVER.COM has written the
- * address to this file.
- *
- * The logical MX_BULLETIN_POSTMASTER can be defined as a local
- * username to receive error notices. If BULLETIN returns an error
- * while trying to add a message, and the MX_BULLETIN_POSTMASTER
- * is defined as a valid local username, the message will be mailed
- * to that user for further handling.
- *
- * MX_BULLETIN_POSTMASTER must be defined system-wide in executive mode:
- *
- * $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER
- *
- * Modification history:
- *
- * 01-001 Hunter Goatley 14-MAR-1991 14:41
- * Added scan_for_from_line, which scans the message's RFC822
- * headers for the "From:" line. General cleanup on a few
- * routines. MX_BULL now provides an RESPOND-able address in
- * BULLETIN.
- *
- * 01-000 Hunter Goatley 8-MAR-1991 07:20
- * Genesis.
- *
- */
-
-/* Include all needed structures and constants */
-
-#include descrip
-#include lib$routines
-#include libdef
-#include lnmdef
-#include maildef
-#include rms
-#include ssdef
-#include str$routines
-#include string
-
-/* Declare the external BULLETIN routines that we call */
-
-unsigned long int INIT_MESSAGE_ADD();
-unsigned long int WRITE_MESSAGE_LINE();
-unsigned long int FINISH_MESSAGE_ADD();
-
-/* Define some macros to make things a little easier */
-
-#define rms_get(rab) ((rms_status = SYS$GET(rab)))
-#define err_exit(stat) {traceerr(stat); return(stat);}
-#define vms_errchk2() if(!(vms_status&1)) err_exit(vms_status);
-#define vms_errchk(func) {vms_status=func; vms_errchk2();}
-
-#define tracemsg(msg) if (trace) printf("MX_BULL: %s\n",msg);
-#define traceerr(msg) if (trace) printf("MX_BULL: Error status %%X%08x\n",msg);
-
-/* Define some global variables to make things easy */
-
-struct FAB msgfab; /* FAB for message text */
-struct RAB msgrab; /* RAB for message text */
-struct FAB rcptfab; /* FAB for recipients file */
-struct RAB rcptrab; /* RAB for recipients file */
-struct FAB fromfab; /* FAB for FROM file */
-struct RAB fromrab; /* RAB for FROM file */
-char msgbuf[512]; /* Input buffer for msgrab */
-char rcptbuf[512]; /* Input buffer for rcptrab */
-char frombuf[512]; /* Input buffer for frombuf */
-short trace;
-unsigned long int rms_status; /* Status of RMS calls */
-unsigned long int vms_status; /* Status of other calls */
-
-static $DESCRIPTOR(lnm_table,"LNM$SYSTEM_TABLE");
-
-#define itmlstend {0,0,0,0} /* An empty item list */
-typedef struct itmlst /* An item list structure */
-{
- short buffer_length;
- short item_code;
- long buffer_address;
- long return_length_address;
-} ITMLST;
-
-ITMLST
- nulllist[] = {itmlstend};
-
-ITMLST
- address_itmlst[] = { /* MAIL$SEND_ADD_ADDRESS */
- {0, MAIL$_SEND_USERNAME, 0, 0},
- itmlstend},
- bodypart_itmlst[] = { /* MAIL$SEND_ADD_BODYPART */
- {0, MAIL$_SEND_RECORD, 0, 0},
- itmlstend},
- attribute_itmlst[] = { /* MAIL$SEND_ADD_ATTRIBUTE */
- {0, MAIL$_SEND_TO_LINE, 0, 0},
- {0, MAIL$_SEND_FROM_LINE, 0, 0},
- {0, MAIL$_SEND_SUBJECT, 0, 0},
- itmlstend}
- ;
-
-ITMLST
- trnlnm_itmlst[] = { /* $TRNLNM item list */
- {0, LNM$_STRING, 0, 0},
- itmlstend}
- ;
-
-
-/*
- *
- * Function: open_file_rms
- *
- * Functional description:
- *
- * This routine opens a sequential text file in VMS "normal text" file
- * format. It uses RMS to open the file.
- *
- * Inputs:
- *
- * infab - Address of the input FAB
- * inrab - Address of the input RAB
- * buff - Address of the input buffer
- * filename - Address of the filename to open (ASCIZ)
- *
- * Outputs:
- *
- * fab and rab are modified if file is opened.
- *
- * Returns:
- *
- * RMS status
- *
- */
-unsigned long int
-open_file_rms (struct FAB *infab, struct RAB *inrab, char *buff, char *filename)
-{
- unsigned long int rms_status;
-
- *infab = cc$rms_fab; /* Initialize the FAB */
- *inrab = cc$rms_rab; /* Initialize the RAB */
- infab->fab$b_fns = strlen(filename); /* Set filename length */
- infab->fab$l_fna = filename; /* Set filename address */
- infab->fab$b_fac = FAB$M_GET; /* GET access only */
- infab->fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD;
- inrab->rab$l_fab = infab; /* Let RAB point to FAB */
- inrab->rab$b_rac = RAB$C_SEQ; /* Sequential file access */
- inrab->rab$w_usz = 512; /* Record size is 512 bytes */
- inrab->rab$l_ubf = buff; /* Read to this buffer */
-
- rms_status = SYS$OPEN (infab); /* Open the file */
- if (!(rms_status & 1)) /* If an error occurs, return */
- return (rms_status); /* ... a status */
- rms_status = SYS$CONNECT (inrab); /* Connect the RAB */
- return (rms_status); /* Return the RMS status */
-}
-
-/*
- *
- * Function: init_sdesc
- *
- * Functional description:
- *
- * Initialize a static string descriptor.
- *
- * Inputs:
- *
- * sdesc - Address of the descriptor to initialize
- * (of type struct dsc$descriptor_s)
- * string - Address of null-terminated string the descriptor describes
- *
- * Outputs:
- *
- * sdesc - Descriptor passed as sdesc is initialized
- *
- */
-void
-init_sdesc (struct dsc$descriptor_s *sdesc, char *string)
-{
- sdesc->dsc$w_length = strlen(string); /* Set the length */
- sdesc->dsc$b_dtype = DSC$K_DTYPE_T; /* Type is text */
- sdesc->dsc$b_class = DSC$K_CLASS_S; /* Class is static */
- sdesc->dsc$a_pointer = string; /* Point to the string */
-}
-
-/*
- *
- * Function: add_to_bulletin_folder
- *
- * Functional description:
- *
- * Adds a message to a BULLETIN folder by calling the external
- * BULLETIN routines INIT_MESSAGE_ADD, WRITE_MESSAGE_LINE, and
- * FINISH_MESSAGE_ADD.
- *
- * The following constants are (may be) passed to INIT_MESSAGE_ADD:
- *
- * Subject = "" Causes BULLETIN to scan RFC822 headers for
- * a "Subject:" or "Subj:" line
- * From = "MX%" Causes BULLETIN to scan RFC822 headers for
- * a "Reply-to:" or "From:" line
- *
- * Inputs:
- *
- * filerab - Address of the message file's RAB
- * folder - Address of a string descriptor for the name of the folder
- * from - Address of a string descriptor for the "From:" address
- *
- * Outputs:
- *
- * None.
- *
- * Returns:
- *
- * unsigned long int - RMS status of call to INIT_MESSAGE_ADD
- *
- */
-unsigned long int
-add_to_bulletin_folder(struct RAB *filerab, void *folder, void *from)
-{
- unsigned long int bull_status; /* Status from INIT_MESSAGE_ADD */
- struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */
- static $DESCRIPTOR(subject,""); /* Subject is "" */
-
- /* Call BULLETIN routine to initialize adding the message */
-
- INIT_MESSAGE_ADD (folder, from, &subject, &bull_status);
-
- if (!(bull_status & 1)){ /* Error? */
- return(bull_status);
- }
-
- /* Loop reading message lines until end-of-file. For each line read,
- create a string descriptor for it and call the BULLETIN routine to
- add the line. */
-
- while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */
- filerab->rab$l_rbf[filerab->rab$w_rsz] = 0; /* End byte = NULL */
- init_sdesc(&msg_line, filerab->rab$l_rbf); /* Now build desc. */
- WRITE_MESSAGE_LINE (&msg_line); /* Add to BULLETIN */
- }
-
- FINISH_MESSAGE_ADD(); /* Call BULLETIN routine to finish */
-
- tracemsg("Message added to folder");
- return(SS$_NORMAL); /* Return success to caller */
-}
-
-
-/*
- *
- * Function: scan_for_from_line
- *
- * Functional description:
- *
- * The routine scans the message's RFC822 headers for the "From:" line.
- * It parses out the address by extracting the <address>.
- *
- * This routine was necessary because letting BULLETIN find the "From:"
- * line was resulting in a non-RESPONDable address for MX. For example,
- * BULLETIN was creating:
- *
- * From: MX%"Hunter Goatley, WKU <goathunter@WKUVX1.BITNET>"
- *
- * but MX needs
- *
- * From: MX%"<goathunter@WKUVX1.BITNET>"
- *
- * Inputs:
- *
- * filerab - Address of the message file's RAB
- *
- * Outputs:
- *
- * final_from - Address of a character buffer to receive the final address
- *
- * Returns:
- *
- * unsigned long int - binary success/failure status
- *
- * Side effects:
- *
- * The message file is rewound so that subsequent GETs start at the
- * beginning of the message.
- *
- */
-unsigned long int
-scan_for_from_line(struct RAB *filerab, char *final_from)
-{
- unsigned long int scan_status; /* Status from INIT_MESSAGE_ADD */
- struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */
- char whole_from_line[512]; /* The assembled "From:" line */
- char *filebuffer; /* Pointer to the input buffer */
- int i, j, x; /* Work variables */
-
- scan_status = SS$_NORMAL; /* Assume success */
- whole_from_line[0] = '\0'; /* Initialize work buffer */
-
- /* Loop reading message lines until end-of-file or first null line,
- which should signal the end of the RFC822 header. For each line read,
- check to see if we've located the "From:" line.
- */
-
- filebuffer = filerab->rab$l_ubf; /* Init buffer ptr */
- while ((rms_get(filerab) != RMS$_EOF) && /* Loop until EOF */
- ((x = filerab->rab$w_rsz) != 0)){ /* or null record */
- filebuffer[x] = '\0'; /* Set NULL byte */
- if (strncmp(filebuffer,"From:",5)==0){ /* Is it the "From:"? */
-
- /* Found "From:" line */
- tracemsg("Found \042From:\042 line in RFC822 header");
- strcpy(whole_from_line,filebuffer); /* Copy to work buff */
-
- /* The "From:" line may actually be split over several lines.
- In such cases, the remaining lines are indented by 6 spaces.
- To handle this, loop reading records until one is read that
- doesn't begin with a blank. As each record is read, it is
- trimmed and tacked on to whole_from_line, so we end up with
- the entire "From:" line in one buffer. */
-
- while((rms_get(filerab) != RMS$_EOF) && /* Read rest of From: */
- (filebuffer[0] == ' ')){ /* ... line */
- for (i = 0; filebuffer[i] == ' '; ++i); /* Step over blanks */
- strcat(whole_from_line,&filebuffer[i]); /* Tack it on end */
- }
-
- /* Now have the whole "From:" line in whole_from_line. Since
- the real address is enclosed in "<>", look for it by
- searching for the last "<" and reading up to the ">". */
-
- i = strrchr(whole_from_line,'<'); /* Find last "<" */
- if (i != 0){ /* Found it.... */
- j = strchr(i,'>'); /* Find last ">" */
- j = j-i+1; /* Calc addr length */
- }
- else{
- j = strlen(whole_from_line)-6; /* Don't count From: */
- i = &whole_from_line + 6; /* in string length */
- }
- if (j < 0){ /* If neg., error */
- tracemsg("Error - unable to locate from address");
- strcpy(final_from,""); /* Return null string */
- scan_status = 0; /* Set error status */
- }
- else {
- tracemsg("Found sender's address in RFC822 header");
- strncpy(final_from, i, j); /* Copy to caller */
- }
- }
- }
-
- SYS$REWIND(filerab); /* Rewind the file to the beginning */
- return(scan_status); /* Return success to caller */
-}
-
-
-/*
- *
- * Function: forward_to_postmaster
- *
- * Functional description:
- *
- * If an error occurs trying to write a message to a BULLETIN folder,
- * this routine is called to forward the message to the local
- * postmaster.
- *
- * Inputs:
- *
- * filerab - Address of the message file's RAB
- * folder - Address of a string descriptor for the name of the folder
- * from - Address of a string descriptor for the "From:" address
- * status - Address of longword containing the BULLETIN error code
- *
- * Outputs:
- *
- * None.
- *
- * Returns:
- *
- * unsigned long int - binary status of call to INIT_MESSAGE_ADD
- *
- * Side effects:
- *
- * The message file is rewound so that subsequent calls to this routine
- * can be made (in case the message is to be written to several folders).
- *
- */
-unsigned long int
-forward_to_postmaster(struct RAB *filerab, void *folder, void *from, int status)
-{
- struct dsc$descriptor_s msg_line; /* Descriptor for a line of the msg */
- struct dsc$descriptor_s subject;
- char subject_buf[256];
- char postmaster[256]; int postmaster_len;
- char status_msg_buf[256]; int status_msg_len;
- struct dsc$descriptor_s status_msg;
- static $DESCRIPTOR(faostr,"Failed BULLETIN message for folder !AS");
- static $DESCRIPTOR(MXBULL,"MX->SITE (BULLETIN delivery)");
- static $DESCRIPTOR(postmaster_lnm,"MX_BULLETIN_POSTMASTER");
- int send_context = 0; int x; int y;
-
- static char *error_msgs[] = {
- {"Error delivering message to BULLETIN folder. BULLETIN error status:"},
- {""},
- {""},
- {"Original message text follows:"},
- {"--------------------------------------------------"}
- };
-
- trnlnm_itmlst[0].buffer_length = 255;
- trnlnm_itmlst[0].buffer_address = &postmaster;
- trnlnm_itmlst[0].return_length_address = &postmaster_len;
-
- SYS$TRNLNM( 0, &lnm_table, &postmaster_lnm, 0, trnlnm_itmlst);
- if (postmaster_len == 0) /* If logical is not defined, */
- return(SS$_NORMAL); /* then pretend it worked */
-
- tracemsg("Forwarding message to local postmaster....");
- subject.dsc$w_length = 255;
- subject.dsc$a_pointer = &subject_buf;
- SYS$FAO(&faostr, &subject, &subject, folder); /* Format the subject */
-
- address_itmlst[0].buffer_length = postmaster_len; /* To: */
- address_itmlst[0].buffer_address = &postmaster; /* To: */
- attribute_itmlst[0].buffer_length = postmaster_len; /* To: */
- attribute_itmlst[0].buffer_address = &postmaster; /* To: */
- attribute_itmlst[1].buffer_length = MXBULL.dsc$w_length; /* From: */
- attribute_itmlst[1].buffer_address = MXBULL.dsc$a_pointer; /* From: */
- attribute_itmlst[2].buffer_length = subject.dsc$w_length; /* Subject:*/
- attribute_itmlst[2].buffer_address = subject.dsc$a_pointer; /* Subject:*/
-
- vms_errchk(mail$send_begin(&send_context, &nulllist, &nulllist));
- vms_errchk(mail$send_add_address(&send_context, &address_itmlst,
- &nulllist));
- vms_errchk(mail$send_add_attribute(&send_context, &attribute_itmlst,
- &nulllist));
-
- for (x = 0; x < 5; x++){
- bodypart_itmlst[0].buffer_length = strlen(error_msgs[x]);
- bodypart_itmlst[0].buffer_address = error_msgs[x];
- vms_errchk(mail$send_add_bodypart(&send_context,
- &bodypart_itmlst, &nulllist));
- if (x == 1){
- status_msg.dsc$w_length = 256;
- status_msg.dsc$b_dtype = DSC$K_DTYPE_T;
- status_msg.dsc$b_class = DSC$K_CLASS_S;
- status_msg.dsc$a_pointer = &status_msg_buf;
- y = SYS$GETMSG (status, &status_msg, &status_msg, 15, 0);
- if (!(y & 1))
- sprintf(status_msg_buf,"Error code is %%X%08x",status);
- else
- status_msg_buf[status_msg.dsc$w_length] = '\0';
- bodypart_itmlst[0].buffer_length = strlen(status_msg_buf);
- bodypart_itmlst[0].buffer_address = &status_msg_buf;
- vms_errchk(mail$send_add_bodypart(&send_context,&bodypart_itmlst,
- &nulllist));
- }
- }
-
- while (rms_get(filerab) != RMS$_EOF){ /* Loop until EOF */
- bodypart_itmlst[0].buffer_length = filerab->rab$w_rsz;
- bodypart_itmlst[0].buffer_address = filerab->rab$l_rbf;
- vms_errchk(mail$send_add_bodypart(&send_context,
- &bodypart_itmlst, &nulllist));
- }
-
- vms_errchk(mail$send_message(&send_context, &nulllist, &nulllist));
- vms_errchk(mail$send_end(&send_context, &nulllist, &nulllist));
-
- tracemsg("Message forwarded to postmaster....");
-}
-
-
-/*
- *
- * Function: log_accounting
- *
- * Functional description:
- *
- * This routine will write an accounting record for the message.
- *
- * Inputs:
- *
- * folder - Address of a string descriptor for the name of the folder
- * from - Address of a string descriptor for the "From:" address
- * status - Address of longword containing the BULLETIN error code
- *
- * Outputs:
- *
- * None.
- *
- * Returns:
- *
- * unsigned long int - RMS status
- *
- */
-unsigned long int
-log_accounting(void *folder, void *from, int bull_status)
-{
- struct FAB accfab;
- struct RAB accrab;
- static $DESCRIPTOR(MX_BULL_ACCNTNG,"MX_BULLETIN_ACCNTNG");
- static $DESCRIPTOR(faostr,
- "!%D MX_BULL: FOLDER=\042!AS\042, ORIGIN=\042!AS\042, STATUS=%X!XL");
- char outbufbuf[256];
- struct dsc$descriptor_s outbuf = {256, DSC$K_DTYPE_T, DSC$K_CLASS_S,
- &outbufbuf};
-
- int status;
- static char bullacc[] = "MX_BULLETIN_ACC";
- static char bullaccdef[] = "MX_SITE_DIR:.DAT";
-
- status = SYS$TRNLNM( 0, &lnm_table, &MX_BULL_ACCNTNG, 0, 0);
- if (!(status & 1))
- return(SS$_NORMAL);
-
- tracemsg("Writing accounting information to accounting log....");
- accfab = cc$rms_fab;
- accrab = cc$rms_rab;
- accfab.fab$b_fns = strlen(bullacc); /* Set filename length */
- accfab.fab$l_fna = &bullacc; /* Set filename address */
- accfab.fab$b_dns = strlen(bullaccdef); /* Set filename length */
- accfab.fab$l_dna = &bullaccdef; /* Set filename address */
- accfab.fab$b_fac = FAB$M_PUT; /* PUT access only */
- accfab.fab$b_shr = FAB$M_SHRGET+FAB$M_SHRPUT+FAB$M_SHRUPD;
- accfab.fab$b_rfm = FAB$C_VAR; /* Variable length records */
- accfab.fab$b_rat = FAB$M_CR; /* Normal "text" rat */
- accrab.rab$l_fab = &accfab; /* Let RAB point to FAB */
- accrab.rab$b_rac = RAB$C_SEQ; /* Sequential file access */
-
- status = SYS$OPEN (&accfab); /* Try to open the file */
- if (status & 1) /* Success? */
- accrab.rab$l_rop = RAB$M_EOF; /* Set to EOF */
- else /* Couldn't open, so create */
- status = SYS$CREATE (&accfab); /* ... a new one */
- if (status & 1){ /* If either was OK... */
- status = SYS$CONNECT (&accrab); /* Connect the RAB */
- if (status == RMS$_EOF) /* RMS$_EOF status is OK */
- status = RMS$_NORMAL; /* Change it to NORMAL */
- if (!(status & 1)){ /* If any error occurred */
- tracemsg("Unable to open accounting file");
- traceerr(status);
- SYS$CLOSE (&accfab); /* Close the file */
- return(status); /* And return the error */
- }
- }
- else
- return(status);
-
- SYS$FAO(&faostr, &outbuf, &outbuf, 0, folder, from, bull_status);
- accrab.rab$w_rsz = outbuf.dsc$w_length;
- accrab.rab$l_rbf = outbuf.dsc$a_pointer;
- SYS$PUT (&accrab);
- SYS$CLOSE (&accfab);
-}
-
-/*
- *
- * Main routine
- *
- */
-main(int argc, char *argv[])
-{
- struct dsc$descriptor_s folder; /* Descriptor for the folder name */
- struct dsc$descriptor_s from_user; /* Descriptor for "From:" line */
- static $DESCRIPTOR(MX_SITE_DEBUG,"MX_SITE_DEBUG");
-
- char *from_line; /* Pointer to dynamic "From:" buffer */
- char *folder_name; /* Pointer to folder name in rcptbuf */
- char *atsign; /* Pointer to "@" in rcptbuf */
- int x; /* Work variable */
- unsigned long int bull_status; /* Status from add_to_bulletin_folder */
-
- --argc; /* Don't count the program name */
- if ((argc != 2) && (argc != 3)) { /* If too many or too few args, */
- exit(LIB$_WRONUMARG); /* ... exit with error status */
- }
-
- vms_status = SYS$TRNLNM( 0, &lnm_table, &MX_SITE_DEBUG, 0, 0);
- if (vms_status & 1)
- trace = 1;
- else
- trace = 0;
-
- /* Open all input files */
-
- tracemsg("Opening message file....");
- vms_errchk(open_file_rms (&msgfab, &msgrab, &msgbuf, argv[1]));
- tracemsg("Opening recipients file....");
- vms_errchk(open_file_rms (&rcptfab, &rcptrab, &rcptbuf, argv[2]));
-
- if (argc == 2){
- tracemsg("Using sender address from RFC822 headers....");
- scan_for_from_line(&msgrab, &frombuf);
- }
- else {
- tracemsg("Opening sender address file....");
- vms_errchk(open_file_rms (&fromfab, &fromrab, &frombuf, argv[3]));
-
- tracemsg("Reading sender address from file....");
- rms_get(&fromrab); /* Read the from line */
- if (!(rms_status & 1)) /* Exit if an error occurred */
- err_exit(rms_status);
-
- /* Set the end of the record read, then initialize the descriptor for it */
- frombuf[fromrab.rab$w_rsz] = 0;
-
- SYS$CLOSE(&fromfab);
- } /* End of "if (argc == 2)"... */
-
- /* frombuf now has the sender's address in it */
-
- if (strlen(frombuf) == 0) {
- tracemsg("Unable to find sender's address, using MX%");
- init_sdesc(&from_user, "MX%");
- }
- else{
-
- /* Now add the MX% prefix and the double quotes */
- from_line = malloc(4 + strlen(frombuf) + 1 + 1); /* Allocate memory */
-
- /* Make the string repliable through MX by adding MX%"" to it */
- strcpy(from_line,"MX%\042");
- strcat(from_line,frombuf);
- strcat(from_line,"\042");
- if (trace)
- printf("MX_BULL: Sender's address is %s\n", from_line);
- init_sdesc (&from_user, from_line); /* Create a string descriptor */
- }
- /*
- Read through all the recipients, writing the message to all BULLETIN
- folders (identified by checking for @BULLETIN in the address).
- */
- rms_get(&rcptrab); /* Read a recipient */
- while ((rms_status & 1) & (rms_status != RMS$_EOF)){
- tracemsg("Looking for BULLETIN folder....");
- folder_name = &rcptbuf; /* Point to receipt buffer */
- if (folder_name[0] == '<'){ /* If line begins with "<" */
- ++folder_name; /* bump over it and check */
- atsign = strchr(rcptbuf,'@'); /* for a "@" */
- if (atsign != 0){ /* If "@" was found, */
- if (strncmp(atsign,"@BULLETIN",9)==0){/* Is it @BULLETIN? */
- x = atsign - folder_name; /* Length of folder name */
- folder_name[x] = 0; /* Terminate folder name */
- init_sdesc (&folder, folder_name); /* Initialize descriptor */
- str$upcase(&folder, &folder); /* Convert to uppercase */
- if (trace)
- printf("MX_BULL: Found BULLETIN folder \042%s\042....\n",
- folder_name);
- tracemsg("Adding message to BULLETIN folder....");
- bull_status = add_to_bulletin_folder (&msgrab, &folder, &from_user);
- if (!(bull_status & 1)){
- traceerr(bull_status);
- vms_errchk(forward_to_postmaster(&msgrab, &folder, &from_user,
- bull_status));
- }
- log_accounting(&folder, &from_user, bull_status);
- SYS$REWIND(&msgrab); /* Rewind the file for next folder */
-
- }
- }
- }
- rms_get(&rcptrab); /* Read next recipient */
- }
-
-
- /* Close the RMS files */
-
- SYS$CLOSE(&msgfab); SYS$CLOSE(&rcptfab);
-
- tracemsg("BULLETIN message processed");
- exit(SS$_NORMAL); /* Always return success */
-
-}
-$eod
-$copy/log sys$input MX_BULL.TXT
-$deck
- MX_BULL
- An MX SITE transport
- March 14, 1991
-
-MX_BULL is a transport between MX and BULLETIN, a VMS bulletin board program
-by Mark London at MIT. It is designed to be called as an MX SITE transport,
-letting MX write messages into BULLETIN folders as they are processed, instead
-of routing the messages to MAIL.MAI files for each folder.
-
-The following files make up the MX_BULL distribution:
-
- BUILD_MX_BULL.COM Command procedure to build MX_BULL.EXE
- MX_BULL.C VAX C source code for MX_BULL
- MX_BULL.TXT This file
- MX_BULL_SITE_DELIVER.COM SITE_DELIVER.COM for MX_BULL
-
-The current version is 01-001.
-
-
-WHAT IS BULLETIN?
------------------
-BULLETIN is a VMS bulletin board written by Mark London at MIT that allows
-multiple users to access a common message base. Messages are divided into
-folders, which work much like VMS Mail folders. Using MX_BULL, messages can
-be routed from Internet/Bitnet mailing lists directly to BULLETIN folders,
-allowing all (or some) users on a system to access the mailing lists without
-individual subscriptions. This can cut down on the number of incoming
-Bitnet/Internet mail messages significantly, since only one copy of a message
-need be sent to a site.
-
-BULLETIN can be found on a number of the DECUS VAX SIG tapes, including the
-Fall 1990 tapes. It can also be retrieved by sending a mail message to
-BULLETIN@NERUS.PFC.MIT.EDU. The body of the message must contain one of
-the following commands:
-
- SEND ALL Sends all bulletin files.
- SEND filename Sends the specified file.
- BUGS Sends a list of the latest bug fixes.
- HELP or INFO Sends a brief description of BULLETIN.
-
-
-BUILDING MX_BULL.EXE
---------------------
-MX_BULL is written in VAX C and can be compiled by executing BUILD_MX_BULL.COM.
-
-MX_BULL must be linked with the BULLETIN object library, BULL.OLB. The
-build procedure for MX_BULL expects the logical BULL_SOURCE to point to the
-BULLETIN library. You must define this logical (or edit the .COM file)
-before building MX_BULL.
-
-
-INSTALLING MX_BULL
-------------------
-To install MX_BULL, perform the following steps:
-
-1. Using MCP, define a path named BULLETIN as a SITE transport:
-
- MCP> DEFINE PATH "BULLETIN" SITE
-
-2. Using MCP, define a rewrite rule early in the list (this should actually
- be done using CONFIG.MCP so that the order is correct):
-
- MCP> DEFINE REWRITE_RULE "<{folder}@BULLETIN>" "<{folder}@BULLETIN>"
-
-3. If you don't have a SITE transport already defined, simply copy
- MX_BULL_SITE_DELIVER.COM to MX_EXE:SITE_DELIVER.COM.
-
- If you do have a SITE transport defined, you'll need to merge the MX_BULL
- stuff into the existing MX_EXE:SITE_DELIVER.COM.
-
-4. Reset the MX routers by using MCP RESET/ALL, or shutting down MX and
- restarting it.
-
-Once these steps have been completed, MX_BULL is set up to begin delivering
-messages to BULLETIN.
-
-
-ROUTING MESSAGES TO BULLETIN
-----------------------------
-Messages are routed to BULLETIN folders by addressing mail to
-MX%"folder@BULLETIN", where "folder" is the name of the target BULLETIN
-folder. For example, the following commands would send a message from VMS
-Mail to the BULLETIN folder GENERAL (on the local system):
-
- $ MAIL
- MAIL> SEND
- To: MX%"GENERAL@BULLETIN"
- Subj: This is a test....
- .....
-
-The message is sent to the MX router, which in turn sends it to the MX SITE
-agent, since the @BULLETIN path was defined as a SITE path.
-
-To facilitate the automatic delivery of messages to BULLETIN folders, you
-should set up forwarding addresses for each of the BULLETIN folders:
-
- MAIL> SET FORWARD/USER=GENERAL MX%"""GENERAL@BULLETIN"""
- MAIL> SET FORWARD/USER=MX-LIST MX%"""MX-LIST@BULLETIN"""
-
-Mail addressed to GENERAL or MX-LIST will automatically be forwarded to
-BULLETIN via MX_BULL.
-
-To subscribe to a Bitnet/Internet mailing list and have the messages delivered
-to BULLETIN, use MX's MLFAKE to send a subscription request on behalf of the
-BULLETIN folder. For example, the user to specify would be:
-
- MLFAKE/USER=MX-LIST ....
-
-(Alternatively, you could create a dummy account named MX-LIST (or whatever
-the list name is) that exists only long enough to send the request via MAIL.)
-
-Once added to the lists, incoming mail addressed to MX-LIST will get forwarded
-to MX%"MX-LIST@BULLETIN", which will invoke MX_BULL. For example, an incoming
-message to my local BULLETIN folder would be addressed to:
-
- MX-LIST@WKUVX1.bitnet
-
-Since I have MX-LIST forwarded to MX%"MX-LIST@BULLETIN", the message is routed
-to the BULLETIN folder.
-
-To try to illustrate the process, assume the node is WKUVX1.bitnet. We've
-subscribed a fake local user, INFO-VAX, to the MX mailing list; mail forwarding
-has been set up for INFO-VAX to send it to MX%"INFO-VAX@BULLETIN". When mail
-arrives addressed to INFO-VAX@WKUVX1.BITNET, the MX Router passes the message
-to the Local agent, which discovers that the mail is forwarded to
-MX%"INFO-VAX@BULLETIN". The message is then sent back to the Router, which
-finds that BULLETIN is defined as a SITE path, so the message is passed to
-MX->SITE, which in turn calls MX_BULL.
-
-
-MX_BULL ACCOUNTING AND DEBUGGING
---------------------------------
-MX_BULL accounting is enabled with the system logical MX_BULLETIN_ACCNTNG:
-
- $ DEFINE/SYS/EXEC MX_BULLETIN_ACCNTNG TRUE
-
-This will cause MX_BULL to create MX_SITE_DIR:MX_BULLETIN_ACC.DAT. The
-logical MX_BULLETIN_ACC can be defined system-wide to change the name of the
-file:
-
- $ DEFINE/SYS/EXEC MX_BULLETIN_ACC LOCALDISK:[DIR]MX_BULL.ACCOUNTING
-
-To generate debugging logs in MX_SITE_DIR:, define the system logical
-MX_SITE_DEBUG.
-
-
-ERRORS WRITING TO BULLETIN
---------------------------
-By default, MX_BULL_SITE_DELIVER.COM always returns success to the MX SITE
-agent. This was done to avoid bouncing network mail back to a mailing list.
-In order to be notified in case of problems writing the message to BULLETIN,
-you can define a system logical MX_BULLETIN_POSTMASTER to be a local
-username to receive failed MX_BULL transactions:
-
- $ DEFINE/SYS/EXEC MX_BULLETIN_POSTMASTER GOATHUNTER
-
-If BULLETIN returns an error, MX_BULL will forward the message (via the
-callable VMS Mail interface) to GOATHUNTER.
-
-
-BULLETIN AND "From:" ADDRESSES
-------------------------------
-If you use the return address supplied by the MX SITE agent, the return address
-for BULLETIN messages will look something like the following:
-
- From: MX%"@WKUVX1.BITNET:I-AMIGA@UBVM.BITNET"
-
-By default, MX_BULL_SITE_DELIVER.COM is set up to ignore the sender's address.
-If you want to use the MX SITE-supplied address, simply modify the following
-line in MX_BULL_SITE_DELIVER.COM:
-
- $ USE_SITE_FROM = 0 !Change to 1 to use MX sender's address
-
-If the sender's address is ignored (again, the default), MX_BULL will search
-the RFC822 headers in the message for the "From:" line. It then pulls out
-the sender's address in a format suitable for using the RESPOND command in
-BULLETIN. This lets users easily RESPOND to the sender of a message, or
-POST a message to the list itself.
-
-Note: MX_BULL just uses the address it's given. Some addresses are gatewayed
-to death, leaving a bad address on the "From:" line. This frequently happens
-with messages coming via UUCP through Internet to Bitnet, etc.
-
-
-AUTHOR INFORMATION
-------------------
-MX_BULL was written by:
-
- Hunter Goatley, VMS Systems Programmer, WKU
-
- E-mail: goathunter@wkuvx1.bitnet
- Voice: 502-745-5251
-
- U.S. Mail: Academic Computing, STH 226
- Western Kentucky University
- Bowling Green, KY 42101
-$eod
-$copy/log sys$input MX_BULL_SITE_DELIVER.COM
-$deck
-$!
-$! SITE_DELIVER.COM for MX_BULL
-$!
-$! Author: Hunter Goatley, goathunter@wkuvx1.bitnet
-$! Date: March 11, 1991
-$!
-$! By default, MX_BULL will tell BULLETIN to search the RFC822 headers
-$! in the message for a "Reply-to:" or "From:" line. If you want MX_BULL
-$! to use the P3 as the "From:" line, simply set USE_SITE_FROM to 1.
-$!
-$ USE_SITE_FROM = 0 !Change to 1 to use P3
-$ mxbull :== $mx_exe:mx_bull.exe
-$!
-$ set noon
-$ if f$trnlnm("SYS$SCRATCH").eqs."" then define SYS$SCRATCH MX_SITE_DIR:
-$ if USE_SITE_FROM !Use P3 as "From:"?
-$ then create mx_site_dir:sitesender.addr; !If so, write it out to a file
-$ open/append tmp mx_site_dir:sitesender.addr; !... to make sure DCL
-$ write tmp p3 !... doesn't mess it up
-$ close tmp !...
-$ mxbull 'p1' 'p2' mx_site_dir:sitesender.addr
-$ delete/nolog mx_site_dir:sitesender.addr;
-$ else mxbull 'p1' 'p2' !Just let BULLETIN find "From:"
-$ endif
-$ exit 1 !Always return success
-$eod
diff --git a/decus/vax91b/bulletin-net91b/pmdf.com b/decus/vax91b/bulletin-net91b/pmdf.com
deleted file mode 100644
index 4bfb470133f78b8a68853a4d7586f2cd21f9bfa2..0000000000000000000000000000000000000000
--- a/decus/vax91b/bulletin-net91b/pmdf.com
+++ /dev/null
@@ -1,1029 +0,0 @@
-$set nover
-$copy/log sys$input BULLETIN_MASTER.PAS
-$deck
-%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC'
-PROGRAM bulletin_master (output, outbound,
- %INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC',
- %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC',
- %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC');
-
-(*******************************************************************)
-(* *)
-(* Authors: Ned Freed (ned@ymir.bitnet) *)
-(* Mark London (mrl%mit.mfenet@nmfecc.arpa) *)
-(* 8/18/88 *)
-(* *)
-(*******************************************************************)
-
- CONST
- %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC'
-
- TYPE
- %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC'
-
- string = varying [alfa_size] of char;
-
- VAR
- %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC'
-
- outbound : text;
-
- (* Place to store the channel we are servicing *)
- mail_channel : mm_channel_ptr := nil;
-
- (* MM status control flag *)
-
- mm_status : (uninitialized, initialized, sending) := uninitialized;
-
- filename : vstring;
-
- (* Place to store the protocol that we are providing/servicing *)
- protocol_name : varying [10] of char;
-
- %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC'
-
- (* Declare interface routines to BULLETIN *)
-
- procedure INIT_MESSAGE_ADD (
- in_folder : [class_s] packed array [l1..u1 : integer] of char;
- in_from : [class_s] packed array [l2..u2 : integer] of char;
- in_descrip : [class_s] packed array [l3..u3 : integer] of char;
- var ier : boolean); extern;
-
- procedure WRITE_MESSAGE_LINE (
- in_line : [class_s] packed array [l1..u1 : integer] of char); extern;
-
- procedure FINISH_MESSAGE_ADD; extern;
-
- PROCEDURE warn_master (message : varying [len1] of char);
-
- BEGIN (* warn_master *)
- writeln;
- os_write_datetime (output);
- writeln (message);
- END; (* warn_master *)
-
- (* abort program. *)
-
- PROCEDURE abort_master (message : varying [len1] of char);
-
- BEGIN (* abort_master *)
- warn_master (message);
- halt;
- END; (* abort_master *)
-
-(* activate_mm fires up the MM package and performs related startup chores. *)
-
-function activate_mm (is_master : boolean) : rp_replyval;
-
-var
- mm_init_reply : rp_replyval; found : boolean; mail_chan_text : ch_chancode;
- stat : integer;
-
-begin (* activate_mm *)
- (* Set up the name of the protocol we are servicing/providing *)
- stat := $TRNLOG (lognam := 'PMDF_PROTOCOL',
- rslbuf := protocol_name.body,
- rsllen := protocol_name.length);
- if (not odd (stat)) or (stat = SS$_NOTRAN) then protocol_name := 'IN%';
- mm_status := initialized;
- mm_init_reply := mm_init;
- mail_chan_text := ' ';
- stat := $TRNLOG (lognam := 'PMDF_CHANNEL', rslbuf := mail_chan_text);
- if (not odd (stat)) or (stat = SS$_NOTRAN) then
- mail_chan_text := 'l ';
- if rp_isgood (mm_init_reply) then begin
- mail_channel := mm_lookup_channel (mail_chan_text);
- if mail_channel = nil then mail_channel := mm_local_channel;
- end else mail_channel := mm_local_channel;
- activate_mm := mm_init_reply;
-end; (* activate_mm *)
-
- (* initialize outbound, mm_ and qu_ *)
-
- PROCEDURE init;
-
- VAR fnam : vstring;
- i : integer;
-
- BEGIN (* init *)
- os_jacket_access := true;
- (* Initialize subroutine packages *)
- IF rp_isbad (activate_mm (false)) THEN
- abort_master ('Can''t initialize MM_ routines');
- IF rp_isbad (qu_init) THEN
- abort_master ('Can''t initialize QU_ routines');
- fnam.length := 0;
- IF NOT os_open_file (outbound, fnam, exclusive_read) THEN
- abort_master ('Can''t open outbound file');
- END; (* init *)
-
-
-procedure return_bad_messages (var bad_address : vstring);
-
-label
- 100;
-
-var
- line : vstring;
- bigline : bigvstring; result : rp_bufstruct;
- pmdfenvelopefrom : vstring;
- temp_line : vstringlptr;
-
- procedure try_something (rp_error : integer; routine : string);
-
- begin (* try_something *)
- if rp_isbad (rp_error) then begin
- mm_wkill; mm_status := initialized; goto 100;
- end;
- end; (* try_something *)
-
-begin (* return_bad_messages *)
- if mm_status = uninitialized then
- try_something (activate_mm (false), 'mm_init');
- mm_status := sending;
- try_something (mm_sbinit, 'mm_sbinit');
- initstring (line, 'postmaster@ ', 11);
- catvstring (line, mm_local_channel^.official_hostname);
- try_something (mm_winit (mail_channel^.chancode, line), 'mm_winit');
- initstring (line,
- 'postmaster ', 10);
- try_something (mm_wadr (mail_channel^.official_hostname,
- line), 'mm_wadr');
- try_something (mm_rrply (result), 'mm_rrply');
- try_something (result.rp_val, 'mm_rrply structure return');
- try_something (mm_waend, 'mm_waend');
- initstring (line, 'From: PMDF Mail Server <Postmaster@ ', 35);
- catvstring (line, mm_local_channel^.official_hostname);
- catchar (line, '>');
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'To: Postmaster ', 14);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Subject: Undeliverable mail ', 27);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Date: ', 6);
- os_cnvtdate (line);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- line.length := 1; line.body[1] := chr (chr_lf);
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'The message could not be delivered to: ', 38);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- line.length := 1; line.body[1] := chr (chr_lf);
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Addressee: ', 11);
- catvstring (line, bad_address);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Reason: No such bulletin folder. ', 32);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- line.length := 1; line.body[1] := chr (chr_lf);
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, '----------------------------------------', 40);
- catchar (line, chr (chr_lf));
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- try_something (qu_rkill, 'qu_rkill');
- try_something (qu_rinit (filename, pmdfenvelopefrom), 'qu_rinit');
- while rp_isgood (qu_radr (line)) do begin end;
- while rp_isgood (qu_rtxt (bigline)) do
- try_something (mm_bigwtxt (bigline), 'mm_wtxt');
- mm_status := initialized;
- try_something (mm_wtend, 'mm_wtend');
- try_something (mm_rrply (result), 'mm_rrply');
- try_something (result.rp_val, 'mm_rrply structure return');
-100:
-end; (* return_bad_messages *)
-
- (* submit messages to BULLETIN *)
-
- PROCEDURE dosubmit;
-
- VAR fromaddr, toaddr, tombox, name : vstring;
- retval : rp_replyval;
- line : bigvstring;
- ier, done : boolean;
- i : integer;
-
- BEGIN (* dosubmit *)
- WHILE NOT eof (outbound) DO BEGIN
- readvstring (outbound, filename, 0);
- IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN
- done := false;
- FOR i := 1 TO fromaddr.length DO
- fromaddr.body[i] := upper_case (fromaddr.body[i]);
- IF rp_isgood (qu_radr (toaddr)) THEN BEGIN
- REPEAT
- retval := qu_radr (name);
- UNTIL rp_isbad (retval);
- mm_parse_address (toaddr, name, tombox, TRUE, FALSE, 0);
- FOR i := 1 TO tombox.length DO
- tombox.body[i] := upper_case (tombox.body[i]);
- INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length),
- protocol_name,' ', ier);
-(* The parameter with 'IN%', causes bulletin to search for the From line: *)
-(* substr (fromaddr.body, 1, fromaddr.length), *)
- IF ier THEN BEGIN
- WHILE rp_isgood (qu_rtxt (line)) DO BEGIN
- IF line.length > 0 THEN line.length := pred (line.length);
- WRITE_MESSAGE_LINE (substr (line.body, 1, line.length));
- END; (* while *)
- FINISH_MESSAGE_ADD;
- done := true;
- END ELSE BEGIN
- warn_master ('Error opening folder ' +
- substr (tombox.body, 1, tombox.length));
- return_bad_messages(tombox);
- done := true;
- END;
- END
- ELSE warn_master ('Can''t read To: address in file ' +
- substr (filename.body, 1, filename.length));
- if done then qu_rend else qu_rkill;
- END
- ELSE warn_master ('Can''t open queue file ' +
- substr (filename.body, 1, filename.length));
- END; (* while *)
- END; (* dosubmit *)
-
- BEGIN (* bulletin_master *)
- init;
- dosubmit;
- mm_end (true);
- qu_end;
- END. (* bulletin_master *)
-$eod
-$copy/log sys$input BULLETIN_MASTER.PAS_V32
-$deck
-%INCLUDE 'PMDF_ROOT:[SRC]ATTRIB.INC'
-PROGRAM bulletin_master (%INCLUDE 'PMDF_ROOT:[SRC]APFILES.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMFILES.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]QUFILES.INC'
- outbound);
-
-(*******************************************************************)
-(* *)
-(* Authors: Ned Freed (ned@ymir.claremont.edu) *)
-(* Mark London (mrl@nerus.pfc.mit.edu) *)
-(* 12/28/90 *)
-(* *)
-(*******************************************************************)
-
- CONST
- %INCLUDE 'PMDF_ROOT:[SRC]UTILCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]OSCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]APCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]SYCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]HECONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMCONST.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]LOGCONST.INC'
-
- TYPE
- %INCLUDE 'PMDF_ROOT:[SRC]UTILTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]OSTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]APTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]SYTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]HETYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMTYPE.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]LOGTYPE.INC'
-
- string = varying [alfa_size] of char;
-
- VAR
-(* %INCLUDE 'PMDF_ROOT:[SRC]UTILVAR.INC' *)
- %INCLUDE 'PMDF_ROOT:[SRC]OSVAR.INC'
-(* %INCLUDE 'PMDF_ROOT:[SRC]APVAR.INC' *)
-(* %INCLUDE 'PMDF_ROOT:[SRC]QUVAR.INC' *)
- %INCLUDE 'PMDF_ROOT:[SRC]MMVAR.INC'
-(* %INCLUDE 'PMDF_ROOT:[SRC]HEVAR.INC' *)
-(* %INCLUDE 'PMDF_ROOT:[SRC]LOGVAR.INC' *)
-
- outbound : text;
- fromaddr, filename : vstring;
- bull_chan : mm_channel_ptr;
- bull_chan_text : ch_chancode;
- protocol_name : varying [10] of char;
-
- %INCLUDE 'PMDF_ROOT:[SRC]UTILDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]OSDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]APDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]HEDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]LOGDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]SYDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]MMDEF.INC'
- %INCLUDE 'PMDF_ROOT:[SRC]QUDEF.INC'
-
- (* Declare interface routines to BULLETIN *)
-
- procedure INIT_MESSAGE_ADD (
- in_folder : [class_s] packed array [l1..u1 : integer] of char;
- in_from : [class_s] packed array [l2..u2 : integer] of char;
- in_descrip : [class_s] packed array [l3..u3 : integer] of char;
- var ier : boolean); extern;
-
- procedure WRITE_MESSAGE_LINE (
- in_line : [class_s] packed array [l1..u1 : integer] of char); extern;
-
- procedure FINISH_MESSAGE_ADD; extern;
-
- PROCEDURE warn_master (message : varying [len1] of char);
-
- BEGIN (* warn_master *)
- writeln (os_output_file^);
- os_write_datetime (os_output_file^);
- writeln (os_output_file^, message);
- END; (* warn_master *)
-
- (* initialize outbound, mm_ and qu_ *)
-
- PROCEDURE init;
-
- VAR fnam : vstring;
- i, stat : integer;
-
- BEGIN (* init *)
- os_insure_open_output;
- os_jacket_access := true;
- (* Initialize subroutine packages *)
- IF rp_isbad (mm_init) THEN
- mm_abort_program (os_output_file^,
- 'Can''t initialize MM_ ', 20, true);
- IF rp_isbad (qu_init) THEN
- mm_abort_program (os_output_file^,
- 'Can''t initialize QU_ ', 20, false);
- bull_chan := mm_my_channel (bull_chan_text);
- (* Set up the name of the protocol we are servicing/providing *)
- stat := $TRNLOG (lognam := 'PMDF_PROTOCOL',
- rslbuf := protocol_name.body,
- rsllen := protocol_name.length);
- IF (not odd (stat)) OR (stat = SS$_NOTRAN) THEN protocol_name := 'IN%';
- fnam.length := 0;
- IF NOT os_open_file (outbound, fnam, exclusive_read) THEN
- mm_abort_program (os_output_file^,
- 'Can''t open outbound file ', 24, false);
- END; (* init *)
-
- PROCEDURE return_bad_messages (var bad_address : vstring);
-
- LABEL
- 100;
-
- VAR
- line, errorsto : vstring;
- bigline : bigvstring; result : rp_bufstruct;
- header : he_header;
- i : integer;
-
- PROCEDURE try_something (rp_error : integer; routine : string);
-
- BEGIN (* try_something *)
- IF rp_isbad (rp_error) THEN BEGIN
- warn_master ('Routine ' + routine + ' failed while returning message.');
- mm_wkill; goto 100;
- END; (* if *)
- end; (* try_something *)
-
- BEGIN (* return_bad_messages *)
- he_init_header (header);
- try_something (mm_sbinit, 'mm_sbinit');
- initstring (line, 'postmaster@ ', 11);
- catvstring (line, mm_local_channel^.official_hostname);
- try_something (mm_winit (bull_chan_text, line), 'mm_winit');
- try_something (qu_rbtxt, 'qu_rbtxt');
- try_something (he_read_header (header, qu_rtxt), 'he_read_header');
- errorsto.length := 0;
- IF header[he_errors_to] <> NIL THEN WITH header[he_errors_to]^ DO
- IF ltext.length <= ALFA_SIZE THEN BEGIN
- errorsto.length := ltext.length;
- FOR i := 1 TO errorsto.length DO errorsto.body[i] := ltext.body[i];
- END; (* if *)
- IF errorsto.length > 0 THEN BEGIN
- try_something (mm_wadr (mm_local_channel^.official_hostname, errorsto),
- 'mm_wadr');
- try_something (mm_rrply (result), 'mm_rrply');
- END
- ELSE result.rp_val := RP_NO;
- IF rp_isbad (result.rp_val) THEN BEGIN
- copyvstring (errorsto, fromaddr);
- try_something (mm_wadr (mm_local_channel^.official_hostname,
- fromaddr), 'mm_wadr');
- try_something (mm_rrply (result), 'mm_rrply');
- END; (* if *)
- IF bull_chan^.sendpost or rp_isbad (result.rp_val) THEN BEGIN
- initstring (line,
- 'postmaster ', 10);
- try_something (mm_wadr (bull_chan^.official_hostname, line), 'mm_wadr');
- try_something (mm_rrply (result), 'mm_rrply');
- try_something (result.rp_val, 'mm_rrply structure return');
- END; (* if *)
- try_something (mm_waend, 'mm_waend');
- initstring (line, 'From: PMDF Mail Server <Postmaster@ ', 35);
- catvstring (line, mm_local_channel^.official_hostname);
- catchar (line, '>');
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'To: ', 4);
- catvstring (line, errorsto);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Subject: Undeliverable bulletin ', 31);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Date: ', 6);
- os_catdatetime (line);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- line.length := 1; line.body[1] := chr (chr_lf);
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'The message could not be delivered to: ', 38);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- line.length := 1; line.body[1] := chr (chr_lf);
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Addressee: ', 11);
- catvstring (line, bad_address);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, 'Reason: No such bulletin folder. ', 32);
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- line.length := 1; line.body[1] := chr (chr_lf);
- try_something (mm_wtxt (line), 'mm_wtxt');
- initstring (line, '----------------------------------------', 40);
- catchar (line, chr (chr_lf));
- catchar (line, chr (chr_lf));
- try_something (mm_wtxt (line), 'mm_wtxt');
- try_something (he_write_header (header, mm_bigwtxt), 'he_write_header');
- line.length := 1; line.body[1] := chr (chr_lf);
- try_something (mm_wtxt (line), 'mm_wtxt');
- WHILE rp_isgood (qu_rtxt (bigline)) DO
- try_something (mm_bigwtxt (bigline), 'mm_wtxt');
- try_something (mm_wtend, 'mm_wtend');
- try_something (mm_rrply (result), 'mm_rrply');
- try_something (result.rp_val, 'mm_rrply structure return');
- 100:
- END; (* return_bad_messages *)
-
- (* submit messages to BULLETIN *)
-
- PROCEDURE dosubmit;
-
- VAR toaddr, tombox, name : vstring;
- retval : rp_replyval;
- line : bigvstring;
- ier, done : boolean;
- i : integer;
- chan_dummy : mm_channel_ptr;
-
- BEGIN (* dosubmit *)
- WHILE NOT eof (outbound) DO BEGIN
- readvstring (outbound, filename, 0);
- IF rp_isgood (qu_rinit (filename, fromaddr)) THEN BEGIN
- done := false;
- IF rp_isgood (qu_radr (toaddr)) THEN BEGIN
- REPEAT
- retval := qu_radr (name);
- UNTIL rp_isbad (retval);
- chan_dummy := mm_parse_address (toaddr, name, tombox,
- TRUE, FALSE, 0, 0);
- FOR i := 1 TO tombox.length DO
- tombox.body[i] := upper_case (tombox.body[i]);
- INIT_MESSAGE_ADD (substr (tombox.body, 1, tombox.length),
- protocol_name, ' ', ier);
- IF ier THEN BEGIN
- WHILE rp_isgood (qu_rtxt (line)) DO BEGIN
- IF line.length > 0 THEN line.length := pred (line.length);
- WRITE_MESSAGE_LINE (substr (line.body, 1, line.length));
- END; (* while *)
- FINISH_MESSAGE_ADD;
- done := true;
- END
- ELSE BEGIN
- warn_master ('Error opening folder ' +
- substr (tombox.body, 1, tombox.length));
- return_bad_messages (tombox);
- done := true;
- END;
- END
- ELSE warn_master ('Can''t read To: address in file ' +
- substr (filename.body, 1, filename.length));
- IF done THEN qu_rend ELSE qu_rkill (true);
- END
- ELSE warn_master ('Can''t open queue file ' +
- substr (filename.body, 1, filename.length));
- END; (* while *)
- END; (* dosubmit *)
-
- BEGIN (* bulletin_master *)
- init;
- dosubmit;
- mm_end (true);
- qu_end;
- END. (* bulletin_master *)
-$eod
-$copy/log sys$input MASTER.COM
-$deck
-$ ! MASTER.COM - Initiate delivery of messages queued on a channel
-$ !
-$ ! Modification history and parameter definitions are at the end of this file.
-$ !
-$ set noon
-$ !
-$ ! Clean up and set up channel name, if on hold just exit
-$ !
-$ channel_name = f$edit(p1, "COLLAPSE,LOWERCASE")
-$ hold_list = "," + f$edit(f$logical("PMDF_HOLD"), "COLLAPSE,LOWERCASE") + ","
-$ if f$locate("," + channel_name + ",", hold_list) .lt. -
- f$length(hold_list) then exit
-$ define/process pmdf_channel "''channel_name'"
-$ !
-$ ! Save state information, set up environment properly
-$ !
-$ save_directory = f$environment("DEFAULT")
-$ set default pmdf_root:[queue]
-$ save_protection = f$environment("PROTECTION")
-$ set protection=(s:rwed,o:rwed,g,w)/default
-$ save_privileges = f$setprv("NOSHARE")
-$ !
-$ if f$logical("PMDF_DEBUG") .eqs. "" then on control_y then goto out
-$ !
-$ ! Create listing of messages queued on this channel.
-$ !
-$ if p3 .eqs. "" then p3 = "1-JAN-1970"
-$ dirlst_file = "pmdf_root:[log]" + channel_name + "_master_dirlst_" + -
- F$GETJPI ("", "PID") + ".tmp"
-$ define/process outbound 'dirlst_file'
-$ directory/noheader/notrailer/column=1/since="''p3'"/output='dirlst_file' -
- pmdf_root:[queue]'channel_name'_*.%%;*
-$ !
-$ ! Determine whether or not connection should really be made
-$ !
-$ if p2 .nes. "POLL" .and. -
- f$file_attributes(dirlst_file, "ALQ") .eq. 0 then goto out1
-$ !
-$ ! Handle various channels specially
-$ !
-$ if channel_name .eqs. "l" then goto local_channel
-$ if channel_name .eqs. "d" then goto DECnet_compatibility_channel
-$ if channel_name .eqs. "directory" then goto dir_channel
-$ if f$extract(0,5,channel_name) .eqs. "anje_" then goto BITNET_channel
-$ if f$extract(0,4,channel_name) .eqs. "bit_" then goto BITNET_channel
-$ if f$extract(0,5,channel_name) .eqs. "bull_" then goto BULLETIN_channel
-$ if f$extract(0,3,channel_name) .eqs. "cn_" then goto CN_channel
-$ if f$extract(0,5,channel_name) .eqs. "ctcp_" then goto CTCP_channel
-$ if f$extract(0,3,channel_name) .eqs. "dn_" then goto DECnet_channel
-$ if f$extract(0,6,channel_name) .eqs. "dsmtp_" then goto DSMTP_channel
-$ if f$extract(0,5,channel_name) .eqs. "etcp_" then goto ETCP_channel
-$ if f$extract(0,5,channel_name) .eqs. "ftcp_" then goto FTCP_channel
-$ if f$extract(0,4,channel_name) .eqs. "ker_" then goto KER_channel
-$ if f$extract(0,5,channel_name) .eqs. "mail_" then goto MAIL_channel
-$ if f$extract(0,5,channel_name) .eqs. "mtcp_" then goto MTCP_channel
-$ if f$extract(0,5,channel_name) .eqs. "px25_" then goto PX25_channel
-$ if f$extract(0,4,channel_name) .eqs. "tcp_" then goto TCP_channel
-$ if f$extract(0,5,channel_name) .eqs. "test_" then goto TEST_channel
-$ if f$extract(0,5,channel_name) .eqs. "uucp_" then goto UUCP_channel
-$ if f$extract(0,5,channel_name) .eqs. "wtcp_" then goto WTCP_channel
-$ if f$extract(0,6,channel_name) .eqs. "xsmtp_" then goto XSMTP_channel
-$ !
-$ ! This must be a PhoneNet channel (the default); set up and use MASTER
-$ ! Read the list of valid connection types for each channel.
-$ !
-$ cnt = f$integer("0")
-$ open/read/error=regular_master pmdf_data pmdf_root:[table]phone_list.dat
-$ list_loop:
-$ read/end=eof_list pmdf_data line
-$ ! Ignore comment lines.
-$ if (f$extract (0, 1, line) .eqs. "!") then -
- goto list_loop
-$ line = f$edit (line, "COMPRESS,LOWERCASE")
-$ ! Get the channel name from the line read.
-$ chan = f$extract (0, f$locate(" ", line), line)
-$ if (chan .nes. channel_name) then -
-$ goto list_loop
-$ ! Get the connection name
-$ name = f$edit(f$extract(f$locate(" ",line),255,line),"COLLAPSE")
-$ ! If none, then ignore the line
-$ if name .eqs. "" then -
- goto list_loop
-$ ! Found at least one to try.
-$ cnt = cnt + 1
-$ @pmdf_root:[exe]all_master.com 'name'
-$ define PMDF_DEVICE TT
-$ !
-$ ! Define other logical names
-$ !
-$ define/user script pmdf_root:[table.'channel_name']'name'_script.
-$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp
-$ define/user option_file pmdf_root:[table]'channel_name'_option.
-$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn
-$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log
-$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log
-$ !
-$ ! This check attempts to verify that we are in fact the owner process of
-$ ! the device, TT. If the device is sharable, then we ignore the
-$ ! owner.
-$ !
-$ if (f$getdvi("TT","pid") .nes. f$getjpi(0,"pid")) .and. -
- (f$getdvi("TT","shr") .eqs. "FALSE") then -
- goto list_loop
-$ !
-$ ! Run master to deliver the mail
-$ !
-$ run pmdf_root:[exe]master
-$ exit_stat = $status
-$ !
-$ ! Activate optional cleanup script to reset terminal/modem
-$ !
-$ if f$search("pmdf_root:[exe]''name'_cleanup.com") .nes. "" then -
- @pmdf_root:[exe]'name'_cleanup.com 'exit_stat'
-$ deallocate TT
-$ deassign TT
-$ deassign PMDF_DEVICE
-$ !
-$ ! If master does not exit normally, then try a different connection.
-$ !
-$ if exit_stat .ne. 1 then goto list_loop
-$ eof_list:
-$ close pmdf_data
-$ !
-$ ! If we found at least one connection type for this channel, then skip
-$ ! the attempt to use the conventional mechanism.
-$ !
-$ if cnt .gt. 0 then goto out_phonenet
-$ !
-$ regular_master:
-$ @pmdf_root:[exe]'channel_name'_master.com
-$ define PMDF_DEVICE TT
-$ !
-$ ! Define logical names
-$ !
-$ define/user script pmdf_root:[table]'channel_name'_script.
-$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp
-$ define/user option_file pmdf_root:[table]'channel_name'_option.
-$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn
-$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log
-$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log
-$ !
-$ run pmdf_root:[exe]master
-$ exit_stat = $status
-$ !
-$ ! Activate optional cleanup script to reset terminal/modem
-$ !
-$ if f$search("''channel_name'_cleanup.com") .nes. "" then -
- @pmdf_root:[exe]'channel_name'_cleanup.com 'exit_stat'
-$ deallocate TT
-$ deassign TT
-$ deassign PMDF_DEVICE
-$ !
-$ out_phonenet:
-$ if P4 .eqs. "POST" then wait 00:00:30
-$ goto out1
-$ !
-$ ! Directory channel
-$ !
-$ dir_channel:
-$ !
-$ run pmdf_root:[exe]dir_master
-$ goto out1
-$ !
-$ ! This is a DECnet channel; set up and use DN_MASTER
-$ !
-$ DECnet_channel:
-$ !
-$ ! Define other logical names
-$ !
-$ node_name = f$edit(channel_name - "dn_", "UPCASE")
-$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp
-$ define/user option_file pmdf_root:[table]'channel_name'_option.
-$ define/user di_transcript pmdf_root:[log]di_'channel_name'_master.trn
-$ define/user ph_logfile pmdf_root:[log]ph_'channel_name'_master.log
-$ define/user di_errfile pmdf_root:[log]di_'channel_name'_master.log
-$ define/user pmdf_node "''node_name'::""PMDF="""
-$ !
-$ run pmdf_root:[exe]dn_master
-$ goto out1
-$ !
-$ ! This is a BITNET channel; use BN_MASTER
-$ !
-$ BITNET_channel:
-$ !
-$ if channel_name .eqs. "bit_gateway" then goto BITNET_gateway
-$ run pmdf_root:[exe]bn_master
-$ goto out1
-$ !
-$ ! This is the BITNET gateway channel; use BN_GATEWAY
-$ !
-$ BITNET_gateway:
-$ !
-$ run pmdf_root:[exe]bn_gateway
-$ goto out1
-$ !
-$ ! This is a BULLETIN channel; use BULLETIN_MASTER
-$ !
-$ BULLETIN_channel:
-$ !
-$ run pmdf_root:[exe]bulletin_master
-$ goto out1
-$ !
-$ ! This is a Tektronix TCP channel; use TCP_MASTER
-$ !
-$ TCP_channel:
-$ !
-$ run pmdf_root:[exe]tcp_master
-$ goto out1
-$ !
-$ ! This is a CMU/Tektronix TCP channel; use CTCP_MASTER
-$ !
-$ CTCP_channel:
-$ !
-$ run pmdf_root:[exe]ctcp_master
-$ goto out1
-$ !
-$ ! This is a Wollongong TCP channel; use WTCP_MASTER
-$ !
-$ WTCP_channel:
-$ !
-$ ! Define other logical names
-$ !
-$ run pmdf_root:[exe]wtcp_master
-$ goto out1
-$ !
-$ ! This is a MultiNet TCP channel; use MTCP_MASTER
-$ !
-$ MTCP_channel:
-$ !
-$ run pmdf_root:[exe]mtcp_master
-$ goto out1
-$ !
-$ ! This is a Excelan TCP channel; use ETCP_MASTER
-$ !
-$ ETCP_channel:
-$ !
-$ run pmdf_root:[exe]etcp_master
-$ goto out1
-$ !
-$ ! This is an NRC Fusion TCP channel; use FTCP_MASTER
-$ !
-$ FTCP_channel:
-$ !
-$ run pmdf_root:[exe]ftcp_master
-$ goto out1
-$ !
-$ CN_channel:
-$ !
-$ ! Define other logical names
-$ !
-$ define/user script pmdf_root:[table]'channel_name'_script.
-$ ! following may vary: should point to cnio's group
-$ define/table=lnm$process_directory lnm$temporary_mailbox lnm$group_000277
-$ !
-$ run/nodeb'p5' pmdf_root:[exe]cn_smtp_master
-$ goto out1
-$ !
-$ KER_channel:
-$ !
-$ ! kermit protocol is slave only. If we get here there has been a mistake.
-$ ! however we will just exit and no harm done.
-$ goto out1
-$ !
-$ ! This is a PhoneNet X25 channel; set up and use PX25_MASTER
-$ !
-$ PX25_channel:
-$ !
-$ ! Define other logical names
-$ !
-$ define/user ph_current_message pmdf_root:[log]'channel_name'_master_curmsg.tmp
-$ define/user option_file pmdf_root:[table]'channel_name'_option.
-$ define/user di_transcript pmdf_root:[log]'channel_name'_di_master.trn
-$ define/user ph_logfile pmdf_root:[log]'channel_name'_ph_master.log
-$ define/user di_errfile pmdf_root:[log]'channel_name'_di_master.log
-$ !
-$ run pmdf_root:[exe]PX25_master
-$ goto out1
-$ !
-$ ! This is a DEC/Shell channel; set up and use UUCP_MASTER
-$ !
-$ UUCP_channel:
-$ !
-$ ! Define other logical names
-$ !
-$ uucp_to_host = channel_name - "uucp_"
-$ define/user uucp_to_host "''uucp_to_host'"
-$ define/user uucp_current_message -
- pmdf_root:[log]'channel_name'_master_curmsg.tmp
-$ define/user uucp_logfile pmdf_root:[log]'channel_name'_master.logfile
-$ !
-$ run pmdf_root:[exe]UUCP_master
-$ uupoll = "$shell$:[usr.lib.uucp]uupoll"
-$ uupoll 'uucp_to_host'
-$ goto out1
-$ !
-$ ! This is a X.25 SMTP channel; set up and use XSMTP_MASTER
-$ !
-$ XSMTP_channel:
-$ !
-$ run pmdf_root:[exe]xsmtp_master
-$ goto out1
-$ !
-$ ! This is a DECNET SMTP channel; set up and use DSMTP_MASTER
-$ !
-$ DSMTP_channel:
-$ !
-$ run pmdf_root:[exe]dsmtp_master
-$ goto out1
-$ !
-$ ! Handle delivery on the local channel, MAIL_ channels, and
-$ ! the DECnet compatibility channel
-$ !
-$ MAIL_channel:
-$ local_channel:
-$ DECnet_compatibility_channel:
-$ open/read queue_file 'dirlst_file'
-$ local_loop:
-$ read/end=exit_local_loop/error=exit_local_loop queue_file file_to_process
-$ priv_list = f$setprv("SYSPRV, DETACH")
-$ mail/protocol=pmdf_mailshr 'file_to_process'
-$ priv_list = f$setprv(priv_list)
-$ goto local_loop
-$ !
-$ exit_local_loop:
-$ close queue_file
-$ goto out1
-$ !
-$ ! This is a SMTP test channel, use TEST_SMTP_MASTER
-$ !
-$ TEST_channel:
-$ !
-$ ! Typically some form of redirection is needed here...
-$ deassign sys$input
-$ run pmdf_root:[exe]test_smtp_master
-$ goto out1
-$ !
-$ out1:
-$ delete 'dirlst_file';*
-$ !
-$ ! Common exit point - clean up things first
-$ !
-$ out:
-$ if f$logical("OUTBOUND") .nes. "" then deassign/process outbound
-$ if f$logical("PMDF_CHANNEL") .nes. "" then deassign/process pmdf_channel
-$ if f$logical("PMDF_DATA") .nes. "" then close pmdf_data
-$ if f$logical("PMDF_DEVICE") .eqs. "" then goto restore
-$ deallocate TT
-$ deassign TT
-$ deassign PMDF_DEVICE
-$ restore:
-$ !
-$ ! Restore saved stuff
-$ !
-$ set protection=('save_protection')/default
-$ set default 'save_directory'
-$ set process/priv=('save_privileges')
-$ !
-$ exit
-$ !
-$ ! Modification history:
-$ !
-$ ! This version by Ned Freed, 20-Jul-1986
-$ !
-$ ! Modified by Gregg Wonderly to allow multiple connections for each channel
-$ ! 10-Oct-1986.
-$ ! Some additions by Ned Freed 30-Oct-86.
-$ ! Added CMU/Tektronix TCP channel (CTCP) /Kevin Carosso 6-Mar-1987
-$ ! Added Multinet TCP channel (MTCP) /Ned Freed 10-Mar-1987
-$ ! Added directory save/restore /Ned Freed 1-Jun-1987
-$ ! Added Excelan TCP channel (ETCP) /Ned Freed 9-Jul-1987
-$ ! Added MAIL, CNIO, KERMIT channel /Bob Smart 4-Jul-1987
-$ ! Added Warwick Jackson's PhoneNet X25 support /Ned Freed 5-Sep-87
-$ ! Added X25 SMTP channel SX25_ /Goeran Bengtsson, Mats Sundvall 24-Jul-87
-$ ! Added NRC Fusion TCP channel (FTCP) /Kevin Carosso 12-Jan-1988
-$ ! Added a variant of Randy McGee's code to put a list of channels on hold
-$ ! /Ned Freed 9-Feb-1988
-$ ! Made this procedure save and restore a little more state information
-$ ! than it used to, including default protection and privileges. Also
-$ ! moved a bunch of the logical name assignments around to eliminate
-$ ! redundant code all over the place. /Ned Freed 10-Feb-1988
-$ ! Modified to allow P3 date/time paramter. /Ned Freed 23-Feb-1988
-$ ! Added support for Dennis Boylan's UUCP channel. /Ned Freed 28-Mar-1988
-$ ! Added Robert Smart's directory channel. /Ned Freed 21-Apr-1988
-$ ! Added support for Warwick Jackson's SMTP over X.25 and SMTP over
-$ ! DECnet channels. /Ned Freed 26-May-1988
-$ ! Added P4 and P5 parameters. /Ned Freed 10-Jun-1988
-$ ! Added code to call the TEST_SMTP_MASTER for testing. /Ned Freed 1-Jul-1988
-$ ! Added preliminary support for ANJE. /Ned Freed 7-Jul-1988
-$ ! Removed extra dispatch for WTCP_ channel. /Ned Freed 3-Sep-1988
-$ ! Added dispatch for BULL_ channel. /Ned Freed 28-Nov-1988
-$ ! Cleaned up error recovered and emergency exit -- close PHONE_LIST.DAT
-$ ! file when aborting. /Ned Freed 13-Dec-1988
-$ ! Additional error recovery cleanup -- use PMDF_DEVICE instead of TT to
-$ ! allow deallocation on an abort. /Ned Freed 14-Dec-1988
-$ !
-$ ! Parameters:
-$ !
-$ ! P1 - Name of the channel whose messages are to be delivered.
-$ ! P2 - Activity type. If P2 .eqs. "POLL", establish the connection
-$ ! unconditionally, otherwise only establish the connection if
-$ ! messages are waiting in the queue.
-$ ! P3 - Earliest possible date/time for message(s). Messages older than
-$ ! this time are not processed.
-$ ! P4 - Environment. P4 .eqs. "POST" if MASTER is being called from the
-$ ! POST.COM procedure or some other procedure that invokes MASTER
-$ ! more than once. This parameter is used to insert delays before
-$ ! returning if hardware needs time to reset.
-$ ! P5 - Parameter reserved for channel-specific uses.
-$eod
-$copy/log sys$input PMDF.TXT
-$deck
-This describes the procedure necessary to use BULLETIN with PMDF. You must
-be using at least PMDF V3.1. If using V3.2 you will instead have to use
-BULLETIN_MASTER.PAS_V32. V3.2 does come with it's own BULLETIN_MASTER.PAS, but
-there is a small bug in it.
-
-BULLETIN_MASTER.PAS and MASTER.COM are the files you need to run a BULLETIN
-channel. Put BULLETIN_MASTER.PAS in a subdirectory of PMDF_ROOT:[SRC] (I use
-the directory PMDF_ROOT:[SRC.BULLETIN]). Compile it there and then link it as
-follows. This might result in undefined reference errors. You can ignore them,
-as these are routines that are used for connecting to USENET NEWS, and are not
-used by the BULLETIN_MASTER executable.
-
-For V3.1:
-
- LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER -
- BULLETIN_MASTER,[EXE]PMDFLIB/LIB,BULL_SOURCE:BULL/LIB, -
- PMDF_ROOT:[EXE]VAXC/OPT
-
-For V3.2:
-
- LINK /EXE=PMDF_ROOT:[EXE]BULLETIN_MASTER -
- BULL_DIR:BULLETIN_MASTER,PMDF_ROOT:[EXE]PMDFSHR_LINK.OPT/OPT, -
- [EXE]IDENT.OPT/OPT,BULL_SOURCE:BULL.OLB/LIB,PMDF_ROOT:[EXE]VAXC/OPT
-
-If you need to, put the new MASTER.COM in PMDF_ROOT:[EXE]. NOTE: Check your
-MASTER.COM, as the latest version of PMDF contains the code necessary to check
-for bulletin mail. However, it will not necessary have the latest copy of
-BULLETIN_MASTER.PAS.
-
-You then need a channel definition like the following in your configuration
-file PMDF.CNF:
-
- bull_local single logging
- BULLETIN-DAEMON
-
-And a rewrite rule of the form:
-
- BULLETIN $U%BULLETIN@BULLETIN-DAEMON
-
-Then you put an alias in your ALIASES. file for each mailing list you want to
-process this way. I have the following:
-
- info-vax: info-vax@bulletin
- tex-hax: tex-hax@bulletin
- xmailer-list: xmailer@bulletin
- mail-l: mail-l@bulletin
- jnet-l: jnet-l@bulletin
- policy-l: policy-l@bulletin
- future-l: future-l@bulletin
- mon-l: mon-l@bulletin
- ug-l: ug-l@bulletin
-
-Then mail sent to info-vax@localhost will be routed to a folder called
-info-vax. In general, an alias of the form
-
- a : b@bulletin
-
-will route mail sent to a@localhost to folder b in BULLETIN.
-
-NOTE: If you have BBOARD set for a folder that you convert to be delivered
-directly to PMDF, remember to do a SET NOBBOARD for that folders (unless
-using the LISTSERV option. See HELP SET BBOARD LISTSERV for more info). After
-doing so, restart BULLCP using BULLETIN/START.
-$eod
diff --git a/util/.gitignore b/util/.gitignore
deleted file mode 100644
index f5387d94e6660808ac9bdc9e7161ac1ce81f16a2..0000000000000000000000000000000000000000
--- a/util/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-fpt