mirror of
https://github.com/PDP-10/its.git
synced 2026-01-31 05:52:12 +00:00
Added EXPN/VRFY. Resolves #489.
This commit is contained in:
Eric Swenson
343
src/sysnet/expn.91
Executable file
343
src/sysnet/expn.91
Executable file
@@ -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=<pushj p,>
|
||||
ret=<popj p,>
|
||||
|
||||
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(<hsiz+4/5>+1)
|
||||
.scalar user(<usiz+4/5>+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==:<<usiz+hsiz+1>/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 "<EXPN or VRFY>"
|
||||
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<random text> 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 <lf> 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
|
||||
Reference in New Issue
Block a user