;[CSC60]HOWDY:MLIST.NEW.2, 14-May-86 19:45:29, Edit by FORDYCE ;[ti-38] Make the DESCRIBE command an option to the ADD command instead ; 7(25) ;[TI-CSL60]HOWDY:MLIST.NEW.22, 31-Oct-85 19:47:39, Edit by FORDYCE ;[ti-37] Change the auto-re-munge process of running a subfork to do the ; 7(24) SUBMIT, rather than a rescan SUBMIT ;[TI-CSL60]HOWDY:MLIST.NEW.21, 31-Oct-85 16:58:44, Edit by FORDYCE ;[ti-36] Add code so that if the batch database re-munge is in progress, then ; 7(23) just tell the user to please wait, and exit (to keep >1 munge from ; appearing at a time. If a batch job, then don't even check for ; munge flag ;[TI-CSL60]HOWDY:MLIST.NEW.19, 30-Oct-85 23:50:17, Edit by FORDYCE ;[ti-35] Fix code at NEXT: to better handle RCUSR errors ; 7(22) ;[TI-CSL60]HOWDY:MLIST.NEW.17, 30-Oct-85 22:15:23, Edit by FORDYCE ;[ti-34] Add a little error logging at NEXT to print out the bad user name ; 7(21) Add ALLOK label to help track recent problems ;[TI-CSL60]HOWDY:MLIST.NEW.15, 3-Apr-85 14:59:02, Edit by FORDYCE ;[ti-33] Require at least DELETE privs to delete a mailing list too. ; 7(20) Add quoted string to the list of available DELETE options. ;[TI-CSL60]HOWDY:MLIST.NEW.13, 13-Feb-85 23:14:30, Edit by FORDYCE ;[ti-32] Add use of PRVTAB: to distinguish between levels of MLIST priv's ; 7(17) Update SAVMNG: routine to handle saving priv's ; Update $PRMIT: routine ; Clarify REVOKE command/noise word syntax ;MLIST.MAC.90, 15-Nov-84 11:28:31, Edit by FORDYCE ;[ti-31] Add MAXLST to be the maximum number of mailing lists supported ; 7(16) by MLIST. Tell user if a "create" request exceeds this quota. ;MLIST.MAC.89, 15-Nov-84 10:16:37, Edit by FORDYCE ;[ti-30] Save updated list of authorized mungers ; 7(15) ;MLIST.MAC.84, 15-Nov-84 08:27:57, Edit by FORDYCE ;[ti-29] Clean up AUTHORIZE command ;MLIST.MAC.83, 14-Nov-84 12:56:56, Edit by FORDYCE ;[ti-28] Add MMAILBOX/XMAILBOX (depending on setting of assembly-time ; 7(14) switches) to top level command table ;MLIST.MAC.82, 14-Nov-84 10:11:24, Edit by FORDYCE ;[ti-27] Add check for "full" PMTTAB: ;MLIST.MAC.81, 13-Nov-84 23:29:01, Edit by FORDYCE ;[ti-26] Correct setup for "new" mungers (in INIT:) ; MLIST.MAC.78, 13-Nov-84 14:40:37, Edit by FORDYCE ;[ti-25] Clean up $$AUTH ;MLIST.MAC.77, 13-Nov-84 13:41:17, Edit by FORDYCE ;[ti-24] Fix problem with $BUILD routine clobbering flag word ; 7(13) ;MLIST.MAC.76, 12-Nov-84 23:31:17, Edit by FORDYCE ;[ti-23] Add %TBINI routine to initialize "mlist mungers" tbluk table ; 7(12) ;MLIST.MAC.68, 12-Nov-84 09:39:12, Edit by FORDYCE ;[ti-22] Replace REPARS with REPAR$ ; 7(11) RESTAR with RE$TAR in order to resolve multiple ; definitions between MLIST source and CMD.MAC ; Run SYS:MLIST_HELP20.EXE as a subfork, rather than trying ; to resolve all linking/stack/command state block problems ;M20.MAC.3, 24-Oct-84 12:52:21, Edit by FORDYCE ;[ti-21] Make HELP20 support assembly time switched (H20SW==1) ; 7(10) ; MLIST.MAC.66, 20-Sep-84 15:54:21, Edit by FORDYCE ; [ti-20] Add HELP20 support ;MLIST.MAC.61, 16-Aug-84 13:45:50, Edit by FORDYCE ; [ti-19] Add secondary TBLUK command tables for users ; who are "MLIST-authorized" to use ; Add $$AUTH routine for SHOW command ; Check authorized user status on DELETE, PURGE ;MLIST.MAC.59, 15-Aug-84 17:24:29, Edit by FORDYCE ; [ti-18] Add CLRBUF macro, and make use of it ;MLIST.MAC.54, 15-Aug-84 16:52:27, Edit by FORDYCE ; [ti-17] Check to see if there is room for more entries on the ; specified mailing list on an "ADD", and give the user ; instructions if the mailing list is FULL ;MLIST.MAC.53, 15-Aug-84 14:23:02, Edit by FORDYCE ; [ti-16] Add NWNAME assembly-time switch to let each ; site decide for itself whether it wants the ; restriction applied so that no network addresses ; can be added to a mailing list already having a ; mailing list name. ;MLIST.MAC.23, 9-Aug-84 12:32:07, Edit by FORDYCE ; 7(7) [ti-15] Expand mailbox support to allow for running ; either XMAILBOX or MMAILBOX ;MLIST.MAC.22, 8-Aug-84 15:38:21, Edit by FORDYCE ; [ti-14] Clean up "renamed from" message ;MLIST.MAC.18, 8-Aug-84 13:57:42, Edit by FORDYCE ; 7(6) [ti-13] Restore support for mailing list names (removed ; in [ti-10] below) ;MLIST.MAC.17, 10-Jul-84 14:44:40, Edit by FORDYCE ; 7(5) [ti-12] Fix bug in "DELETE {file} (from) {mailing list}" ; code which RLJFNed the JFN for the file to-be-deleted ; before MLIST had a chance to check all file names in ; the particular mailing list. ; Changed JFNS punctuation bits to exclude the file ; to-be-deleted's generation number. ;MLIST.MAC.16, 21-Feb-84 10:49:31, Edit by FORDYCE ; Reason: [ti-11] Add DESCRIBE and WHAT commands to, respectively, ; 7(4) document what a mailing list is for, and to display ; that documentation ;MLIST.MAC.6, 1-Feb-84 22:39:45, Edit by FORDYCE ; Reason: [ti-10] Remove mailing list name support ; 7(3) ;MLIST.MAC.19, 19-Jul-83 15:23:58, Edit by FORDYCE ; Reason: [ti-9] Add Kaiser to PMTTAB: (removing JETER) ; 7(2) Increase MAXUSR to ^D199 (199 entries + 1 header word) ; Add DBUGSW ; Change references to 500 to DTAPAG ; Adjust the format of MLIST.PMAP to: ; o support up to ^d200 mailing lists ; o support up to ^d199 entries per mailing list ; o move output MLIST-RESTORE.LOG to PS: ;MLIST.MAC.3, 17-Jun-83 11:07:14, Edit by FORDYCE ; Reason: [ti-8] Don't allow network mailboxes in mailing lists with ; 7(1) mailing list names ; Add MAILBOX support to VERIFY command ; Make MAILBOX support assembly-time-switched (for 2020) ;MLIST.MAC.11, 13-Jun-83 16:37:46, Edit by FORDYCE ; Reason: [ti-7] Add MALBOX code to check for mailboxes ; 7(0) ;MLIST.MAC.10, 2-May-83 08:38:16, Edit by FORDYCE ; Reason: [ti-6] Add switch to SUBMIT command (/batch-log:append) to ; 6(^d18) override individual users' batch defaults ; ;MLIST.MAC.9, 11-Oct-82 22:52:37, Edit by FORDYCE ; Reason: [ti-5] Correct problem in detection of adding network addresses ; 6(^d17) to mailing lists ; ;MLIST.MAC.8, 7-Sep-82 10:51:52, Edit by FORDYCE ; Reason: [ti-4] Added code to better handle 'double confirm' on ; 6(^d16) 'DELETE ' command. ; ;MLIST.MAC, 15-Jul-82, Edit by FORDYCE ; REASON: [ti-3] Changed directories for MLIST.LOG and MLIST-RESTORE.LOG ; 6(^d15) to SUB:. Removed KEHLER from PMTTAB:. Added XPORT ; assembly-time switch. ; ;MLIST.MAC, 15-Jul-82, Edit by FORDYCE ; REASON: [ti-2] To correct problem with not being able to add network ; 6(^d14) addresses regardless of whether or not a valid 2060 ; (local) user id existed. ; ;MLIST.MAC, 24-Jun-82, Edit by FORDYCE ; REASON: [ti-1] To correct problem with re-entry address to JRST to ; 6(^d13) ; ;MLIST.MAC, 18-May-82, Edit by FORDYCE ; REASON: To change references to SYSTEM:DECNET-HOSTS.TXT to ; 6(^d12) SUB:MLIST-DECNET-HOSTS.TXT because I don't want to ; take the time now to modify the ...HOSTS.TXT file ; parse routine to handle = ! ; (etc.) Removed ; PATTERMANN from PMTTAB. ; ;MLIST.MAC, 6-Feb-82, Edit by FORDYCE ; REASON: To correct problem with individual users' logical names ; 6(^d11) (preceding file specs) getting stored in system-wide ; mailing lists, instead of the true file spec. ; ;MLIST.MAC, 21-Dec-81, Edit by FORDYCE ; REASON: To correct problem with protection code getting set too ; 6(^d10) strict when new SUB:MLIST.PMAP file is created. ; ;MLIST.MAC, 5-Dec-81, Edit by FORDYCE ; REASON: To increase the maximum number of 'users' per mailing list ; 6(^d9) from ^d50 to ^d100. Increased the size of the PMAPed file ; SUB:MLIST.PMAP to handle the increase in the maximum number ; of users per mailing list. ; ;MLIST.MAC, 25-Nov-81, Edit by FORDYCE ; REASON: Add conditional assembly for the initialization notification ; 6(^d8) scheme for PCL / non-PCL EXEC sites. ; Removed Miller from pmttab: ; ;MLIST.MAC, 17-Sep-81, Edit by FORDYCE ; REASON: Add the PURGE command to do the following: ; 6(^d7) 1) delete a user from all mailing lists, or ; 2) guide the user through the mailing lists that he is on, ; asking for yes or no ; ;MLIST.MAC, 29-Jul-81, Edit by FORDYCE ; REASON: Modify 're-initialization' code so that when the mailing list ; 6(^d6) data base is out of sync with the MLIST: directory, MLIST submits ; a batch job to do the re-initialization, instead of requiring the ; user to wait while the re-initialization is done. The batch job ; notifies the user when the re-initialization is complete. ; ;MLIST.MAC, 21-Apr-81, Edit by FORDYCE ; REASON: Add ALL option to "SHOW USERS" to show all the users for all the ; 6(^d5) mailing lists. ; ;MLIST.MAC, 20-Feb-81, Edit by FORDYCE ; REASON: If the site using MLIST does not have DECNET and/or the ; 6(^d4) file PS:DECNET-HOSTS.TXT containing DECNET node ; names does not exist, then proceed as normally, but don't ; try to parse a network address. ; ;MLIST.MAC, 9-Feb-81, Edit by FORDYCE ; REASON: (1) To modify the break mask when parsing the file name ; 6(^d3) of a mailing list so that periods are allowed (this was ; inadvertently changed during modification to allow network ; addresses) ; (2) To allow the addition of network addresses ONLY to mailing ; lists which DO NOT have mailing list names (i.e. of the format ; 'Mail-list:' . This is a restriction brought about by MM's ; net-mail capabilities). ; ;MLIST.MAC, 29-Jan-81, Edit by FORDYCE ; REASON: To check if the user is authorized to do a MUNGE BEFORE ; 6(2) the %cmnoi ; ;MLIST.MAC, 21-Jan-81, Edit by FORDYCE ; REASON: (1) To permit the user, during the VERIFY command, to ; 6(1) delete an invalid user or file spec from a mailing list ; (2) To increase the flexibility of the ADD command - ; allow the user to add a network address to a mailing list ; (3) To provide verification of the network address that ; is being added to a mailing list ; ;MLIST.MAC, 5-Jan-81, Edit by FORDYCE ; REASON: (1) To add a new command - 'VERIFY', which allows the user to ; 6(0) check the validity of entries in a mailing list(s) . ; (2) To correct the problem of parsing mailing lists with ; mailing list names but without entries. ; (3) To allow the 'DELETE' command to delete entire mailing ; lists. ; ;MLIST.MAC, 3-Dec-80, Edit by FORDYCE ; REASON: To allow the user to delete obsolete file specs from ; 5(4) mailing lists (i.e. alter the break mask for .CMFLD ; to exclude the following characters: ; ! % * . : < > ; ;MLIST.MAC, 25-Nov-80, Edit by FORDYCE ; REASON: To incorporate the move of the MLIST data base from ; 5(3) PS: to PS: ; ;MLIST.MAC, 24-Nov-80, Edit by FORDYCE ; REASON: To use TBLUK to validate user access to invoke MUNGE ; 5(2) ; ;MLIST.MAC, 19-Nov-80, Edit by FORDYCE ; REASON: (1) To open the MLIST data base with thawed access ; 5(1) to allow simultaneous to the data base by ; multiple users ; (2) To correct problem with DELETEing the last entry ; from a mailing list and then ADDing another entry ; resulting in 2 commas with no entry in between (in the ; file ; (3) To put a at the end of the file when ; invoking the following options: ADD, CREATE, DELETE, ; and RENAME ; (4) To incorporate a user validation system so that only ; certain users can invoke MUNGE ; ;[End of Edit History] TITLE MLIST - Mailing List Manager SUBTTL Written by David Fordyce $VERNO=7 $EDNO=25 ;************************************************************************* ; ; MLIST was written for the purpose of providing some "automated" ; means of maintaining mailing lists, as used by MM and BABYL. ; ; MLIST support for mailboxes was extracted from MMAILR/MMAILBOX ; (from the MM Mail System, courtesy of Stanford University). ; ;************************************************************************* ;* * ;* DISCLAIMER: This was my "very first" experience with programming * ;* in DEC-20 MACRO, so please excuse any glaring coding oddities. * ;* Although I have enhanced MLIST over the last couple of years, I have * ;* left all the code that worked alone. * ;* * ;************************************************************************* ; ; Communications about MLIST should be addressed to: ; ; David Fordyce ; Texas Instruments Incorporated ; Computer Science Laboratory ; P.O. Box 226015 ; M/S 238 ; Dallas, TX 75266 ; (214) 995-0375 ; FORDYCE@TI-CSL.CSNET SUBTTL Definitions SEARCH Cusym ; obtain Columbia macros, ; symbols, etc. twoseg ; use twoseg for purity %setenv ; Search Monsym, Macsym, ; initialize things external helper, helprf, rescan ; CUrel routines [ti-11] ; ; define registers (just for informational purposes) ; ; p=:17 ; Stack pointer ; cx=:16 ; Call / Return temporary ; .sac=:16 ; CU / MacSym utility register ; f=:0 ; Flag register (preserved) ; t1=:1 ; General temp and Jsys registers: ; t2=:2 ; never preserved ; t3=:3 ; ... ; t4=:4 ; ; q1=:5 ; First set of preserved regs ; q2=:6 ; (must be preserved by callee ; q3=:7 ; across a call) ; p1=:10 ; Second set of preserved registers ; p2=:11 ; (ditto) ; p3=:12 ; ; p4=:13 ; ; p5=:14 ; ; p6=:15 ; NB: not useable with TrVar MacSym ; ; facility ; .fp=:15 ; Frame pointer for Trvar facility ; SUBTTL Flag Definitions %flags comment \ xitflg: on to indicate that an exit has been requested. rscflg: on to indicate that the command line contains data other than the name of this program (MList) which may be parameters to feed to this program. strflg: on to indicate that a <*structure|user-name|file name> is included as part of the mailing list, so let the first ":" that is encountered be treated as another ordinary alpha- numeric character flag2: on to indicate that a mailing list entry (i.e. a user name) is of the format '*ps:< user name > abc.xyz'. fstnam: on to indicate that the next mailing list name will be the first asciz string added to mmnams: , so do not do any calculations to determine the address at which to begin storing the string. Store the asciz string beginning at address mmnams+1 . colflg: on to indicate that the current mailing list being processed does not contain an actual name of a mailing list of the form ':'. (This mailing list is probably obsolete ?) gotusr: on to indicate that a non-blank user is currently being parsed; or has been immediately followed with a blank rather than a comma. gotnam: on to indicate that the name of a mailing list (as found in a file containing a mailing list) is being parsed. anynam: on to indicate that the current mailing list does contain a mailing list name, whether or not it has any entries. anyusr: on to indicate that at least one "user" has been found in the mailing list that is currently being parsed. anylst: on to indicate that at least one mailing list containing the user-specified user name has been found. anymng: on to indicate that MUNGE was performed. If MUNGE WAS performed, a new version of the mailing list data base was created in the pages beginning at location 500000. So PMAP these pages from process to file to make this copy of the mailing list data base permanent instead of UNmapping the process pages to the file. If MUNGE WAS NOT performed, the mailing list data base was PMAPed from the file containing the permanent copy of the mailing list data base into the process pages beginning at location 500000. anydbs: on to indicate that a mailing list data base DOES exist. anymap: on to indicate that the mailing list data base is mapped from the permanent copy in the file to the process pages. Off to indicate that the next time that the file containing the mailing list data base is closed, the process pages should be mapped from process pages to file, rather than simply UNmapped. dirmng: on to indicate that the MUNGE requested was the result of of an invocation of the MUNGE command of MLIST, rather than a result of the file (containing the mailing list data base) not existing. delflg: on to indicate that during the process of trying to match a user input user name - file spec, that the particular user name - file spec has already been deleted from the file once, so do not try to delete the user name - file spec more than once on a single pass through the data base's 'map' of the file. delopt: on to indicate that the DELETE option is being invoked. renopt: on to indicate thet the RENAME option is being invoked. a: on to indicate that an ADD was invoked during this execution of MLIST (for LOG purposes only). c: on to indicate that a CREATE was invoked during this execution of MLIST (for LOG purposes only). d: on to indicate that a DELETE was invoked during this execution of MLIST (for LOG purposes only). h: on to indicate that a HELP was invoked during this execution of MLIST (for LOG purposes only). m: on to indicate that a MUNGE was invoked during this execution of MLIST (for LOG purposes only). re: on to indicate that a RENAME was invoked during this execution of MLIST (for LOG purposes only). s: on to indicate that a SHOW was invoked during this execution of MLIST (for LOG purposes only). match: on to indicate that corresponding names of files ( MLIST data base VS. MLIST: ) that contain mailing lists are equal. This flag is used to indicate whether or not a new mailing list was created WITHOUT USING MLIST (i.e. by using EMACS, or some other editor instead), or if a previously-existing mailing list was deleted from MLIST: , but information from that particular mailing list is still resident in the MLIST data base. dodel: on to indicate that during a pass through the entries in a mailing list (as contained in the MLIST data base) looking for the entry that is to be deleted, the entry has been located and "deleted". badusr: on to indicate that during a VERIFY, the current mailing list being processed contains at least one invalid user (either a non-existent file or an invalid user name); OR during an ADD, that the "user" that is being added to a mailing list is an invalid file spec, which MLIST will not allow. badfil: on to indicate that during a DELETE, the obsolete user that is to be deleted from a mailing list is a file spec, so precede it with a '*'. anyhst: on to indicate that a file ( PS:DECNET-HOSTS.TXT ) exists containing DECNET network node names. \ SUBTTL Assembly Time Switches ;PCLEXE ;.EQ. 0 if not running TOPS20 PCL Exec ;XPORT ;.NE. 0 if using export-only code ;XMLBX ;.NE. 0 if using SYS:XMAILBOX.EXE (used ; for XMAILBOX-specific code) ;MMLBX ;.NE. 0 if using SYS:MMAILBOX.EXE (used ; for MMAILBOX-specific code) ;POBOX ;.NE. 0 if using either XMAILBOX or ; MMAILBOX ;MLLOG ;.EQ. 0 if no MLIST.LOG wanted ;NWNAME ;.EQ. 0 if no restrictions to be applied ; to the addition of network addresses ; to mailing lists having a mailing list ; name ;H20SW ;[ti-21] .EQ. 0 if using regular HELPER ;[ti-21] routine ;[ti-21] .NE. 0 if using Rutger's HELP20 ;[ti-21] routines ifndef pclexe, ifn pclexe, ifndef xport, ;[ti-3] ifn xport, ;[ti-3] ifndef xmlbx, ;[ti-8] for XMAILBOX-specific code ifn xmlbx, ;[ti-8] ifndef mmlbx, ;[ti-15] for MMAILBOX-specific code ifn mmlbx, ;[ti-15] ifndef pobox, ;[ti-15] for X|Mmailbox (generic) code ifn xmlbx, ;[ti-15] ifn mmlbx, ;[ti-15] ifndef mllog, ifn mllog, ifndef nwname, ;[ti-16] ifn nwname, ;[ti-16] ifndef h20sw, ;[ti-21] By default, use HELP20 ifn h20sw, ;[ti-21] SUBTTL Macro Definitions ;[ti-18] Clear out buffer areas Define Clrbuf(Bufnam,Buflen),< Setzm Bufnam Move T1,[Bufnam,,Bufnam+1] Blt T1,Bufnam+Buflen-1 > SUBTTL Data Section reloc 0 ; impure data prompt: block ^d10 ; place to construct prompt when ; using RDTTY jsys rspns: block 1 ; place to put response ctgtxt: block ^d80 ;[ti-11] save area for mailing ;[ti-11] list description dcrjfn: block 1 ;[ti-11] jfn for description file fdbInf: block .FBLEN ; Fdb information block gjfBlk: block .gjln ; Gtjfn block for comnd %impure ifn pobox,<;[ti-15] ;;;[ti-7] Miscellaneous for MALBOX code PAGE0==100 ;Starting page PAGEN==PAGE0 DEFINE DEFPAG (ADDR,LENGTH) < ADDR==PAGEN*1000 IFIDN ,<>, IFDIF ,<>, >;DEFINE DEFPAG STRBUF: BLOCK 1000 ;String buffer, used globally STRBF1: BLOCK 1000 ;Alternative string buffer, used locally DEFPAG XFLGPG ;For XMAILR.FLAGS if needed DEFPAG TMPBUF,2 ;Temporary storage DEFPAG FWDWIN,2 ;Forwarding string window WINPAG: BLOCK 1 ;Page number of window into forwarding program HSTBUF: BLOCK 5 ;Put string of a host here mbxfk: block 1 ; fork handle for X!Mmailbox.exe (if any) mbxfkJ: block 1 ; Jfn on X!Mmailbox.exe orgnam: block 10 ; original name (possibly a mailbox) lstnam: block 20 ; resultant translation >;pobox [ti-8][ti-15] hlpfrk: block 1 ;[ti-22] Fork handle for MLIST's HELP20 hlpjfn: block 1 ;[ti-22] Jfn for MLIST's HELP20 PRGNAM: BLOCK 1 ;[ti-22] This program's name acctn: block 2000 ;[ti-23] Pmtnam: block 100 ;[ti-23] Mlist Munger (users) pmtjfn: block 1 ;[ti-23] Jfn of MLIST.MUNGERS file pmtptr: block 1 ;[ti-23] Pointer to munger table dbugsw: block 0 ;[ti-9] <> 0 to indicate debugging prtext: block 20 ;[ti-4] save area for constructing ;[ti-4] prompts delreq: block 1 ;[ti-4] temp area used by DELETE ;[ti-4] command regsav: block 15 ; save area for the registers ; 'f' thru 'p5' (used during a ; VERIFY when the user wants ; to go ahead and delete an ; invalid entry when MLIST ; requests him to) regend==.-1 cntsav: block 1 ; save area for count of ; number of mailing lists ; during VERIFY index: block 1 ; save area for the address of ; the entry (in namtab) of the ; mailing list that is currently ; being processed count: block 1 ; save area for the count of the ; number of mailing lists that ; are currently being ; maintained in the MLIST data ; base ijfn: block 1 ; save area for jfn returned from ; parsing file spec with COMND jsys iusrno: block 1 ; save area for directory number ; returned from parsing user name with ; COMND jsys addcod: block 1 ;[ti-38] fncode: block 1 ; save area for function code used by ; COMND jsys fncod1: block 1 ; save area for function code ; used by COMND jsys fncod2: block 1 ; save area for function code used ; by COMND jsys shoadr: block 1 ; save area for address of the routine ; to complete processing of a SHOW ; command entcnt: block 1 ; save area for the count of the number ; of entries in a single mailing list flspst: block 25 ; save area for file spec ; returned from JFNS fladdr: block 1 ; save area for beginning address ; of last file name for a mailing ; list which was stored in filnam fdbtbl: block 37 ; file descriptor block oldpmp: block 1 ; flag which indicates if PMAP file ; exists ( <> 0 ) or is a new file ; ( = 0 ) jfnsav: block 1 ; save area for JFN tmpjfn: block 1 ; save area for unique jfn returned ; from long form GTJFN jfndb: block 1 ; save area for the jfn returned ; for pmapped data base file logjfn: block 1 ; save area for the jfn returned ; for the MLIST.LOG file mngblk: block 3 ; argument to prepare for ; entry into the keyword ; table (cmdtab) mngexe: block 1 ; area to store dispatch ; addresses of routines ; to execute when MUNGE ; command is invoked blkmng: block 3 ; argument to prepare for ; entry into the keyword ; table (cmdtab) blkexe: block 1 ; area to store dispatch ; addresses of routines ; to execute when M ; command is invoked SUBTTL Data Base Definition comment \ dirnos: an area to store users (i.e. user numbers or addresses of asciz strings (in mmnams:) specifying file specifications or obsolete users (users for which a user number no longer exists) which make up each mailing list. Within dirnos, a header word is associated with each mailing list. Each header word is of the format: (number of entries - i.e. users (ptr to an associated asciz string in the associated mailing list),, containing the name of the mailing list, if any) Each of the other words within dirnos contains a user number specifying a user who is a "member" of the mailing list specified by the associated header word, or an address (in mmnams) of an asciz string file specification (preceded by an asterisk) or an obsolete user for which a user number no longer exists. jfndir: a (tbluk) keyword table - an area to store, for each mailing list, the address (in filnam:) of the asciz string specifying the name of the file containing the mailing list, and the jfn associated with that particular file (during this execution of MLIST) Within jfndir, a header word is associated with all of the mailing lists combined. This header word is of the format of word 0 of a tbluk table - i.e. the left half contains the actual number of entries in the table, and the left half contains the possible number of entries in the table. Each of the other words within jfndir is of the format: (addr. of the file name, (jfn of the file containing in filnam, containing ,, the mailing list) this mailing list) mmnams: an area for storing asciz strings specifying the names of mailing lists and for storing asciz strings specifying obsolete users for which user numbers no longer exist. filnam: an area for storing asciz strings specifying the names of the files which contain the mailing lists. namtab: a (tbluk) keyword table an area for storing, for each mailing list, the address (in filnam:) of the asciz string specifying the name of the file containing the mailing list, and the address of the header word (in dirnos) for that mailing list Namtab has a header word associated with the (tbluk) keyword table as a whole. This header word is of the format of word 0 of a tbluk table - i.e. the left contains the number of actual entries in the table, and the right half contains the number of possible entries in the table. Each of the other entries in the table is of the following format: (addr. of the asciz string (addr. of the header word, in dirnos, name of the file containing ,, for that particular mailing list) that mailing list) \ HSTPTR: block 1 ; Pointer to host table HOSTAB: BLOCK 1000 ; host table HSTNAM: BLOCK 2000 ; host table data HOSTN: BLOCK 1000 ; host table data dtapag=:^d128 ;[ti-9] jfnpag=:^d206 ;[ti-9] mmnpag=:^d207 ;[ti-9] filpag=:^d217 ;[ti-9] nampag=:^d227 ;[ti-9] pmtpag=:^d228 ;[ti-9] aldusr=:^d229 ;[ti-9] ;[ti-9] maxusr=:^d199 ; maximum number of users allowed ; on a mailing list pmpnum=:aldusr-dtapag+1 ; number of pages to PMAP bklngh=:*1000 ; computed length of PMAPed ; block to (re)initialize tblock=:pmpnum*1000 ; computed length of total ; block of PMAPed data dtaddr=:dtapag*1000 ; computed address of the ; PMAPed mailing list data ; base dirnos=:dtaddr jfndir=:jfnpag*1000 mmnams=:mmnpag*1000 q2save=:mmnams ; save area for ; address of last asciz file ; name added to filnam:,, ; address of last asciz ; string added to mmnams: filnam=:filpag*1000 lsthdr=:filnam ; save area for address of header ; word of the last mailing list ; (not necessarily alphabetically) ; added to the data base namtab=:nampag*1000 maxlst=*1000-1 ;[ti-31] Maximum number of mailing lists ;[ti-31] supported by MLIST paglen==1000 ;[ti-18] Length of a page bufsiz==200 buf: block bufsiz/5+1 buffr3: block bufsiz ; work area where contents of new ; mailing list are saved (during ; invocation of CREATE) dstlen==25 buffr4: block dstlen*2 ; work area dirstg: block dstlen ; directory string ( this is built from ; user input string (mailing list entry) ; to look like : ; PS:< user input string >) tabent: block 1 ; save area for table entries t1save: block 1 ; save areas for registers t2save: block 1 ; t3save: block 1 ; t4save: block 1 ; q1save: block 1 ; q3save: block 1 ; p4save: block 1 ; p5save: block 1 ; saveT2: block 1 ; saveQ1: block 1 ; saveQ2: block 1 ; myusno: block 1 ;[ti-19] myulen==25 ;[ti-19] myustg: block myulen ;[ti-19] SUBTTL Command Tables reloc 400000 ; pure data goes into hiSeg ;[ti-32] prvtab: %table %key ,[sixbit/DELETE/] %key ,[sixbit/SETPRV/] %tbEnd ;Top-Level Command Table (for Non-Priv Users) cmdtab: %table %key , [.add,,$add] %key , [.creat,,$creat] %key , [.delet,,$delet] %key , [.dscrb,,$dscrb] ;[ti-11] %key , [.exit,,$exit] %key , [.help,,$help] ifn mmlbx,< %key , [.mmlbx,,$mmlbx] ;[ti-28] > %key , [.purge,,$purge] %key , [.renam,,$renam] %key , [.show,,$show] %key , [.vrify,,$vrify] %key , [.what4,,$what4] ;[ti-11] ifn xmlbx,< %key , [.mmlbx,,$mmlbx] ;[ti-28] > %tbEnd ;[ti-19] Top-Level Command Table (for Priv Users) cmdta%: %table %key , [.add,,$add] %key ,[.prmit,,$prmit] %key , [.creat,,$creat] %key , [.delet,,$delet] ;[ti-38] %key , [.dscrb,,$dscrb] ;[ti-11] %key , [.exit,,$exit] %key , [.help,,$help] ifn mmlbx,< %key , [.mmlbx,,$mmlbx] ;[ti-28] > %key , [.munge,,$munge] %key , [.purge,,$purge] %key , [.renam,,$renam] %key , [.prvnt,,$prvnt] %key , [.show,,$show] %key , [.vrify,,$vrify] %key , [.what4,,$what4] ;[ti-11] ifn xmlbx,< %key , [.mmlbx,,$mmlbx] ;[ti-28] > %tbEnd ;Options for the PURGE command prgtab: %table %key %tbEnd ;[ti-38] Options for the ADD command addtab: %table %key , $dscrb %tbEnd ;Options for the SHOW command (for Non-Priv Users) shotbl: %table %key , $$all %key , $$mlst %key , $mylst ;[ti-13] repeat 0,< %key , $$name ;[ti-13]>;[ti-10] %key , $$usrs %tbEnd ;[ti-19] Options for the SHOW command (for Non-Priv Users) shotb%: %table %key , $$all %key , $$auth %key , $$mlst %key , $mylst ;[ti-13] repeat 0,< %key , $$name ;[ti-13]>;[ti-10] %key , $$usrs %tbEnd ; Any time MLIST needs a YES/NO answer YNtab: %table ;[ti-4] %key ,0 ;[ti-4] %key ,1 ;[ti-4] %tbEnd ;[ti-4] ; Users allowed to use MUNGE command ;[ti-19] pmttab: 0,,nmngrs ;[ti-27] Init the header word block nmngrs ;[ti-27] Leave space for the number ;[ti-27] of users allowed to do ;[ti-27] MLIST MUNGING nauth: block 1 ;[ti-30] On entry, the number of ;[ti-30] authorized mungers aldblk=:aldusr*1000 ; save area for asciz strings ; (user names) of users allowed ; to invoke MUNGE argtbl: gj%old+gj%ifg ; flags,,gen num. .nulio,,.priou ; injfn,,outjfn -1,,[asciz/mlist:/] ; default device -1,,[asciz/*/] ; default directory -1,,[asciz/*/] ; default file name -1,,[asciz/*/] ; default file type 0 ; file protection 0 ; account 0 ; deltbl: gj%old+gj%ifg+.gjleg ; flags,,gen num. .nulio,,.priou ; injfn,,outjfn -1,,[asciz/mlist:/] ; default device -1,,[asciz/*/] ; default directory -1,,[asciz/*/] ; default file name -1,,[asciz/*/] ; default file type 0 ; file protection 0 ; account 0 ; filtbl: gj%new ; file must not exist .nulio,,.priou ; injfn,,outjfn -1,,[asciz/mlist:/] ; default device -1,,[asciz/*/] ; directory -1,,[asciz/*/] ; file name -1,,[asciz/*/] ; file type 0 ; file protection 0 ; account 0 ; vsntbl: gj%fou+gj%old ; file must exist, but give it a new ; generation number .nulio,,.priou ; injfn,,outjfn -1,,[asciz/mlist:/] ; default device -1,,[asciz/*/] ; directory -1,,[asciz/*/] ; file name -1,,[asciz/*/] ; file type 0 ; file protection 0 ; account 0 ; dcrprt: asciz/ Mailing List Description (1-400 chars, terminated with ^Z or ESC) : /;[ti-11] pmapdb: asciz/SUB:MLIST.PMAP/ ; file specification of mailing ; list data base newmap: asciz/SUB:MLIST.PMAP;P777777/ ; file specification of NEW mailing ; list data base with EXPLICIT ; protection code mngfil: asciz/PS:MLIST.MUNGERS/ ;[ti-30] File name containing ;[ti-30] list of MLIST Mungers mngflg: asciz/G:MLIST-DATABASE-RESTORE-IN-PROGRESS../ ;[ti-36] If this file ;[ti-36] exists, don't ;[ti-36] submit ;[ti-36] another re- ;[ti-36] munger exemng: asciz/SYS:_RESTORE_MLIST_.EXE/ ;[ti-37] Exe file which takes care ;[ti-37] of re-munging the MLIST ;[ti-37] database SUBTTL Program entry and Initialization entvec: jrst start ; start address jrst reEntr ; reentry address %version ($VERNO,$EDNO) ; standard version number evlen=.-entvec ; entry vector length reEntr: jrst start ; Reentry handling (nothing special). start: %setup ; Start address, set up stack, etc. seto t1, ;[ti-36] get info about current job hrli t2,-1 ;[ti-36] only get one word and put it hrri t2,t4 ;[ti-36] in ac4 movei t3,.jibat ;[ti-36] check if this job is ;[ti-36] controlled by batch GETJI ;[ti-36] jfcl ;[ti-36] skipe t4 ;[ti-36] If this job is not ;[ti-36] controlled by batch, then ;[ti-36] check to see if munge ;[ti-36] flag is set jrst start2 ;[ti-36] If controlled by batch, then ;[ti-36] don't check for munge flag move t1,[gj%sht!gj%old] ;[ti-36] hrroi t2,mngflg ;[ti-36] If re-munge in progress, just GTJFN ;[ti-36] tell user to try again later jrst start2 ;[ti-36] database ok...so continue RLJFN ;[ti-36] re-munge in progress, so clean jfcl ;[ti-36] up... hrroi t1,[asciz/ ? MLIST database restore in progress. Please try again later. /] ;[ti-36] ...tell user what's going on.. PSOUT ;[ti-36] jrst cont4 ;[ti-36] ...and exit... start2: ;[ti-36] Here if *NO* database munge ;[ti-36] in progress call init ; Initialize. move t1,[gj%sht+gj%old] ; assume that the file ; containing the mailing list ; data base already exists hrroi t2,pmapdb ; byte pointer to asciz file ; specification GTJFN ; short form jrst [ move t1,[gj%new+gj%sht] ; assume a new file hrroi t2,newmap ; byte pointer to asciz file ; specification GTJFN ; short form jrst [ hrroi t1,[asciz/ ?Unable to create mailing list data base./] psout jrst cont4] movem t1,jfndb ; save the jfn returned move t2,[of%rd+of%wr+of%thw] ; 36-bit bytes; and read and ; write access OPENF %jsErr ,cont4 %trnOff anymap ; set flag to indicate to remapm ; that the process pages should ; be PMAPed to the file instead ; of UNmapped. call remapm ; munge the data base skipn t4 ; if MUNGE done by batch, then continue jrst cont6 ; else, exit MLIST jrst cont2] ; and continue movem t1,jfndb move t2,[of%rd+of%wr+of%thw] ; 36-bit bytes; read access; ; and wait if off-line cont: OPENF %jsErr , cont4 %trnOn anymap ; set flag to indicate to remapm ; that the process pages should ; be UNmapped from the process, ; instead of PMAPed to the file movei t1,namtab ; get the beginning address ; of the keyword table that ; contains the names of the ; files that contain the ; mailing lists movem t1,index ; save this address movei p3,1 ; set up the increment addm p3,index ; increment the index to point ; to the entry for the first ; mailing list that is ; currently maintained in the ; MLIST data base hrl t1,jfndb ; get the source designator hrri t1,0 ; start with page 0 of the file hrli t2,.fhslf ; get process handle on self hrri t2,dtapag ;[ti-9] start with pg. DTAPAG of ;[ti-9] process move t3,[pm%cnt+pm%rd+pm%wr+pm%cpy] ; read and write access ; to the pages hrri t3,pmpnum ; pmap pmpnum # of pages PMAP hlrz t1,namtab ; get the count of the actual ; number of mailing lists ; currently maintained in the ; MLIST data base movem t1,count ; save this count %trnOff match ; initialize flag movei t1,argtbl ; get address of arg. table for ; GTJFN setz t2, GTJFN jrst [ seto t1, ; unmap hrli t2,.fhslf ; process handle on self hrri t2,dtapag ;[ti-9] begin with page DTAPAG hrl t3,[pm%cnt] hrri t3,pmpnum ; unmap pmpnum # of pages PMAP move t1,jfndb ; get the jfn CLOSF %jsErr < ?Unable to close data base.>, cont4 jrst cont4] movem t1,jfnsav ; save the jfn %1 hrroi t1,buffr4 ; byte pointer to destination ; designator hrrz t2,jfnsav ; get the jfn move t3,[1100,,1] ; output file name, file type setz t4, JFNS hlro t1,@index ; byte pointer to file name ; from MLIST data base hrroi t2,buffr4 ; byte pointer to file name ; from MLIST: skipe dbugsw ;[ti-9] for debugging purposes call [ push p,t1 ;[ti-9] save ac's push p,t2 ;[ti-9] PSOUT ;[ti-9] hrroi t1,[asciz/ ::: /] ;[ti-9] PSOUT ;[ti-9] move t1,t2 ;[ti-9] PSOUT ;[ti-9] hrroi t1,[asciz/ /] ;[ti-9] PSOUT ;[ti-9] pop p,t2 ;[ti-9] restore ac's pop p,t1 ;[ti-9] ret ] STCMP cain t1,0 ; is it a match ? %trnOn match ; yes, so set flag %skpOn match ; did a match occur ? jrst [hrrz t1,jfnsav ; get the jfn used for MLIST: RLJFN ; release it jfcl jrst %3f] ; no, so MUNGE came p3,count ; have all of the mailing lists ; been processed ? jrst [movei t1,namtab ; get the beginning address of ; the table containing the ; address of the file names ; containing the mailing lists movem t1,index ; save this address addi p3,1 ; increment the index into ; namtab addm p3,index ; increment the index to point ; to the entry for the next ; mailing list move t1,jfnsav ; get the jfn (wild card flags ; are already present in the ; left half of t1) GNJFN ; erjmp [hrrz t1,jfnsav ; that is all of the mailing ; lists in MLIST: but not in ; the MLIST data base - no mis- ; matches occurred, but the ; MLIST data base has more ; mailing lists than MLIST: ; so MUNGE RLJFN jfcl jrst %3f] %trnOff match ; reset the flag jrst %1b] ; and continue move t1,jfnsav ; get the jfn (with the wild ; card flags) GNJFN ; see if any more files ; containing mailing lists ; exist that alphabetically ; follow the last mailing ; list in the MLIST data base erjmp %2f ; MLIST: and the MLIST data ; base ARE INDEED compatible ; so get UNIQUE jfns for all ; of the files in MLIST: ; here when there are mailing list(s) which alphabetically follow ; the last mailing list in the MLIST data base, and (or) when there are ; more mailing lists in MLIST data base than there are in MLIST: %3 %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped back to the file ; instead of PMAPed to the ; file hrrz t1,jfnsav ; get the jfn RLJFN jrst .+1 call remapm ; the mailing list data base ; is inconsistent with the ; actual mailing lists that ; do exist, so MUNGE the ; data base skipn t4 ; if MUNGE done by batch, then continue jrst cont6 ; else, exit MLIST jrst cont2 ; and continue allok: ;[ti-34] %2 hrrz t1,jfnsav ; get the jfn RLJFN ; and release it jrst .+1 %trnOn anydbs ; set flag to indicate that a ; data base DOES exist %trnOn anymap ; set flag to indicate that ; the process pages should be ; UNmapped instead of PMAPed ; to the file hlrz q2,q2save ; get the address of the last ; asciz file name for a mailing ; list added to filnam: movem q2,fladdr ; and save this address %trnOn anymap ; set flag to indicate that ; the process pages should ; be UNmapped instead of ; PMAPed to the file jrst cont2 ;;;;; hrrz q1,namtab ; get the count of the number of ; mailing lists maintained ; currently in the data base hrlz q2,q1 ; do a MASS GTJFN to set up ; the mailing list data ; base in memory movem q2,q1save ; movn q1,q1save ; set up the negative count ; of the number of mailing ; lists currently maintained ; in the data base hrri q1,1 ; set up the index cont1: movei t1,argtbl ; get the beginning address of ; the argument table hlro t2,namtab(q1) ; byte pointer to asciz string ; specifying appropriate file ; name GTJFN ; long form jrst [ %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped back to the file ; instead of PMAPed to the ; file call remapm ; the mailing list data base ; is inconsistent with the ; actual mailing lists that ; do exist, so munge the ; the data base skipn t4 ; if MUNGE done by batch, then continue jrst cont6 ; else, exit MLIST jrst cont2] ; memory space hrrm t1,jfndir(q1) ; save the jfn returned in ; jfndir aobjn q1,cont1 ; and continue %trnOn anymap ; set flag to indicate that ; the process pages should ; be UNmapped instead of ; PMAPed to the file cont2: movei t1,aldblk+1 ;[ti-32] Setup for "new" mungers movem t1,aldblk ;[ti-32] call main ; Do the main program nop ; nothing special on failure setom oldpmp ; set flag to indicate that ; PMAP file already existed ;cont6: %trnOn anymap ; set flag to indicate that ; ; the process pages should ; ; be UNmapped instead of ; ; PMAPed to the file cont6: skipn oldpmp ; if PMAP file is new, then ; initialize the file call [ setzm dtaddr hrli t1,dtaddr hrri t1,dtaddr+1 blt t1,aldblk+777 ret ] movei t3,0 ; zero out AC3 hrlz t2,jfndir ; prepare both halves of AC1 for ; AOBJ movem t2,t2save ; movn t1,t2save ; hrri t1,1 ; %1 hrrm t3,jfndir(t1) ; zero out the jfns in jfndir ; because they are not valid ; from one execution of MLIST ; to the next aobjn t1,%1b %skpOn anymap call [hrli t1,.fhslf ; get process handle on self hrri t1,DTAPAG ;[ti-9] begin with page DTAPAG hrl t2,jfndb ; get the destination designator ; (i.e. the jfn) hrri t2,0 ; begin with page 0 move t3,[pm%wr+pm%cnt] hrri t3,pmpnum ; PMAP pmpnum # of pages ret] %skpOff anymap call [seto t1, ; UNmap hrli t2,.fhslf ; get process handle on self hrri t2,DTAPAG ;[ti-9] begin with page DTAPAG move t3,[pm%cnt] hrri t3,pmpnum ; UNmap pmpnum # of pages ret] PMAP ; PMAP (or UNmap) the process ; pages back to the file hrli t1,12 ; change word 12 of the fdb hrr t1,jfndb ; get the jfn of the associated file seto t2, ; change all of the bits in the word movei t3,tblock ; get the number of bytes in the ; file CHFDB move t1,jfndb ; get the jfn for the mailing ; list data base CLOSF %jsErr < ?Unable to close data base.>, cont4 seto t1, ; close any open files CLOSF jrst cont4 cont4: seto t1, RLJFN ; release all remaining jfns jrst cont5 cont5: HALTF ; Halt when done %trnOff rscflg ; but on continuation, jrst reEntr ; go back ... [ti-1] SUBTTL Miscellaneous Initialization init: %trnOff rscflg ; initialize flags %trnOff xitflg ; %trnOff anymng ; %trnOff anydbs ; %trnOff dirmng ; %trnOff a ; %trnOff c ; %trnOff d ; %trnOff h ; %trnOff m ; %trnOff re ; %trnOff s ; GJINF ;[ti-19] movem t1,myusno ;[ti-19] Save user number move t2,t1 ;[ti-19] hrroi t1,myustg ;[ti-19] DIRST ;[ti-19] and user name string setzm myustg ;[ti-19] setzm oldpmp ; initialize flag to indicate that ; (so far) no PMAP file exists setzm dbugsw ;[ti-9] NOT debugging move t1,[SIXBIT/MLIST/] ;[ti-22] Now prep subsystem name MOVEM t1,PRGNAM ;[ti-22] call %tbini ;[ti-23] Init "mungers" table setzm pmttab ;[ti-23] On error, NOONE is a munger hlrz t1,pmttab ;[ti-30] Save initial "state" of movem t1,nauth ;[ti-30] mungers list movei t1,aldblk+1 ;[ti-26] Setup for "new" mungers movem t1,aldblk ;[ti-26] ; ; pass rescan argument (if any) to command parser ; move t1, [point 7, [asciz/Mlist/]] ; supply our program name movei t2, gjfBlk ; and our GTJFN block address call rescan ; check for rescan arguments. %trnOn rscflg ; there are rescan args. ; here to modify the break mask of .CMKEY to exclude the following ; characters: ; . movei t1,[fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] ; get the address of one of ; the function descriptor ; blocks used by the ; COMND jsys move t2,[10,,0] ; use this mask to exclude ; period from the break ; mask movem t1,t1save ; save the address of ; the fdb movei t3,.cmbrk ; set up the offset to ; get the address of ; the 4-word break ; mask addm t3,t1save ; set up the address ; of the word in the ; fdb that contains ; the address of the ; break mask move t1,@t1save ; get the address of ; the break mask addi t1,1 ; modify this address ; to point to the ; second word of the ; break mask move t3,@t1 ; get the second word ; of the break mask ior t3,t2 ; exclude the period ; from the break mask xor t3,t2 ; movem t3,@t1 ; restore the second ; word of the break ; mask ; here to modify the break mask for .CMFLD to exclude the following ; characters: ; * . < > : % ! movei t1,[fldbk. (.CMFLD,cm%brk+cm%sdh,,,,[ brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,,<.>)])] ; get the address of one of ; the function descriptor ; blocks used by the ; COMND jsys move t2,[210210,,1240] ; use this mask to exclude ; * . < > : from the break ; mask movem t1,t1save ; save the address of ; the fdb movei t3,.cmbrk ; set up the offset to ; get the address of ; the 4-word break ; mask addm t3,t1save ; set up the address ; of the word in the ; fdb that contains ; the address of the ; break mask move t1,@t1save ; get the address of ; the break mask addi t1,1 ; modify this address ; to point to the ; second word of the ; break mask move t3,@t1 ; get the second word ; of the break mask ior t3,t2 ; exclude the characters ; from the break mask xor t3,t2 ; movem t3,@t1 ; restore the second ; word of the break ; mask jrst %1f ;;;;;;;; ; ; here to remove '@' from word 2 of the break mask for .CMFLD ; addi t1,1 ; point to word 2 move t3,@t1 ; get word 2 of the ; break mask move t2,[400000,,0] ; mask to be used ; to remove '@' ; from break mask ior t3,t2 xor t3,t2 ; do it movem t3,@t1 ; restore word 2 %1 CALL $BUILD NOP ; ;;;;;;;; ret SUBTTL Main Program - Highest Level Command Parser main: stkVar temp ; allocate local temporary variable ; on stack %skpOff rscflg ; rescan entry ? jrst [move t1,[.priou] ; output a line feed if there movei t2,12 ; was anything in the rescan %skpOff anymng ; buffer BOUT jrst repar$] ; yes, don't set up prompt. re$tar: %skpOff xitflg ; If we get here with xitflg on, ret ; then exit. %trnOn anymap ; set flag to indicate that ; the process pages should ; be UNmapped instead of ; PMAPed to the file call fldrst %cmini (<>,,,gjfblk) ; issue the prompt %jserr repar$: move t3,[sixbit/SETPRV/] ;[ti-32] call ckauth ;[ti-19] jrst repar1 ;[ti-19] Use non-priv cmd table %comnd [flddb. (.CMKEY,,cmdta%,)] ;[ti-19] %merrep re$tar, repar$ ;[ti-19] jrst repar2 ;[ti-19] repar1: ;[ti-19] (label) %comnd [flddb. (.CMKEY,,cmdtab,)] %merrep re$tar, repar$ repar2: ;[ti-19] (label) %trnOff delopt ; initialize flags %trnOff renopt ; ; Initialize work space clrbuf Dirstg, Dstlen ;[ti-18] clrbuf Buffr3, Bufsiz ;[ti-18] clrbuf Buffr4, Dstlen*2 ;[ti-18] ; here to handle a keyword keywrd: hrrz t2, (t2) ; get address of associated dispatch ; word hrrzm t2, temp ; we'll need it again soon. load t1, %prsad, (t2) ; secondary parse routine address call (t1) ; call it to parse next field %jmerrep re$tar, repar$, re$tar ; handle bad return ; ; get here after all fields successfully parsed ; move t2, temp ; get command table word back again. load t1, %evlAd, (t2) ; Action routine address. call (t1) ; Call the action routine. nop ; on failure ... %skpOff xitFlg ; was it an exit command ? ret ; yes, exit. rstret: jrst re$tar ; No, keep going. SUBTTL Check User Authority ;[ti-19] CKAUTH checks to see if this user has the authority ; to MUNGE, etc. ; ; AC3/ sixbit code for priv's needed to return +2 ; ; Returns: +1 if this user is NOT authorized ; +2 if this user IS authorized ckauth: move t4,t3 ;[ti-32] Save priv code from TBLUK contamination movei t1,pmttab hrroi t2,myustg TBLUK txnn t2,tl%exm ret move t2,(t1) ;[ti-32] Found this user has MLIST priv's.... move t2,(t2) ;[ti-32] ...now see how much camn t2,[sixbit/SETPRV/] ;[ti-32] whoa....don't stop this guy ! retskp ;[ti-32] came t2,t4 ;[ti-32] If not "SETPRV" check against minimum priv's ret ;[ti-32] NOPE ! retskp SUBTTL REMAPR - Remap for Read-Only Access to Data Base ; ; Use this remap routine to unmap the pages from the process to the file, ; and to PMAP the pages back from the file to the process with read access ; to the pages ; remapr: %trnOn anymap ; set flag to indicate that the ; process pages should be ; UNmapped instead of PMAPed to ; to the file SETO T1, ; UNMAP PAGES HRLI T2,.FHSLF ; GET PROCESS HANDLE ON SELF HRRI T2,DTAPAG ;[ti-9] START WITH PAGE DTAPAG move T3,[PM%CNT] HRRI T3,pmpnum ; pmap pmpnum # of PAGES PMAP move t1,[co%nrj] ; dont release the jfn !!! hrr t1,jfndb ; get the jfn CLOSF %jsErr move t1,jfndb ; get the jfn move t2,[of%rd+of%thw] ; 36-bit bytes; read access; ; and wait if off-line OPENF %jsErr HRL T1,JFNDB ; GET THE SOURCE DESIGNATOR ; (I.E. JFN) HRRI T1,0 ; START WITH PAGE 0 HRLI T2,.FHSLF ; GET PROCESS HANDLE ON SELF HRRI T2,DTAPAG ;[ti-9] START WITH PAGE DTAPAG MOVE T3,[PM%CNT+PM%RD] HRRI T3,pmpnum ; PMAP pmpnum # of PAGES PMAP RET SUBTTL REMAPW - Remap for Read/Write Access to Data Base ; Use this remap routine to unmap the pages from the process to the file ; and then to pmap the pages back from the file to the process with ; read and write access to the pages. ; remapw: %trnOn anymap ; set flag to indicate that the ; process pages should be ; UNmapped instead of PMAPed ; to the file SETO T1, ; UNMAP PAGES HRLI T2,.FHSLF ; GET PROCESS HANDLE ON SELF HRRI T2,DTAPAG ;[ti-9] START WITH PAGE DTAPAG move T3,[PM%CNT] HRRI T3,pmpnum ; pmap pmpnum # of PAGES PMAP move t1,[co%nrj] ; dont release the jfn !!! hrr t1,jfndb ; get the jfn CLOSF %jsErr move t1,jfndb ; get the jfn move t2,[of%rd+of%wr+of%thw] ; 36-bit bytes; and read and ; write access OPENF %jsErr HRL T1,JFNDB ; GET THE SOURCE DESIGNATOR ; (I.E. JFN) HRRI T1,0 ; START WITH PAGE 0 HRLI T2,.FHSLF ; GET PROCESS HANDLE ON SELF HRRI T2,DTAPAG ;[ti-9] START WITH PAGE DTAPAG MOVE T3,[PM%CNT+PM%RD+pm%wr+PM%CPY] HRRI T3,pmpnum ; PMAP pmpnum # of PAGES PMAP RET remapm: tmsg< Initialization of mailing list data base required. > seto t1, ; get info about current job hrli t2,-1 ; only get one word and put it in ac4 hrri t2,t4 ; movei t3,.jibat ; check if this job is controlled by ; batch GETJI jfcl skipn t4 ; If this job is not controlled by ; batch, then load the rescan buffer ; to submit a BATCH job to do the ; re-initialization. If this job is ; controlled by batch, then go ahead ; and do the re-initialization. jrst [ hrroi t2,exemng ;[ti-37] call runfil ;[ti-37] Run the program to fix ;[ti-37] the MLIST database setz t4, ; indicate to caller that MUNGE is to ; be done by BATCH job jrst goon ] ; This job is controlled by batch, so.. call $munge ; the file does not exist, so ; MUNGE the mailing list data ; base nop ; a no-op to permit correct ; return from $munge %skpOn anymap call [hrli t1,.fhslf ; get process handle on self hrri t1,DTAPAG ;[ti-9] begin with page DTAPAG hrl t2,jfndb ; get the destination designator ; (i.e. the jfn) hrri t2,0 ; begin with page 0 move t3,[pm%wr+pm%cnt] hrri t3,pmpnum ; PMAP pmpnum # of pages ret] %skpOff anymap call [seto t1, ; UNmap hrli t2,.fhslf ; get process handle on self hrri t2,DTAPAG ;[ti-9] begin with page DTAPAG move t3,[pm%cnt] hrri t3,pmpnum ; UNmap pmpnum # of pages ret] PMAP ; PMAP (or UNmap) the process ; pages back to the file jrst %1f move t1,[co%nrj] ; dont release the jfn hrr t1,jfndb ; get the jfn CLOSF jrst .+1 move t1,jfndb ; get the jfn move t2,[of%rd+of%thw] ; 36-bit bytes and read access; ; wait if off-line OPENF %jsErr , cont4 %1 hrl t1,jfndb ; get source designator (jfn) hrri t1,0 ; begin with page 0 hrli t2,.fhslf ; get process handle on self hrri t2,DTAPAG ;[ti-9] begin with page DTAPAG move t3,[pm%cnt+pm%rd+pm%wr+pm%cpy] hrri t3,pmpnum ; PMAP pmpnum # of pages PMAP ; PMAP the mailing list data seto t4, ; indicate to caller that MUNGE ; was completed goon: ret ; base back into addressable SUBTTL Network Host Table Initialization .build: %cmnoi %pret %cmcfm %pret retskp $build: %trnOff anyhst ; reset flag to indicate that ; no file containing node ; names has been located yet ; ; Init DECNET host table ; HSTIND: MOVe t1,[GJ%OLD+GJ%SHT] HRROI t2,[ASCIZ /SUB:MLIST-DECNET-HOSTS.TXT/] GTJFN jrst HSTINE ; Can't get host table, done MOVE t2,[7B5+OF%RD] ; OPENF %jsErr , bldret %trnOn anyhst ; set flag to indicate that ; the file in question has ; been found MOVEM t1,TMPJFN ; Save it away push p,f ;[ti-24] Save this !!! movei f,0 movei t1,hstnam ; get address of area to ; put host data movem t1,hstptr setzm hostab ; initialize word 0 of ; DECNET host table HSTID1: %1 movei t1,1 addm t1,hostab ; update word 0 of host ; table MOVE t1,TMPJFN HRRO t2,hstptr ;Where to start string MOVEI t3,HSTNAM+1777 SUBI t3,(f) IMULI t3,5 ;Amount of room left MOVEI t4,12 ;Until end of line SIN ERJMP [ pop p,f ;[ti-24] get this back jrst HSTID2 ] ;Must be eof JUMPE t3,[ tmsg pop p,f ;[ti-24] get this back jrst bldret] ADD t2,[7B5] SKIPGE t2 SUB t2,[43B5+1] ;Back up byte pointer MOVEI t4,0 DPB t4,t2 ;Replace CR with null HRROI t2,1(t2) hrrzm t2,t2save EXCH t2,f ;Update free pointer HRROS t2 ;Mark DECNET host MOVEM t2,(q1) ;Save number MOVEi t1,hostab ; get address of word 0 of ; host table HRlz t2,hstptr ; get table entry TBADD ERJMP .+1 ;In case an ARPANET name too move t2,t2save hrrzm t2,hstptr CAIL q1,HOSTN+777 jrst [ tmsg pop p,f ;[ti-24] get this back jrst bldret] jrst hstid1 HSTID2: CALL CLSTMP hstine: MOVE t1,HSTPTR ;Return pointer to things jrst bldRET ;Done clstmp: skipg t1,tmpjfn ret CLOSF clstm0: skipa t1,tmpjfn jrst clstm1 RLJFN nop clstm1: setom tmpjfn ret bldret: retskp SUBTTL Miscellaneous Break Mask Routines FLDbrk: Movei T1,[Fldbk. (.cmfld,cm%brk+cm%sdh,,,,[ brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,,<.>)])] move t2,[400000,,0] ; use this mask to ; prevent @ from ; from being a ; break character movem t1,t1save ; save the address of ; the fdb movei t3,.cmbrk ; set up the offset to ; get the address of ; the 4-word break ; mask addm t3,t1save ; set up the address ; of the word in the ; fdb that contains ; the address of the ; break mask move t1,@t1save ; get the address of ; the break mask addi t1,2 ; modify this address ; to point to the ; third word of the ; break mask move t3,@t1 ; get the third word ; of the break mask ior t3,t2 ; exclude the characters ; from the break mask xor t3,t2 ; movem t3,@t1 ; restore the third ; word of the break ; mask ret FLDRST: Movei T1,[Fldbk. (.cmfld,cm%brk+cm%sdh,,,,[ brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,,<.>)])] move t2,[400000,,0] ; use this mask to ; prevent @ from ; from being a ; break character movem t1,t1save ; save the address of ; the fdb movei t3,.cmbrk ; set up the offset to ; get the address of ; the 4-word break ; mask addm t3,t1save ; set up the address ; of the word in the ; fdb that contains ; the address of the ; break mask move t1,@t1save ; get the address of ; the break mask addi t1,2 ; modify this address ; to point to the ; third word of the ; break mask move t3,@t1 ; get the third word ; of the break mask ior t3,t2 ; restore the characters ; in the break mask movem t3,@t1 ; restore the third ; word of the break ; mask ret SUBTTL Log-Keeping Routines LOG: ife mllog,< ret >;ife mllog ifn mllog,< move t1,[gj%sht+gj%old] ; assume file already exists hrroi t2,[asciz/SUB:MLIST.LOG/] ;[ti-3] GTJFN ; short form jrst [ move t1,[gj%sht+gj%new] ; then file must not exist, so ; create a new one hrroi t2,[asciz/SUB:MLIST.LOG/] ;[ti-3] GTJFN ; short form again jrst logret jrst %1f] %1 hrrzs t1 ; get rid of the flags returned movem t1,logjfn ; save this jfn move t2,[<7b5>+of%app+of%thw] ; 7-bit bytes; append access OPENF jrst logret move t1,logjfn ; get the destination designator movei t2,40 ; output a space BOUT GJINF ; get information pertaining to ; the current job move t2,t1 ; shift the user number returned ; to ac2 move t1,logjfn ; get the destination designator DIRST jrst [ move t1,logjfn ; get destination designator hrroi t2,[asciz/Couldn't get user/] setz t3, setz t4, SOUT jrst %2f] %2 %skpOff a call [hrroi t2,[asciz/ ADD /] ret] %skpOff c call [hrroi t2,[asciz/ CREATE /] ret] %skpOff d call [hrroi t2,[asciz/ DELETE /] ret] %skpOff h call [hrroi t2,[asciz/ HELP /] %trnOff h ret] %skpOff m call [hrroi t2,[asciz/ MUNGE /] %trnOff m ret] %skpOff re call [hrroi t2,[asciz/ RENAME /] ret] %skpOff s call [hrroi t2,[asciz/ SHOW /] %trnOff s ret] move t1,logjfn ; get the destination designator setz t3, setz t4, SOUT %skpOff a jrst %3f %skpOff c jrst %3f %skpOff d jrst %3f %skpOff re jrst %3f jrst %4f %3 move t1,logjfn ; get the destination designator movei t2,40 ; output 3 spaces BOUT movei t2,40 BOUT movei t2,40 BOUT %skpOff a call [move q1,t2save ; get the offset into namtab of ; the entry for the mailing ; list that was processed hlro t2,namtab(q1) ; get byte pointer to the name ; of the file containing the ; appropriate mailing list %trnOff a ; reset flag ret] %skpOff c call [hrroi t2,flspst ; get byte pointer to the name ; of the file containing the ; appropriate mailing list %trnOff c ; reset flag ret] %skpOff d call [move q1,t2save ; get the offset into namtab of ; the entry for the mailing ; list that was processed hlro t2,namtab(q1) ; get byte pointer to the name ; of the file containing the ; appropriate mailing list %trnOff d ; reset flag ret] %skpOff re call [move q1,t2save ; get the offset into namtab of ; the entry for the mailing ; list that was processed hlro t2,namtab(q1) ; get byte pointer to the name ; of the file containing the ; appropriate mailing list %trnOff re ; reset flag ret] move t1,logjfn ; get the destination designator setz t3, setz t4, SOUT ; output the name of the file ; containing the mailing list ; that was changed or created %4 move t1,logjfn ; get the destination designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT move t1,logjfn ; get the jfn CLOSF jrst logret logret: ret >;ifn mllog SUBTTL Add Miscellaneous Routines alredy: tmsg< [> ; tell the user that this ; entry already exists on ; this mailing list move p3,fncode ; get the function code cain p3,.CMUSR ; was a user name parsed ? jrst [move t1,[.priou] ; get the destination designator move t2,iusrno ; get the user number that the ; user thought that he could ; delete DIRST jrst %1f jrst %1f] cain p3,.CMUSR ; was a user name parsed ? jrst [hrroi t1,dirstg ; byte pointer to asciz string ; designating file spec psout jrst %1f] cain p3,.CMFLD ; was a field parsed ? call [hrroi t1,buffr3 ; byte pointer to field psout ret] %1 tmsg< is already on mailing list > move q1,t2save ; get the offset into namtab ; of the entry for this mailing ; list move t1,[.priou] ; get destination designator hlro t2,namtab(q1) ; get byte pointer to ; asciz string name of ; the file containing ; this mailing list setz t3, setz t4, SOUT tmsg< - no addition performed]> ret ;;; ;;; ac3 contains a byte pointer to the file name ( to be part of the prompt ) ;;; read: move t1,shoadr ; check again tlne t1,777777 ; if 'ALL' option was requested, ; then don't ask the user anything jrst [ movei t1,namtab ; calculate the necessary address movem t1,t2save ; for DELETE routine addm q1,t2save ; movem q1,saveQ1 ; save ac's movem q2,saveQ2 ; call $DELET ; jfcl ; noop to handle RETSKP from $DELET tmsg< > setz t4, ; set this to indicate "all's well" move q1,saveQ1 ; restore ac's move q2,saveQ2 ; jrst %1f ] hrroi t1,prompt ; destination designator movei t2," " ; prefix prompt with a space BOUT move t2,t3 ; make bp a source designator setz t3, setz t4, SOUT ; add the file name to the prompt hrroi t2,[asciz/ > /] ; finish off the prompt setz t3, ; setz t4, ; SOUT ; redp: hrroi t1,prompt ; prompt the user PSOUT hrroi t1,rspns ; place to put input from tty: move t2,[rd%rai!1b35] ; read 1 byte (raised on input) hrroi t3,prompt ; get the prompting text RDTTY %jsErr < ? Unintelligible response. Please try again.>, redp move t2,[point 7,rspns] ildb t3,t2 cain t3,131 ; 'Y' ? jrst [ movei t1,namtab ; calculate the necessary address movem t1,t2save ; for $DELET addm q1,t2save ; movem q1,saveQ1 ; save ac's movem q2,saveQ2 ; tmsg< > call $DELET ; jfcl ; noop to handle RETSKP from $DELET tmsg< > move q1,saveQ1 ; restore ac's move q2,saveQ2 ; setz t4, ; set flag for OK jrst %1f ] cain t3,116 ; 'N' ? jrst [ setz t4, ; set flag for OK tmsg< > jrst %1f ] cain t3,101 ; 'A' ? jrst [ tmsg< Aborting.... > seto t4, ; set flag for an abort jrst %1f ] cain t3,15 ; CR ? jrst [ hrroi t1,rspns ; byte pointer to place to put input move t2,[rd%rai!1b35] ; read 1 byte (raise it on input) hrroi t3,prompt ; byte pointer to prompting text RDTTY ; use this to snarf up any extra input ; (i.e. LF following CR, etc.) %jsErr < ? Unintelligible response. Please try again.>, redp movei t1,namtab ; calculate the necessary address movem t1,t2save ; for $DELET addm q1,t2save ; movem q1,saveQ1 ; save ac's movem q2,saveQ2 ; call $DELET ; jfcl ; noop to handle RETSKP from $DELET tmsg< > move q1,saveQ1 ; restore ac's move q2,saveQ2 ; setz t4, ; set flag for OK jrst %1f ] cain t3,"?" ; '?' ? jrst [ tmsg< The allowable responses are: Y or CRLF yes N no A abort this 'PURGE' > jrst redp ] tmsg< ? Your response must be Y, CRLF, or N > jrst redp ; if all else fails, go try again %1 ret SUBTTL Show/Purge Miscellaneous Routines $mylst: move p4,jfndir ; get the count of the number ; of mailing lists, hlrzm p4,t3save ; and save it %1 %trnOff anylst ; initialize flag to indicate ; that no match has been ; located movei q1,1 ; set up index into namtab movei q2,1 ; set up index into dirnos movei q3,1 setz p5, ; set up increment (count of ; number of mailing lists ; output per line) %6 hrrz t2,namtab(q1) ; get address of next header word ; in dirnos movem t2,savet2 ; save this address hlrz t4,@t2 ; get count of number of entries ; in this mailing list (as stored ; in this header word in dirnos movem t4,entcnt ; save this count for later compares %7 movei q3,1 ; reset up index addm q3,savet2 ; update the address of the next ; mailing list entry move t3,iusrno ; get next entry in this mailing ; list came t3,@savet2 ; does the test user number ; match the mailing list entry ? jrst [addi q2,1 ; no, increment the index into ; dirnos camg q2,entcnt ; have all of the entries for ; this mailing list been tested ? jrst %7b ; no, so try another one addi q1,1 ; yes, so increment the index ; into jfndir camg q1,t3save ; have all of the mailing lists ; been tested ? jrst [movei q2,1 ; no, so reset index into dirnos movei t1,1 jrst %6b] ; and test the next mailing ; list jrst %5f] ; yes, so go back to command level ; here when name of mailing list is to be output to the terminal move t1,shoadr ; see what is going on trnn t1,777777 ; if not doing a 'SHOW', then don't jrst %1f ; do this either cain p5,0 ; have any mailing list names ; been output to the tty yet jrst [ move t1,[.priou] movei t2,40 ; output a space BOUT jrst %1f ] ; no caig p5,5 ; have 5 or more entries ; been output to this line ; on the terminal ? call [move t1,[.priou] ; no movei t2,"," ; output a comma BOUT movei t2,40 ; and a space BOUT ret] cail p5,5 ; have 5 or more entries ; been output to this line ; on the terminal ? call [move t1,[.priou] ; yes, so get destination ; designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT movei t2,40 ; output a space BOUT setz p5, ; reset the count of the ; number of entries on this ; line ret] %1 move t1,shoadr ; check again trnn t1,777777 ; if not doing a 'SHOW', then jrst [ hlro t3,namtab(q1) ; get byte pointer to prompting string call read ; and read instructions from tty: caie t4,0 ; if ac4 is still 0, everthing is OK jrst %8f ; otherwise, quit this PURGE jrst %2f ] hlro t1,namtab(q1) ; get byte pointer to file name ; (file containing mailing list) psout ; and output to TTY: %2 %trnOn anylst ; set this flag addi p5,1 ; increment count of number of ; mailing lists output to this ; line addi q2,1 ; increment index camg q2,entcnt ; is that all of the entries in this ; mailing list jrst %7b ; no, so go get the next one addi q1,1 ; increment the index into ; jfndir camg q1,t3save ; is that all of the entries in ; jfndir ? jrst [movei q2,1 ; no, so reset the index into dirnos jrst %6b] ; and go back to process the entries ; in this mailing list %5 %skpOn anylst ; were there any mailing lists for ; this user ? call [tmsg< ?There are no mailing lists for > ; no, so output appropriate msg move t1,[.priou] ; get destination designator move t2,iusrno ; get user-input user number DIRST call [ tmsg ret] ret] move t1,shoadr ; if not doing a 'SHOW', then return trnn t1,777777 ; jrst %8f ; %skpOff anylst ; were there any mailing lists for ; this user ? call [move t1,[.priou] ; get destination designator movei t2,015 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT tmsg< [Mailing lists for > move t1,[.priou] ; get destination designator move t2,iusrno ; get user-input user number DIRST call [ tmsg ret] tmsg< complete]> ret] %8 %cmRes ret ; go back to command level SUBTTL EXIT Command .exit: %cmnoi ; issue noise word %pret %cmcfm ; get confirmation %pret hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncode ; save the function code retskp $exit: %trnOn xitFlg ; turn on the exit flag, move t3,[sixbit/SETPRV/] ;[ti-32] call ckauth retskp ;[ti-30] Not a MUNGER so don't ;[ti-30] try to save new mungers hlrz t1,pmttab ;[ti-30] See if any changes made camn t1,nauth ;[ti-30] retskp ;[ti-30] No changes...so...quit stkvar move t1,aldblk ;[ti-30] Check if any changes hrroi t2,mngfil ;[ti-30] call newlog ;[ti-30] skipn t1 ;[ti-30] ret ;[ti-30] movem t1,jfntmp ;[ti-30] Save jfn call savmng ;[ti-30] Save the list of ;[ti-30] mungers CLOSF ;[ti-30] jrst [ move t1,jfntmp ;[ti-30] At least release the jfn... RLJFN ;[ti-30] jfcl ;[ti-30] retskp ] ;[ti-30] retskp Subttl SavMng - Save updated list of mungers SavMng: hlrz q3,pmttab ;get count of authorized users movn q3,q3 ;make it negative hrlz q3,q3 ;...and setup for looping hrri q3,1 ;[ti-25] Skip over "header" word SavMn2: hlro t2,pmttab(q3) ;byte pointer to user string setzb t3,t4 ;[ti-30] SOUT move t3,pmttab(q3) ;[ti-32] move t3,(t3) ;[ti-32] Get 6-bit priv string skipn t3 ;[ti-32] jrst SavMn4 ;[ti-32] No priv's movei t2,"=" ;[ti-32] MUST have this here ! BOUT ;[ti-32] SavMn3: setz t2, ;[ti-32] lshc t2,6 ;[ti-32] skipe t2 ;[ti-32] jrst [ addi t2,40 ;[ti-32] make it 7-bit BOUT ;[ti-32] jrst SavMn3 ] ;[ti-32] SavMn4: hrroi t2,[asciz/ /] setzb t3,t4 ;[ti-32] SOUT aobjn q3,SavMn2 ;loop if any more ret SUBTTL HELP Command .help: %cmnoi ; issue noise word [ti-8] (modified) %pret %cmcfm ; get confirmation %pret repeat 0,< hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncode ; save the function code >;repeat 0 retskp $help: %trnOn h ; set flag to indicate that a ; HELP was invoked during ; this execution of MLIST ; (for LOG purposes only) ife h20sw,< ;[ti-20][ti-21] move t2,[point 7,[asciz/HLP:MLIST.HLP/]] call helper >;ife h20sw ;[ti-20][ti-21] ifn h20sw,< move t2,[point 7,[asciz/sys:mlist_help20.exe/]] call runfil ;[ti-22] GO DO IT!!! >;ifn h20sw ;[ti-22] call LOG retskp SUBTTL MUNGE Command .munge: call chkprm ; check to see if the user is ; authorized ret ; bad return to MAIN %cmnoi ; parse noise word %pret %cmcfm ; get confirmation %pret %trnOn dirmng ; set flag to indicate that ; this MUNGE is a result of ; an invocation of the ; MUNGE command retskp chkprm: hllz q1,pmttab ; get the count of the number ; of entries in the keyword ; table movem q1,q1save ; movn q1,q1save ; negate this count to set ; up the index register hrri q1,1 ; set up the index GJINF ; get the current user ; information move t2,t1 ; shift user number to ac2 hrroi t1,buffr3 ; get the destination designator DIRST jfcl hrroi t2,buffr3 ; get byte pointer to test ; string movei t1,pmttab ; get the beginning address ; of the keyword table TBLUK ; see if the user is in the ; table txne t2,tl%exm ; jrst %1f ; yes, so allow the user to ; to invoke MUNGE ; no, so tell the user tmsg< ?Does not match switch or keyword > ret ; bad return to .MUNGE %1 retskp ; good return to .MUNGE $munge: %trnOn m ; set flag to indicate that a ; MUNGE was invoked during ; this execution of MLIST ; (for LOG purposes only) %skpOn dirmng ; output this message ONLY ; when MUNGE command invoked call [ hrroi t1,[asciz/ Please wait.../] PSOUT ret ] move t1,jfndb ; get the jfn for the file ; containing the mailing ; list data base GTSTS ; check to see if the MUNGE ; request is direct (i.e. via ; MLIST command) or indirect ; (i.e. the file containing ; the mailing list data base ; does not exist tlnn t2,100000 ; does specified file have ; write access ? call remapw ; no, so unmap the pages of ; of the file containing the ; mailing list data base and ; close the file; open the ; file with read and write ; access; and pmap the pages ; of the file into address- ; able memory with read and ; write access to the private ; pages hlrz t2,namtab ; get the count of the number ; of mailing lists in the ; MLIST: data base movem t2,t2save ; save this count movei t3,1 ; initialize the offset into ; jfndir %1 camg t3,t2save ; have all of the jfns been ; released ? jrst [hrrz t1,jfndir(t3) ; get the next old jfn, cain t1,0 ; if there is one jrst %2f RLJFN ; and release it jrst .+1 addi t3,1 ; increment the offset jrst %1b] %2 call dtabas ; create the MLIST database %trnOn anydbs ; set flag to indicate that ; mailing list data base ; does exist %trnOn anymng ; set flag to indicate that ; MUNGE has been performed %CRtype< Initialization of mailing list data base complete.> hrroi t1,[asciz/ /] psout %skpOff dirmng ; was the MUNGE that was ; requested a result of an ; invocation of the MUNGE ; command ? call [%trnOff dirmng ; yes, so unmap the modified ; pages of the mailing list ; data base and close the ; file; open the file with ; read access only; and pmap ; back the pages of the file ; containing the mailing list ; data base with read access ; only %trnOn anymap ret] call LOG retskp .prmit: %trnOn anymap %cmnoi ; issue noise word %pret %comnd [flddb. (.CMUSR)] %pret movem t2,iusrno ;[ti-29] %cmnoi ;[ti-32] issue noise word %pret %comnd [flddb. (.CMKEY,,prvtab)];[ti-32] %pret move q2,t2 ;[ti-32] save address of priv %cmcfm ; get confirmation %pret retskp $prmit: hlrz t1,pmttab ;[ti-27] Check if table is full cail t1,nmngrs ;[ti-27] jrst [ hrroi t1,[asciz/ ? MLIST cannot handle any more privileged users. Please contact your local MLIST support person./] ;[ti-27] PSOUT ;[ti-27] ret ] ;[ti-27] move t1,aldblk ;[ti-29] byte pointer to storage area hrli t1,440700 ;[ti-29] to which the user number ;[ti-29] will be DIRSTed move t2,iusrno ;[ti-29] DIRST ;[ti-29] jrst [ hrroi t1,[asciz/? Error trying to grant MUNGE privileges/] PSOUT ;[ti-29] ret ] setz t2, ;[ti-29] Tie off the string BOUT ;[ti-29] move t1,aldblk ; get address of where user name ; name string was DIRSTed hrlz t2,t1 ; prepare entry for TBADD hrr t2,q2 ;[ti-32] Get address of priv hrr t2,(t2) ;[ti-32] movei t1,pmttab ; get beginning address of ; the keyword table TBADD erjmp [tmsg hrro t1,aldblk ;[ti-29] user is already in table psout tmsg< is already authorized.> hrroi t1,[asciz/ /] psout jrst %1f] tmsg< [Authorization for > hrro t1,aldblk ;[ti-29] psout tmsg< complete.]> hrroi t1,[asciz/ /] psout %2 move t4,@aldblk caie t4,0 ; is the word a null word ? jrst [movei t1,1 ; no, so try the next word addm t1,aldblk jrst %2b] movei t1,1 ; set up the address of the addm t1,aldblk ; next entry to be added to ; the table of authorized ; users %1 %trnOn anymap ; set flag to indicate that ; the process pages should ; be UNmapped instead of ; PMAPed to the file retskp .prvnt: %trnOn anymap ; set flag to indicate that ; the process pages should ; be unmapped instead of ; PMAPed to the file %cmnoi ;[ti-32] issue noise word %pret %comnd [flddb. (.CMUSR)] %pret move t4,[point 7,buffr3] ; get byte pointer to storage ; area to which to transfer ; the contents of atom ; buffer %cmgab t4 %cmcfm %pret retskp $prvnt: movei t1,pmttab ; get the address of word 0 ; of the keyword table move t2,[point 7,buffr3] ; byte pointer to string ; in caller's address space ; that is to be compared ; with the string in the ; table TBLUK erjmp %1f txne t2,tl%exm ; is it an exact match ? jrst [move t2,t1 ; put the matching address ; in ac2 movei t1,pmttab ; get the address of word 0 ; of the keyword table TBDEL ; remove this user's privileges erjmp %1f tmsg< [MLIST privileges have been revoked for > ;[ti-32] hrroi t1,buffr3 psout tmsg<] > jrst %2f] %1 tmsg< ?Unable to revoke MLIST privileges of > ;[ti-32] hrroi t1,buffr3 psout tmsg< > %2 %trnOn anymap ; set flag to indicate that ; the process pages should ; be UNmapped instead of ; PMAPed to the file retskp .purge: setzm shoadr ; set this so that '$MYLST' routine ; will know that a 'SHOW' was not ; invoked -- in other words, we are ; are doing a 'PURGE' %comnd [flddb. (.CMUSR)] %pret movem t2,iusrno ; save the user number %cmnoi %pret %comnd [flddb. (.CMCFM,cm%hpp+cm%sdh,,,,[ flddb. (.CMKEY,,prgtab)])] %pret hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it caie t3,.CMKEY ; did you already get confirmation ? jrst %1f ; yes %cmcfm ; no, so get it %pret move t1,shoadr ; indicate that 'PURGE ALL' was ; invoked tlo t1,400000 ; movem t1,shoadr ; %1 retskp $purge: move t3,[sixbit/DELETE/] ;[ti-32] call ckauth ;[ti-19] Am I authorized ? jrst $purg2 ;[ti-19] no...so only let me ;[ti-19] purge me jrst $purg3 ;[ti-19] yes...so do whatever I ;[ti-19] $purg2: ;[ti-19] (label) move t1,iusrno ;[ti-19] came t1,myusno ;[ti-19] am I trying to purge me ? jrst [ tmsg < ? You are ONLY allowed to PURGE yourself...sorry> ;[ti-19] ret ] ;[ti-19] $purg3: ;[ti-19] (label) movei t1,.CMUSR ; set the function code so $MYLST movem t1,fncode ; routine will know what to do call $mylst ; do it tmsg< [ PURGE completed ]> retskp SUBTTL ADD Command - Parse User Input .add: %comnd [flddb. (.CMUSR,,,,,[ flddb. (.CMKEY,,addtab,,,[ flddb. (.CMIFI,cm%hpp+cm%sdh,,,,[ fldbk. (.CMFLD,cm%brk+cm%sdh,,,,[ brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,,<.>)])])])])] %pret %trnOff badusr ; init setzm fncod1 ; setzm addcod ;[ti-38] assume no add table option ;[ti-38] selected move t4,[point 7,dirstg] ; byte pointer to storage area ; to which the contents of the ; atom buffer will be transferred %cmgab t4 ; transfer contents of the atom ; buffer hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncode ; save the function code cain t3,.CMKEY ;[ti-38] jrst .dscrb ;[ti-38] cain t3, .CMUSR ; was it a user name ? call [ movem t2,iusrno ; yes, so save user number hrroi t1,dirstg ; destination designator move t2,iusrno ; translate this user # DIRST jfcl ret ] cain t3, .CMIFI ; was it a file spec ? call [ hrrzm t2,ijfn ; yes, so save the jfn hrroi t1,dirstg ; destination designator move t2,ijfn ; translate this jfn move t3,[111100,,1] ; using these formatting bits setz t4, JFNS ret ] ifn pobox,<;[ti-15] hrroi t1,orgnam ;[ti-7] save specified address hrroi t2,dirstg ;[ti-7] for MALBOX setzb t3,t4 ;[ti-7] SOUT ;[ti-7] setz t2, ;[ti-7] BOUT ;[ti-7] >;pobox [ti-8][ti-15] hrroi t1,buffr4 ; transfer contents of the ; atom buffer again to hrroi t2,dirstg ; construct a network ; address setz t3, setz t4, SOUT movem t1,t1save ; save the update byte ; pointer move t3,fncode ; get the function code cain t3,.CMFLD ; was it a text field ; (i.e. an invalid user, ; an invalid file spec, ; or DESTINATION net-mail) jrst %1f cain t3,.CMIFI ; did you parse a file spec ? jrst %4f move p3,[cm%xif] iorm p3,%csb ; no indirect files allowed ifn pobox,<;[ti-15] call malbox ;[ti-7] is it a mailbox ? jrst [ skipe hstbuf ;[ti-8] YES, so if this is a network %trnOn badusr ;[ti-8] addr, then so indicate jrst %4f ] ;[ti-7] >;pobox [ti-8][ti-15] %skpOn anyhst ; has the file containing ; DECNET node names been ; found and processed ? jrst %4f ; no, so go get name of ; mailing list %comnd [flddb. (.CMTOK,cm%sdh,,<"@">,,[ fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])])] %pret hrrzs t3 ; address of fdb actually used ldb t3,[pointr (.cmfnp(t3),cm%fnc)] ; get the function ; code from it movem t3,fncod1 ; save the function code cain t3,.CMKEY ; was it a mailing list file ; name ? jrst %9f ; yes %trnOn badusr ;[ti-5] indicate network address movei p4,.CMFLD movem p4,fncode ; move t1,t1save movei t2,"@" BOUT ; append an at-sign to the ; valid user name movem t1,t1save ; save the updated byte ; pointer jrst %2f ; no %1 move p3,[cm%xif] iorm p3,%csb ; no indirect files allowed move t4,[point 7,dirstg] ; check "field" for file ; spec %5 ildb p4,t4 ; get the next byte cain p4,":" ; is it a colon ? jrst [%trnOn badusr jrst %5b] cain p4,"<" ; is it a left bracket ? jrst [%trnOn badusr jrst %5b] caie p4,0 ; is this the end of the ; "field" jrst %5b ; no %skpOn badusr jrst %6f move t1,[gj%sht+gj%old] hrroi t2,dirstg ; byte pointer to file spec GTJFN jrst [ cain t1,600104 jrst [tmsg< ?File not found> jrst %3f] cain t1,600074 jrst [tmsg< ?No such device> jrst %3f] cain t1,600075 jrst [tmsg< ?No such directory name> jrst %3f] cain t1,600077 jrst [tmsg< ?No such file type> jrst %3f] cain t1,600066 jrst [tmsg< ?Generation number is not numeric> jrst %3f] cain t1,600114 jrst [tmsg< ?Directory access privileges required> jrst %3f] tmsg< ?File not found> jrst %3f] %3 ret ; error return %6 ifn pobox,<;[ti-15] call malbox ;[ti-7] is it a mailbox ? jrst [ skipe hstbuf ;[ti-8] YES, so if this is a network %trnOn badusr ;[ti-8] addr, then so indicate jrst %4f ] ;[ti-7] >;pobox [ti-8][ti-15] %comnd [flddb. (.CMTOK,cm%sdh,,<"@">)] %pret move t1,t1save ; get destination designator movei t2,"@" ; and output an at-sign BOUT movem t1,t1save ; save the updated byte ; pointer %trnOn badusr ; set flag to indicate that ; the user to be added is ; a network address %2 %comnd [flddb. (.CMKEY,,hostab)] %pret move t1,t1save ; destination designator hlro t2,@t2 ; source designator setz t3, setz t4, SOUT %4 %cmnoi %pret %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] %pret %9 movem t2,t2save ; save the address of the ; table entry where the ; keyword was found hrroi t1,dirstg ; destination designator hrroi t2,buffr4 ; source designator setz t3, setz t4, SOUT %cmcfm %pret ifn nwname,< ;[ti-16] %skpOff badusr jrst [move t2,t2save ; [ti-2] retrieve address ; of table entry ; where keyword was ; found hrrz t1,@t2 ; get the address of the ; header word in dirnos for ; this mailing list hrrz t3,@t1 ; get the address of the name ; for this mailing list, if ; if any caie t3,0 ; is there a name for this ; mailing list ? jrst [tmsg< ?No network addresses allowed on mailing lists having mailing list names - no addition performed> jrst %8f] jrst %4f] >;ifn nwname ;[ti-16] %4 %cmRes ; reset the parsing information retskp %8 ret SUBTTL ADD Command - Processing $add: skipe addcod ;[ti-38] if option selected from jrst @addcod ;[ti-38] the table, then do that ;[ti-38] instead %trnOn a ; set flag to indicate that an ; ADD was invoked during this ; execution of MLIST ; (for LOG purposes only) %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file move t1,t2save ; get the address of the ; table entry where the ; keyword was found movei t2,namtab ; get the beginning address ; of the keyword table movem t2,t2save ; save this address subm t1,t2save ; calculate the offset of the ; table entry from the ; beginning of the keyword ; table move q1,t2save ; get the offset into namtab of ; the entry for this mailing ; list hrrz q2,namtab(q1) ; get the address of the header ; word (in dirnos) for this ; mailing list hlrz q3,@q2 ; get the count of the number ; of entries in this mailing ; list caile q3,MAXUSR-1 ;[ti-17] Is there room for just ;[ti-17] one more ??? jrst [ hrroi t1,[asciz/ ? This mailing list is FULL. Please notify your system manager. /] ;[ti-17] PSOUT ;[ti-17] ret ] ;[ti-17] cain q3,0 ; are there any entries in ; this mailing list ? jrst .adusr ; no, so proceed to add this ; user name or file spec to ; the mailing list movem q3,entcnt ; save this count of the number ; of entries in this mailing ; list movem q2,t4save ; save the address of the header movem q2,p4save ; header word in dirnos movei q3,1 ; set up the increment into ; dirnos for this mailing list %1 addm q3,t4save ; calculate the address of the ; next entry in this mailing ; list move t3,@t4save ; get this next entry move p4,fncode ; get the function code cain p4,.CMUSR ; was a user name parsed ? jrst [tlnn t3,777777 ; yes, is this entry a user ; number ? jrst %5f ; no, so try the next entry came t3,iusrno ; does this entry match what ; the user input ? jrst %5f ; no, so try the next entry call alredy ; yes, so tell the user %trnOff a ; reset flag jrst addret] ; and go back to command level caie p4,.CMUSR ; was a file spec or field ; parsed ? jrst [tlne t3,777777 ; is this entry a file spec ; or field ? jrst %5f ; no, so go try the next entry move p1,[point 7,@t3] ; yes, so get byte pointer to asciz ; file spec or field move p2,[point 7,flspst] ; byte pointer to storage area ; to construct file spec ; without the '*' move p4,fncode ; get the last function code %4 ildb p3,p1 ; get next byte from input file ; spec idpb p3,p2 ; deposit the byte tlne p1,760000 ; has the byte pointer to this ; word been exhausted ? jrst %4b ; no, so get the next byte addi t3,1 ; get the address of the next ; word of the asciz string move p4,@t3 ; get the next word of the ; asciz string caie p4,0 ; is the word a null word ? jrst [move p1,[point 7,@t3] ; no, so get ; byte ptr to ; this word jrst %4b] ; and continue idpb p4,p2 ; yes, so deposit it move p4,fncode ; get the last function code cain p4,.CMFLD ; was a field parsed ? jrst [hrroi t1,buffr3 ; destination designator hrroi t2,flspst ; source designator setz t3, setz t4, SOUT jrst %7f] ; yes move t1,[gj%sht+gj%old] ; file must exist hrroi t2,flspst ; byte pointer to file spec GTJFN ; short form jrst %5f hrrzs t1 ; get rid of the flags returned movem t1,t1save ; save the jfn returned move t2,t1 ; get the jfn returned hrroi t1,buffr3 ; get byte pointer to storage ; area where asciz string ; specifying test string ; will be returned move t3,[111110,,1] ; punctuation bits setz t4, JFNS move t1,t2 ; get the old jfn RLJFN ; and release it jrst .+1 %7 move p4,fncode ; get the function code cain p4,.CMFLD ; was a field parsed jrst [hrroi t1,buffr4 ; destination designator hrroi t2,dirstg ; source designator setz t3, setz t4, SOUT jrst %6f] hrroi t1,buffr4 ; get byte pointer to storage ; area where asciz string ; specifying base string ; will be returned move t2,ijfn ; get jfn returned from COMND ; jsys move t3,[111110,,1] ; punctuation bits setz t4, JFNS move t1,t2 ; shift the jfn to ac1 RLJFN ; and release it jrst .+1 %6 hrroi t1,buffr3 ; byte pointer to test string hrroi t2,buffr4 ; byte pointer to base string STCMP cain t1,0 ; is it a match ? jrst [call alredy ; yes, so tell the user so %trnOff a ; reset flag jrst addret] ; and go back to command level %5 addi q3,1 ; increment the index into ; dirnos for this mailing list camg q3,entcnt ; have all of the entries in ; this mailing list been ; tested ? jrst [move p4,p4save ; restore the address of the ; header word (in dirnos) ; for this mailing list movem p4,t4save ; jrst %1b] jrst .adusr] ; yes, so proceed to add this ; user or file spec to the ; mailing list SUBTTL ADD Command - Add User .adusr: move t3,fncode ; get the function code cain t3,.CMUSR ; was a user name parsed ? jrst %9f ; yes ; prefix the file spec in memory with a "*" move t1,[point 7,flspst] ; byte pointer to storage ; area where '*' will be ; added as a prefix to the ; file spec move t2,[point 7,dirstg] ; byte pointer to storage ; area where the file spec ; itself is being kept cain t3,.CMFLD ; was a field parsed ? jrst %1f ; yes so don't prefix with ; a "*" movei t3,"*" idpb t3,t1 ; deposit the "*" %1 ildb t3,t2 ; get the next byte of the ; file spec idpb t3,t1 ; and deposit it in the ; modified string caie t3,0 ; is it the end of the string ? jrst %1b ; no ; add the user name / modified file spec to the mailing list %9 move q1,t2save ; get the offset into jfndir ; of the entry for this ; mailing list movei t1,argtbl ; get the beginning address of ; the argument table hlro t2,namtab(q1) ; byte pointer to asciz string ; specifying appropriate file ; name GTJFN jrst [ tmsg move t3,fncode cain t3, .CMUSR hrroi t1,dirstg caie t3, .CMUSR hrroi t1,flspst psout tmsg< to > hlro t1,namtab(q1) psout tmsg<. Please try again.> jrst addret] hrrm t1,jfndir(q1) ; save the jfn returned hrrz t1,jfndir(q1) ; get the jfn for the file ; containing this mailing ; list move t2,[<7b5>+of%rd+of%wr+of%awt] ; 7 bit bytes and append access OPENF jrst [ caie t1,600121 ; does the file containing the ; mailing list exist ? jrst %1f ; yes tmsg jrst addret %1 tmsg move t3,fncode cain t3, .CMUSR hrroi t1,dirstg caie t3, .CMUSR hrroi t1,flspst psout tmsg< to > hlro t1,namtab(q1) psout tmsg<. Please try again.> jrst addret] hrrz t4,namtab(q1) ; get the address of the header ; word (in dirnos) for this ; mailing list movem t4,t4save ; save this address hlrz t4,@t4save ; get the count of the number ; of entries in this mailing ; list (from the header word ; for this mailing list in ; in dirnos) caie t4,0 ; are there any entries in ; this mailing list ? call [seto t2, ; set the file's pointer to the ; current end of file SFPTR ; erjmp .+1 BKJFN ; back up one byte erjmp %2f %1 BIN ; see what the byte is caig t2,37 ; is the byte a control ; character ? jrst [BKJFN ; back up 2 bytes to get erjmp %2f ; the "next previous" BKJFN ; character erjmp %2f jrst %1b] %2 hrrz t1,jfndir(q1) ; yes, so get the jfn ; (i.e. destination designator) movei t2,"," ; output a comma BOUT movei t2," " ; and a space BOUT ret] hrrz t1,jfndir(q1) ; destination designator move t3,fncode ; get the function code cain t3, .CMUSR ; was a user name parsed ? move t2,[point 7,dirstg] ; yes, so get byte pointer ; to user name caie t3, .CMUSR ; was a user name parsed ? move t2,[point 7,flspst] ; no, so get byte pointer to ; modified file spec setz t3, setz t4, SOUT hrrz t1,jfndir(q1) ; get the destination designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT hrrz t1,jfndir(q1) ; get the jfn from jfndir CLOSF jrst .+1 ; update the data base move q1,t2save ; get the offset into the ; keyword table / jfndir hrrz q2,namtab(q1) ; get the address of the header ; word in dirnos for the ; appropriate mailing list hlrz t1,@q2 ; get the count of the number ; of entries in the appropriate ; mailing list from the header ; word in dirnos addi t1,1 ; increment the index into ; dirnos hrlm t1,@q2 ; restore the header word in ; dirnos of the appropriate ; mailing list move t3,fncode ; get the function code caie t3, .CMUSR ; was a user name parsed ? call [hrrz t2,q2save ; get the address of the last ; asciz string added to mmnams %1 move q3,@t2 caie q3,0 ; is it a null word? jrst [addi t2,1 ; no jrst %1b] addi t2,1 ; leave a null word between ; strings hrrm t2,q2save ; save this address hrroi t1,@t2 ; destination designator hrroi t2,flspst ; byte pointer to string to be ; written setz t3, setz t4, SOUT hlrz t1,@q2 ; get index into current mailing ; list information in dirnos move t3,t2save ; get the offset into namtab ; and jfndir of the entries ; for this mailing list hrrz t2,namtab(t3) ; get the address of the header ; word for the associated ; mailing list in dirnos movem t2,t4save ; save this address hrrz q2,q2save ; get the address of the last ; asciz string added to mmnams addm t1,t4save ; update the address of the next ; entry in the appropriate ; mailing list in dirnos movem q2,@t4save ; add this address to the ; appropriate mailing list in ; dirnos tmsg< [> move t1,[.priou] ; get destination designator move t2,[point 7,dirstg] ; byte pointer to asciz string ; file specification setz t3, setz t4, SOUT tmsg< added to mailing list > move t1,[.priou] ; get destination designator move q1,t2save ; get the offset of the address ; of the file name (in namtab) ; for this mailing list hlro t2,namtab(q1) ; byte pointer to the file ; name for this mailing list setz t3, setz t4, SOUT tmsg<]> ret] move t3,fncode ; get the function code cain t3, .CMUSR ; was a user name parsed ? call [movem q2,t4save ; save the address of the ; header word in dirnos of the ; appropriate mailing list ; for the purpose of calculating ; the address of the newest ; entry in the mailing list move t3,iusrno ; get the user number parsed by ; the COMND jsys addm t1,t4save ; update address of the next ; entry in the appropriate ; mailing list movem t3,@t4save ; add this address to the ; appropriate mailing list in ; dirnos tmsg< [> move t1,[.priou] ; get destination designator move t2,iusrno ; get user-input user number DIRST jrst .+1 tmsg< added to mailing list > move t1,[.priou] ; get destination designator move q1,t2save ; get the offset of the address ; (in namtab) of the file name ; for this mailing list hlro t2,namtab(q1) ; byte pointer to the file ; name for this mailing list setz t3, setz t4, SOUT tmsg<]> ret ] %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file hrrz t1,jfndir(q1) ; get the old jfn RLJFN ; and release it jrst .+1 %cmRes ; reset the parsing information call LOG ; addret: retskp SUBTTL CREATE Command - Parse User Input .creat: %cmnoi ; issue noise word %pret hrli t1,filtbl+.gjgen ; put user-suppliable data hrri t1,gjfblk+.gjgen ; in GTJFN argument block blt t1,gjfblk+.gjjfn ; for use by COMND jsys %comnd [flddb. (.CMFIL,cm%sdh,,)] %pret hrrzm t2,ijfn ; save the jfn returned hrrzm t2,jfnsav ; hrrzm t2,tmpjfn ; clrbuf Dirstg, Dstlen ;[ti-18] Clear out buffer space move q1,[point 7,dirstg] ; byte pointer to storage area to ; which contents of atom buffer ; will be transferred %cmgab q1 ; transfer contents of atom buffer %cmcfm ; get confirmation %pret crtret: %cmRes ; reset the parsing information retskp SUBTTL CREATE Command - Processing $creat: hlrz t1,namtab ;[ti-31] cail t1,maxlst ;[ti-31] Tell user if no more jrst [ hrroi t1,[asciz/ ? Your request exceeds the maximum number of mailing lists currently supported by MLIST. Please contact your local MLIST support person. /] ;[ti-31] PSOUT ;[ti-31] ret ] %trnOn c ; set flag to indicate that a ; CREATE was invoked during ; this execution of MLIST ; (for LOG purposes only) %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file clrbuf Buffr3, Bufsiz ;[ti-18] Clear out buffer space ;[ti-13] repeat 0,< hrroi t1,[asciz/ Please enter name of new mailing list. Terminate with a carriage return: /] ; give user necessary psout ; instructions hrroi t1,buffr3 ; byte pointer to storage ; area where user input ; (name of new mailing list) ; is to be placed hrrzi t2,30 ; maximum of 30 bytes setz t3, RDTTY %jsErr < ? Error reading mailing list name...continuing...>, namerr ;[ti-13]>;[ti-10] NO MAILIST NAMES !!!! namerr: hrroi t1,[asciz/ Please enter contents of mailing list /] ; give user necessary psout ; instructions move t1,[.priou] ; get destination designator hrroi t2,dirstg ; byte pointer to file name ; of new mailing list ; (without device name) movei t3,50 ; max of 50 bytes movei t4,40 ; terminate output on a ; space SOUT move t1,[.priou] ; get destination designator movei t2,"." ; output a period BOUT hrroi t1,[asciz/ Terminate input with or C-Z./] psout move t1,[.priou] ; get destination designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT hrroi t1,buffr4 ; byte pointer to storage ; area where user input ; (contents of new mailing ; list) is to be placed move t2,[rd%brk] ; break on esc or c-z hrri t2,1000 ; 1000 bytes setz t3, RDTTY %jsErr < ? Error reading contents...aborting...>, retcrt move t1,jfnsav ; get the jfn move t2,[<7b5>+of%rd+of%wr] ; 7-bit bytes, and write access OPENF jrst [ tmsg hrroi t1,dirstg psout tmsg<. Please try again.> jrst retcrt] setz p4, ; zero out the counter of the ; number of bytes input as ; the name of the mailing list ; (excluding the ":") move t1,jfnsav ; get the jfn move q3,[point 7,buffr3] ; byte pointer to storage area ; containing string to be ; transferred %5 ildb t2,q3 ; get the next byte cain t2,15 ; is it a carriage return ? jrst [caile p4,1 ; yes, so make sure that a ":" ; is the last byte of the name ; of the mailing list, if any jrst [caie t3,":" ; was the last byte input a ":" ? jrst [move t1,jfnsav ; get the destination ; designator movei t2,":" ; output a ":" BOUT movei t2,40 ; output a space BOUT jrst %3f] jrst %3f] jrst %3f] caile t2,37 ; is it a control character ? jrst [move t3,t2 ; no, so save this byte for later BOUT ; output the byte to the file ; containing the new mailing ; list addi p4,1 ; increment the count of the ; bytes in the name of the new ; mailing list jrst %5b] jrst %5b %3 move t1,jfnsav ; get the jfn move q3,[point 7,buffr4] ; byte pointer to storage area ; containing string to be ; transferred %1 ildb t2,q3 ; get the next byte cain t2,32 ; is it a c-z ? jrst %2f ; yes cain t2,33 ; is it an esc ? jrst %2f ; yes caile t2,37 ; is it a control character ? BOUT ; no, so output the byte to ; the file containing the new ; mailing list jrst %1b ; and continue %2 move t1,jfnsav ; get the jfn movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT hrli t1,12 ; update word 12 of fdb hrr t1,jfnsav ; get the jfn seto t2, ; update all 36 bits of word 12 movei t3,1000 ; 1000 bytes CHFDB move t1,[co%nrj] ; do not release the jfn hrr t1,jfnsav ; get the jfn CLOSF jrst .+1 %trnOff strflg ; initialize flags for correct %trnOff flag2 ; invocation of goagin %trnOff fstnam ; %trnOn colflg ; %trnOff gotusr ; %trnOn gotnam ; MOVE T2,LSTHDR ; get the address of the header ; word (in dirnos) of the last ; mailing list to be added (not ; necessarily alphabetically) ; to the data base MOVEM T2,P4SAVE ; SAVE THIS ADDRESS CALL GOAGIN ; PARSE THE CONTENTS OF THE ; NEW MAILING LIST AND UPDATE ; THE MAILING LIST DATA BASE retcrt: %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file hrrz t1,jfnsav ; now you can release the jfn RLJFN jrst .+1 %cmRes ; reset the parsing information call LOG retskp SUBTTL Delete Miscellaneous Routines delerr: setzm %csb+.cminc ;[ti-4] to handle errors on ;[ti-4] 'DELETE ' jrst (q3) ;[ti-4] SUBTTL DELETE Command - Parse User Input .delet: call fldbrk ; remove @ from the break mask ; for .CMFLD move p3,[cm%xif] iorm p3,%csb ; no indirect files allowed move t3,[sixbit/DELETE/] ;[ti-33] call ckauth ;[ti-33] Am I authorized ? jrst .dele2 ;[ti-33] no...so only let me ;[ti-33] delete me ;[ti-33] yes...so do whatever I ;[ti-33] say do %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[ flddb. (.CMUSR,,,,,[ flddb. (.CMIFI,cm%hpp+cm%sdh,,,,[ flddb. (.CMQST,cm%sdh,,,,[ ;[ti-33] fldbk. (.CMFLD,cm%brk+cm%sdh,,,,[ brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,,<.>)])])])])])] %pret jrst .dele3 ;[ti-33] .dele2: ;[ti-33] Here for non-priv DELETE %comnd [flddb. (.CMUSR,,,,,[ flddb. (.CMIFI,cm%hpp+cm%sdh,,,,[ flddb. (.CMQST,cm%sdh,,,,[ ;[ti-33] fldbk. (.CMFLD,cm%brk+cm%sdh,,,,[ brmsk. (fldb0.,fldb1.,fldb2.,fldb3.,,<.>)])])])])] ;[ti-33] %pret ;[ti-33] .dele3: move t4,[point 7,dirstg] ; byte pointer to storage area ; to which the contents of the ; atom buffer will be transferred %cmgab t4 ; transfer contents of the atom ; buffer hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncode ; save the function code cain t3,.CMKEY ; was it a mailing list ? jrst [movem t2,t2save ; save the address of the ; keyword in the tbluk table jrst %2f] cain t3, .CMFLD ; was it an obsolete user ; name ? jrst %1f cain t3, .CMQST ;[ti-33] Treat the same as a field jrst %1f ;[ti-33] cain t3, .CMUSR ; was it a user name ? call [ movem t2,iusrno ; yes, so save the user number hrroi t1,dirstg ; destination designator move t2,iusrno ; translate this user # DIRST jfcl ret ] cain t3, .CMIFI ; was it a user name ? call [ movem t2,ijfn ; no, so save the jfn hrroi t1,dirstg ; destination designator move t2,ijfn ; translate this jfn move t3,[111100,,1] ; using these format bits setz t4, JFNS ret ] %1 %cmnoi ; issue noise word %pret %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] ; parse name of mailing list ; with altered break mask %pret movem t2,t2save ; save the address of the ; table entry where the ; matching keyword was ; found %2 %cmcfm ; get confirmation %pret move t3,fncode ; was it an entire mailing ; list to be deleted ? caie t3,.CMKEY jrst %3f hrroi t1,prtext ;[ti-4] build the prompt here hrroi t2,[asciz/ Are you sure that you want to delete /];[ti-4] setzb t3,t4 ;[ti-4] SOUT ;[ti-4] move t2,t2save hlro t2,@t2 ;[ti-4] move p5,t1 ; save this byte pointer SOUT ;[ti-4] hrroi t2,[asciz/ ? /] ;[ti-4] SOUT ;[ti-4] hrroi t2,[asciz//] ;[ti-4] SOUT ;[ti-4] %cmRes ;[ti-4] hrroi t1,prtext ;[ti-4] save byte pointer to prompt ;[ti-4] in csb movem t1,%csb+2 ;[ti-4] movei t1,delrep ;[ti-4] save reparse address in csb hrrm t1,%csb ;[ti-4] %cmRes ;[ti-4] movei q3,delrst ;[ti-4] save error address delrst: %comnd [flddb. (.CMINI,,,gjfblk)] ;[ti-4] %jsErr delrep: %comnd [flddb. (.CMKEY,,YNtab,,)] ;[ti-4] %merrep (delrst, delerr) ;[ti-4] hrrz t2,(t2) ;[ti-4] extract dispatch data movem t2,delreq ;[ti-4] save it %cmcfm ;[ti-4] get confirmation %pret ;[ti-4] skipn delreq ;[ti-4] jrst [ tmsg< [No deletion performed]> ;[ti-4] jrst %1f ] ;[ti-4] %3 %cmRes ; reset the parsing information retskp %1 ret SUBTTL DELETE Command - Processing $delet: call fldrst ; restore @ into the break ; mask for .CMFLD %trnOn d ; set flag to indicate that a ; DELETE was invoked during ; this execution of MLIST ; (for LOG purposes only) %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file %trnOff delflg ; initialize flag to indicate ; that no user name or file ; spec has been deleted from ; a mailing list %trnOn delopt ; set flag to indicate to a ; later portion of code that ; the DELETE option is being ; invoked move t3,fncode ;[ti-19] Get the last function code caie t3,.CMUSR ;[ti-19] If not trying to delete a jrst $dele3 ;[ti-19] user, don't check authority move t3,[sixbit/DELETE/] ;[ti-32] call ckauth ;[ti-19] Am I authorized ? jrst $dele2 ;[ti-19] no...so only let me ;[ti-19] delete me jrst $dele3 ;[ti-19] yes...so do whatever I ;[ti-19] $dele2: ;[ti-19] (label) move t1,iusrno ;[ti-19] came t1,myusno ;[ti-19] am I trying to purge me ? jrst [ tmsg < ? You are ONLY allowed to DELETE yourself...sorry> ;[ti-19] ret ] ;[ti-19] $dele3: ;[ti-19] (label) move t3,fncode ; get the last function code cain t3,.CMKEY jrst [move t1,t2save ; get the address of the ; matching table entry movei t2,namtab ; get the beginning address ; of the keyword table movem t2,t2save ; save this address subm t1,t2save ; calculate the offset into ; the keyword table move q1,t2save ; and get this offset movei t1,deltbl ; beginning address of ; argument block hlro t2,namtab(q1) ; byte pointer to file spec GTJFN jrst [ tmsg hlro t1,namtab(q1) psout tmsg< . Please try later.> jrst DELRET] movem t1,jfnsav ; save the jfn returned movei t1,jfndir ; address of word 0 of tbluk ; table move t2,jfndir(q1) ; save entry just in case movem t2,tabent ; move t2,q1 ; calculate the address of ; the matching entry addi t2,jfndir ; TBDEL erjmp [tmsg hlro t1,tabent psout tmsg< . Please try later.> jrst DELRET] movei t1,namtab ; address of word 0 of tbluk ; table move t2,q1 ; calculate the address of ; the matching entry addi t2,namtab ; TBDEL erjmp [tmsg hlro t1,tabent psout tmsg< . Please try later.> move t1,jfndir ; restore the entry deleted move t2,tabent ; from jfndir tbluk table TBADD erjmp DELRET] %2 hrrz t1,jfnsav ; get rid of the flags move t2,[of%wr+of%rtd] OPENF jrst [ tmsg hlro t1,tabent psout tmsg< . Please try later.> movei t1,jfndir ; address of word 0 of ; keyword table hllz t2,tabent ; table entry TBADD erjmp .+1 movei t1,namtab ; address of word 0 of ; keyword table move t2,tabent ; table entry TBADD erjmp .+1 jrst DELRET] move t1,[co%nrj] hrr t1,jfnsav ; get the jfn CLOSF ; and close the file jrst .+1 move t1,[df%exp] ; delete, but don't expunge ; the file hrr t1,jfnsav ; get the jfn DELF erjmp [tmsg hlro t1,tabent psout tmsg< . Please try later.> jrst DELRET] hrrzs t1 ; get rid of the flags, RLJFN ; and release the jfn ; since it wasn't released ; by DELF jfcl movei t1,deltbl ; address of word 0 of ; argument block hlro t2,tabent ; byte pointer to file ; spec GTJFN jrst [ caie t1,600104 ; have all generations of ; this file been deleted ? jrst [cain t1,600076 jrst %1f jrst DELRET] jrst %1f] jrst %2b %1 tmsg< [Mailing list > hlro t1,tabent ; byte pointer to mailing list ; file name psout tmsg< deleted]> jrst DELRET] caie t3,.CMQST ;[ti-33] (treat the same as a field) cain t3,.CMFLD ; was it an obsolete user name ; or file spec ? jrst [hrroi t1,buffr4 ; destination designator hrroi t2,dirstg ; source designator (string ; to be written setz t3, setz t4, SOUT ; move the obsolete user ; to a work area to see ; if it is a file spec %trnOff badfil ; set flag to indicate that ; the obsolete user is an ; invalid user name until ; proven otherwise move t1,[point 7,buffr4] %6 ildb q1,t1 ; get the next byte cain q1,0 ; is it a null ? jrst %7f ; yes cain q1,":" ; is it a colon ? %trnOn badfil ; yes, so set flag to ; indicate that the obsolete ; user is a file spec cain q1,"<" ; is it a left angle bracket ? %trnOn badfil ; yes, so set flag to ; indicate that the obsolete ; user is a file spec jrst %6b %7 %skpOn badfil ; is the obsolete user a file ; spec ? jrst %8f hrroi t1,dirstg ; destination designator movei t2,"*" ; prefix the file spec with a ; "*" BOUT hrroi t2,buffr4 ; source designator (string ; to be written) setz t3, setz t4, SOUT jrst %8f] %8 move t2,t2save ; get the address of the table ; entry where the matching ; keyword was found movei t3,namtab ; get the beginning address of ; the keyword table where the ; matching keyword was found ; for the purpose of calculating ; the offset into the keyword ; table movem t3,t2save ; save the beginning address ; of the keyword table subm t2,t2save ; calculate the offset of the ; matching keyword table entry ; into the keyword table move q1,t2save ; get this offset hrrz t4,namtab(q1) ; get the address of the header ; word (in dirnos) for the ; appropriate mailing list ; in namtab movem t4,t4save ; save this address hlrz q2,@t4 ; get the count of the number ; of entries in this mailing ; list movem q2,q3save ; save this count movei q3,1 ; set up the offset into dirnos camle q3,q3save ; are there any entries in ; this mailing list ? jrst [tmsg< [Mailing list > move t1,[.priou] ; get destination designator move q1,t2save ; get the offset into namtab of ; the file name for this mailing ; list hlro t2,namtab(q1) ; byte pointer to this file name setz t3, setz t4, SOUT tmsg< is empty - no deletion performed]> jrst delret] ; %1 add t4,q3 ; yes, so set up the address of the ; next entry in this mailing ; list move t3,@t4 ; get the next entry in this ; mailing list move t4,fncode ; get the function code caie t4, .CMQST ;[ti-33] (Treat the same as a field) cain t4, .CMFLD ; was an obsolete user name ; parsed ? jrst [tlne t3,777777 ; is this entry a user number ? jrst %5f ; yes, so go try the next entry hrroi t1,@t3 ; byte pointer to test string ; "obsolete" user name hrroi t2,dirstg ; byte pointer to base string STCMP cain t1,0 ; is it a match ? call delusr ; yes, so go delete it from ; the file and the data base %skpOff delflg ; was the user deleted ? jrst [tmsg< [> move t1,[.priou] ; get destination designator move t2,[point 7,dirstg] ; byte pointer to asciz ; string specifying ; obsolete user setz t3, setz t4, SOUT tmsg< deleted from mailing list > move t1,[.priou] ; destination designator move q1,t2save ; get offset into namtab ; of the address of the ; file name for this ; mailing list hlro t2,namtab(q1) ; byte pointer to this ; file name setz t3, setz t4, SOUT tmsg<]> jrst delret] ; yes, so only delete the user ; one time jrst %5f] ; no, so go try the next entry move t4,fncode ; get the function code cain t4, .CMUSR ; was a user name parsed ? jrst [tlne t3,111111 ; yes, but is this entry a ; user number ? jrst [camn t3,iusrno ; yes, but does the user input ; match this entry ? call delusr ; yes, so delete this user from ; this mailing list %skpOff delflg ; was the user deleted ? jrst [tmsg< [> move t1,[.priou] ; destination designator move t2,iusrno ; get user-input user ; number DIRST jrst .+1 tmsg< deleted from mailing list > move t1,[.priou] ; destination designator move q1,t2save ; get offset into namtab ; of the address of the ; file name for this ; mailing list hlro t2,namtab(q1) ; byte pointer to this ; file name setz t3, setz t4, SOUT tmsg<]> jrst %3F] ; yes, so only delete the user ; one time jrst %2f] %2 addi q3,1 ; increment the offset into ; dirnos camg q3,q3save ; have all of the entries in ; this mailing list been tested ? jrst [move t4,t4save ; restore the address of the ; header word (in dirnos) of ; this mailing list jrst %1b] ; and go try the next entry tmsg< [> move t1,[.priou] ; get destination designator move t2,iusrno ; get user number that the ; user thought he could ; delete DIRST jrst %3f tmsg< not on mailing list > move q1,t2save ; get the offset into namtab ; of the entry for this ; mailing list hlro t1,namtab(q1) ; get the beginning address ; of the asciz string ; designating the name of ; the file containing the ; mailing list psout tmsg< - no deletion performed]> jrst %3f] ; that's all for this mailing ; list %3 move t4,fncode ; get the function code cain t4, .CMIFI ; was a file spec parsed ? ; here when the user input is a file spec to delete from a mailing ; list jrst [tlne t3,111111 ; is this entry a user number ? jrst %5f ; yes, so go try the next entry move p1,[point 7,@t3] ; no, so get byte pointer to asciz ; file spec move p2,[point 7,flspst] ; byte pointer to storage area ; to construct file spec ; without the '*' ibp p1 ; space over the '*' %4 ildb p3,p1 ; get next byte from input file ; spec caie p3,0 ; is the byte a null ? jrst [idpb p3,p2 ; no, so deposit it and go jrst %4b] ; get the next one addi t3,1 ; get the address of the next ; word of the asciz string move p4,@t3 ; get the next word of the ; asciz string caie p4,0 ; is the word a null word ? jrst [move p1,[point 7,@t3] ; no, so get ; byte ptr to ; this word jrst %4b] ; and continue idpb p3,p2 ; yes, so deposit it move t1,[gj%sht+gj%old] ; file must exist hrroi t2,flspst ; byte pointer to file spec GTJFN ; short form jrst %5f hrrzs t1 ; get rid of the flags returned movem t1,t1save ; save the jfn returned move t2,t1 ; get the jfn returned hrroi t1,dirstg ; get byte pointer to storage ; area where asciz string ; specifying test string ; will be returned move t3,[111100,,1] ; punctuation bits [ti-12] setz t4, JFNS move t1,t2 ; get the old jfn RLJFN ; and release it jrst .+1 hrroi t1,buffr4 ; get byte pointer to storage ; area where asciz string ; specifying base string ; will be returned move t2,ijfn ; get jfn returned from COMND ; jsys move t3,[111100,,1] ; punctuation bits [ti-12] setz t4, JFNS repeat 0,< move t1,t2 ; get the old jfn RLJFN ; and release it jrst .+1 >;[ti-12] ;[ti-12] we still need this jfn later hrroi t1,dirstg ; byte pointer to test string hrroi t2,buffr4 ; byte pointer to base string STCMP cain t1,0 ; is it a match ? call delusr ; yes, so go delete it from ; the file and the data base %skpOff delflg ; was the user deleted ? jrst [tmsg< [> move t1,[.priou] ; get destination designator move t2,[point 7,flspst] ; byte pointer to asciz ; string file spec setz t3, setz t4, SOUT tmsg< deleted from mailing list > move t1,[.priou] ; destination designator move q1,t2save ; get offset into namtab of the ; address of the file name for ; this mailing list hlro t2,namtab(q1) ; byte pointer to this ; file name setz t3, setz t4, SOUT tmsg<]> move t1,ijfn ;[ti-12] we're all done with RLJFN ;[ti-12] this jfn now jfcl ;[ti-12] jrst delret] ; yes, so only delete the user ; one time %5 addi q3,1 ; increment the offset into ; dirnos camg q3,q3save ; have all of the entries in ; this mailing list been tested ? jrst [move t4,t4save ; restore the address of the ; header word (in dirnos) of ; this mailing list jrst %1b] ; and go try the next entry tmsg< [> move t1,[.priou] ; get destination designator hrroi t2,dirstg ; get byte pointer to asciz ; string designating the ; file spec that the user ; thought he could delete setz t3, setz t4, SOUT tmsg< not on mailing list > move q1,t2save ; get the offset into namtab ; of the entry for this mailing ; list hlro t1,namtab(q1) ; get byte pointer to the asciz ; string designating the file ; that contains this mailing ; list psout tmsg< - no deletion performed]> move t1,ijfn ;[ti-12] we're all done with RLJFN ;[ti-12] this jfn now jfcl ;[ti-12] jrst delret] DELRET: %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file %cmRes ; reset the parsing information call LOG retskp ; that's all for this mailing ; list SUBTTL Delete Miscellaneous Routines ; find (and delete) the user name from the mailing list delusr: %trnOff dodel ; reset flag movem q3,q1save ; save the offset into this ; particular mailing list (in ; dirnos) of the entry to ; delete rename: move t4,t4save ; get the address of the header ; word (in dirnos) for this ; mailing list ; --> t2save contains the offset ; into jfndir of the entry for ; this particular mailing list ; --> q3save contains the number ; of entries in this mailing ; list move q1,t2save ; get the offset into jfndir ; of the entry for this mailing ; list hrrz t1,jfndir(q1) ; get the old jfn for this ; mailing list cain t1,0 ; if there is one jrst %3f RLJFN ; and release it jrst .+1 %3 hrrzi t1,vsntbl ; address of the beginning of ; the argument table hlrz t3,namtab(q1) ; get the address of the file ; specification for the file hrroi t2,@t3 ; byte pointer to asciz file ; specification GTJFN ; long form jrst [ hrroi t1,[asciz/Unable to perform deletion /] psout jrst dusrrt] hrrzs t1 ; get rid of the flags returned hrrm t1,jfndir(q1) ; save the jfn returned in ; jfndir move t2,[<7b5>+of%rd+of%wr+of%awt] ; 7 bit bytes; read and write access OPENF ; jrst [ caie t1,600121 ; does the file containing the ; mailing list still exist ? jrst %1f ; yes hrroi t1,[asciz/?This mailing list no longer exists./] psout jrst dusrrt %1 hrroi t1,[asciz/Unable to perform deletion /] psout jrst dusrrt] move q2,@t4 ; get the header word for this ; mailing list trne q2,777777 ; does the header word of this ; mailing list (in dirnos) ; contain an address of a mailing ; list name asciz string ? call [hrrzs q2 ; get rid of the count of the ; number of entries move t3,q2 %2 move p1,[point 7,@t3] ; byte pointer to asciz string to ; be written %1 ildb p3,p1 ; get the next byte caie p3,0 ; is this byte a null ? jrst [hrrz t1,jfndir(q1) ; no, so get destination ; designator move t2,p3 BOUT jrst %1b] addi t3,1 ; yes, so see if the next word is ; a null move p3,@t3 ; get the next word caie p3,0 ; is this word a null word ? jrst %2b ; no, so continue hrrz t1,jfndir(q1) ; yes, so get destination designator movei t2," " ; and byte to be output BOUT ret] %skpOn delopt ; is the DELETE option being ; invoked ? jrst [movei q3,1 ; are there any entries in ; this mailing list ? camle q3,q3save ; jrst %3f ; no, so close the file jrst %7f] ; yes, so continue to output ; the entries in the mailing ; list to the file %7 move p4,t4save ; get the address of the header ; word in dirnos for this ; mailing list movem p4,p4save ; save this address again movei p4,1 ; set up an index into dirnos %9 addm p4,p4save ; calculate the address of the ; next entry in this mailing ; list came p4,q1save ; is this the entry to delete ? jrst [move p3,@p4save ; no, so get this entry that is ; not to be deleted tlne p3,777777 ; is this entry a user number ? ; yes, so ... call [hrrz t1,jfndir(q1) ; get destination designator move t2,p3 ; get user number DIRST ; output user number to ; file call [ hrroi t1,[asciz/An error has occurred during deletion. Please check contents of mailing list/] psout ret] ret] tlnn p3,777777 ; is this entry a user number ? ; no, so ... call [hrrz t1,jfndir(q1) ; get destination designator hrroi t2,@p3 ; byte pointer to asciz string ; to be written setz t3, setz t4, SOUT ret] ; yes addi p4,1 ; no, so increment the index into ; this mailing list in dirnos camg p4,q3save ; have all of the entries in this ; mailing list been processed ? jrst [caml p4,q3save ; are we about to "process" the ; last entry in the mailing ; list ? jrst [%skpOff renopt ; if this is a RENAME ; then go be sure to ; output all the ; entries in the ; mailing list jrst %4f %skpOn dodel ; has the entry already ; been deleted ? jrst %3f ; no, so don't output ; a and close ; the file jrst %4f] ; yes, so continue %4 move t4,t4save ; get the address of the ; header word in dirnos ; for this mailing list movem t4,p4save ; restore this address hrrz t1,jfndir(q1) ; get destination designator movei t2,"," ; output a comma BOUT movei t2," " ; output a space BOUT jrst %9b] ; and go try the next ; entry in this mailing ; list jrst %3f] ; now, close the file and update ; the data base %trnOn dodel ; set flag to indicate that the ; appropriate entry has been ; deleted from the mailing list addi p4,1 ; yes, so increment the index into ; this mailing list in dirnos camg p4,q3save ; have all of the entries in this ; mailing list been processed ? jrst [move t4,t4save ; get the address of the header ; word (in dirnos) for this ; mailing list movem t4,p4save ; restore this address jrst %9b] ; and go try the next entry in ; this mailing list %3 hrrz t1,jfndir(q1) ; get destination designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT hrrz t1,jfndir(q1) ; get the jfn CLOSF jrst .+1 %skpOn delopt ; is the DELETE option ; being invoked ? ret ; no, so return ; update the data base ; --> q1save contains the offset ; of the header word (in dirnos) ; of this mailing list move t1,q1save ; set up offsets of successive ; entries in this mailing list ; for the purpose of shifting move t2,t1 ; entries to remove the deleted addi t2,1 ; entry move q1,t1 ; save these offsets move t4,t2 ; %1 camle t1,q3save ; have all of the entries been ; tested ? jrst [setz t3, ; yes, so zero out the word ; left vacant by the shift of ; entries move t1,q3save ; get the count of the number ; of entries in this mailing ; list prior to the deletion addi t1,@t4save ; add in the address of the ; header word (in dirnos) to ; the offsets movem t3,@t1 ; left vacant by the shift of jrst %3f] ; entries %2 addi t1,@t4save ; add the address of the header ; word (in dirnos) to the offsets addi t2,@t4save ; move t3,@t2 ; shift the rest of the entries ; of this mailing list to remove ; the user-input user to be deleted ; from the data base movem t3,@t1 ; addi q1,1 ; increment offsets addi t4,1 ; move t1,q1 ; restore offsets move t2,t4 ; jrst %1b ; and go back %3 move q3,q3save ; get the count of entries in this ; mailing list movei t4,1 ; correct the number of entries in movem t4,q3save ; the header word (in dirnos) ; for this mailing list subm q3,q3save ; move q3,q3save ; get the corrected count of the ; number of entries in this ; mailing list hrlm q3,@t4save ; and restore this half of the ; header word (in dirnos) for ; this mailing list %trnOn delflg ; set flag to indicate that ; a user has been deleted from ; a mailing list dusrrt: ret SUBTTL DESCRIBE Command - Parse User Input ;[ti-11] The DESCRIBE command creates a file with the name: ;[ti-11] MLIST-DOC:{mailing-list-name} .dscrb: %cmnoi ;[ti-38] %pret %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] %pret push p,t2 move t1,[point 7,dirstg] ; byte pointer to storage area ; to which the contents of the ; atom buffer will be transferred hrroi t2,[asciz/MLIST-DOC:/] setzb t3,t4 SOUT pop p,t2 hlro t2,(t2) setzb t3,t4 SOUT setz t2, BOUT ; tie off the string %cmcfm %pret movei t1,$dscrb ;[ti-38] movem t1,addcod ;[ti-38] retskp SUBTTL DESCRIBE Command - Processing $dscrb: call redcat ret retskp SUBTTL REDCAT - Read Catalogued Information comment \ REDCAT This routine reads new description information for the specified mailing list. \ RedCat: hrroi t1,dcrprt PSOUT hrroi t1,ctgtxt ; destination designator move t2,[rd%brk!^d400] ; maximum of 400 characters hrroi t3,dcrprt ; re-prompting text RDTTY %jsErr < ? Error reading description...aborting...>, catret setz t2, dpb t2,t1 ; get rid of the break character move t1,[gj%sht!gj%fou] hrroi t2,dirstg GTJFN jrst [ hrroi t1,[asciz/ ? Couldn't create file to save your description/] PSOUT ret ] movem t1,dcrjfn ; save jfn move t2,[7b5!of%rd!of%wr] OPENF jrst [ hrroi t1,[asciz/ ? Couldn't open file to save your description/] PSOUT move t1,dcrjfn RLJFN jfcl ret ] move t1,dcrjfn hrroi t2,ctgtxt ; "file" the description setzb t3,t4 SOUT move t1,dcrjfn ; all done, so close the file CLOSF jfcl retskp ; +2 return if OK catret: ret ; +1 return if error SUBTTL RENAME Command - Parse User Input .renam: %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] %pret movem t2,t2save ; save the address of the ; keyword table where the ; keyword was found %cmnoi %pret %comnd [flddb. (.CMTXT,cm%hpp+cm%sdh,,,,[ flddb. (.CMCFM,cm%hpp+cm%sdh,, )])] %pret hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncode ; save the function code hrrz q1,q2save ; get the beginning address ; of the last asciz string ; added to mmnams addi q1,1 ; increment this address %1 move q2,@q1 ; get this word caie q2,0 ; is this a null word ? jrst [addi q1,1 ; no, so try the next one jrst %1b] addi q1,1 ; leave a null word between ; asciz strings move t4,[point 7,dirstg] ; byte pointer to storage area ; where contents of atom ; buffer are to be ; transferred %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file %cmgab t4 move t3,fncode ; get the function code cain t3, .CMCFM ; only get one confirmation jrst rnmret %cmcfm ; get confirmation %pret rnmret: %cmRes ; reset the parsing information repeat 0,< ;[ti-13] skipe dirstg ;[ti-10] If the user attempted jrst [ hrroi t1,[asciz/ ? No mailing list names allowed/] ;[ti-10] PSOUT ;[ti-10] ret ] ;[ti-10] >;[ti-13] retskp SUBTTL RENAME Command - Processing $renam: %trnOn re ; set flag to indicate that a ; RENAME was invoked during ; this execution of MLIST ; (for LOG purposes only) %trnOn renopt ; set flag to indicate to a ; later portion of code that ; the RENAME option is being ; invoked move t1,[point 7,@q1] ; byte pointer to storage area ; where new mailing list will ; be constructed movei t3,0 ; initialize this register setz p3, ; zero out the counter of the ; number of bytes input as ; the new name of a mailing ; list %2 move p4,[point 7,dirstg] ; byte pointer to new name of ; existing mailing list %1 ildb t2,p4 ; get the next byte caie t2,0 ; is the byte a null ? jrst [cain t2,":" move t3,t2 ; save this byte for later addi p3,1 ; increment the count of the ; bytes in the new name for ; the mailing list jrst %1b] ; and continue cain p3,0 ; is there a new name for ; this mailing list ? jrst [setz q3, ; no addi q1,1 ; increment the address in ; mmnams jrst %1f] ; and continue move p4,t3 ; save the ":", if any hrroi t1,@q1 ; destination designator hrroi t2,dirstg ; source designator setz t3, setz t4, SOUT caie p4,":" ; did the new name already ; contain a ":" ? call [hrroi t2,[asciz/:/] ; no, so add one setz t3, setz t4, SOUT ret] %1 hrrm q1,q2save ; save the address of the last ; asciz string added to mmnams move t2,t2save ; get the address of the matched ; keyword movei t1,namtab ; get the beginning address of ; the keyword table movem t1,t2save ; save this address subm t2,t2save ; calculate the offset into ; the keyword table of the ; matching keyword move q1,t2save ; get this offset hrrz q2,namtab(q1) ; get the address of the header ; word (in dirnos) of the ; appropriate mailing list movem q2,t4save ; save this address hlrz t1,@q2 ; get the count of the number ; of entries in this mailing ; list movem t1,q3save ; and save this count hrrz t1,@q2 ; get the beginning address ; of the old name of this ; mailing list movem t1,p5save ; and save this address hrrz q3,q2save ; get the address of the new ; name of the mailing list hrrm q3,@q2 ; put the address of the ; new name (in mmnams) for ; this mailing list in the ; header word (in dirnos) ; for this mailing list cain p3,0 hrrm p3,@q2 ; if the new name is no ; name at all hrrzi t4,777777 ; initialize a save area ; to indicate that a DELETE ; is not to occur movem t4,q1save ; call rename tmsg< [Mailing list > move q1,t2save ; get the offset into namtab ; of the address of the file ; name for this mailing list hlro t2,namtab(q1) ; byte pointer to the file name move t1,[.priou] ; get destination designator setz t3, setz t4, SOUT tmsg< renamed from > move t2,p5save ; see if there was a previous ; name cain t2,0 ; jrst [hrroi t1,[asciz/ "" /] ;[ti-14] psout jrst %1f] move t1,[.priou] ; get destination designator hrro t2,p5save ; byte pointer to asciz string ; (old name of mailing list) ; to be written setz t3, setz t4, SOUT %1 tmsg< to > move t1,[.priou] ; get destination designator hrrz t2,q2save ;[ti-14] Get 1st part of string skipn (t2) ;[ti-14] (if any) jrst [ hrroi t1,[asciz/ "" /] ;[ti-14] PSOUT ;[ti-14] jrst %2f ] ;[ti-14] hrro t2,q2save ; byte pointer to asciz string ; (new name of mailing list) ; to be written setz t3, setz t4, SOUT %2 tmsg<]> ;[ti-14] (add label) %cmRes ; reset all parsing ; information %trnOn anymap ; set flag to indicate that ; process pages should be ; UNmapped instead of PMAPed ; to the file %cmRes ; reset the parsing information call LOG retskp subttl SHOW Command - Parse User Input .show: move t3,[sixbit/SETPRV/] ;[ti-32] call ckauth ;[ti-19] jrst .show1 ;[ti-19] %comnd [fldbk. (.CMKEY,cm%brk,shotb%,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[ flddb. (.CMCFM)])] %pret jrst .show2 .show1: %comnd [fldbk. (.CMKEY,cm%brk,shotbl,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[ flddb. (.CMCFM)])] %pret .show2: hrrz q3,@t2 ; get the dispatch address of ; the routine to perform in ; order to complete processing ; of the SHOW command hrrzm q3,shoadr ; save the address of the routine ; to complete processing this ; invocation of the SHOW command hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncode ; save the function code cain t3, .CMCFM ; was it a carriage return ? jrst shoret ; yes ;;;;;;; cain q3,$$all ;[ti-19] If "ALL" then just get jrst %9f ;[ti-19] confirmation cain q3,$$auth ;[ti-19] If "AUTHORIZED" then jrst %9f ;[ti-19] just get confirmation %1 caie q3,$$mlst ; was it the MAILING-LIST ; option ? jrst %2f %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] ; parse name of mailing list ; with altered break mask %pret hrrzm t2,t2save ; save the address of the ; table entry where the ; keyword was found jrst %9f ; get confirmation ;;;;;;; %2 caie q3,$mylst ; was it the MY-LISTS option ? jrst %3f %cmnoi ; noise for user name %pret %comnd [flddb. (.CMUSR,,,,,[ flddb. (.CMCFM)])] %pret hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncod1 ; save the function code caie t3, .CMUSR ; was it a user name ? call [GJINF ; get info pertaining to the ; current job move t2,t1 ; shift the user number that ; is returned to ac2 ret] ; here to handle a user name movem t2,iusrno ; save user number for input ; user name move t3,fncod1 ; get the function code cain t3,.CMCFM ; was it a confirmation ? jrst shoret ; yes, so use logged in user jrst %9f ; no, so get confirmation ;;;;;;; %3 caie q3,$$name ; was it the NAME option ? jrst %4f %cmnoi ; issue noise word %pret %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] ; parse name of mailing list ; with altered break mask %pret hrrzm t2,t2save ; save the address of the ; table entry where the ; keyword was found jrst %9f ; get confirmation ;;;;;;; %4 caie q3,$$usrs ; was it the USERS option ? jrst shoret %cmnoi ; issue noise word %pret %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[ flddb. (.CMCFM,cm%hpp+cm%sdh,,)])] ; parse name of mailing list ; with altered break mask %pret hrrzm t2,t2save ; save the address of the ; table entry where the ; keyword was found hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncod2 ; save the function code cain t3,.CMCFM ; was it a confirmation ? jrst shoret ; yes %9 %cmcfm %pret shoret: %cmRes ; reset the parsing information retskp SUBTTL SHOW Command - Processing $show: %trnOn s ; set flag to indicate that a ; SHOW was invoked during this ; this execution of MLIST ; (for LOG purposes only) move t3,fncode ; get function code last used ; by COMND jsys cain t3, .CMCFM ; was the SHOW command terminated ; with a carriage return ? call [movei t3,$$all ; yes, so default to showing movem t3,shoadr ; the file names of all the ret] ; mailing lists move t3,shoadr ; no, so call the appropriate ; routine call (t3) ; %cmRes ; reset all parsing information call LOG retskp SUBTTL Show All (mailing lists) $$all: %1 hllz q1,namtab ; get the count of the number ; of entries in the keyword ; table of file names for all ; of the mailing lists movem q1,q1save ; save this count movn q1,q1save ; negate this count in preparation ; of the indexing register hrri q1,1 ; set up the right half of the ; indexing register setz q2, %1 move t1,[.priou] ; get destination designator movei t2,40 ; output a space BOUT move t1,[.priou] ; get destination designator hlro t2,namtab(q1) ; get the address of the next ; file name for a mailing list movei t3,^d22 ; max of 22 (decimal) bytes ; to output movei t4,0 ; terminate on a null byte SOUT ; and output the file name to ; the terminal addi q2,1 ; increment number of mailing ; list file names per line cain q2,3 ; have 3 mailing list file names ; already been output on this ; line on the tty ? jrst [move t1,[.priou] ; yes, so get destination designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT jrst %2f] caie q2,3 ; have 3 mailing list file names ; already been output on this ; line on the tty ? call [move t1,[.priou] movei t2,11 BOUT cail t3,7 ; call [move t1,[.priou] movei t2,11 BOUT ret] cail t3,17 ; t3 still contains 22 (decimal) ; minus the number of bytes ; that were output by the last ; SOUT call [move t1,[.priou] ; get destination designator movei t2,11 ; output an extra horizontal ; tab because the last asciz ; string output was so short BOUT ; (i.e. to even up the columns) ret] cail t3,25 call [move t1,[.priou] movei t2,11 BOUT ret] ret] %2 cain q2,3 ; have 3 mailing list file names ; already been output on this ; line on the tty ? call [setz q2, ; yes, so re-initialize counter of ; mailing list names on this ; line on the tty ret] aobjn q1,%1b ; increment both the index and ; the control. Loop until all ; of the file names have been ; output to the terminal. %CRtype< [Mailing lists complete]> ret SUBTTL Show Authorized-Users ;[ti-19] $$auth: tmsg < The following users are MLIST-authorized users: > hlrz q3,pmttab ;get count of authorized users movn q3,q3 ;make it negative hrlz q3,q3 ;...and setup for looping hrri q3,1 ;[ti-25] Skip over "header" word tmsg < > ;[ti-25] loop: tmsg < > loop2: hlro t1,pmttab(q3) ;byte pointer to user string PSOUT tmsg < [> ;[ti-32] move t3,pmttab(q3) ;[ti-32] move t3,(t3) ;[ti-32] Get 6-bit priv string skipn t3 ;[ti-32] jrst [ tmsg< [no MLIST privileges] > ;[ti-32] jrst $$aut2 ] ;[ti-32] loop3: setz t2, ;[ti-32] lshc t2,6 ;[ti-32] skipe t2 ;[ti-32] jrst [ addi t2,40 ;[ti-32] make it 7-bit movei t1,.priou ;[ti-32] BOUT ;[ti-32] jrst loop3 ] ;[ti-32] tmsg <] > $$aut2: aobjn q3,loop ;loop if any more ret SUBTTL Show Mailing-List $$mlst: tmsg < Mailing list name: > ;[ti-13] hrrz q3,@t2save ; get the address of the ; header word (in dirnos) ; for this mailing list hrrz t2,@q3 ; get the beginning address ; of the (asciz string) ; mailing list name (in ; mmnams:) cain t2,0 ; does a name for the mailing ; list exist ? ;[ti-13] jrst $$shou ;[ti-10] no jrst %1f ;[ti-13] no ;[ti-13] tmsg< Mailing list name: > ;[ti-10] Do it here instead ;[ti-10] of at $$MLST: hrroi t1,@t2 ; get the address of the ; mailing list name which ; appears in the mailing list psout ; output this name %1 hrroi t1,[asciz/ /] psout $$shou: movei q3,namtab ; get the address of the keyword ; table which contains the ; file names of the mailing ; lists move t2,t2save ; get the address of the keyword ; table entry where the keyword ; was found movem q3,t2save ; store the address of the ; keyword table subm t2,t2save ; get the index into namtab ; of the matched keyword move q3,t2save ; get the index hrrz q2,namtab(q3) ; get the address of the header ; word of the appropriate ; mailing list in dirnos movem q2,t4save ; save this address movem q2,p4save ; hlrz q2,@t4save ; get the count of the number of ; entries in this mailing list movem q2,q3save ; save this number movei q1,1 ; set up the index to use into ; dirnos movei q2,1 ; set up the increment camle q1,q3save ; are there any entries in this ; mailing list jrst [tmsg< [Mailing list > ; no move t1,[.priou] ; get destination designator move q1,t2save ; get offset into namtab of the ; address of the file name for ; this mailing list hlro t2,namtab(q1) ; byte pointer to this file name setz t3, setz t4, SOUT tmsg< is empty]> jrst %3f] tmsg< Users: > movei p5,1 ; set up count of entries per line ; (when listing the contents on a ; mailing list) %1 addm q1,p4save ; set up the address to the next ; entry in the mailing list move q3,@p4save ; get the next entry in this ; mailing list tlne q3,111111 ; is this mailing list entry a ; user number ? jrst [move t1,[.priou] ; yes; get destination designator move t2,q3 ; get user number DIRST ; jrst .+1 jrst %2f] hrro t1,@p4save ; byte pointer to a file spec ; or an obsolete user psout %2 camge q1,q3save ; have all of the entries in ; this mailing list been ; output to the terminal ? jrst [caig p5,4 ; have 4 or more entries ; been output to this line ; on the terminal ? call [move t1,[.priou] ; no movei t2,"," ; output a comma BOUT movei t2,40 ; and a space BOUT ret] cail p5,4 ; have 4 or more entries ; been output to this line ; on the terminal ? call [move t1,[.priou] ; yes, so get destination ; designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT movei t2,11 ; output a horizontal tab BOUT setz p5, ; reset the count of the ; number of entries on this ; line ret] addi q1,1 ; increment the index into ; dirnos move q3,t4save ; restore the address of the ; header word (in dirnos) for ; this mailing list movem q3,p4save ; addi p5,1 ; increment count of the number ; of entries on this line jrst %1b] move t1,[.priou] ; get destination designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT tmsg< [Mailing list > move t1,[.priou] ; get destination designator move q1,t2save ; get the offset into namtab ; of the address of the file ; name for this mailing list hlro t2,namtab(q1) ; byte pointer to this file name setz t3, setz t4, SOUT tmsg< complete]> %3 ret SUBTTL Show Name $$name: hrrz q3,@t2save ; get the address of the header ; word (in dirnos) for this ; mailing list hrrz t2,@q3 ; get the beginning address ; of the (asciz string) ; mailing list name (in ; mmnams:) cain t2,0 ; does a name for the mailing ; list exist ? jrst [tmsg< ?There is no name for mailing list > move t1,[.priou] ; get destination designator hlro t2,@t2save ; byte pointer to the file name ; for this mailing list setz t3, setz t4, SOUT jrst %1f] ; no tmsg< Mailing list name: > hrroi t1,@t2 ; output the name of the ; mailing list which appears ; in the mailing list psout ; %1 ret SUBTTL Show Users $$usrs: move t1,fncod2 ; get the function code from SHOW caie t1,.CMCFM ; was it a confirmation ? jrst %2f ; no, so output users on only one list movei p4,1 ; setup for first mailing list %1 movei t1,namtab ; get beginning address of table add t1,p4 ; setup for first mailing list movem t1,t2save ; tmsg< > hlro t1,@t2save ; get byte pointer to file name PSOUT tmsg< > call $$shou addi p4,1 ; increment index tmsg< > hlrz p3,namtab ; get count of actual number of ; mailing lists in MLIST data base camg p4,p3 ; is that all of the mailing lists ? jrst %1b ; no, so get the next one jrst %3f %2 call $$shou ; output the users (entries) ; in this mailing list %3 ret subttl VERIFY Command - Parse User Input .vrify: %cmnoi ; issue noise word %pret %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[ flddb. (.CMCFM,cm%hpp+cm%sdh,,)])] %pret hrrzs t3 ; address of fdb actually used ldb t3, [pointr (.cmfnp(t3),cm%fnc)] ; get the function code ; from it movem t3,fncod1 ; save the function code movem t2,t2save ; save the actual address of the ; table entry where the ; keyword was found (not the ; offset into the tbluk table) cain t3,.CMCFM jrst vrfret %cmcfm %pret vrfret: %cmRes ; reset the parsing information retskp SUBTTL VERIFY Command - Processing $vrify: move t3,fncod1 cain t3,.CMCFM jrst [hlrz q3,namtab ; get count of the number ; of mailing lists in the ; database movem q3,cntsav ; save this count for testing movei q1,1 ; set up increment ; HERE IS WHERE TO GET JFN FROM JFNDIR movei t1,argtbl ; beginning address of the ; argument table hlro t2,namtab(q1) ; byte pointer to file spec GTJFN jrst %3f hrrm t1,jfndir(q1) ; save the jfn returned jrst %1f] %1 move t3,fncod1 cain t3,.CMKEY jrst [move q1,t2save ; get the address of the ; table entry where the ; keyword was found subi q1,namtab ; calculate the offset into ; the keyword table movei t1,argtbl ; beginning address of the ; argument block hlro t2,namtab(q1) ; byte pointer to file spec GTJFN jrst [ tmsg hlro t1,namtab(q1) psout jrst %2f] hrrm t1,jfndir(q1) ; save the jfn returned jrst vrfy0] vrfy0: %trnOff strflg ; no asterisk has been encountered yet %trnOff flag2 %trnOn fstnam ; the next mailing list name encountered ; will be the first one %trnOn gotnam ; assume that a name does exist in the ; mailing list %trnOn colflg ; assume that an actual name for a mailing ; list is not present until it is really ; accounted for %trnOff badusr ; reset flag to indicate that no ; invalid users have yet been found ; in this mailing list hrroi t1,[asciz/ Mailing list : /] psout hlro t1,namtab(q1) ; get byte pointer to file name from ; data base psout call vrfy1 %skpOn badusr call [tmsg< [OK] > ret] %2 move t3,fncod1 caie t3,.CMCFM retskp %skpOff badusr call [hrroi t1,[asciz/ /] psout ret] %3 addi q1,1 ; increment the increment camle q1,cntsav ; have all of the mailing lists been ; VERIFYed ? retskp ; yes, that's all of the mailing lists movei t1,argtbl ; beginning address of argument block hlro t2,namtab(q1) ; byte pointer to file spec GTJFN jrst %3b hrrm t1,jfndir(q1) ; save the jfn returned jrst vrfy0 vrfy1: %trnOff anyusr ; reset flag to indicate that no "users" ; have yet been found in this mailing ; list hrrz t1,jfndir(q1) ; get jfn move t2,[<7b5>+of%rd+of%wr+of%awt] ; 7 bit bytes, read ; and write access OPENF jrst retvrf vrfy2: clrbuf Buffr4, Dstlen*2 ;[ti-18] move t4,[point 7,buffr4] ; set up byte pointer to work area %trnOff gotusr ; vrfy3: hrrz t1,jfndir(q1) ; get jfn BIN ; input next byte from mailing list cain t2,011 ; is byte a horizontal tab ? jrst vrfy3 cain t2,012 ; is byte a line feed ? jrst vrfy3 cain t2,015 ; is byte a carriage return ? jrst vrfy3 cain t2,"*" ; is byte an asterisk ? jrst [%trnOn strflg ; set flags %trnOn flag2 ; %trnOff gotnam ; %trnOn gotusr ; idpb t2,t4 ; deposit asterisk in asciz string for ; a user name jrst vrfy3] cain t2," " ; is byte a blank ? jrst [%skpOff gotnam ; have you got a mailing list name jrst [idpb t2,t4 ; yes jrst vrfy3] jrst vrfy3 ; no, so go back whether or not you ; have a user (skipping over the blank) %trnOff gotnam ; reset flag movei q3,0 ; yes, so terminate the user string ; with a null idpb q3,t4 ; %trnOn anyusr ; on to indicate that at least one ; "user" has been found in the ; mailing list that has been parsed tmsg< found a blank> call chkusr ; check for valid user or file spec jrst vrfy2] ; then, go try to find another one cain t2,":" ; is byte a ":" ? jrst [%skpOn strflg ; has there already been an asterisk ? jrst [idpb t2,t4 ; deposit part of mailing list name movei q3,0 ; terminate the mailing list name with ; a null idpb q3,t4 %trnOff gotnam ; reset flag jrst vrfy2] ; go get some more idpb t2,t4 ; deposit colon %trnOff strflg ; re-initialize flag jrst vrfy3] ; go get some more cain t2,"," ; is byte a "," ? jrst [%skpOff gotusr jrst [movei q3,0 idpb q3,t4 ; terminate user name with a null %trnOn anyusr ; on to indicate that at least ; one "user" has been found in ; this mailing list call chkusr ; check for valid user or file spec jrst vrfy2] ; and go get it jrst vrfy2] ; ; here if byte is an alphanumeric character (either part of the ; name of the mailing list, or part of a user name ; caig t2,37 ; is byte a control character ? jrst [cain t2,0 ; yes, but is it a null byte ? jrst %1f ; yes jrst vrfy3] ; no, so continue %1 caie t2,0 ; is byte a null jrst [idpb t2,t4 ; no, so deposit the byte %trnOn gotusr ; reset flag jrst vrfy3] ; and go get the next byte %skpOff gotusr ; has a user been processed ; but no terminating character ; has occurred yet ? call [%trnOn anyusr ; on to indicate that at least ; one "user" has been found in ; this mailing list call chkusr ; check for valid user or file spec ret] ; string and get 36-bit directory ; number. Then add this entry to ; buffr1 and update the necessary ; pointers. hrrz t1,jfndir(q1) ; yes, so get the jfn CLOSF jrst .+1 retvrf: %trnOn colflg ; reset flag ret savreg: hrli t1,f hrri t1,regsav blt t1,regend ; save the current contents of the ; registers 'f' thru 'p5' ret rstreg: hrli t1,regsav hrri t1,f blt t1,p5 ; restore the original contents of ; the registers 'f' thru 'p5' ret $$delt: jfcl ; call savreg save the contents of registers call $delet nop call rstreg ; restore the contents of the ; registers hrrz t1,jfndir(q1) RLJFN jrst .+1 movei t1,argtbl ; get address of gtjfn arg block ; (get a new jfn because the old ; one was released when the ; DELETE was performed) hlro t2,namtab(q1) GTJFN jrst [ tmsg< ?Error in deletion - continue at your own risk> jrst %1f] hrrm t1,jfndir(q1) ; and save the new jfn for the ; rest of the VERIFY %trnOff anyusr ; reset flag hrrz t1,jfndir(q1) move t2,[<7b5>+of%rd+of%wr+of%awt] OPENF jrst .+1 %1 ret $gltch: call savreg call $what jrst [call rstreg jrst %1f] call rstreg retskp %1 ret $what: jfcl ; Prompt user confm: move t4, t1 ; Save ptr in case of "?" psout ; Output prompt hrroi t1, buf ; Get a line from luser move t2, [rd%rnd+bufsiz] setz t3, ; no C-R text rdtty trna tlnn t2, (rd%btm) ; Rubout or ^U past beginning? ret ; Yes, negative return move p3, [point 7,buf,6] ; Get first character ldb p3, p3 cain p3, "?" ; Be it a question prompt? jrst conhlp ; Yes, say something wise caie p3, 15 ; Be it ? ret ; No, drop on through to input buf retskp ; yes conhlp: hrroi t1, [asciz ' Carriage return means yes. Rubout or ^U , or anything else will mean no. '] psout move t1, t4 ; Restore smashed string pointer jrst confm chkusr: %trnOff gotnam ; reset this flag in case the first ; entry in the mailing list is a ; user instead of a mailing list ; name (there are occasions when ; a mailing list name contains ; blanks) move t4,[point 7,buffr4] ildb p4,t4 ; get the first byte of the user entry ; ( user name or file spec ) cain p4,"*" call [move t1,[gj%sht] move t2,t4 ; skip over "*" GTJFN jrst [ move t2,t1 ; transfer contents of ; ac1 hrroi t1,[asciz/ /] psout tmsg< > move t1,t4 psout cain t2,600117 ; are directory access ; privileges required ? call [tmsg< cannot be verified - directory access privileges required> ret] caie t2,600117 call [tmsg< does not exist > ret] %trnOn badusr hrroi t1,dirstg ; destination designator move t2,t4 ; source designator setz t3, setz t4, SOUT ; prepare for delete tmsg< Do you want to delete > hrroi t1,dirstg ; source designator psout tmsg< from > hlro t1,namtab(q1) ;source designator psout tmsg< ? > call $gltch ; get the user's answer jrst %1f ; no hrroi t4,dirstg ; yes, so continue preparing ; for delete movei t1,.CMFLD ; movem t1,fncode ; movei t1,namtab add t1,q1 movem t1,t2save ; save the address of the ; table entry where the ; matching keyword was ; found call $$delt ; yes, so do it jrst %1f] RLJFN ; ac1 still contains the jfn returned ; from the previous call jrst %1f %1 ret] caie p4,"*" call [move t1,[rc%par+rc%emo] ; the given string must be ; matched exactly hrroi t2,buffr4 ; get byte pointer to the ; user name string setz t3, RCUSR tlne t1,70000 ; test for any failure bits ; returned from RCDIR call [ ifn pobox,<;[ti-15] hrroi t1,orgnam ;[ti-8] check for malbox hrroi t2,buffr4 ;[ti-8] setzb t3,t4 ;[ti-8] SOUT ;[ti-8] setz t2, ;[ti-8] tie off the string BOUT ;[ti-8] call malbox ;[ti-8] is it a valid mailbox ? jrst %1f ;[ti-8] yes >;pobox [ti-8][ti-15] move t4,[point 7,buffr4] %2 ildb t3,t4 ; check to see if the user ; is a network address cain t3,"@" jrst %1f ; user IS a network address caie t3,0 ; is this the end of the string ? jrst %2b hrroi t1,[asciz/ /] psout tmsg< > hrroi t1,buffr4 psout tmsg< is an invalid user name > %trnOn badusr hrroi t1,dirstg ; destination designator hrroi t2,buffr4 ; source designator setz t3, setz t4, SOUT ; prepare for delete tmsg< Do you want to delete > hrroi t1,buffr4 ; source designator psout tmsg< from > hlro t1,namtab(q1) ;source designator psout tmsg< ? > call $gltch ; get the user's answer jrst %1f ; no ; hrroi t4,dirstg ; yes, so continue preparing ; for delete movei t1,.CMFLD ; movem t1,fncode ; movei t1,namtab add t1,q1 movem t1,t2save ; save the address of the ; table entry where the ; matching keyword was ; found call $$delt ; yes, so do it %1 ret] ret] ret ; ; FINISH* ; subttl WHAT Command - Parse User Input ;[ti-11] The WHAT command displays what the specified mailing list ;[ti-11] is for. .what4: %cmnoi %pret %comnd [fldbk. (.CMKEY,cm%brk,namtab,,,[ brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])] %pret push p,t2 move t1,[point 7,dirstg] ; byte pointer to storage area ; to which the contents of the ; atom buffer will be transferred hrroi t2,[asciz/MLIST-DOC:/] setzb t3,t4 SOUT pop p,t2 hlro t2,(t2) setzb t3,t4 SOUT setz t2, BOUT ; tie off the string %cmnoi %pret %cmcfm %pret retskp SUBTTL WHAT Command - Processing $what4: move t2,[point 7,dirstg] setz t3, ;don't output '[no help...' message call helprf skipe t3 ;if no description available, tell user jrst %1f hrroi t1,[asciz/ No description is available/] PSOUT %1 retskp subttl (M|X)mailbox ;[ti-28] .mmlbx: %cmnoi %pret %cmcfm %pret retskp $mmlbx: ifn mmlbx,< hrroi t2,[asciz/SYS:MMAILBOX.EXE/] > ifn xmlbx,< hrroi t2,[asciz/SYS:XMAILBOX.EXE/] > call runfil ;Run mailbox program retskp ; ; THIS PORTION OF THE PROGRAM SETS UP THE DATA BASE FOR CURRENT ; MAILING LISTS ; dtabas: %trnOff strflg ; no asterisk has been encountered yet %trnOff flag2 %trnOn fstnam ; the next mailing list name encountered ; will be the first one %trnOn gotnam ; assume that a name does exist in the ; mailing list %trnOn colflg ; assume that an actual name for a mailing ; list is not present until it is really ; accounted for setzm dirnos ; zero out buffer space ; hrli t1,dirnos ; hrri t1,dirnos+1 ; blt t1,dirnos+bklngh-1 ; movei q3,mmnams+1 ; get address of next asciz string ; to be added to mmnams movem q3,q1save ; save this address hrrm q3,q2save ; movei p4,dirnos ; get address of first header word ; in dirnos movem p4,p4save ; save this address movem p4,lsthdr ; movei t1,filnam+1 ; get address of next asciz string ; file name specification to be ; added to filnem hrlm t1,q2save ; save this address movei t1,argtbl ; get address of arg. table for gtjfn setz t2, ; file spec in table GTJFN ; long form jrst [ seto t1, ; unmap pages hrli t2,.fhslf ; get process handle on self hrri t2,DTAPAG ;[ti-9] begin with loc DTAPAG*1000 move t3,[pm%cnt] ; count of number of pages in ac3 hrri t3,pmpnum ; pmap pmpnum # of pages PMAP hrli t1,12 ; change word 12 of the fdb hrr t1,jfndb ; get the jfn of the associated file seto t2, ; change all of the bits in the word movei t3,tblock ; get the number of bytes in the file CHFDB move t1,jfndb ; get the jfn for the mailing list ; data base CLOSF ; and close the file jrst .+1 seto t1, ; close any open files CLOSF jrst .+1 seto t1, ; release all remaining jfns RLJFN jrst .+1 tmsg< Abnormal condition found. Please try again later> JSHLT] movem t1,jfnsav ; save jfn movei t4,64041 ; get the left half of the mask returned ; in ac1 after a long-form call of GTJFN ; using wild card file descriptors hrlm t4,jfnsav ; set the left half of the bit mask %1 call goagin call [move t1,jfnsav ; get the saved jfn with the wild card flags GNJFN retskp ; that's all of the mailing lists ret] jrst %1b RET ; this RET signifies the end of setting up ; the data base for current mailing lists SUBTTL Reparse Existing Mailing List goagin: hrroi t1,flspst ; get pointer to destination designator hrrz t2,jfnsav ; get jfn move t3,[1100,,1] ; output filnam, filtyp setz t4, JFNS setzm q1save ; initialize storage area to contain ; address of current header word in dirnos %trnOff strflg ; reset flag to indicate that no * has ; yet been encountered among the ; entries in the current mailing list %trnOn gotnam ; reset flag to indicate the ; assumption that a name does exist ; in the mailing list (assumed until ; disproved) call parsit ; now parse the mailing list for the name ; of the mailing list and the individual ; names included on the mailing list %skpOn dirmng ; output filenames ONLY when MLIST MUNGE ; command is invoked jrst nolst move t1,[.priou] ; get destination designator movei t2,15 ; output a carriage return BOUT movei t2,12 ; output a line feed BOUT movei t2," " ; output a space BOUT hrroi t1,flspst ; output the mailing list file name psout tmsg< [OK]> nolst: %trnOff fstnam ret ; parsit: %trnOff anynam ; reset flag to indicate that a name ; has not yet been found for the ; current mailing list %trnOff anyusr ; reset flag to indicate that no "users" ; have yet been found in this mailing ; list hrrz t1,jfnsav ; get jfn move t2,[7b5+of%rd+of%awt] ; 7 bit bytes, read access only OPENF jrst prsret parse1: move t4,[point 7,buffr4] ; set up byte pointer to work area %trnOff gotusr ; ; parse2: hrrz t1,jfnsav ; get jfn BIN ; input next byte from mailing list cain t2,011 ; is byte a horizontal tab ? jrst parse2 cain t2,012 ; is byte a line feed ? jrst parse2 cain t2,015 ; is byte a carriage return ? jrst parse2 ; cain t2,"*" ; is byte an asterisk ? jrst [%trnOn strflg ; set flags %trnOn flag2 ; %trnOff gotnam ; %trnOn gotusr ; idpb t2,t4 ; deposit asterisk in asciz string for ; a user name jrst parse2] ; cain t2," " ; is byte a blank ? jrst [%skpOff gotnam ; have you got a mailing list name jrst [idpb t2,t4 ; yes jrst parse2] jrst parse2 ; no, so go back whether or not you ; have a user (skipping over the blank) %trnOff gotnam ; reset flag movei q1,0 ; yes, so terminate the user string ; with a null idpb q1,t4 ; %trnOn anyusr ; on to indicate that at least one ; "user" has been found in the ; mailing list that has been parsed call bldusr ; and process the user string accordingly jrst parse1] ; then, go try to find another one ; cain t2,":" ; is byte a ":" ? jrst [%skpOn strflg ; has there already been an asterisk ? jrst [idpb t2,t4 ; deposit part of mailing list name movei q1,0 ; terminate the mailing list name with ; a null idpb q1,t4 %trnOff gotnam ; reset flag %trnOn anynam ; the current mailing list ; DOES have a mailing list ; name call bldnam ; Add this asciz string to mmnams: ; and update the pointer to it ; in dirnos: jrst parse1] ; go get some more idpb t2,t4 ; deposit colon %trnOff strflg ; re-initialize flag jrst parse2] ; go get some more ; cain t2,"," ; is byte a "," ? jrst [%skpOff gotusr jrst [movei q1,0 idpb q1,t4 ; terminate user name with a null %trnOn anyusr ; on to indicate that at least ; one "user" has been found in ; this mailing list call bldusr ; construct structure/directory ; string and get 36-bit directory ; number. Then add this entry to ; buffr1 and update the necessary ; pointers. jrst parse1] ; and go get it jrst parse1] ; ; here if byte is an alphanumeric character (either part of the ; name of the mailing list, or part of a user name ; caig t2,37 ; is byte a control character ? jrst [cain t2,0 ; yes, but is it a null byte ? jrst %1f ; yes jrst parse2] ; no, so continue %1 caie t2,0 ; is byte a null jrst [idpb t2,t4 ; no, so deposit the byte %trnOn gotusr ; reset flag jrst parse2] ; and go get the next byte %skpOff gotusr ; has a user been processed ; but no terminating character ; has occurred yet ? call [idpb t2,t4 ; no, so deposit the byte %trnOn anyusr ; on to indicate that at least ; one "user" has been found in ; this mailing list call bldusr ; construct structure/directory ret] ; string and get 36-bit directory ; number. Then add this entry to ; buffr1 and update the necessary ; pointers. hrrz t1,jfnsav ; yes, so get the jfn hrli t1,400000 ; BUT DONT release the jfn !!! CLOSF jrst .+1 call getjfn ; release wild card jfn and ; get unique jfn prsret: %trnOn colflg ; reset flag ret bldnam: %trnoff colflg %skpOn fstnam call [move p4,p4save ; get address of previous header ; word in dirnos addi p4,maxusr ; set up this address for the next ; header word in dirnos movem p4,p4save ; and save this address movem p4,lsthdr ; hrrz q1,q2save ; get address of last asciz string ; added to mmnams %1 move t2,@q1 move t3,t2 caie t3,0 ; find next available address in ; which to store an asciz string jrst [addi q1,1 jrst %1b] addi q1,1 ; leave a null word between each ; asciz string for the purpose of ; delimiting the strings hrrm q1,q2save ; and save this address movem q1,q1save ret] hrrz q1,q2save ; get address of last asciz ; string added to mmnams movem q1,q1save ; save this address again as the ; beginning address of the last ; name of a mailing list added ; to mmnams hrroi t1,@q1 ; get destination designator hrroi t2,buffr4 ; byte pointer to string to be ; written setz t3, ; terminate output on a null setz t4, SOUT hrrz q1,q2save ; get beginning address of last ; asciz string added to mmnams move p4,p4save ; get address of current header ; word in dirnos hrrm q1,@p4 ; store pointer to asciz string ; in the current header word in ; dirnos bldnm1: %skpOff fstnam call [hrroi t1,filnam+1 ; get byte pointer to the address ; at which to begin storing the ; file names of mailing lists movem t1,fladdr ; save this byte pointer hrlm t1,q2save ; save only the address setzm jfndir ; initialize word 0 of this ; keyword table ret] %skpOn fstnam call [hrrz q1,fladdr ; get last address at which a file ; name was stored %1 move q2,@q1 ; get contents of that word caie q2,0 ; is it a null jrst [addi q1,1 ; no, so try the next word jrst %1b] addi q1,1 ; yes, so hrroi t1,@q1 ; set up a byte pointer to this address movem t1,fladdr ; and save it hrlm t1,q2save ; save only the address ret] move t1,fladdr ; get pointer to storage area for ; JFNS hrrz t2,jfnsav ; get right half of wild card jfn move t3,[1100,,1] ; output file name and file type setz t4, JFNS move t2,fladdr ; get byte pointer to asciz string ; file specification hrrzi t1,argtbl ; long form; file must exist GTJFN ; long form call [move t1,jfnsav ; this occurs if the mailing ; list is being CREATEd ; instead of being MUNGEd ret] hrrzm t1,tmpjfn ; store unique jfn MOVEI P1,1 ; INCREMENT COUNTER OF NUMBER ; OF MAILING LISTS CURRENTLY ; MAINTAINED IN THE MAILING ; LIST DATA BASE ADDM P1,JFNDIR ; movei t1,jfndir ; get address of the header ; word (word 0) of this ; keyword table hrl t2,fladdr ; get the address of the ; beginning of the file ; name for this mailing ; list hrr t2,tmpjfn ; get unique jfn TBADD erjmp .+1 ret bldusr: %skpOff colflg ; here when the mailing list ; to be parsed does not ; contain an actual mailing ; list name call [ move p4,p4save ; get the address of the last ; header word added to dirnos addi p4,maxusr ; update the address to that ; of the next header word to ; be added movem p4,p4save ; and save this address movem p4,lsthdr ; %trnOff colflg ; reset flags %trnOff gotnam ; call bldnm1 ret] %skpOff flag2 ; here when the "user" that is ; being parsed is either a file ; specification preceded by an ; asterisk, or an obsolete user ; for which a user number no ; longer exists jrst [hrrz q1,q2save ; get address of the last string ; added to mmnams %1 move t2,@q1 move t3,t2 caie t3,0 ; find the next available address ; in which to begin storing an ; asciz string jrst [addi q1,1 jrst %1b] addi q1,1 ; leave a null word between strings ; for the purpose of delimiting the ; strings hrrm q1,q2save ; and save this address hrrz q1,q2save ; get beginning address of ; area to store the next ; asciz string hrroi t1,@q1 ; get destination designator hrroi t2,buffr4 ; get beginning address of ; asciz string setz t3, setz t4, SOUT move p4,p4save ; get address of header word ; of current mm list in dirnos move p1,@p4 add p1,[1,,0] ; increment count of entries in ; this particular mm list hllm p1,@p4 hrrz t3,q2save ; get address of asciz name of ; mm list in mmnams hlrz p1,@p4 move p2,p4 add p2,p1 movem t3,@p2 jrst next1] next: move t1,[rc%par+rc%emo] ; the given string must be ; matched exactly hrroi t2,buffr4 ; get byte pointer to the ; user name string setz t3, RCUSR erjmp nexer1 ;[ti-35] tlne t1,70000 ; test for any failure bits ; returned from RCDIR jrst nexer1 ;[ti-35] repeat 0,< ;[ti-35] erjmp [ hrroi t1,[asciz/ ? Couldn't parse /] ;[ti-34] PSOUT ;[ti-34] hrroi t1,buffr4 ;[ti-34] PSOUT ;[ti-34] hrroi t1,[asciz/ /] ;[ti-34] jrst direrr ] ;[ti-34] >;repeat 0 ;[ti-35] move t1,[.nulio] ; get destination designator move t2,t3 ; get 36-bit user number DIRST nexer1: ;[ti-35] (label only) call [ %skpOn fstnam ; here when no user ; name corresponds to ; given user number call [hrrz q1,q2save ; get the address of the ; last asciz string added ; to mmnams %1 move t3,@q1 ; get the contents of that ; word caie t3,0 ; is it a null jrst [addi q1,1 ; no, so try the next word jrst %1b] addi q1,1 ; set up the next address ; for adding the next ; asciz string to mmnams hrrm q1,q2save ; and save this address ret] call [hrrz q1,q2save ; get the address where the ; next asciz string is to ; be added to mmnams hrroi t1,@q1 ; get byte pointer to this ; address hrroi t2,buffr4 ; get destination designator setz t3, setz t4, SOUT ; store the user name (asciz ; string) in mmnams hrrz t3,q2save ; put the beginning address ; of this asciz string in ; another register for ; updating namtab ret] ret] move p4,p4save ; get the address of the header ; word for the current mm list move p1,@p4 ; get the header word add p1,[1,,0] ; update the count of the number ; of entries in the header word movem p1,@p4 ; store the header word hlrz p1,@p4 ; get the count of the number of ; entries move p2,p4 add p2,p1 ; set up the index movem t3,@p2 ; store the new entry in dirnos next1: %trnOff flag2 direrr: ret getjfn: %skpOn anyusr ; are there any users in this ; mailing list ? call [%skpOn anynam ; here when an empty mailing ; list is parsed (i.e. no name ; and no entries are present ; in the mailing list itself ) call [move p4,p4save ; get the address of the last ; header word added to dirnos addi p4,maxusr ; update the address to that ; of the next header word to ; be added movem p4,p4save ; and save this address movem p4,lsthdr ; %trnOff colflg ; reset flags %trnOff gotnam ; call bldnm1 ; add appropriate entry to ; jfndir command table ret] ret] %skpOff fstnam call [movei t1,1 ; initialize the 'header word' - ; actual # of entries,,max # of ; entries movem t1,namtab ; ret] ; %skpOn fstnam call [movei q2,1 ; increment the 'possible' ; number of entries in this ; tbluk table addm q2,namtab ; restore the 'header word' ret] movei t1,namtab ; get the address of word 0 ; (header word) of the ; tbluk table hrl t2,fladdr ; get the beginning address ; of the asciz string file ; name for this mailing list hrr t2,p4save ; merge in the pointer ; to the header word for the ; appropriate mm list in ; dirnos TBADD ercal [hrroi t1,[asciz/ ?This mailing list already exists in data base. Duplicate not allowed./] psout ret] ret ifn pobox,<;[ti-15] ;;;[ti-7] MALBOX is a routine which checks to see if the specified ;;; string in ORGNAM: is a mailbox ;;; ;;; +2 ret == Either 'no such mailbox' or some failure ;;; +1 ret == Valid mailbox ;Calling sequence for MLFWRD malbox: hrroi t1,orgnam ;Get byte pointer to name to translate CALL MLFWRD ;Look up forwarding address JRST [ hrroi t1,[ASCIZ/Forwarding program failure /] jrst SNDLCX ] ;Program bombed JRST [ hrroi t1,[ASCIZ/Error from forwarding program /] jrst SNDLCX ] ;Error from program JRST [ hrroi t1,[ASCIZ/No such mailbox /] jrst SNDLCX ] ;No such mailbox JRST [ hrroi t1,[ASCIZ/Address valid, but no mailbox /] jrst SNDLCX ] ;Valid local address hrroi t1,[asciz/ Requeued for further forwarding /] ; PSOUT call fwdrcp call clrmlf ; clear up after X!Mmailbox inferior fork ret sndlcx: ; PSOUT retskp >;pobox [ti-8][ti-15] SUBTTL Run MAILBOX Program ifn pobox,<;[ti-15] ; Routine to run mailbox program to lookup forwarding address or mailing list ; ; For XMAILBOX.SAV: ; Entry: t1 = ptr to user name ; Call: CALL MLFWRD ; Return: +1, program bombed ; +2, program gave error message ; +3, No such mailbox for this address ; +4, valid address without forwarding ; +5, forwarding found MLFWRD: PUSH P,T1 ; Save calling args PUSH P,T2 SKIPE MBXFK ; Fork already existing? JRST MLFWR1 ; Yes MOVSI T1,(GJ%OLD!GJ%SHT) ; Get JFN of forwarder ifn xmlbx,< HRROI T2,[ASCIZ /SYS:XMAILBOX.EXE/] >;[ti-15] ifn mmlbx,< HRROI T2,[ASCIZ /SYS:MMAILBOX.EXE/] >;[ti-15] GTJFN JRST MLFWRX ; Not there. hrrzm T1,mbxfkJ ; Save jfn MOVSI T1,(CR%CAP) ; Create an inferior fork CFORK JRST [ MOVEI T1,^D5000 ; Failed get fork, wait 5 sec DISMS MOVSI T1,(CR%CAP) CFORK JRST [ move T1,mbxfkJ ; Failed again, quit RLJFN ; Punt the JFN NOP ; Don't case JRST MLFWRX]; Return to caller JRST .+1] ; Got fork, go on. MOVEM T1,MBXFK ; Save fork handle RPCAP ; TOPS-20 will not let you do anything TLO T2,(SC%SUP) ; to a superior (ie IIC it) unless you TLO T3,(SC%SUP) ; have the cap to map it. EPCAP ; So enable that capability move T1,mbxfkJ ; Get back Jfn HRL T1,MBXFK ; a := fork handle,,JFN GET ; Get pgm into fork MLFWR1: HRLZ T1,MBXFK ; a := inferior fork,,page 0 DMOVE T2,[.FHSLF,, ; b := our fork,,shared page PM%RD!PM%WR!PM%CNT+2] PMAP MOVE T1,[POINT 7,TMPBUF+200] ; a := ptr to shared page (200) MOVE T2,-1(P) ; b := ptr to address user name CALL MOVST0 ; Copy string and terminating null MOVE T1,MBXFK ; a := fork handle again ifn xmlbx,< MOVEI T2,3 ; XMAILR entry >;[ti-15] ifn mmlbx,< MOVEI T2,4 ; MMAILR entry >;[ti-15] SFRKV WFORK ; Wait for it to halt ; Here we see how the MAILBOX pgm fared RFSTS ; Read status HLRZS T1 ; a := termination code CAIE T1,2 ; Normal HALTF? JRST [ CALL CLRMLF ; No, better clean it up JRST MLFWRX] ; And return AOS -2(P) ; At least skip return now SKIPGE T1,TMPBUF+177 ; Check success flag JRST MLFWRX ; Error from program AOS -2(P) JUMPE T1,MLFWRX ; No such mailbox AOS -2(P) CAILE T1,2 ; Valid local entry? AOS -2(P) ; No, found forwarding MLFWRX: POP P,T2 ; Recover ac's POP P,T1 RET >;pobox [ti-8][ti-15] ifn pobox,<;[ti-15] ; Routine to clear up the MAILBOX.SAV fork ; Entry: MBXFK = frk handle ; frk pg 0 possibly mapped to tmpbuf in our space CLRMLF: SKIPN MBXFK ; a := fork handle RET ; If none, nothing to do SETO T1, ; Unmap shared page DMOVE T2,[.FHSLF,, PM%CNT+2] PMAP HRRI T2, MOVE T3,[PM%CNT+2] PMAP SETOM WINPAG ; No window page MOVE T1,MBXFK ; a := fork handle KFORK ; Get rid of fork ERJMP .+1 SETZM MBXFK ; Show fork gone RET ; Return >;pobox [ti-8][ti-15] ifn pobox,<;[ti-15] ;;; Copy a string from the forwarding inferior ;;; T1/ output string ;;; T2/ address in inferior FWDCPY: PUSH P,T1 ;Save parameters PUSH P,T2 LSH T2,-<^D9> ;Get inferior page number CAMN T2,WINPAG ;Already cached? JRST FWDCP1 HRL T1,MBXFK HRR T1,T2 MOVE T2,[.FHSLF,,FWDWIN/1000] MOVE T3,[PM%CNT+PM%RD+PM%CPY+2] PMAP FWDCP1: POP P,T2 MOVEI T1,FWDWIN/1000 DPB T1,[POINT 9,T2,26] POP P,T1 JRST MOVST0 ;;; Make a new recipient block from forwarded address ;;; Q2/ host,,name ;;; Returns O/ standard recipient block FWDRCP: PUSH P,Q2 MOVE T1,[POINT 7,STRBUF] hrrz T2,tmpbuf+300 CALL FWDCPY ;Copy string from inferior HRROI T1,STRBUF CALL CPYSTR ;Get byte pointer and count HRLI T2,() POP P,Q2 HLRZ T2,tmpbuf+300 ;Get host address JUMPE T2,FWDRC1 ;Local MOVE T1,[POINT 7,HSTBUF] CALL FWDCPY ;Copy host name from inferior TLNN T1,760000 ; Filled to word boundary? JRST .+3 IDPB T4,T1 ; No, do another null JRST .-3 move T1,[point 7,strbf1] move T2,[point 7,strbuf] ;move user name call movst5 ; move T2,[point 7,[asciz/ at /]] ;move node "prefix" call movst5 ; move T2,[point 7,HSTBUF] ;and finally node name call movst2 ; BUT this time add terminating null FWDRC1: hrroi T1,strbf1 ; PSOUT RET >;pobox [ti-8][ti-15] ;;; ;;;Move string and terminating null ;;; T1) destination byte pointer ;;; T2) source byte pointer ;;; MOVST0: HRLI T2,() MOVST2: ILDB T4,T2 IDPB T4,T1 JUMPN T4,MOVST2 MOVST3: RET ;;; ;;;Same as MOVST0: thru MOVST3: above, except that terminating nulls ;;; don't get deposited ;;; movst4: hrli T2,() MOVST5: ILDB T4,T2 cain T4,0 ; if a null, don't deposit it jrst movst6 ; IDPB T4,T1 JUMPN T4,MOVST5 MOVST6: RET ;;; Make a copy of string in T1, return address in T2, count in T3 CPYSTR: PUSH P,T1 ;Save address HRLI T1,() SETZ T3, CPYST1: ILDB T4,T1 JUMPE T4,CPYST2 AOJA T3,CPYST1 CPYST2: MOVEI T1,5(T3) ;Account for null and round wd cnt up IDIVI T1,5 HRL T2,(P) HRRZM T2,(P) ADDI T1,(T2) BLT T2,-1(T1) POP P,T2 RET Subttl Runfil - Run a Program ;Runfil: Called with byte pointer to file (program) to run in AC2 ; ;Runfil will run the program "ephemerally" (i.e., the fork will be ; disposed of after its execution finishes) RUNFIL: MOVSI T1,(GJ%OLD!GJ%SHT) GTJFN JRST [ HRROI T1,[ASCIZ " ? Couldn't find file to run"] PSOUT RET ] PUSH P,T1 ;Save the JFN MOVSI T1,(CR%CAP) ;Yes, give it our caps CFORK JRST [ HRROI T1,[ASCIZ " ? Couldn't create fork"] PSOUT POP P,T1 ;Release the jfn too RLJFN JFCL RET ] SETO T2, ;All priv's possible SETZ T3, ;But none enabled EPCAP ;At least give him possibles EXCH T1,(P) ;Get back JFN HRL T1,(P) ; HLRZM T1,frkhan ;Save fork handle GET POP P,T1 ;Get back fork handle SETZ T2, SFRKV ;At regular startup point WFORK KFORK MOVE T1,PRGNAM ;Restore names MOVE T2,PRGNAM ;Restore names SETSN JFCL RET Subttl Tbluk Table Initialization ;;;Init Mlist Mungers Table ; ; Returns +2 on success ; %tbini: movei t1,pmttab movem t1,pmtptr ; setup pointer movei t1,1000 movem t1,pmttab ; set up word 0 of TBLUK table movei q2,pmtnam ; set up byte pointer for reading ; from PS:Mlist.Mungers movei q1,acctn MOVSI t1,(GJ%OLD!GJ%SHT) HRROI t2,mngfil ;[ti-30] GTJFN jrst PMTABT ;Can't get mungers table, done MOVE t2,[7B5+OF%RD] OPENF jrst [ hrroi t1,[asciz/Can't open MUNGERS list/] psout seto t1, closf jfcl jrst pmtabt ] MOVEM t1,PMTJFN ;Save it away PMTID1: MOVE t1,PMTJFN HRROI t2,(q2) ;Where to start string MOVEI t3,Pmtnam+100-1 ;End of munger area SUBI t3,(q2) IMULI t3,5 ;Amount of room left MOVEI t4,.CHLFD ;Until end of line SIN ERJMP PMTID2 ;Must be eof JUMPE t3,[ hrroi t1,[asciz/MUNGERS table buffer exhausted/] psout seto t1, closf jfcl jrst pmtabt ] ADD t2,[7B5] SKIPGE t2 SUB t2,[43B5+1] ;Back up byte pointer MOVEI t4,0 DPB t4,t2 ;Replace CR with null HRROI t2,1(t2) EXCH t2,q2 ;Update free pointer ;;;Scan this string to see if comment or synonym PUSH P,t2 HRLI t2,() ;Make byte pointer ILDB t1,t2 CAIE t1,.CHTAB ;Leading whitespace loses entirely, CAIN t1,.CHSPC ; but treat as comment to avoid JRST PMTID1 ; utter lossage CAIA PMTID4: ILDB t1,t2 ;Get a character from the line CAIE t1,.CHTAB ;Ignore whitespace if present CAIN t1,.CHSPC JRST PMTID4 CAIN t1,"," ;Routing list? JRST PMTID6 CAIE t1,"!" ;Comment? CAIN t1,";" JRST PMTID6 ;Yes, end the line here CAIN t1,"=" ;Synonym? JRST [ SETZ t1, ;Yes, end this string DPB t1,t2 HRROI q2,1(t2) ;Update free pointer MOVEi t1,prvtab ;[ti-32] Is string in table? TBLUK TLNE t2,(TL%NOM!TL%AMB) ;No good? JRST [ ADJSP P,-1 ;Fix up stack context JRST PMTID2] POP P,t2 ;Restore start pointer MOVSI t2,(t2) HRR t2,(t1) ;Get data for real name MOVE t1,PMTPTR ;TBADD table address JRST PMTID5] JUMPN t1,PMTID4 ;Character okay, try next PMTID3: POP P,t2 HRLI t2,() ;See if the line had anything at all ILDB t1,t2 JUMPE t1,PMTID1 ;Whitespace or comment line, flush HRROS t2 ;Mark ACCOUNT MOVEM t2,(q1) ;Save number MOVE t1,PMTPTR MOVSI t2,(t2) ;[ti-32] HRRI t2,(q1) hllz t2,t2 ;[ti-32] No privs PMTID5: TBADD ERJMP .+1 ;In case an ARPANET name too CAIL q1,ACCTN+1777 jrst [ hrroi t1,[asciz/Host number buffer exhausted/] psout seto t1, closf jfcl jrst pmtabt ] AOJA q1,PMTID1 PMTID6: SETZ t1, DPB t1,t2 JRST PMTID3 ;And continue processing PMTID2: MOVE t1,PMTJFN CLOSF jfcl SETOM PMTJFN PMTINE: MOVE t1,PMTPTR ;Return pointer to things RETSKP ;Done PMTABT: RET ;Failure return Subttl Newlog - Create a new version of a file ;;; ;;; NEWLOG is a routine which will create a new version of ;;; the file name a byte pointer to which is in AC2. Ret +1 ;;; with a jfn in AC1 (or 0 if open couldn't be done). ;;; ;;; If NEWLGO is called instead, close the file whose jfn is ;;; in AC1, then continue with NEWLOG (as described above). ;;; NEWLGO: stkvar movem t1,jfntmp skipn t1 ; If no jfn in ac1 continue jrst newlg2 ; quietly.... CLOSF ; Out with the OLD.... jrst [ move t1,jfntmp RLJFN jfcl jrst newlg2 ] NEWLOG: stkvar NEWLG2: move t1,[gj%sht+gj%fou] ; ...in with the NEW GTJFN jrst [ hrroi t1,[asciz/? Couldn't create new version of file/] PSOUT setz t1, ;Indicate NO new log created ret ] movem t1,jfntmp move t2,[7B5+of%app] OPENF jrst [ hrroi t1,[asciz/? Couldn't open new version of file /] PSOUT movei t1,.priou move t2,jfntmp move t3,[111110,,1] JFNS hrroi t1,[asciz/ /] PSOUT move t1,jfntmp RLJFN jfcl setz t1, ; Indicate NO new log created ret ] ret end ; - EMACS editing modes - ; local modes: ; mode:Macro ; comment start:; ; comment rounding:+1 ; end: