;;; 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