Trailing-Edge
-
PDP-10 Archives
-
decuslib20-11
-
decus/20-192/mlist.mac
There are no other files named mlist.mac in the archive.
;[CSC60]HOWDY:<FORDYCE.WORK>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:<FORDYCE.WORK>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:<FORDYCE.WORK>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:<FORDYCE.WORK>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:<FORDYCE.WORK>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:<FORDYCE.WORK>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:<FORDYCE.WORK>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
;<FORDYCE.WORK>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.
;<FORDYCE.WORK>MLIST.MAC.89, 15-Nov-84 10:16:37, Edit by FORDYCE
;[ti-30] Save updated list of authorized mungers
; 7(15)
;<FORDYCE.WORK>MLIST.MAC.84, 15-Nov-84 08:27:57, Edit by FORDYCE
;[ti-29] Clean up AUTHORIZE command
;<FORDYCE.WORK>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
;<FORDYCE.WORK>MLIST.MAC.82, 14-Nov-84 10:11:24, Edit by FORDYCE
;[ti-27] Add check for "full" PMTTAB:
;<FORDYCE.WORK>MLIST.MAC.81, 13-Nov-84 23:29:01, Edit by FORDYCE
;[ti-26] Correct setup for "new" mungers (in INIT:)
; <FORDYCE.WORK>MLIST.MAC.78, 13-Nov-84 14:40:37, Edit by FORDYCE
;[ti-25] Clean up $$AUTH
;<FORDYCE.WORK>MLIST.MAC.77, 13-Nov-84 13:41:17, Edit by FORDYCE
;[ti-24] Fix problem with $BUILD routine clobbering flag word
; 7(13)
;<FORDYCE.WORK>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)
;<FORDYCE.WORK>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
;<FORDYCE.WORK>M20.MAC.3, 24-Oct-84 12:52:21, Edit by FORDYCE
;[ti-21] Make HELP20 support assembly time switched (H20SW==1)
; 7(10)
; <FORDYCE.WORK>MLIST.MAC.66, 20-Sep-84 15:54:21, Edit by FORDYCE
; [ti-20] Add HELP20 support
;<FORDYCE.WORK>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
;<FORDYCE.WORK>MLIST.MAC.59, 15-Aug-84 17:24:29, Edit by FORDYCE
; [ti-18] Add CLRBUF macro, and make use of it
;<FORDYCE.WORK>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
;<FORDYCE.WORK>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.
;<FORDYCE.WORK>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
;<FORDYCE.WORK>MLIST.MAC.22, 8-Aug-84 15:38:21, Edit by FORDYCE
; [ti-14] Clean up "renamed from" message
;<FORDYCE.WORK>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)
;<FORDYCE.WORK>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.
;<FORDYCE.WORK>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
;<FORDYCE.WORK>MLIST.MAC.6, 1-Feb-84 22:39:45, Edit by FORDYCE
; Reason: [ti-10] Remove mailing list name support
; 7(3)
;<FORDYCE.SOURCES>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:<GOODIES>
;<FORDYCE>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)
;<FORDYCE.SOURCES>MLIST.MAC.11, 13-Jun-83 16:37:46, Edit by FORDYCE
; Reason: [ti-7] Add MALBOX code to check for mailboxes
; 7(0)
;<FORDYCE.SOURCES>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
;
;<FORDYCE.SOURCES>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
;
;<FORDYCE.SOURCES>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 <mailing list>' command.
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>MLIST.MAC, 24-Jun-82, Edit by FORDYCE
; REASON: [ti-1] To correct problem with re-entry address to JRST to
; 6(^d13)
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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:
;
;<FORDYCE.SOURCES>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
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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:<SYSTEM>DECNET-HOSTS.TXT containing DECNET node
; names does not exist, then proceed as normally, but don't
; try to parse a network address.
;
;<FORDYCE.SOURCES>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).
;
;<FORDYCE.SOURCES>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
;
;<FORDYCE.SOURCES>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
;
;<FORDYCE.SOURCES>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.
;
;<FORDYCE.SOURCES>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:
; ! % * . : < >
;
;<FORDYCE.SOURCES>MLIST.MAC, 25-Nov-80, Edit by FORDYCE
; REASON: To incorporate the move of the MLIST data base from
; 5(3) PS:<MAIL> to PS:<SUBSYS>
;
;<FORDYCE.SOURCES>MLIST.MAC, 24-Nov-80, Edit by FORDYCE
; REASON: To use TBLUK to validate user access to invoke MUNGE
; 5(2)
;
;<FORDYCE.SOURCES>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 <CRLF> 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
; [email protected]
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<xitflg,rscflg,strflg,flag2,fstnam,colflg,gotusr,gotnam,
anynam,anyusr,anylst,anymng,anydbs,anymap,dirmng,
delflg,delopt,renopt,a,c,d,h,m,re,s,match,dodel,badusr,badfil,
anyhst>
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
'<name>:'. (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:<SYSTEM>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,<pclexe==0>
ifn pclexe,<pclexe==1>
ifndef xport,<xport==0> ;[ti-3]
ifn xport,<xport==1> ;[ti-3]
ifndef xmlbx,<xmlbx==0> ;[ti-8] for XMAILBOX-specific code
ifn xmlbx,<xmlbx==1> ;[ti-8]
ifndef mmlbx,<mmlbx==1> ;[ti-15] for MMAILBOX-specific code
ifn mmlbx,<mmlbx==1> ;[ti-15]
ifndef pobox,<pobox==0> ;[ti-15] for X|Mmailbox (generic) code
ifn xmlbx,<pobox==1> ;[ti-15]
ifn mmlbx,<pobox==1> ;[ti-15]
ifndef mllog,<mllog==0>
ifn mllog,<mllog==1>
ifndef nwname,<nwname==0> ;[ti-16]
ifn nwname,<nwname==1> ;[ti-16]
ifndef h20sw,<h20sw==1> ;[ti-21] By default, use HELP20
ifn h20sw,<nwname==1> ;[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 <LENGTH>,<>,<PAGEN==PAGEN+1>
IFDIF <LENGTH>,<>,<PAGEN==PAGEN+LENGTH>
>;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=:<aldusr-dtapag-1>*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=<pmtpag-nampag>*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 <delete>,[sixbit/DELETE/]
%key <setprv>,[sixbit/SETPRV/]
%tbEnd
;Top-Level Command Table (for Non-Priv Users)
cmdtab: %table
%key <add>, [.add,,$add]
%key <create>, [.creat,,$creat]
%key <delete>, [.delet,,$delet]
%key <describe>, [.dscrb,,$dscrb] ;[ti-11]
%key <exit>, [.exit,,$exit]
%key <help>, [.help,,$help]
ifn mmlbx,<
%key <mmailbox>, [.mmlbx,,$mmlbx] ;[ti-28]
>
%key <purge>, [.purge,,$purge]
%key <rename>, [.renam,,$renam]
%key <show>, [.show,,$show]
%key <verify>, [.vrify,,$vrify]
%key <what>, [.what4,,$what4] ;[ti-11]
ifn xmlbx,<
%key <xmailbox>, [.mmlbx,,$mmlbx] ;[ti-28]
>
%tbEnd
;[ti-19] Top-Level Command Table (for Priv Users)
cmdta%: %table
%key <add>, [.add,,$add]
%key <authorize>,[.prmit,,$prmit]
%key <create>, [.creat,,$creat]
%key <delete>, [.delet,,$delet]
;[ti-38] %key <describe>, [.dscrb,,$dscrb] ;[ti-11]
%key <exit>, [.exit,,$exit]
%key <help>, [.help,,$help]
ifn mmlbx,<
%key <mmailbox>, [.mmlbx,,$mmlbx] ;[ti-28]
>
%key <munge>, [.munge,,$munge]
%key <purge>, [.purge,,$purge]
%key <rename>, [.renam,,$renam]
%key <revoke>, [.prvnt,,$prvnt]
%key <show>, [.show,,$show]
%key <verify>, [.vrify,,$vrify]
%key <what>, [.what4,,$what4] ;[ti-11]
ifn xmlbx,<
%key <xmailbox>, [.mmlbx,,$mmlbx] ;[ti-28]
>
%tbEnd
;Options for the PURGE command
prgtab: %table
%key <all mailing lists>
%tbEnd
;[ti-38] Options for the ADD command
addtab: %table
%key <description>, $dscrb
%tbEnd
;Options for the SHOW command (for Non-Priv Users)
shotbl: %table
%key <all>, $$all
%key <mailing-list>, $$mlst
%key <my-lists>, $mylst
;[ti-13] repeat 0,<
%key <name>, $$name
;[ti-13]>;[ti-10]
%key <users>, $$usrs
%tbEnd
;[ti-19] Options for the SHOW command (for Non-Priv Users)
shotb%: %table
%key <all>, $$all
%key <authorized-users>, $$auth
%key <mailing-list>, $$mlst
%key <my-lists>, $mylst
;[ti-13] repeat 0,<
%key <name>, $$name
;[ti-13]>;[ti-10]
%key <users>, $$usrs
%tbEnd
; Any time MLIST needs a YES/NO answer
YNtab: %table ;[ti-4]
%key <no>,0 ;[ti-4]
%key <yes>,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:<SYSTEM>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 <Unable to open data base. Please try again later.>,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 <Unable to open data base. Please try later.>, 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 (<<MLIST>>,,,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%,<Command,>)] ;[ti-19]
%merrep re$tar, repar$ ;[ti-19]
jrst repar2 ;[ti-19]
repar1: ;[ti-19] (label)
%comnd [flddb. (.CMKEY,,cmdtab,<Command,>)]
%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 <Unable to open data base. Please try later.>, 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<HOST TABLE>
%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 <Can't open DECNET host table>, 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<Host table buffer exhausted>
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<Host number buffer exhausted ???>
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<the specified user>
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<the specified user>
ret]
tmsg< complete]>
ret]
%8 %cmRes
ret ; go back to command level
SUBTTL EXIT Command
.exit: %cmnoi<from MLIST> ; 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 <jfntmp>
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<with MLIST> ; 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<FOR MLIST> ; 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<USER> ; issue noise word
%pret
%comnd [flddb. (.CMUSR)]
%pret
movem t2,iusrno ;[ti-29]
%cmnoi<TO HAVE> ;[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<MLIST privileges of> ;[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<FROM>
%pret
%comnd [flddb. (.CMCFM,cm%hpp+cm%sdh,,<CR to prompt me with my mailing lists>,,[
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,,<file specification>,,[
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,<point 7,[asciz/@/]>,<"@">,,[
fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
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,<point 7,[asciz/@/]>,<"@">)]
%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<TO>
%pret
%comnd [fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
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<Unable to add >
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<?This mailing list no longer exists.>
jrst addret
%1 tmsg<Unable to add >
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<NEW MAILING-LIST> ; 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,,<file name of new mailing list>)]
%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 <Esc> 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<Unable to create mailing list >
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 <mailing list>'
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,<mailing list,>,,[
brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[
flddb. (.CMUSR,,,,,[
flddb. (.CMIFI,cm%hpp+cm%sdh,,<file specification>,,[
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,,<file specification>,,[
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<FROM> ; issue noise word
%pret
%comnd [fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
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,<option,>,<yes>)] ;[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<Unable to delete mailing list >
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<Unable to delete mailing list >
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<Unable to delete mailing list >
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<Unable to delete mailing list >
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<Unable to delete mailing list >
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 <CRLF> 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 <for mailing list> ;[ti-38]
%pret
%comnd [fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
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,<mailing list,>,,[
brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)])]
%pret
movem t2,t2save ; save the address of the
; keyword table where the
; keyword was found
%cmnoi<TO BE>
%pret
%comnd [flddb. (.CMTXT,cm%hpp+cm%sdh,,<name of mailing list>,,[
flddb. (.CMCFM,cm%hpp+cm%sdh,,
<carriage return to remove name of mailing list>)])]
%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,<mailing list,>,,[
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 <FOR> ; 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<OF> ; issue noise word
%pret
%comnd [fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
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<ON> ; issue noise word
%pret
%comnd [fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[
flddb. (.CMCFM,cm%hpp+cm%sdh,,<CR for all mailing lists>)])]
; 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<MAILING-LIST> ; issue noise word
%pret
%comnd [fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
brmsk. (keyb0.,keyb1.,keyb2.,keyb3.,,<.>)],[
flddb. (.CMCFM,cm%hpp+cm%sdh,,<all mailing lists by confirming with a carriage return>)])]
%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<Unable to verify >
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 <cr>?
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 <is>
%pret
%comnd [fldbk. (.CMKEY,cm%brk,namtab,<mailing list,>,,[
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 <for>
%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 <check a mailbox>
%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 <SUBSYS>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,,<TMPBUF/1000> ; 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,,<TMPBUF/1000>
PM%CNT+2]
PMAP
HRRI T2,<FWDWIN/1000>
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,(<POINT 7,0>)
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,(<POINT 7,0>)
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,(<point 7,0>)
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,(<POINT 7,0>)
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:<SYSTEM>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,(<POINT 7,0>) ;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,(<POINT 7,0>) ;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 <jfntmp>
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 <jfntmp>
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 <evLen,,entVec>
; - EMACS editing modes -
; local modes:
; mode:Macro
; comment start:;
; comment rounding:+1
; end: