From 8f8a44ac4e5016e61f866ceb2281007b46d5c841 Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Mon, 13 Mar 2017 22:42:04 -0700 Subject: [PATCH] Added EXPN/VRFY. Resolves #489. --- README.md | 1 + build/build.tcl | 5 + src/sysnet/expn.91 | 343 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 349 insertions(+) create mode 100755 src/sysnet/expn.91 diff --git a/README.md b/README.md index 664e3d45..bdd05cb9 100644 --- a/README.md +++ b/README.md @@ -145,6 +145,7 @@ A list of [known ITS machines](doc/machines.md). - DUMP/LOAD, tape backup and restore. - EMACS, editor. - EXECVT, convert 20x.exe (SSAVE) file to ITS BIN (PDUMP) file. + - EXPN/VRFY - query remote SMTP server. - FAIL, assembler from SAIL. - FCDEV, talk to LispM file server. - FDIR, fast directory listing. diff --git a/build/build.tcl b/build/build.tcl index e8d4b2f6..062abb7f 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -1367,6 +1367,11 @@ expect ":KILL" respond "*" ":midas sys3;ts host_sysnet;host\r" expect ":KILL" +# EXPN/VRFY +respond "*" ":midas sys3;ts expn_sysnet;expn\r" +expect ":KILL" +respond "*" ":link sys3;ts vrfy,sys3;ts expn\r" + # WHOLIN respond "*" ":midas sys2;ts wholin_sysen2;wholin\r" expect ":KILL" diff --git a/src/sysnet/expn.91 b/src/sysnet/expn.91 new file mode 100755 index 00000000..e52d7f00 --- /dev/null +++ b/src/sysnet/expn.91 @@ -0,0 +1,343 @@ +;;; This looks like -*- MIDAS -*- code to me! + + TITLE EXPN -- check remote mailing list + +;;; Open a conection to remote SMTP server and EXPN or VRFY name. + +;;; GUMBY, May 86 + +f=:0 +a=:1 +b=:a+1 +c=:b+1 +d=:c+1 +e=:d+1 +t=:12 +tt=:t+1 +length=:14 +strptr=:length+1 +ochan=:16 ;"standard-output" +p=:17 + +T1=7 +T2=10 + +call= +ret= + +ascbyt==440700 +sixbyt==440600 + +pdllen==:100 +.vector pdlbuf(pdllen) + +tyoch==1 +tyich==tyoch+2 +tblch==3 +nullch==4 +netich==5 +netoch==netich+1 + +.chspc=:40 ;space character + +define syscall name,args + .call [setz ? sixbit /name/ ? args((setz))] + termin + +define setup &string + movei length,<.length string> + move strptr,[ascbyt,,[ascii string]] +termin + +define type &string + setup string + syscal siot,[%climm,,tyoch ? strptr ? length] + .lose %lssys +termin + + SUBTTL set flags for NETWRK routines + +;;; Type char on T on tty +netwrk"putchr: .iot tyoch,t ? ret +debug: -1 + +$$CHAOS==1 ;1 to support Chaosnet hosts and rtns +$$ARPA==1 ;1 to support Arpanet hosts and rtns +$$TCP==1 ;1 to support /TCP switch & routines + +$$HOSTNM==1 ;Host name file lookup routines. +$$SYMGET==0 ;Interactive symbol input routine +$$SYMLOOK==1 ;table lookup routine. +$$HSTMAP==1 ;HSTMAP, HSTUNMAP, HSTSRC host name table rts +$$HSTSIX==0 ;Sixbit host name abbreviation +$$OWNHST==0 ;Routine to get own host address +$$NETSRC==0 ;NETSRC routine to get network names + $$ICP==1 ;Initial Connection Protocol + $$SERVE==0 ;Respond to an ICP (for a server) +$$CONNECT==1 ;Network Connection Routine (ARPCON, CHACON) +$$SIMPLE==0 ;Simple-transaction for Chaosnet +$$ANALYZE==1 ;Network Error Analysis Routine +$$ERRHAN==1 ;Automatic ANALYZE in ARPCON, CHACON, etc. +$$LOGGING==0 ;Network library usage logging + +.insrt dsk:syseng;netwrk + + SUBTTL program starts here + +;;; RFC 821 claims that neither uname nor domain may not exceed 64. +;;; characters in length, so we only have to handle that much command +;;; line (plus a little slack). + +usiz==:64. +hsiz==:64. + +.scalar comand ;name of the program (e.g. VRFY, EXPN) +.scalar hstlen,unmlen +.scalar host(+1) +.scalar user(+1) +.scalar hstnum +.scalar dbgch ;"debug" channel + +go: move p,[-pdllen,,pdlbuf-1] + syscal open,[%climm,,nullch ? %clbit,,.uao ? [sixbit/nul/]] + .lose %lsfil + movei a,nullch ;discard irrelevent bits... + skipe debug ;but when debugging, + movei a,tyoch ;print them on the console + movem a,dbgch + syscal open,[%clbit,,.uao+%tjdis ;want ^P + %climm,,tyoch ? [sixbit/tty/]] + .lose %lsfil + .iot tyoch,[^P] ? .iot tyoch,["A] ;we asked for it! + .suset [.rxjname,,T] + came t,[sixbit /expn/] + camn t,[sixbit /vrfy/] + skipa + jrst usage + movem t,comand + .suset [.roption,,a] + tlnn a,%opcmd ;no JCL??? + jrst usage + call getjcl ;parse the jcl + movei a,tblpgs ;where to map the host table + movei b,tblch + call netwrk"hstmap ;get the host table for hstlook + jrst maplos + movei a,host ;point to JCL + call netwrk"hstlook ;look for a host + jrst nxhost + movem a,hstnum + .iot tyoch,["[] ;] teco's not too bright + move b,a ;foo! + call netwrk"hstsrc + .lose %lssys ;huh? + hrli a,ascbyt ;make into byte ptr +hprlp: ildb b,a + jumpe b,hprdon + .iot tyoch,b + jrst hprlp + +hprdon: call netwrk"hstunmap + jrst maplos ;urk! + ldb tt,[netwrk"nw$byt,,hstnum] + ;; perhaps we should prefer internet for those hosts (like + ;; athena?) which claim to support chaos but don't? + caie tt,.ldb netwrk"nw$byt,netwrk"nw%chs ;arpa or chaos ? + jrst [call arpopn ? jrst .+2] ;open for arpanet + call chaopn + +;;; we're supposed to HELO here -- but Xerox's cedar SMTP is the only +;;; host which enforces this, I believe, and it can't support EXPN +;;; anyway! + call sndreq ;send EXPN or VRFY + call sndqt ;send quit + jrst die ;ugly but practical way to end it all! + + subttl parse jcl + +jcllen==:</5>+2 +.scalar jclbuf(jcllen+1) + +;;; clear whole JCL buffer in case we were $G'ed +getjcl: movei a,jcllen-1 +jclclr: setzm jclbuf(a) ;clear backwards! + sojge a,jclclr + setom jclbuf+jcllen ;now terminate is + .break 12,[..rjcl,,jclbuf] ;now ask for it + move a,[ascbyt,,jclbuf] +wskip: ldb b,a + caie b,.chspc ;space? + cain b,^I ;tab? + jrst [ibp a ? jrst wskip] + move b,[ascbyt,,user] + setz c, ;length count +uloop: ildb t,a + cain t,"@ ;atsign? + jrst udone ;uhuh + caile t,.chspc ;not printing character + cail c,usiz ;name too long? + jrst usage ;message should be more informative! + idpb t,b + aos c + jrst uloop + +udone: skipn c ;no uname? + jrst usage + movem c,unmlen + setz c, ;save an instruction, what the hell + idpb c,b ;terminate uname (in case we're $G'd) + move b,[ascbyt,,host] +hloop: ildb t,a + caie t,^M ;end of user typein + cain t,^? ;or end of JCLbuffer? + jrst hdone ;guess we'll call it a parse + caie t,^C ;despite the documentation, + cain t,^_ ;these ca terminate JCL too! + jrst hdone + caile t,.chspc ;not printing character + cail c,hsiz ;name too long? + jrst usage ;forget it! + idpb t,b + aos c + jrst hloop + +hdone: skipn c ;no host at all?? + jrst usage ;hmm... + movem c,hstlen + setz c, + idpb c,b ;terminate host name (in case we're $G'd) + ret + + SUBTTL error messages + +;;; These all print and die + +usage: type "Usage is :" + skipn comand + jrst [type "" + jrst usage1] + movei ochan,tyoch + call comprt +usage1: setup " Listname@host" + jrst prtdie + +;;; I've always liked this message from UP +nxhost: setup "Diplomatic Relations do not exist with the specified host." + jrst prtdie + +maplos: setup "Can't get host table!" + +prtdie: syscal siot,[%climm,,tyoch ? strptr ? length] + .lose %lssys +die: skipe debug + .value + .logout 1, + + subttl network IO + +;;; A reply line looks like XYZC X,Y,and Z are condition +;;; codes; C is either space or dash; dash means this line continues +;;; on the next + +netrpl: 0 ;contains remote reply code +netrbp: ascbyt,,netrpl ;bp to above +rplch1: 350700,,netrpl ;bp to first char (low-grade response) +rplch2: 260700,,netrpl ;bp to second char (med-grade response) +rplch3: 170700,,netrpl ;bp to third char (high-grade response) +rplcon: 100700,,netrpl ;bp to fourth char (whether this is final line) + +arpopn: type " via internet]" + .iot tyoch,[^M] ? .iot tyoch,[^J] + movei a,netich + move b,hstnum + movei c,25. ;ARPA is too stupid to think of names for ports! + call netwrk"tcpcon + jrst die + jrst opndon + +chaopn: type " via chaos]" + .iot tyoch,[^M] ? .iot tyoch,[^J] + movei a,netich + move b,hstnum + movei c,[asciz/SMTP/] + movei d,5 ;I haven't the faintest idea how big this should be. + call netwrk"chacon + jrst die +opndon: move ochan,dbgch + jrst prtrsp + +sndreq: movei ochan,netoch + call comprt + .iot netoch,[.chspc] + syscal siot,[%climm,,netoch ? [ascbyt,,user] ? unmlen] + .lose %lssys + .iot netoch,[^M] ? .iot netoch,[^J] + movei ochan,tyoch + jrst sndfin + +;;; Send QUIT command +sndqt: setup "QUIT +" + syscal siot,[%climm,,netoch ? strptr ? length] + .lose %lssys + move ochan,dbgch +sndfin: syscal force,[%climm,,netoch] + .lose %lssys + +;;; Read a response from the remote end; print it on channel in A. +;;; Believe that the remote host obeys RFC821. Just print the string; +;;; strip the first four characters of each line. +prtrsp: movei length,4 + move strptr,netrbp + syscal siot,[%climm,,netich ? strptr ? length] + .lose %lssys + skipn debug + jrst prtrs1 + movei length,4 ;now print those four characters + move strptr,netrbp + syscal siot,[%climm,,tyoch ? strptr ? length] + .lose %lssys + +;;; print eveything up to and including onto console +prtrs1: .iot netich,t ;get character + syscal iot,[ochan ? t] ;print it on appropriate stream + .lose %lssys + caie t,^J ;was it a linefeed? + jrst prtrs1 ;nope, keep on truckin' + ldb t,rplcon ;get continuation character + cain t,"- ;if it was a dash, then get the next line too + jrst prtrsp ;tail-recur + ret + +;;; Bashes T & TT, but prints command name on OCHAN/ +comprt: move tt,comand +compr1: setz t, + lshc t,6 ;get next character of host + addi t,.chspc ;convert to ASCII + syscal IOT,[ochan ? t] ;put into message + .lose %lssys + jumpn tt,compr1 ;do until whole name sent + ret + + + +;tsint: p +; 0 ? 1_usrch ? 0 ? 1_usrch ? die +;ltsint==:.-tsint + +;intloc==. +;loc 40 +; 0 +; 0 +; -ltsint,,tsint +;loc intloc + + consta ; dump the literals to avoid bashing them + variab ; same for .vector & friends + +patch: block 100 +patend: -1 + +tblpgs==<.+1777>/2000 ;place for hostab + +END GO