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