perm filename SMTPSR.FAI[S,NET]25 blob
sn#826035 filedate 1986-10-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00011 00002 TITLE SMTPSR History FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ROBUF BOBUF BUGHST ICPBLK ICPSTS ICPSKT HOSTNO CONECB CNIBTS OURSTR HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD maxpth REVPTH COLONS MFRBUF MSJBUF SNDNAM XRFBUF XRFBZZ XRFBBP XRRBBP XXBUF XXBZZ XXBBP NBUFS DSKIBF DSKOBF MFDIBF OLDIBF RLYOBF BUGOBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC RMDWAK RMDSYS PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC RLY BUG MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS MXMSGW MXCHRS NCHRS
C00038 00003 Definitions of a "global" nature UFDN ERRBTS
C00041 00004 Initial control link connection establishment ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO
C00044 00005 Initialize local data device ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
C00055 00006 Main program starts here START %SITE% REGO
C00061 00007 Main loop of SMTPSR LOOP SCHEK STATUS
C00063 00008 Accumulator save, restore routines, also clock turning-on routine SAVACX SAVACS GETACS
C00065 00009 Dispatch routines CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL
C00067 00010 CI routine - Read commands from control link, send answers, etc. CIROUT COMDIS BADCOM
C00068 00011 Set up type and byte size for transfer GETSET GETSE1 GETSEL C2 GETSEA ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1
C00075 00012 HELO HELOLP NOOP NOFROM RCPT RCPTML RELDUN RCPTCL RCPTX SYNERR UNKHST BADHMS BADHM2 WHOIAM NORLAY XSEN XSEM XMAS MAIL MAILCM MAILER GETFRM GETFRL GETFRS GETFRQ GETFNQ GETFRE GETFRX OK250 NODEST DATA NMAIL MAILIN NODOT EOMAIL EOMAI2 EOMBIG SETMFL SETMFR RMDLK RMDAOS RMDFIL WRHDR WHDFRB WSCRLF WHDFRM RCDCR WRTSSP WRTSS1 WRTSTR WRTST1 WRTST2 wrtsix wrlp wrsoj SWRTCH WRTCHR CORERR IERR4 HELP NOMAIL NOUSER SYNER2 SENERR NOPPNM RCVD DAYLIT MAISTR MAIST2 MAIDEC MAI2DG
C00098 00013 LOGGED LOGGE1 LOGTST JBLP JBNXT
C00100 00014 VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
C00105 00015 MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR
C00108 00016 MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR
C00111 00017 sixwrt wrlp wrsoj
C00112 00018 Command String reader GETCOM GETCO1 FLUSCS FLCS1 GETCO2
C00115 00019 Convert command string to index GETIDX ANAMES
C00116 00020 Send ASCII character out on IMP control connection PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3
C00120 00021 Get ASCII character from IMP control connection GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
C00124 00022 Routines to output ASCII information on control channel GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
C00127 00023 Another routine to output ASCII string to IMP control channel IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH IMPOCT
C00130 00024 SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
C00133 00025 Get file name GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPWIN GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF
C00139 00026 Validate destination address GETDST MLNCOP MLNB MLNA MLNMIN MLNMOK PRELAY MLFILE MLNMFF MLNMF2 MLNMF0 TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX DSTHNM DSTHNX FOPEN FACTXT DORELA DORELU DORELC DORELF DOREHC DOREHE DORELH DORERR DORNUS DORNU2 HSTCHK HSTOK SCANUS MLHOST MLHOSL MLHOS2 POP12J RECRLY RECRL2 RECRL3 RECRLP RECRL0 RECRLE RECOUT RECOU2 GET0E1 GET0E2 GET0E3 GET0E4 GET0E5 GET0E6 GET0E7 GET010 GET011 GET012 GET013 GET014 GET015 GET016 GET017 GET1E1 GET1E2 GET1E3 GET1E4 GET1E5 GET1E6 GET1E7 GET1E8 GET1E9 GET110 GET111 GET112 GET1ER GET0ER COPDOM COPHST COPHS2 COPHOK CHKSTR CHKST0 SKPSPC SKPSP0 SKPSPG SKPSGL
C00177 00027 Forwarding FF CR LF TAB TRYFOR TRYFO0 TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT
C00182 00028 NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
C00186 00029 Interrupt level routine ILEVEL DNTSAY timout SXACTV LOOK
C00188 00030 Host name magic using NETWRK CHKHTB GETHNM COPYUS GOTUS CPYHST CPYDUN HSTTAB HSTSIX ERRTNS WHYWHY
C00191 00031 Miscellaneous error messages BYE BYE1 BYE2 ERRKIL QUIT QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
C00197 00032 BUGBEG BUGRL2 BUGRL3 BUGRLP BUGRL0 BUGRLE BUGCHR BUGOUT BUGOU2
C00200 ENDMK
C⊗;
TITLE SMTPSR ;⊗ History FLG A B C D E F FLG2 MBP MCH MSJ T T1 T2 T3 P PDLL PDL DIBUF DOBUF FOBUF FIBUF IBUF OBUF ROBUF BOBUF BUGHST ICPBLK ICPSTS ICPSKT HOSTNO CONECB CNIBTS OURSTR HSTSTR PRIVS UFDFIL PASMTA PRVMTA PRVBUF PASWD PRIVWD GRPWD maxpth REVPTH COLONS MFRBUF MSJBUF SNDNAM XRFBUF XRFBZZ XRFBBP XRRBBP XXBUF XXBZZ XXBBP NBUFS DSKIBF DSKOBF MFDIBF OLDIBF RLYOBF BUGOBF LOURH3 OURH3 LCSS LCRS FCSS FCRS LDSS LDRS FDRS FDSS UPPN ALIPPN UPRG PPNTMP PASTRY SILENT DOMODE DIMODE DOTYPE DITYPE IMODES FMODES DOBS DIBS DOACTV DIACTV XACTV RTYPE RBS SCHEKF OUTINSTR SYNCH DIRFLC RMDWAK RMDSYS PATCH IMP DIMP DOMP FIMP FOMP .MFD .OLD .PASS UFDC RLY BUG MEOFBT USREBT PASSBT MFRWIN MFRLUZ MFRDUN MFNMF LFSEEN LISTFL MSJDUN MSJWIN MSJLUZ MSJDUN QUOTEF LEFTF .MAIL .XSEN .XSEM .XMAS CPOPJ2 POPJ1 CPOPJ1 CPOPJ REPMET QUANTM REAPRV WRTPRV MASPRV SYSPRV SCYPRV DECPRV ACTPRV CSPPRV GROUPS MXMSGW MXCHRS NCHRS
COMMENT ⊗ History (please record changes):
TCP server for the Simple Mail Transfer Protocol, as defined in RFC 822.
SMTPSR originated as a modified version of FTPSER, so comments often refer
to FTP. Code not relevant for SMTP has been removed or commented out.
03 May 83 ME IP/TCP code under FTIP.
04 May 83 ME EOMAIL wakes up remind phantom to deliver the mail.
17 May 83 JJW Fix to convert IP addresses to/from HOSTS2 format.
15 May 83 ME MLNLFF now checks host name in To: line to see if it's ours.
Quoting with "\" in From: line works, but leave "\" in line
for local mail hdr; MAIL should be fixed to accept this
form in a destination. RSET cmd clears GOTFRM. MLNB refuses
to accept mail for relaying (starts with "@" and contains
":" or "," -- already refused if contained "@...:").
19 May 83 ME MLFILE now handles mail to "@file"@ourname correctly.
23 May 83 ME RCPT checks to see if the user is really logged in for SEND,
and returns a 450 failure reply if not.
10 Jun 83 ME Put more specific error replies in MAIL/GETFRM.
11 Jun 83 ME Conversion to HOSTS3. Also uses dotted host number string
if no known host name for given host number. Allows connection
if from any of our alias host numbers when system down. Uses
exec 355 ptr to our host numbers.
13 Jun 83 ME Bug fixed at MLHOST, infinite loop resetting aobjn ptr.
23 Jun 83 ME Turned off "verbose" mode, to speed up I-level.
24 Jun 83 ME Fixed ILEVEL's verbose mode output buffer check to be more
conservative to avoid attempt to reschedule at I-level.
04 Jul 83 ME Fixed SCHEK to check for RFCS and RFCR instead of just CLS bits,
since a completely closed connection shows no bits at all.
Separated IVERBOSE from VERBOSE; former causes I-level typeout.
05 Jul 83 ME Fixed PUTCH2 and GETCH7 to include 32↔33 in ASCII/WAITS
character conversion (previous done to FTP/FTPSER).
04 Aug 83 ME SYNERR, NOMAIL and NOUSER errors in recipient include RCPT
line in error reply. Fixed START to clear HSTADR in case
core image is restarted, since JOBFF is reset by RESET, thus
allowing any mapped in host table's core to be reused and
hence clobbered.
11 Aug 83 ME Change NORLAY to return 550 instead of 553 (for no relaying
implemented), and fixed GETDST to take direct return to
get to NORLAY if first host name parsed isn't us (implying
relaying request).
12 Aug 83 ME IMPSTR fixed not to outstr stuff twice in verbose mode;
other routines fixed to type out text in verbose mode,
being more consistent (call PUTCH1 instead of PUTCHR).
GETDST sets SYNCOD with code of any syntax error; SYNERR
returns octal error code in SMTP reply.
17 Aug 83 ME Fixed bug in SYNERR that made it not include error code but
our host name in the syntax error text.
18 Aug 83 ME Made SYNERR and GETxEx to report last char plus error code.
19 Aug 83 ME Fixed DNTSAY (on user interrupt) and GETCH1 not to use SYNCH,
since SMTP protocol doesn't have DataMarks; the 200 bit must
be zero. GET0E6 halts after changing job name to 'GET ME'.
20 Aug 83 ME MLNMIN accepts "." in mailbox name, in case foreign host
is sending us a message to be relayed to another host.
Removed halt at GET0E6 except when A holds zero (null).
22 Aug 83 ME Fixed GETDST (1) to clear any previous overflow of XRFBUF
and (2) to zero XRFBBP to stop saving text in XRFBUF after
recipient line finished at MLNCOP. This should fix the
erroneous "syntax error" reply we sometimes have been
returning (after long msg followed by second msg using
same connection).
30 Aug 83 ME Removed halt at GET0E6 for final case (A holds null),
since the bug was fixed and this halt really happens
when the foreign mailer has a syntax problem.
16 Sep 83 JJW Removed FTHST3 switch and non-HOSTS3 code. Changed failure
return from HSTNUM to call HNUMST in NETWRK.
26 Oct 83 ME Made WRHDR use downarrows instead of double quotes to
quote the "from:" text for local mail header, etc.
GETFRL maintains spaces, tabs and brackets in name that
is quoted with double quotes.
7 Dec 83 ME GETDST fixed partially to allow double quotes around dest
(to make "@FILE"@SU-AI work).
5 Mar 84 ME Fixed IMPSTH always to put out domain string (.ARPA).
IMPSTH and RCVD also both now use our host name from OURSTR,
which is set up by GETHNM using NETWRK and lowcore 355 table.
RCVD includes .ARPA in line, omits last part of "with TCP/SMTP".
When host table includes ".ARPA" in names, flush refs to
DOMARP to avoid duplicating the .ARPA.
6 Mar 84 ME DOMARP removed at same time .ARPAs included in new host table.
28 Apr 84 ME DORELA in GETHST sets up MAIL's destination to handle SMTP
mail relaying, using /-E switch to indicate this to MAIL.
22 May 84 ME Kludge in DORELA to accept CCRMA as destination host for relay.
Mail relaying put up.
23 May 84 ME DORERR returns flag indicating unknown host (SYNCOD negative),
so that RCPT can return a reply saying unknown host. Also,
if SCANUS fails, DORNUS returns code causing RCPT to reply
that we're not the claimed host (either for mail relaying
or direct mail). Also, attempts to mail @sail,user@score
will now get syntax error reply (from MLFILE).
13 Nov 84 JJW GETDST allows "user%host" syntax to specify relaying.
14 Jun 85 ME WRHDR leaves empty /FROM↓↓ switch in header for MAIL if
the remote host said MAIL FROM:<> (return failed mail msg).
17 Mar 86 ME Fixed GETFRM to reject return paths that have two unquoted
colons in them (e.g., @score:@sushi:user@sierra). There
are at least a couple of hosts that have been observed
giving us such bad return paths: SCRC-Quabbin and SRI-AI.
18 Mar 86 ME Added FTLFRM, under which we log all MAIL FROM:<...> lines in
relay-log file for any mail relayed BEFORE reaching WAITS.
(We always log any mail being relayed through WAITS.) This is
for debugging funny mail with extra colon, since yesterday's
fix didn't stop this stuff from being accepted by WAITS.
5 Apr 86 ME Re-worked PRELAY and MLNMIN to allow multiple percent-signs
and to relay the message to the host following the last
percent-sign. But disabled at MLNMIN+10 (see comment) until
MAIL can accept address like User%Host1%Host2.
14 May 86 ME UNKHST tells what our host name is, when rejecting some
host name as not ours.
7 Aug 86 ME Added BUGBEG and BUGCHR routines to log entire SMTP
transactions with selected host (BUGHST), under IFN BUGLOG.
20 Aug 86 ME Enabled code at MLNMIN+10 to accept multiple percent signs in
mail to be relayed, since MAIL now accepts such destinations.
25 Aug 86 ME EOMAIL rejects message if too big (bigger than MXCHRS characters).
29 Aug 86 ME Copied new MXMSGW of 30000 from MAIL, now that host table is in
MAIL's upper segment. SMTPSR now uses ATTHST/DETHST upper
segment host table routines in NETWRK.
Flushed FTMUSF since CCRMA now on net and in host table.
08 Sep 86 JJW Removed FTIP switch and all IFE FTIP code. (Should have been
done long ago!) Cleaned up some code and removed some useless
code.
History: end of comment ⊗
PRINTS /Have you listed your changes at History: on page 2?
/
IFNDEF BUGLOG,<↓BUGLOG←←1> ;nonzero to log transactions with selected host
IFNDEF FTLFRM,<↓FTLFRM←←0> ;nonzero to log mail if relayed before here
;IFNDEF FTMUSF,<↓FTMUSF←←1> ;kludge to allow relaying to CCRMA (SAIL only!)
;IFDEF F2UUO,<↓FTMUSF←←0> ;set to zero if not at SAIL
IFNDEF FTPSKT,<FTPSKT←←=25> ;Port number for SMTP
PRINTS/To put up a new SMTPSR, save core image as TCP025.DMP[NET,SYS].
/
IFNDEF VERBOSE,<VERBOSE←←0> ;SET TO 0 FOR QUIET
IFNDEF IVERBOSE,<IVERBOSE←←0> ;SET TO 0 FOR QUIET, else typeout at I-level
IFNDEF FTMSJ,<FTMSJ←←0> ;Nonzero means extract subject from mail
;Zero now to let MAIL program find the subject
IFNDEF FTFRM,<FTFRM←←0> ;Nonzero means extract "from: line" from mail
;Zero now since SMTP has explicit "from" text
EXTERN JOBFF,JOBSA
; ACCUMULATOR DEFINITIONS:
FLG←0 ;High order bit for EOF from MAIL command, see below
↓A←1 ;TEMP
↓B←2 ;TEMP
C←3
D←4
E←5
F←6
FLG2←7 ;USED TO INSERT INITIAL SPACES IN MLFL LINES
IFN FTFRM,<
MBP←10 ;USED FOR MAIL "FROM" LINE FINDER
MCH←11 ;DITTO
>;IFN FTFRM
IFN FTMSJ,<
MSJ←12 ;USED FOR MAIL "SUBJECT" LINE FINDER
>;IFN FTMSJ
T←13
↓T1←14
↓T2←15
↓T3←16
↓P←17 ;PUSH DOWN LIST
; STORAGE ASSIGNMENTS:
PDLL←←60 ;PDL LENGTH
PDL: BLOCK PDLL
DIBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM IMP DATA CONNECTION
DOBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO IMP DATA CONNECTION
FOBUF: BLOCK 3 ;BUFFER HEADER, INPUT FROM (DSK,MTA,DTA,ETC.)
FIBUF: BLOCK 3 ;BUFFER HEADER, OUTPUT TO (DSK,MTA,DTA,ETC.)
IBUF: BLOCK 3 ;INPUT CONTROL BUFFER HEADER
OBUF: BLOCK 3 ;OUTPUT CONTROL BUFFER HEADER
ROBUF: BLOCK 3 ;buffer header, relay-log output
IFN BUGLOG,<
BOBUF: BLOCK 3 ;buffer header, bug-log output
BUGHST: -1 ;(no one) IP number of host to have transactions logged
; BUGHST: 3200,,112 ;(SIMTEL20) IP number of host to have transactions logged
; BUGHST: 4411,,303 ;(Score) IP number of host to have transactions logged
printx Logging SMTP transactions with host whose number is in BUGHST.
>;IFN BUGLOG
ICPBLK: 1 ; LISTEN
ICPSTS: 0 ; status
FTPSKT ; listen socket
-1 ; wait flag
=32 ; byte size
ICPSKT: 0 ; foreign socket
HOSTNO: 0 ; foreign host
CONECB: BLOCK 7
CNIBTS: 0 ;INTERRUPT LEVEL ROUTINES PUTS BITS HERE
OURSTR: BLOCK =10 ;our host name gets stuck here
HSTSTR: BLOCK =10 ;HOST STRING
PRIVS: 0 ;SAVE USER'S PRIVILEGES HERE
UFDFIL: 0
SIXBIT/UFD/
0
SIXBIT/ 1 1/
PASMTA: SIXBIT/GODMOD/
15
0
0
PRVMTA: SIXBIT /GODMOD/
14
IOWD 17,PRVBUF
PRVBUF: BLOCK 13
PASWD: 0 ;PASSWORD RETURNED HERE IF INF
PRIVWD: 0 ;PRIVILEGES RETURNED HERE
0 ;LAST LOGIN TIME RETURNED HERE
GRPWD: 0 ;GROUP ACCESS BITS RETURNED HERE
maxpth←←=256
REVPTH: BLOCK 1+maxpth/5 ;MAIL cmd's argument -- reverse path
COLONS: -1 ;count to ensure return path has no extra colon
IFN FTFRM,<
MFRBUF: BLOCK 40 ;FOR "FROM" LINE STORAGE (MAIL cmd's argument)
>;IFN FTFRM
IFN FTMSJ,<
MSJBUF: BLOCK 40 ;FOR "SUBJECT" LINE STORAGE
>;IFN FTMSJ
;; XRSQSW: 0 ; 0 Default scheme, -1 Text-first scheme.
; +1 Recip-first BH 7/28/80
;; XRBBEG: 0 ; Addr of start of buffer
;; XRBTOP: 0 ; Addr of 1st non-used loc (should be = JOBFF)
;; XRBPTR: 0 ; BP to deposit text at
;; XRBCNT: 0 ; If -, # chars free in buffer, else # chars.
;;MAXRCP←←=100 ;max number of recipients we're supposed to handle
SNDNAM: BLOCK 1+MAXPTH/5 ;argument of HELO command, sending host's domain&name
XRFBUF: BLOCK 1+MAXPTH/5 ; Block for remembering one recipient
XRFBZZ: 0 ; Must stay zero, overflow test
XRFBBP: 0 ; BPT for adding recipient
XRRBBP: 0 ; BPT for re-scanning recipient
XXBUF: BLOCK 1+MAXPTH/5 ; Block for remembering one recipient line
XXBZZ: 0 ; Must stay zero, overflow test
XXBBP: 0 ; BPT for adding recipient
;; XRFOBP: 0 ; BPT after last added recipient
;; XRFHBP: 0 ; Copy of OBP as flag for header generation
NBUFS←←=9 ;optimum number of disk buffers
;I/O BUFFERS
DSKIBF: BLOCK NBUFS*203 ;A WHOLE TRACK'S WORTH FOR THE MAIN DISK CHANNELS
DSKOBF: BLOCK NBUFS*203
MFDIBF: BLOCK 2*203 ;NOT WORTH IT FOR THESE LOW-USE ONES
OLDIBF: BLOCK 2*203
RLYOBF: BLOCK 2*203 ;output buffers for relay-log entry mail file
IFN BUGLOG,<
BUGOBF: BLOCK 2*203 ;output buffers for bug-log file
>;IFN BUGLOG
LOURH3←←10 ;number of host numbers to allow for ourselves
OURH3: BLOCK LOURH3 ;our host number(s), copied from system via lowcore 355
; VARIABLE DEFINITONS:
LCSS: 0 ;LOCAL CONTROL SEND SOCKET
LCRS: 0 ;LOCAL CONTROL RECEIVE SOCKET
FCSS: 0 ;FOREIGN CONTROL SEND SOCKET
FCRS: 0 ;FOREIGN CONTROL RECEIVE SOCKET
LDSS: 0 ;LOCAL DATA SEND SOCKET
LDRS: 0 ;LOCAL DATA RECEIVE SOCKET
FDRS: 0 ;FOREIGN DATA RECEIVE SOCKET
FDSS: 0 ;FOREIGN DATA SEND SOCKET
UPPN: SIXBIT/NETGUE/ ;"LOCAL" PPN OF USER FTP
ALIPPN: SIXBIT/NETGUE/ ;ALIAS PPN OF USER FTP
UPRG: 'GUE' ;JUST PRG FROM UPPN (FOR CAME IN ILDDEV)
PPNTMP: 0 ;Save user name here until password is given
PASTRY: 0 ;Number of try user has left to guess password
ifn verbose,<
SILENT: 0 ;Hide password from spies running FTPS
>;ifn verbose
DOMODE: 0 ;LEGAL MODES ARE: 0-Stream, 1-Block, 2-Text,
DIMODE: 0 ; 3-Hasp
DOTYPE: 0 ;LEGAL TYPES ARE: 0-Ascii, 1-Image, 2-Local byte,
DITYPE: 0 ; 3-Print file ascii, 4-Ebcdic
IMODES: 1000 ↔ 1010 ↔ 1010
FMODES: 1000 ↔ 1010 ↔ 1010
DOBS: =8 ;BYTE SIZE, DATA CONNECTION OUT
DIBS: =8 ;BYTE SIZE, DATA CONNECTION IN
DOACTV: 0 ;DATA OUT LINE IS ACTIVE
DIACTV: 0 ;DATA IN LINE IS ACTIVE
XACTV: 0
RTYPE: 0 ;REAL TYPE, LATEST GOTTEN FROM USER
RBS: =8 ;REAL BYTE SIZE, LATEST GOTTEN FROM USER
SCHEKF: 0 ;IF MINUS, IT'S TIME TO CHECK IMP STATUS
OUTINSTR:0 ;FOR DATGEN, WHICH OUTPUT SINK TO WRITE CHARS TO
SYNCH: 0 ;IF +, # OF UNMATCHED DATA MARK CHARS (200)
;IF -, # OF UNMATCHED INS INTERRUPTS
;WHILE -, FLUSH ALL INPUT CHARS EXCEPT DM
DIRFLC: 0 ;COUNTER FOR FLUSHING EXTRA DIRECTORY ENTRIES
RMDWAK: '<RMND>'
RMDSYS: 'RMDSYS'
0
PATCH: BLOCK 40 ;patch space
; I/O CHANNEL DEFINITONS
IMP←←4 ;CONTROL CONNECTIONS
DIMP←←1 ;DATA IN FROM IMP CHANNEL
DOMP←←0 ;DATA OUT TO IMP CHANNEL
FIMP←←3 ;FILE IN (IN FROM IMP, OUT TO DEVICE) CHANNEL
FOMP←←2 ;FILE OUT (OUT TO IMP, IN FROM DEVICE) CHANNEL
; NOTE: DIMP,FIMP ARE USED TOGETHER,
; SIMILARLY, DOMP,FOMP GO TOGETHER
; SOME OF THE ABOVE ARE USED NON-SYMBOLICALLY IN CODE!!!
.MFD←←5 ;READ MFD
.OLD←←6 ;READ OLD MAIL FILE
.PASS←←7 ;USED TO CHECK PASSWORD
UFDC←←10 ;USED TO READ UFD FOR ACCESS CHECK
RLY←←11 ;used to write .FTP file to record mail relay
BUG←←12 ;used to write .FTP file for debugging transactions
; FLG bits, left half.
MEOFBT←←1B0 ;EOF on MAIL (must be 4.9 bit!)
USREBT←←1B1 ;User command given, expecting password
PASSBT←←1B2 ;Password given, OK to STOR, etc.
IFN FTFRM,<
MFRWIN←←40000 ;MAIL "FROM" LINE FINDER IS ON THE RIGHT LINE
MFRLUZ←←20000 ;MAIL "FROM" LINE FINDER IS ON THE WRONG LINE
MFRDUN←←10000 ;MAIL "FROM" LINE FINDER IS FINISHED READING IT
>;IFN FTFRM
MFNMF←←4000 ;MLFLNM IN PROGRESS
LFSEEN←←2000 ;LF HAS BEEN EATEN IN INCOMING COMMAND LINE
LISTFL←←1000 ;DO OPERATION IS LIST (OR NLST) AS OPPOSED TO RETR OR STAT
IFN FTMSJ,<
MSJDUN←←400 ;MAIL "SUBJECT" LINE FINDER IS FINISHED READING IT
MSJWIN←←200 ;MAIL "SUBJECT" LINE FINDER IS ON THE RIGHT LINE
MSJLUZ←←100 ;MAIL "SUBJECT" LINE FINDER IS ON THE WRONG LINE
>;IFN FTMSJ
IFE FTMSJ,<
MSJDUN←←0 ;no such bit now
>;IFE FTMSJ
QUOTEF←←40 ;QUOTED STRING IN PROGRESS
LEFTF←←20 ;LEFT JUSTIFIED SIXBIT
;ABOVE ARE LH FLAGS
.MAIL←←1 ;MAIL COMMAND LIKE LOCAL MAIL (SMTP: MAIL)
.XSEN←←2 ;XSEN COMMAND LIKE LOCAL SEND/N (SMTP: SEND)
.XSEM←←4 ;XSEM COMMAND LIKE LOCAL SEND/Y (SMTP: SOML)
.XMAS←←10 ;XMAS COMMAND LIKE LOCAL SEND/M (SMTP: SAML)
;ABOVE ARE RH FLAGS AND MAYN'T BE MOVED
CPOPJ2: AOS (P)
POPJ1: ;I CAN NEVER REMEMBER
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
DEFINE MES(TEXT) <
IFN VERBOSE, <OUTSTR [ASCIZ ⊗TEXT
⊗] >>
DEFINE REPMES(TEXT) <
MOVE E,[POINT 7,[ASCIZ ⊗TEXT
⊗]]
JRST REPMET >
REPMET: PUSHJ P,GSRCI
PUSHJ P,ASCIIE
SOS IMPSTF
JRST FLUSCS
QUANTM←←=60 ;ONE CLOCK "TICK" IS ONE SECOND
;GROUP ACCESS/PRIVILEGE BITS
;None of these symbols are actually used in the code except GROUPS and MASPRV.
;GROUPS is a fullword value but MASPRV must be right half.
REAPRV←←40000
WRTPRV←←20000
MASPRV←←1
SYSPRV←←2
SCYPRV←←4
DECPRV←←10
ACTPRV←←20
CSPPRV←←40
GROUPS←←47 ;ALL OF THE ABOVE.
MXMSGW←←30000-200 ;max message size in 36-bit words (MAIL's limit, less spare room)
MXCHRS←←MXMSGW*5 ;max number of characters allowed per message (less than 10000 wds)
NCHRS: 0 ;number of characters in current message so far
;Definitions of a "global" nature ;⊗ UFDN ERRBTS
UFDN←←20 ;NUMBER OF WORDS IN A DIRECTORY ENTRY
ERRBTS←←0
DEFINE X(BIT,VAL) <
BIT ← VAL ↔ ERRBTS ← ERRBTS!VAL
>;DEFINE X
X(IODEND,020000); END OF FILE
X(IOBKTL,040000); BLOCK TOO LARGE
X(IODTER,100000); DEVICE ERROR
X(IODERR,200000); DATA ERROR
X(IOIMPM,400000); IMPROPER MODE
RFCS ←← 200000 ; RFC SENT
RFCR ←← 100000 ; RFC RECEIVED
CLSS ←← 040000 ; CLS SENT
CLSR ←← 020000 ; CLS RECEIVED
RFC ←← RFCS ! RFCR
CLS ←← CLSS ! CLSR
STLOC ←← 1
LSLOC ←← 2
WFLOC ←← 3
BSLOC ←← 4
FSLOC ←← 5
HNLOC ←← 6
EXTERNAL JOBCNI,JOBAPR,JOBREL,JOBFF
DEFINE NAMES <
; X(RNTO) ;MUST BE INDEX 1 WHEN DEFINED
; X(USER)
; X(PASS)
; X(TYPE)
; X(SOCK)
; X(STRU)
; X(MODE)
; X(BYTE)
; X(RETR)
; X(STOR)
; X(APPE)
; X(RNFR)
; X(DELE)
X(MAIL)
; X(MLFL)
; X(STAT)
X(HELP)
; X(XCWD)
; X(CWD)
; X(BYE)
; X(ABOR)
; X(LIST)
; X(NLST)
X(SEND,XSEN) ;EXPERIMENTAL, SEND/N
X(SOML,XSEM) ;EXPERIMENTAL, SEND/Y
X(SAML,XMAS) ;EXPERIMENTAL, SEND/M
; X(XRSQ) ; XRCP scheme selection
; X(XRCP) ; XRCP command itself
; X(ACCT)
; X(ALLO)
X(HELO)
X(RCPT) ;specifies a recipient
X(QUIT,BYE)
X(DATA)
X(RSET,ABOR)
X(NOOP)
>
INTINP ←← 000010
INTIMS ←← 000020
INTINS ←← 000040
INTCLK ←← 000200
;OPCODE DEFINITONS:
DEFINE INTOFF <INTMSK 1,[0]>
DEFINE INTON <INTMSK 1,[-1]>
OPDEF PTOCNT [PTYUUO 3,]
;Initial control link connection establishment ;⊗ ICP ICPCHK ICPX ICPTO KFLAG ICPGTO ICPSTO
;THIS ROUTINE ESTABLISHES BOTH CONTROL CONNECTIONS
; TO THE USER FTP, AND SKIP RETURNS. NON-SKIP RETURN
; INDICATES SOME KIND OF FAILURE.
ICP: MTAPE IMP,ICPGTO ;GET SYSTEM DEFAULT TIMEOUTS
MOVE A,ICPGTO+1 ;GET SYSTEM DEFAULT TIMEOUTS IN A
OR A,[17,,400000] ;RFC TIMEOUT≥64 SECONDS, ALLOC TIMEOUT ≥30 SEC
MOVEM A,ICPSTO+1
MTAPE IMP,ICPSTO ;SET TIMEOUTS
MOVEI A,1
MOVEM A,CONECB ;Do a LISTEN, not a connect
SETOM CONECB+WFLOC ;Wait for (duplex) connection
SETZM CONECB+FSLOC ;Listen for any foreign port
SETZM CONECB+HNLOC ;Any foreign host will do
MOVE A,LCSS
MOVEM A,CONECB+LSLOC
MOVEI A,10
MOVEM A,CONECB+BSLOC
MTAPE IMP,CONECB ;INITIATE CONNECTION OUT
MOVE A,CONECB+FSLOC ;get foreign port number
MOVEM A,FCSS ;new FTP has all foreign port nbrs the same
MOVEM A,FCRS
MOVEM A,FDRS
MOVEM A,FDRS
MOVE 0,CONECB+HNLOC ;get foreign host number
MOVEM 0,HOSTNO ;save
STATZ IMP,ERRBTS ;TIMEOUT? (OR OTHER RANDOM ERROR)?
JRST ICPTO ; YES
PUSHJ P,ICPCHK
JRST CPOPJ1
ICPCHK: MOVE A,CONECB+STLOC
TRNN A,-1
STATZ IMP,ERRBTS
JRST ICPX
POPJ P,
ICPX:
IFN VERBOSE<
OUTSTR [ASCIZ/⊗Error in control connections: /]
MOVE 0,A ;Error code where MTPERR wants it
PUSHJ P,MTPERR ;Print error message
>;IFN VERBOSE
POP P,A
POPJ P,
ICPTO: ;ICP Time Out
MES (ICP times out)
MOVE A,['KILL-1']
MOVEM A,KFLAG
JRST QUIT
KFLAG: 0
ICPGTO: =16 ↔ 0
ICPSTO: =15 ↔ 0
;Initialize local data device ;⊗ ILDDEV ILDSTT DPBIT ILDDO NOOPEN ILDVCH ILDVC1 ILDVC2 NOUFDC ACCOK ILDL69 ILDDL1 ILDDL ILDDE0 ILDDET ILDE69 ILDDE1 ILDDE ILDDUG ILDDD ILDDRN ASSHOL ILD123 ILDD ILDSS1 ILDSS2 ACCCHK OWNACC GRPCHK
;;THIS ROUTINE DOES THE NECESSARY OPEN'S, LOOKUP'S OR ENTER'S REQUIRED
;;SO THAT INPUT OR OUTPUT UUO'S ON THE CHANNELS FIMP, FOMP WILL FUNCTION.
;;NOTE: THE LOCAL DATA DEVICE NEED NOT NECCESSARILY BE THE DISK.
;; CALL: MOVE C,[<DEVICE NAME IN SIXBIT>]
;; MOVE D,[<PPN IN SIXBIT>]
;; MOVE E,[<XWD <FILE EXTENSION IN SIXBIT>,0]
;; MOVE F,[<FILE NAME IN SIXBIT>]
;; MOVEI B,1 (FOR DATA OUT TO IMP, LOCAL LOOKUP)
;; ,5 (FOR STAT, LOCAL LOOKUP, NO DATA TRANSFER)
;; ,2∨6 (FOR DATA IN FROM IMP, LOCAL ENTER)
;; (6 FOR MAIL OR MLFL, COPIES OLD FILE LATER)
;; ,3 (FOR DATA IN FROM IMP, LOCAL UPDATE)
;; ,10 (FOR RNTO OR DELE)
;; ,21 (FOR RNFR, DOES LOOKUP BUT CHECKS WRITE ACCESS)
;; PUSHJ P,ILDDEV
;; ERROR RETURN
;; SUCCESS RETURN
ILDDEV: SETZM UFDOKF# ;FLAG WHERE -1 MEANS DON'T CHECK UFD PROTECTION
CAIN B,6 ;HERE FROM MAIL OR MLFL?
SETOM UFDOKF ;YES
TRNN D,-1 ;WAS A PROGRAMMER NAME SPECIFIED?
MOVE D,ALIPPN ; NO, USE THE DEFAULT PPN
CAIN B,10
JRST ILDSTT ;DON'T CHANGE STORED FILENAME FOR RNTO OR DELE
MOVEM C,ERRDEV#
MOVEM F,ERRFIL#
HLLZM E,ERREXT#
MOVEM D,ERRPPN#
ILDSTT: TRZ B,4
TLZ FLG,(MEOFBT) ;STAYS 0 EXCEPT FOR MAIL
IFN VERBOSE, <
OUTSTR [ASCIZ /Opening local file system... /]
>
SETZM ERRTYP# ;THIS WILL INDICATE WHEN ERROR HAPPENS
MOVEM C,ILDD+1 ;store device name for OPEN
MOVE A,DOTYPE
TRNE B,2
MOVE A,DITYPE
MOVE A,FMODES(A)
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;SKIP IF NOT DISK
TRO A,200 ;***** ONLY IF DEVICE IS DISK!!
MOVEM A,ILDD
MOVEI A,2 ;ASSUME RENAME, USE INPUT CHANNEL
TRNE B,10 ;FORGET OPEN STUFF IF RENAMING
JRST DPBIT
MOVE T,B
ANDI T,3
MOVE A,[FOBUF
FIBUF,,0
FIBUF,,FOBUF]-1(T) ;BUFFER STRUCTURE
MOVEM A,ILDD+2
MOVE A,[2↔3↔3]-1(T) ;CHANNELS
DPBIT: DPB A,[POINT 4,ILDDO,12] ;DEPOSIT CHANNEL NUMBERS EVERYWHERE.
DPB A,[POINT 4,ILDDL,12]
DPB A,[POINT 4,ILDDE,12]
DPB A,[POINT 4,ILDDE1,12]
DPB A,[POINT 4,ILDDL1,12]
DPB A,[POINT 4,ILDDUG,12]
DPB A,[POINT 4,ILDL69,12]
DPB A,[POINT 4,ILDE69,12]
DPB A,[POINT 4,ILDDRN,12]
DPB A,[POINT 4,ASSHOL,12] ;YA MISSED ONE!!!
DPB A,[POINT 4,ILDVC1,12]
DPB A,[POINT 4,ILDVC2,12]
HRRM A,ILDVCH
TRNE B,10 ;NO OPEN ON RNTO
JRST NOOPEN ; BECAUSE RNFR DID IT
ILDDO: OPEN 000,ILDD
POPJ P, ;ERROR RETURN, CAN'T OPEN DEVICE
NOOPEN:
AOS ERRTYP
IFN VERBOSE, <OUTSTR [ASCIZ / OPEN/]>
ILDVCH: MOVEI T,000 ;CHANNEL NUMBER
DEVCHR T,
TLNN T,200000 ;SKIP IF DISK
JRST [AOS ERRTYP↔JRST ACCOK]
ILDVC1: GETSTS 000,T
TRO T,200
ILDVC2: SETSTS 000,(T)
MOVEI T,217
MOVEM T,ILDD
SETZM ILDD+2
OPEN UFDC,ILDD ;CHANNEL FOR UFD LOOKUPS TO CHECK FILE ACCESS
JRST [MES(Access check OPEN failure)↔POPJ P,]
MOVEM D,ILDD ;PREPARE TO LOOKUP UFD
CAMN D,[' 1 1'] ;DON'T ACCESS CHECK MFD IF READING UFD
JRST NOUFDC
HRLZI T,'UFD'
MOVEM T,ILDD+1
SETZM ILDD+2
MOVE T,[' 1 1']
MOVEM T,ILDD+3
LOOKUP UFDC,ILDD
JRST [MES(No UFD for access check)↔POPJ P,]
PUSHJ P,GRPCHK
SKIPE UFDOKF ;DO WE NEED TO CHECK THE UFD PROTECTION?
JRST NOUFDC ;NO
PUSHJ P,ACCCHK ;CHECK ACCESS
JRST [MES(UFD access prohibited)↔POPJ P,]
NOUFDC: MOVEM D,ILDD+3 ;Store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
LOOKUP UFDC,ILDD ;NOW WE CHECK THE ACTUAL FILE
JRST [AOS ERRTYP↔JRST ACCOK]
CAMN D,[' 1 1'] ;IF READING A UFD,
PUSHJ P,GRPCHK ; NOW IS THE TIME FOR GROUP CHECKING
PUSHJ P,ACCCHK ;CHECK FILE ACCESS
JRST [MES(File access prohibited)↔POPJ P,]
RELEAS UFDC, ;DONE READING FILE FOR ACCESS CHECK
ACCOK: AOS ERRTYP
MOVEM D,ILDD+3 ;store PPN in lookup block
MOVEM F,ILDD ;store filename
MOVEM E,ILDD+1 ;store extension
SETZM ILDD+2
TRNN B,1 ;going to do input?
JRST ILDDET ;no
PUSH P,JOBFF ;RECYCLE BUFFER SPACE
MOVEI T,DSKIBF ;FIXED LOCATION
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDL1 ;use more buffers for disk
ILDL69: INBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDL1: INBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF ;JUST IN CASE SOMEBODY ELSE USES IT
ILDDL: LOOKUP 000,ILDD
JRST [CAIN B,3 ;IF UPDATING, LOOKUP FAILURE IS OK
JRST ILDDE0
MES(LOOKUP failed)
POPJ P, ; OTHERWISE, IT ISN'T
]
ILDDE0:
ILDDET: TRNN B,2
JRST ILDDD ;INPUT ONLY
PUSH P,JOBFF
MOVEI T,DSKOBF
MOVEM T,JOBFF
MOVE T,C ;get device name
DEVCHR T,
TLNE T,200000 ;skip if device isn't a disk
JRST ILDDE1 ;use more buffers for disk
ILDE69: OUTBUF 000,0 ;use standard number of buffers for other devices
CAIA
ILDDE1: OUTBUF 000,NBUFS ;use optimal number of buffers for disk
POP P,JOBFF
MOVEM D,ILDD+3 ;REPLACE ZAPPED PPN
HLLZS ILDD+1 ;DATE75
SETZM ILDD+2
ILDDE: ENTER 000,ILDD
JRST [MES(ENTER failed)↔POPJ P,]
CAIN B,3 ;UPDATE FILE?
ILDDUG: UGETF 000,A ;DOES USETO TO NEXT FREE
ILDDD: MOVE T,DOTYPE
TRNE B,2
MOVE T,DITYPE
XCT ILDSS1(T)
TRNE B,1
DPB T,[POINT 6,FOBUF+1,11]
TRNE B,2
DPB T,[POINT 6,FIBUF+1,11]
TRNN B,10 ;RENAME TIME
JRST ILD123
ILDDRN: HLLZS ILDD+1
SETZM ILDD+2
ASSHOL: RENAME 000,ILDD ;DO IT
JRST [MES(RENAME failed)↔POPJ P,]
ILD123: MES ( Done)
JRST CPOPJ1
ILDD: BLOCK 4
ILDSS1: MOVEI T,7 ;TABLE OF BYTE SIZE GOBBLERS BY XFER TYPE
MOVEI T,=36
PUSHJ P,ILDSS2 ;LOCAL, NEED DOBS OR DIBS
ILDSS2: MOVE T,DOBS
TRNE B,2
MOVE T,DIBS
POPJ P,
ACCCHK: MOVE T,ILDD+2 ;GET PROTECTION
TLZ T,600000 ;FLUSH THESE LOSING BITS
SKIPN OWNER ;IF USER HAS GROUP ACCESS PRIVS TO THIS UFD,
CAMN D,UPPN ; OR IF FILE PPN IS USER'S PPN,
JRST OWNACC ; USE OWNER ACCESS
LSH T,3 ;ELSE EITHER LOCAL OR GUEST ACCESS
TLNN FLG,(PASSBT) ; DEPENDING
LSH T,3
OWNACC: TRNE B,36 ;IF ANYTHING OTHER THAN STRAIGHT READ,
LSH T,1 ; CHECK WRITE ACCESS
TLNN T,200000 ;THE MAGIC BIT SHOULD ALWAYS BE HERE NOW
AOS (P) ;ACCESS OK
POPJ P,
GRPCHK: SETZM OWNER# ;THIS WILL FLAG OWNER ACCESS
AOS ERRTYP ;WE'VE FOUND THE UFD
MTAPE UFDC,PRVMTA ;READ RETRIEVAL
POPJ P, ;CAN'T, NO GROUP ACCESS
SETZM PASWD ;JUST IN CASE WE HAVE INF
MOVE T,GRPWD ;GET FILE ACCESS GROUPS FOR THIS UFD
AND T,[GROUPS] ;JUST THE RIGHT BITS PLEASE
HRRZ A,ILDD ;PRG OF TARGET UFD
CAME A,UPRG ;PRG OF OUR USER
TRZ T,MASPRV ;NOT THE SAME, NO MAS ACCESS
TLO T,REAPRV!WRTPRV ;ALSO ALLOW REA AND WRT ACCESS
TDNE T,PRIVS ;DOES USER HAVE ANY CORRESPONDING PRIVS?
SETOM OWNER ;YES! ALLOW OWNER ACCESS
POPJ P,
;Main program starts here ;⊗ START %SITE% REGO
START: JFCL
RESET
;; SETZM HSTADR ;no host table mapped in now, since JOBFF reset
OUTSTR [ASCIZ/SMTPSR started
/]
MOVE [SIXBIT/SMTPSR/]
SETNAM
MOVE P,[XWD -PDLL,PDL] ;GET A PUSH DOWN LIST
CLKINT =30*=60*=60
SETZM PRIVS ;PARANOID? ME, PARANOID?
SETZ FLG, ;Zero flags
SETO B,
GETLIN B
MOVEM B,TTYNUM#
SETOM RECOPN# ;no relay-log file open
IFN BUGLOG,<
SETOM BUGOPN# ;no bug-log file open
>;IFN BUGLOG
SETZM OURSTR ;clear our own host string
SETZM OURH3 ;clear all our host numbers
MOVE T1,[OURH3,,OURH3+1] ;BLT source,,dest
BLT T1,OURH3+LOURH3-1 ;clear entire array
PUSHJ P,DETHST ;flush upper segment host table, if any, for SETPR2
MOVSI T1,377777
SETPR2 T1, ;peek at system
JRST [ OUTSTR [ASCIZ/?? SETPR2 failed./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
SKIPL T1,400000!355 ;lowcore 355 is aobjn ptr to our HOSTS3 address
JRST [ ;can't tell who we are if no addresses
OUTSTR [ASCIZ /?? No valid host number for us pointed to by exec 355./]
EXIT 1,
JRST %SITE% ] ;let him continue, we just don't know who we are
HLRE T2,T1 ;- number of addresses
MOVN T2,T2 ;make positive nbr of host numbers
CAILE T2,LOURH3 ;skip if our table is as at least big as systems
MOVEI T2,LOURH3 ;only store as many as we have room for
MOVSI T3,400000(T1) ;BLT source address -- in system
HRRI T3,OURH3 ;BLT dest -- our table of our host number(s)
BLT T3,OURH3-1(T2) ;copy whole table from system (or what fits)
%SITE%: DETSEG ;flush simulated upper segment (for host table later)
INIT IMP,1
('IMP')
OBUF,,IBUF
JRST NOIMP
MOVEI A,FTPSKT ;listen port
MOVEM A,LCRS ; is used for both send
MOVEM A,LCSS ; and receive of control connection
SUBI A,1 ;port one less
MOVEM A,LDRS ; is used for both send
MOVEM A,LDSS ; and receive of data connection
MOVEI A,ILEVEL ;INTENB USED TO BE AFTER ICP
MOVEM A,JOBAPR ; SO A VERY QUICK CLOSE COULD GO UNNOTICED
MOVSI A,INTINP!INTIMS!INTINS
INTENB A, ;ENABLE FOR IMP INPUT INTERRUPTS
PUSHJ P,ICP ;INITIAL CONNECTION PROTOCOL
JRST ERRKIL
INBUF IMP,2
OUTBUF IMP,2
MOVEI A,=8
DPB A,[POINT 6,IBUF+1,11]
DPB A,[POINT 6,OBUF+1,11]
;dcs: 4-12-73
;Some sites won't send allocation for our control out link until we
; send them some for our control in link. We don't do that (in the NCP)
; until the user program does something to suggest input -- so that
; user-specified allocation, if any, will be used. This test for input
; is sufficient to get our NCP to send allocation.
mtape imp,[=8] ;send them allocation for control conn.
jfcl
PUSHJ P,SAYWHO ;type out name of host we're talking to
IFN BUGLOG,<
MOVE A,HOSTNO ;get host we're connected to
CAMN A,BUGHST ;we want to record transactions with this host?
PUSHJ P,BUGBEG ;yes, open a log file (to be mailed!)
>;IFN BUGLOG
PUSHJ P,GREET ;SEND USER OUR GREETING MESSAGE
MOVEM P,SAVPDP#
REGO: MOVE P,SAVPDP
MOVE A,CIP1
MOVEM A,CIP
; MOVE A,DIP1
; MOVEM A,DIP
; MOVE A,DOP1
; MOVEM A,DOP ;BECOMES CLEAR NEED TO
SETZM CIHUNG ; SAVE DATA IN COMMON
; SETZM DIHUNG ; AND CLEAR WITH BLT'S!
; SETZM DOHUNG
SETZM QUITNG
SETZM DIACTV
SETZM DOACTV
SETZM PRIVS ;PARANOID? ME, PARANOID?
;Main loop of SMTPSR ;⊗ LOOP SCHEK STATUS
;; PROGRAM LOOPS UNTIL XACTV IS INCREASED TO ZERO, THEN GOES
;; INTO INTERRUPT WAIT. INTERRUPT-LEVEL MODULE WILL SET XACTV TO
;; A SMALL NEGATIVE INTEGER, AND MAY ALSO SET SCHEKF
LOOP: CLKINT =30*=60*=60
AOSG SCHEKF ;TIME TO CHECK IMP STATUS?
PUSHJ P,SCHEK ; YES
PUSHJ P,CIDISP ;DISPatch to Control Input handler
; SKIPE DIACTV ;Data In channel ACTiVe?
; PUSHJ P,DIDISP ; YES
; SKIPE DOACTV
; PUSHJ P,DODISP
INTMSK [0]
AOSLE XACTV ;ANYTHING STILL WANTING ATTENTION?
IMSTW [-1] ; NO, ENABLE INTERRUPTS AND WAIT
INTMSK [-1] ;ENABLE INTERRUPTS IN CASE WE SKIPPED
JRST LOOP
SCHEK: MTAPE IMP,STATUS
MOVE A,STATUS+1
OR A,STATUS+2
TLC A,RFC ;these bits should be on (now off)
TLNN A,RFC!CLS ;CONTROL LINK CLOSING?
POPJ P, ; NO, ALL IS OK
IFN VERBOSE,<
OUTSTR [ASCIZ / Control link closed!/]
>;
JRST ERRKIL
STATUS: 2 ↔ 0 ↔ 0
;Accumulator save, restore routines, also clock turning-on routine ;⊗ SAVACX SAVACS GETACS
SAVACX: 0
SAVACS: ;CALL: PUSH P,[XWD 0,<ADDRESS OF 17 WORD BLOCK>]
; JRST SAVACS
; ROUTINE DOES NOT RETURN. THE ARGUMENT
; ON THE STACK IS POPPED OFF, AND THEN A POPJ
; IS PERFORMED.
MOVEM 0,@(P) ;SAVE AC0
MOVE 0,(P)
ADD 0,[XWD 1,16] ;C(0) = 1,,LOC+16
HRRZM 0,SAVACX
SUBI 0,15 ;C(0) = 1,,LOC+1
BLT 0,@SAVACX ;SAVE AC1-16
SUB P,[XWD 1,1] ;DELETE ARGUMENT FROM STACK
POPJ P, ;RETURN UPLEVEL
GETACS: ;CALL: PUSHJ P,GETACS
; XWD 1,<ADDRESS OF 17 WORD BLOCK>
; RETURN HERE ALWAYS
HRLZ 16,@(P) ;C(16) = XWD <ADDR>,0
BLT 16,15 ;RESTORE ACS 0-15
HRRZ 16,@(P)
MOVE 16,16(16) ;RESTORE AC16
JRST CPOPJ1 ;RETURN
;Dispatch routines ;⊗ CIDISP CIREEN CIWAIT CIWAIX CIACS CIP CIP1 CIHUNG CIPDL
; CI PREFIX MEANS CONTROL INPUT
; DI PREFIX MEANS DATA INPUT
; DO PREFIX MEANS DATA OUTPUT
CIDISP: SKIPE CIHUNG ;IS CI ROUTINE HUNG? (I.E., IS IT IN THE
; MIDDLE OF SOMETHING AND WAITING?)
JRST CIREEN ; YES, REENTER CI ROUTINE
EXCH P,CIP
PUSHJ P,CIROUT ; NO, START AT BEGINNING OF CI ROUTINE
EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
SETZM CIHUNG ;INDICATE THAT CI ROUTINE FINISHED NORMALLY
POPJ P, ;RETURN TO MAIN LOOP
CIREEN: PUSHJ P,GETACS
XWD 1,CIACS
EXCH P,CIP ;RETRIEVE CI PUSHDOWN POINTER
POPJ P, ;AND RETURN WO WAITING CI ROUTINE.
CIWAIT: SETOM CIHUNG ;PUSHJ TO HERE TO MAKE CI ROUTINE WAIT
CIWAIX: EXCH P,CIP ;SAVE CI PDL, GET OLD PDL
PUSH P,[XWD 0,CIACS]
JRST SAVACS ;SAVE CI ACCUMULATORS, RETURN TO MAIN LOOP
CIACS: BLOCK 17 ;STORAGE FOR CI ACCUMULATORS 0-16
CIP: XWD -PDLL,CIPDL ;STORAGE FOR CI ACCUMULATOR 20 WHEN CI
CIP1: XWD -PDLL,CIPDL
; ROUTINE IS ACTIVE, MAIN ACC 17 OTHERWISE
CIHUNG: 0 ;NON ZERO MEANS CI ROUTINE IS WAITING
CIPDL: BLOCK PDLL
;CI routine - Read commands from control link, send answers, etc. ;⊗ CIROUT COMDIS BADCOM
CIROUT: PUSHJ P,GETCOM ;READ COMMAND FROM IMP
POPJ P, ; IT WAS A BUM COMMAND
PUSHJ P,GETIDX ;C(A) ← # OF COMMAND
PUSHJ P,@COMDIS(A)
JRST SXACTV ;4-28-73 make sure all input is read.
DEFINE X(A,B) <IFIDN<B><><0+A;>0+B>; second arg is address if different from name
COMDIS: BADCOM
NAMES
BADCOM: PUSHJ P,FLUSCS
PUSHJ P,GSRCI ;GET PERMISSION TO OUTPUT ON CONTROL CHANNEL
PUSHJ P,IMPST0
ASCIZ /500 No comprendo "/
PUSHJ P,ASCII1
C
PUSHJ P,IMPST0
ASCIZ /"
/
SOS IMPSTF ;RETURN PERMISSION
JRST FLUSCS
;Set up type and byte size for transfer ;⊗ GETSET GETSE1 GETSEL C2 GETSEA ILDERR ILDER1 STOMES ERRNUM ERRNM1 TYPNAM ERRTXT ERRTX1 TYPDSP ERRPP ERRPP1 ERRPP2 ERRMF ERRMF1 ERRFN ERRFN1
;;CALL: MOVEI B,<0 FOR DO, 1 FOR DI>
;; PUSHJ P,GETSET
;; ERROR RETURN - TYPE A AND NOT BYTE 8
;; GETSEA FAKE TYPE A BYTE 8 FOR MAIL/MLFL, NO SKIP RETURN
GETSET: MOVE A,RTYPE ;GET TYPE FROM USER
CAIN A,3 ;LOCAL PRINT
MOVEI A,0 ; IS REALLY ASCII
;;; JUMPE A,GETSEA ;ASCII USES BYTE 8 REGARDLESS
MOVE T,RBS ;ELSE WE GOBBLE REAL BYTE SIZE
CAIE T,=8
JUMPE A,CPOPJ
AOS (P)
CAIE A,1 ;IMAGE?
JRST GETSEL ;NO, LOCAL BYTE
CAIE T,=8 ;IMAGE, MAYBE CONVERT TO EASIER LOCAL BYTE
CAIN T,=32 ; BUT NOT FOR THESE BYTE SIZES
JRST GETSEL
SKIPA A,C2 ;ANY OTHER BYTE SIZE OK FOR LOCAL TYPE
GETSE1: MOVEI T,=8 ;CONSTANT BYTE SIZE FOR ASCII
GETSEL: MOVEM T,DOBS(B) ;SAVE BYTE SIZE
HRRZM A,DOTYPE(B) ; AND TYPE FOR THIS TRANSFER
C2: POPJ P,2
GETSEA: MOVEI A,0 ;ASCII TYPE
JRST GETSE1
ILDERR: PUSHJ P,GSRCI ;INTERPRET ILDDEV ERROR FOR LOSER
MOVE F,ERRTYP ;THIS IS THE TYPE OF ERROR
CAIGE F,3 ; UNLESS ERROR WAS FROM LOOKUP ETC
JRST ILDER1 ; IN WHICH CASE WE NEED ERROR CODE
HRRZ C,ILDD+1 ; FROM LOOKUP (ETC) BLOCK
SKIPA D,ERRNM1(C) ;THIS IS THE RESPONSE CODE IN THAT CASE
ILDER1: MOVE D,ERRNUM(F) ;RESPONSE CODE FOR NON-LOOKUP-ETC ERROR
MOVE E,[POINT 7,D]
PUSHJ P,ASCIIE ;PUT OUT CODE
PUSHJ P,STOMES ;PUT OUT TYPE OF OPERATION AND FILE
HRRZ C,ILDD+1 ;RESTORING CLOBBERED AC
MOVE E,[POINT 7,[ASCIZ / failed, /]]
PUSHJ P,ASCIIE
CAIGE F,3 ;DISPATCH ON ERROR AGAIN
SKIPA E,ERRTXT(F)
MOVE E,ERRTX1(C)
PUSHJ P,ASCIIE
MOVE E,[POINT 7,[ASCIZ /
/]]
PUSHJ P,ASCIIE
SOS IMPSTF
JRST FLUSCS
STOMES: MOVE D,STORTYP# ;FIND OUT WHAT HE WAS DOING
CAIN D,30
MOVEI D,4 ;FILL A BIG HOLE
MOVE E,TYPNAM-1(D) ;GET PTR TO OPERATION NAME
PUSHJ P,ASCIIE
JRST @TYPDSP-1(D) ;PUT OUT FILE NAME OR WHATEVER
ERRNUM: ASCII /451 / ;0 - OPEN FAILED
ASCII /451 / ;1 - UFD LOOKUP FAILED
ASCII /451 / ;2 - ACCESS PROHIBITED
ERRNM1: ASCII /451 / ;0 - NO SUCH FILE
ASCII /451 / ;1 - NO SUCH PPN (CAN'T HAPPEN)
ASCII /451 / ;2 - PROTECTION VIOLATION (CAN'T)
ASCII /451 / ;3 - FILE BUSY
ASCII /451 / ;4 - ALREADY EXISTS (RENAME)
ASCII /451 / ;5 - NO FILE OPEN (CAN'T)
ASCII /451 / ;6 - DIFFERENT FILENAME (R/A, CAN'T)
ASCII /451 / ;7 - CAN'T
ASCII /451 / ;10 - BAD RTVL
ASCII /451 / ;11 - BAD RTVL
ASCII /452 / ;12 - DISK FULL
TYPNAM: POINT 7,[ASCIZ /Retrieve of /]
POINT 7,[ASCIZ /Store of /]
POINT 7,[ASCIZ /Append to /]
POINT 7,[ASCIZ /Rename of /] ;REALLY STORTYP 30
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Mail scratch file open/]
POINT 7,[ASCIZ /Directory listing for /]
POINT 7,[ASCIZ /Delete of /]
ERRTXT: POINT 7,[ASCIZ /can't initialize local device/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
ERRTX1: POINT 7,[ASCIZ /no such file/]
POINT 7,[ASCIZ /no such file directory/]
POINT 7,[ASCIZ /protection failure/]
POINT 7,[ASCIZ /file busy/]
POINT 7,[ASCIZ /new filename already exists/]
POINT 7,[ASCIZ /impossible system error (5)/]
POINT 7,[ASCIZ /impossible system error (6)/]
POINT 7,[ASCIZ /impossible system error (7)/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /bad retrieval/]
POINT 7,[ASCIZ /disk is full/]
TYPDSP: ERRFN ;RETR, WHOLE FILESPEC
ERRFN ;STOR
ERRFN ;APPE
ERRFN ;RENAME
ERRPP ;STAT, FN AS PPN
CPOPJ ;MAIL
ERRFN ;USED FOR START MSG FOR LIST, NLST
ERRFN ;DELE
ERRPP: MOVE D,ERRFIL ;DO FILENAME AS PPN
ERRPP1: TLNN D,-1 ;IF MAIL, MAYBE ONLY PRG
JRST ERRPP2
MOVEI A,"["
PUSHJ P,PUTCH1
HLLZ B,D
PUSHJ P,SIXWRT
MOVEI A,","
PUSHJ P,PUTCH1
ERRPP2: HRLZ B,D
JUMPN B,.+2
MOVEI B,'* ' ;FOR MAIL
PUSHJ P,SIXWRT
TLNN D,-1
POPJ P,
MOVEI A,"]"
JRST PUTCH1
ERRMF: MOVE B,RMLF
PUSHJ P,SIXWRT
SKIPN B,RMLE
JRST ERRMF1
MOVEI A,"."
PUSHJ P,PUTCH1
PUSHJ P,SIXWRT
ERRMF1: MOVE D,RMLD
JRST ERRPP1
ERRFN: MOVE B,ERRDEV
PUSHJ P,SIXWRT
MOVEI A,":"
PUSHJ P,PUTCH1
MOVE B,ERRFIL
PUSHJ P,SIXWRT
SKIPN B,ERREXT
JRST ERRFN1
MOVEI A,"."
PUSHJ P,PUTCH1
PUSHJ P,SIXWRT
ERRFN1: MOVE D,ERRPPN
JRST ERRPP1
;⊗ HELO HELOLP NOOP NOFROM RCPT RCPTML RELDUN RCPTCL RCPTX SYNERR UNKHST BADHMS BADHM2 WHOIAM NORLAY XSEN XSEM XMAS MAIL MAILCM MAILER GETFRM GETFRL GETFRS GETFRQ GETFNQ GETFRE GETFRX OK250 NODEST DATA NMAIL MAILIN NODOT EOMAIL EOMAI2 EOMBIG SETMFL SETMFR RMDLK RMDAOS RMDFIL WRHDR WHDFRB WSCRLF WHDFRM RCDCR WRTSSP WRTSS1 WRTSTR WRTST1 WRTST2 wrtsix wrlp wrsoj SWRTCH WRTCHR CORERR IERR4 HELP NOMAIL NOUSER SYNER2 SENERR NOPPNM RCVD DAYLIT MAISTR MAIST2 MAIDEC MAI2DG
HELO: MOVE B,[POINT 7,XRFBUF] ;byte ptr for copying name
MOVEM B,XRFBBP ;save for GETCHR
SETZM XRFBZZ ;clear any previous overflow
HELOLP: PUSHJ P,GETCHR
CAIE A,12
JRST HELOLP
MOVEI A,0
IDPB A,XRFBBP ;terminate string with null
SETZM XRFBBP ;stop copying
MOVE A,[XRFBUF,,SNDNAM]
BLT A,SNDNAM-1+1+MAXPTH/5 ;copy name to where we want it
PUSHJ P,IMPSTR
ASCIZ/250 /
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPCR ;output crlf
POPJ P,
NOOP: REPMES (250 No-op acknowledged.)
NOFROM: REPMES (503 You forgot to send a MAIL command first.)
RCPT: SKIPN GOTFRM
JRST NOFROM ;no MAIL cmd yet
MOVE B,[POINT 7,XXBUF] ;byte ptr for copying line
MOVEM B,XXBBP ;save for GETCHR
SETZM XXBZZ ;clear any previous overflow
PUSHJ P,GETDST ;Get a destination name
JRST RELDUN ;JRST NORLAY ;relaying requested
JRST SYNERR ;syntax error or bad host name
JRST NOUSER ;ERROR
PUSHJ P,VALID ;LOOK UP LOSER IN MFD
JRST NOMAIL ;NO SUCH LOSER
SETZM XXBBP ;quit collecting recipient line
ifn 1,<
TRNE FLG,.MAIL!.XMAS!.XSEM ;skip if cmd is just SEND
JRST RCPTML ;not just sending, but possibly mailing
PUSHJ P,LOGGED ;see if this user is logged in
JRST SENERR ;nope
RCPTML:
>;ifn 1
RELDUN: MOVEI A,","
AOSE FSTDST ;skip if this is first destination
PUSHJ P,WRTCHR ; Separate recipients in .FTP file
MOVE B,[POINT 7,XRFBUF] ; set up BPT to copy valid recipient name
RCPTCL: ILDB A,B
JUMPE A,RCPTX
PUSHJ P,WRTCHR ;write char to .FTP file
JRST RCPTCL
RCPTX: REPMES (250 Recipient name accepted.)
SYNERR: SKIPGE SYNCOD ;skip unless really is bad host name
JRST UNKHST ;bad host name
PUSHJ P,IMPSTR
ASCIZ/500 Syntax error #/
MOVE A,SYNCOD ;get error code
PUSHJ P,IMPOCT ;output octal number from A
PUSHJ P,IMPSTR
ASCIZ/ in recipient specification: "RCPT /
JRST SYNER2 ;go copy recipient line into reply
UNKHST: MOVN E,SYNCOD ;get postive bad-host code
HRRZ E,BADHMS-1(E) ;get ptr to beginning of reply
PUSHJ P,IMPSTN ;output it
MOVEI E,DSTHNM ;ptr to losing host name string
PUSHJ P,IMPSTN ;output to foreign mailer
MOVN E,SYNCOD ;positive code again
XCT BADHM2-1(E) ;special action for this error
PUSHJ P,IMPSTR
ASCIZ/", in "RCPT /
JRST SYNER2 ;go copy recipient line into reply
;table of bad-host-name messages, selected by negative value in SYNCOD from GETDST
BADHMS: [ASCIZ/550 Unknown host (mail relay dest): "/] ;-1
[ASCIZ/550 I'm not host "/] ;-2
;table parallel to above, XCT'd
BADHM2: JFCL ;nothing special
PUSHJ P,WHOIAM ;say who I am
WHOIAM: MOVEI E,[ASCIZ/", I'm "/]
PUSHJ P,IMPSTN ;output it
MOVEI E,OURSTR ;ptr to our host name
JRST IMPSTN ;output it to foreign mailer
repeat 0,<
NORLAY: SETZM XXBBP ;quit collecting recipient line
REPMES (550 Mail relaying not yet implemented.)
>;repeat 0
;;MAIL -- ACCEPT NETWORK MAIL
XSEN: MOVEI A,[ASCIZ ⊗SEND/NOMAIL⊗]
MOVEM A,NTMLCM#
MOVEI A,.XSEN ;SEND/N
JRST MAILCM
XSEM: MOVEI A,[ASCIZ ⊗SEND/YESMAI⊗]
MOVEM A,NTMLCM
MOVEI A,.XSEM ;SEND/Y
JRST MAILCM
XMAS: MOVEI A,[ASCIZ ⊗SEND/MAIL⊗]
MOVEM A,NTMLCM
MOVEI A,.XMAS ;SEND/M
JRST MAILCM
MAIL: MOVEI A,[ASCIZ ⊗MAIL⊗]
MOVEM A,NTMLCM
MOVEI A,.MAIL ;MAIL
MAILCM: SETZM GOTFRM
RELEAS FIMP,3 ;flush any output file we were writing
TRZ FLG,17 ;TURN OFF FLG BITS FOR COMMAND
IORI FLG,(A) ;SET WHICH COMMAND WE'RE DOING
MOVEI B,6 ;CODE FOR MAIL STORE
MOVEM B,STORTYPE
SETOM EOFMAI# ;SET FLAG FOR DIEOF
SETOM FSTDST# ;flag no dests seen yet
PUSHJ P,SETMFL ;SET MAIL FILE NAME
PUSHJ P,ILDDEV ;OPEN FILE FOR OUTPUT
JRST ILDERR
TLO FLG,(MEOFBT) ;FLAGS MAIL FOR DIEOF
PUSHJ P,GETFRM ;get reverse path into REVPTH
JRST MAILER ;bad form, error reply already made
PUSHJ P,WRHDR ;write .FTP file header (mail cmd)
SETOM GOTFRM# ;flag MAIL cmd seen
POPJ P,
;Here on some syntax error in the MAIL From: command.
MAILER: RELEASE FIMP,3 ;flush output file
SETZM REVPTH ;no valid reverse path now
POPJ P,
;Get the sender field out of the MAIL From: line (the part in brackets).
;Skips on success. On syntax error, send error reply and take direct return.
GETFRM: PUSHJ P,SKPSPG ;START SCANNING HIS INPUT
MOVE B,[POINT 7,[ASCIZ/from:/]]
PUSHJ P,CHKSTR ;make sure starts with "from:"
JRST [REPMES (501 "From:" not found in command.)]
PUSHJ P,SKPSGL ;skip spaces again
CAIE A,"<" ;> ;path must start with left bracket
JRST [REPMES (501 "From:" not followed by "<".)] ;> match bracket
TLZ FLG,QUOTEF ;no quoting in progress yet
SETZM REVPTH ;clear any previous reverse path
SETOM COLONS ;count colons to avoid a particular bad format
MOVEI C,MAXPTH ;max length string we can store
SKIPA B,[POINT 7,REVPTH] ;byte ptr for storing reverse path
GETFRL: IDPB A,B ;store new char in buffer
GETFRS: PUSHJ P,GETCHR ;get a char from the command
CAIN A,42 ;double quote?
JRST [ TLC FLG,QUOTEF ;set or clear quoting flag
JRST GETFNQ] ;on to next char
TLNE FLG,QUOTEF ;skip unless quoting
JRST GETFRQ ;quoting, allow right bracket and spaces
CAIN A,":" ;count relay-host ending characters (colons)
AOSG COLONS ;skip if already had seen an earlier colon
CAIA
JRST [REPMES (501 Reverse-path has more than one colon.)]
CAIN A,76 ;right bracket?
JRST GETFRX ;yes, end of sender field--end of line next
CAIE A,11
CAIN A," "
JRST GETFRS ;ignore spaces and tabs that aren't quoted
GETFRQ: CAIE A,15 ;(match < below)
CAIN A,12 ;check for end of line without right bracket
JRST [REPMES(501 Reverse-path doesn't end with ">".)]
CAIE A,"\" ;quoting char?
JRST GETFNQ ;no
SOJLE C,GETFRE ;yes, jump if path too long now
IDPB A,B ;stuff quoter into string
PUSHJ P,GETCHR ;get quoted char, for stuffing into string
GETFNQ: SOJG C,GETFRL ;loop unless string too long
GETFRE: SETZM REVPTH
REPMES (501 Reverse-path too long.)
;Here when have seen right bracket ending reverse path -- should be crlf next.
GETFRX: MOVEI A,0 ;terminate sender string
IDPB A,B ; with null (don't keep brackets)
PUSHJ P,SKPSPG ;skip following spaces, get CR
CAIE A,15 ;command line end with CR?
JRST [REPMES (501 Extraneous text after "From:<...>" and before carriage return.)]
PUSHJ P,GETCHR ;get char after CR
CAIN A,12 ;LF?
JRST OK250 ;yup, all done, don't store CRLF
REPMES (501 Linefeed missing after carriage return ending command.)
OK250: PUSHJ P,IMPSTR
ASCIZ/250 OK
/
JRST CPOPJ1
NODEST: RELEAS FIMP,3
SETZM GOTFRM
REPMES (503 You forgot to tell me whom to mail to -- use RCPT before DATA.)
DATA: SKIPN GOTFRM ;any MAIL cmd seen?
JRST NOFROM ;nope, lose
SKIPGE FSTDST ;skip if any dests seen
JRST NODEST ;no dests
PUSHJ P,WSCRLF ;close first page of .FTP file
PUSHJ P,RCVD ;insert line saying when Received and from where
SETZM GOTFRM ;no more recipients allowed
PUSHJ P,FLUSCS ;BH 7/31/80 So MAIL @FOO[A,B] reads past crlf
MOVEI B,1 ;DI
PUSHJ P,GETSEA ;SET TYPE AND BYTE SIZE
NMAIL: PUSH P,E
PUSHJ P,IMPSTR
ASCIZ /354 What's shakin'? End text with <crlf>.<crlf>
/
POP P,E
SETZM NCHRS ;no characters in message text yet
; here at every new mail line
MAILIN: PUSHJ P,RGETCH ;CHARACTER OF MAIL
CAIE A,"." ;".", MAY BE END OF MSG
JRST NODOT
PUSHJ P,RGETCH ;SEE
CAIN A,15 ;if not end of mail, we flush leading dot anyway
JRST EOMAIL ;END OF MAIL
;here with each new char
NODOT: PUSHJ P,SWRTCH ;write out char
AOS NCHRS ;count characters in message
CAIN A,12 ;END OF LINE?
JRST MAILIN
PUSHJ P,RGETCH
JRST NODOT
EOMAIL: TLZ FLG,LFSEEN
PUSHJ P,RGETCH ;GET THE LF
MOVE A,NCHRS ;number of chars in message
CAIL A,MXCHRS ;message too big?
JRST EOMBIG ;yes, reject it
RELEASE FIMP,
PUSHJ P,IMPSTR
ASCIZ /250 Thanks for the blurb
/
MOVEI E,RMDWAK
WAKEME E, ;wake up remind phantom to deliver the mail
JFCL
EOMAI2: SKIPN QUITNG ;IF TRIED TO QUIT, TRY
POPJ P, ; AGAIN (MULTIPLE-SUICIDE MODE)
JRST BYE1
EOMBIG: RELEASE FIMP,3 ;flush output file!
PUSHJ P,IMPSTR
ASCIZ /552 Message text too long! (Try sending it in smaller pieces.)
/
JRST EOMAI2
SETMFL: MOVEM F,RMLF#
MOVEM E,RMLE#
MOVEM D,RMLD#
SETMFR: ACCTIM A, ;HIGHLY MNEMONIC FILE NAME
DPB A,[POINT 12,A,29] ;SHIFT RH BY 6 BITS
MOVEM A,RMDFIL
PJOB A,
DPB A,[POINT 6,RMDFIL,35]
INIT UFDC,217
('DSK')
0
JRST QUIT
RMDLK: MOVE A,RMDSYS
MOVEM A,RMDFIL+3
LOOKUP UFDC,RMDFIL
SKIPA A,RMDFIL+1
JRST RMDAOS
TRNE A,-1
JRST RMDAOS
MOVE F,RMDFIL
HLLZ E,RMDFIL+1
MOVE D,RMDSYS
MOVSI C,'DSK'
RELEAS UFDC,
POPJ P,
RMDAOS: MOVEI A,100
SUBM A,RMDFIL ;USED TO BE AOS, BUT SOS IS SAFER
;NOT REALLY SOS DUE TO JOB BUT THIS
;PROGRAM IS SUCH A PIECE OF SHIT ALREADY
;ANOTHER TURD WON'T HURT
JRST RMDLK
RMDFIL: 0
'FTP ' ;extension to use to write cmd file for MAIL
0
0 ;PPN stuffed in here from cell called RMDSYS
WRHDR: MOVE B,[PUSHJ P,WRTCHR]
MOVEM B,OUTINSTR
MOVE F,RMLF
MOVE E,RMLE
MOVE D,RMLD
MOVE B,NTMLCM
PUSHJ P,WRTSTR ;COMMAND AND SWITCH
MOVEI B,[ASCIZ ⊗/FROM↓⊗]
PUSHJ P,WRTSTR
SKIPE REVPTH ;DID HE IDENTIFY HIMSELF?
JRST WHDFRM ;YES, USE HIS OWN ID IN HEADER
repeat 0,< ;now we just leave an empty /FROM↓↓ switch for MAIL to see
MOVEI B,[ASCIZ / host /]
PUSHJ P,WRTSTR
MOVEI B,HSTSTR
PUSHJ P,WRTSTR
>;repeat 0
WHDFRB: MOVEI B,[ASCIZ /↓ /]
PUSHJ P,WRTSTR
POPJ P,
WSCRLF: MOVEI B,RCDCR
PUSHJ P,WRTSTR ; <CRLF>
MOVEI A,14
PUSHJ P,WRTCHR
POPJ P,
WHDFRM: MOVEI B,REVPTH
PUSHJ P,WRTSSP
JRST WHDFRB
RCDCR: ASCIZ /
/
WRTSSP: HRLI B,(<POINT 7,0>)
WRTSS1: ILDB A,B
CAIE A," " ;DISCARD LEADING SPACES AND TABS
CAIN A,11 ; IN NETWORK FROM: AND SUBJECT: LINES
JRST WRTSS1
JRST WRTST2
WRTSTR: HRLI B,(<POINT 7,0>)
WRTST1: ILDB A,B
WRTST2: JUMPE A,CPOPJ
XCT OUTINSTR
JRST WRTST1
wrtsix: movei c,6
wrlp: movei a,
lshc a,6
jumpe a,wrsoj
addi a,40
pushj p,wrtchr
jumpe t,wrsoj
caie c,4
jrst wrsoj
movei a,(t)
pushj p,wrtchr
wrsoj: sojg c,wrlp
popj p,
SWRTCH:
WRTCHR: SOSG FIBUF+2
OUT FIMP,
CAIA
JRST IERR4
IDPB A,FIBUF+1
POPJ P,
CORERR: POP P,(P)
PUSHJ P,IMPSTR
ASCIZ /452 Can't get core for message, aborting.
/
POPJ P,
IERR4: PUSHJ P,IMPSTR
ASCIZ /451 Local file system error, mail aborted
/
JRST ERRKIL
HELP: PUSHJ P,IMPSTR
ASCIZ ⊗214-Welcome to sunny California!
214-
214-Implemented Commands: HELO,MAIL,SEND,SOML,SAML,RCPT,DATA,NOOP,RSET,QUIT,HELP.
214 Report problems to Bug-SMTP @ ⊗
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPCR ;output crlf
JRST FLUSCS
NOMAIL: MOVE T1,MLDEST
TLNE T1,-1
JRST NOPPNM
NOUSER: PUSHJ P,IMPSTR
ASCIZ /550 Unrecognized MAIL recipient: "RCPT /
SYNER2: PUSHJ P,FLUSCS ;copy rest of command line to return string
MOVEI E,0
IDPB E,XXBBP ;terminate recipient line's string
ifn verbose,<
outstr xxbuf
>;ifn verbose
MOVE E,[POINT 7,XXBUF]
PUSHJ P,ASCIIE ;copy recipient line into reply
PUSHJ P,IMPSTR ;put out ending quote and crlf
ASCIZ /"
/
SETZM XXBBP ;quit collecting recipient line
SETZM XRFBBP ; No longer copying name.
POPJ P,
SENERR: PUSHJ P,IMPSTR
ASCIZ /450 User not logged in.
/
SETZM XRFBBP ; No longer copying name.
JRST FLUSCS
NOPPNM: PUSHJ P,IMPSTR
ASCIZ /550 Cannot mail to PPNs--use programmer name.
/
SETZM XXBBP ;quit collecting recipient line
SETZM XRFBBP ; No longer copying name.
JRST FLUSCS
;insert line saying when Received and from where, e.g.:
;Received: from CMU-CS-C by SU-AI with TCP/SMTP; 20 Jan 83 11:42:41 PST
;preserves all ACs but A.
RCVD: PUSH P,C
PUSH P,B
MOVEI C,[ASCIZ/Received: from /]
PUSHJ P,MAISTR
MOVEI C,HSTSTR ;ptr to host name
PUSHJ P,MAISTR ;print foreign host's name (our version)
;; MOVEI C,DOMARP ;get ptr to domain string (.ARPA)
;; PUSHJ P,MAISTR ;print it too
MOVEI C,[ASCIZ/ by /]
PUSHJ P,MAISTR
;; MOVE C,WAITST ;get waits site number
;; MOVE C,WATHST(C) ;get ptr to host name string
MOVEI C,OURSTR ;get ptr to our host name string
PUSHJ P,MAISTR ;print our host name
;; MOVEI C,DOMARP ;get ptr to domain string (.ARPA)
;; PUSHJ P,MAISTR ;print it too
MOVEI C,[ASCIZ $ with TCP; $]
PUSHJ P,MAISTR
ACCTIM A, ;get current date,,time in secs
PUSH P,A ;save time
HLRZ A,A ;date
IDIVI A,=31 ;day of month-1 to B
PUSH P,A
MOVEI A,1(B) ;day of month
PUSHJ P,MAIDEC ;print day of month
MOVEI A," "
PUSHJ P,SWRTCH
POP P,A
IDIVI A,=12 ;month-1 to B, year-=64 to A
PUSH P,A
MOVE B,@MONTAB(B) ;name of month
AND B,[BYTE (7)177,177,177] ;shorten name of month to three chars
MOVEI C,B
PUSHJ P,MAISTR ;print month name
MOVEI A," "
PUSHJ P,SWRTCH
POP P,A
ADDI A,=64
PUSHJ P,MAIDEC ;print year in two digits
MOVEI C,[ASCIZ/ /]
PUSHJ P,MAISTR
POP P,A ;time in secs
MOVEI A,(A) ;flush date from LH
IDIVI A,=60*=60 ;hours to A, secs to B
PUSH P,B
PUSHJ P,MAI2DG ;print hours as 2 digits
MOVEI A,":"
PUSHJ P,SWRTCH
POP P,A
IDIVI A,=60 ;mins to A, secs to B
PUSH P,B
PUSHJ P,MAI2DG ;print mins as 2 digits
MOVEI A,":"
PUSHJ P,SWRTCH
POP P,A
PUSHJ P,MAI2DG ;print secs as 2 digits
DAYLIT←←261 ;LOWCORE POINTER TO NONZERO IF DAYLIGHT SAVINGS TIME
MOVEI B,DAYLIT ;FIND OUT IF DAYLIGHT SAVINGS
PEEK B, ;get ptr to cell
PEEK B, ;get flag from cell
MOVEI C,[ASCIZ/ PDT
/]
SKIPN B ;skip if daylight savings
MOVEI C,[ASCIZ/ PST
/]
PUSHJ P,MAISTR ;print time zone and CRLF
POP P,B
POP P,C
POPJ P,
MAISTR: HRLI C,440700 ;make byte ptr
MAIST2: ILDB A,C
JUMPE A,CPOPJ
PUSHJ P,SWRTCH ;String to .FTP file
JRST MAIST2
MAIDEC: IDIVI A,=10 ;output decimal number to .FTP file
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,MAIDEC
HLRZ A,(P)
ADDI A,"0"
JRST SWRTCH
MAI2DG: CAIL A,=10
JRST MAIDEC ;number already has two (or more) digits
PUSH P,A
MOVEI A,"0"
PUSHJ P,SWRTCH ;print leading zero
POP P,A
ADDI A,"0"
JRST SWRTCH ;print second digit
;⊗ LOGGED LOGGE1 LOGTST JBLP JBNXT
LOGGED: PUSH P,C
PUSH P,D
PUSH P,F
PUSHJ P,LOGTST
JRST LOGGE1
POP P,F
POP P,D
POP P,C
POPJ P,
LOGGE1: POP P,(P)
POP P,F
POP P,D
POP P,C
JRST CPOPJ1
LOGTST: SKIPN MLDEST ;FORGET THIS IF MAIL TO :FILE
JRST CPOPJ1
PUSHJ P,DETHST ;flush upper segment host table, if any, for SETPR2
MOVSI A,377777 ;VERIFY SEND RECIPIENT LOGGED IN
SETPR2 A,
JRST CPOPJ1
MOVE T,400222 ;MAX JOB NUMBER
JBLP: MOVE C,400210 ;JBTSTS
ADDI C,400000(T)
MOVE C,(C)
TLNN C,40000
JRST JBNXT ;NO SUCH JOB
MOVE A,400236 ;JBTLIN
ADDI A,400000(T)
MOVE A,(A)
MOVE D,A
AOJE D,JBNXT ;DETACHED
TLNE A,4000 ;PTY BIT
TLNE A,1000 ;ARPA BIT
JRST .+2
JRST JBNXT
MOVEI B,(A)
MOVE F,400211 ;PRJPRG
ADDI F,400000(T)
MOVE F,(F) ;GET JOB'S PPN
MOVE D,MLDEST
TRNE D,-1
TLZA D,-1
HLLZS F
TLNN D,-1 ;MASK OUT WILD FIELD
HRRZS F
CAME F,D
JRST JBNXT
XCT @(P)
JBNXT: SOJG T,JBLP ;LOOK FOR MORE DESTS
DETSEG ;flush simulated segment (allow host table in)
JRST CPOPJ1
;⊗ VALID VALCL1 MFDLP MFDLP1 VWINS VLDONE GETMFD GTM1CH MFDIN MFDIN1 VTRYFT MOPEN MBUF MFDNAM MFDNAM NOMFD VSXCHR VALFIL VALFPP
COMMENT ⊗
Modified 8/2/80 by BH, to use VALDAT[RMD,SYS] instead of mfd
for validation. VALDAT's first record is an index into the rest of
the file for USETIing for extra speed; the rest is sorted PRGs from
the mfd. Don't believe any MFDxxx labels, it's really reading VALDAT. ⊗
VALID: SKIPN T1,MLDEST ;ALWAYS OK TO :FILE
JRST VALFIL ; IF THE PPN EXISTS. BH 8/17/80
SKIPE FWDING ;ALWAYS OK IF FORWARDING
JRST VWINS
TLNE T1,-1 ;Cannot mail to prj,prg now
JRST VLDONE ;Nor to prj,*
MOVE T1,[POINT 6,MLDEST,17]
VALCL1: MOVE T2,T1
ILDB T3,T1
JUMPE T3,VALCL1
MOVEM T2,FBPINI
MOVE T2,[PUSHJ P,VSXCHR]
MOVEM T2,FBPXCT
PUSHJ P,TRYFOR
JRST VWINS ;FORWARDING WINS
MOVSI C,'DSK'
PUSHJ P,GETMFD
JRST NOMFD
MFDLP: PUSHJ P,MFDIN ;GET UFD NAME
JRST VTRYFT ;EOF
COMMENT ⊗
MOVE T2,T1
MOVEI T1,UFDN-1 ;FLUSH THE REST OF THE ENTRY
MOVEM T1,DIRFLC
MFDLP1: PUSHJ P,MFDIN
JRST VTRYFT
SOSLE DIRFLC
JRST MFDLP1
JUMPE T2,MFDLP ;IGNORE ZERO PPN
MOVE T1,MLDEST
; TLNN T1,-1
HRRZS T2
; TRNN T1,-1
; HLLZS T2
CAME T1,T2
⊗
CAME T1,MLDEST
JRST MFDLP
VWINS: AOS (P)
VLDONE: RELEAS .MFD,
POPJ P,
GETMFD: MOVEM C,MOPEN+1
OPEN .MFD,MOPEN ;CHECK DEST LIST AGAINST MFD
POPJ P,
PUSH P,JOBFF
MOVEI T1,MFDIBF
MOVEM T1,JOBFF
INBUF .MFD,2
POP P,JOBFF
;;; MOVE T1,MFDNAM
MOVE T1,['MAISYS']
MOVEM T1,MFDNAM+3
LOOKUP .MFD,MFDNAM
POPJ P,
INPUT .MFD, ;READ VALDAT INDEX
MOVE T1,MLDEST ;THING TO CHECK IN INDEX
TRNN T1,777700 ;SINGLE-CHAR?
JRST GTM1CH ;YES, START AT BEGINNING OF DATA
MOVEI T2,=27 ;BEGINNING OF 3-CHAR STUFF IN INDEX
TRNN T1,770000 ;TWO-CHAR?
TDZA T2,T2 ;YES, START AT BEGINNING OF INDEX
LSH T1,-6 ;NO, FIRST CHAR IS OVER HERE
LSH T1,-6 ;RIGHT ADJUST FIRST CHAR
SUBI T1,'A'
JUMPGE T1,.+2
MOVNI T1,1 ;ANYTHING BELOW A IS -1
ADDI T2,1(T1) ;FINAL INDEX POSITION
MOVE T1,MBUF+1
IBP T1 ;I FORGET WHAT THE BPT LOOKS LIKE INITIALLY
ADDI T2,(T1) ;THIS IS POINTER TO INDEX WORD IN CORE
USETI .MFD,@(T2)
GTM1CH: SETZM MBUF+2
JRST POPJ1
MFDIN: SOSG MBUF+2 ;READ A WORD FROM MFD
IN .MFD,
JRST MFDIN1
STATO .MFD,20000
JRST NOMFD
POPJ P,
MFDIN1: ILDB T1,MBUF+1
JRST POPJ1
VTRYFT: MOVE T1,MLDEST
TLNE T1,-1 ;IF DEST ISN'T JUST PRG,
JRST VLDONE ;WE'VE HAD IT
JRST TRYFAC ;BUT IF SO GIVE FACT.TXT A CHANCE
MOPEN: 10
SIXBIT /DSK/
XWD 0,MBUF
MBUF: BLOCK 3
COMMENT ⊗
MFDNAM: SIXBIT / 1 1/
SIXBIT /UFD/
0
SIXBIT / 1 1/
⊗
MFDNAM: 'VALDAT'
0
0
SIXBIT /MAISYS/
NOMFD: REPMES (451 System error, can't read master user list.)
VSXCHR: MOVEI A,0
TLNN F,770000
POPJ P,
ILDB A,F
ADDI A,40
POPJ P,
VALFIL: JUMPE D,CPOPJ ;MAIL TO FILE, MUST BE A PPN
MOVEM D,VALFPP ;SAVE FOR LOOKUP
MOVE T1,[' 1 1'] ;PUT MFD PPN IN LOOKUP BLOCK
MOVEM T1,VALFPP+3
INIT .MFD,17
'DSK '
0
POPJ P, ;GOTTA BE A DISK
LOOKUP .MFD,VALFPP ;LOOK FOR THE UFD
JRST VLDONE ;NO, CAN'T MAIL TO FILE IN IT
JRST VWINS ;YES, OK
VALFPP: 0
'UFD '
0
' 1 1'
;⊗ MFRINI MFRCHR MFRSTR MFRING MFRQTE MFROVR
IFN FTFRM,<
MFRINI: TLNE FLG,MFRDUN ;INIT FINDING "FROM" LINE IN HEADER
POPJ P, ;NOTHING TO DO IF FOUND ALREADY
TLZ FLG,MFRWIN+MFRLUZ
MOVE MBP,[POINT 7,[ASCIZ /FROM: /]]
CAIN A," " ;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
POPJ P, ; WHERE "CATCH" MEANS IGNORE
MFRCHR: TLNE FLG,MFRLUZ!MFRDUN ;HERE FOR EACH CHAR
POPJ P, ;IF LOSING, LOSE
TLNE FLG,MFRWIN ;IF WINNING,
JRST MFRING ; WIN
ILDB MCH,MBP ;NOT SURE YET. GET A TRIAL CHAR
JUMPE MCH,MFRSTR ;IF NO MORE TO TEST, START WINNING
CAILE A,140 ;STRANGE UC/LC CONVERSION
ADDI MCH,40 ; NAMELY MAKE THE MASK AGREE
CAIE A,(MCH) ;TEST FOR EQUAL
TLO FLG,MFRLUZ ;NOPE, LOSING
POPJ P,
MFRSTR: TLO FLG,MFRWIN ;THIS IS THE FROM LINE
MOVE MBP,[POINT 7,MFRBUF]
MFRING: CAIE A,12 ;WINNING LINE:
CAIN A,15 ;IS IT OVER?
JRST MFROVR ;YUP
CAIN A,42 ;DOUBLE QUOTE?
JRST MFRQTE ;YES, CHANGE TO TWO SINGLE QUOTES!
IDPB A,MBP ;SAVE WINNING CHAR
POPJ P,
MFRQTE: MOVEI MCH,47 ;RIGHT SINGLE QUOTE
IDPB MCH,MBP ;Two of them to simulate double quote
IDPB MCH,MBP
POPJ P,
MFROVR: MOVEI MCH,0 ;FROM FINISHED
IDPB MCH,MBP ;MARK END OF FROM LINE
TLZ FLG,MFRWIN+MFRLUZ ;NOT IN PROGRESS ANYMORE
TLO FLG,MFRDUN ;DON'T LOOK AGAIN
POPJ P,
>;IFN FTFRM
;⊗ MSJINI MSJCHR MSJSTR MSJING MSJQTE MSJOVR
IFN FTMSJ,<
MSJINI: TLNE FLG,MSJDUN ;INIT FINDING "SUBJECT" LINE IN HEADER
POPJ P, ;NOTHING TO DO IF FOUND ALREADY
TLZ FLG,MSJWIN+MSJLUZ
MOVE MSJ,[POINT 7,[ASCIZ /SUBJECT: /]]
CAIN A," " ;CATCH INITIAL SPACE IN CASE OF PEOPLE LIKE US
POPJ P, ; WHERE "CATCH" MEANS IGNORE
MSJCHR: TLNE FLG,MSJLUZ!MSJDUN ;HERE FOR EACH CHAR
POPJ P, ;IF LOSING, LOSE
TLNE FLG,MSJWIN ;IF WINNING,
JRST MSJING ; WIN
ILDB MCH,MSJ ;NOT SURE YET. GET A TRIAL CHAR
JUMPE MCH,MSJSTR ;IF NO MORE TO TEST, START WINNING
CAILE A,140 ;STRANGE UC/LC CONVERSION
ADDI MCH,40 ; NAMELY MAKE THE MASK AGREE
CAIE A,(MCH) ;TEST FOR EQUAL
TLO FLG,MSJLUZ ;NOPE, LOSING
POPJ P,
MSJSTR: TLO FLG,MSJWIN ;THIS IS THE SUBJECT LINE
MOVE MSJ,[POINT 7,MSJBUF]
MSJING: CAIE A,12 ;WINNING LINE:
CAIN A,15 ;IS IT OVER?
JRST MSJOVR ;YUP
CAIN A,42 ;DOUBLE QUOTE?
JRST MSJQTE ;YES, CHANGE TO TWO SINGLE QUOTES!
IDPB A,MSJ ;SAVE WINNING CHAR
POPJ P,
MSJQTE: MOVEI MCH,47 ;RIGHT SINGLE QUOTE
IDPB MCH,MSJ ;Two of them to simulate double quote
IDPB MCH,MSJ
POPJ P,
MSJOVR: MOVEI MCH,0 ;SUBJECT FINISHED
IDPB MCH,MSJ ;MARK END OF SUBJECT
TLZ FLG,MSJWIN+MSJLUZ ;NOT IN PROGRESS ANYMORE
TLO FLG,MSJDUN ;DON'T LOOK AGAIN
POPJ P,
>;IFN FTMSJ
;⊗ sixwrt wrlp wrsoj
begin sixwrt
GLOBAL A,C
↑sixwrt:movei c,6
wrlp: movei a,
lshc a,6
jumpe a,wrsoj
addi a,40
pushj p,PUTCH1 ;WAS ASCIIC, FUCK IT
wrsoj: sojg c,wrlp
popj p,
bend sixwrt
;Command String reader ;⊗ GETCOM GETCO1 FLUSCS FLCS1 GETCO2
GETCOM: ;CALL: PUSHJ P,GETCOM
; RETURN HERE, NON-SYNTACTICAL COMMAND
; RETURN HERE, C(C) = COMMAND (IN ASCIZ),
;CLOBBERS A,B,C,D
TLZ FLG,LFSEEN ;OK TO REALLY READ FROM IMP AGAIN (FLUSCS FAKEOUT HACK)
MOVNI D,-5 ;MAXIMUM LENGTH OF COMMAND (INCLUDING DELIMITER)
MOVE B,[POINT 7,C]
SETZ C,
PUSHJ P,GETCAP
CAIE A," "
CAIN A,11
JRST .-3 ;IGNORE LEADING TABS, SPACES
CAIA
GETCO1: PUSHJ P,GETCAP
CAIN A," " ;END OF COMMAND?
JRST CPOPJ1 ; YES, SUCCESS EXIT
CAIN A,15 ;IGNORE CR!
JRST GETCO1
CAIN A,12 ;PREMATURE END OF COMMAND LINE?
JRST GETCO2 ; YES
IDPB A,B
AOJL D,GETCO1 ;LOOP FOR NEXT COMMAND CHARACTER...
PUSHJ P,GSRCI
PUSHJ P,IMPST0 ; ... UNLESS TOO MANY ALREADY
ASCIZ /500 Command more than 4 characters: /
PUSHJ P,ASCII1
C
PUSHJ P,IMPCR
SOS IMPSTF
FLUSCS: ;FLUSH COMMAND STRING
ifn verbose,<
outchr [173] ;flushing (dcs: 4-12-73)
>;ifn verbose
FLCS1: PUSHJ P,GETCHR ;GET CHARACTER
CAIE A,12 ;L.F.?
JRST FLCS1 ;LOOP FOR NEXT
ifn verbose,<
outchr [176]
>;ifn verbose
POPJ P, ; YES, EXIT (FAILURE EXIT FROM GETCOM)
;FLUSH WANTS TO SEE SOMETHING PERHAPS
GETCO2:
; AOS IBUF+2 ;BACK UP ONE IN COUNTER
; MOVE B,[100000,,0]
; ADDM B,IBUF+1 ; AND IN BUFFER
MOVEI A," " ;FAKE THE SPACE
JRST CPOPJ1
;Convert command string to index ;⊗ GETIDX ANAMES
GETIDX: ;CALL: PUSHJ P,GETIDX
; RETURN HERE, C(A) = XWD <GARBAGE>,N
; N=0 - UNRECOGNIZED COMMAND
MOVSI A,-NNAMES
CAMN C,ANAMES(A)
AOJA A,CPOPJ
AOBJN A,.-2
SETZ A,
POPJ P,
DEFINE X(A,B) <ASCIZ /A/ ↔ >
ANAMES: NAMES
NNAMES ←← .-ANAMES
;Send ASCII character out on IMP control connection ;⊗ PUTCH1 PUTCHR PUTCH2 PUTBUF PUTBU2 PUTBU2 PUTBU3
PUTCH1:
ifn verbose,<
OUTCHR A
>;ifn verbose
PUTCHR: ;CALL: MOVE A,<ASCII CHARACTER>
; PUSHJ P,PUTCHR
; RETURN HERE ALWAYS, ALL ACCUMULATORS INTACT
JUMPE A,CPOPJ ;DON'T OUTPUT NULL CHARACTER
SOSG OBUF+2 ;ROOM IN BUFFER FOR THIS CHARACTER?
PUSHJ P,PUTBUF ; NO, MAKE ROOM BY OUTPUTTING BUFFER
IFN BUGLOG,<
SKIPL BUGOPN ;bug-log file open?
PUSHJ P,BUGCHR ;yes, log this character
>;IFN BUGLOG
PUSH P,A ;JUST IN CASE
;WAITS to ASCII character conversion
CAIN A,33
SOJA A,PUTCH2 ;not-equals
CAIN A,175
MOVEI A,33 ;altmode
CAIN A,176
MOVEI A,175 ;right brace
CAIN A,32
MOVEI A,176 ;tilde
PUTCH2: IDPB A,OBUF+1 ; STUFF IT IN
POP P,A
CAIE A,12 ;IT'S A LINE FEED?
POPJ P, ; NO
JRST PUTBUF ; YES, SEND OUT ENTIRE BUFFER, AND RETURN
PUTBUF: ;CALL: PUSHJ P,PUTBUF
; RETURN HERE ALWAYS
; OUTPUTS A BUFFER OF ASCII ON THE CONTROL IMP CONNECTION.
PUSH P,B ;GET AN ACCUMULATOR
PUSH P,A
PUTBU2: LDB B,[POINT 3,OBUF+1,2];PUT MAGIC BITS FOR NULL BYTES
MOVEI A,1
LSH A,(B)
SUBI A,1
IORM A,@OBUF+1
REPEAT 0,<
PUTBU2: LDB B,[POINT 6,OBUF+1,5]
CAIGE B,10 ;IS WORD FILLED OUT?
JRST PUTBU3 ; YES
SOS OBUF+2 ; NO, FILL IT OUT WITH NOP'S
MOVEI B,202
IDPB B,OBUF+1
JRST PUTBU2
>;REPEAT 0
PUTBU3: ;IT MIGHT BE NICE TO PUT A TEST HERE
; TO MAKE SURE WE CAN DO THE OUTPUT
; WITHOUT HANGING UP FOR ALLOCATION
; OR BLOCKED LINK OR WHATEVER.
; (IN WHICH CASE, IMPSTR,DIMPSTR,DOMPSTR
; SHOULD BE DISTINGUISHED, TO PREVENT
; INTERMIXING OF THEIR MESSAGES.)
POP P,A
POP P,B ;RESTORE ACCUMULATOR
OUT IMP, ;SEND OUT THE BUFFER
POPJ P, ; SUCCESS, RETURN
MES (OUT IMP fails)
; IN THIS CASE, TIS BETTER TO GO ON THAN TO QUIT
POPJ P, ;NO MATTER WHAT THE PROBLEM, IGNORE IT
; OR LET SOMEBODY ELSE FIND IT!
; (BECAUSE SOME MAIL's CLOSE DOWN BEFORE
; ACKNOWLEDGEMENT)
;Get ASCII character from IMP control connection ;⊗ GETCHR RGETCH GETCH1 GETCH6 GETCH7 GETCH2 GETCH3 GETCH4 GETCH5 GETCAP FAKELF
GETCHR: ;CALL: PUSHJ P,GETCHR
; RETURN HERE ALWAYS, C(A) HAS CHARACTER
; CLOBBER NO ACCUMULATORS
TLNE FLG,LFSEEN ;IS THIS COMMAND LINE ALREADY DONE?
JRST FAKELF ;YUP, KEEP RETURNING LF TO MAKE FLUSCS HAPPY.
RGETCH: SOSG IBUF+2 ;CHR IN BUFFER?
JRST GETCH2 ; NO, DO AN INPUT
GETCH1: ILDB A,IBUF+1
;; CAIN A,200 ;DATA MARK?
;; AOS SYNCH ; YES, UPDATE COUNT
;; SKIPL SYNCH ;IF SYNCH IS NEGATIVE, IGNORE INPUT
;;;;; CAIN A,202 ;NOP?
CAIL A,200 ;TELNET CONTROL?
JRST RGETCH ; YES, GET ANOTHER CHARACTER
JUMPE A,RGETCH ;IGNORE NULLS
ifn verbose,<
SKIPE SILENT ;HIDING THEIR INPUT?
JRST GETCH6 ;YES
trne a,200
outchr ["↑"]
outchr a
GETCH6:
>;ifn verbose
;; TRNE A,200 ;CONTROL CHARACTER?
;; POPJ P, ;RETURN, WHATEVER IT IS
;ASCII to WAITS character conversion
CAIN A,32
AOJA A,GETCH7 ;not-equals
CAIN A,176
MOVEI A,32 ;tilde
CAIN A,175
MOVEI A,176 ;right brace
CAIN A,33
MOVEI A,175 ;altmode
GETCH7: CAIN A,12
TLO FLG,LFSEEN ;NO MORE READING UNTIL NEXT GETCOM
IFN BUGLOG,<
SKIPL BUGOPN ;bug-log file open?
PUSHJ P,BUGCHR ;yes, log this character
>;IFN BUGLOG
CAIE A,15 ;don't save cr or lf
CAIN A,12
POPJ P,
SKIPE XRFBBP ; Are we saving XRCP recipient name?
SKIPE XRFBZZ ; And not overflowed?
CAIA
IDPB A,XRFBBP ; Yes, save char.
SKIPE XXBBP ; Are we saving recipient line?
SKIPE XXBZZ ; And not overflowed?
POPJ P,
IDPB A,XXBBP ; Yes, save char.
POPJ P,
GETCH2: PUSH P,F ;GET AN ACCUMULATOR
HRRZ F,IBUF ;GET POINTER TO BUFFER
HRRZ F,(F) ;GET POINTER TO NEXT BUFFER
SKIPGE (F) ;INPUT WAITING IN NEXT BUFFER?
JRST GETCH3 ; YES
INTMSK [0] ;TURN OFF INTERRUPTS
MTAPE IMP,[10] ;INPUT WAITING IN FREE STORAGE?
JRST GETCH4 ; NO
INTMSK [-1] ; YES, RE-ENABLE INTERRUPTS
GETCH3: POP P,F ;RESTORE ACCUMULATOR
IN IMP, ;DO THE INPUT
JRST GETCH1 ; AND FETCH THE CHARACTER
JRST GETCH5 ; OOPS! INPUT FAILED
GETCH4: INTMSK [-1]
POP P,F ;RESTORE ACCUMULATOR
GETCH5: PUSHJ P,CIWAIT
JRST GETCH2
GETCAP: PUSHJ P,GETCHR ;SAME AS GETCHR, EXCEPT CHANGES
CAIL A,"a" ; LOWER CASE TO UPPER CASE
CAILE A,"z" ; BEFORE RETURNING
POPJ P,
SUBI A,"a"-"A"
POPJ P,
FAKELF: MOVEI A,12
POPJ P,
;Routines to output ASCII information on control channel ;⊗ GSRCI GSR ASCII1 ASCII2 ASCII3 ASCIIY ASCIIE ASCIIC
; NOTE: THE PRIVILEGE OF SENDING ASCII OUT ON CONTROL CHANNEL
; IS A "SCARCE RESOURCE", SINCE THE CI,DI AND DO ROUTINES MAY ALL
; TRY TO DO SO SIMULTANEOUSLY. THE FLAG "INPSTF" GOVERNS THE USE
; OF THESE ROUTINES.
; IMPORTANT: WHEN DONE, THE CALLING ROUTINE MUST RELEASE THE
; RESOURCE BY A "SOS IMPSTF" INSTRUCTION.
GSRCI: MOVEI A,IMP
GSR: ;Get Scarce Resource
;CALL: MOVEI A,<DIMP or DOMP or IMP>
; PUSHJ P,GSR
; RETURN HERE WITH CONTROL OF SCARCE RESOURCE
AOSG IMPSTF ;IS RESOURCE AVAILABLE?
POPJ P, ; YES
SOS IMPSTF ; NO
CAIN A,IMP
PUSHJ P,CIWAIT
; CAIN A,DIMP
; PUSHJ P,DIWAIT
; CAIN A,DOMP
; PUSHJ P,DOWAIT
JRST GSR
ASCII1: ;CALL: PUSHJ P,ASCII1
; <ADDRESS OF ONE WORD OF ASCII OR ASCIZ>
; RETURN HERE, 0,1,2,3,4,OR 5 CHARACTERS OUTPUT
;CLOBBERS ACCUMULATORS E,F
MOVNI F,5
PUSH P,A
MOVE E,[POINT 7,0]
HRR E,@-1(P)
ASCII2: ILDB A,E
JUMPE A,ASCII3 ;JUMP ON END OF ASCIZ STRING
PUSHJ P,PUTCH1 ;OUTPUT 1 CHARACTER
AOJL F,ASCII2 ;LOOP FOR NEXT CHARACTER
ASCII3: POP P,A
JRST CPOPJ1
ASCIIY: ILDB A,E
JUMPE A,ASCII3
PUSHJ P,PUTCH1
JRST ASCIIY
ASCIIE: ;CALL: MOVE E,[POINT 7,[ASCIZ /MESSAGE TO GO OUT ON IMP/]]
; PUSHJ P,ASCIIE
; RETURN HERE ALWAYS, ACCUMULATOR A LOST
PUSH P,[.+1] ;PUT <RETURN ADDRESS LESS ONE> ON STACK
PUSHJ P,ASCIIY ;THIS IMPLICIT RETURN ADDRESS IS CLOBBERED
POPJ P, ;THIS IS THE RETURN FROM ASCIIE
ASCIIC: PUSH P,A
PUSHJ P,GSRCI ;GET SCARCE RESOURCE -- IMP OUTPUT CONTROL
POP P,A
PUSHJ P,PUTCH1
SOS IMPSTF
POPJ P,
;Another routine to output ASCII string to IMP control channel ;⊗ IMPSTR IMPSTF IMPST0 IMPSTN IMPST1 IMPST2 IMPCR IMPSTH IMPOCT
;; IMPST0 IS A ROUTINE TO OUTPUT AN ASCII STRING TO THE IMP CONTROL
;;CHANNEL. HOWEVER, SEVERAL DIFFERENT ROUTINES MAY WISH SIMULTANEOUS
;;ACCESS TO IMPST0, WHICH WOULD CAUSE THE MESSAGES GOING OUT TO BE INTER-
;;MINGLED, AND THEREFORE GARBLED. THUS, INPST0 IS TREATED AS A "SCARCE
;;RESOURCE", AND THE COUNTER "IMPSTF" INDICATES ITS AVAILIBILITY.
;; SO, IMPST0 HAS 3 ENTRY POINTS: DIMPSTR, DOMPSTR AND IMPSTR.
;;THESE CORRESPOND TO THE 3 ROUTINES DIROUT, DOROUT AND CIROUT.
IMPSTR: AOSG IMPSTF ;IS IMPSTR AVAILABLE?
JRST IMPST0 ; YES
PUSHJ P,CIWAIT ; NO, WAIT AWHILE
SOS IMPSTF
JRST IMPSTR
IMPSTF: -1 ;MINUS ONE MEANS IMPST0 ROUTINE IS AVAILABLE
IMPST0: ;CALL: PUSHJ P,IMPST0
; ASCIZ /STRING TO BE OUTPUT/
; RETURN HERE
;CLOBBERS ACCUMULATOR E
POP P,E
PUSHJ P,IMPSTN ;output string pointed to by E
SOS IMPSTF
JRST 1(E)
;Output to IMP the ASCIZ string pointed to by RH E.
IMPSTN: HRLI E,(<POINT 7,0>)
ifn verbose,<
OUTSTR (E) ;type the message too, in case attached
>;ifn verbose
PUSH P,A
IMPST1: ILDB A,E
JUMPE A,IMPST2
PUSHJ P,PUTCHR
JRST IMPST1
IMPST2: POP P,A
POPJ P,
IMPCR: PUSHJ P,IMPSTR
ASCIZ /
/
POPJ P,
;routine to output our host name to the IMP
IMPSTH: MOVEI E,OURSTR ;get ptr to our host name string
JRST IMPSTN
IMPOCT: IDIVI A,10 ;octal output routine
HRLM B,(P)
JUMPE A,.+2
PUSHJ P,IMPOCT
HLRZ A,(P)
ADDI A,"0"
JRST PUTCH1 ;output to IMP
;⊗ SIXINL SIXINR SIXIN1 SIXIN2 SIXIN3 SIXIN4
;CR'S ARE IGNORED, ALSO LEADING SPACES AND TABS
;CALL: MOVE T3,[POINT 7,[ASCIZ /<BREAK CHARACTERS>/]]
; PUSHJ P,SIXINL/R
; RETURN HERE ALWAYS,
; C(T) = LEFT/RIGHT JUSTIFIED SIXBIT
; C(T1)= BREAK CHARACTER:
; ILLEGAL 6BIT(1-37),LF(12),OR FROM TABLE(1-177)
SIXINL: MOVE T2,[POINT 6,T]
TLOA FLG,LEFTF
SIXINR: TLZ FLG,LEFTF
SETZ T, ;PUSHJ TO HERE FOR RIGHT NORMALIZATION
PUSH P,A
PUSH P,T3 ;SAVE POINTER TO BREAK CHARACTERS
TLZ FLG,QUOTEF ;FLAG NO QUOTING IN PROGRESS
SIXIN1: ILDB A,XRRBBP ;C(A) GETS CHARACTER from rescanned string
MOVE T1,A
CAIN T1,42 ;QUOTE HACKING?
TLCA FLG,QUOTEF ;YES, TOGGLE FLAG AND CHECK STATE
CAIA
JRST SIXIN1
TLNE FLG,QUOTEF
JRST SIXIN3
CAIE T1,40
CAIN T1,11
JRST [JUMPE T,SIXIN1 ;IGNORE LEADING BLANKS AND TABS
JRST SIXIN4] ;ELSE RETURN
MOVE T3,(P) ;T3 ← POINTER TO BREAK CHARACTERS
SIXIN2: ILDB A,T3 ;A ← BREAK CHARACTER FROM TABLE
JUMPE A,SIXIN3 ;JUMP ON END OF BREAK TABLE
CAMN A,T1 ;MATCH WITH INPUT CHARACTER?
JRST SIXIN4 ; YES, GO EXIT
JRST SIXIN2 ;FETCH NEXT BREAK CHARACTER
SIXIN3: CAIL T1,"a"
CAILE T1,"z"
JRST .+2
TRZ T1,40 ;MAKE LOWER CASE INTO UPPER CASE
CAIGE T1,40
JRST SIXIN4 ;RETURN IF CHAR. HAS NO SIXBIT CODE
SUBI T1,40
ANDI T1,77
TLNE FLG,LEFTF ;LEFT JUSTIFIED SIXBIT?
JRST [ TLNE T2,770000 ;YES, ALREADY HAVE SIX CHARACTERS?
IDPB T1,T2 ;NO, STASH IT IN
JRST SIXIN1]
TLNE T,770000 ;ALREADY HAVE 6 CHARACTERS?
JRST SIXIN1 ; YES, FLUSH EXTRA CHARACTERS
LSH T,6
IOR T,T1
JRST SIXIN1 ;READ NEXT CHARACTER
SIXIN4: POP P,T3 ;RESTORE POINTER TO BREAK CHARACTERS
POP P,A ;RESTORE ACCUMULATOR A
POPJ P, ;AND RETURN
;Get file name ;⊗ GFNML GFN GFN0 GFN0A GFN1 GPPN1 GPPN2 GPPN3 GPPWIN GPPN GPPNX GPPWIN GPPFIL MLFLNM MLFLN1 OKMF
;; CALL: PUSHJ P,GFN ;(Get File Name)
;; ERROR RETURN
;; SUCCESS RETURN, C(F) = FILENAME IN SIXBIT
;; C(E) = EXTENSION IN SIXBIT
;; C(D) = PPN IN SIXBIT
;; C(C) = DEVICE IN SIXBIT
;; CLOBBERS T,T1,T2,T3 ONLY
;; CALL: PUSHJ P,GPPN ;(Get PPN)
;; ERROR RETURN
;; SUCCESS RETURN, C(D) = PPN IN SIXBIT
;Jump here from MLNB. POPJs on error, double skips on success.
GFNML: SETZM MLDEST ;MAIL TO :FILE or via indirect file (@)
SETOM DISFIL ;distribution file (or direct file)
;; MOVEM A,MBOXCH ;SAVE # OR @ FOR MAIL COMMAND
MOVE D,[' PDOC'] ;DEFAULT PPN FOR @ FILE
MOVEI E,0 ;NO DEFAULT EXT FOR @ FILE (MAIL handles it)
CAIE A,"@" ;USE ABOVE DEFAULTS FOR INDIRECT FILE
GFN: SETZB D,E ;DEFAULT EXT AND PPN
TLZ FLG,MFNMF
MOVSI C,'DSK' ;DISK IS ASSUMED DEVICE
MOVE T3,[POINT 7,[ASCIZ /:.[@/]]
PUSHJ P,SIXINL
GFN0: CAIE T1,":"
JRST GFN0A
MOVE C,T
MOVE T3,[POINT 7,[ASCIZ/.[@/]]
PUSHJ P,SIXINL
GFN0A: MOVE F,T ;SET FILE NAME
CAIE T1,"." ;EXTENSION IS NEXT?
JRST GFN1 ; NO
MOVE T3,[POINT 7,[ASCIZ /[@/]]
PUSHJ P,SIXINL
;;; This change installed for the benefit of a multiple STOR
;;; from a tenex with longer filenames, so we truncate the ext instead of
;;; refusing the transfer
HLLZS T
;;; TRNE T,-1 ;EXTENSION NAME MORE THAN 3 CHARACTERS?
;;; POPJ P, ; YES, ERROR RETURN
MOVE E,T ;SET EXTENSION NAME
GFN1: CAIE T1,"[" ;PPN IS NEXT?
JRST CPOPJ2 ; NO, SUCCESS EXIT
GPPN1: ;ENTER HERE FOR PPN ONLY
MOVE T3,[POINT 7,[ASCIZ /,]@/]]
PUSHJ P,SIXINR
GPPN2: TLNE T,-1 ;PROJECT NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
MOVS D,T
JUMPE T,CPOPJ2 ;THIS IS NO PPN ON GPPN ENTRY
CAIE T1,"," ;PROJECT & PROGRAMMER NAMES DELIMITED OK?
JRST GPPN3 ; NO, JUST PROJECT CODE
MOVE T3,[POINT 7,[ASCIZ /]@/]]
PUSHJ P,SIXINR
TLNE T,-1 ;PROGRAMMER NAME MORE THAN 3 CHARACTERS?
POPJ P, ; YES, ERROR RETURN
HRR D,T ;SET PPN
JRST CPOPJ2 ;SUCCESS RETURN
GPPN3: TLNE FLG,MFNMF ;IF MLFLNM, TAKE ERROR RETURN SIGH
POPJ P,
HRR D,ALIPPN ;GET DEFAULT PROGRAMMER NAME
JRST CPOPJ2
repeat 0,<
GPPWIN: MOVE D,T
JRST CPOPJ1
GPPN: TLZ FLG,MFNMF
GPPNX: MOVE T3,[POINT 7,[ASCIZ /[,/]]
PUSHJ P,SIXINR
JUMPE T,GPPN1
AOSE USRCMD#
JRST GPPN2
CAMN T,['ANONYM']
JRST GPPWIN
CAIN T1,","
JRST GPPN2
TLNE T,-1
POPJ P,
HRLI T,'1'
GPPWIN: MOVE D,T
JRST CPOPJ1
;; GPPFIL: LIKE GFN BUT ACCEPTS "PRJ,PRG" TO MEAN "*.*[PRJ,PRG]"
;THIS IS COMPLETELY WRONG.
GPPFIL: MOVSI F,'* '
MOVSI E,'* '
MOVEI D,0
MOVSI C,'DSK'
TLZ FLG,MFNMF
MOVE T3,[POINT 7,[ASCIZ /:[.,/]]
PUSHJ P,SIXINL
CAIE T1,","
JRST GFN0 ;WE HAVE FILENAME
TRNN T,77 ;ELSE RIGHT JUSTIFY
JRST [ LSH T,-6
JRST .-1]
JRST GPPN2 ;AND TREAT AS PPN
;; MLFLNM
MLFLNM: TLO FLG,MFNMF
PUSHJ P,GPPNX
;falls through
>;repeat 0
MLFLN1: JRST [MOVE D,T ;IF NO COMMA WAS FOUND, THAT'S
TLNN T,-1 ; OK, MAILING TO PROGRAMMER ONLY
JRST OKMF ; ELSE P OR PN WAS
POPJ P,] ;TOO LONG
OKMF: MOVSI C,'DSK'
MOVSI E,'MSG'
MOVE F,D
MOVE D,['2 2'] ;PERSON.MSG[2,2]
MOVEM F,MLDEST# ;SAVE PPN FOR HEADER ETC.
JRST CPOPJ1 ;SUCCESS RETURN
;Validate destination address ;⊗ GETDST MLNCOP MLNB MLNA MLNMIN MLNMOK PRELAY MLFILE MLNMFF MLNMF2 MLNMF0 TRYFAC FACTLP FACGE1 FACGE2 FACGE3 FACWRD FACTRY FACTST FACLUZ FACEOF FACRGT FACCHR FACCH1 HRPRIM HRLOOP HRDONE NOFACT FACERR UNRECU AMBIG FACBUF NBUFFR NBUFFX DSTHNM DSTHNX FOPEN FACTXT DORELA DORELU DORELC DORELF DOREHC DOREHE DORELH DORERR DORNUS DORNU2 HSTCHK HSTOK SCANUS MLHOST MLHOSL MLHOS2 POP12J RECRLY RECRL2 RECRL3 RECRLP RECRL0 RECRLE RECOUT RECOU2 GET0E1 GET0E2 GET0E3 GET0E4 GET0E5 GET0E6 GET0E7 GET010 GET011 GET012 GET013 GET014 GET015 GET016 GET017 GET1E1 GET1E2 GET1E3 GET1E4 GET1E5 GET1E6 GET1E7 GET1E8 GET1E9 GET110 GET111 GET112 GET1ER GET0ER COPDOM COPHST COPHS2 COPHOK CHKSTR CHKST0 SKPSPC SKPSP0 SKPSPG SKPSGL
;NEW GETDST TO ACCEPT HUMAN BEING NAMES AND LOOK IN FACT.TXT
;Validate destination address
; PUSHJ P,GETDST
; <relaying requested>
; <syntax error> or <bad host name> (latter iff SYNCOD is negative)
; <unknown user>
; <valid-user return>
GETDST: SETZM SYNCOD# ;clear error code for possible syntax error
SETZM FWDING# ;FLAG NOT FORWARDING
SETZM DQUOT# ;flag not quoted dest yet
SETZM SAWQUO# ;haven't seen any quoting (for relay check)
SETZM PRCENT# ;haven't seen percent yet
PUSHJ P,SKPSPG ;START SCANNING HIS INPUT
MOVE B,[POINT 7,[ASCIZ/to:/]]
PUSHJ P,CHKSTR ;make sure starts with "to:"
JRST GET1E1 ;didn't, syntax error, skip return with error 1
PUSHJ P,SKPSGL ;skip spaces again
CAIE A,"<" ;> ;path must start with left bracket
JRST GET1E2 ;syntax error, skip return with error 2
PUSHJ P,SKPSPG ;skip spaces after left broket
MOVE B,[POINT 7,XRFBUF] ;set up BPT to
MOVEM B,XRFBBP ; force GETCH to save name in buffer
SETZM XRFBZZ ;clear any previous overflow
IDPB A,XRFBBP ;store first char (read by SKPSPG)
CAIA ;already have first char of name now
MLNCOP: PUSHJ P,GETCHR ;get rest of line into buffer (allows rescanning it)
CAIE A,12 ;loop till end of line
JRST MLNCOP
SETZB A,DISFIL# ;not distribution file so far
IDPB A,XRFBBP ;terminate string with null
SETZM XRFBBP ;stop copying name
MOVE A,[POINT 7,XRFBUF] ;start scanning at beginning
MOVEM A,XRRBBP ;set up rescan byte ptr
ILDB A,XRRBBP ;check first char for special
CAIE A,"@" ;maybe relaying request
JRST MLNA ;nope
MLNB: ILDB A,XRRBBP ;if so, it'll have a colon later
;might CAIN A,"," ;old SMTP version used comma instead of colon
;be ppn JRST GET0E3 ;unimplemented relaying requested
CAIE A,":"
JUMPN A,MLNB ;loop unless end of string
JUMPN A,DORELA ;relaying requested, direct return
MLNA: AOS (P) ;want to skip at least once (unless reach POP12J)
MOVE A,[POINT 7,XRFBUF] ;start scanning at beginning
MOVEM A,XRRBBP ;set up rescan byte ptr
IFN FTLFRM,< ;log FROM: line if mail has been relayed before here
LDB A,[POINT 7,REVPTH,6] ;first char of reverse path
CAIN A,"@" ;atsign means was relayed
PUSHJ P,RECRLY ;record previously relayed mail
>;IFN FTLFRM
ILDB A,XRRBBP
CAIN A,42 ;dest quoted?
JRST [ SETOM DQUOT ;yes, remember that
MOVEI A," "
DPB A,XRRBBP ;replace quote with a space (assume local mail)
SETOM SAWQUO ;remember that we've flush quote, in case of relay
ILDB A,XRRBBP ;and get first real char
JRST .+1]
CAIN A,"\" ;quoting character?
JRST [ MOVEI A," "
DPB A,XRRBBP ;flush quote char for MAIL's benefit
SETOM SAWQUO ;remember that we've flush quote, in case of relay
ILDB A,XRRBBP ;yes (maybe quoting file designation char)
JRST .+1]
CAIE A,"#"
CAIN A,":" ;DEST STARTS WITH COLON
SKIPA A,["#"] ;(GFNML WILL SAVE THE CHAR FOR LATER
CAIN A,"@" ; AND WE ACCEPT INDIRECT REQUESTS)
JRST MLFILE ; SO IT'S A FILE SPEC, parse it
MOVE B,[POINT 7,NBUFFR] ;OTHERWISE WE MUST ACCUMULATE HIS NAME
MOVEI C,0 ;CHAR COUNT
MLNMIN: CAIL A,"A" ;JUST TAKE ALPHAMERICS
CAILE A,"Z" ;NONE OF THIS FUNNY STRING STUFF
CAIN A,"-" ;ACCEPT HYPHEN FOR PSEUDO-MAILBOX
JRST MLNMOK
CAIL A,"a"
CAILE A,"z"
CAIN A,"." ;accept dot in mailbox name for relaying
JRST MLNMOK
CAIN A,"%" ;Accept % sign to specify relaying
JRST [
;Flush next two instructions when MAIL can accept dest like: User%Host1%Host2
;Flushing these two instructions will allow multiple percents in SMTP relaying.
;;flushed SKIPE PRCENT ;no multiple percents yet (till MAIL takes 'em)
;;flushed JRST GET0E2 ;indicate error, two or more percents
MOVEM B,PRCENT ;save output byte ptr
MOVE T,XRRBBP ;save input byte ptr
MOVEM T,PRCENX#
JRST MLNMOK] ;and keep scanning incase multiple percent-signs
CAIL A,"0" ;allow digits in mailbox name
CAILE A,"9"
JRST MLNMFF ;not valid mailbox address char, end of name
MLNMOK: IDPB A,B
ILDB A,XRRBBP
repeat 0,< ;this can't work because of the space it sticks in the middle
;of the destination name
CAIN A,"\" ;quoting character?
JRST [ MOVEI A," "
DPB A,XRRBBP ;flush quote char for MAIL's benefit
ILDB A,XRRBBP ;yes (maybe quoting file designation char)
JRST .+1]
>;repeat 0
SKIPN NBUFFX ;QUICK & DIRTY OFLO DETECTOR
AOJA C,MLNMIN
SETZM NBUFFX ;SO HE CAN TRY AGAIN
JRST UNRECU ;NAME UNRECOGNIZED IF TOO LONG
;% seen to indicate relaying. Skip return has already been set, will be
;undone if we are successful. Here after entire address has been scanned.
PRELAY: MOVEI T,0 ;terminate name in NBUFFR at last percent
IDPB T,PRCENT
MOVE T,PRCENX ;get input byte ptr
MOVEM T,XRRBBP ;restore byte ptr for scanning relay host name
PUSHJ P,SKPSPC ;skip blanks
PUSHJ P,COPHST ;get host name into DSTHNM
JRST GET0E6 ;host name too long
MOVE T,CLRBBP ;see where @ourhst started
CAME T,XRRBBP ;is that where relay host name ended?
JRST GET0E7 ;no, bad relay host syntax
MOVEI T,0
IDPB T,B ;terminate name in DSTHNM
PUSHJ P,HSTCHK ;see if we recognize host name
JRST [ SETOM SYNCOD ;bad host name
POPJ P,]
; PUSHJ P,SKPSP0 ;skip blanks
SOS (P) ;Yes, undo previous AOS (P)
POPJ P, ;And take relay-requested return
; SETOM PRCENT ;flag that we saw a %
; JRST MLNMF2 ;now parse our host name
MLFILE: PUSHJ P,GFNML ;scan distribution list filename, double skips
JRST GET0E4 ;bad syntax
JRST GET0E5 ;can't happen
LDB A,XRRBBP ;get last char read (delimiter)
CAIE A,"]" ;end of PPN?
JRST GET017 ;nope, lose (maybe was old format: @sail,user@host)
ILDB A,XRRBBP ;yes, get char after filename
JRST MLNMF2 ;filename OK, now parse rest of line (host)
;End of name. check for @SU-AI.ARPA (etc.).
;char delimiting name is in A, should be "@" (or ending quote)
MLNMFF: MOVEI T,0 ;delimit copy of name for TRYFOR
IDPB T,B ;terminate name in NBUFFR
MLNMF2: SKIPN DQUOT ;are we quoting?
JRST MLNMF0 ;no
CAIE A,42 ;yes, should see ending double quote
JRST GET016 ;but didn't
MOVEI A," "
DPB A,XRRBBP ;replace quote with a space (assume local mail)
PUSHJ P,SKPSPC ;yup, get real delimiter afer the quote
MLNMF0: MOVE T,XRRBBP ;byte pointer past end of name in XRFBUF
MOVEM T,CLRBBP# ;save for later (below)
movem a,saveda# ;save for debugging
PUSHJ P,SKPSP0 ;skip spaces after mailbox name
CAIE A,"@" ;name must be followed by "@" and host name
JRST GET0E6 ;syntax error -- no "@" where expected
PUSHJ P,SCANUS ;scan a host name, and make sure it's ours
JRST DORNU2 ;host name too long or isn't ours
;here if host name checked out OK as ours.
CAIE A,76 ;host name should be followed by right bracket
JRST GET011
PUSHJ P,SKPSPC ;name done, skip spaces after right bracket
JUMPN A,GET013 ;jump if junk at end of line -- syntax error
MOVEI T,0
DPB T,CLRBBP ;delimit main part of recipient address
JUMPN A,GET014 ;GOTTA END WITH NULL (CRLF flushed by GETCHR)
SKIPE DISFIL ;skip unless we went to GFNML
JRST CPOPJ2 ;OK, we win
JUMPE C,GET015 ;GOTTA HAVE SOME TEXT!
SKIPE PRCENT ;Was there a % for relaying?
JRST PRELAY ;yes, check it out
AOS (P) ;no more syntax error possibility
CAIG C,3 ;IF ≤3 CHARS STORED,
JRST HRPRIM ; TREAT AS JUST PRG (MAYBE WE'LL COME BACK)
MOVE A,[POINT 7,NBUFFR] ;INITIALIZE POINTERS
MOVEM A,FBPINI#
MOVE T2,[ILDB A,F]
MOVEM T2,FBPXCT#
PUSHJ P,TRYFOR ;TRY FORWARDING
JRST OKMF ;WIN
TRYFAC: OPEN .MFD,FOPEN ;OTHERWISE WE DO THE FACT.TXT THING
JRST [REPMES (451 System error, can't open disk to find user name.)]
MOVE C,['SPLSYS']
MOVEM C,FACTXT+3
LOOKUP .MFD,FACTXT
JRST NOFACT ;TROUBLE
SETZM FACCNT# ;COUNT MATCHES HERE
FACTLP: MOVE C,[POINT 6,B] ;READ A FACT.TXT ENTRY
MOVEI B,0 ;FIRST PRG IN SIXBIT
FACGE1: PUSHJ P,FACCHR ;GET DSK CHAR
JRST FACEOF
SUBI A,40
JUMPLE A,FACGE2
IDPB A,C
JRST FACGE1 ;CONTINUES TO TAB
FACGE2: MOVEM B,FACPRG#
MOVE B,[POINT 7,FACBUF]
MOVEM B,FACBPT#
FACGE3: PUSHJ P,FACCHR ;NOW COLLECT NAME
JRST FACEOF
IDPB A,B
CAIE A,12
JRST FACGE3
MOVEI A,0
IDPB A,B
FACWRD: MOVE B,[POINT 7,NBUFFR]
MOVEM B,FCSTBP# ;PREPARE TO START SCAN
FACTRY: ILDB A,FACBPT ;COMPARISON LOOP
ILDB B,FCSTBP
JUMPE B,FACTST ;USER'S NAME DONE, CHECK END OF FILE NAME
CAIL A,140 ;IGNORE CASE DIFFERENCES
SUBI A,40
CAIL B,140
SUBI B,40
CAIE B,(A)
JRST FACLUZ ;NOT THE SAME, SORRY
JRST FACTRY ;SAME, KEEP TRYING
FACTST: CAIE A,15 ;IF NEXT FILE CHAR IS DELIM
CAIN A,40 ; (COULD FLUSH 40 TO JUST MATCH LAST NAME)
SKIPA B,FACPRG ; THEN MATCH, TELL HIM
JRST FACLUZ
MOVEM B,FACPPN# ;AND SAVE FOR LATER
repeat 0,< ;SMTP doesn't allow multiple responses to cmds
PUSHJ P,IMPSTR
ASCIZ /050 /
PUSHJ P,SIXWRT ;PUT OUT PRG IN SIXBIT
PUSHJ P,IMPSTR
ASCIZ / is the ID for user /
MOVE E,[POINT 7,FACBUF]
PUSHJ P,ASCIIE ;GOOD GRIEF
>;repeat 0
AOS FACCNT ;COUNT MATCHES
JRST FACTLP ;GET NEXT FILE ENTRY
FACLUZ: CAIN A,15 ;NON-MATCH: IF AT END OF FILE ENTRY,
JRST FACTLP ; GET ANOTHER
CAIN A,40 ;IF AT END OF FILE WORD BUT NOT ENTRY,
JRST FACWRD ; KEEP SCANNING THIS ENTRY
ILDB A,FACBPT ;OTHERWISE SCAN THE FILE MORE
JRST FACLUZ
FACEOF: CLOSE .MFD, ;END OF FACT.TXT, LET IT GO
SKIPN C,FACCNT ;HOW MANY MATCHES?
JRST UNRECU ;NONE, NO SUCH USER
SOJN C,AMBIG ;TOO MANY
SKIPA D,FACPPN ;OK, GET THE PRG CODE
FACRGT: LSH D,-6
TRNN D,77 ;RIGHT ADJUST
JRST FACRGT
MOVEM D,MLDEST
JRST OKMF ;CONTINUE AS USUAL
FACCHR: SOSG MBUF+2
IN .MFD,
JRST FACCH1
STATO .MFD,20000
JRST NOFACT
RELEAS .MFD,
POPJ P,
FACCH1: ILDB A,MBUF+1
JUMPE A,FACCHR
JRST CPOPJ1
HRPRIM: MOVEI T1,12 ;FAKE DELIM OF LF
MOVEI T,0 ;ACCUMULATE RT-JUSTIFIED NAME
MOVE B,[POINT 7,NBUFFR] ; FROM TYPEIN
HRLOOP: ILDB A,B
JUMPE A,HRDONE
CAIL A,140
SUBI A,40
SUBI A,40
LSH T,6
IORI T,(A)
TLNN T,77
JRST HRLOOP
HRDONE: TLO FLG,MFNMF
PUSHJ P,GPPN2 ;FOOLS JUMP IN...
JRST MLFLN1 ;AND AGAIN
TRNE D,-1 ; (DON'T ASK. JUST DON'T ASK.)
PUSHJ P,FLUSCS
JRST OKMF ;AND AGAIN
NOFACT: PUSHJ P,IMPSTR
ASCIZ /451 Error reading user name file--mail aborted.
/]
RELEAS .MFD,
FACERR: POP P,A ;POP RET ADDR TO THWART OLD ERROR MSG AND FLUSCS
POPJ P,
UNRECU: PUSHJ P,IMPSTR
ASCIZ /550 I don't know anybody named /
ifn verbose,<
outstr nbuffr
>;ifn verbose
MOVE E,[POINT 7,NBUFFR]
PUSHJ P,ASCIIE
PUSHJ P,IMPSTR
ASCIZ /
/]
JRST FACERR
AMBIG: PUSHJ P,IMPSTR
ASCIZ /550 Ambiguous name rejected, matches multiple users
/]
JRST FACERR
FACBUF: BLOCK 20 ;BUFFER FOR FACT.TXT NAME
NBUFFR: BLOCK 1+MAXPTH/5 ;BUFFER FOR TYPED-IN NAME (recipient path name)
NBUFFX: 0 ;BECOMES NONZERO ON OVERFLOW
DSTHNM: BLOCK 1+MAXPTH/5 ;buffer for host name
DSTHNX: 0 ;overflow detector for host name
FOPEN: 0
SIXBIT /DSK/
XWD 0,MBUF
FACTXT: SIXBIT /FACT/
SIXBIT /TXT/
0
SIXBIT /SPLSYS/
;Here to parse an explicit mail relay request for RCPT TO: command.
;Expected syntax is <@SAIL,@HOST1,@HOST2,...,@HOSTn:user@HOSTm>.
;Scan a host name (to colon or comma) and see if we found
;our own hostname (if not, error).
;If char is colon, then dest string for mail is everything after colon
;(user@HOSTm), although we must verify HOSTm as a known host.
;If char is comma, then should be followed by "@" and next host name; scan
;host name for known host. Host name should be followed by comma or colon;
;dest string for mail is:
; ↓:everything.after.hostname.including.comma.or.colon↓%hostname
DORELA: MOVE A,[POINT 7,XRFBUF] ;start scanning at beginning
MOVEM A,XRRBBP ;set up rescan byte ptr
ILDB A,XRRBBP ;check first char for special
CAIE A,"@" ;must be atsign (was last time we looked)
JRST GET1E3 ;impossible error
PUSHJ P,SCANUS ;scan a host name, and make sure it's ours
JRST DORNUS ;host name too long or isn't ours
CAIN A,":" ;colon now means next text is user@hostm
JRST DORELU ;process @sail:user@hostm
CAIE A,"," ;otherwise better be comma
JRST GET1E4 ;bad syntax
PUSHJ P,SKPSPC ;get another @ after comma
CAIE A,"@" ;better be one
JRST GET1E5 ;oops, syntax error
PUSHJ P,SKPSPC ;skip spaces again
PUSHJ P,COPHST ;get host name into DSTHNM
JRST GET1E6 ;host name too long
MOVEI T,0
IDPB T,B ;terminate name in DSTHNM
PUSHJ P,HSTCHK ;see if we recognize host name
JRST DORERR ;bad host name, restore ACs and take error return
;now we've verified that the host we have to relay on to is known to us
PUSHJ P,SKPSP0 ;skip spaces around host name
CAIE A,":" ;host name must be followed by one of
CAIN A,"," ; these two chars
CAIA ;OK
JRST GET1E7 ;but it isn't!
SKIPA C,[76] ;terminator to check for is right bracket
DORELU: MOVEI C,"@" ;terminate copy on atsign
;output .FTP file to record relay event by mailing msg to MAIL-RELAY-LOG/-H
;Text of entry is: MAIL MAIL-RELAY-LOG/-H<crlf><ff>
; date/time, remote host initiating, mail sender, mail dest.
;sender is in REVPTH
;dest is in XRFBUF
PUSH P,A ;preserve indicator characters
PUSH P,C
PUSHJ P,RECRLY ;record relay in .FTP file
POP P,C
POP P,A
MOVE B,[POINT 7,XRFBUF] ;set up BPT to move name to front of buffer
MOVEI T,"↓" ;quote the whole string to MAIL
IDPB T,B
CAIE C,"@" ;skip if only one more host, final relay
IDPB A,B ;insert colon or comma for SMTP relaying
MOVEI T,0 ;no right bracket yet
DORELC: ILDB A,XRRBBP ;move rest of forwarding path to front of buf
IDPB A,B ;can't overflow, since didn't before (same buf)
CAIN A,(C) ;find last right bracket or atsign
MOVE T,B ;save byte ptr to last right bracket/atsign
JUMPN A,DORELC ;loop to end of path (null)
JUMPE T,GET1E8 ;no right bracket seen!
MOVEI A,"↓" ;end quoted string for MAIL
DPB A,T ;overwrite bracket with quoter
CAIN C,"@" ;if here via DORELU, scan host name now
JRST DORELH ;go copy host name into DSTHNM and verify it
DORELF: MOVEI A,"%"
IDPB A,T ;signal remote host to MAIL
SKIPA B,[POINT 7,DSTHNM] ;byte ptr to host name
DOREHC: IDPB A,T
SKIPE XRFBZZ ;check for overflow
JRST GET1E9 ;ovrfl: unlikely, it all came out of same buffer
ILDB A,B ;copy destination host name for MAIL
JUMPN A,DOREHC ;loop till the final null
JUMPE C,CPOPJ ;jump if came via DORELH -- no /-E needed
MOVE B,[POINT 7,[ASCIZ $/-E$]] ;add switch to indicate relaying to MAIL
DOREHE: ILDB A,B
IDPB A,T ;(even allow overflow into XRFBZZ!)
JUMPN A,DOREHE ;loop till copied the final null
POPJ P, ;destination string now ready in XRFBUF
;Byte ptr to output string for MAIL dest is now in T. Must not clobber it.
DORELH: MOVEM T,XRRBBP ;set up byte ptr to scan host name now
PUSHJ P,SKPSPC ;skip spaces around host name
PUSHJ P,COPHST ;get host name into DSTHNM
JRST GET1E6 ;host name too long
MOVEI C,0
IDPB C,B ;terminate name in DSTHNM
PUSHJ P,HSTCHK ;see if we recognize host name
JRST DORERR ;bad host name, restore ACs and take error return
;now we've verified that the host we have to relay on to is known to us
PUSHJ P,SKPSP0 ;skip spaces around host name
CAIE A,76 ;host name must be followed by right bracket
JRST GET112 ;oops
JRST DORELF ;now copy host name into string for MAIL (via T)
;here if unrecognized host name, flag it and take same error return as syntax err
DORERR: SETOM SYNCOD ;negative error code means unknown host
JRST CPOPJ1 ;take skip return for unknown host
;here if host name given isn't ours; flag it, take same error return as syntax err.
;enter at DORNU2 if return addr already has been AOS'd.
DORNUS: AOS (P) ;skip return for bad host
DORNU2: MOVNI E,2 ;-2 flags host name as not ours when it should be
MOVEM E,SYNCOD ;negative error code means bad host name
POPJ P,
;routine to skip iff host name in DSTHNM is known to us. preserves all ACs.
HSTCHK: PUSHJ P,CHKHTB ;make sure have host table segment
MOVEM 11,1+11(P) ;save ACs (NETWRK clobbers 0:11)
MOVEI 11,1(P) ;source,,dest of BLT from ACs
BLT 11,1+10(P) ;save only those NETWRK says it clobbers
ADJSP P,12 ;fix stack
MOVEI 0,DSTHNM ;ptr to host name to look up
repeat 0,< ;CCRMA is now in host table
IFN FTMUSF,<
MOVE 1,DSTHNM
AND 1,[BYTE (7) 137,137,137,137,137]
CAMN 1,[ASCII/CCRMA/]
JRST HSTOK ;special kludge for CCRMA (copied from MAIL)
>;IFN FTMUSF
>;repeat 0
PUSHJ P,HSTNAM ;check host name
SOSA -12(P) ;no such host, take error return
SOS -12(P) ;ambiguous host, take error return
HSTOK: MOVSI 11,-11(P) ;source,,dest of BLT to ACs
BLT 11,11 ;restore ACs 0:11
ADJSP P,-12 ;back up the stack ptr
JRST CPOPJ1 ;assume success (unless HSTNAM failed)
;Scan buffer for a host name, and see if it is ours
;Direct return if name too long or isn't ours.
;Skip if host name is ours.
SCANUS: PUSHJ P,CHKHTB ;make sure have host table segment
PUSHJ P,SKPSPC ;skip spaces after "@"
PUSHJ P,COPHST ;copy host name to special block
POPJ P, ;host name too long
MOVEI T,0
IDPB T,B ;terminate name in DSTHNM
PUSHJ P,SKPSP0 ;skip spaces around host name
MOVEM 11,1+11(P) ;save ACs (NETWRK clobbers 0:11)
MOVEI 11,1(P) ;source,,dest of BLT from ACs
BLT 11,1+10(P) ;save only those NETWRK says it clobbers
ADJSP P,12 ;fix stack
MOVEI 0,DSTHNM ;ptr to host name to look up
PUSHJ P,HSTNAM ;check host name
JRST POP12J ;no such host, restore ACs and take error return
JRST POP12J ;ambiguous host, restore ACs and take error return
MLHOST: MOVE 1,[-LOURH3,,OURH3] ;aobjn ptr to list of our host nbrs
MLHOSL: CAMN 0,(1) ;is this one of our host nbrs?
JRST [ AOS -12(P) ;host name was OK, it's ours, success return
JRST POP12J] ;restore ACs and win
AOBJN 1,MLHOSL ;no, check other numbers
MLHOS2: PUSHJ P,HSTNXA ;get next host address for name given earlier
JRST POP12J ;none, lose
JUMPN 0,MLHOST ;if non-zero, then try it out
POP12J: MOVSI 11,-11(P) ;source,,dest of BLT to ACs
BLT 11,11 ;restore ACs 0:11
ADJSP P,-12 ;back up the stack ptr
POPJ P, ;host name isn't ours
;Open .FTP file and write a log entry for relayed mail
;Note that any file opened here is closed at QUIT.
RECRLY: PUSH P,OUTINSTR ;preserve whatever there is
MOVE D,[PUSHJ P,RECOUT] ;instruction to output char to event log mailer
MOVEM D,OUTINSTR
AOSE RECOPN ;skip if file not open already
JRST RECRL3 ;already done first part
INIT RLY,200 ;open device
'DSK '
ROBUF,,0 ;output buffer hdr
JRST RECRLE ;lose
RECRL2: PUSHJ P,SETMFR ;get filename for .FTP file in RMDFIL
MOVEM D,RMDFIL+3 ;store PPN
ENTER RLY,RMDFIL ;create .FTP file for relay log entry
JRST RECRL0 ;failed, see why, maybe retry
PUSH P,JOBFF
MOVEI B,RLYOBF
MOVEM B,JOBFF
OUTBUF RLY,2 ;two buffers should be plenty
POP P,JOBFF
MOVEI B,[ASCIZ $MAIL/-H MAIL-RELAY-LOG
$]
PUSHJ P,WRTSTR ;start file with above string
MOVEI A,14 ;a formfeed ends cmd page for MAIL
XCT OUTINSTR
RECRL3: PUSHJ P,DATGEN ;output date to log entry
MOVEI B,[ASCIZ/ relay from /]
PUSHJ P,WRTSTR
MOVEI B,HSTSTR ;pointer to host name
PUSHJ P,WRTSTR ;say whom mail came to us from
MOVEI B,[ASCIZ/
mail from:</]
PUSHJ P,WRTSTR
MOVEI B,REVPTH
PUSHJ P,WRTSTR ;output rest of MAIL FROM: line
MOVEI B,[ASCIZ/>
rcpt to:</] ;>;matching bracket
PUSHJ P,WRTSTR
MOVEI B,XRFBUF
PUSHJ P,WRTSTR ;output rest of RCPT TO: line
MOVEI B,RCDCR ;output CRLF
PUSHJ P,WRTSTR
RECRLP: POP P,OUTINSTR ;restore whatever was here before
POPJ P,
RECRL0: HRRZ B,RMDFIL+1 ;get error code
CAIN B,3 ;busy file?
JRST RECRL2 ;yes, try another filename
RECRLE: SETOM RECOPN ;some strange error, give up
JRST RECRLP
RECOUT: SOSG ROBUF+2
OUT RLY,
JRST RECOU2
OUTSTR [ASCIZ/OUT uuo failed for RLY channel, aborting mail relay log entry.
/]
MOVSI A,(<JFCL>)
MOVEM A,OUTINSTR ;make sure we don't try any more
RELEAS RLY,
SETOM RECOPN ;no longer open
POPJ P,
RECOU2: IDPB A,ROBUF+1
POPJ P,
GET0E1: JSP T,GET0ER ;set error code and take direct return
GET0E2: JSP T,GET0ER
GET0E3: JSP T,GET0ER
GET0E4: JSP T,GET0ER
GET0E5: JSP T,GET0ER
GET0E6: JSP T,[ JUMPN A,GET0ER ;give error to foreign mailer unless have a null
repeat 0,< ;bug fixed -- don't halt -- this is foreign mailer's real syntax error
INTMSK [0] ;disable interrupts for now (connection may die...)
PUSH P,T
MOVE T,['GET ME']
SETNAM T, ;change our name to attract attention
POP P,T
HALT $.+1
INTMSK [-1] ;re-enable after continuing
>;repeat 0
JRST GET0ER ]
GET0E7: JSP T,GET0ER
GET010: JSP T,GET0ER
GET011: JSP T,GET0ER
GET012: JSP T,GET0ER
GET013: JSP T,GET0ER
GET014: JSP T,GET0ER
GET015: JSP T,GET0ER
GET016: JSP T,GET0ER
GET017: JSP T,GET0ER
GET1E1: JSP T,GET1ER ;set error code and take skip return
GET1E2: JSP T,GET1ER
GET1E3: JSP T,GET1ER
GET1E4: JSP T,GET1ER
GET1E5: JSP T,GET1ER
GET1E6: JSP T,GET1ER
GET1E7: JSP T,GET1ER
GET1E8: JSP T,GET1ER
GET1E9: JSP T,GET1ER
GET110: JSP T,GET1ER
GET111: JSP T,GET1ER
GET112: JSP T,GET1ER
GET1ER: AOS (P) ;set skip return and then store error code
SUBI T,GET1E1-GET0E1 ;adjust PC to other table
GET0ER: MOVSI T,-GET0E1(T) ;calculate syntax error code
HRRI T,(A) ;include last character (or whatever) in code
MOVEM T,SYNCOD ;store for error reply
POPJ P,
;discard domain name, skip on success (always, unless host name already too long)
COPDOM: TDZA B,B ;don't save output -- discard domain name
;copy host name to DSTHNM, skip on success, no-skip on name too long
COPHST: MOVE B,[POINT 7,DSTHNM] ;byte ptr for saving destination host name
COPHS2: CAIL A,"A" ;JUST TAKE ALPHAMERICS and dash
CAILE A,"Z" ;NONE OF THIS FUNNY STRING STUFF
CAIN A,"-" ;ACCEPT HYPHEN FOR PSEUDO-MAILBOX or host
JRST COPHOK
CAIL A,"a"
CAILE A,"z"
CAIN A,"." ;allow dot in host name for domain
JRST COPHOK
CAIL A,"0" ;allow digits in names
CAILE A,"9"
JRST CPOPJ1 ;end of name -- not letter, digit or hyphen
COPHOK: IDPB A,B
ILDB A,XRRBBP
SKIPN DSTHNX ;QUICK & DIRTY OFLO DETECTOR
JRST COPHS2 ;no overflow, keep scanning
SETZM DSTHNX ;clear overflow flag
POPJ P, ;NAME TOO LONG, error return
;compare input string against a constant. skip if OK. ignore case.
;B points to constant. call with A containing first char already.
CHKSTR: ILDB C,B
JUMPE C,CPOPJ1 ;skip if end of constant
CAIN C,(A)
JRST CHKST0 ;OK so far
CAIL C,"A" ;maybe letter of different case
CAILE C,"z"
POPJ P, ;different chars, lose
CAILE C,"Z"
CAIL C,"A"
TRC C,40 ;invert case of constant string's letter
CAIE C,(A)
POPJ P, ;different chars
CHKST0: PUSHJ P,GETCHR ;next input char
JRST CHKSTR ;loop
SKPSPC: ILDB A,XRRBBP
SKPSP0: CAIE A,40 ; SKIPPING IRRELEVANCIES
CAIN A,11
JRST SKPSPC
POPJ P,
SKPSPG: PUSHJ P,GETCHR
SKPSGL: CAIE A,40 ; SKIPPING IRRELEVANCIES
CAIN A,11
JRST SKPSPG
POPJ P,
;Forwarding ;⊗ FF CR LF TAB TRYFOR TRYFO0 TRYFO1 FORLIN FORCHR FORNO FORTEL FORTE1 FORTE2 FOTAB FORCPY FORCP1 FORCP2 FORZIP FORCHG FORTXT
FF←←14
CR←←15
LF←←12
TAB←←11
TRYFOR:
repeat 0,<
SKIPE XRFBBP ;Doing XRCP R scheme?
JRST TRYFO0 ;Yes, accept forwarding.
TRNN FLG,.MAIL
JRST CPOPJ1 ;NO FORWARDING EXCEPT FOR MAIL CMD
TRYFO0:
>;repeat 0
MOVEM B,FORB#
MOVEM C,FORC#
MOVEM D,FORD#
MOVEM E,FORE#
MOVEM F,FORF#
OPEN .MFD,FOPEN
JRST [REPMES (451 System error, can't open disk to find user name.)]
MOVE C,['MAISYS']
MOVEM C,FORTXT+3
LOOKUP .MFD,FORTXT
JRST NOFACT ;TROUBLE
PUSHJ P,FORCHG ;CHECK FOR E DIRECTORY
MOVE T1,MBUF+1
MOVE T2,(T1)
CAME T2,[ASCII /COMME/]
JRST FORLIN
MOVE T2,1(T1)
CAME T2,[ASCII /NT ⊗ /]
JRST FORLIN
MOVE T2,2(T1)
CAME T2,[ASCII / VAL/]
CAMN T2,[ASCII /INVAL/]
JRST TRYFO1
JRST FORLIN
TRYFO1: PUSHJ P,FORCHG
JUMPE A,FORLIN
CAIE A,FF
JRST TRYFO1
PUSHJ P,FORCHG
FORLIN: MOVE F,FBPINI ;NEW LINE OF FILE, REREAD THE USER'S STRING
FORCHR: JUMPE A,FORZIP ;FORMAT ERROR, EOF IN MID-LINE
CAIN A,LF
JRST FORZIP ;FORMAT ERROR, LINE ENDS W/O TAB
CAIN A,TAB
JRST FOTAB ;END OF STRING IN FILE
PUSH P,A
XCT FBPXCT ;ELSE GET A CHAR FROM USER'S STRING
POP P,T1
CAIL T1,140
SUBI T1,40
CAIL A,140
SUBI A,40 ;LC TO UC
CAIE T1,(A) ;MATCH THE FILE?
JRST FORNO ;NO, GO TO NEXT LINE
PUSHJ P,FORCHG ;READ CHAR FROM FORWRD.TXT
JRST FORCHR
FORNO: PUSHJ P,FORCHG ;SKIP TO END OF LINE
JUMPE A,FORZIP
CAIE A,LF
JRST FORNO
PUSHJ P,FORCHG ;BEGINNING OF NEXT LINE
JUMPE A,FORZIP ;DONE IF DONE
JRST FORLIN ;ELSE CHECK OUT THIS LINE
FORTEL: AOJN C,FORCPY ;JUMP IF NOT FIRST GRITCH
repeat 0,< ;no multiple responses in smtp
PUSHJ P,IMPSTR
ASCIZ /050 Mail for /
PUSH P,F
MOVE F,FBPINI
FORTE1: XCT FBPXCT ;COPY THE FORWARDEE
JUMPE A,FORTE2
PUSHJ P,PUTCH1
JRST FORTE1
FORTE2: PUSHJ P,IMPSTR
ASCIZ / will be forwarded to /
POP P,F
>;repeat 0
JRST FORCPY
FOTAB: XCT FBPXCT ;END OF FILE STRING. END OF USER STRING TOO?
JUMPN A,FORNO ;NO, NOT A MATCH
MOVNI C,1 ;FLAG FOR INFORMING THE REMOTE END
FORCPY: PUSHJ P,FORCHG ;COPY A CHAR
CAIE A,CR
CAIN A,LF
MOVEI A,0 ;SIMULATE EOF ON EOL
CAIN A,"⊗"
JRST FORTEL ;GRITCH MEANS TELL ABOUT THE FORWARDING
JUMPL C,FORCP1 ;JUMP IF NOT NOTIFYING
CAIN A,"%"
MOVEI A,"@" ;USE OFFICIAL NETWORK FORMAT (SIGH...)
;; PUSHJ P,PUTCH1
FORCP1: JUMPN A,FORCPY ;CONTINUE IF NOT DONE
JUMPL C,FORCP2
;; PUSHJ P,IMPCR
FORCP2: SETOM FWDING ;FLAG FORWARDING
CLOSE .MFD,
POPJ P, ;SUCCESS RETURN
FORZIP: CLOSE .MFD,
MOVE B,FORB#
MOVE C,FORC#
MOVE D,FORD#
MOVE E,FORE#
MOVE F,FORF#
JRST CPOPJ1 ;FAILURE RETURN
FORCHG: PUSHJ P,FACCHR
MOVEI A,0
POPJ P,
FORTXT: SIXBIT /FORWRD/
SIXBIT /TXT/
0
SIXBIT /MAISYS/
;⊗ NUMPR NUMPR1 DON0 DATGEN NODA1 ONEDDD NODATE NOTIME NOZON MONTAB PDDATE PSDATE DTKIND
; OUTPUT IS TO DISK FILE
DEFINE STROUT(X) <
MOVEI B,X
PUSHJ P,WRTSTR
>
DEFINE OUT1 (X) <MOVE A,X ↔ XCT OUTINSTR>
DEFINE PRNUM(X,N) <
IFN X-T2,<MOVE T2,X ;arranged to be ok for this routine,
; to clobber T2 whenever prnum called>
PUSHJ P,NUMPR ;ok to generate multiple words
N ; in PRNUM -- this is min width
>;PRNUM
NUMPR:PUSH P,T1
MOVE T1,@-1(P)
PUSHJ P,NUMPR1
POP P,T1
AOS (P)
POPJ P,
NUMPR1:IDIVI T2,=10
IORI T3,"0"
HRLM T3,(P)
SUBI T1,1
JUMPE T2,.+2
PUSHJ P,NUMPR1
JUMPLE T1,DON0
OUT1 (["0"])
SOJG T1,.-1
DON0:HLRZ T2,(P)
OUT1 T2
POPJ P,
; THE DATGEN ROUTINE
DATGEN: DATE T1,
IDIVI T1,=31
ADDI T2,1
PUSH P,T2
NODA1: IDIVI T1,=12
MOVEI T3,261 ;DAYLIT
PEEK T3,
PEEK T3,
SKIPE T3
SKIPA T3,[PDDATE]
MOVEI T3,PSDATE
MOVEM T3,DTKIND
MOVEI B,@MONTAB(T2)
PUSHJ P,WRTSTR
POP P,A
IDIVI A,=10
JUMPE A,ONEDDD
ADDI A,"0"
XCT OUTINSTR
ONEDDD: MOVEI A,"0"(B)
XCT OUTINSTR
MOVEI B,[ASCIZ/, /]
PUSHJ P,WRTSTR
MOVEI T2,=1964(T1)
PRNUM (T2,2)
STROUT ([ASCIZ/ /])
NODATE: MSTIME T2,
IDIVI T2,=1000*=60
IDIVI T2,=60
MOVE T1,T3
PRNUM (T2,2)
MOVE T2,T1
PRNUM (T2,2)
NOTIME: STROUT (@DTKIND)
NOZON: POPJ P,
MONTAB: [ASCIZ/January /]
[ASCIZ/February /]
[ASCIZ/March /]
[ASCIZ/April /]
[ASCIZ/May /]
[ASCIZ/June /]
[ASCIZ/July /]
[ASCIZ/August /]
[ASCIZ/September /]
[ASCIZ/October /]
[ASCIZ/November /]
[ASCIZ/December /]
PDDATE: ASCIZ/ PDT/
PSDATE: ASCIZ/ PST/
DTKIND: 0
;Interrupt level routine ;⊗ ILEVEL DNTSAY timout SXACTV LOOK
ILEVEL: MOVE A,JOBCNI
ifn iverbose, <
PTOCNT LOOK
MOVE b,LOOK+1
CAILE b,120 ;make sure plenty of room in output buffer
JRST DNTSAY ;not enough room, avoid I-level schedule attempt
outchr ["↔"]
tlne a,intinp
outchr ["p"]
tlne a,intims
outchr ["s"]
TLNE A,INTINS
OUTCHR ["A"]
>;ifn iverbose
DNTSAY: tlne a,intclk
jrst timout
;; TLNE A,INTINS
;; SOS SYNCH ;IF THIS GOES NEGATIVE WE STOP TILL IT CATCHES UP
TLNE A,INTINS
SETZM CIHUNG ;PREPARES US FOR A COMMAND AT ONCE (BETTER BE ABOR)
TLNE A,INTIMS
SETOM SCHEKF ;Status CHEcK Flag
MOVE A,[-3]
MOVEM A,XACTV
DISMIS
timout: debreak
jrst errkil
SXACTV: PUSH P,[-3] ;HANDY ROUTINE TO SET XACTV
POP P,XACTV ; WITHOUT CLOBBERING ANY
POPJ P, ; ACCUMULATORS
ifn iverbose, <
LOOK: 0↔0
>
SUBTTL Host name magic using NETWRK ;⊗ CHKHTB GETHNM COPYUS GOTUS CPYHST CPYDUN HSTTAB HSTSIX ERRTNS WHYWHY
CHKHTB: SKIPN HSTADR ;already have host table segment attached?
JRST ATTHST ;no, attach host table upper segment
POPJ P,
GETHNM:
BEGIN NETHAK
PUSH P,A
PUSHJ P,CHKHTB ;attach host table upper segment if necessary
SKIPE OURSTR ;know our name yet?
JRST GOTUS ;yup, must have been here before
PUSHJ P,OURNAM ;get our host name
JRST [ MOVE 0,OURH3 ;use first host number
MOVEI 1,OURSTR ;put our number into OURSTR
PUSHJ P,HNUMST
JRST GOTUS]
HRLI 1,440700 ;copy our name to safe place
MOVE 2,[440700,,OURSTR]
COPYUS: ILDB 0,1
IDPB 0,2
JUMPN 0,COPYUS
GOTUS: MOVE 0,HOSTNO ;get number of host we're connected to
PUSHJ P,HSTNUM ;convert to name
JRST [ MOVEI 1,HSTSTR ;Failed, make NETWRK put number in HSTSTR for us
PUSHJ P,HNUMST
JRST CPYDUN]
PUSH P,1 ;save ptr to name
HRLI 1,440700
MOVE 2,[440700,,HSTSTR]
CPYHST: ILDB 0,1
IDPB 0,2
JUMPN 0,CPYHST
POP P,1 ;ptr to name, for SETANM
CPYDUN: PUSHJ P,SETANM ;change our Alias to indicate foreign host
;;; PUSHJ P,UNMHST ;don't unmap, so that MLNMFF can use host table
POP P,A
POPJ P,
;Now preparation for inserting NETWRK.
HSTTAB←←1 ;indicate to NETWRK we want host table
HSTSIX←←1 ;also want code to generate alias from host name
ERRTNS←←1 ;Also get error routine
WHYWHY: 0 ;unused, but ref'd by NETWRK's HSTDED (not called)
.INSERT NETWRK.FAI[S,NET]
INTERN HSTNAM,HSTNXA,HSTADR,ATTHST,DETHST
BEND NETHAK
;Miscellaneous error messages ;⊗ BYE BYE1 BYE2 ERRKIL QUIT QUIT1 ABOR FLUSH NEWTMO NOIMP UFLUSH GREET GREETL GREET0 NOFLAK GREET1 SAYWHO
BYE: PUSHJ P,FLUSCS ;THE COMMAND
BYE1: SKIPN DIACTV ;IF I/O ACTIVE, CAN'T QUIT YET
SKIPE DOACTV
JRST [SKIPE QUITNG ;GIVE INTERIM MESSAGE BUT ONCE
POPJ P,
SETOM QUITNG# ;THIS IS HOW
PUSHJ P,IMPSTR
ASCIZ /500 I'll split just as soon as the current transfer is done.
/
POPJ P,]
BYE2: PUSHJ P,IMPSTR
ASCIZ /221 CUL
/
ERRKIL: MTAPE IMP,NEWTMO ;Order of RELEASing changed to insure
RELEASE IMP, ;at least the control link gets closed.
PUSHJ P,FLUSH ;FLUSH ALL DATA I/O
MOVE A,['KILL-2']
MOVEM A,KFLAG
QUIT: RELEASE FIMP,3 ;IN CASE OF MAIL ABORT
SETZM PRIVS ;PARANOID? ME, PARANOID?
SKIPL RECOPN ;skip if no relay-log file open
RELEAS RLY, ;close it
SETOM RECOPN ;not open any more
IFN BUGLOG,<
SKIPL BUGOPN ;skip if no bug-log file open
RELEAS BUG, ;close bug-log channel
SETOM BUGOPN ;not open now
>;IFN BUGLOG
RESET ;IF ATTACHED TO A TERMINAL,
;; SETZM HSTADR ;no host table mapped in now, since JOBFF reset
; MOVNI B,1 ; START OVER (TEST AGAIN
; GETLIN B ; IN CASE IT'S CHANGED).
; AOJN B,QUIT1
EXIT
QUIT1: OUTSTR [ASCIZ /Starting over
/]
JRST START
ABOR: SETZM DIACTV ;FLUSH ALL ACTIVITY
SETZM DOACTV
; SETZM DIHUNG ;AND RESET COROUTINES
; SETZM DOHUNG
PUSHJ P,IMPSTR ;BARF SO WHAT IF SCARCE RESOURCE
ASCIZ /250 El grande de grosse RSET
/
PUSHJ P,FLUSH
SETZM GOTFRM ;forget any From: line seen
JRST REGO ;RESET ALL ACTV, HUNG, AND PDLS
FLUSH: RELEASE FIMP,3 ;(The other mtapes get unassigned I/O
RELEASE FOMP,3 ;sometimes)
;; CHNSTS DIMP,A ;FIXING ABOVE LOSS
;; TRNE A,400000
;; MTAPE DIMP,NEWTMO
;; RELEASE DIMP,
;; CHNSTS DOMP,A ;FIXING ABOVE LOSS
;; TRNE A,400000
;; MTAPE DOMP,NEWTMO
;; RELEASE DOMP,
POPJ P,
NEWTMO: 17
BYTE (6) 2,24,24,7,7
NOIMP: MES(CANNOT INIT IMP)
JRST ERRKIL
UFLUSH: PUSHJ P,PUTBUF ; EXCRETE MESSAGE
MOVEI B,5
SLEEP B,
JRST QUIT
GREET: MOVE E,[-LOURH3,,OURH3] ;aobjn ptr to list of our host nbrs
MOVE B,HOSTNO ;get nbr of foreign host
GREETL: CAMN B,(E) ;is this one of our host nbrs?
JRST GREET0 ;host nbr is ours, let us in even if system down
AOBJN E,GREETL ;no, check other numbers
MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET0
PUSHJ P,IMPSTR
ASCIZ/421- /
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS SMTP Server at /
MOVE B,[PUSHJ P,PUTCH1] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
PUSHJ P,IMPSTR
ASCIZ\
421 Sorry, the system is being debugged. Try again later.
\
OUTSTR [ASCIZ/MaintMode: Refusing /]
PUSHJ P,SAYWHO
JRST UFLUSH
GREET0: PUSHJ P,IMPSTR
ASCIZ/220-/
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPSTR
ASCIZ/ WAITS SMTP Server at /
MOVE B,[PUSHJ P,PUTCH1] ;OUT INSTR FOR DATGEN -- NOT
MOVEM B,OUTINSTR ; A SCARCE RESOURCE YET
PUSHJ P,DATGEN
MOVEI B,256 ; LASTDISASTERTIME
PEEK B,
PEEK B,
JUMPE B,NOFLAK
ACCTIM A,
SUB A,B
TLZE A,1 ;FORGIVE ONE DAY
ADDI A,=24*=60*=60
CAILE A,=15*=60
JRST NOFLAK
PUSHJ P,IMPSTR
ASCIZ/
220-The system is misbehaving. Proceed with caution!/
NOFLAK: MOVEI B,254 ; MAINTMODE
PEEK B,
PEEK B,
JUMPE B,GREET1
PUSHJ P,IMPSTR
ASCIZ/
220-The system is being debugged./
GREET1: PUSHJ P,IMPSTR
ASCIZ\
220 Bugs/gripes to Bug-SMTP @ \
PUSHJ P,IMPSTH ;output our host name (SU-AI.ARPA, S1-A.ARPA, ...)
PUSHJ P,IMPCR ;output crlf
POPJ P,
SAYWHO: OUTSTR [ASCIZ /Connection from host /]
PUSHJ P,GETHNM
OUTSTR HSTSTR
OUTSTR [ASCIZ/
/]
POPJ P,
;⊗ BUGBEG BUGRL2 BUGRL3 BUGRLP BUGRL0 BUGRLE BUGCHR BUGOUT BUGOU2
IFN BUGLOG,<
;Open .FTP file and write a log entry for debugging mail from a certain host.
;Note that any file opened here is closed at QUIT.
BUGBEG: PUSH P,OUTINSTR ;preserve whatever there is
MOVE D,[PUSHJ P,BUGOUT] ;instruction to output char to bug log mailer
MOVEM D,OUTINSTR
AOSE BUGOPN ;skip if file not open already
JRST BUGRL3 ;already done first part
INIT BUG,200 ;open device
'DSK '
BOBUF,,0 ;output buffer hdr
JRST BUGRLE ;lose
BUGRL2: PUSHJ P,SETMFR ;get filename for .FTP file in RMDFIL
MOVEM D,RMDFIL+3 ;store PPN
ENTER BUG,RMDFIL ;create .FTP file for relay log entry
JRST BUGRL0 ;failed, see why, maybe retry
PUSH P,JOBFF
MOVEI B,BUGOBF
MOVEM B,JOBFF
OUTBUF BUG,2 ;two buffers should be plenty
POP P,JOBFF
MOVEI B,[ASCIZ $MAIL/subject postmaster
$]
PUSHJ P,WRTSTR ;start file with above string
MOVEI A,14 ;a formfeed ends cmd page for MAIL
XCT OUTINSTR
BUGRL3: MOVEI B,[ASCIZ/SMTP transaction from /]
PUSHJ P,WRTSTR
MOVEI B,HSTSTR ;pointer to host name
PUSHJ P,WRTSTR ;say whom mail came to us from
MOVEI B,RCDCR ;output CRLF
PUSHJ P,WRTSTR
BUGRLP: POP P,OUTINSTR ;restore whatever was here before
POPJ P,
BUGRL0: HRRZ B,RMDFIL+1 ;get error code
CAIN B,3 ;busy file?
JRST BUGRL2 ;yes, try another filename
BUGRLE: SETOM BUGOPN ;some strange error, give up
JRST BUGRLP
BUGCHR: PUSH P,OUTINSTR ;don't let this be clobbered
PUSHJ P,BUGOUT ;record a character
POP P,OUTINSTR
POPJ P,
BUGOUT: SOSG BOBUF+2
OUT BUG,
JRST BUGOU2
OUTSTR [ASCIZ/OUT uuo failed for BUG channel, aborting bug log entry.
/]
PUSH P,A
MOVSI A,(<JFCL>)
MOVEM A,OUTINSTR ;make sure we don't try any more
POP P,A
RELEAS BUG,
SETOM BUGOPN ;no longer open
POPJ P,
BUGOU2: IDPB A,BOBUF+1
POPJ P,
>;IFN BUGLOG
END START