Trailing-Edge
-
PDP-10 Archives
-
bb-l014w-bm_tops20_v7_0_atpch_23
-
autopatch/smtlis.mac
There are 21 other files named smtlis.mac in the archive. Click here to see a list.
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1989.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
TITLE LISTEN - SMTP Listener
TWOSEG
RELOC 400000
;Cloned by MX. Does not return or get killed.
SEARCH MACSYM
EXTERN DB%VD8,MX%UNQ,MX$VAL,NODNAM,TBL%LO,UF%CLO,UN%ACC
EXTERN UF%OPE,UF%WRI,UM%GET,UM%REL,UN%CLO,UN%REA,UN%WRI,SCAN%P
EXTERN UN%OPEN,MX$TIM,RELASC,UT%TEX,MXERRS,NMLDIE,LOG
INTERN SMTPLI,STRLEN,STRLN
IP$JAC==400000000000 ;Like SC%WHL for TOPS10
SC%WHL==400000
FTLOG==0 ;NO LOGGING NOW (20 ONLY)
;Offsets into various MX data structures
.DESTN==3
.FILSP==1
.POST==1
.DONE=2
.SENDR==2
.DECNT==1
.RECNM==0
.RECTY==1
.RECLE==2
.RECTX==3
.PKTYP==0
.PKID==1
.PKSEQ==2
.PKSTS==3
.PKRCT==4
;Ac definitions
F==0
T1==1
T2==2
T3==3
T4==4
T5==5
T6==6
RCPTPT==7 ;LINKED LIST OF RECEIPIENTS
CONBLK==10 ;ADDR OF CONNECT BLOCK
REQLEN==11 ;LENGTH OF REQUEST BLOCK
REQ==12 ;ADDRESS OF REQUEST BLOCK
;DON'T USE 13, RESERVED FOR BLISS
DECNET==14 ;DECNET CHANNEL NUMBER
;15 IS RESERVED FOR BLISS
VR==16 ;POINTER TO VARIABLE SPACE
P==17
;Object type
OBJTYP==^D0 ;Using name not number
;OFFSETS INTO BLOCK OF INFORMATION AT VR (Local data)
TXTPTR==0 ;POINTER TO LAST LINE READ BUFFER
TXTLEN==1 ;LENGTH OF LAST READ IN TEXT
FRMPTR==2 ;POINTER TO "FROM" BUFFER
RSPPTR==3 ;POINTER TO SPACE FOR RESPONSES
SCRWRD==4 ;SCRATCH FOR ROUTINE RETURNS
CMDWRD==5 ;FIRST 5 CHARS OF INCOMING COMMAND
TMPPTR==6 ;POINTER TO CHAIN OF RECEIPIENTS
ATPNTR==7 ;POINTER TO THE @ IN A "TO" STRING
ENPNTR==10 ;POINTER TO END OF NODENAME
USPNTR==11 ;POINTER TO BEGINNING OF USERNAME
NXTPTR==12 ;POINTER TO NEXT SUBBLOCK TO CREATE
TXTBLK==13 ;TEXT ARG BLOCK FOR UT%TEX
FILE==14 ;FILE NUMBER
OUTBFR==15 ;pointer to output buffer begin
OUTPNT==16 ;pointer into output buffer
OUTCNT==17 ;number of chars left in buffer
SENDFL==20 ;faking SEND, not doing MAIL
STARTP==21 ;Stack pointer at startup
SAVACL==22 ;ac save block
N%VAR=SAVACL+4+1 ;NUMBER OF VARIABLES NEEDED
NXT==0 ;NEXT POINTER FOR RCPT LINKED LIST
;LH IS LENGTH OF BLOCK, RH IS NEXT BLOCK ADDR (OR 0)
;Constants of merit
CONLEN==^D64 ;SIZE OF DECNET CONNECT BLOCK
OUTLEN==1000 ;NUMBER OF WORDS FOR FILE OUTPUT BUFFER
MAXREC==1000*^D8*5 ;MAX NUMBER OF CHARACTERS WE CAN RECEIVE
MAXSND==^D1000 ;MAX WE WILL SEND, OR EXPECT FOR NON-MESSAGES
TXBLEN==10 ;FOR UT%TXT
;These allow us to format up SMTP responses
DEFINE $RSPC(val),<
MOVEI T1,^D val
DMOVEM T1,@TXTBLK(VR)
MOVE T1,[POINT 7,STDSTR]
MOVEI T2,2 >
DEFINE $RSPA(ind),<
EXTERN ind
MOVE T2,MXERRS+ind >
DEFINE $RSE(val,ind),<
$RSPA (ind)
$RSPC (val) >
DEFINE $RSP(val,text),<
MOVE T2,[POINT 7,[ASCIZ `text`]]
$RSPC(val) >
define logger(txt),<
IFN FTLOG,<
CALL [PUSH P,[ -1,,[ASCIZ/
********** txt
/]]
call logers
adjsp p,-1
RET]
> >
define logget(addr),<
IFN FTLOG,<
CALL [PUSH P,addr
call logers
adjsp p,-1
RET]
> >
IFN FTLOG,<
logers: PUSH P,T1
PUSH P,T2
MOVX T1,GJ%SHT+GJ%OLD
HRROI T2,[ASCIZ/MX:SMTLIS.LOG/]
GTJFN%
ERJMP NOLOGR
MOVX T2,OF%APP+7B5
OPENF%
ERJMPS NOLOGX
PUSH P,T3
SETZ T3,
move t2,-4(p)
sout%
erjmps .+1
pop p,T3
nologx: closf%
erjmps .+1
nologr: pop p,t2
pop p,t1
ret
>
DEFINE GETMEM(size),<
%$$==<size>
PUSH P,[%$$]
CALL SVACLI
CALL UM%GET
CALL RSACLI
ADJSP P,-1
JUMPE T1,NOMEME
>
DEFINE SETADR(whrpnt,size),<
MOVEM T1,whrpnt
ADDI T1,<size>
%$$==%$$-<size>
IFLE %$$,<PRINTX Not enough memory asked for in SMTLIS>
>
ALLMEM=< N%VAR+CONLEN+TXBLEN+OUTLEN+<MAXREC/5+1>+3*<MAXSND/5+1> >+1
;Start here
SMTPLI: GETMEM (ALLMEM)
SETADR VR,N%VAR ;N%VAR WORDS POINTED TO BY VR
SETADR CONBLK,CONLEN ;CONLEN WORDS POINTED TO BY CONBLK
SETADR TXTBLK(VR), TXBLEN ;TXBLEN WORDS POINTED TO BY TXTBLK(VR)
HRLI T1,(POINT 7) ;EVERYTHING BELOW IS A BP
SETADR OUTBFR(VR), OUTLEN ;OUTPUT BUFFER
SETADR TXTPTR(VR), MAXREC/5+1 ;INPUT FROM DECNET
SETADR FRMPTR(VR), MAXSND/5+1 ;FOR PROCESSING FROM, ETC.
SETADR RSPPTR(VR), MAXSND/5+1 ;FPR BUILDING RESPONSES
SETADR TMPPTR(VR), MAXSND/5+1 ;STRING HACK SPACE
SETZB RCPTPT,FILE(VR) ;NO FILE YET, NO RECPIENTS
MOVEM P,STARTP(VR) ;SAVE STARTING STACK POINTER
;Come back here to set up the next connection
GOAGAI: MOVE P,STARTP(VR) ;START WITH RIGHT STACK
SETZM 0(CONBLK)
MOVSI T1,(CONBLK) ;SET UP TO CLEAR THE CONNECT BLOCK
HRRI T1,1(CONBLK)
BLT T1,CONLEN-1(CONBLK)
; MOVX T1,OBJTYP ;STORE OBJECT TYPE
; MOVEM T1,2(CONBLK) ;..DON'T, IS A 0
;
;SET UP A SOURCE TASK NAME IN CB_TASK
;
MOVE T1,[POINT 7,[ASCII /MX-SENDER/]] ;Who we want to hear from
MOVEM T1,3(CONBLK)
MOVEI T1,^D9 ;LENGTH OF ABOVE TASK NAME
MOVEM T1,4(CONBLK)
;
;SET UP DESTINATION TASK NAME IN CB_DESCRIPTOR FIELD
;
MOVE T1,[POINT 7,[ASCIZ /MX-LISTENER/]] ;Who we are
MOVEM T1,15(CONBLK)
MOVEI T1,^D11 ;LENGTH OF ABOVE TASK NAME
MOVEM T1,16(CONBLK)
PUSH P,[1] ;CONNECT TYPE 1, DESTINATION
PUSH P,CONBLK
PUSH P,[0]
PUSH P,[0]
PUSH P,[0]
logger <Attempting to open a SMTP Receive connection>
CALL SVACLI
CALL UN%OPEN ;Open the recieving link
CALL RSACLI
ADJSP P,-5
SKIPG DECNET,T1 ;OK? STORE RESULTING LINK-ID
JRST DIENOW ;FAILED
logger <Opened, sending accept>
PUSH P,DECNET ;SET UP TO ACCEPT LINK
PUSH P,[0]
PUSH P,[0]
CALL SVACLI
CALL UN%ACCEPT
CALL RSACLI
ADJSP P,-3
;SAY HELLO
SETZ T4, ;BUILD ONLINE MESSAGE
MOVE T2,RSPPTR(VR)
HRROI T1,[ASCIZ/220 /] ;SMTP PROTOCOL VALUE FOR ONLINE MESSAGE
CALL CSTRB
MOVE T1,[POINT 7,NODNAM] ;ADD OUR NODENAME
CALL CSTRB
HRROI T1,[ASCIZ/ Ready
/] ;+<SP>message
CALL CSTRB
CALL DNTOUT ;WRITE MESSAGE OUT
;Get greeting
GETGRT: logger <Waiting for hello message>
CALL DCTREA ;WAIT FOR HELLO MESSAGE
MOVEI T1,TABLE1 ;LOOK ON STATE TABLE 1 FOR REACTION
CALL CMDFND ;..
JRST NOHELO ;COMMAND NOT KNOWN
JRST (T1) ;KNOWN, DISPATCH
TABLE1: TLEN1,,TLEN1
[ASCIZ/HELO/],,GOTHLO ;HELO, ALL SET, ENTER STATE 2
[ASCIZ/NOOP/],,OKGGRT ;NOOP, FINE, IGNORE
[ASCIZ/QUIT/],,QUIT ;QUIT, GO START HANGING UP
[ASCIZ/RSET/],,OKGGRT ;RSET, FINE, IGNORE
TLEN1=.-TABLE1-1
;Here to set up for next state 2 command
GOTHLO: CALL READY ;CLEAR OUT EVERYTHING
OKCMD: $RSP (250,OK) ;SAY LAST COMMAND WAS OK
logger <Sending OK>
RSPCMD: CALL SNDRSP ;SEND MESSAGE IN T1
NXTCMD: CALL DCTREA ;GET A COMMAND
;TO LOSE TIMING CHECK, COMMENT OUT NEXT 5 LINES
CALL SVACLI
CALL MX$TIM ;GET # OF SECS TILL SYSTEM GOES DOWN
CALL RSACLI
CAIGE T1,^D60 ;GOT 60 MORE SECONDS?
JRST SYSDWN ;NO - CLOSE UP
;END TIMING CHECK
MOVEI T1,TABLE2 ;LOOK ON TABLE FOR STATE 2 COMMANDS
CALL CMDFND
JRST NOCMD ;NOT KNOWN
JRST (T1) ;DISPATCH
;What we expect to get once the premilinaries are out of the way
TABLE2: TLEN2,,TLEN2
[ASCIZ/DATA/],,DODATA ;DATA, RECEIVE TEXT
[ASCIZ/HELO/],,GOTHLO ;HELO, TREAT LIKE RSET
[ASCIZ/MAIL/],,DOFROM ;MAIL, START OF A MAIL TRANSCATION
[ASCIZ/NOOP/],,OKCMD ;NOOP, OUR FAVORITE
[ASCIZ/QUIT/],,QUIT ;QUIT, GO END CONVERSATION
[ASCIZ/RCPT/],,DOTO ;RCPT, ACCEPT (ANOTHER) RECEIPIENT
[ASCIZ/RSET/],,GOTHLO ;RSET, CLEAR OUT ALL BUFFERS
[ASCIZ/SEZZ/],,DOSEND ;SEND, DO A SPECIALIZED SEND
[ASCIZ/SOML/],,DOFROM ;SOML, TREAT LIKE MAIL
[ASCIZ/VRFY/],,VERIFY ;VRFY, VERIFY A USER
TLEN2=.-TABLE2-1
NOCMD: CALL WHAT ;Here if we get something we didn't
JRST NXTCMD ;Expect. Send back the right 50n.
DOSEND: SETOM SENDFL(VR)
logger <Got SEZZ command>
JRST DOXXXX
;FROM command
DOFROM: SETZM SENDFL(VR)
logger <Got FROM command>
DOXXXX: MOVE T1,TXTPTR(VR)
ADDI T1,1 ;SKIP FIRST 5 CHARS
FNDFRS: ILDB T3,T1 ;SCAN FOR ":"
JUMPE T3,BADCMD ;NEVER SAW IT, BAD
CAIE T3,":"
JRST FNDFRS ;SCAN SMORE
MOVE T2,FRMPTR(VR) ;GOT IT, COPY REST TO FRMPTR(VR)
FROMCP: ILDB T3,T1 ;COPY REV. PATH WITHOUT <CRLF>
CAIE T3,.CHCRT ;STOP ON CR..
CAIN T3,.CHLFD ;OR LF
SETZ T3,
IDPB T3,T2
JUMPN T3,FROMCP ;KEEP GOING UNTIL ALL READ
$RSP (250,OK for mail) ;RESPOND OK
JRST RSPCMD
;Here if we get trash
BADCMD: $RSE (501,MG$ARG)
JRST RSPCMD
;These routines attempt to verify a username. They measure the provided
; string and pass it to MX$VAL. The return value is MX$VAL's.
VERIUS: MOVE T1,TXTPTR(VR)
ADDI T1,1
VERIST: MOVE T5,T1
SETZ T4,
VERCHP: ILDB T3,T1
JUMPE T3,NOCRVY
CAIE T3,.CHCRT
AOJA T4,VERCHP
NOCRVY: JUMPE T4,BADCMD
PUSH P,T4
PUSH P,T5
HRRZ T1,TMPPTR(VR)
PUSH P,T1
CALL SVACLI
CALL MX$VAL
CALL RSACLI
ADJSP P,-3
RET
;The VRFY command comes here. Verify and say "250 <name>" or "Not here"
VERIFY: CALL VERIUS
TRNE T1,1
JRST VEROKR ;USER IS OK
$RSP (550,User not known here)
JRST RSPCMD
VEROKR: MOVE T2,TXTPTR(VR) ;MOVE NAME INTO <NAME@USNODE>
MOVE T1,T2 ;MAY AS WELL USE SAME STRING SPACE
ADDI T1,1 ;USERNAME STARTS ONE WORD DOWN
MOVEI T3,"<" ;MOVE WEDGY IN
IDPB T3,T2
VEROK2: ILDB T3,T1 ;COPY USERNAME UNTIL <CR> OR NULL
JUMPE T3,VEROK3
CAIN T3,.CHCRT
JRST VEROK3 ;OK, ADD @NODENAME
IDPB T3,T2
JRST VEROK2
VEROK3: MOVEI T3,"@"
IDPB T3,T2 ;@
MOVE T1,[POINT 7,NODNAM]
VEROK4: ILDB T3,T1 ;COPY NODENAME
JUMPE T3,VEROK5
IDPB T3,T2
JRST VEROK4
VEROK5: MOVEI T3,">"
IDPB T3,T2
SETZ T3,
IDPB T3,T2 ;NULL TERMINATE
MOVE T2,TXTPTR(VR)
$RSPC (250) ;SAY OK, AND GIVE NAME BACK
JRST RSPCMD
;MAIL command
;This is messy
;SMTP allows strings in the form <user@node> or <@node,@node,@node..:user@node>
; user@node is easy, just verify node, and if it is us, verify user
; @node...:user@node is messy. Toss the first node (it should be us), verify
; the second one in the list, and pass the rest verbatim.
DOTO: logger <Got MAIL command>
MOVE T1,TXTPTR(VR)
ADDI T1,1 ;SKIP FIRST 5 CHARS ("MAIL ")
MOVE T4,TXTLEN(VR)
SUBI T4,5 ;ACCOUNT FOR 5 CHARS SKIPPED
FNDTOS: ILDB T3,T1 ;FETCH
JUMPE T3,BADCMD ;NULL? BAD COMMAND
CAIE T3,"<" ;FIND THE OPEN ANGLE BRACKET
SOJA T4,FNDTOS ;NOPE, ANOTHER CHAR GONE
MOVE T6,T1 ;GOT IT, SAVE POINTER
IDIVI T4,5 ;HOW MUCH SPACE TO HOLD THIS STRING?
MOVEI T4,2(T4) ;LEAVE SOME EXTRA
PUSH P,T4 ;FETCH THE MEMORY
CALL SVACLI
CALL UM%GET ;GET ENOUGH MEMORY TO HOLD RCPT STRING & HEADER
CALL RSACLI
ADJSP P,-1
JUMPE T1,STORFL ;NO ROOM? ABORT!
logger <MAIL command has enough memory>
HRL RCPTPT,T4 ;MAKE LEN,,POINTER TO NEXT BLOCK
MOVEM RCPTPT,NXT(T1) ;STORE IN NEW BLOCK
MOVE RCPTPT,T1 ;LINK IN
ADD T1,[POINT 7,1] ;POINT TO STRING DESTINATION
SETZM ATPNTR(VR) ;NO "@" YET
SETZM USPNTR(VR) ;NO USER NAME YET
SETZB T4,ENPNTR(VR) ;NO NODENAME YET, NO FLAGS
CPTOST: ILDB T3,T6 ;SCAN STRING, PARSING OUT NODENAME, ETC.
CAIN T3,">" ;TREAT CLOSE ANGLE AS TERMINATOR
SETZ T3, ;..
JUMPE T3,CHKTOS ;END OF STRING
CAIN T3,"\" ;QUOTING CHAR?
JRST LITTOA ;YES, GO HANDLE
CAIE T3,"@" ;NODENAME STARTS HERE?
JRST LITTOS ;NO, DOING USERNAME
TRNN T4,2 ;YES, GOT A USERNAME YET?
TROE T4,1 ;NO, IS THIS FIRST NODENAME?
JRST CPFRND ;NOT A FORWARDING REQUEST.
;HERE WE SEE @US,@OTHERSTUFF. REMOVE "@US,"
TOSSLF: ILDB T3,T6 ;GOBBLE FIRST NODENAME (IT'S US)
JUMPE T3,NOUSER ;ERROR - NO USER OR NODENAME
CAIE T3,":" ;LOOK FOR NODENAME TERMINATOR
CAIN T3,"," ;..
JRST CPTOST ;SKIPPED OUR NODENAME, BACK TO SCANNING
JRST TOSSLF ;KEEP SCANNING
;HERE IF WE HAVE "USER@NODENAME" REMEMBER WHERE THE "@" IS
CPFRND: IDPB T3,T1 ;PUT "@" IN
MOVEM T1,ATPNTR(VR) ;AND STORE POINTER TO IT
;HERE TO COPY OUT A NODENAME
CPTOND: ILDB T3,T6
CAIN T3,">"
SETZ T3,0
IDPB T3,T1 ;COPY CHARACTER
JUMPE T3,ENDNDS ;END, GO SEE WHAT WE GOT
CAIE T3,":"
CAIN T3,"," ;NODENAME END?
JRST ENDNDS ;YES, GO SEE WHAT WE GOT
JRST CPTOND ;KEEP COPYING NODENAME
ENDNDS: MOVEM T1,ENPNTR(VR) ;STORE POINTER TO END OF NODE
JUMPE T3,CHKTOS ;WAS LAST CHAR NULL?
CPBLIN: ILDB T3,T6 ;NO, COPY REST OF STRING VERBATIM
IDPB T3,T1
JUMPN T3,CPBLIN
JRST CHKTOS ;AND GO DEAL WITH WHAT'S REVELANT TO US
LITTOA: ILDB T3,T6 ;HERE FOR QUOTED CHAR, FETCH IT
LITTOS: TRON T4,2 ;HAVE WE STARTED USERNAME ALREADY?
MOVEM T1,USPNTR(VR) ;NO, STORE POINTER TO IT
IDPB T3,T1 ;WRITE USERNAME CHARACTER
JRST CPTOST ;GO AGAIN
;DONE PARSING, SEE WHAT WE GOT
CHKTOS: SKIPN T1,ATPNTR(VR) ;WAS A NODENAME SEEN?
JRST LCLMAL ;NO, JUST A LOCAL USERNAME
LDB T3,ENPNTR(VR) ;FETCH CHARACTER THAT ENDS STRING AND SAVE IT
SETZ T2, ;PREPARE TO NULL IT
DPB T2,ENPNTR(VR) ;..
PUSH P,T1 ;VALIDE THE NODENAME
PUSH P,[1] ;PUSH LOCAL DOMAIN
PUSH P,[-1] ;PUSH UNKNOWN DOMAIN
CALL SVACLI
CALL DB%VD8 ;VALID8 NODE
CALL RSACLI
ADJSP P,-3 ;FIX STACK
DPB T3,ENPNTR(VR) ;REPAIR STRING
JUMPL T1,BADNOD ;UNKNOWN NODE, WE CAN'T DO THIS
JUMPN T3,USRNTL ; "," OR ":" FORCE FORWARDING (USER NOT LOCAL)
JUMPG T1,USRNTL ;.GT. 0 IF NOT LOCAL, HANDLE AS SUCH
;THE NODE IS LOCAL, LET'S DO THE USERNAME
LCLMAL: SKIPN T1,USPNTR(VR) ;POINTER TO USERNAME TO CHECK
JRST NOUSER ;NONE GIVEN, COMPLAIN
SETZ T2, ;MAKE USERNAME NULL TERMINATED
DPB T2,ATPNTR(VR) ;NULL OUT "@"
CALL VERIST ;VERIFY USER
MOVEI T2,"@"
DPB T2,ATPNTR(VR) ;REPAIR STRING
TRNN T1,1 ;REAL USERNAME?
JRST NOUSER ;NO, COMPLAIN
USRNTL: logger <username acceptable>
JRST OKCMD ;OK STRING IF NOT LOCAL OR GOOD LOCAL USERNAME
NOUSER: logger <username unacceptable (not local)>
MOVE T1,USPNTR(VR) ;NEVER HEARD OF THE BLIGHTER
$RSPA (SL$NSU)
JRST ERR550
BADNOD: logger <nodename not known>
MOVE T1,ATPNTR(VR) ;NEVER HEARD OF THIS NODE
$RSPA (SL$NNK)
ERR550: MOVE T3,TXTBLK(VR) ;ERROR 550, BAD RECIPIENT
MOVEM T1,2(T3)
MOVEI T1,^D550
DMOVEM T1,(T3)
MOVEI T2,3
HRROI T1,STDSTI
PUSH P,T1
PUSH P,T2
HLRZ T4,NXT(RCPTPT) ;DELETE THIS RECIPIENT
PUSH P,RCPTPT
PUSH P,T4
HRRZ RCPTPT,NXT(RCPTPT)
CALL SVACLI
CALL UM%REL
CALL RSACLI
ADJSP P,-2
POP P,T2
POP P,T1
JRST RSPCMD
;HERE TO CLEAR OUT OLD COMMAND STATES. TOSS OLD RCPT LINKED LIST
; ZERO APPROPRATE VARIABLES, DROP OPEN FILES, ETC.
READY: logger <At READY (clearing out old data)>
JUMPE REQ,NOREQK
PUSH P,REQ
PUSH P,REQLEN
CALL UM%REL
ADJSP P,-2
SETZ REQ, ;NO REQUEST BLOCK
NOREQK: SKIPN T1,FILE(VR) ;ANY FILE OPEN?
JRST NOFILE
PUSH P,T1 ;YES, ABORT IT
PUSH P,[1] ;ABORT FLAG
PUSH P,[0] ;DON'T WANT ERROR STRING
CALL SVACLI
CALL UF%CLO
CALL RSACLI
ADJSP P,-3
SETZM FILE(VR) ;GONE
NOFILE: JUMPE RCPTPT,ENDTOL ;ANY RECPIENTS LEFT?
NXTTOK: HLRZ T4,NXT(RCPTPT) ;YES, FETCH LENGTH OF THIS BLOCK
PUSH P,RCPTPT ;ARG: ADDRESS
PUSH P,T4 ;ARG: LENGTH
HRRZ RCPTPT,NXT(RCPTPT) ;ADVANCE FOR NEXT BLOCK (OR 0)
CALL SVACLI
CALL UM%REL ;DELETE BLOCK
CALL RSACLI
ADJSP P,-2
JUMPN RCPTPT,NXTTOK ;DO NEXT IF NOT DONE
ENDTOL: HRRZ T1,FRMPTR(VR) ;CLEAR OUT FROM BUFFER
SETZM (T1) ;..
RET ;READY TO START AFRESH
;DATA COMMAND
DODATA: JUMPN RCPTPT,DATAST ;ANY RECIPIENTS ON THE LIST?
$RSP (554,No legal receivers given)
JRST DATANO ;NO, NO GOOD RECIPIENT RECIEVED
DATAST: MOVE T1,FRMPTR(VR) ;POINT TO FROM STRING
logger <Got DATA with good previous receivers>
SKIPE (T1) ;ANY "FROM"?
JRST DATAS1 ;OK, GOOD
$RSP (554,No MAIL command given)
JRST DATANO
SKIPE SENDFL(VR)
JRST [$RSP (357,Go wild)
CALL SNDRSP ;SEND REQUEST, THIS IS SPECIAL
JRST SENDI2]
;Here to start creating a buffer of information to hand to MX
DATAS1: CALL STRLN ;COUNT CHARS REF'D BY T1, TO T4
IDIVI T4,5 ;HOW MANY WORDS?
MOVEI REQLEN,4(T4) ;ANSWER INTO REQLEN, PLUS HEADER
MOVE T2,RCPTPT ;NOW ADD SPACE FOR EACH RECPIENT STRING
CNTUP: HLRZ T1,NXT(T2) ;GET LENGTH..
ADDI REQLEN,4(T1) ;ADDED IN, PLUS HEADER
HRRZ T2,NXT(T2) ;GET NEXT BLOCK
JUMPN T2,CNTUP ;IF THERE IS ONE
ADDI REQLEN,^D20 ;ADD SPACE FOR FILE NAME AND HEADERS AND EXTRA
PUSH P,REQLEN ;REQUEST THAT MUCH
CALL SVACLI
CALL UM%GET ;..
CALL RSACLI
ADJSP P,-1 ;..
SKIPN REQ,T1 ;STORE ADDRESS OF BLOCK IN REQ
JRST STORFL ;NO MEMORY
;SET UP 5 WORD BLOCK HEADER
HRRI T1,.POST ;First block
HRLI T1,.DECNT ;We're a decnet listener
MOVEM T1,.PKTYP(REQ) ;NEW COMMAND BUFFER
SETZM .PKID(REQ) ;NO ID NUMBER
SETZM .PKRCT(REQ) ;NO RECORDS SO FAR
MOVEI T1,1
MOVEM T1,.PKSEQ(REQ) ;FIRST IN GROUP (OF 1)
MOVEM T1,.PKSTS(REQ) ;..
;SET UP FIRST RECORD, FILENAME
MOVEI T5,.PKRCT+1(REQ) ;POINT TO FIRST BLOCK
AOS T1,.PKRCT(REQ) ;HAVE A NEW RECORD IN THE BLOCK
MOVEM T1,.RECNM(T5) ;ADD RECORD NUMBER IN
MOVEI T1,.FILSP ;TYPE IS FILESPEC
MOVEM T1,.RECTY(T5) ;..
CALL SVACLI
CALL MX%UNQ ;GENERATE A FILENAME THAT'S UNIQUE
CALL RSACLI
HRLI T1,(POINT 7) ;RETURNS ADDRESS OF STRING
MOVEI T2,(T5) ;POINT TO SUBBLOCK START
ADD T2,[POINT 7,.RECTX] ;BUILD BYTE POINTER TO FILENAME SECTION
PUSH P,T2 ;NOTE! FOR CALL TO UF%OPE BELOW!
PUSH P,T1 ;SAVE FOR RELASC
SETZ T4, ;NEED LENGTH OF THIS STRING
CALL CSTRB
HRRZS (P) ;REDUCE BP TO ADDRESS
CALL SVACLI
CALL RELASC ;AND RELEASE STRING CREATED BY MX%UNQ
CALL RSACLI
ADJSP P,-1 ;TOSS SOURCE ADDR OFF STACK
MOVE T1,T4 ;GET STRING LENGTH INTO T1
IDIVI T1,5 ;GET STRING LENGTH IN WORDS
ADDI T1,3+1 ;CORRECT LENGTH, AND ADD IN HEADER LENGTH
MOVEM T1,.RECLE(T5) ;AND STORE
ADDI T5,(T1) ;UPDATE T5 TO POINT TO NEXT BLOCK TO CREATE
MOVEM T5,NXTPTR(VR) ;AND STORE
PUSH P,[2] ;WRITE ACCESS (ADDRESS OF NAME ALREADY STACKED)
PUSH P,[0] ;NO ERROR BUFFER
CALL SVACLI
CALL UF%OPE ;OPEN FILE FOR WRITE
CALL RSACLI
ADJSP P,-3 ;REBALANCE STACK
JUMPLE T1,STORFA ;CHECK IF OK, COMPLAIN IF NOT
FILEOP: MOVEM T1,FILE(VR) ;RECORD FILE NUMBER
$RSP (354,Go)
CALL SNDRSP ;SAY "OK FOR TEXT"
logger <GO given for DATA>
;BUILD DATA STRUCTURE WHILE WAITING FOR INCOMING MAIL
MOVE T5,NXTPTR(VR)
AOS T1,.PKRCT(REQ)
MOVEM T1,.RECNM(T5)
MOVEI T1,.SENDR
MOVEM T1,.RECTY(T5)
MOVE T1,FRMPTR(VR) ;COPY REVERSE PATH IN
MOVE T2,T5 ;BUILD POINTER INTO REQ BLOCK
ADD T2,[POINT 7,.RECTX] ;..
SETZ T4,
CALL CSTR ;COPY STRING AND GET LENGTH
IDIVI T4,5
ADDI T4,3+1 ;SIZE OF BLOCK PLUS HEADER
MOVE T5,NXTPTR(VR)
MOVEM T4,.RECLE(T5)
ADDI T5,(T4) ;GET ADDR NEXT BLOCK IN T5
RECPCP: AOS T1,.PKRCT(REQ)
MOVEM T1,.RECNM(T5)
MOVEI T1,.DESTN
MOVEM T1,.RECTY(T5)
MOVE T2,T5 ;BUILD POINTER TO RECEIPIENT NAME
ADD T2,[POINT 7,.RECTX] ;..
MOVE T1,RCPTPT ;GEN POINTER TO WHERE IT IS NOW
ADD T1,[POINT 7,1] ;SKIP HEADER..
SETZ T4,
CALL CSTR ;COPY IT
MOVE T1,T4
IDIVI T1,5 ;HOW LONG?
ADDI T1,3+1 ;PLUS HEADER PLUS NULL
MOVEM T1,.RECLE(T5)
ADDI T5,(T1) ;POINT TO NEXT BLOCK
PUSH P,RCPTPT ;TOSS USED RECIPIENT BUFFER
HLRZ T1,NXT(RCPTPT) ;..
PUSH P,T1 ;..
HRRZ RCPTPT,NXT(RCPTPT) ;ADVANCE POINTER FOR NEXT TIME
CALL SVACLI
CALL UM%REL ;ZAP
CALL RSACLI
ADJSP P,-2
JUMPN RCPTPT,RECPCP ;IS THERE MORE?
;SET UP TO READ/PARSE THE MESSAGE AND WRITE IT TO A FILE
;TERMINATE ON A LINE BEGINNING WITH ".<CR><LF>"
;IN HERE, T6 IS -1 IF WE JUST READ A <LF> (OR ARE JUST STARTING),
; AND IS 1 IF WE JUST READ A <LF> FOLLOWED BY "." (NEXT WILL BE "." OR <LF>)
; ANY OTHER TIME WE KEEP IT 0
;TXTLEN(VR) IN THE NUMBER OF CHARACTERS LEFT IN THE READ BUFFER (SET BY DCTREA)
;OUTCNT(VR) IS THE NUMBER OF CHARACTERS WRITTEN INTO OUTBFR
SENDI2: SETO T6, ;FLAG: DOT IS MEANINGFUL
SETZM TXTLEN(VR) ;EMPTY BUFFER
logger <Initing up for DATA receives>
JRST SETOUT ;GO INITIALIZE
;Here, read a line, check for leading ".", and store text or finish
INLOOP: CALL DCTREA ;READ A CHUNK OF MESSAGE
MOVE T3,TXTPTR(VR) ;FETCH POINTER TO IT
SCAND: SOSGE TXTLEN(VR) ;GET A CHARACTER HERE
JRST INLOOP ;NONE LEFT, GO REFIL BUFFER
ILDB T1,T3 ;PICK UP NEXT CHARACTER
CAIN T1,.CHLFD ;LF MEANS END OF LINE..
JRST FLAGLF ;SO GO FLAG IT AND GO ON
JUMPGE T6,DOTIRR ;ARE WE RIGHT AFTER A <LF>?
CAIE T1,"." ;YES, IS THIS A DOT?
JRST GOWRIT ;NO. CLEAR FLAG AND GO ON
MOVEI T6,1 ;YES, FLAG "<LF>." AND TOSS LEADING .
JRST SCAND ;AND GET NEXT CHARACTER
DOTIRR: JUMPE T6,GOWRIN ;NOT AFTER BARE <LF>. AFTER "<LF>."?
CAIE T1,.CHCRT ;ALLOW <LF>.<CR> TO TERMINATE
CAIN T1,.CHLFD ;ALSO ALLOW <LF>.<LF>, JIC
JRST WRISTR ;DONE! GO WRITE THIS LAST BUFFER
GOWRIT: TDZA T6,T6 ;HERE FOR A MUNDANE CHARACTER WRITE
FLAGLF: SETO T6, ;HERE TO FLAG A <LF>
GOWRIN: IDPB T1,OUTPNT(VR) ;PUT THE CHARACTER IN THE BUFFER
AOS T1,OUTCNT(VR) ;DID WE FILL IT?
CAIGE T1,OUTLEN*5-1 ;..
JRST SCAND ;NO, GET NEXT CHARACTER
;Here if we are dumping our last buffer (T6 .GT. 0) or have a full buffer to
;dump (T6 anything else).
WRISTR: SKIPE SENDFL(VR)
JRST SENDBR
PUSH P,FILE(VR) ;FILE
PUSH P,OUTBFR(VR) ;POINTER
PUSH P,OUTCNT(VR) ;LENGTH
PUSH P,[0] ;NO BUFFER FOR ERROR
CALL SVACLI
CALL UF%WRI
CALL RSACLI
ADJSP P,-4
TRNN T1,1
JRST STORFA ;WRITE ERROR, GO ABORT ALL THIS
SETOUT: SETZM OUTCNT(VR) ;BUFFER WRITTEN, RESET IT
MOVE T1,OUTBFR(VR)
MOVEM T1,OUTPNT(VR)
JUMPLE T6,SCAND ;"DONE" FLAG? GO DO MORE IF NOT LIT (.GT. 0)
EOFGOP: SKIPE SENDFL(VR)
JRST GOTHLO ;FINE, SAY OK
PUSH P,FILE(VR) ;CLOSE UP FILE
PUSH P,[0] ;CLOSE, NOT ABORT
PUSH P,[0] ;DONT WANT AN ERROR STRING
CALL SVACLI
CALL UF%CLO ;CLOSE IT
CALL RSACLI
ADJSP P,-3
SETZM FILE(VR) ;FILE NOT NOW OPEN
TRNN T1,1 ;CLOSE OK?
JRST STORFA ;NO, SAY FAILURE
;POST DATA AT REQ (LENGTH REQLEN)
logger <All DATA received, calling SCAN%P...>
PUSH P,REQ
PUSH P,[0]
PUSH P,[-1,,[ASCIZ/MX SMTP Listener/]]
PUSH P,[SC%WHL!IP$JAC]
CALL SVACLI
CALL SCAN%P ;CHECK THE PACKET
CALL RSACLI
ADJSP P,-4
logger <Return from SCAN%P>
JUMPE T1,STORFX ;SNH! WE BUILT IT RIGHT!
MOVE T1,.PKSTS(REQ) ;POST OK?
CAIN T1,.POST ;..
JRST GOTHLO ;RETURN OK
;BAD POST, ASSUME NO MEMORY TO HOLD IT
STORFX: PUSH P,SCNP%E
JRST STORFQ
SCNP%E: ASCIZ/ SMTLIS: Unexpected fail return from SCAN%P/
DSKW%E: ASCIZ/ SMTLIS: Can't write incoming mail to disk/
MEME%E: ASCIZ/ SMTLIS: Can't get memory to handle incoming mail/
STORFA: PUSH P,DSKW%E
JRST STORFQ
STORFL: PUSH P,MEME%E
;Here if a reasonable request can't be satisfied because of space
; Send a 452, Serious room problem.
;Come with address of complaint string on stack
STORFQ: PUSH P,[0] ;[318]Push a 0 for the "id"
CALL LOG
ADJSP P,-2 ;[318]Adjust the stack accordingly
logger <STORFL, unable to find memory or disk space, returning 452>
$RSE (452,SP$UIE)
DATANO: CALL SNDRSP
DATAN1: CALL READY
JRST NXTCMD
SENDBR: SETZ T1,
IDPB T1,OUTPNT(VR) ;NULL TERMINATE
MOVE T1,RCPTPT
MOVEI T1,1(T1) ;POINT AT USERNAME TEXT
PUSH P,T1
PUSH P,OUTBFR(VR) ;POINTER TO MESSAGE
CALL SVACLI
CALL BROAD ;SEND IT TO THE TERMINALS
CALL RSACLI
ADJSP P,-2
JRST SETOUT
BROAD: RET ;FOR NOW
;Here if we get an unexpected command. See if it is in the spec at all,
; or legal but not in this context, or legal in this context but not handled by
; us, and give the right error accordingly. MX's SMTP sender should never allow
; this to get called.
WHAT: MOVEI T1,ALLTBL
CALL CMDFND ;Is it legal at all?
TRNA
JRST ERR503 ;NOPE
MOVEI T1,UNSTBL ;YES, DO WE JUST NOT SUPPORT IT?
CALL CMDFND
JRST ERR500
ERR502: $RSE (502,MG$UIC)
JRST SNDRSP
ERR503: $RSE (503,MG$UEC)
JRST SNDRSP
ERR500: $RSE (500,MG$UNC)
JRST SNDRSP
ALLTBL: ALEN,,ALEN
[ASCIZ/DATA/],,0
[ASCIZ/HELO/],,0
[ASCIZ/MAIL/],,0
[ASCIZ/NOOP/],,0
[ASCIZ/QUIT/],,0
[ASCIZ/RCPT/],,0
[ASCIZ/RSET/],,0
[ASCIZ/SOML/],,0
[ASCIZ/VRFY/],,0
ALEN=.-ALLTBL-1
;Unimplemented command
UNSTBL: ULEN,,ULEN
[ASCIZ/EXPN/],,0 ;WE AREN'T THIS BRIGHT
[ASCIZ/HELP/],,0 ;HELPLESS
[ASCIZ/SAML/],,0 ;WE NEVER DO SEND AND MAIL
[ASCIZ/SEND/],,0 ;WE NEVER DO SEND (THIS WAY)
[ASCIZ/TURN/],,0 ;WE AREN'T THIS BRIGHT
ULEN=.-UNSTBL-1
;Here if we know this node is going down real soon. Politely request we hang up.
SYSDWN: $RSP (221,This node is going down - please QUIT)
CALL SNDRSP
CALL DCTREA
MOVEI T1,TABLE4 ;SEVERELY LIMIT CORRECT RESPONSES
CALL CMDFND
JRST SYSDWN ;WRONG, COMPLAIN AGAIN
JRST (T1)
;LEGAL RESPONSE TO A '221 SORRY GOING DOWN NOW' MESSAGE
TABLE4: TLEN4,,TLEN4
[ASCIZ/QUIT/],,QUIT
TLEN4=.-TABLE4-1
;Take the first 4 characters at txtptr and see what command they are.
CMDFND: MOVE T2,@TXTPTR(VR)
LDB T3,[POINT 7,T2,34]
CAIE T3," " ;5TH CHAR MUST BE <SP> OR <CR>
CAIN T3,.CHCRT
ACCTAB: TRZA T2,377 ;OK. MAKE IT <NULL>
RET ;BAD CHARACTER, NO SKIP RETURN
MOVEM T2,CMDWRD(VR) ;STORE 4 SYMBOLS OF COMMAND AND <NULL>
PUSH P,T1 ;PUSH TABLE ADDRESS
MOVE T3,T1 ;KEEP TABLE ADDRESS AROUND
MOVE T1,[POINT 7,CMDWRD]
ADD T1,VR
PUSH P,T1 ;PUSH BP TO STRING
MOVEI T1,SCRWRD(VR) ;PUSH ADDRESS TO RETURN INDEX IN
PUSH P,T1 ;..
CALL SVACLI
CALL TBL%LO ;CALL TABLE LOOKUP ROUTINE
CALL RSACLI
ADJSP P,-3 ;TOSS STACKED ARGS
TRNN T1,1 ;OK MATCH?
RET ;NO MATCH
MOVE T1,SCRWRD(VR) ;INDEX WENT HERE
ADD T1,T3
HRRZ T1,(T1) ;GET RH OF TARGET WORD
CPOPJ1: AOS (P) ;SKIP HOME
RET
;HERE FROM STATE 1, WAITING FOR THE HELO COMMAND
OKGGRT: $RSP (250,Please HELO)
CALL SNDRSP
JRST GETGRT
;WE EXPECT A HELO AND WERE DISSAPOINTED
NOHELO: CALL WHAT
JRST GETGRT
;Return a null terminated string starting at TXTPTR(VR)
;On a channel death, dispatch to DIENOW (does not return)
DCTREA: PUSH P,DECNET
PUSH P,[MAXREC]
PUSH P,TXTPTR(VR)
CALL SVACLI
CALL UN%READ
CALL RSACLI
ADJSP P,-3
JUMPE T1,DCTREA ;NO ONE WANTS A NULL STRING
JUMPL T1,DCTERR ;-1 OR -2 IS ERROR
MOVEM T1,TXTLEN(VR)
ADJBP T1,TXTPTR(VR) ;FORCE NULL TERMINATION
SETZ T2,
IDPB T2,T1
logget TXTPTR(VR)
MOVE T1,TXTLEN(VR) ;RETURN LENGTH
CPOPJ: RET
DCTERR: AOJE T1,TIMOUT ;-1 MEANS TIMED OUT
;ERROR OTHER THAN TIMOUT. ASSUME MESSAGE TOO LONG FOR OUR BUFFER. IF,
; INSTEAD, IT IS AN ABORTED LINK, SNDRSP WILL GO TO TIMOUT
CHOKE: $RSE (500,MG$LTL)
CALL SNDRSP
ADJSP P,-1 ;UNDO CALL TO DCTREA
JRST DIENOW ;QUIT WHILE WE CAN
;Here with T1/ BP to directive string, T2/ number of args in TXTBLK
; formats and sends string
SNDRSP: PUSH P,RSPPTR(VR)
MOVEI T3,(P)
PUSH P,T3
PUSH P,[MAXREC-5]
TLC T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
PUSH P,T1
PUSH P,T2
PUSH P,TXTBLK(VR)
CALL SVACLI
CALL UT%TEX
CALL RSACLI
ADJSP P,-6
SOSG T4,T1
JRST STORFL
;JRST DNTOUT
;Needs T4 containing number of bytes to write, and RSPPTR(VR) pointing at
; text to write. On an error, does not return (goes to DIENOW)
DNTOUT: logget RSPPTR(VR)
PUSH P,DECNET
PUSH P,[1] ;COMPLETE MESSAGE
PUSH P,T4
PUSH P,RSPPTR(VR)
CALL SVACLI
CALL UN%WRI
CALL RSACLI
ADJSP P,-4
TRNN T1,1
JRST TIMOUT
RET
;Here when we see a QUIT
QUIT: $RSP (221,Closing channel)
CALL SNDRSP
logger <Received a QUIT, closing channel real soon>
JRST DIENOW
TIMOUT: logger <SINR failed (at TIMOUT)>
DIENOW: logger <At DIENOW>
CALL READY
;CLOSE DECNET
JUMPLE DECNET,NCLOND ;CLOSE IF OPEN
PUSH P,DECNET
PUSH P,[0]
PUSH P,[0]
CALL SVACLI
CALL UN%CLO
CALL RSACLI
ADJSP P,-3
NCLOND:
JRST GOAGAI ;GO AGAIN, WAIT FOR NEXT CONNECT
;COPY STRING AND END WITH NULL
CSTR: CALL CSTRB
IDPB T3,T2
RET
;MEASURE STRING, RETURN COUNT IN T4
STRLEN: TLCE T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
STRLN: SETZ T4,
STRLE1: ILDB T3,T1
CAIE T3,0
AOJA T4,STRLE1
RET
;COPY STRING, LEAVE POINTER SET FOR APPENDING
CSTRB: TLCE T1,-1
TLCN T1,-1
HRLI T1,(POINT 7)
TLC T2,-1
TLCN T2,-1
HRLI T2,(POINT 7)
CSTRC: ILDB T3,T1
JUMPE T3,CPOPJ
IDPB T3,T2
AOJA T4,CSTRC
;SAVE AND RESTORE AC'S FOR BLISS
RSACLI: DMOVE T2,SAVACL(VR)
DMOVE T4,SAVACL+2(VR)
RET
SVACLI: DMOVEM T2,SAVACL(VR)
DMOVEM T4,SAVACL+2(VR)
RET
NOMEME: PUSH P,[POINT 7,[ASCIZ/Out of memory at SMTLIS startup/]]
CALL NMLDIE
;NO RETURN
STDSTR: ASCIZ !%D %A%/!
STDSTI: ASCIZ !%D %I%/!
END