mirror of
https://github.com/PDP-10/its.git
synced 2026-01-21 10:13:35 +00:00
344 lines
8.1 KiB
Plaintext
Executable File
344 lines
8.1 KiB
Plaintext
Executable File
;;; 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
|