;USR1:MMAILR.MAC.479 31-Mar-86 FM+6D.11H.55M.56S., by BUDD ; Add SWTLOS for S/W tools lossage over DECnet ;USR1:MMAILR.MAC.476 28-Mar-86 FM+3D.21H.48M.33S., by BUDD ; INCREASE TCP TIMEOUTS FOR CYPRESS! ; HACKING WITH "|FOO" AS AN ADDRESS, PIPES ;USR1:MMAILR.MAC.414 29-Sep-85 FM+17H.40M.55S., by BUDD ; Mkae SPCLCL longer (was 1!!) ;USR1:MMAILR.MAC.422 27-Feb-85 FQ+22H.51M.12S., by BUDD ; Change local send headers to placate OZ REPLY ([Message from X@Y...]) ;USR1:MMAILR.MAC.421 14-Feb-85 LQ+3D.0H.21M.52S., by BUDD ; Chomp for even more lusing new VAX mailer. ;USR1:MMAILR.MAC.418 10-Feb-85 FM+5D.11H.8M.25S., by BUDD ; Look for LCLNCN also in TRNMGR ;USR1:MMAILR.MAC.413 1-Feb-85 FQ+4D.9H.53M.26S., by BUDD ; Make $PID never return error. ;USR1:MMAILR.MAC.407 16-Jan-85 LQ+3D.6H.2M.6S., by BUDD ; Added DCNSEG for DCNSND. Rest of the world uses MAXSEG. ;USR1:MMAILR.MAC.404 19-Dec-84 LQ+4D.20H.53M.29S., by BUDD ; Change SOUT to SOUTR in MSGOUT ;USR1:MMAILR.MAC.389 27-Nov-84 NM+4D.22H.25M.14S., by BUDD ; Merge changes into Stanford 5.3(386) ;USR1:MMAILR.MAC.385 15-Nov-84 FM+7D.1H.7M.56S., by BUDD ; Replace some ^D1000s with MAXSEG ;USR1:MMAILR.MAC.381 12-Nov-84 FM+4D.19H.10M.0S., by BUDD ; UNIX LF brain damage under $$BU, also SOUTR just before end of DATA ;USR1:MMAILR.MAC.378 11-Nov-84 FM+3D.16H.47M.23S., by BUDD ; BU change -- use object 254 for SMTP ;USR1:MMAILR.MAC.377 2-Nov-84 FQ+2D.4H.10M.8S., by BUDD ; Base version 5.3(372) Added OZ changes for FOO.BAR.-1, $PID ; and a few other cosmetic ones. TITLE MMailr -- System Mailer Daemon for MM Mailsystem SUBTTL Mike McMahon & Mark Crispin/MMcM/MRC/TCR/DT/DE/CLH/yduJ/GZ/SRA ;Version components MMLWHO==7 ;Who last edited MMAILR (0=developers) MMLVER==5 ;MMAILR's release version (matches monitor's) MMLMIN==4 ;MMAILR's minor version ;MMLEDT==^D408 ;MMAILR's edit version MMLEDT==^D410 ;[jsol] MMAILR's edit version SEARCH MACSYM,MONSYM ;System definitions SEARCH SNDDEF ;Definitions for terminal messages SALL ;Suppress macro expansions .DIRECTIVE FLBLST ;Sane listings for ASCIZ, etc. .TEXT "/NOINITIAL" ;Suppress loading of JOBDAT .TEXT "MMAILR/SAVE" ;Save as MMAILR.EXE .TEXT "/SYMSEG:PSECT:CODE" ;Put symbol table and patch area in CODE .REQUIRE HSTNAM ;Host name routines .REQUIRE WAKEUP ;MMailr wakeup routines - make LINK happy .REQUIRE SNDMSG ;Terminal message support .REQUIRE SYS:MACREL ;MACSYM support routines .REQUIRE RELAY ;RELAY code IFNDEF DECSEG,DECSEG==^D750 ;[PLB] DECNET SEG SIZ (AWFUL S/W TOOLS MAILER) IFNDEF MAXSEG,MAXSEG==^D1000 ;[PLB] MAX SEG SIZE FOR NON-DECNET IFNDEF $$OZ,$$OZ==1 ;[PLB] OZ CHANGES FOR HOLMES IFNDEF $$BU,$$BU==1 ;[PLB] BU CHANGES IFN $$BU,< .REQUIRE POPEN ;[PLB] GET PIPE OPEN ROUTINE EXTERN POPEN ;[PLB] GET ROUTINE > ;$$BU TCPTMO==^D120 ;[PLB] TCP DATA TIMEOUT (WAS 30.) TCPFIN==^D120 ;[PLB] TCP FIN TIMEOUT (WAS 60.) ; ******************************************************************* ; * * ; * MMailr is a multiple network mailer program for TOPS-20. Like * ; * most fine software, it is the result of several individuals' * ; * work. * ; * It was originally conceived as XMAILR about January 1980 by * ; * Mike McMahon (MIT Artificial Intelligence Lab) and jointly * ; * developed for TOPS-20 with Mark Crispin (Stanford Computer * ; * Science Dept.). * ; * The TENEX version of XMAILR was developed by Tom Rindfleisch * ; * (Stanford SUMEX Project) and Mike McMahon in January 1981. * ; * MMailr was developed from XMAILR version 524 for TCP/IP and * ; * SMTP by Mark Crispin in September 1982. Dan Tappan (BBN) * ; * assisted in the development and debugging of the new host name * ; * lookup technology, including eliminating the need for HOSTS2. * ; * David Eppstein (Stanford) wrote the interface into the send * ; * system, which in turn was written by Kirk Lougheed (Stanford) * ; * et. al. Charles Hedrick (Rutgers) wrote the new relaying code. * ; * Ken Rossman (Columbia) finished the DECnet support code. Mark * ; * Crispin wrote the HSTNAM module and SMTP support, specified the * ; * other modules, and generally had a hand in everything. * ; * * ; ******************************************************************* ; Routines invoked externally EXTERN $GTPRO,$GTNAM,$GTCAN,$GTLCL,$ADDOM,$RMREL EXTERN $GTHNS,$PUPNS,$CHSNS,$DECNS,$SPCNS EXTERN $PUPSN EXTERN $SEND,$WTRCP,$SSTAT EXTERN $GTRLY,$INRLY,DM%TRN,DM%RLY SUBTTL Conditional Assembly ; Following are assembly switches and functions IFNDEF DATORG, ;Data on page 1 IFNDEF CODORG, ;Code on page 10 IFNDEF PAGORG, ;Paged data on page 50 IFNDEF FREORG, ;Free storage starts at page 100 IFNDEF NTDAYS, ;Default sender status period, 1 day IFNDEF DEDAYS, ;Default dead letter period, 3 days IFNDEF MAXTMT, ;Max time for Daemon to transmit whole message IFNDEF MAXTMC, ;Max time for Daemon to transmit one copy IFNDEF MAXTMB, ;Max time to transmit 1000 chars IFNDEF INTRXM, ;Number of minutes between retransmit scans IFNDEF INTSCN, ;Number of minutes between file scans SUBTTL Definitions F==:0 ;Flags A=:1 ;JSYS/argument passing B=:2 ;... C=:3 ;... D=:4 ;... E=:5 T=:6 ;Scratch TT=:7 ;Ditto M=:10 ;Holds current message N=:11 ;Current host block when sending O=:12 ;Current recipient block "" X=:14 Y=:15 CX=:16 ;Used by MACREL ;P=:17 ;Stack pointer ; Character definitions .CHDQT==42 ;Double quote ; Local UUO's OPDEF UTYPE [1B8] OPDEF UETYPE [2B8] OPDEF UERR [3B8] ; Macros for initializing and disabling timer TMRTCK==^D5 ;Timer tick interval in seconds ; intvl = time-out interval in seconds ; retad = time-out error return address DEFINE TMOSET (INTVL,RETAD) < SETZM INTOK ;An interrupt here could be embarrassing MOVEM P,TIMRTP ;Save the stack ptr for return PUSH P,[PC%USR+RETAD] ;Set the return address POP P,TIMLOC PUSH P,[-] ;Set the time-out interval in ticks POP P,INTOK >;DEFINE TMOSET DEFINE TMOCLR < SETZM INTOK ;Turn off time-out counter SETZM TIMLOC ;And the return adr >;DEFINE TMOCLR ; The following print macros do output only if PRINTP is set DEFINE TYPE (X) < UTYPE [ASCIZ/X/] ;Just type string > DEFINE CTYPE (X) < UTYPE 10,[ASCIZ/X/] ;Do crlf and type string > DEFINE CITYPE (X) < UTYPE 1,[ASCIZ/X/] ;Conditional crlf and type string > DEFINE ETYPE (X) < UETYPE [ASCIZ/X/] ;Type string (fmt codes) > DEFINE CETYPE (X) < UETYPE 10,[ASCIZ/X/] ;Do crlf and type string (fmt codes) > DEFINE CIETYP (X) < UETYPE 1,[ASCIZ/X/] ;Conditional crlf and type str (fmt codes) > DEFINE DEFERR (X,Y) < DEFINE X (Z) < IFB , IFNB ,> OPDEF %'X [UERR Y,]> DEFERR WARN,0 DEFERR JWARN,4 DEFERR FATAL,10 DEFERR JFATAL,14 SUBTTL Flags ; Beware! Flags are local, not global. Consequently, they shouldn't be ;referenced outside of their defined context. Each return from a SAVACS ;context will restore the flags to their prior context. ; ; There are a number of other flags in various location, this page is only ;for the flags in F. ;;; Parser flags FP%FF== 1B0 ;Formfeed seen at start of line FP%CLN==1B1 ;Colon seen FP%EOL==1B2 ;Blank line (after any formfeed, that is) FP%DEL==1B3 ;Rubout on line FP%EQU==1B4 ;Equal sign seen (control parameter) FP%BKA==1B5 ;Backarrow seen (sender spec) FP%WSP==1B6 ;Whitespace at start ;;; Following used in parsing sender addresses from msg headers FP%LBK==1B7 ;Left angle bracket seen FP%RBK==1B8 ;Right angle bracket seen FP%HST==1B9 ;Collecting host FP%SEP==1B10 ;"Separator" at end of sender adr field FP%DQT==1B11 ;" seen to start quoted field ;;; Delivery flags FM%FAI==1B18 ;Failing message FM%RLY==1B19 ;Current transaction is being relayed FM%HDR==1B20 ;Headers already generated FM%FLO==1B21 ;Addressee is a file FM%VRC==1B22 ;Valid recipient seen FM%QOT==1B23 ;Must quote this address in protocol ;;; Requeue flags FQ%DON==1B26 ;"Host done" set on entry FQ%XER==1B27 ;Discard msg on failure FQ%XNT==1B28 ;Don't send non-delivery notifications FQ%RNM==1B29 ;Rename file to have RETRANSMIT ext FQ%SXX==1B30 ;Failure notice rerouted to mail agent FQ%SDR==1B31 ;Mail failed to sender FQ%MLA==1B32 ;Mail failed to mail agent FQ%OMF==1B33 ;Old style mail queue file FQ%ALL==1B34 ;Output all of this host FQ%HST==1B35 ;Host already output SUBTTL Paged storage .PSECT DATPAG,PAGORG ;Enter paged data DEFINE DEFPAG (ADDR,LENGTH) < ADDR: IFB , IFNB , >;DEFINE DEFPAG DEFPAG IPCPAG,1 ;Junk page for IPCF DEFPAG HSTTBL,4 ;Internal table of hosts HTBLSZ==<4*1000>-1 ;Length of table in TBLUK% format DEFPAG FLGPAG ;For MAILER.FLAGS if needed DEFPAG TMPBUF,2 ;Temporary storage DEFPAG FWDWIN,2 ;Forwarding string window .ENDPS .PSECT FRESTG,FREORG FSPAG== ;First free storage page .ENDPS SUBTTL Impure storage LOC 20 ;Low memory FATACS: BLOCK 20 ;AC's saved on crash UUOLOC: BLOCK 1 ;LUUO saved here JSR UUOH ;Set up UUO handler FHTAB: BLOCK 3 ;Start of daughter fork handle table FORKX: BLOCK 1 ;Logical fork number NEWF: BLOCK 1 ;Non-zero to scan new mail NETF: BLOCK 1 ;Non-zero to deliver to network recipients RXMF: BLOCK 1 ;Non-zero to scan retransmit mail FSTF: BLOCK 1 ;Non-zero to cache dead hosts DAEMNP: BLOCK 1 ;If running as system job WOPRP: BLOCK 1 ;If WHEEL or OPERATOR MYUSRN: BLOCK 1 ;User number MYDIRN: BLOCK 1 ;Connected directory number MYJOBN: BLOCK 1 ;Job number MYLDIR: BLOCK 1 ;Logged-in directory RELOC .PSECT DATA,DATORG ;Enter data area NPDL==377 ;Size of stack PDL: BLOCK NPDL ;Pushdown list MEMBEG==. ;Start of memory initialized at startup IPCFON: BLOCK 1 ;Non-zero if IPCF is set up LOGJFN: BLOCK 1 ;Log file when Daemon STAJFN: BLOCK 1 ;Statistics file when Daemon SEGSIZ: BLOCK 1 ;Size of segments we'll send SWTLOS: BLOCK 1 ;[PLB] S/W/ TOOLS LF LOSSAGE MODE MPP: BLOCK 1 ;Saved stack ptr for SAVACS/RSTACS SAVEN: BLOCK 1 ;Place to save recipient host ptr SAVEP: BLOCK 1 ;For Pup abort returns DODJFN: BLOCK 1 ;DODIR's current JFN FRNHST: BLOCK 1 ;Address of foreign host string FRNADR: BLOCK 1 ;Foreign host address PGTBLL==<1000-FSPAG+^D35>/^D36 PAGTBL: BLOCK PGTBLL ;Bit table FREPTR: BLOCK 1 ;Tail,,head for free block list PLINBP: BLOCK 2 ;Start of line in parser PWSPBP: BLOCK 2 ;Byte pointer of start of line after whitespace PCLNBP: BLOCK 2 ;Where there was a colon PDELBP: BLOCK 2 ;Where there was a rubout PDELB2: BLOCK 2 ;Where it ends SDRHST: BLOCK 1 ;Sender host site SDRNAM: BLOCK 2 ;Ptr/cnt to sender name NXTSEQ: BLOCK 1 ;Ascending number in sequence for uniqueness NETJFN: BLOCK 1 ;Network JFN REQJFN: BLOCK 1 ;Requeue output JFN FAIJFN: BLOCK 1 ;Failure message JFN NTFJFN: BLOCK 1 ;Sender notify message JFN HSHPAG: BLOCK 1 ;Page it is mapped into HSHSIZ: BLOCK 1 ;Size of hash file SITHSH: BLOCK 1 ;Hash for this site TXTJFN: BLOCK 1 ;JFN for text file CURDTM: BLOCK 1 ;Date/time when MMailr scan started SCNTIM: BLOCK 1 ;Time to do file scan SYSDIR: BLOCK 1 ;SYSTEM: directory MLQDIR: BLOCK 1 ;MAILQ: directory DIRNUM: BLOCK 1 ;Directory being hacked MFLAGP: BLOCK 1 ;Are mailer flags mapped in? TIMKIL: BLOCK 1 ;-1 if clock should be killed TIMLOC: BLOCK 1 ;PC to go to on time-out TIMRTP: BLOCK 1 ;Stack ptr for time-out return INTOK: BLOCK 1 ;Neg if time-out interrupt active INTPC: BLOCK 1 ;Interrupt PC CTGCNT: BLOCK 1 ;# of ^G's typed ICPTIM: BLOCK 1 ;ICP time-out countdown HDRLEN: BLOCK 1 ;Number of characters in current header block FILIDX: BLOCK 1 ;File tbl index for queued file type OMLRBF: BLOCK 20 ;Buffer for address strings (old MAILER) MBXFK: BLOCK 1 ;MMAILBOX.EXE fork handle INUUO: BLOCK 1 ;Safety check to prevent recursive UUO's NUPDL==100 ;Size of UUO PDL UUOPDL: BLOCK NUPDL ;Pushdown list for processing UUO's UUOACS: BLOCK 20 ;ACs saved over UUO INTACS: BLOCK 20 ;ACs saved over level 1 interrupt HSTBFL==30 HSTBUF: BLOCK HSTBFL ;Put string of a host here AUTLEN==10 ;Length of author strings FILAUT: BLOCK AUTLEN ;Place for msg file's author string ORGAUT: BLOCK AUTLEN ;Vanilla author string GTINF: BLOCK <.JIBAT-.JITNO+1> ;GETJI% stores data here USRNUM: BLOCK 1 FRMMSG: BLOCK 30 NTDEQF: BLOCK 1 ;Pos -- Notify sender if undeliverable ;Zero -- No action ;Neg -- Dequeue msg if undeliverable IPCNT: BLOCK 1 ;Count of times we've MSEND%'d IPCFOK: BLOCK 1 ;Non-zero if okay to bump interrupted PC NOSLEP: BLOCK 1 ;Non-zero if we should skip DISMS RLYLST: BLOCK 1 ;List of relay hosts we are trying CURDOM: BLOCK 1 ;Domain block for relaying DOMTBL: BLOCK 1 ;Table of domains created by relay code STRBSZ==1000 ;Length of string buffers STRBUF: BLOCK STRBSZ ;String buffer, used globally STRBF1: BLOCK STRBSZ ;Alternative string buffer, used locally MEMEND==.-1 ;End of memory initialized at startup PIDGET: IP%CPD ;Create a PID 0 ;Where the PID goes 0 ;For INFO ENDPID-.,,.+1 ;Length,,address of message block 1,,.IPCII ;Ask to associate a name 0 ;No PID for copy ASCIZ/[SYSTEM]MMAILR/ ;The name ENDPID==. IPCFMS: 0 ;Flags 0 ;Sender 0 ;Receiver IPCFBL,,IPCFBF ;Length,,address of message block IPCFBL==10 ;Size of IPCF buffer IPCFBF: BLOCK IPCFBL ;Place for MRECV%/MUTIL% to write to IFN $$OZ,< IP$PID: 0 ;PID for $daemon messages > SDBLOK: 0 ;.SDPID - PID for local sends T%RSYS!T%HDR ;.SDFLG - We build the header, obey REF SYS PRINTP: 0 ;-1 to print activity messages DEBUGP: 0 ;-1 if debugging network protocol LOGP: -1 ;[PLB] -1 if should make logs STATP: -1 ;[PLB] -1 if should keep statistics ;;;Non-zero pure data UUOH: 0 ;UUO handler JRST UUOH0 SAVACS: 0 ;AC save routine JRST SAVAC0 LCLNAM: ASCIZ/TOPS-20/ ;Gets clobbered at initialization time BLOCK LCLNAM+20-. LCLNME==. ;End of local name (for padding purposes) LCLNCN: BLOCK 20 ;Local name for current network REQID=='MM' ;Request ID for our ENQ%'ing ENQBLK: 1,,ENQBLL ;Number of locks, block size REQID ;Interrupt channel, request ID 0 ;Flags, level number,,JFN -1,,ENQNAM ;Pointer to name string (this name for 0 ; MM/MS compatibility) 0 ENQBLL==.-ENQBLK ;Length of ENQ% BLOCK ENQNAM: ASCIZ/Mail expunge interlock/ CHNTAB::PHASE 0 1,,TIMINT ;Time-out 1,,CTGINT ;^G typed IPCHAN::!1,,IPCINT ;Handle IPCF interrupt WAKCHN::!1,,WAKINT ;Process interrupt wakeup channel REPEAT <^D36-.>,<0> DEPHASE ; Sending protocol information ; ; SNDRT0 contains all the routines that MMailr might use. ; ; SNDRTS is a table (built from SNTRT0) of the routines ; it can use (because the monitor knows about them) ; DEFINE DEFNT(PROT,NTDEV,SNDRTN)< [[ASCIZ/PROT/],,SNDRTN],,[ASCIZ/NTDEV/] >;DEFINE DEFNT ; These should be ordered by prefered priority of use SNDRT0: DEFNT(TCP,TCP,INTSND) ;Internet DEFNT(Chaos,CHA,CHASND) ;Chaosnet DEFNT(Pup,PUP,PUPSND) ;Pup Ethernet DEFNT(DECnet,DCN,DCNSND) ;DECnet DEFNT(Special,MAILS,SPCSND) ;Special (non-MMailr) network NSNDRS==.-SNDRT0 ; Format of a SNDRTS table entry is ,, ; SNDRTS: BLOCK NSNDRS ;Where we build the table 0 ;End of table marker .ENDPS SUBTTL Pure storage .PSECT CODE,CODORG ;Enter code LEVTAB::INTPC ;Priority level table 0 0 BITS: ...BIT==0 REPEAT <^D36>,< 1B<...BIT> ...BIT==...BIT+1 >;REPEAT <^D36> ;;; Various timer value definitions RXMINT: INTRXM*^D<60*1000> ;RETRANSMIT file scan interval SCNINT: INTSCN*^D<60*1000> ;File scan interval NTFINT: NTDAYS,,0 ;Sender notify interval (internal fmt) MAXQUE: DEDAYS,,0 ;Maximum time in the queue (internal fmt) TMTINT: MAXTMT*^D1000 ;Max total transmission time (msec) TMCINT: MAXTMC*^D1000 ;Max transmission time/copy (msec) DAEDIR: ASCIZ/OPERATOR/ ;Directory DAEMON runs out of MLAGNT: ASCIZ/Mailer/ ;Person handling mail problems ; Following are definitions and a table of file names/processing ; functions to handle delivery of various queued mail formats: DEFINE FILXX(GSTR,BSTR,PRCHDR,PRCTXT,FLGS)< %FLSTR==0 [ASCIZ `GSTR`],,[ASCIZ `BSTR`] ;File group name string %FLPRC==1 PRCHDR,,PRCTXT ;Setup routines for processing ;header/text %FLFLG==2 FLGS %FLLEN==3 >;DEFINE FILXX ; Control flags for processing names FF%OML==1B0 ;Old style queue file (adr in extension) FF%RNM==1B1 ;Rename file with RETRANSMIT ext if requeued FF%RXM==1B2 ;Only scan this file type every RXMINT minutes FF%XNT==1B3 ;Don't notify sender of failures FF%NEW==1B4 ;This is a new file with possible local recipients FF%NET==1B5 ;This file is requeued from NEW FILTBL: FILXX(<[--QUEUED-MAIL--].NEW*>,<[--BAD-QUEUED-MAIL--].>,GQUEQM,GQUEH1,FF%RNM!FF%NEW) FILXX(<[--QUEUED-MAIL--].NETWORK>,<[--BAD-QUEUED-MAIL--].NETWORK>,GQUEQM,GQUEH1,FF%RNM!FF%NET) FILXX(<[--QUEUED-MAIL--].RETRANSMIT>,<[--BAD-QUEUED-MAIL--].RETRANSMIT>,GQUEQM,GQUEH1,FF%RXM) FILXX(<[--RETURNED-MAIL--].NEW*>,<[--BAD-RETURNED-MAIL--].>,GQUEQM,GQUEH1,FF%RNM!FF%XNT!FF%NEW) FILXX(<[--RETURNED-MAIL--].NETWORK>,<[--BAD-RETURNED-MAIL--].>,GQUEQM,GQUEH1,FF%RNM!FF%XNT!FF%NET) FILXX(<[--RETURNED-MAIL--].RETRANSMIT>,<[--BAD-RETURNED-MAIL--].RETRANSMIT>,GQUEQM,GQUEH1,FF%XNT!FF%RXM) FILXX(<[--UNSENT-MAIL--].*>,</UNDELIVERABLE-MAIL/.>,GQUEUN,GQUEH0,FF%OML!FF%NEW) FILXX(<]--UNSENT-NEGATIVE-ACKNOWLEDGEMENT--[.*>,</UNDELIVERABLE-MAIL/.>,GQUEUN,GQUEH0,FF%OML!FF%XNT) NFTBL==<.-FILTBL>/%FLLEN SUBTTL Main program IFNDEF VI%DEC,< ;In case MACSYM is prior to release 6 VI%DEC==1B18 >;IFNDEC VI%DEC ; Program entry vector ENTVEC: JRST MMAILR ;START JRST MMAILR ;REENTER VI%DEC!!!! FRKTAB: PHASE 0 JRST MMLNLF ;Fork 1: First time deliver to local recipients NETFRK:!JRST MMLNNF ;Fork 2: New network mail, fast scan JRST MMLRXM ;Fork 3: Retransmitted mail, slow scan DEPHASE NFRKS==.-FRKTAB ;Number of forks ENTVCL==.-ENTVEC ;Length of entry vector ;;;Fork 1: First time delivery to local recipients MMLNLF: MOVEI A,1 ;Set logical fork number MOVEM A,FORKX SETOM NEWF ;Scan new mail SETZM NETF ;Don't deliver to network recipients SETZM RXMF ;Don't scan retransmit mail SETOM FSTF ;Cache dead hosts (doesn't matter here) SETOM DAEMNP ;We are the daemon SETOM WOPRP ;Also, we must have been WHEEL or OPERATOR JRST MAILR1 ;Enter main program ;;;Fork 2: First time delivery to network recipients MMLNNF: MOVEI A,2 ;Set logical fork number MOVEM A,FORKX SETZM NEWF ;Don't scan new mail SETOM NETF ;Deliver to network recipients SETZM RXMF ;Don't scan retransmit mail SETOM FSTF ;Cache dead hosts SETOM DAEMNP ;We are the daemon SETOM PRINTP ;****** TEST ****** SETOM WOPRP ;Also, we must have been WHEEL or OPERATOR JRST MAILR1 ;Enter main program ;;;Fork 3: Slow scan through the RETRANSMIT queue MMLRXM: MOVEI A,3 ;Set logical fork number MOVEM A,FORKX SETZM NEWF ;Don't scan new mail SETOM NETF ;Deliver to network recipients SETOM RXMF ;Scan retransmit mail SETZM FSTF ;Don't cache dead hosts SETOM DAEMNP ;We are the daemon SETOM WOPRP ;Also, we must have been WHEEL or OPERATOR SETOM PRINTP ;******* TEST ******* JRST MAILR1 ;Enter main program ;;;Mother fork start MMAILR: DO. GTAD% ;a =: date/time AOSE A ;Set yet? IFSKP. MOVEI A,^D5000 ;No, wait 5 sec DISMS% LOOP. ;And try again ENDIF. ENDDO. RESET% ;Flush all I/O MOVE P,[IOWD NPDL,PDL] ;Establish stack GJINF% MOVEM A,MYUSRN ;Save user number MOVEM B,MYDIRN ;Save connected directory number MOVEM C,MYJOBN ;Save job number SETZ A, ;Get login directory MOVE B,MYUSRN ;My user number RCDIR% MOVEM C,MYLDIR ;My logged-in directory SETZB F,MEMBEG ;Clear out impure storage MOVE A,[MEMBEG,,MEMBEG+1] BLT A,MEMEND SETOM INUUO ;Init recursive UUO flag SETZM FORKX ;This is top fork SETOM NEWF ;Assume scan new mail SETOM NETF ;Assume deliver to network recipients SETOM RXMF ;Assume scan retransmit mail SETOM FSTF ;Assume cache dead hosts SETZM DAEMNP ;Assume not the Daemon SETOM PRINTP ;Assume print all messages MOVX A,.FHSLF RPCAP% ;Get our capabilities IFXN. B,SC%WHL!SC%OPR ;WHEEL or OPERATOR? SETOM WOPRP ;Yes, flag so IOR C,B ;Enable everything we've got EPCAP% MOVX A,RC%EMO ;Now see if we're the Daemon (must be priv'd) HRROI B,DAEDIR ;b =: dir Daemon runs out of RCUSR% MOVE T,C GJINF% DAEPAT:! ;;;Patch this location to NOP to force Daemon CAMN A,T ;Are we logged in as the Daemon user? SETOM DAEMNP ;Yes, we're the Daemon ENDIF. SKIPN DAEMNP ;Are we the daemon? IFSKP. CALL WAKTOP ;Set up for passing on wakeup interrupts MOVSI X,-NFRKS ;Set up fork count DO. MOVX A,CR%CAP ;Make an inferior fork, pass down capabilities CFORK% IFJER. JFATAL HALTF% ;Punt JRST MMAILR ;Restart on CONTINUE ENDIF. MOVEM A,FHTAB(X) ;Save daughter's fork handle SETZ T, ;Reset page index DO. MOVE A,T ;Get the page number HRLI A,.FHSLF ;This fork RMAP% ;Read page access IFXN. B,RM%PEX ;Does page exist? MOVE C,B ;Yes, get its access bits ANDX C,RM%RD!RM%WR!RM%EX!RM%CPY ;Turn off unwanted bits TXZE C,RM%WR ;Does this page have write access? TXO C,RM%CPY ;Yes, set copy-on-write for daughters MOVE A,T ;Get page number HRLI A,.FHSLF ;This fork MOVE B,T ;For destination also HRL B,FHTAB(X) ;New fork handle PMAP% ;Map the page ENDIF. CAIGE T,777 ;At last page? AOJA T,TOP. ;No so keep going ENDDO. MOVE A,FHTAB(X) ;Start daughter fork MOVEI B,FRKTAB(X) ;At specified address SFORK% AOBJN X,TOP. ;Start next fork ENDDO. DO. MOVSI X,-NFRKS ;Set up DO. MOVE A,FHTAB(X) ;Get fork handle RFSTS% ;Check its status LOAD A,RF%STS,A ;Not interested in PSI or frozen flag CAIE A,.RFHLT ;If HALTF%, treat like blew up CAIN A,.RFFPT ;Forced process termination? IFNSK. MOVEI A,1(X) ;Get fork index CETYPE MOVEI T,-1(B) ;Get symbolic PC CALL SYMOUT MOVE A,FHTAB(X) ;Get fork handle GETER% ;Get last error of this process ETYPE <, last error: %2E, ...restarting > MOVE A,FHTAB(X) ;Get fork handle again MOVEI B,CRASH ;Get it to dump and reboot SFORK% ENDIF. AOBJN X,TOP. ;Otherwise looks good, try next ENDDO. MOVX A,^D<5*60*1000> ;Wait five minutes between checks DISMS% LOOP. ENDDO. ENDIF. MAILR1: RESET% ;Flush all I/O MOVE P,[IOWD NPDL,PDL] ;Establish stack GJINF% MOVEM A,MYUSRN ;Save user number MOVEM B,MYDIRN ;Save connected directory number MOVEM C,MYJOBN ;Save job number SETZ A, ;Get login directory MOVE B,MYUSRN ;My user number RCDIR% MOVEM C,MYLDIR ;My logged-in directory SETZB F,MEMBEG ;Clear out impure storage MOVE A,[MEMBEG,,MEMBEG+1] BLT A,MEMEND SETOM INUUO ;Init recursive UUO flag MOVEI A,.FHSLF ;Set up PSI MOVE B,[LEVTAB,,CHNTAB] SIR% EIR% MOVX B,1B0 ;Set up for channel 0 to interrupt AIC% TMOCLR ;No time-out interrupts, please ; ; Place initial entries in our host table ; MOVEI A,HTBLSZ ;Maximum number of hosts we can handle at once MOVEM A,HSTTBL ;Init the table CALL INICNX ;Figure out the protocols we speak HRROI A,LCLNAM ;Try to get local host name for Internet CALL $GTLCL ;Get local host name FATAL MOVEI A,HSTTBL ;Add it to our host table MOVSI B,LCLNAM TBADD% MOVX B,HF%PRM ;Mark it permanent IORM B,(A) MOVEI A,ALCBLK ;Set up routines for use by relay code MOVEI B,PRMHST CALL $INRLY ;Init relay tables MOVEM A,DOMTBL ;Save table of domains it made JSP CX,SETTIM ;Set the timer up SKIPE DAEMNP ;Are we the Daemon? IFSKP. MOVEI A,.FHSLF ;No, set up ^G interrupt MOVX B,1B1 AIC% MOVE A,[.TICCG,,1] ATI% SETOM PRINTP ;Print all messages GTAD% ;Log current date/time MOVEM A,CURDTM MOVE B,MYDIRN ;Get connected directory CAMN B,MYLDIR ;Login same as connected? IFSKP. CALL DODIR ;Do connected first CALL CRIF MOVE B,MYLDIR ;Get login directory ENDIF. CALL DODIR ;Do login HALTF% JRST MMAILR ;Restart totally if continue ENDIF. ; falls through SUBTTL Background operator task ; drops in ;;; ****** TEST ****** ;;; SETZM PRINTP ;Don't print detailed logs SKIPE DEBUGP ;Unless debugging SETOM PRINTP ;Want detailed logs MOVX A,RC%EMO ;No MAILQ:, use SYSTEM: HRROI B,[ASCIZ/SYSTEM:/] RCDIR% TXNE A,RC%NOM!RC%AMB ;Anything go wrong? SETZ C, ;This shouldn't happen MOVEM C,SYSDIR ;Save SYSTEM: directory MOVX A,RC%EMO ;Look up MAILQ: HRROI B,[ASCIZ/MAILQ:/] RCDIR% TXNE A,RC%NOM!RC%AMB ;Anything go wrong? MOVE C,SYSDIR ;Yes, use SYSTEM: directory instead MOVEM C,MLQDIR ;Set directory to check every time MOVEI A,.FHSLF SETOB C,B EPCAP% CALL MAPFLG ;Map in the mailer flags JWARN ; falls through ; drops in ;;;This is the main daemon loop DO. SKIPN LOGP ;Should make logs? IFSKP. ;Yes SETOM PRINTP ;Want details DO. MOVE A,[POINT 7,STRBUF] MOVEI B,[ASCIZ/MAIL:/] CALL MOVSTR MOVE B,FORKX ;Fork handle MOVX C,^D8 NOUT% JFATAL MOVEI B,[ASCIZ/-MMAILR.LOG/] CALL MOVST0 HRROI B,STRBUF MOVX A,GJ%SHT GTJFN% IFJER. CAIE A,GJFX24 ;Work around monitor bug JWARN MOVX A,^D5000 ;Wait 5 seconds DISMS% LOOP. ENDIF. MOVEM A,LOGJFN MOVX B,<!OF%APP> OPENF% IFJER. PUSH P,A ;Save error code MOVE A,LOGJFN ;Recover JFN RLJFN% ;Release it JWARN SETZM LOGJFN ;Clear log JFN MOVX A,^D5000 ;Wait a few seconds DISMS% POP P,A ;Recover error code CAIN A,OPNX9 ;No error if file just busy LOOP. CAIE A,OPNX2 ;File disappeared? WARN LOOP. ENDIF. ENDDO. MOVEI B,(A) ;B := Nul,,log HRLI B,.NULIO MOVX A,.FHSLF ;Set primary JFNs for this fork SPJFN% ENDIF. SKIPN STATP ;Taking statistics? IFSKP. DO. MOVE A,[POINT 7,STRBUF] MOVEI B,[ASCIZ/MAIL:/] CALL MOVSTR MOVE B,FORKX ;Fork handle MOVX C,^D8 NOUT% JFATAL MOVEI B,[ASCIZ/-MMAILR.STAT/] CALL MOVST0 HRROI B,STRBUF MOVX A,GJ%SHT GTJFN% IFJER. CAIE A,GJFX24 ;Work around monitor bug JWARN MOVX A,^D5000 ;Wait 5 seconds DISMS% LOOP. ENDIF. MOVEM A,STAJFN MOVX B,<!OF%APP> OPENF% IFJER. PUSH P,A ;Save error code MOVE A,STAJFN ;Recover JFN RLJFN% ;Release it JWARN SETZM STAJFN ;Clear STAT JFN MOVEI A,^D5000 ;Wait a few seconds DISMS% POP P,A ;Recover error code CAIN A,OPNX9 ;No error if file just busy LOOP. CAIE A,OPNX2 ;File disappeared? WARN LOOP. ENDIF. ENDDO. ENDIF. ; falls through ; drops in CITYPE CALL NDHOST ;Clear dead host list AOSE TIMKIL ;If clock got killed restart it JSP CX,SETTIM CALL WAKINI ;Set up wakeup interrupt SKIPE A,FORKX ;Initialize IPCF if fork 0 (single fork) or CAIN A,1 ; fork 1 (first time requests). This is here CALL IPCINI ; so we retry every scan if failed SKIPN IPCFON ;IPCF on? IFSKP. JSP C,IPCHEK ;Yes, check the queue IFSKP. CIETYP ;Log this MOVEI A,.FHSLF ;Now fake an IPCF delivery MOVX B,1B IIC% ENDIF. ENDIF. GTAD% ;Log current date/time MOVEM A,CURDTM TIME% ;Get time SKIPN RXMF ;Scanning retransmit files? IFSKP. ADD A,RXMINT ;Yes, wait longer between wakeups ELSE. ADD A,SCNINT ;Normal scan interval ENDIF. MOVEM A,SCNTIM ;Set time to scan again ; falls through ; drops in SKIPL MFLAGP ;Have mailer flags to do? IFSKP. MOVSI A,-1000 DO. SKIPN B,FLGPAG(A) ;Find a word with bit set IFSKP. DO. JFFO B,.+2 ;Get bit position EXIT. ;Last bit in this word PUSH P,A ;Found a directory, do it PUSH P,B MOVNI D,(C) ;Negative bit number MOVX B,1B0 LSH B,(D) ;Make bit to clear ANDCAM B,FLGPAG(A) ;Clear it in flag page ANDCAM B,(P) ;And in saved word MOVEI B,(A) IMULI B,^D36 ADDI B,(C) ;Compute directory to do HLL B,MYLDIR CAME B,MLQDIR ;We'll do MAILQ: below CAMN B,SYSDIR ;Ditto SYSTEM: CAIA CALL DODIR POP P,B POP P,A LOOP. ENDDO. ENDIF. AOBJN A,TOP. ENDDO. ENDIF. ; falls through ; drops in SKIPN B,MLQDIR ;Scan the MAILQ: directory IFSKP. CALL DODIRX MOVX A,DD%DTF+DD%DNF ;Deleting ;T and non-existent files MOVE B,MLQDIR ;Now, expunge the directory DELDF% IFJER. JWARN ENDIF. ENDIF. SKIPE B,SYSDIR ;Scan the SYSTEM: directory CAMN B,MLQDIR ;Only if it is different from MAILQ: IFSKP. CALL DODIRX ;It is, scan it MOVX A,DD%DTF+DD%DNF ;Deleting ;T and non-existent files MOVE B,SYSDIR ;Now, expunge the directory DELDF% IFJER. JWARN ENDIF. ENDIF. MOVX A,.FHSLF ;Restore primaries SETO B, SPJFN% SKIPN A,LOGJFN ;Close log file IFSKP. CLOSF% JFATAL SETZM LOGJFN ENDIF. SKIPN A,STAJFN ;Close statistics file IFSKP. CLOSF% JFATAL SETZM STAJFN ENDIF. TIME% ;Current time EXCH A,SCNTIM ;Time to do scan SUB A,SCNTIM IFG. A ;Sleep only if time left in this interval SKIPN RXMF ;Scanning retransmit files? IFSKP. CAMLE A,RXMINT ;Paranoia MOVE A,RXMINT ELSE. CAMLE A,SCNINT ;Paranoia MOVE A,SCNINT ENDIF. SETOM TIMKIL ;Kill the clock SETOM IPCFOK ;Indicate IPCF interrupts are OK to grant SKIPN NOSLEP ;Okay to sleep? DISMS% NOP ;In case of interrupts SETZM IPCFOK ;Indicate IPCF interrupts not allowed SETZM NOSLEP ;Allowed to DISMS% now ENDIF. LOOP. ENDDO. ; Here to process files in a directory DODIR: CIETYP DODIRX: MOVEM B,DIRNUM ;Save directory number MOVE A,[-NFTBL,,FILTBL] ;Init file type index SETZM DODJFN ;Initially no current group JFN DO. ;For each group SKIPE DODJFN ;Have a current JFN defined? IFSKP. ;No current JFN defined MOVEM A,FILIDX ;Save file flags index HRROI A,STRBUF ;Build filename here MOVE B,DIRNUM ;Start with desired directory DIRST% ERJMP ENDLP. ;No such directory, can't do anything MOVE B,FILIDX ;b =: ptr to current file type string HLRZ B,%FLSTR(B) CALL MOVST0 MOVE A,[GJ%IFG!GJ%OLD!GJ%SHT+.GJALL] HRROI B,STRBUF GTJFN% ;See if file group found IFNJE. MOVEM A,DODJFN ;Save JFN DO. MOVE A,FILIDX ;Get pointer to file type string MOVE A,%FLFLG(A) ;Get flags for this group IFXN. A,FF%NEW ;Is this a new file? SKIPE NEWF ;Allowed to do new files? EXIT. ;Yes, do it ELSE. ;Not new file SKIPN NETF ;Allowed to do network I/O? IFSKP. ;Network I/O ok IFXN. A,FF%RXM ;Is this a retransmit file? SKIPE RXMF ;Allowed to do retransmit files? EXIT. ;Yes, do it ELSE. ;Not retransmit file, assume 1st time net file SKIPE FSTF ;Doing fast 1st time net mail delivery? EXIT. ;Yes, do it ENDIF. ;End retransmit file test ENDIF. ;End network I/O okay ENDIF. ;End test of group type CALL MAIFLG ;Not allowed to do it, make sure mailer knows HRRZ A,DODJFN ;Now flush this JFN RLJFN% NOP SETZM DODJFN ;Don't try to do this group ENDDO. ;End validate need to do this group ENDIF. ;End found files matching this group ENDIF. ;End no current JFN defined SKIPN A,DODJFN ;Current JFN defined IFSKP. ;Process current file for this JFN DO. HRRZS A CALL GETQUE JRST [TYPE <...queue map failed...requeued> CALL MAIFLG ;Make sure mailer knows EXIT.] JRST [TYPE <...bad file format> CALL MAIFLG ;Make sure mailer knows EXIT.] SETZM NTDEQF ;Clear dequeue flag MOVE B,FILIDX ;Notify sender about this file type? MOVE B,%FLFLG(B) IFXE. B,FF%XNT SKIPN A,MSGNTF(M) ;Sender notify time given? IFSKP. CAMGE A,CURDTM ;Yes, time to squawk if undeliverable? AOS NTDEQF ;Yes, flag to send notification ENDIF. ENDIF. SKIPN A,MSGDEQ(M) ;Dequeue time given? IFSKP. CAML A,MSGAFT(M) ;Yes, dequeue time before after time? IFSKP. MOVE A,MSGAFT(M) ;Yes, don't be absurd! Use after time CAMG A,CURDTM ;Unless it's before now MOVE A,CURDTM ;In which case we'll use the time now ADD A,MAXQUE ;Plus interval MOVEM A,MSGDEQ(M) ;Set corrected dequeue time ENDIF. CAMGE A,CURDTM ;Time to dequeue this file? SETOM NTDEQF ;One more try, then dequeue failures ENDIF. CALL FWDLCL MOVE A,MSGAFT(M) ;Get after parameter, if any CAMLE A,CURDTM ;Time to do this message yet? IFSKP. PUSH P,MSGTMT(M) ;Yes, no overall time limits on locals SETZM MSGTMT(M) CALL SNDLCL ;Always try local recipients IFNSK. ADJSP P,-1 ;Reset stack TYPE <...bad file format> CALL MAIFLG ;Make sure mailer knows EXIT. ENDIF. POP P,MSGTMT(M) ;Restore global delivery timeout CALL SNDMSG ;Deliver the message IFNSK. TYPE <...bad file format> CALL MAIFLG ;Make sure mailer knows EXIT. ENDIF. SKIPE NETF ;If no net sends hold off on this SETZM MSGDOP(M) ;Next time use MAIL to deliver this message ELSE. CIETYP < Processing of recipients deferred until %1T> MOVEI A,MSGLCL(M) ;Pointer to local mail DO. ;Flag "temporary" failure to fake out REMAIL HRRZ B,(A) IFN. B MOVX C,FR%TMP IORM C,RCPFLG(B) MOVEI A,(B) LOOP. ENDIF. ENDDO. ENDIF. CALL REMAIL ;Requeue or send failure CALL RELQUE CITYPE < Done, > SKIPN REQJFN ;Was something requeued? IFSKP. TYPE CALL MAIFLG ;Make sure mailer knows MOVE A,FILIDX ;Was the file renamed too? MOVE A,%FLFLG(A) IFXN. A,FF%RNM!FF%OML HRRZ A,DODJFN ;Yes. GNJFN% fails if current file renamed RLJFN% ;Release this jfn JWARN SETZM DODJFN MOVE A,FILIDX ;Get current group ADJSP A,-1 ;Back up group so iteration redos this one SUBI A,%FLLEN-1 MOVEM A,FILIDX ;Now store it ENDIF. ELSE. TYPE HRRZ A,DODJFN TXO A,DF%NRJ DELF% JWARN ENDIF. CALL HSTCLR ;Clean up the host table ENDDO. ENDIF. ;End processing for this file SKIPN A,DODJFN ;Get JFN back IFSKP. GNJFN% ;See if another file in this group IFNJE. LOOP. ;Another file, do it ENDIF. SETZM DODJFN ;No more JFNs in this group ENDIF. MOVE A,FILIDX ;a =: current file type index ADDI A,%FLLEN-1 ;Step to next one AOBJN A,TOP. ;And do next group if more to do ENDDO. ;End of per-group processing RET SUBTTL Get atom from file routine ;;; Read atom into string buffer in C, from open JFN in A. ;;; Always pads to word boundaries, uppercasing. FILATM: BIN% ERJMP FILAT1 ;Done on EOF JUMPE B,FILAT1 ; or on NUL CAIE B,.CHLFD ; or LF CAIN B,.CHSPC ; or space JRST FILAT1 CAIN B,.CHCRT ; or CR JRST FILAT3 CAIL B,"a" CAILE B,"z" CAIA SUBI B,"a"-"A" IDPB B,C ;Else, add it JRST FILATM FILAT3: BIN% ;CR, flush LF too FILAT1: SETZ B, ;Tie off local name FILAT2: IDPB B,C TXNE C,76B4 JRST FILAT2 RET ; Routine to scan the possible sending routines, and remove ; those that the monitor doesn't know about. ; Create a protocol table for later use in mail sending ; ; Return: +1 INICNX: MOVX T,<-NSNDRS,,SNDRT0> ;Number of possible sending routines MOVEI TT,SNDRTS ;Table of allowed sending routines DO. HRRO A,(T) ;a := ptr to dev name for this net STDEV% ;Local system know about it? IFNJE. HLRZ A,(T) ;Get the data address MOVE A,(A) ;And the data MOVEM A,(TT) ;Save AOS TT ;Increment table ENDIF. AOBJN T,TOP. ENDDO. SETZM (TT) ;End of table marker RET ;Yes SUBTTL Memory allocation ;;; Bit table hacking, page number in A for all PAGSBT: PUSH P,[IORM B,(A)] ;Set bit JRST PAGHBT PAGCBT: PUSH P,[ANDCAM B,(A)] ;Clear bit JRST PAGHBT PAGTBT: PUSH P,[TDNE B,(A)] ;Skip if bit clear PAGHBT: PUSH P,A PUSH P,B SUBI A,FSPAG ;Make relative to start of bit table IDIVI A,^D36 MOVEI A,PAGTBL(A) ;Point to right word MOVE B,BITS(B) ;Get right bit XCT -2(P) SKIPA AOS -3(P) POP P,B POP P,A ADJSP P,-1 RET ;;; Allocate number of pages in A, returns +1 failure, +2 page number in B PAGAL1: MOVEI A,1 ;Allocate one page PAGALC: PUSH P,C PUSH P,A ;Save number of pages we need MOVEI B,FSPAG ;Starting free page PAGALB: CALL PAGFFP ;Fast search for first free page JRST POPACJ ;Failure, just return MOVEI A,1(B) MOVE C,(P) ;Get number of pages to hack again PAGALL: SOJLE C,PAGALW ;Got enough, return address from b CAIL A,1000 ;Page number too big? JRST POPACJ ;Yes, fail CALL PAGTBT ;Is this bit set? IFNSK. MOVEI B,1(A) ;Try for next free page JRST PAGALB ENDIF. AOJA A,PAGALL ;Try for next match PAGALW: MOVE C,(P) MOVEI A,(B) PAGAW1: CALL PAGSBT ;Allocate one page SOJLE C,POPAC1 AOJA A,PAGAW1 POPAC1: AOS -2(P) ;Winning return POPACJ: POP P,A POP P,C RET ;;; Deallocate pages, number in A, starting page in B PAGDA1: MOVEI A,1 ;Deallocate one page PAGDAL: PUSH P,A PUSH P,B PUSH P,C EXCH A,B ;Setup for page number in A PAGDA2: SOJL B,PAGDA3 CALL PAGCBT ;Clear one bit AOJA A,PAGDA2 PAGDA3: SETO A, MOVE B,-1(P) ;Starting page HRLI B,.FHSLF HRRZ C,-2(P) ;Count TXO C,PM%CNT PMAP% ;Flush those pages POP P,C POPBAJ: POP P,B CPOPAJ: POP P,A RET ;;; Fast search for the first free bit, starting page in B ;;; Returns +1 failure, +2 with page number in B PAGFFP: SUBI B,FSPAG ;Make relative to start of bit table IDIVI B,^D36 SETCM A,PAGTBL(B) ;Get first word to check LSH A,(C) MOVNI C,(C) LSH A,(C) ;Clear out random bits to left SKIPA C,B ;Starting word index PAGFF1: SETCM A,PAGTBL(C) ;Get word to check JFFO A,PAGFF2 ;Got any ones? CAIL C,PGTBLL ;No - beyond last word? RET ;Failed AOJA C,PAGFF1 ;No, search for next word PAGFF2: IMULI C,^D36 ;Number of bits passed ADDI B,FSPAG(C) ;Final winning page number CAIL B,1000 ;Was page valid? RET ;No RETSKP ; Routine to unmap memory buffer pages currently in use ; Entry: pagtbl = bitmap for pages in use ; Call: CALL CLRPTB ; Return: +1 CLRPTB: SETO A, ;Unmap special prebuffer pages MOVSI B,.FHSLF SETZ C, HRRI B, ;Do FLAGS page PMAP% HRRI B, ;Do MMAILBOX buffer page MOVX C,PM%CNT!2 ;Unmap both temp pages PMAP% HRRI B, PMAP% MOVSI T,-PGTBLL ;t =: aobjn ptr to PAGTBL CLRPT0: SKIPE A,PAGTBL(T) ;Any bits in this entry? JFFO A,CLRPT1 ;Yes, scan for 1st one AOBJN T,CLRPT0 ;No more, try next word RET ;Done ; Here to unmap a page flagged in PAGTBL ; Entry: t = ptr to PAGTBL word for page ; b = count of flag bit position for page CLRPT1: MOVEI C,0(T) ;c =: PAGTBL word index IMULI C,^D36 ;c =: page count for prior wds in table ADDI B,FSPAG(C) ;b =: memory page number CAIL B,1000 ;Legal page? FATAL CALL PAGDA1 ;Deallocate this page JRST CLRPT0 ;Look for more to do ;;; Map in a file, given name in B, ;;; Returns +1 failure, +2 success, starting address in B, ;;; number of bytes in C, start,,count in D MAPQFL: PUSH P,[OF%RD!OF%WR!OF%PDT] SKIPA ;Try for write too first, save dates for queue MAPFIL: PUSH P,[OF%RD] ;Normally try just read MOVX A,GJ%OLD!GJ%SHT GTJFN% IFJER. ADJSP P,-1 RET ENDIF. CIETYP < File %1J:> MOVE B,(P) ;Get OPENF% flags PUSH P,A ;Save the jfn OPENF% JRST MPFLOE MAPFL1: SIZEF% JRST MPFLE1 PUSH P,B ;Save number of bytes MOVEI A,(C) ;Number of pages needed for whole file CALL PAGALC ;Allocate them IFNSK. MOVE B,-2(P) ;Get starting OPENF% bits TXNN B,OF%PDT ;From MAPQFL call? JRST MAPFLE ;No, just fail return JRST MAPQFE ;Make "Bad Mail" file ENDIF. HRLZ A,-1(P) ;Start with page 0 of file HRLI B,.FHSLF HRLI C,(PM%CNT!PM%RD!PM%CPY) PMAP% ERJMP MAPFLE HRLI C,(B) MOVS D,C ;Count,,start LSH B,9 ;Make page number into address POP P,C ;Count of bytes POP P,-1(P) ;Move the jfn down on the stack POPA1J: POP P,A RETSKP ;; Here on error mapping file MAPFLE: ADJSP P,-1 ;Clear byte count MPFLE1: POP P,A ;Recover JFN CLOSF% JWARN ADJSP P,-1 ;Clear OPENF% bits RET ;; Here when mail file is too big. C = # of pages MAPQFE: ADJSP P,-1 ;Clear byte count POP P,A ;Recover JFN ADJSP P,-1 ;Clear OPENF% bits MOVE B,DIRNUM ;Directory number WARN TXO A,CO%NRJ ;Close it but keep the JFN CLOSF% JFATAL HRRZS A ;Just JFN again CALL RENBAX ;Rename to bad mail file MOVEI B,STRBUF ;Ptr to name of new file WARN < Renamed to %2W> RET ;; Here if OPENF% fails for file MPFLOE: CAIE A,OPNX9 ;If not invalid simultaneous access TXNN B,OF%WR ;And asking for write JRST MPFOE1 MOVE A,(P) ;Try once more MOVEI B,OF%RD ;With just read OPENF% SKIPA JRST MAPFL1 ;Succeeded this way, use it MPFOE1: POP P,A RLJFN% JWARN ADJSP P,-1 ;Clear OPENF% bits RET ;;; Free storage ;;; Format of free list is FREHDR,,forward-link ? size,,backward-link ... ;;; ... FRETAI,,0 ;;; format of allocated entry is ALCHDR,,size ? ... ? ALCTAI,,0 FREHDR== FRETAI== ALCHDR== ALCTAI== ;;; Routine to check the integrity of a free space block. Requires the ;;; header and tail to match and the tail to point to the header ; Entry: b = adr of block to check ; Call: CALL CHKBLK ; Return: +1, block format is bad ; +2, format OK - allocated block ; +3, format OK - free block CHKBLK: HLRZ T,(B) ;t =: block header type CAIN T,FREHDR ;Free block? JRST CHKBLF ;Yes, check the rest CAIE T,ALCHDR ;Allocated block? RET ;No??? HRRZ T,0(B) ;t =: size of allocated block ADDI T,1(B) ;t =: adr of tail word HLRZ TT,0(T) ;tt =: block tail type HRRZ T,0(T) ;t =: ptr to head CAIN TT,ALCTAI ;Allocated block tail? CAIE T,0(B) ;And ptr really to head of block? RET ;No??? RETSKP ;Good allocated block, return +2 ;;; Here to check out a free block tail CHKBLF: HLRZ T,1(B) ;t =: size of free block ADDI T,1(B) ;t =: adr of tail word HLRZ TT,0(T) ;tt =: block tail type HRRZ T,0(T) ;t =: ptr to head CAIN TT,FRETAI ;Free block tail? CAIE T,0(B) ;And ptr really to head of block? RET ;No??? R2SKP: AOS (P) ;Do one skip JRST RSKP ;and then a normal skip return ;;; Allocate a block, given size in A, ;;; Returns +1 failure, +2 address of block in B, real size in A ALCBLK: JSR SAVACS ;Save all ACs CAIGE A,5 ;Minimum size MOVEI A,5 MOVEI C,FREPTR ;Start by pointing to free list ALCBLL: HRRZ B,(C) ;Get link word JUMPE B,ALCBPG ;End of list, need a whole new page HLRZ D,1(B) ;Size of free block CAIL D,(A) ;Large enough? JRST ALCBLF ;Yes, found winner MOVEI C,(B) ;Too small, setup to try next one JRST ALCBLL ;; Now have block in B, previous in C, size in D, user's size still in A ALCBLF: CALL CHKBLK ;Check block integrity NOP ;+1, block type bad FATAL ;+2, allocated block CAIG D,5(A) ;Size close enough to desired? JRST ALCBLR ;Yes, no need to split MOVEI E,(B) ;Get copy of address of block HRLM A,1(B) ;Store new size of block to be returned ADDI E,2(A) ;Address of start of other block HRRZ T,(B) ;Old forward link HRRM E,(B) ;Second is forward link for first one IFE. T HRLM E,FREPTR ELSE. HRRM E,1(T) ENDIF. HRLI T,FREHDR MOVEM T,(E) ;Old forward is forward link of second block MOVSI T,FRETAI HRRI T,(B) MOVEM T,-1(E) ;Store end of first block SUBI D,2(A) ;New size of rest of block EXCH D,A ;D should have size of block we are returning HRLI A,(B) MOVSM A,1(E) ;Backward link of second block is first block ADDI A,1(E) HRRM E,(A) ;Update pointer to start of block ALCBLR: HRRZ T,(B) ;Forward link of this block HRRM T,(C) ;Becomes forward link of our backward link IFE. T HRLM C,FREPTR ELSE. HRRM C,1(T) ;Its backward link is our former backward link ENDIF. MOVEM D,A-ACBASE(P) ;Return real size in A MOVSI T,ALCHDR HRRI T,(D) MOVEM T,(B) ADDI B,1 ;User should see block, not header MOVEM B,B-ACBASE(P) ;Return address in B MOVSI A,0(B) ;Compose BLT pointer to clear block HRRI A,1(B) SETZM 0(B) ;Clear first word ADDI B,(D) ;Address of end CAIL D,2 ;If multiple words, BLT A,-1(B) ; clear rest of block MOVEI T,ALCTAI HRLM T,(B) ;Mark end as used too RETSKP ;Skip return ;; Need to allocate a whole other page ALCBPG: PUSH P,A ;Save desired size ADDI A,1003 ;Round to page and have room for headers LSH A,-9 ;Get number of pages needed CALL PAGALC ;Get that many JRST CPOPAJ ;Failed, return failure to whole thing LSH B,9 ;Make address out of it HRRM B,(C) ;Link onto end of list HRLM B,FREPTR ;And save end of free list MOVSI T,FREHDR ;Setup header of block and forward link MOVEM T,(B) LSH A,9 ;Number of words we asked for MOVEI D,-2(A) ;This is the created size HRLM D,1(B) ;Store it HRRM C,1(B) ;Store backward link ADDI A,-1(B) ;End of page MOVSI T,FRETAI HRRI T,(B) MOVEM T,(A) ;Mark end of block POP P,A ;Get back size user requested JRST ALCBLF ;Go return this one ;;; Deallocate a block, address in B FREBLK: JSR SAVACS ;Save all ACs SETO X, ;Flag if link into list someway SUBI B,1 ;Point to real block CALL CHKBLK ;Check block integrity SKIPA ;+1, block type bad SKIPA ;+2, good allocated block FATAL ;+3, free blk HRRZ A,(B) ;Get size of block HLRZ T,-1(B) ;End of previous block, maybe CAIE T,FRETAI ;Check for free entry IFSKP. MOVE C,-1(B) ;Yes, get start of block then PUSH P,B ;Save input block adr HRRZ B,C ;b =: ptr to preceding free block CALL CHKBLK ;Check its integrity NOP ;+1, Bad block FATAL ;+2, Allocated block POP P,B HLRZ D,1(C) ;Get size of previous block ADDI A,2 ;Freeing headers ADDB D,A ;Get new total size HRLM D,1(C) ;Store that ADDI D,1(C) ;End of new big block MOVEM C,(D) ;Store tail there MOVEI B,(C) ;This is the block to use now ADDI X,1 ENDIF. MOVEI C,(A) ADDI C,2(B) ;Address of start of next block, maybe HLRZ T,(C) CAIE T,FREHDR ;Is it? JRST FREBL3 ;No PUSH P,B ;Save input block adr HRRZ B,C ;b =: ptr to preceding free block CALL CHKBLK ;Check its integrity NOP ;+1, Bad block FATAL ;+2, Allocated block POP P,B AOJE X,FREBL2 ;Was it linked to previous? HRRZ D,(C) ;Forward link of block HRRZ E,1(C) ;Backward link IFE. E HRRM D,FREPTR ELSE. HRRM D,(E) ;Splice out this entry since already there ENDIF. IFE. D HRLM E,FREPTR ELSE. HRRM E,1(D) ;Backward link ENDIF. HLRZ D,1(C) ;Get size of block ADDI A,2 ADDB D,A HRLM D,1(B) ;Update size ADDI D,1(B) ;End of new big block HRRM B,(D) ;Store correct starting address JRST FREBLR ;That's all there is to it FREBL2: DMOVE T,(C) ;Start of second block HLRZ D,TT ;Size of block ADDI A,2(D) HRL TT,A ;Update total size DMOVEM T,(B) ;Store as start of this entry TXNN TT,.RHALF HRRI TT,FREPTR HRRM B,(TT) ;Update forward link of backward link IFXE. T,.RHALF HRLM B,FREPTR ELSE. HRRM B,1(T) ;And vice versa ENDIF. ADDI C,1(D) ;End of large block HRRM B,(C) ;Store pointer to start FREBL3: IFL. X ;Already linked in? HRLZM A,1(B) ;Clear backward link, store size HRRZ T,FREPTR ;Old beginning of free list HRRM T,(B) IFE. T HRLM B,FREPTR ELSE. HRRM B,1(T) ;Update backward link of old beginning ENDIF. HRRM B,FREPTR ;New beginning ENDIF. FREBLR: MOVEI T,FREHDR ;Free header HRLM T,(B) ADDI A,1(B) ;End of block MOVEI B,FRETAI HRLM B,(A) ;Free tail RET ;Return ;;; Make a block bigger, address of block in B, length in A ;;; Returns with new address and length GROBLK: JSR SAVACS HLRZ T,-1(B) ;t =: old block header CAILE A,0 ;New length reasonable? CAIE T,ALCHDR ;Old block type right? FATAL ;;;*** This should try to steal from next block *** CALL ALCBLK ;Get a new block RET DMOVE T,A ;Save new results EXCH A,A-ACBASE(P) ;This is what we return EXCH B,B-ACBASE(P) HRLI TT,(B) ;Old,,new ADDI T,(TT) ;End of new block BLT TT,-1(T) ;Transfer data into new block CALL FREBLK ;Release the old block now RETSKP ;;; Set the bit for a particular directory MAIFLG: CALL MAPFLG RET HRRZ A,DIRNUM IDIVI A,^D36 MOVNI B,(B) MOVX C,1B0 LSH C,(B) IORM C,FLGPAG(A) RET ;;; Map in the mailer flags MAPFLG: SKIPGE A,MFLAGP ;Have the mailer flags already? RETSKP ;Yes, don't bother JUMPG A,R ;Cannot get them MOVX A,GJ%OLD!GJ%SHT HRROI B,[ASCIZ/MAIL:MAILER.FLAGS/] GTJFN% IFJER. MOVX A,GJ%OLD!GJ%SHT ;Failed, try on SYSTEM: HRROI B,[ASCIZ/SYSTEM:MAILER.FLAGS/] GTJFN% IFJER. AOS MFLAGP ;Flag that we can't get the flags RET ENDIF. ENDIF. MOVEI B,OF%RD!OF%WR!OF%THW MOVE C,A ;Save JFN away in case OPENF% loses OPENF% IFJER. AOS MFLAGP MOVE A,C ;Get rid of the JFN we got RLJFN% JWARN RET ENDIF. HRLZ A,A MOVE B,[.FHSLF,,FLGPAG/1000] MOVX C,PM%RD!PM%WR PMAP% SETOM MFLAGP ;Flag that we have the flags in RETSKP SUBTTL Host table routines ; The host table is a TBLUK% format table, with the left half of ;each entry pointing to the host name string (in fully expanded ;format) and the right half holding flags ; ; Currently defined flags are HF%PRM==1 ;Permanent table entry HF%DED==2 ;Host was dead recently ; Parse a host name ; Call: CALL HSTNAM ; B/ Pointer to host name ; Returns: ; +1 Host not known ; +2 Success ; B/ Host pointer HSTNAM: SAVEAC STKVAR ,> TXC B,.LHALF ;Is source LH -1? TXCN B,.LHALF HRLI B,() ;Yes, set up byte pointer MOVEI A,HSTTMP ;Make a copy of the host name HRLI A,() CALL MOVST2 ;Make the copy in HSTTMP MOVEI A,HSTTBL ;Point to our table HRROI B,HSTTMP TBLUK% ;Look it up in the cache IFXN. B,TL%EXM ;Found it? HLRZ B,(A) ;Great, get the string address RETSKP ;Return success ENDIF. HRROI A,HSTTMP ;Get the string pointer HRROI B,HSTCAN ;Where to put canonical name MOVEI C,SNDRTS ;Check all protocols known at this point CALL $GTCAN ;Get canonical name, address, and registry IFSKP. MOVEM B,HSTADR ;Success, save host address HRROI A,HSTTMP ;Where to store name SETO B, ;Local host address for this protocol CALL $GTNAM ;Canonicalize the name IFSKP. ;Can't fail most places CAME B,HSTADR ;Is this our local host? ANSKP. MOVEI B,LCLNAM ;Yes, return local host name and be done! RETSKP ENDIF. MOVEI A,HSTCAN ;Make pointer to canonical name in A HRLI A,() ELSE. HRROI A,HSTTMP ;Try for a relay, return canonical name in A CALL $GTRLY RET ENDIF. MOVEM A,HSTPTR ;Save pointer to canonical name MOVEI A,HSTTBL ;Cache header MOVE B,HSTPTR ;Pointer to possible name to add TBLUK% IFXE. B,TL%EXM ;Found it? MOVE A,HSTPTR CALL CPYSTR ;Copy the string HRLZS B ;RH 0 means temporary table entry MOVEI A,HSTTBL ;Point to the table TBADD% ;Add it to table ENDIF. HLRZ B,(A) ;Get the string address RETSKP ;Return success ENDSV. ; Make a host a permanent table entry ; Call: CALL HSTPRM ; B/ Host pointer ; Returns: +1 always. HSTPRM: SAVEAC MOVEI A,HSTTBL TBLUK% TXNE B,TL%NOM!TL%AMB FATAL MOVX B,HF%PRM IORM B,(A) ;Set the right flag RET ; Combination of HSTNAM and HSTPRM. ; Call: CALL PRMHST ; B/ Host string ; returns +1 or +2, like HSTNAM, but also marks host perm if ; it works. PRMHST: CALL HSTNAM RET ;Fail if HSTNAM does SAVEAC HRRO B,B CALL HSTPRM ;Mark it permanent RETSKP ; Clear the table of all temporary entries. ; Call: CALL HSTCLR ; Returns: +1 always HSTCLR: SAVEAC HLRZ C,HSTTBL ;number of entries MOVNS C MOVSS C HRRI C,HSTTBL+1 ;Make an AOBJN pointer MOVEI A,HSTTBL DO. HRRZ B,(C) ;get entries flag IFE. B ;0 = temp entry HLRZ B,(C) ;Get name string block CALL FREBLK ;release the storage MOVEI B,(C) TBDEL% SOS C ;correct pointer for deleted entry ENDIF. AOBJN C,TOP. ENDDO. RET ; Routine to check if a host is known to be dead ; Entry: b = host pointer ; Call: CALL HSTDED ; Return: +1, host dead ; +2, host is alive HSTDED: SKIPN NETF ;Allowed to scan network mail? RET ;No, pretend host is dead SKIPN FSTF ;Slow scan fork? RETSKP ;Yes, no need to scan dead host table SAVEAC MOVEI A,HSTTBL ;Look this one up HRROS B ;Make sure byte pointer TBLUK% TXNE B,TL%NOM!TL%AMB ;Paranoia FATAL HRRZ A,(A) ;Get flags JXN A,HF%DED,R ;Dead? RETSKP ;Else return success ; Routine to add a host to the dead list. ; Entry: FRNHST = host pointer ; Call: CALL ADEADH ; Return: +1 always ADEADH: SKIPN FSTF ;Slow scan? RET ;Yes, no need to do this SAVEAC MOVEI A,HSTTBL HRRO B,FRNHST TBLUK% ;Look it up TXNE B,TL%NOM!TL%AMB FATAL MOVX B,HF%DED IORM B,(A) ;Set the right flag RET ; Routine to remove all dead host flags from the list ; Call: CALL NDHOST ; Return: +1 always NDHOST: HLRZ A,HSTTBL ;Get length MOVNS A ;(Better be at least one) MOVSS A HRRI A,HSTTBL+1 ;Make an AOBJN pointer MOVX B,HF%DED DO. ANDCAM B,(A) ;Clear the flag AOBJN A,TOP. ;and loop ENDDO. RET SUBTTL Parser ;;; Initialize parser, called with starting address in B, byte count in C PARINI: HRLI B,() DMOVE X,B RET ;;; Parse a single line PARLIN: TXZ F,FP%FF!FP%CLN!FP%EOL!FP%DEL!FP%WSP SETZM PDELB2 ;Filter for malformed pairs DO. DMOVEM X,PLINBP ;Save start of line DO. DMOVEM X,PWSPBP SOJL Y,R ILDB D,X ;Get first character CAIE D,.CHTAB ;Leading whitespace? CAIN D,.CHSPC IFNSK. TXO F,FP%WSP ;Yes, note it LOOP. ;And continue ENDIF. ENDDO. IFXE. F,FP%FF ;Seen formfeed yet? CAIE D,.CHFFD ;No, is there one now? IFSKP. TXO F,FP%FF TXZ F,FP%BKA!FP%EQU ;Clear special flags LOOP. ENDIF. ELSE. IFXE. F,FP%EQU!FP%BKA ; Seen one of these yet? CAIE D,"=" ;Equal sign? IFSKP. TXO F,FP%EQU ;Yes LOOP. ENDIF. CAIE D,"_" ;Backarrow? IFSKP. TXO F,FP%BKA ;Yes LOOP. ENDIF. ENDIF. ENDIF. ENDDO. CAIN D,.CHCRT ;End of line? IFSKP. DO. CAIE D,.CHDEL IFSKP. TXON F,FP%DEL ;Rubout within line is start of host IFSKP. SKIPN PDELB2 ;Matching pair? IFSKP. SETOM PDELB2 ;No, flag error ELSE. DMOVEM X,PDELB2 ENDIF. ELSE. DMOVEM X,PDELBP ENDIF. ELSE. CAIN D,":" TXOE F,FP%CLN IFSKP. DMOVEM X,PCLNBP ;Save pointers when got to colon ENDIF. ENDIF. SOJL Y,R ILDB D,X CAIE D,.CHCRT LOOP. ENDDO. ELSE. TXO F,FP%EOL ENDIF. SOJL Y,R ILDB D,X ;Skip lf too SKIPG PDELB2 ;Matching set? TXZ F,FP%DEL ;No, ignore any seen RETSKP ;;; Parse a keyword from table in A ;;; Returns +1 failure, else calls routine pointed to by table PARKEY: IFXN. F,FP%CLN ;Line had a colon in it? MOVE D,PCLNBP ;Yes, use byte pointer of colon then ELSE. SETO D, ADJBP D,X ENDIF. LDB TT,D ;Get character that terminates atom SETZ T, DPB T,D ;Replace it with null MOVE T,0(A) ;t := aobjn ptr to lookup table PARKY2: HLRZ A,0(T) ;a := ptr to next table entry HRLI A,() MOVE B,PLINBP ;Start of line CALL STRCMP ;Match? AOBJN T,PARKY2 ;No, try the next DPB TT,D ;Replace character JUMPGE T,R ;If no match, return HRRZ A,(T) ;Get entry JRST (A) ;Go call that routine ;;; Get pointers for this line PARSTR: DMOVE C,PLINBP PARST1: SUB D,Y SUBI D,2 ;Number of chars less CRLF RET ;;; Make lengths of fields in line with rubout relative PARDEL: MOVE T,PLINBP+1 ;Start of line MOVE TT,PDELBP+1 SUB T,TT SUBI T,1 ;Less rubout itself MOVEM T,PLINBP+1 MOVE T,PWSPBP+1 SUB T,TT SUBI T,1 MOVEM T,PWSPBP+1 MOVE T,PDELB2+1 SUB TT,T SUBI TT,1 MOVEM TT,PDELBP+1 SUB T,Y SUBI T,2 ;Less CRLF MOVEM T,PDELB2+1 RET ;;; Return a host index for string in C and D, returns as HSTNAM PARHLN: CALL PARSTR ;Get pointers for this line PARHST: MOVE B,[POINT 7,HSTBUF] DO. ILDB A,C ;Copy string IDPB A,B CAIE A,.CHNUL ;Quit on null SOJG D,TOP. ;Or count ENDDO. SETZ A, ;Fill out with nulls DO. IDPB A,B TXNE B,76B4 LOOP. ENDDO. MOVE B,[POINT 7,HSTBUF] CALLRET HSTNAM ;Go try to parse host name SUBTTL Queue file handling ;;; Structure of a queue file entry: MSGPAG==0 ;Count,,starting page mapped into MSGJFN==1 ;Flags,,JFN for it MSGFHS==2 ;Foreign host MSGHDR==3 ;Byte pointer of start of headers MSGHCN==4 ;Count of bytes in that MSGTXT==5 ;Byte pointer of start of text MSGTCN==6 ;Count of bytes in that MSGNHD==7 ;Count,,addr of headers for this network MSGRCP==10 ;Network recipients MSGLCL==11 ;Local recipients MSGSDR==12 ;Sender of msg MSGWRT==13 ;Time msg was queued MSGAFT==14 ;Time to start attempting message delivery MSGNTF==15 ;Time to tell sender of delivery status MSGDEQ==16 ;Time to dequeue the msg -- dead letter MSGTMT==17 ;Time limit for sending whole msg (msec) MSGTMC==20 ;Time limit for sending one copy (msec) MSGDOP==21 ;Delivery options MSGRPT==22 ;Return path MSGLEN==23 ;Length of entry ;;; Global flags for msg handling (lh of MSGJFN) FG%XER==1B0 ;Discard file on error (hard failure or ;dequeue time-out) ;;; Structure of host entry: HSTFLG==0 ;Flags,,link to next FH%DON==1B0 ;Host done FH%DN1==1B1 ;Host about to be done ;;; Flags for "sender" specification (used in sender host block) FS%BKA==1B2 ;Sender specified in mail file preamble FS%RMF==1B3 ;Sender from "ReSent-From:" line FS%SDR==1B4 ;Sender from "Sender:" line FS%FRM==1B5 ;Sender from "From:" line FS%RPL==1B6 ;Sender from "Reply-to:" line FS%NTM==1B7 ;"Mail-from:" net host line seen FS%MLA==1B8 ;"Mail Agent" is the default sender HSTHST==1 ;Host pointer HSTRCP==2 ;Recipients HSTLEN==3 ;Length of entry ;;; Structure of recipient entry: RCPFLG==0 ;Flags,,link to next FR%FAI==1B0 ;Hard failure FR%TMP==1B1 ;Temporary failure FR%ERM==1B2 ;There is a consed up error FR%STR==1B3 ;Name is consed locally FR%MLA==1B4 ;Recip = mail agent and failed FR%SDR==1B5 ;Recip = sender and failed RCPBPT==1 ;Byte pointer to name RCPCNT==2 ;Byte count RCPERR==3 ;Error message RCPLEN==4 ;Length of entry ;;; Get a queue file JFN in A, returns +1 if failure, +2 with file entry in M GETQUE: JSR SAVACS ;Save all ACs MOVEI B,(A) HRROI A,STRBUF SETZ C, JFNS% HRROI B,STRBUF ;Must get another JFN CALL MAPQFL RET ;Failed, return CALL PARINI ;Initialize parser PUSH P,A ;Save JFN MOVEI A,MSGLEN CALL ALCBLK ;Allocate a block for message IFNSK. POP P,A ;Restore JFN CALL UNMQU0 ;Unmap file and return NOP RET ENDIF. MOVEI M,(B) ;Pointer to block POP P,MSGJFN(M) ;Save JFN MOVEM M,M-ACBASE(P) ;Return that too MOVEM D,MSGPAG(M) ;Page info SETZM MSGFHS(M) SETZM MSGNHD(M) SETZM MSGRCP(M) ;Initialize recipient pointers SETZM MSGLCL(M) SETZM MSGSDR(M) SETZM MSGAFT(M) ;Clear default after interval SETZM MSGNTF(M) ;Clear delivery status notification time SETZM MSGDEQ(M) ;Clear default dequeue time for msg SETZM MSGDOP(M) ;Clear delivery options SETZM MSGRPT(M) ;Clear return path SKIPN A,DAEMNP ;Running as daemon? IFSKP. SKIPE RXMF ;Doing a retransmission? IFSKP. TIME% ;No, log xmit time limit for whole msg ADD A,TMTINT ELSE. SETZ A, ;No overall time limit for retransmissions ENDIF. ENDIF. MOVEM A,MSGTMT(M) ;Record it SETZM MSGTMC(M) ;Clear xmit time limit/msg copy HRRZ A,MSGJFN(M) ;Get file write date CALL .GFWDT MOVEM B,MSGWRT(M) CALL GDFSDR ;Set up the default sender FATAL MOVE A,MPP ;From here on, return +2 on error AOS (A) MOVE A,FILIDX ;a := current file type index HLRZ A,%FLPRC(A) ;a := processing dispatch for header JRST 0(A) ;Do it ;; Here to fake a header for xxx. files GQUEUN: PUSH P,X ;Save the current msg string info PUSH P,Y HRROI A,STRBUF ;a := buffer for the extension info HRRZ B,MSGJFN(M) ;b := msg file JFN MOVSI C,000100 ;Print extension only JFNS% MOVE A,[POINT 7,STRBUF] ;Now scan the string for the host name MOVE B,A SETZB X,Y ;Init host ptr and string length DO. ILDB C,B ;c := next char IFN. C ;While non-null CAIN C,.CHCNV ;^V? LOOP. ;Yes, ignore it CAIE C,"@" ;Start of host? IFSKP. SETZ C, ;Yes, clobber the "@" with a null IDPB C,A MOVE X,A ;Save start of string LOOP. ENDIF. IDPB C,A ;Store the char AOJA Y,TOP. ;Count the char and do the next ENDIF. SKIPN X ;"@" seen? MOVE X,A ;No, update host ptr CAME A,X ;Is host null? IFSKP. MOVE B,[POINT 7,LCLNAM] ;No, use local name LOOP. ENDIF. ENDDO. MOVE B,A ;OK, terminate edited string IDPB C,B ;;;Now we create a fake header (as if [--QUEUED-MAIL--]) MOVE A,[POINT 7,OMLRBF] ;a := place to build it MOVEI B,.CHFFD ;Start with ^L IDPB B,A MOVE B,X ;b := ptr to host string SETZ C, SOUT% ;(Have to SOUT% - not word boundary) MOVEI B,CRLF0 CALL MOVSTR MOVEI B,STRBUF ;Add CALL MOVSTR MOVEI B,CRLF0 CALL MOVSTR MOVEI B,.CHFFD ;And finish with ^L IDPB B,A MOVEI B,CRLF0 CALL MOVST0 MOVE X,[POINT 7,OMLRBF] ;Now set to scan the string ADDI Y,^D8+1 ;Account ^L's and 's in length ;(and 1 so PARLIN thinks a msg follows) ; JRST GQUEQM ;Drop into common code ;; Parse the head of the file GQUEQM: CALL PARLIN ;Get a line from the file JRST QUEEOF ;Premature eof IFXE. F,FP%FF ;Was a formfeed seem? CALL QUEBAD ;No, bad format file HRROI B,[ASCIZ/Invalid queued mail file format in line "/] JRST QUEBP0 ;Toss the losing file out ENDIF. ;; Now parse the message recipients GQUERC: IFXN. F,FP%EOL ;Empty line? JXN F,FP%EQU,QUEBPM ;Error if control parameter specification JXE F,FP%BKA,GQUEHD ;If not sender, must be start of actual msg MOVEI B,LCLNAM ;Default sender host to us JRST GQUSDR ;Set up new sender spec ENDIF. TXNE F,FP%EQU ;Control parameter specification? JRST GQUPRM ;Yes, decode it CALL PARHLN ;Get host from name IFNSK. JXE F,FP%BKA,QUEBHS ;If not sender spec, can't win... DO. ;Yes, ignore it CALL PARLIN ;Eat line JRST QUEEOF ;Premature EOF TXNE F,FP%FF ;Started with form? JRST GQUERC ;Yes, done with this LOOP. ;Otherwise eat remainder of specification ENDDO. ENDIF. JXN F,FP%BKA,GQUSDR ;Set up if sender spec SKIPN WOPRP ;WHEEL or OPERATOR? IFSKP. CAIE B,LCLNAM ;Yes, deliver directly if local host IFSKP. MOVEI O,MSGLCL(M) ;Point to local entry JRST GQURC5 ENDIF. ENDIF. PUSH P,B ;Save site entry HRROS B ;Set to check if this host already seen MOVEI N,MSGRCP(M) ;Starting pointer for linked host list GQURC2: HRRZ A,(N) ;a := next host entry on list JUMPE A,GQURC3 ;Quit at end of list MOVEI N,(A) ;n := adr of this host block CAME B,HSTHST(N) ;Host already on list? JRST GQURC2 ;No, check next block POP P,B ;Yes, recover site entry JRST GQURC4 ;Append these users ;; Here when the new host is not already on the recipient list GQURC3: MOVEI A,HSTLEN ;Get a host entry CALL ALCBLK JRST QUEBRT ;Failed, free what we used and return HRRM B,(N) ;Link it in MOVEI N,(B) ;Now the end of the list SETZM HSTFLG(N) POP P,HSTHST(N) ;Save host pointer SETZM HSTRCP(N) ;Init recipient list GQURC4: MOVEI O,HSTRCP(N) ;This is the start of the recipients GQURC5: HRRZ A,(O) ;a := next recipient entry on list JUMPE A,GQURC1 ;Quit at end of the list MOVEI O,(A) ;o := adr of this recipient block JRST GQURC5 ;Try another ;; Here to process the next input line... GQURC1: CALL PARLIN ;Get a line JRST QUEEOF ;Premature eof TXNE F,FP%FF ;Started with form? JRST GQUERC ;Yes, next host then TXNE F,FP%EOL ;End of line? JRST GQURC1 ;Yes, ignore it and try another MOVEI A,RCPLEN ;Get block for this recipient CALL ALCBLK JRST QUEBRT ;Failed, return HRRM B,(O) ;Link it in MOVEI O,(B) ;Now the end of the list SETZM RCPFLG(O) ;Clear flags CALL PARSTR ;Limits of string DMOVEM C,RCPBPT(O) ;Save them JRST GQURC1 ;; Here when sender spec encountered. b = host site tbl adr GQUSDR: PUSH P,[0] ;Save place for user ptr PUSH P,[0] PUSH P,B ;Save host adr (until we have a user) GQUSD0: CALL PARLIN ;Get a line IFNSK. ADJSP P,-3 ;Premature eof JRST QUEEOF ENDIF. TXNE F,FP%FF ;Started with form? JRST GQUSD1 ;Yes, record what we have TXNE F,FP%EOL ;End of line? JRST GQUSD0 ;Yes, ignore it and try another CALL PARSTR ;OK, get limits of string DMOVEM C,-2(P) ;Save them TXZE F,FP%BKA ;First user entry? JRST GQUSD0 ;Yes, see if there are anymore JRST GQUSDB ;Too many, bad sender spec ;; Here when new line starting with FF GQUSD1: JXN F,FP%BKA,GQUSDB ;Exactly one sender? HRRZ B,MSGSDR(M) ;OK, b := adr of host entry block MOVX A,FS%MLA ;Clear "mlagnt" bit if on ANDCAM A,HSTFLG(B) MOVX A,FS%BKA ;Set "_sender" bit IORM A,HSTFLG(B) POP P,HSTHST(B) ;Install new sender host HRRZ B,HSTRCP(B) ;b := adr of recipient entry block POP P,RCPCNT(B) ;Install new byte count POP P,RCPBPT(B) ;and byte ptr SETZM RCPERR(B) ;Clear error JRST GQUERC ;Now see about the next host ;; Now finish up, remembering where the headers start GQUEHD: MOVE A,FILIDX ;a := index to current file type HRRZ A,%FLPRC(A) ;a := processing dispatch for msg JRST 0(A) ;Do it GQUEH0: POP P,Y ;Recover ptr info for msg text itself POP P,X GQUEH1: DMOVEM X,MSGHDR(M) CALL FNDSDR ;Find sender by parsing msg headers MOVE P,MPP ;Undo extra pushes RETSKP ;Skip return from it all ;;; Here to process file processing parameter specifications. These are ;;; of the form =: GQUPRM: MOVEI A,QUEPTB ;Lookup in parameter keyword table CALL PARKEY JRST QUEBPM ;Bad luck... JRST GQURC1 ;Got it, continue processing ;;; Here to fetch return path QUERPT: DMOVE C,PCLNBP ;Rest of line after colon CALL PARST1 SKIPN A,D ;Length of string RETSKP ;Return path null? Ignore it I guess IDIVI A,5 ;Size in words ADDI A,1 ;Add an extra word for remainder and null pad CALL ALCBLK RETSKP ;Don't care all that much MOVEM B,MSGRPT(M) ;Save pointer to block HRLI B,() ;Make byte pointer QUERP1: ILDB A,C ;Copy string IDPB A,B SOJG D,QUERP1 ;Continue until count exhausted IDPB D,B ;Tie off string with null RETSKP ;;; Here to fetch delivery options QUEDEL: DMOVE C,PCLNBP ;Rest of line after colon CALL PARST1 CAIE D,4 ;Is string 4 characters precisely? RET ;No, can't be valid ADJBP D,C ;Pointer to delimeter byte ILDB TT,D ;Get delimiter byte SETZ T, ;Make it null-terminated DPB T,D MOVEI A,QUEDOP ;Lookup in parameter keyword table MOVE B,C TBLUK% DPB TT,D ;Put delimiter back TXNE B,TL%NOM!TL%AMB ;Bad delivery option? RET HRRZ B,(A) ;Get delivery options table code MOVEM B,MSGDOP(M) RETSKP QUEDOP: NQDOPS,,NQDOPS DOPTAB: PHASE 0 [ASCIZ/MAIL/],,. ;Mail (MUST BE FIRST IN TABLE!!!!!!!!) D%SAML:![ASCIZ/SAML/],,. ;Send and mail D%SEND:![ASCIZ/SEND/],,. ;Send D%SOML:![ASCIZ/SOML/],,. ;Send or mail DEPHASE NQDOPS=.-DOPTAB ;;; Here to fetch physical host that connected to us QUEHST: DMOVE C,PCLNBP ;Rest of line after colon CALL PARST1 CALL PARHST ;Parse the host name SETZ B, ;Failed, ignore it (shouldn't happen) MOVEM B,MSGFHS(M) RETSKP ;;; Here to fetch time to attempt network retransmissions QUEAFT: CALL GQUTIM ;Decode the time value RET ;No go MOVEM B,MSGAFT(M) ;Save it RETSKP ;And success return ;;; Here to fetch time to notify sender of transmission status QUENTF: CALL GQUTIM ;Decode the time value RET ;No go MOVEM B,MSGNTF(M) ;Save it RETSKP ;And success return ;;; Here to fetch time to notify sender of transmission status QUEDEQ: CALL GQUTIM ;Decode the time value RET ;No go MOVEM B,MSGDEQ(M) ;Save it RETSKP ;And success return ;;; Here to set flag for discarding msg without notifying sender if ;;; failed or dequeued. QUEDER: MOVX A,FG%XER ;Set flag IORM A,MSGJFN(M) RETSKP ;And success return ;;; Routine to decode a time value for a control parameter ;;; Return: +1, error ;;; +2, success - value in b GQUTIM: DMOVE C,PCLNBP ;Rest of line after colon CALL PARST1 MOVE A,[POINT 7,STRBF1] ;Temp buffer for time string GQUTI0: ILDB B,C CAIE B,.CHSPC ;Skip starting spaces and tabs CAIN B,.CHTAB IFNSK. SOJG D,GQUTI0 ;Look some more RET ;Unless string exhausted ENDIF. SKIPA GQUTI1: ILDB B,C ;Next char IDPB B,A ;Copy it CAIN B,.CHNUL ;Quit on null JRST GQUTI2 SOJG D,GQUTI1 ;If not end of string, continue MOVEI B,0 ;Else end with null IDPB B,A GQUTI2: HRROI A,STRBF1 ;Now convert the time string IDTIM% RET RETSKP ;;; Table of parameter keywords and processing routines QUEPTB: -NQPRMS,,.+1 [ASCIZ/AFTER/],,QUEAFT ;Formerly RETRANSMIT ; [ASCIZ/DATA/],,QUEDAT [ASCIZ/DELIVERY-OPTIONS/],,QUEDEL [ASCIZ/DEQUEUE/],,QUEDEQ [ASCIZ/DISCARD-ON-ERROR/],,QUEDER ; [ASCIZ/ERROR/],,QUEERR [ASCIZ/NET-MAIL-FROM-HOST/],,QUEHST [ASCIZ/NOTIFY/],,QUENTF [ASCIZ/RETURN-PATH/],,QUERPT NQPRMS=.-QUEPTB-1 ; Routine to set up the default sender for a msg ; Entry: queue file mapped ; Call: CALL GDFSDR ; Return: +1, failure ; +2, OK GDFSDR: HRRZ A,MSGJFN(M) ;a := queue file JFN HRLI A,.GFLWR ;Get its author string HRROI B,FILAUT ;Into filaut buffer GFUST% MOVE A,[FILAUT,,ORGAUT] ;Save original in ORGAUT BLT A,ORGAUT+AUTLEN-1 MOVE N,[POINT 7,MLAGNT] ;Set up mail agent as default author DMOVE A,[POINT 7,FILAUT ;See if it was written by system server POINT 7,DAEDIR] CALL STRCMP ;Was it? IFNSK. MOVX A,RC%EMO ;No, see if looks like a local user name HRROI B,FILAUT RCUSR% ;Parse user name IFNJE. TXNN A,RC%NOM!RC%AMB ;Parsed, does it exist? MOVE N,[POINT 7,FILAUT] ;Yes, set local user as default author ENDIF. ENDIF. PUSH P,N ;Save author on stack MOVEI N,MSGSDR(M) ;n := root for sender host entry blk MOVEI A,HSTLEN ;Get a host entry CALL ALCBLK JRST GDFSDX ;Failed, return +1 HRRM B,0(N) ;Link it in MOVEI N,(B) ;Now the end of the list SETZM B,HSTFLG(N) MOVX A,FS%MLA ;Check if dflt sender = mail agent HRRZ B,(P) CAIN B,MLAGNT ;Is it? IORM A,HSTFLG(N) ;Yes, set the flag MOVEI B,LCLNAM ;b := host site tbl adr MOVEM B,HSTHST(N) ;Save site entry MOVEI O,HSTRCP(N) ;o := start of the sender recipient MOVEI A,RCPLEN ;Get block for this recipient CALL ALCBLK JRST GDFSDX ;Failed, return +1 HRRZM B,(O) ;Link it in MOVEI O,(B) ;Now the end of the list SETZM RCPFLG(O) ;Clear flags MOVE A,(P) ;a := ptr to dflt sender string SETZ B, ;b := str length ILDB C,A ;c := next char CAIE C,.CHNUL ;Quit on null AOJA B,.-2 ;Otherwise count it POP P,A ;a := fresh ptr to sender string DMOVEM A,RCPBPT(O) ;Install the sender name RETSKP ;Return +2 ; Here if error allocating blocks GDFSDX: ADJSP P,-1 ;Reset the stack RET ;Fail return +1 ;;; The following code is to parse the msg headers to find the msg ;;; sender if none was specified by "_sender" in the msg preamble and ;;; the msg file author was DAEDIR. ; Keyword table for locating msg header lines possible containing a ; sender address. FSDRTB: -NFSDR,,.+1 [ASCIZ/RESENT-FROM/],,SDRRMF [ASCIZ/REMAILED-FROM/],,SDRRMF [ASCIZ/REDISTRIBUTED-FROM/],,SDRRMF [ASCIZ/SENDER/],,SDRSDR [ASCIZ/FROM/],,SDRFRM [ASCIZ/REPLY-TO/],,SDRRPL [ASCIZ/MAIL-FROM/],,SDRNTM NFSDR==.-FSDRTB-1 ; Find sender name by parsing message header. Message file mapped ; Entry: m = adr of message block ; x,y = ptr/cnt to start of msg headers ; Call: CALL FNDSDR ; Returns +1 always FNDSDR: HRRZ N,MSGSDR(M) ;n := adr of "sender" recip host block MOVX A,FS%BKA MOVX B,FS%MLA TDNN A,HSTFLG(N) ;Sender from file preamble? TDNN B,HSTFLG(N) ;No, sender = non-DAEDIR file author? RET ;Yes, don't supersede that HRRZ O,HSTRCP(N) ;o := adr of "sender" recipient block SETZM SDRHST ;Init sender temp locs SETZM SDRNAM FNDSD0: CALL PARLIN ;Get a line from the msg text JRST FNDSD1 ;EOF, check out sender TXNE F,FP%EOL ;Empty line? JRST FNDSD1 ;No more header lines, check out sender MOVEI A,FSDRTB ;a := sender spec line keywords TXNE F,FP%CLN ;Colon seen? CALL PARKEY ;Yes, look up this line's keyword JRST FNDSD0 ;+1, no go, move on to next line HRRM B,SDRHST ;Save the new host DMOVEM C,SDRNAM ;Install the new recipient name ptr JRST FNDSD0 ;Loop through rest of headers ; Here when finished with msg headers FNDSD1: DMOVE C,SDRNAM ;c/d := new recipient name ptr/cnt JUMPE C,R ;If highest priority spec failed, quit DMOVEM C,RCPBPT(O) ;Install the new recipient name ptr SKIPN B,SDRHST ;b := sender host site MOVEI B,LCLNAM ;Yes HRRZM B,HSTHST(N) ;Install it RET ;Done ; Following are the routines to check out various "sender" ; specification lines. ; Return: +1, No sender found ; +2, Sender address found ; b = host site tbl entry adr ; c = ptr to sender name string ; d = byte count for sender name ; Here to process "ReSent-From:" line SDRRMF: MOVX A,FS%RMF ;a := flag for this line type IORM A,SDRHST ;Show we've seen one SDRRM0: CALL GTSNDR ;Go scan for the sender JRST SDRXXX ;Error RETSKP ;Success, return +2 ; Here to process "Sender:" line SDRSDR: MOVX A,FS%SDR ;a := flag for this line type IORM A,SDRHST ;Show we've seen one MOVX A,FS%RMF ;Already have higher priority spec? TDNE A,SDRHST RET ;Yes CALLRET SDRRM0 ;Go scan for the sender ; Here to process "From:" line SDRFRM: MOVX A,FS%FRM ;a := flag for this line type IORM A,SDRHST ;Show we've seen one MOVX A,FS%RMF!FS%SDR ;Already have higher priority spec? TDNE A,SDRHST RET ;Yes CALLRET SDRRM0 ;No, go scan for the sender ; Here to process "Reply-to:" line SDRRPL: MOVX A,FS%RPL ;a := flag for this line type IORM A,SDRHST ;Show we've seen one MOVX A,FS%RMF!FS%SDR!FS%FRM ;Already have higher priority spec? TDNE A,SDRHST RET ;Yes CALLRET SDRRM0 ;No, go scan for the sender ; Here to process "Mail-from:" line SDRNTM: MOVX A,FS%NTM ;a := flag for this line type IORM A,SDRHST ;Show we've seen one RET ; Here on error in parsing sender address line SDRXXX: HLLZS SDRHST ;Clear the sender address stuff SETZM SDRNAM RET ; Parse a line for sender's name and host ; Entry: Input line set up to parse ; Call: CALL GTSNDR ; Return: +1, error, no valid address ; +2, success, b = host site, c/d = sender name ptr/cnt GTSNDR: STKVAR TXZ F,FP%LBK!FP%RBK!FP%DQT ;Clear flags DMOVE C,PCLNBP ;Set to scan from ":" CALL PARST1 ;Adjust counts GTSND0: SETZM SDRHSP ;Reset host/name SETZM SDRNPT TXZ F,FP%HST ;Not collecting host yet CALL GTSFLD ;Scan a field of the input string JUMPL B,R ;If questionable char, do error return MOVEM T,SDRNPT ;Save the name ptr/cnt MOVEM TT,SDRNCT TXNN F,FP%SEP ;Special char term? JRST GTSND3 ;Yes ; Here to check for "at" field signalling host name GTSND1: CALL GTSFLD ;Get the next field JUMPL B,R ;Quit on questionable char IFXE. F,FP%SEP ;This field end with separator? SETZM SDRNPT ;No, bad syntax JRST GTSND4 ;Try to make sense of spec char ENDIF. TXZ A,10040 ;Capitalize last two small letters CAIN A,"AT" ;Is it "at"? JRST GTSND5 ;Yes, process host name SETZM SDRNPT ;Random string format, flush ptr GTSND2: CALL GTSFLD ;Look for field ending with a spec char JUMPL B,R ;Quit on error TXNN F,FP%SEP ;This field term with separator? JRST GTSND4 ;No, better be eol or bracket JRST GTSND2 ;Scan further ; Here when hit special char GTSND3: CAIN B,"@" ;At-sign? JRST GTSND5 ;Yes, end name and start host GTSND4: CAIN B,.CHCRT ;End of line? JRST GTSND6 ;Yes CAIE B,.CHDQT ;Start of quoted string? IFSKP. TXOE F,FP%DQT ;Yes, set flag and check for error RET ;Shouldn't be here then JRST GTSND0 ;Start collection over ENDIF. CAIE B,"<" ;Left angle-bracket? IFSKP. TXOE F,FP%LBK ;Yes, mark it and check for earlier one RET ;Can't have more than one JRST GTSND0 ;OK, start over ENDIF. CAIE B,">" ;Right angle-bracket? IFSKP. TXO F,FP%RBK ;Yes, set flag JRST GTSND6 ;Check it out ENDIF. RET ;No, can't make sense of it, bomb! ; Here when saw "@" or "at". Should get host name next GTSND5: CALL GTSFLD ;Get the next field JUMPL B,R ;Quit on weird char JUMPE TT,GTSND4 ;If null string, check terminator MOVEM B,SAVEB ;Save current field info MOVEM C,SAVEC MOVEM D,SAVED DMOVE C,T ;Get ptr to this field CALL PARHST ;Lookup the host name RET ;No go, punt TXON F,FP%HST ;Good host, already have one? MOVEM B,SDRHSP ;No, save this host site entry MOVE D,SAVED ;Restore field scanning information MOVE C,SAVEC MOVE B,SAVEB TXNN F,FP%SEP ;Last field end with separator? JRST GTSND3 ;No, check out special char JRST GTSND1 ;Better be more host stuff! ; Here when done processing line GTSND6: SKIPN SDRNPT ;Find a name? RET ;No TXCE F,FP%LBK!FP%RBK ;Either no <> TXCN F,FP%LBK!FP%RBK ;Or matching set? TRNA ;OK RET ;Bad news MOVE D,SDRNCT ;b,c,d := host site and ptr/cnt MOVE C,SDRNPT MOVE B,SDRHSP RETSKP ;Return +2 - sender found ENDSV. ; Routine to scan for next field in sender address ; Entry: c/d = ptr/cnt to remainder of line ; Call: CALL GTSFLD ; Return: +1, always ; t = starting ptr, tt = char count for field ; a = last 5 chars of field ; b = terminating char ; fp%sep set if terminated by special char GTSFLD: SETZB T,TT ;Clear field string ptr/cnt SETZ A, ;Clear shift reg for last chars in field TXZ F,FP%SEP ;Reset separator flag GTSFL0: CALL GTSCHR ;Get a char JRST GTSFL0 ;+1, ignore leading separators RET ;+2, special char - return MOVE T,C ;+3, regular char - save starting ptr ADD T,[7B5] GTSFL1: ADDI TT,1 ;Bump char counter LSH A,7 ;Accumulate last chars of field IORI A,0(B) CALL GTSCHR ;Get next character TXO F,FP%SEP ;+1, separator - set flag RET ;+2, special char - return JRST GTSFL1 ;+3, regular char - continue collecting ; Get next input character in scanning for sender address. Skips over ; multiple blanks, tabs, and comments (...), checks for allowed special ; chars: "@" "<", ">", or . Other special chars abort the parsing ; and require human intervention to decode the address: ",", ";", or ":". ; Entry: c/d = source byte ptr/cnt ; Call: CALL GTSCHR ; Return: +1, separator seen, b = space ; +2, special character, b = character ; +3, normal character, b = character ; Updates c/d appropriately GTSCHR: CALL GTSLDB ;Fetch a byte JRST GTSCH4 ;eol IFXN. F,FP%DQT ;Quoted string? CAIE B,.CHDQT ;Yes, ending now? JRST R2SKP ;No, take char as is TXZ F,FP%DQT ;Turn off quote flag JRST GTSCH1 ;And make like it is a separator ENDIF. CAIE B,.CHSPC ;Space? CAIN B,.CHTAB ;Tab? JRST GTSCH1 ;Yes CAIN B,"(" ;Start of comment? JRST GTSCH2 ;Yes CALL CHKSPC ;Address punctuation? RETSKP ;Yes, return +2 JRST R2SKP ;No, treat as regular char, return +3 ; Here to process separators GTSCH1: CALL GTSLDB ;Fetch a byte JRST GTSCH4 ;EOL CAIE B,.CHSPC ;Space or tab? CAIN B,.CHTAB JRST GTSCH1 ;Yes, skip over it CAIE B,"(" ;Start of comment? JRST GTSCH3 ;No, end of separator ; Here to skip over a comment (...) GTSCH2: CALL GTSLDB ;Fetch a byte IFNSK. SETO B, ;eol before matching ")", fail RETSKP ;Return +2 (special char) ENDIF. CAIN B,")" ;End of comment? JRST GTSCH1 ;Yes, back to skipping separtors JRST GTSCH2 ;Find end of comment ; Here on end of a separator GTSCH3: CALL CHKSPC ;Special char after the separator? RETSKP ;Yes, return it +2 MOVEI B,.CHSPC ;Return " " for separator ADD C,[7B5] ;Back up input ptr/cnt AOJA D,R ; Here on end of line GTSCH4: MOVEI B,.CHCRT ;b := RETSKP ;Return +2 (special char) ; Routine to fetch a byte from a sender line. Ignores null's and del's. ; Entry: c/d = ptr/cnt to input line ; Call: CALL GTSLDB ; Return: +1, eol encountered ; +2, b = next char GTSLDB: SOJL D,R ;EOL if count exhausted ILDB B,C ;b := next char TXNE F,FP%DQT ;Quoted string? RETSKP ;Yes, return whatever it is CAIE B,.CHNUL ;Null? CAIN B,.CHDEL ;Or DEL JRST GTSLDB ;Yes, ignore it RETSKP ;Got a char, return +2 ; Routine to categorize special chars ; Entry: b = char ; Call: CALL CHKSPC ; Return: +1, char part of address punctuation ; +2, char not part of punctuation CHKSPC: TXNE F,FP%DQT ;Quoted string? RETSKP ;Yes, char can't be special CAIN B,.CHDQT ;Start of quoted string? RET ;Yes CAIE B,"<" ;Part of <> address subfield? CAIN B,">" RET ;Yes CAIN B,"@" ;Start of host field? RET ;Yes CAIE B,"," ;Human intervention required? CAIN B,";" JRST CHKSP0 ;Yes CAIN B,":" ;Human intervention required? JRST CHKSP0 ;Yes RETSKP ; Here char is not a recognized punctuation char but is not part of ; regular name either.. CHKSP0: SETO B, RET ;; Premature EOF QUEEOF: CALL QUEBAD ;Setup message back to luser HRROI B,[ASCIZ/Premature end of file, /] SOUT% JRST QUEBDR ;Finish up ;; Bad control parameter specification QUEBPM: CALL QUEBAD HRROI B,[ASCIZ/Bad control parameter in line "/] QUEBP0: SOUT% CALL PARSTR MOVE B,C MOVN C,D SOUT% SETZ C, JRST QUEBH1 ;; Here on invalid sender spec GQUSDB: CALL QUEBAD ;Too many, set up neg ack file HRROI B,[ASCIZ/Invalid sender specification. /] SETZ C, ;Print the bad news SOUT% JRST QUEBDF ;Abort ;; Bad host QUEBHS: CALL QUEBAD HRROI B,[ASCIZ/No such host as "/] SOUT% HRROI B,HSTBUF SOUT% QUEBH1: HRROI B,[ASCIZ/", /] SOUT% QUEBDR: SKIPE MSGJFN(M) SKIPN MSGPAG(M) IFSKP. HRROI B,[ASCIZ/bad queue file follows: ------- /] SETZ C, SOUT% PUSH P,A HRRZ A,MSGJFN(M) SIZEF% IFNSK. HLRZ B,MSGPAG(M) IMULI B,5000 ENDIF. POP P,A MOVN C,B HRRZ B,MSGPAG(M) IMULI B,1000 HRLI B,() SKIPGE C SOUT% HRROI B,[ASCIZ/ ------- /] SETZ C, SOUT% CLOSF% JFATAL HRRZ A,MSGJFN(M) ;Get back file jfn PUSH P,A ;Save it TXO A,CO%NRJ CALL UNMQUF ;Unmap NOP POP P,A ;And get rid of it DELF% JWARN JRST QUEBRT ENDIF. HRROI B,[ASCIZ/ file renamed to /] SOUT% QUEBDF: CALL RENBAD ;Rename file as bad HRROI B,STRBUF SETZ C, SOUT% HRROI B,[ASCIZ/ ------- /] SOUT% CLOSF% JFATAL ;; Bad return QUEBRT: CALL RELQUE ;Free entry MOVE P,MPP ;Undo excess pushes RET ;Single return ;;; Release storage from queue entry in M RELQUE: PUSH P,A PUSH P,B PUSH P,N PUSH P,O HRRZ B,MSGNHD(M) ;Are there any headers allocated? SKIPE B CALL FREBLK HRRZ A,MSGJFN(M) CALL UNMQUF ;Unmap queue NOP ;Can't happen SKIPE N,MSGRCP(M) ;Any network recipients? CALL RELQHS ;Yes, release the list buffers SKIPE O,MSGLCL(M) ;Local recipients? CALL RELQLS ;Yes, release them SKIPE N,MSGSDR(M) ;Any "sender" specification? CALL RELQHS ;Yes, release it SKIPE B,MSGRPT(M) ;Any return path specification? CALL FREBLK ;Free the return path MOVEI B,(M) ;Release the message block itself CALL FREBLK POP P,O POP P,N JRST POPBAJ ; Routine to chase down a list of hosts/recipients, releasing the ; free space blocks in use. ; Entry: n = adr of first host entry ; Call: CALL RELQHS ; Return: +1 RELQHS: DO. SKIPE O,HSTRCP(N) ;Any recipients for this host? CALL RELQLS ;Yes, release them MOVEI B,(N) HRRZ N,HSTFLG(N) ;Link to next CALL FREBLK ;Free this host block JUMPN N,TOP. ;Do them all ENDDO. RET ; Routine to chase down a list of recipients, releasing the free space ; blocks in use for names and error msgs ; Entry: o = adr of first recipient entry ; Call: CALL RELQLS ; Return: +1 RELQLS: DO. MOVX B,FR%ERM ;Consed error message TDNN B,RCPFLG(O) IFSKP. MOVE B,RCPERR(O) ;b := error message block adr CALL FREBLK ;Free it up ENDIF. MOVX B,FR%STR ;Locally generated string for name? TDNN B,RCPFLG(O) IFSKP. HRRZ B,RCPBPT(O) ;Yes, can free it then CALL FREBLK ENDIF. MOVEI B,(O) HRRZ O,RCPFLG(O) ;Link to next one CALL FREBLK ;Free this recipient block JUMPN O,TOP. ;Do them all ENDDO. RET ; Routine to reset the error flags for a recipient ; Entry: o = adr of recipient block ; Call: CALL RSTRCP ; Return: +1, flags cleared and error msg block freed ; No AC's clobbered RSTRCP: SAVEAC MOVX B,FR%ERM ;Consed error message? TDNN B,RCPFLG(O) IFSKP. MOVE B,RCPERR(O) ;b := error message? CALL FREBLK ;Free it up ENDIF. MOVX B,FR%FAI!FR%TMP!FR%ERM ;Clear the error flags ANDCAM B,RCPFLG(O) RET ; Routine to update error information for all recipients at a given ; host. If error message is already present, it is left as is unless ; the severity of the error increases from TMP to FAI. ; Entry: b = error flags ; strbuf = error msg ; saven = ptr to host block ; Call: CALL STUMSG ; Return: +1 always STUMSG: SKIPG N,SAVEN ;n := ptr to starting recipient host RET ;None MOVEI O,HSTRCP(N) ;o := recipient list adr for this host STUMS0: DO. CALL NXTRCP ;Get the next recipient RET ;No more, quit JN FR%FAI,RCPFLG(O),TOP. ;Leave alone if recipient already lost hard TXNE B,FR%FAI ;Increasing soft to hard? CALL RSTRCP ;Yes, clear out the old stuff CALL STEMSG ;Install new failure flags and msg LOOP. ;Do next recipient ENDDO. ; Routine to install failure information for addressee ; Entry: b = error flags ; strbuf = error msg (attached to user if FR%ERM on in b) ; o = adr of recipient block ; Call: CALL STEMSG ; Return: +1 always STEMSG: SAVEAC JN FR%FAI,RCPFLG(O),R ;Leave alone if recipient already lost hard IFXN. B,FR%ERM ;Append error msg now? ANDQE. FR%ERM,RCPFLG(O) ;Yes, but not if a message installed already MOVEI A,STRBUF ;a := ptr to last response PUSH P,B ;Save flags CALL CPYSTR ;Get a copy MOVEM B,RCPERR(O) ;Install it POP P,B ENDIF. IORM B,RCPFLG(O) ;Flag failure type RET ; Routine to set up an appropriate failure msg for all hosts/recipients ; using the information already collected for hosts that were processed. ; If this is to dequeue the msg file, all errors become hard. If it is ; just to notify the sender, temporary errors are conjured up. Default ; errors are used when none came out of the processing. ; Entry: m = adr of message block ; Call: CALL SERRCP ; Return: +1 SERRCP: JSR SAVACS ;Save the ac's MOVE A,[POINT 7,STRBUF] ;Set up default error msg MOVEI B,[ASCIZ/Cannot append to mailbox/] CALL MOVST0 MOVEI O,MSGLCL(M) ;Do locals first TXO F,FQ%DON ;We must have done the locals CALL SERRLS ;Hack this list MOVE A,[POINT 7,STRBUF] ;Set up default error msg MOVEI B,[ASCIZ/Cannot connect to host/] CALL MOVST0 MOVEI N,MSGRCP(M) ;Now scan net recipients DO. HRRZ N,(N) ;n := next host block adr JUMPE N,R ;Quit on 0 MOVX B,FH%DON ;"Host done" set? TDNN B,HSTFLG(N) TXZA F,FQ%DON ;No, clear flag TXO F,FQ%DON ;Yes, record fact SKIPG NTDEQF ;Dequeueing msg? IORM B,HSTFLG(N) ;Yes, always show host done MOVEI O,HSTRCP(N) ;Do recipients for this host CALL SERRLS LOOP. ;Do all hosts ENDDO. ; Routine to scan a list of recipients and install failure/error ; Entry: o = adr of recipient list ; strbuf = default error string if none already given ; Call: CALL SERRLS ; Return: +1 SERRLS: DO. HRRZ O,(O) ;o := adr of next recipient JUMPE O,R ;Done with list MOVE A,RCPFLG(O) ;Fetch recipient flags JXN A,FR%FAI,TOP. ;Ignore if hard error already seen IFXE. A,FR%TMP ;Any temporary error seen? JXN F,FQ%DON,TOP. ;No, if host processed, assume recipients ok ENDIF. MOVX B,FR%ERM!FR%TMP ;If notifying sender, leave error temporary SKIPL NTDEQF ;Dequeueing msg? IFSKP. ANDCAM B,RCPFLG(O) ;Yes, clear "temporary" error indicators MOVX B,FR%ERM!FR%FAI ;And make error hard ENDIF. CALL STEMSG ;Set the error message LOOP. ;Do all recipients at this host ENDDO. ; Here to unmap a queued msg file UNMQUF: MOVE D,MSGPAG(M) CALL UNMQU0 SKIPA AOS (P) SETZM MSGJFN(M) SETZM MSGPAG(M) RET UNMQU0: JUMPE D,UNMQU1 PUSH P,A HLRZ A,D HRRZ B,D CALL PAGDAL POP P,A UNMQU1: JUMPE A,R TXZN A,CO%NRJ ;Don't release JFNs? IFSKP. PUSH P,A ;Yes, save JFN HRROI A,STRBF1 ;Buffer to put filename string into HRRZ B,(P) ;JFN to release MOVE C,[111110,,JS%PAF] ;Dev/dir/nam/ext/gen, punctuate JFNS% ;Get string for this file IFJER. ADJSP P,-1 RET ;In case JFN already released somehow ENDIF. MOVX A,GJ%SHT!GJ%OLD!GJ%DEL ;Now get another JFN HRROI B,STRBF1 ;On the same filename GTJFN% ;Get virgin JFN in A IFJER. POP P,A ;Get back JFN CLOSF% ;Flush it NOP ;Don't care if it failed RET ENDIF. POP P,B ;Old JFN in B SWJFN% ;Make old JFN caller know about virgin JFN ENDIF. CLOSF% ;Flush the JFN JWARN RETSKP ;;; Create a response queue file for a bad one QUEBAD: CALL RESPQF ;Initialize the file CALL SDRADR ;Addressee = sender CALL RESPQB ;Finish up the file HRRZ B,MSGJFN(M) MOVE C,[111110,,1] JFNS% HRROI B,[ASCIZ/ /] SETZ C, SOUT% RET ;;; Rename a bad file RENBAX: PUSH P,A ;Save a PUSH P,A ;Save the JFN JRST RENBA0 RENBAD: PUSH P,A ;Save present JFN HRRZ A,MSGJFN(M) PUSH P,A TXO A,CO%NRJ CALL UNMQUF ;Unmap, leave JFN IFNSK. ADJSP P,-1 JRST CPOPAJ ENDIF. RENBA0: HRROI A,STRBUF HRRZ B,(P) MOVE C,[110000,,1] JFNS% MOVE B,FILIDX ;b := index to current file type HRRZ B,%FLSTR(B) ;b := ptr to "bad file" name CALL MOVSTR HRROI B,[ASCIZ/;P770000/] SETZ C, SOUT% DO. MOVX A,GJ%NEW!GJ%FOU!GJ%SHT HRROI B,STRBUF GTJFN% IFJER. CAIE A,GJFX24 ;Work around monitor bug JWARN MOVEI A,^D5000 ;Wait 5 seconds DISMS% LOOP. ENDIF. ENDDO. MOVE B,A POP P,A CALL RNMFIL ;Rename the file IFNSK. JWARN EXCH A,B ;A:=existing JFN, B:=JFN we failed to rename to RLJFN% ;Flush the failing JFN NOP ENDIF. HRROI A,STRBUF MOVE C,[111110,,1] JFNS% MOVE A,B RLJFN% JWARN JRST CPOPAJ ;;; Create a response queue file RESPQN: SKIPA A,[[ASCIZ/[--RETURNED-MAIL--].NEW-NOTIFY-/]] RESPQF: MOVEI A,[ASCIZ/[--RETURNED-MAIL--].NEW-FAILURE-/] STKVAR <,TMPJFN,RESPQT> MOVEM A,RESPQT ;Save queue type HRROI A,STRBUF ;Put this file where msg file came from HRRZ B,MSGJFN(M) MOVE C,[110000,,1] JFNS% MOVE B,RESPQT CALL MOVSTR MOVE B,FORKX MOVX C,^D8 NOUT% JFATAL MOVEI B,[ASCIZ/;P770000/] CALL MOVST0 MOVX A,GJ%NEW!GJ%FOU!GJ%SHT HRROI B,STRBUF SETZ C, DMOVEM A,GTJARG ;Save the args DO. DMOVE A,GTJARG ;Install args GTJFN% IFJER. CAIE A,GJFX24 ;Work around monitor bug JWARN MOVEI A,^D5000 ;Wait 5 seconds DISMS% LOOP. ENDIF. MOVEM A,TMPJFN ;Save the JFN MOVX B,<!OF%WR> OPENF% IFJER. EXCH A,TMPJFN ;Recover JFN, save error code RLJFN% ;Release it JWARN MOVEI A,^D5000 ;Wait a few seconds DISMS% MOVE A,TMPJFN ;Recover error code CAIE A,OPNX9 ;No error if file just busy CAIN A,OPNX2 ;File disappeared? LOOP. ;Yes, try again WARN LOOP. ENDIF. ENDDO. HRLI A,.FBBYV ;Set to retain infinite versions MOVX B,FB%RET SETZ C, CHFDB% HRRZS A ;a := output JFN CALLRET SDRMLA ;Write the sender header = mail agent ENDSV. ;; Here to set up "DISCARD-ON-ERROR" parameter ; Entry: a = output jfn DSCRDE: MOVEI B,.CHFFD ;Signal parameter start BOUT% HRROI B,[ASCIZ/=DISCARD-ON-ERROR: /] SETZ C, SOUT% RET ; Here to finish up reply file header RESPQB: MOVEI B,.CHFFD ;Terminate addressee headers BOUT% HRROI B,[ASCIZ/ Date: /] SOUT% SETO B, ;Now MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL ;RFC 822 standard date/time ODTIM% HRROI B,[ASCIZ/ From: The Mailer Daemon -- so MACRO doesn't fail SETZ C, SOUT% HRROI B,MLAGNT ;Use MLAGNT so user can reply SOUT% MOVEI B,"@" BOUT% MOVEI B,.CHDEL BOUT% HRROI B,LCLNAM ;Get local host name string SOUT% MOVEI B,.CHDEL BOUT% HRROI B,[ASCIZ/> To: /] SOUT% MOVE D,MSGSDR(M) ;d := entry adr for sender HRRZ C,HSTRCP(D) MOVE B,RCPBPT(C) ;b,c := ptr,-cnt to sender name string MOVN C,RCPCNT(C) SOUT% ;write the sender's address MOVEI B,"@" BOUT% MOVEI B,.CHDEL BOUT% HRRO B,HSTHST(D) ;Get the host pointer SOUT% MOVEI B,.CHDEL BOUT% HRROI B,[ASCIZ/ Subject: /] SOUT% RET ; Routine to output the sender as "sender" or "addressee" in mail file ; header ; Entry: a = output JFN ; m = ptr to queued msg block ; Call: CALL SDRHDR ("sender" = sender) ; CALL SDRADR ("addressee" = sender) ; Return: +1, b = ptr to sender host string SDRHDR: MOVEI B,.CHFFD ;Do ff to signal host BOUT% MOVX B,"_" ;Flag "sender" header SKIPA SDRADR: MOVX B,.CHFFD ;Do ff to signal host BOUT% PUSH P,C ;Save ac's PUSH P,D MOVE D,MSGSDR(M) ;d := hst entry adr for sender HRRO B,HSTHST(D) ;b := file site tbl adr for host SETZ C, SOUT% HRROI B,CRLF0 ;Terminate line SOUT% HRRZ C,HSTRCP(D) ;d := adr of sender recipient list MOVE B,RCPBPT(C) ;b,c := ptr,-cnt to sender name string MOVN C,RCPCNT(C) SOUT% HRROI B,CRLF0 ;Terminate line SOUT% POP P,D ;Recover working ac's POP P,C RET ; Routine to output a "sender" = mail agent header ; Entry: a = output JFN ; Call: CALL SDRMLA ("sender" = mail agent) ; CALL MLAADR ("addressee" = mail agent) ; Return: +1 SDRMLA: MOVEI B,.CHFFD ;Do ff to signal host BOUT% MOVX B,"_" ;Flag "sender" header SKIPA MLAADR: MOVX B,.CHFFD ;Do ff to signal host BOUT% HRROI B,LCLNAM ;Get local name string SETZ C, SOUT% HRROI B,CRLF0 SOUT% HRROI B,MLAGNT ;Now the mail agent's name SOUT% HRROI B,CRLF0 SOUT% RET ;;; Generate headers for message in M to host in A GENHDL: SETZ A, ;Local host; no special transmogrification SKIPA E,[LCLNAM] ;Don't convert LCLNAM to LCLNCN GENHDR: MOVEI E,LCLNCN ;Convert LCLNAM to LCLNCN JSR SAVACS ;Save all AC's STKVAR ,LINCNT> MOVEM A,DSTHPT ;Save destination host pointer MOVEM E,LCLHPT ;Save local name pointer DMOVE X,MSGHDR(M) ;Start of headers of message SKIPN O,MSGNHD(M) ;Was there a block from last time? IFSKP. HRRZ A,-1(O) ;Get size of block ELSE. MOVEI A,100 ;Nominal block to allocate CALL ALCBLK FATAL MOVEI O,(B) MOVEM O,MSGNHD(M) ENDIF. HRLI O,() MOVEI N,(A) IMULI N,5 ;Number of bytes available MOVEM N,HDRLEN ;Save it in case we grow DO. ;Output BP in O, free byte count in N DMOVEM X,MSGTXT(M) CALL PARLIN ;Read a line IFNSK. MOVE C,[POINT 7,CRLF0] ;Failed, just write CRLF MOVEI D,2 EXIT. ENDIF. IFXN. F,FP%EOL ;Blank line? DMOVEM X,MSGTXT(M) ;Update start of actual message text MOVE C,[POINT 7,[BYTE (7) .CHCRT,.CHLFD,.CHCRT,.CHLFD,.CHNUL]] MOVEI D,4 EXIT. ;Yes, finish up then ENDIF. IFXE. F,FP%CLN!FP%WSP ;Looks like a valid line? MOVE C,[POINT 7,CRLF0] ;No, just write CRLF MOVEI D,2 EXIT. ENDIF. IFXE. F,FP%DEL ;Is this a special line? CALL OUHNWL ;New line CALL PARSTR ;Get whole line CALL OUHSTR ;Finish LOOP. ;And go hack next line ENDIF. MOVE T,PLINBP+1 ;Save line context (may get host error) MOVEM T,LINCNT CALL PARDEL ;Canonicalize lengths DMOVE C,PDELBP ;Start of host CALL PARHST ;Parse it IFNSK. MOVE T,LINCNT ;Bad host! Restore line context MOVEM T,PLINBP+1 CALL OUHNWL ;Make like never saw 's CALL PARSTR ;Get whole line CALL OUHSTR ;Output it LOOP. ;And go hack next line ENDIF. MOVEI A,HSTTMP ;Copy returned string so we can muck it HRLI A,() ;Make string pointer MOVEM A,PDELBP ;Save pointer CAIN B,LCLNAM ;Local host name returned? MOVE B,LCLHPT ;Yes, use local name for this network MOVE D,DSTHPT ;Destination host pointer CALL TRNMGR ;Transmogrify host IFSKP. SOS PLINBP+1 ;Flush "@" preceeding SOS PWSPBP+1 ENDIF. SETZ C, ;Now count its length DO. ILDB B,A ;Get byte CAIE B,.CHNUL ;Null? AOJA C,TOP. ;No, count it and do another ENDDO. MOVEM C,PDELBP+1 ;Save length too IFXN. F,FP%WSP ;Is this a continuation line? MOVEI T,1(E) ;Length of line so far, plus a new space ADD T,PWSPBP+1 ;Plus line without whitespace ADD T,PDELBP+1 ;Plus start of host ADD T,PDELB2+1 ;Plus end of host CAIL T,^D79 ;Is that a reasonable length line? IFSKP. MOVEI T,.CHSPC ;Yes, put in a space CALL OUHCHR DMOVE C,PWSPBP ;And use start of stuff after whitespace ELSE. CALL OUHNWL ;New line DMOVE C,PLINBP ;Use start of line ENDIF. ELSE. CALL OUHNWL ;New line DMOVE C,PLINBP ;Use start of line ENDIF. CALL OUHSTR ;Output it DMOVE C,PDELBP ;First part of host CALL OUHSTR ;Output that DMOVE C,PDELB2 ;Rest of line CALL OUHSTR ;Finish LOOP. ;And go hack next line ENDDO. CALL OUHSTR MOVE T,MSGNHD(M) HRRZ T,-1(T) ;Length of block IMULI T,5 ;Total bytes SUB T,N ;Less bytes left is bytes used HRLM T,MSGNHD(M) RET ENDSV. ;TRNMGR - transmogrify host name for destination host ; A/ output byte pointer ; B/ host pointer ; D/ destination host pointer ; Skips if transmogrified so preceeding "@" should be flushed. TRNMGR: SAVEAC ;Don't clobber invoker's context STKVAR MOVEM A,BUFPTR HRRZM B,HSTPTR HRRZM D,DSTPTR CALL MOVST0 MOVE A,BUFPTR ;Save top domain in case no real ones SETZM RELPTR DO. ILDB B,A IFN. B CAIN B,"." MOVEM A,RELPTR LOOP. ENDIF. ENDDO. MOVE A,BUFPTR ;Remove relative domains CALL $RMREL SETZM DOMPTR ;See if there is a real domin DO. ILDB B,A IFN. B CAIN B,"." MOVEM A,DOMPTR LOOP. ENDIF. ENDDO. SKIPN B,DOMPTR ;Is there a domain? IFSKP. MOVE A,DOMTBL ;Yes, is the domain relayed to? TBLUK% JXE B,TL%EXM,R ;If not found, don't transmogrify HRRZ D,(A) ;Yes, get domain block SETZ C, ;Dyke out pseudo-domain DPB C,DOMPTR MOVE A,DOMPTR ;Pointer to pseudo-domain HRROI B,[ASCIZ/Internet/] STCMP% ;See if going to Internet JUMPE A,R ;If so then we're done MOVE B,DM%TRN(D) ;Not official, get transmogrification word HRLI B,() ILDB C,B ;B=trnmgr host, C=trnmgr char ELSE. SKIPN DSTPTR ;Local delivery? RET ;Yes, don't transmogrify ;;Need to convert the locally connected host to something known at ;;destination. Investigate the destination host's relay capabilites. MOVE A,DOMTBL ;Set up aobjn pointer to domain table HLL A,(A) TXC A,.LHALF DO. ;Look for destination host AOBJP A,ENDLP. ;Next domain MOVE B,(A) MOVEI B,DM%RLY(B) DO. ;Loop through relays for this domain HRRZ C,(B) CAMN C,DSTPTR EXIT. ;Same as our destination, done HLRZ B,(B) JUMPN B,TOP. ENDDO. JUMPE B,TOP. ENDDO. IFGE. A ;Destination host a relay? MOVE B,DSTPTR ;No, does it know about our host? MOVE C,RELPTR CALL TRNCHK RET ;Yes, so don't bother transmogrifying MOVE B,[POINT 7,LCLNCN] ;No, must transmogrify, we will relay MOVEI C,"%" ;Assume we'll understand "%" ELSE. ;;Destination is a relay to somewhere, so can't really be sure ;;where the message will end up. Have to come up with an Internet ;;address somehow. MOVE A,DOMTBL ;Pointer to pseudo-domain table HRROI B,[ASCIZ/Internet/] TBLUK% IFXE. B,TL%EXM ;Found Internet? MOVE B,[POINT 7,LCLNCN] ;No, we'll serve as relay MOVEI C,"%" ;Assume we'll understand "%"... ELSE. MOVE A,(A) ;Found Internet, get domain block MOVEI B,DM%RLY(A) ;See if our host is an Internet relay DO. ; so maybe we don't need to transmogrify HRRZ C,(B) CAMN C,HSTPTR EXIT. HLRZ B,(B) JUMPN B,TOP. ENDDO. JUMPN B,R ;Host is Internet relay, no transmogrify needed MOVE C,DM%TRN(A) ;Get domain transmogrification host HRLI C,() MOVE A,HSTPTR ;Is host to transmogrify our local host? CAIE A,LCLNCN CAIN A,LCLNAM IFSKP. MOVE A,BUFPTR ;No, replace host by %host@local DO. ILDB B,A JUMPN B,TOP. ENDDO. ILDB B,C ;Append relay's transmogrification char DPB B,A MOVEI B,LCLNCN ;Append our name CALL MOVST0 MOVE A,BUFPTR ;Flush relative domains from local name CALL $RMREL MOVE B,C ;Get back relay host MOVEI C,"%" ;Assume we'll understand "%" ELSE. ILDB B,C ;Get relay's transmogrification char EXCH B,C ;C/ char, B/ relay host pointer ENDIF. ENDIF. ;End no relay info on ARPA ENDIF. ;End destination not a relay ENDIF. ;End have domain ;; Here if need to transmogrify. B=host, C=char MOVE A,BUFPTR ;Now prepend the character to the string DO. ILDB D,A DPB C,A SKIPE C,D LOOP. ENDDO. MOVEI C,"@" ;Append "@" IDPB C,A CALL MOVST2 ;Append the host MOVE A,BUFPTR ;Flush possible relative domain if local host CALL $RMREL RETSKP ;Done ENDSV. ;; TRNCHK: B/ host pointer C/ domain ;; Skips if host is not in the domain TRNCHK: JUMPE C,RSKP ;Shouldn't happen... HRLI B,() ;Find domain SETZ A, DO. ILDB D,B CAIN D,"." MOVE A,B JUMPN D,TOP. ENDDO. JUMPE A,RSKP ;Not a chance MOVE B,C CALL STRCMP ;Same as the one we want? RETSKP ;No, not in domain RET ;Okay, it is in the domain ;;; Header string output routines, byte pointer is in O, ;;; count of bytes left is in N, length of line is in E OUHNWL: DMOVE C,[POINT 7,CRLF0 2] TDZA E,E ;Init to 0 OUHSTR: ADDI E,(D) ;Update length of line JUMPE D,R ;Nothing if empty string SAVEAC DO. ILDB T,C CALL OUHCHR SOJG D,TOP. ENDDO. RET OUHCHG: MOVE B,MSGNHD(M) HRRZ A,-1(B) ;Length of block now ADDI A,100 ;Increment by this much SUBI O,(B) ;Make pointer relative in case relocated CALL GROBLK FATAL MOVEM B,MSGNHD(M) ADDI O,(B) ;Make pointer absolute again IMULI A,5 ;Number of bytes total available MOVE N,HDRLEN ;Get previous size of block SUBM A,N ;Update now available MOVEM A,HDRLEN ;Update for current size OUHCHR: SOJL N,OUHCHG ;Room left in buffer? IDPB T,O ;Yes, just stick it in RET SUBTTL Sending routines ;;; Send the message in M SNDMSG: JSR SAVACS ;I don't know why, but it's necessary SETZM RLYLST TXZ F,FM%RLY ;Not relaying here MOVEI N,MSGRCP(M) ;Start of recipient list DO. SKIPN MSGTMT(M) ;Total timeout for msg? IFSKP. TIME% ;Yes, elapsed yet? CAML A,MSGTMT(M) RETSKP ;Yes, quit on this round ENDIF. ;The following loop looks for the next physical host. If we are in the ;middle of relaying, it will try the next host in the list of possible ;relays. Otherwise, it will try the next host in the list of recipient ;hosts. The only exit from this loop is the success return from GETPTH. ;So after this loop, the AC's will be set as in GETPTH, for some ;physical host (i.e. if we have to relay, the relay host). DO. ;Look for a host to send to IFXN. F,FM%RLY ;First see if we are looking for a relay HRRZ B,RLYLST ;Yes, so try the first relay host ELSE. ;No, so get a new final destination host HRRZ N,(N) ;Get next host JUMPE N,RSKP ;None, done for now MOVX TT,FH%DON ;Already done this one? TDNE TT,HSTFLG(N) LOOP. ;Yes, look at the next HRRZ B,HSTHST(N) ;Get host pointer ENDIF. ;;;; CIETYPE <*** GETPTH %2W ***> ;***TEMP*** (seems to help!!!) CALL GETPTH ;Do we have a direct path? IFNSK. ;No, see if we can relay ;;;; CIETYPE < ** NO DIRECT PATH **> IFXN. F,FM%RLY ;Check for recursive relaying HLRZ B,RLYLST ;Yes, try next relay host SKIPE B ;If zero, no more relays SKIPN B,(B) ;Else get next relay TXZ F,FM%RLY ;Note that we're not relaying MOVEM B,RLYLST ;;;; CIETYPE < ** TRYING NEXT RELAY **> LOOP. ENDIF. HRRO A,HSTHST(N) ;Get back the host ;;;; CIETYPE < ** $GTRLY(%1W) **> CALL $GTRLY ;See if we can relay to it LOOP. ;No, so much for that host... ;;;; CIETYPE < ** "%1W", CURDOM=%2H **> MOVEM B,CURDOM ;Save the domain block SKIPE B,DM%RLY(B) ;And list of relays TXO F,FM%RLY ;Note that we are relaying ;;;; CIETYPE < ** RELAY LIST = %2H (%2W) ** > MOVEM B,RLYLST ;And go back to process relay host LOOP. ENDIF. ENDDO. MOVX TT,FH%DN1 ;Mark that we are trying to do this one IORM TT,HSTFLG(N) MOVEI O,HSTRCP(N) ;Point to start of recipients MOVEM C,FRNADR ;Save returned host address MOVEM B,FRNHST ;Remember the host we're connecting to HRRO B,HSTHST(N) ;Get final destination CIETYPE < Queued mail for %2W> HLRZ T,E ;Get protocol name IFXN. F,FM%RLY ;If relaying HRRO B,FRNHST ;Get back immediate destination ETYPE < routing via %2W using %6W> ELSE. ETYPE < using %6W> ENDIF. TXZ F,FM%FAI ;Haven't failed MOVEM N,SAVEN ;Save the position in the host list MOVE B,FRNHST ;Get back host pointer MOVE C,FRNADR ;Get the address back CALL (E) ;Call the routine IFNSK. TXO F,FM%FAI ;Failed TYPE < failed.> IFXN. F,FM%RLY ;If relaying HLRZ T,RLYLST ;Then go to next possible host SKIPE T ;If zero, no more relays SKIPN T,(T) ;Else get next relay TXZ F,FM%RLY ;Note we're no longer relaying MOVEM T,RLYLST ENDIF. ELSE. ;If it succeeded SETZM RLYLST ;Forget any further possible relay hosts TXZ F,FM%RLY ;Note we're no longer relaying SKIPN A,STAJFN ;Doing statistics? ANSKP. HRRO B,FRNHST ;Get back host pointer SETZ C, ;Null-terminated SOUT% ERJMP .+1 MOVX B,"," ;Delimiter BOUT% ERJMP .+1 HLRZ B,MSGNHD(M) ;Length of headers generated ADD B,MSGTCN(M) MOVX C,^D10 ;In decimal NOUT% ERJMP .+1 HRROI B,CRLF0 ;Finally output CRLF SETZ C, SOUT% ERJMP .+1 ENDIF. MOVE T,SAVEN ;Recover starting recipient host DO. MOVX TT,FH%DN1 ;Check if "about to be done" TDNN TT,HSTFLG(T) IFSKP. ANDCAM TT,HSTFLG(T) ;If so, clear that MOVX TT,FH%DON TXNN F,FM%FAI ;Unless it failed IORM TT,HSTFLG(T) ENDIF. CAIN T,(N) ;Reached host we just processed? EXIT. ;Yes HRRZ T,(T) ;May have sent more, check them out JUMPN T,TOP. ENDDO. MOVE N,SAVEN ;Recover starting host LOOP. ;Loop ENDDO. ; Get the next recipient for this route, skip if success ; Call: CALL NXTRCP ; N/ Current host block ; O/ Current recipient block ; FRNHST: The current host we have a connection to ; Returns: ; +1 if no more possible recipients ; +2 new recipient ; N/ Host block (possibly changed if relaying) ; O/ Recipient block (definitely changed) ; NXTRCP: SAVEAC HRRZ O,(O) ;Next recipient JUMPN O,RSKP ;Found one ; No more on this host, but see if this host can be used as a relay ; DO. HRRZ N,(N) ;Get the next host block JUMPE N,R ;No more MOVX TT,FH%DON ;Done already? TDNE TT,HSTFLG(N) LOOP. ;Yes, no need to look at it further HRRZ B,HSTHST(N) ;Get host pointer CALL GETPTH ;See if we can get to it directly IFSKP. ;Yes LOOP. ;So it won't need us as a relay ENDIF. HRRO A,HSTHST(N) ;Get host name CALL $GTRLY ;See if it can be relayed to LOOP. ;No, so we can't help it ;Now look through the list of legal relays to see if we are one of them MOVE B,DM%RLY(B) ;Get list of relays from domain block DO. HRRZ C,B ;Get host pointer CAMN C,FRNHST ;Is it us? EXIT. ;Yes - do this guy, too HLRZ C,B ;No, see if there are any more relays JUMPE C,ENDLP. ;None MOVE B,(C) ;Yes, so continue looking LOOP. ENDDO. JUMPE C,TOP. ;Try next if can't relay ENDDO. MOVX TT,FH%DN1 ;Mark that we are trying to do this one IORM TT,HSTFLG(N) MOVEI O,HSTRCP(N) ;Point to start of recipients TXO F,FM%RLY ;Note we are relaying here JRST NXTRCP ;Loop ; Find the path to a given host ; Call: CALL GETPTH ; B/ Host pointer ; Returns: ; +1 No path to host ; +2 path found ; E/ Protocol name,,routine ; B/ Host pointer ; C/ Numeric address to use for this protocol ; GETPTH: STKVAR MOVEM B,HSTPTR ;Set up pointer CALL HSTDED ;Is host up? RET ;No, no path MOVEI C,SNDRTS ;Try direct protocols first HRRO A,HSTPTR ;Get name CALL $GTPRO ;Try to find a protocol RET ;None MOVE E,(C) ;Get protocol data MOVE C,B ;Get foreign host address for this protocol MOVE B,HSTPTR ;Get foreign host pointer RETSKP ENDSV. ;;; Output host in B in absolute form to the output designator in A OUTAHS: STKVAR > ;**** TEMP CHANGE... NEED NOT COPY -PB MOVEM A,HSTPTR ;Save output designator MOVEI A,HSTTMP ;Get copy of host name in HSTTMP HRLI A,() CALL MOVST0 HRROI A,HSTTMP ;Remove relative domains CALL $RMREL MOVE A,HSTPTR ;Restore output designator HRROI B,HSTTMP ;B := host in absolute form SETZ C, SOUT% RET ENDSV. ;;; Output this recipient to designator in A, also to terminal if appropriate OUTRCP: STKVAR > MOVEM A,OTRJFN ;Save JFN MOVE C,[POINT 8,STRBF1] DMOVE T,RCPBPT(O) MOVEM TT,OTRHCT ;Save count before relaying DO. ILDB D,T IDPB D,C ;Copy recipient to STRBF1 SOJG TT,TOP. ENDDO. IFXN. F,FM%RLY ;Are we relaying? MOVEI A,HSTTMP ;Yes, make a copy of it so we can frob it HRLI A,() ;Note HSTTMP is a STKVAR, don't optimize MOVEM A,OTRHPT ;Save this pointer for later HRRZ B,HSTHST(N) ;From site entry CALL MOVST0 MOVE A,OTRHPT ;Look for top-level domain SETZM DOMPTR ;Assume none yet DO. ILDB B,A ;Get a byte from name IFN. B ;If null, scan done CAIN B,"." ;Start of a domain segment? MOVEM A,DOMPTR ;Yes, remember its pointer LOOP. ;Keep looking ENDIF. ENDDO. MOVEI TT,"%" ;Default transmogrification character MOVE A,DOMTBL ;List of domains we know about SKIPN B,DOMPTR ;Pointer to domain to find IFSKP. PUSH P,C ;Guard against TBLUK% clobbering this TBLUK% ;See if this domain can be found POP P,C ANDXN. B,TL%EXM ;Found the domain? SETZ TT, ;Yes, tie off the string at this point DPB TT,DOMPTR HRRZ TT,(A) ;Get domain block MOVE TT,DM%TRN(TT) ;Pointer to transmog character HRLI TT,() ILDB TT,TT ;Get transmogrification character ENDIF. IDPB TT,C AOS OTRHCT ;Bump character count DO. ILDB TT,OTRHPT ;Now copy the transmogrified string to our IFN. TT ; output buffer IDPB TT,C AOS OTRHCT LOOP. ENDIF. ENDDO. ENDIF. CITYPE < > MOVX A,.PRIOU MOVE B,[POINT 8,STRBF1] MOVN C,OTRHCT ;Updated count SKIPE PRINTP SOUT% TYPE <: > MOVE A,OTRJFN ;Restore JFN MOVE B,[POINT 8,STRBF1] MOVN C,OTRHCT ;Updated count SOUT% ERJMP .+1 RET ENDSV. ;;; Output only message headers to JFN in A ;;; Returns: +1, transmission error ;;; +2, successful OUTMSH: STKVAR MOVEM A,OUTMSD ;Save designator MOVEI A,^D1000 ;Transmit 1000 bytes at a time IFN $$BU,< SKIPN SEGSIZ ;[PLB] UNLESS ALREADY SET UP... > ;$$BU MOVEM A,SEGSIZ ;Set segment size SKIPN A,MSGTMT(M) ;Overall delivery timeout in effect? IFSKP. TIME% ;Yes, compute time limit for this copy ADD A,TMCINT CAMLE A,MSGTMT(M) ;Beyond total delivery timeout? MOVE A,MSGTMT(M) ;Yes, use that ENDIF. MOVEM A,MSGTMC(M) ;Record copy timeout MOVE A,OUTMSD ;Restore designator MOVE B,MSGNHD(M) ;Headers we generated HLRZ C,B ;Length HRLI B,() ;Build byte pointer to message MOVNI C,(C) ;And byte count ADDI C,2 ;Skip over the CRLF at the start IBP B IBP B CALL OUTMST ;Check copy timer JRST OUTMSF CALL $SOUT ;If no timeout, output the headers JRST OUTMSF OUTMDN: AOS (P) ;Set success (+2) OUTMSF: TMOCLR ;Disallow timer interrupts now RET ENDSV. ;;; Output whole text of message and headers to JFN in A ;;; Returns: +1, transmission error ;;; +2, successful OUTMSG: CALL OUTMSH ;Output headers RET ;+1 Transmission error SKIPE D,MSGTCN(M) ;+3 Success. Is message body empty? IFSKP. HRROI B,CRLF0 ;Yes, must output at least a CRLF SETZ C, CALL $SOUT JRST OUTMSF ELSE. MOVE B,MSGTXT(M) ;Message non-empty, get pointer to message text DO. ;No, here with message pointer in B, count in D TMOCLR ;Disallow timer interrupts now IFE $$BU, CAIG D,^D1000 ;Do 1000 characters at a time IFN $$BU, CAMG D,SEGSIZ ;[PLB] Do MAXSEG characters at a time SKIPA C,D IFE $$BU, MOVEI C,^D1000 IFN $$BU, MOVE C,SEGSIZ ;[PLB] Do the maximum SUBI D,(C) ;Account for this many characters output MOVNS C ;Negative byte count for SOUT% CALL OUTMST ;Check copy timer JRST OUTMSF ;Timed out CALL $SOUT ;Output the string JRST OUTMSF JUMPG D,TOP. ;Continue output if more bytes to go ENDDO. ENDIF. JRST OUTMDN ;Message output done ;;; Output whole text of message and headers to JFN in A with period checking ;;; Returns: +1, transmission error ;;; +2, successful MSGOUT: STKVAR CALL OUTMSH ;Output headers RET ;+1 Transmission error SKIPN D,MSGTCN(M) ;Get text count or flag text empty IFSKP. ;Message non-empty with count in D MOVE B,MSGTXT(M) ;Get pointer to message text ILDB B,B ;Get first byte of message CAIE B,"." ;Is it a period? IFSKP. CALL $BOUT ;Yes, double it in transmission JRST OUTMSF ENDIF. MOVE B,MSGTXT(M) ;Get pointer to message body again DO. ;Do 1000-bytes at a time with period checking TMOCLR ;Disallow timer interrupts MOVEM B,BUFPTR ;Save pointer to start of buffer SETZB C,TT ;Character count zero, no doubled dot DO. ;Search for "." sequence within buffer CAILE D,2(C) ;Possible at all for "." sequence? IFSKP. ;No, too near end of message MOVE C,D ;Set to output rest of message EXIT. ;And be done with this ENDIF. CAMLE C,SEGSIZ ;Buffer filled? EXIT. ;Yes, output it ILDB T,B ;Get byte from buffer ADDI C,1 ;Count this character CAIE T,.CHCRT ;Is it a CR? LOOP. ;No, continue scan ILDB T,B ;Saw CR, get possible LF ADDI C,1 ;Count this character CAIE T,.CHLFD ;Have we gotten a ? LOOP. ;No, continue scan MOVE T,B ;Saw , get pointer to peek at next byte ILDB T,T ;Peek at next byte CAIE T,"." ;Have we gotten a line starting with period? LOOP. ;No, continue scan SETO TT, ;Yes, end buffer here, flag must double dot IBP B ;Advance pointer beyond the dot ADDI C,1 ;And count it ENDDO. ;End scan through message for . MOVE B,BUFPTR ;Get back pointer to start of buffer SUBI D,(C) ;Account for this many characters output MOVNS C ;Negative byte count for SOUT% CALL OUTMST ;Check copy timer JRST OUTMSF ;Timed out IFE $$BU, CALL $SOUT ;Output the string IFN $$BU, CALL $SOUTR ;[PLB] Output the string JRST OUTMSF IFN. TT ;Do we have to double dot? MOVEM B,BUFPTR ;Yes, save pointer to buffer MOVEI B,"." ;Output the extra period CALL $BOUT JRST OUTMSF MOVE B,BUFPTR ;Retrieve pointer ENDIF. JUMPG D,TOP. ;Continue output if more bytes to go ENDDO. SETO T, ;Back up pointer to last two bytes in buffer ADJBP T,B LDB D,T ;Get next to last byte CAIE D,.CHCRT ;Was it a CR? TDZA D,D ;No, can't be a CRLF sequence ILDB D,T ;Yes, possible CRLF, get last byte ENDIF. CAIN D,.CHLFD ;Here D has either: the last byte output from IFSKP. ; the message, or zero. D can be zero if the HRROI B,CRLF0 ; message body is empty or if the next to the SETZ C, ; last byte wasn't a CR. We can suppress CALL $SOUT ; outputting the CRLF before the EOM only if JRST OUTMSF ; D has a "last byte" of line feed ENDIF. HRROI B,[ASCIZ/. /] ;Send End-Of-Message signal IFN $$BU,< ;[PLB]... SKIPN SWTLOS ;S/W/ TOOLS MAIL? IFSKP. HRROI B,[BYTE(7) .CHLFD] ;**** CROCK ENSURE TRAILING LF SETZ C, ;TO FLUSH THE WORKS CALL $SOUTR ;Ensure fresh record for "." LF JRST OUTMSF HRROI B,[BYTE(7) ".", .CHLFD] ;Send record with just . ;for lusing s/w tools mailer ENDIF. > ;IFN $$BU CALL $SOUTR JRST OUTMSF JRST OUTMDN ENDSV. ;;; Routine to check timer for this msg copy ; Entry: MSGTMC(M) = time limit for transmitting this copy ; Call: CALL OUTMST ; Return: +1, timeout expired ; +2, ready to send next block of text OUTMST: SKIPN MSGTMC(M) ;Copy timeout in effect? IFSKP. SAVEAC ;Save ACs TIME% ;Time limit up? CAML A,MSGTMC(M) CALL TIMOUT ;Timer expired ENDIF. RETSKP SUBTTL Process local mail SNDLCL: SKIPN MSGLCL(M) ;Any local mail? RETSKP ;No JSR SAVACS ;Yes, save all ACs MOVEI X,MSGLCL(M) ;Pointer to local mail SKIPE MSGDOP(M) ;If sending, do this another way JRST SNDLCT CITYPE < Processing local mail> CALL GENHDL ;Build local headers DO. HRRZ O,(X) ;Get next recipient JUMPE O,RSKP ;All done MOVE B,RCPFLG(O) ;Get address flags IFXE. B,FR%FAI!FR%TMP ;Forwarding errors on this address? CALL SNDLCF ;No, try to send to file IFSKP. TYPE ;Success, log it ELSE. CALL CHKSFT ;Failed, was it a soft error? IFSKP. SKIPE NTDEQF ;Soft error, has message expired? ANSKP. MOVX B,FR%TMP ;No, just record soft failure IORM B,RCPFLG(O) CIETYP < %1E> ;JSYS error message ELSE. MOVE B,A ;Dequeueing, get a copy of the JSYS error text HRROI A,STRBF1 HRLI B,.FHSLF SETZ C, ERSTR% ERJMP .+1 ERJMP .+1 MOVEI A,STRBF1 MOVX B,FR%ERM!FR%TMP ;Assume sender notify and requeue SKIPG NTDEQF MOVX B,FR%ERM!FR%FAI ;No, dequeueing CALL RCPLCX ;Save the error string ENDIF. ENDIF. ENDIF. MOVEI X,(O) LOOP. ENDDO. ;;;Skip if error code in A is soft CHKSFT: CAIE A,OPNX6 ;Append access required means no WOPR or file CAIN A,OPNX23 ;Quota exceeded (all cases -- see OVRQTA) RETSKP CAIN A,OPNX9 ;Let invalid simultaneous access through too RETSKP ; OVRQTA and this is soft IFN $$OZ,< ;Errors for $Daemon stuff CAIE A,IPCFX6 ;Send quota exceeded CAIN A,IPCFX7 ;Receiver quota exceeded RETSKP CAIE A,IPCFX8 ;IPCF free space exhausted CAIN A,IPCF13 ;PID quota exceeded RETSKP CAIN A,IPCF27 ;PID is not defined (general purpose in SNDLC$) RETSKP > ;;;Maybe some others need adding here? RET ; Here when address forwards to bad host, it is HSTBUF RCPLXH: MOVE A,[POINT 7,STRBF1] ;a := buffer to construct msg MOVEI B,[ASCIZ/Can't forward - unknown host "/] CALL MOVSTR MOVEI B,HSTBUF CALL MOVSTR MOVEI B,"""" IDPB B,A SETZ B, IDPB B,A MOVEI A,STRBF1 ;Now give him the bad news MOVX B,FR%ERM!FR%FAI ;Hard failure ;;; JRST RCPLCX ; Set error message for a recipient ; a = address of error string ; b = error bits for user block RCPLCX: CALL RSTRCP ;Clear error msgs for this recipient IORM B,RCPFLG(O) CALL CPYSTR MOVEM B,RCPERR(O) UTYPE (B) ;Print the reason RET ; Here to do SNDLCL processing for terminal messages ; returns +2/always ; messages to be sent as mail requeued with temporary error flag ; failed messages that can't be remailed flagged as permanent errors SNDLCT: MOVE A,MSGDOP(M) ;Point to delivery-options HLRO A,DOPTAB(A) ;Get delivery option string CIETYP < Processing %1S terminal message> ;; Build message text to send HRROI A,STRBF1 ;We build the message into STRBUF IFN $$BU,< FMSG <[Message from > ;] [PLB] > ;$$BU SKIPN D,MSGSDR(M) ;d := adr of sender host entry block FATAL HRRZ C,HSTRCP(D) ;Get pointer to recipient entry block MOVE B,RCPBPT(C) ;Point to sender user name MOVN C,RCPCNT(C) ;And sender count SOUT% ;Add it in FMSG <@> ;Add atsign HRRO B,HSTHST(D) ;Now get name for host CALL OUTAHS ;Add host name IFE $$BU,FMSG <, > ;Comma IFN $$BU,< MOVEI B," " ;[PLB] SPACE BOUT% ;[PLB] > ;$$BU SETO B, ;Current time MOVX C,OT%NSC!OT%12H!OT%SCL ;C/Format flags: no seconds, 12 hour time ODTIM% ;Write it IFN $$BU,< ;[ FMSG <]> ;[PLB] > ;$$BU HRROI A,STRBUF ;Into normal place to make send HRROI B,STRBF1 ;From header we just made MOVEI C,STRBSZ*5-1 ;With number of chars allowed in buffer SETZ D, ;To a null SOUT% ;String-to-string copy MOVEI B,.CHCRT ;Now another CR DPB B,A ;Write over null with it MOVEI B,.CHLFD ;And a linefeed IDPB B,A ;To finish the header line CAML C,MSGHCN(M) ;See how much space we have IFSKP. HRROI TT,[ASCIZ/Message text much too long/] CIETYP < All sends failed: %7S> DO. HRRZ O,(X) ;Get next recipient JUMPE O,ENDLP. ;If zero, done flagging them CALL SERMRK ;Set error flags and message MOVEI X,(O) ;Move on to next recipient LOOP. ENDDO. ELSE. MOVE B,MSGHDR(M) ;Point to message header start MOVN C,MSGHCN(M) ;And get count of letters SOUT% ;Copy message text across to finish message ;; Message built. Now make a list of recipients. SETZB T,TT ;No first block, no latest block DO. HRRZ O,(X) ;Get next recipient JUMPE O,ENDLP. MOVE A,[POINT 7,STRBF1] ;Get pointer to random string buffer DMOVE B,RCPBPT(O) ;Point to recipient name, byte count DO. ILDB D,B ;Get a byte IDPB D,A ;And drop it in SOJG C,TOP. ;Until there are no more bytes left ENDDO. IDPB C,A ;Drop in a null to terminate ;; Have name for recipient. Try looking up as a local user MOVX A,RC%EMO ;Forcing exact match HRROI B,STRBF1 ;With string we made RCUSR% ;Read user name IFNJE. ;If we succeeded ANDXE. A,RC%NOM ;And got a match PUSH P,C ;Save user number CALL GSRCPT ;Get recipient block in TT MOVSI A,RC.USR ;This is a user number MOVEM A,(TT) ;Save as block header POP P,1(TT) ;Save user number as data ELSE. HRROI A,STRBF1 ;That failed, point to buffer again MOVEI C,^D8 ;Terminal numbers are octal NIN% ;Try to read one in IFNJE. LDB C,A ;Read terminator byte ANDE. C ;Must be null PUSH P,B ;Is, save terminal number CALL GSRCPT ;Get recipient block for it MOVSI A,RC.TTY ;This is a terminal number MOVEM A,(TT) ;Save as block header POP P,1(TT) ;Save terminal number as data ELSE. MOVX A,FR%TMP ;Couldn't translate, want to send as mail IORM A,RCPFLG(O) ;So requeue with a "temporary error" ENDIF. ENDIF. MOVEI X,(O) ;Move on to next recipient LOOP. ENDDO. ANDN. T ;If nobody left, give up in disgust ;; Here to attempt to send to rcpt list pointed to by T DO. HRROI A,STRBUF ;From string buffer where we built message MOVE B,T ;Starting at the first send MOVEI C,SDBLOK ;With send state block CALL $SEND ;Send it off NOP ;We can tell if it succeeded by looking at B ;; Message has been sent. Loop through rcpts until we find one ;; that failed, logging and freeing blocks as we go. EXCH B,T ;Get starting recipient block in a useful place MOVE TT,A ;Save error pointer if we have any DO. HRROI A,STRBF1 ;Into alternate buffer CALL $WTRCP ;Write recipient name for strings CAMN B,T ;Are we where we left off yet? IFSKP. HRROI A,STRBF1 ;No, rcpt succeeded, get recipient name string CIETYP < %1S: Sent> ;Say we delivered it MOVE A,MSGDOP(M) ;Get delivery options CAIE A,D%SAML ;Send and mail? IFSKP. MOVX A,FR%TMP ;Yes, we need to send it as mail too MOVE O,2(B) ;Point back to recipient block IORM A,RCPFLG(O) ;Requeue with a "temporary error" ENDIF. LOAD O,RC%NXT,(B) ;Point to next recipient CALL FREBLK ;Free this one MOVE B,O ;Get next block pointer back JUMPN B,TOP. ;Got someone, go on SETZ T, ;Break out of outer loop ELSE. HRROI A,STRBF1 ;Point to recipient name CIETYP < %1S: %7S> MOVE O,2(T) ;Point back to recipient block CALL SERMRK ;Set error flags for that recipient MOVE B,T ;Get pointer to this block LOAD T,RC%NXT,(T) ;And move on to the next CALL FREBLK ;Free this one ENDIF. ENDDO. JUMPN T,TOP. ;If we have more to do, go do it ENDDO. ENDIF. RETSKP ; Here with a bad recipient, error string in TT. SERMRK: MOVE A,MSGDOP(M) ;Get message delivery options CAIE A,D%SOML ;If SOML, just set temporary failure CAIN A,D%SAML ;Ditto for SAML IFSKP. HRROI A,STRBF1 ;Into random string buffer MOVE B,TT ;From error string SETZ C, ;No limit (short string, don't worry about it) SOUT% ;String-to-string copy HRROI A,STRBF1 ;Now point to start of string again CALL CPYSTR ;Copy into safer string space MOVEM B,RCPERR(O) ;Save error message with recipient MOVX A,FR%ERM!FR%FAI ;Hard failure ELSE. MOVX A,FR%TMP ;Get flag for temporary error ENDIF. IORM A,RCPFLG(O) ;Set error flags in recipient block RET ; Here to make a recipient block GSRCPT: MOVEI A,3 ;Need: recipient type and data, copy of O CALL ALCBLK ;Allocate block FATAL MOVEM O,2(B) ;Save recipient pointer for flagging SKIPN T ;If we don't have a first block yet MOVEM B,T ;This is it SKIPE TT ;If we had a previous block STOR B,RC%NXT,(TT) ;Link through for $SEND MOVEM B,TT ;In any case save this as the previous block RET ; Mail failed. Check to see if the addressee is the mail agent. ; If so set the FR%MLA bit in RCPFLG(O). ; Entry: n = adr of host block ; o = adr of recipient block ; mlagnt = mail agent name string ; Call: CALL MMLGTL (check addressee assuming local host) ; CALL MMLGT (check addressee on network host) ; Return: +1, always MMLGT: MOVE A,HSTHST(N) ;a := host site CAIE A,LCLNAM ;Local? RET ;No, can't be mail agent MMLGTL: MOVE A,[POINT 7,MLAGNT] ;a := ptr to mail agent name DMOVE B,RCPBPT(O) ;b,c := ptr/ctr to recipient name CALL STRCAL ;Compare the strings RET ;Not same MOVX A,FR%MLA ;Same, flag mail agent failure IORM A,RCPFLG(O) RET ; Mail failed. Check to see if the addressee is the sender. ; If so set the FR%SDR bit in RCPFLG(O). ; Entry: n = adr of host block ; o = adr of recipient block ; msgsdr = message sender ; Call: CALL MSNDRL (check addressee on local host) ; CALL MSNDR (check addressee on network host) ; Return: +1, always MSNDR: SKIPA C,HSTHST(N) ;c := addressee host MSNDRL: MOVEI C,LCLNAM ;c := addressee host = local host MOVE A,MSGSDR(M) ;a := adr of sender host block MOVE B,HSTHST(A) ;b := sender host CAME B,C ;Same host? RET ;No, addressee neq sender HRRZ B,HSTRCP(A) ;a/b := ptr/len of sender name DMOVE A,RCPBPT(B) DMOVE C,RCPBPT(O) ;c/d := ptr/len of recipient name CALL STRCLL ;Compare the strings RET ;Not same MOVX A,FR%SDR ;Same, flag sender failure IORM A,RCPFLG(O) RET ; Routine to check forwarding address. ; Entry: strbuf = new addressee name ; hstbuf = new host ; Call: CALL CKFWDL ; Return: +1, host not recognized ; +2, new addressee = old one ; +3, forwarding OK, b = host site address CKFWDL: MOVE B,[POINT 7,HSTBUF] ;b := ptr to host name CALL HSTNAM ;Look it up RET ;No go, return +1 CAIE B,LCLNAM ;Still to local host? JRST R2SKP ;No, return +3 AOS 0(P) ;Return at least +2 from here SAVEAC MOVE A,[POINT 7,STRBUF] ;a := ptr to new user name DMOVE B,RCPBPT(O) ;b/c := ptr/len of old name CALL STRCAL ;Compare them (upper case) RETSKP ;No match, return +3 RET ;;; Add a forwarding address ;;; O/ ptr to recipient block ;;; B/ host index ADDRCP: MOVEI N,MSGRCP(M) ADDRC7: HRRZ T,HSTFLG(N) ;n := adr of next host block JUMPE T,ADDR11 ;This host not on list MOVE TT,HSTHST(T) CAME TT,B ;Same host JRST [ MOVEI N,(T) JRST ADDRC7] MOVEI N,(T) ADDRC8: MOVEI T,HSTRCP(N) ADDRC9: HRRZ TT,RCPFLG(T) ;Reached end? JUMPE TT,ADDR10 MOVEI T,(TT) JRST ADDRC9 ADDR10: HRRM O,(T) ;Link onto end HRRZ T,(O) ;Get old end