mirror of
https://github.com/PDP-10/its.git
synced 2026-05-05 23:54:18 +00:00
Added EXPN/VRFY. Resolves #489.
This commit is contained in:
Eric Swenson
@@ -145,6 +145,7 @@ A list of [known ITS machines](doc/machines.md).
|
|||||||
- DUMP/LOAD, tape backup and restore.
|
- DUMP/LOAD, tape backup and restore.
|
||||||
- EMACS, editor.
|
- EMACS, editor.
|
||||||
- EXECVT, convert 20x.exe (SSAVE) file to ITS BIN (PDUMP) file.
|
- EXECVT, convert 20x.exe (SSAVE) file to ITS BIN (PDUMP) file.
|
||||||
|
- EXPN/VRFY - query remote SMTP server.
|
||||||
- FAIL, assembler from SAIL.
|
- FAIL, assembler from SAIL.
|
||||||
- FCDEV, talk to LispM file server.
|
- FCDEV, talk to LispM file server.
|
||||||
- FDIR, fast directory listing.
|
- FDIR, fast directory listing.
|
||||||
|
|||||||
@@ -1367,6 +1367,11 @@ expect ":KILL"
|
|||||||
respond "*" ":midas sys3;ts host_sysnet;host\r"
|
respond "*" ":midas sys3;ts host_sysnet;host\r"
|
||||||
expect ":KILL"
|
expect ":KILL"
|
||||||
|
|
||||||
|
# EXPN/VRFY
|
||||||
|
respond "*" ":midas sys3;ts expn_sysnet;expn\r"
|
||||||
|
expect ":KILL"
|
||||||
|
respond "*" ":link sys3;ts vrfy,sys3;ts expn\r"
|
||||||
|
|
||||||
# WHOLIN
|
# WHOLIN
|
||||||
respond "*" ":midas sys2;ts wholin_sysen2;wholin\r"
|
respond "*" ":midas sys2;ts wholin_sysen2;wholin\r"
|
||||||
expect ":KILL"
|
expect ":KILL"
|
||||||
|
|||||||
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