mirror of
https://github.com/PDP-10/its.git
synced 2026-03-09 12:30:45 +00:00
2237 lines
67 KiB
Plaintext
2237 lines
67 KiB
Plaintext
;;; -*- Midas -*-
|
||
|
||
NRTVER==.IFNM2
|
||
|
||
IFNDEF $$FTP,$$FTP==0 ; Do not assemble FTP routines anymore.
|
||
IFNDEF $$TCP,$$TCP==1 ; Normally assemble TCP routines.
|
||
IFNDEF $$DQ,$$DQ==0 ; Normally use host table, not DQ device.
|
||
IFNDEF $$450,$$450==0 ; Disable special casing of SMTP reply code 450
|
||
IFNDEF $$KA10, $$KA10==0 ; default to KS/KL-10 instructions
|
||
|
||
comment|
|
||
This file contains the network hacking code of COMSAT.
|
||
|
||
Routines called by COMSAT:
|
||
|
||
HANLYZ - Convert host names to host numbers.
|
||
NETIM - Queries a network time server.
|
||
NETPTH - For the host in N, find a proper network address/protocol.
|
||
NETICP - Makes network connection.
|
||
NTDISC - Disconnects.
|
||
|
||
NETSND calls these routines:
|
||
|
||
NTXRSQ - Find XRCP scheme that the host prefers.
|
||
NHMLTX and NHITS see if a host is a Multics or an ITS.
|
||
|
||
Generic protocol routines called by NETSND to dispatch
|
||
to protocol-specific handlers:
|
||
|
||
NTMBEG - Readies server for message txt to a rcpt.
|
||
NTXRCP - Specifies rcpt to host.
|
||
NTMSND - Sends the message text.
|
||
NTMEND - Wraps up message and leaves connection ready for next command.
|
||
|
||
Non-skip indicates either:
|
||
1] An IOC error (connections broken),
|
||
2] An interaction failure which is probably temporary (go away)
|
||
3] An interaction failure which is probably permanent (no such user)
|
||
Generally the following values are returned on error:
|
||
A/ MR$xxx error code, one of:
|
||
MR$PEH - Permanent Error for Host (this msg will never win)
|
||
MR$TEH - Temporary Error for Host (host died or conns wedged)
|
||
MR$PER - Permanent Error for Rcpt (this rcpt will never win)
|
||
MR$TER - Temporary Error for Rcpt (some glitch for this rcpt)
|
||
B/ if non-zero, SLP to an error string
|
||
|
||
|
||
|
|
||
|
||
BVAR
|
||
; Global XRCP-hacking vars
|
||
XRSQQ: 0 ; -1 if have tried asking host its preference.
|
||
XRSQPS: 0 ; Preferred scheme of host. 0 none, -1 R, +1 T.
|
||
XRSQRS: 0 ; Scheme actually in effect over net channels.
|
||
XRSQS: 0 ; Scheme selected by sending rtns. (NETSND only)
|
||
|
||
NSMSAR: BLOCK $ARSIZ ; Area for storage of SMTP transaction script
|
||
; Always contains results of last SMTP connection.
|
||
IFN $$DQ,{ ; If doing domain code
|
||
DQBUF: BLOCK 63 ; Random buffer for string hacking (ugh)
|
||
; Size determined by need to hold 255. char hostnames,
|
||
; per RFC 883.
|
||
DQLUZ: 0 ; Fence to detect horrible lossage in NHOPSY.
|
||
} ; End of domain specific storage.
|
||
EVAR
|
||
|
||
|
||
SUBTTL Protocol Definitions
|
||
|
||
BVAR
|
||
NDHOST: 0 ; Host # we're supposedly talking to.
|
||
; Should be same as ac N, or an error has happened.
|
||
NTSITE: 0 ; Host # NETPTH thinks we should connect to - becomes NTHOST.
|
||
NTHOST: 0 ; Host # really connected to, usually same as NDHOST.
|
||
NTTYPE: 0 ; Current net transport/protocol available.
|
||
NTRTSW: 0 ; -1 if relaying mail; tack "@host" onto rcpt names.
|
||
|
||
;;; Variables for forcing certain kludgey routing.
|
||
|
||
KLGFRM: -1 ; Network address from
|
||
KLGTO: -1 ; Network address to
|
||
KLGNET: -1 ; Don't use this network
|
||
KLGGAT: -1 ; Instead, use this host as gateway
|
||
TCPGAT: 0 ; If nonzero, gateway all non-chaos mail through here.
|
||
|
||
;;; For a Chaosnet-only host, set only TCPGAT to Chaos addr of the relay host.
|
||
;;; If the host thinks it is on the ARPAnet, but isn't really, also set OWNHS2.
|
||
;;; You should not generally have to set the other kludge switches.
|
||
|
||
;;; PROTCL macro defines the routines appropriate for each protocol.
|
||
|
||
PR$NAM==:0 ;Name of protocol
|
||
PR$ICP==:1 ;Connection routine
|
||
PR$MIN==:2 ;Transaction initializer
|
||
PR$BEG==:3 ;Message command sender
|
||
PR$RCP==:4 ;Message rcpt sender
|
||
PR$SND==:5 ;Message text sender
|
||
PR$END==:6 ;Message ender
|
||
PR$CHK==:7 ;Error classifier
|
||
NETPR: BLOCK 4*8.
|
||
EVAR
|
||
|
||
%%%PR$==NETPR
|
||
DEFINE PRODEF SYM,NUM,&NAME&,ICPRTN,MINRTN,BEGRTN,RCPRTN,SNDRTN,ENDRTN,CHKRTN
|
||
SYM==:NUM
|
||
IF1,{ PRINTX \Including protocol NAME
|
||
\ }
|
||
%%%TLC==.
|
||
LOC %%%PR$
|
||
[ASCIZ NAME]
|
||
ICPRTN ? MINRTN ? BEGRTN ? RCPRTN ? SNDRTN ? ENDRTN ? CHKRTN
|
||
%%%PR$==%%%PR$+8.
|
||
LOC %%%TLC
|
||
TERMIN
|
||
|
||
NT$LCL==-1 ; Local mail "protocol" (don't change).
|
||
|
||
PRODEF NT$ISM,0,"TCP-SMTP",NSMICP,NSMINI,NSMBEG,NSMRCP,NSMDAT,NSMDON,NTERSM
|
||
PRODEF NT$CHM,1,"CHAOS-MAIL",NKMICP,NKMINI,NKMBEG,NKXRCP,NKSND,NKEND,NTERSM
|
||
PRODEF NT$CHS,2,"CHAOS-SEND",POPJ1,POPJ1,NKSEND,POPJ1,NKSND,NKEND,NTERSM
|
||
PRODEF NT$CSM,3,"CHAOS-SMTP",NKSICP,NSMINI,NSMBEG,NSMRCP,NSMDAT,NSMDON,NTERSM
|
||
IFN $$FTP,[
|
||
PRODEF NT$FTP,4,"NCP-FTP",NNFICP,POPJ1,NNFBEG,POPJ1,NNFRCP,NNFSND,NNFEND,NTERFT
|
||
];$$FTP
|
||
|
||
DEFINE PROTCL AC,PR
|
||
MOVE AC,NTTYPE
|
||
IMULI AC,8.
|
||
MOVE AC,NETPR+PR(AC)
|
||
TERMIN
|
||
|
||
|
||
SUBTTL Network Service Paths
|
||
|
||
; NETPTH - Find path to network service.
|
||
; Takes desired host in N. SORMSW must be set up.
|
||
; Skips if re-connection needed; non-skip means already connected properly.
|
||
; Sets up NTTYPE, NTSITE, and NTRTSW.
|
||
; (Host # zero in N means ourselves.)
|
||
|
||
NETPTH: PUSHAE P,[A,B,N]
|
||
SETZM NTRTSW ; Reset routing flag.
|
||
JUMPE N,[ SETOM NTTYPE ? JRST NETP99 ]
|
||
RESOLV"GETNET A,N ; Find which network the dest site is on.
|
||
CAMN A,[RESOLV"NW%CHS] ; Is host on the Chaosnet?
|
||
JRST NETP10 ; Yes, good - we always have Chaosnet.
|
||
SKIPE B,TCPGAT ; Internet relay required?
|
||
JRST [ MOVE N,B ; Yes, will really connect thru relay.
|
||
JRST NETP60 ]
|
||
NETP10: CAME N,NTHOST ; Are we already connected?
|
||
JRST NETP20 ; No.
|
||
SKIPN SORMSW ; If we are mailing (not sending)
|
||
JRST [ MOVE N,NTHOST ; Current connection is usable.
|
||
JRST NETP99 ]
|
||
CAME A,[RESOLV"NW%CHS] ; Sending over Chaosnet?
|
||
JRST [ MOVE N,NTHOST ; No, so protocols are fairly compatible.
|
||
JRST NETP99 ]
|
||
;; New connection required.
|
||
NETP20: CAMN N,KLGFRM ; If specially patched for this host
|
||
JRST [ MOVE N,KLGTO ; use specific relay address.
|
||
JRST NETP60 ]
|
||
CAME A,[RESOLV"NW%CHS] ; Chaosnet is the fastest connection,
|
||
CAME A,KLGNET
|
||
JRST NETP80
|
||
MOVE N,KLGTO ; Use specific relay address.
|
||
NETP60: SETOM NTRTSW ; Say we are relaying.
|
||
JRST NETP90
|
||
;; No monkey business, just find preferred host address.
|
||
NETP80: MOVE A,[RESOLV"NW%CHS] ; Chaosnet is fastest way to go.
|
||
CALL NETALK ; Find address for host on Chaosnet.
|
||
CAIA
|
||
MOVE N,B ; N gets best host address.
|
||
NETP90: MOVEI B,NT$ISM ; Default transport type is IP-TCP/SMTP.
|
||
RESOLV"GETNET A,N ; Find network.
|
||
CAMN A,[RESOLV"NW%CHS] ; If site IS on the Chaosnet
|
||
MOVEI B,NT$CSM ; Use CHAOS/SMTP instead.
|
||
NETP96: MOVEM B,NTTYPE ; Set up NTTYPE.
|
||
AOS -3(P) ; Say that reconnection is needed.
|
||
NETP99: MOVEM N,NTSITE ; Store actual address to be used.
|
||
POPAE P,[N,B,A]
|
||
RET
|
||
|
||
; NETALK - Network address lookup
|
||
; Look up host address for host in N on network in A.
|
||
; Skip if found with new address in B.
|
||
|
||
NETALK:
|
||
IFN $$DQ,{ ; Domain version? This is gonna hurt...
|
||
RESOLV"GETNET B,N ; Get network for this address
|
||
CAME A,B ; Already have right net?
|
||
JRST NETAL0 ; No, onwards
|
||
MOVE B,N ; Yes, just return this address
|
||
AOS (P) ; Winningly
|
||
RET
|
||
NETAL0:
|
||
IFN 0,{ ; Questionable painkiller code
|
||
CAME A,[RESOLV"NW%CHS] ; Trying to get a Chaosnet address?
|
||
RET ; Nope, forget it, waste of time.
|
||
} ; End of questionable painkiller code
|
||
PUSH P,A ; Save network number
|
||
MOVE A,[440700,,DQBUF] ; Stuff hostname string here
|
||
MOVE B,N ; Host number
|
||
CALL RESOLV"HSTSRC ; Look it up
|
||
JRST NETAL9 ; Punt
|
||
MOVE A,[440700,,DQBUF] ; Probably already there, so what?
|
||
MOVE B,(P) ; A points at name, get network number
|
||
CALL RESOLV"HSTADN ; Look up net specific address
|
||
JRST NETAL9 ; Lost
|
||
MOVE B,A ; Won, address in B
|
||
AOS -1(P) ; Skip return
|
||
NETAL9: POP P,A
|
||
RET
|
||
} ; End of domain version
|
||
.ELSE { ; Non-domain version, still support this
|
||
PUSHAE P,[A,C,D,E]
|
||
MOVE B,N ; Get host #.
|
||
MOVE E,A ; Get network #.
|
||
CALL RESOLV"HSTSRC ; Look up in HOSTS3 database.
|
||
JRST NETAL9
|
||
HRRZ C,(D) ; Get rel addr of ADDRESS entry list.
|
||
JUMPE C,NETAL9
|
||
NETAL1: ADD C,RESOLV"HSTADR ; Derelativize.
|
||
RESOLV"GETNET B,(C) ; Get network for this address entry.
|
||
CAMN B,E ; Is this the one?
|
||
JRST [ MOVE B,(C) ; Yes!
|
||
AOS -4(P)
|
||
JRST NETAL9 ]
|
||
HRRZ C,RESOLV"ADRCDR(C) ; CDR down ADDRESS list.
|
||
JUMPN C,NETAL1
|
||
NETAL9: POPAE P,[E,D,C,A]
|
||
RET
|
||
} ; .ELSE $$DQ
|
||
|
||
|
||
SUBTTL Error handling routines
|
||
|
||
|
||
BVAR ; leave these as variable so we can patch COMSAT -- Gumby
|
||
ICPTMO: 30. ; Timeout ICP after 30 sec. total
|
||
FINTMO: 60. ; timeout for finish
|
||
BYETMO: 30. ; timeoout for SMTP QUIT
|
||
DEFTMO: 300. ; default timeout.
|
||
EVAR
|
||
|
||
; NETRAP - Network Error Trap. Sets up stuff so that
|
||
; a timeout or IOC error will restore ACs and PDL and
|
||
; jump to a specified location.
|
||
; A - # seconds of timeout.
|
||
; Returns .+2 after setting up.
|
||
; RETURNS .+1 IF ERROR TRAP OCCURS!!!
|
||
; BEWARE!!! THIS ROUTINE MUNGS THE PDL!!! Call NERESET before
|
||
; attempting a non-error return!!
|
||
; Either error trap will call NTDISC before returning, so that
|
||
; any possible server in a screwed-up state does not get reused.
|
||
|
||
LVAR NTRPLV: 0 ; Holds ptr to trap frame on PDL.
|
||
LVAR NTRTMO: 0 ; Value of timeout in 60th's of sec.
|
||
NE$FLN==:<5+15> ; Frame length; 5 vars plus 15 ACs.
|
||
|
||
NETRAP: PUSH P,NTRPLV ; Save any previous frame ptr.
|
||
PUSH P,NTRTMO ; Save old timeout value
|
||
PUSH P,NTIOCV ; Save old IOC vector
|
||
PUSH P,RLTVEC ; and old REALT vector.
|
||
IMULI A,60. ; Find timeout in REALT units (60ths of secs)
|
||
MOVEM A,NTRTMO ; Set it.
|
||
IFN A-1,.ERR NETRAP loses, code assumes A=1.
|
||
MOVEI A,1(P)
|
||
HRLI A,2
|
||
ADD P,[15,,15] ; Make room for ACs 2-16
|
||
BLT A,(P) ; Move ACs 2-16 onto PDL.
|
||
PUSH P,[SIXBIT /EFRAME/] ; Check word.
|
||
CLKOFF ; Avoid timing errors.
|
||
MOVEM P,NTRPLV ; Frame completed, now point to it!
|
||
MOVEI A,NTRRLT ; Set up RLT vector.
|
||
MOVEM A,RLTVEC
|
||
MOVEI A,NTRIOC ; Set up IOC vector.
|
||
MOVEM A,NTIOCV
|
||
CLKSET NTRTMO ; Set timeout going.
|
||
CLKON ; and enable timeout interrupt.
|
||
MOVE A,-NE$FLN(P) ; Get back return addr
|
||
JRST 1(A) ; Do skip return!
|
||
|
||
LVAR NTIOCV: 0 ; Net IOC error vector. Holds addr of where to go
|
||
; when a network IOC error happens. Set by NETRAP.
|
||
|
||
;; Come here for any net-channel IOC error.
|
||
NTRIOC: CALL NERZAP ; Restore world
|
||
CALL NTDIS1 ; Thoroughly break connections
|
||
MOVSI A,NCE$IO ; Furnish code for "IOC error"
|
||
RET ; and dispatch to NETRAP return.
|
||
|
||
|
||
NTRRLT: CALL NERZAP ; Restore the world
|
||
CALL NTDIS1 ; Thoroughly break connections
|
||
MOVSI A,NCE$TO ; Furnish code for "Timeout"
|
||
RET ; and dispatch to NETRAP return.
|
||
|
||
|
||
; NERESET - Called in order to flush a trap frame from the PDL.
|
||
; Turns off clock and restores PDL to state as of NETRAP,
|
||
; but doesn't restore any ACs!!
|
||
; Contrives to return "normally".
|
||
; NERZAP - similar, but DOES restore ACs, and leaves NETRAP
|
||
; return address on stack - a POPJ will dispatch to the
|
||
; location immediately after the NERTRAP call.
|
||
; Both clobber A.
|
||
|
||
NERESET:
|
||
CLKOFF ; Turn off clock before messing with PDL.
|
||
SKIPN A,NTRPLV
|
||
JSR AUTPSY
|
||
MOVE A,(A) ; Get last wd on purported frame
|
||
CAME A,[SIXBIT /EFRAME/] ; Make sure a frame is there!
|
||
JSR AUTPSY
|
||
POP P,A ; Yes, so get return addr
|
||
MOVE P,NTRPLV ; Restore PDL ptr to frame level
|
||
SUB P,[16,,16] ; Pop off check-word plus 15 saved ACs.
|
||
POPAE P,[RLTVEC,NTIOCV,NTRTMO,NTRPLV] ; Restore various stuff.
|
||
SUB P,[1,,1] ; Flush old NETRAP return addr.
|
||
JRST (A) ; Return to caller!
|
||
|
||
NERZAP: CLKOFF ; Turn off clock before messing with PDL.
|
||
SKIPN A,NTRPLV
|
||
JSR AUTPSY
|
||
MOVE A,(A) ; Get last wd on purported frame
|
||
CAME A,[SIXBIT /EFRAME/] ; Make sure a frame is there!
|
||
JSR AUTPSY
|
||
POP P,A ; Save return addr to caller.
|
||
MOVE P,NTRPLV ; Restore PDL ptr to frame level
|
||
MOVSI 16,-<<15-1>+1>(P) ; Set up for restoring 15 ACs (2-16)
|
||
; Note extra check wd at top of stack.
|
||
HRRI 16,2
|
||
BLT 16,16 ; Move the words!
|
||
SUB P,[16,,16] ; Flush ACs and check-word from stack.
|
||
POPAE P,[RLTVEC,NTIOCV,NTRTMO,NTRPLV] ; Restore various stuff.
|
||
JRST (A) ; Return to caller.
|
||
; NOTE CAREFULLY that (P) now contains the return
|
||
; addr for the NETRAP invocation; a POPJ will dispatch!
|
||
|
||
|
||
SUBTTL Initial Connection Protocols
|
||
|
||
; NETICP - Performs ICP to foreign host's server.
|
||
; N - Host # to connect to.
|
||
; Sets up NETI and NETO channels.
|
||
; Skips if success.
|
||
; NTHOST - set to host # connected to. (-1 if failure).
|
||
|
||
NCETAB: OFFSET -.
|
||
NCE$GR:: [ASCIZ /Bad Greeting/]
|
||
NCE$HR:: [ASCIZ /Bad init reply/]
|
||
NCE$TO:: [ASCIZ /Timeout/]
|
||
NCE$IO:: [ASCIZ /IOC error/]
|
||
NCE$SY:: [ASCIZ /Syscal err/]
|
||
NCE$CS:: [ASCIZ /Bad state/]
|
||
NCE$I2:: [ASCIZ /NCP 2 conn state/]
|
||
NCE$I3:: [ASCIZ /NCP 3 conn state/]
|
||
NCE$NO:: [ASCIZ /Refused/]
|
||
OFFSET 0
|
||
|
||
NETICP: PUSHAE P,[A,B]
|
||
NETIC1: MOVE U1,DEBUG
|
||
CAMN U1,[-2]
|
||
JRST [ STAT (,("N="),O(N),(" NTHOST="),O(NTHOST),(" NTSITE="),O(NTSITE),(" NTTYPE="),O(NTTYPE))
|
||
JRST .+1 ]
|
||
SETOM NDHOST ; Zap "current host", about to perform new ICP.
|
||
SETZM XRSQQ ; Also zap whether host has been asked re XRCP.
|
||
SETZM NTCCON ; Zap Chaosnet reconnect flag
|
||
SETZM NTRBUF ; Zap #$%^&&^%$ reply buffer
|
||
MOVE A,NTSITE ; Find host we should really use.
|
||
MOVEM A,NTHOST ; Set it to be the current host.
|
||
STAT (,(" ICP-"),RABR,HST(N))
|
||
PROTCL A,PR$NAM
|
||
CSTAT (,SP,LPAR,TZ(@A),FRC)
|
||
SKIPE NTRTSW
|
||
JRST [ CSTAT (,(" via "),HST(NTHOST))
|
||
JRST .+1 ]
|
||
MOVE A,ICPTMO ; Get # secs of timeout for ICP.
|
||
CALL NETRAP ; Set up error traps.
|
||
JRST NETIC2 ; If timeout or IOC trap sprung, handle error.
|
||
PROTCL A,PR$ICP
|
||
CALL (A) ; Call it.
|
||
CAIA
|
||
JRST [ CALL NERESET ; Won - flush err trap.
|
||
CSTAT (,RPAR) ;
|
||
MOVEM N,NDHOST ; Say connected to this host.
|
||
POP P,B ; Skip return.
|
||
JRST POPAJ1 ]
|
||
MOVE B,A ; ICP Lost!
|
||
CALL NERESET ; Reset the trap.
|
||
MOVE A,B ; Recover the error code.
|
||
NETIC2: MOVEM A,NTERRC' ; Come here if error trap hit.
|
||
CSTAT (,("="),CALL(NTICPE),RPAR,FRC)
|
||
CALL NTDISC ; Disconnect if not already disconnected.
|
||
|
||
;; **** Hack: Try CHAOS if Internet is losing. *****
|
||
;; **** Also: Use MAIL if CHAOS/SMTP loses. *****
|
||
;; [I'm not sure what the first part does anymore,
|
||
;; given that we prefer CHAOS addresses already].
|
||
MOVE A,NTTYPE ; Examine current protocol type.
|
||
CAIN A,NT$CSM ; CHAOS/SMTP?
|
||
JRST [ MOVEI A,NT$CHM ; Yeah, switch to CHAOS/MAIL
|
||
SKIPE SORMSW ; or CHAOS/SEND
|
||
MOVEI A,NT$CHS ; as appropriate.
|
||
MOVEM A,NTTYPE
|
||
JRST NETIC1 ] ; Start over....
|
||
CAIN A,NT$CHS ; If was CHAOS-SEND
|
||
JRST NETIC9 ; There is no alternate path.
|
||
CAIN A,NT$ISM ; Did we already try the Chaosnet?
|
||
JRST [ MOVE A,[RESOLV"NW%CHS]
|
||
CALL NETALK ; Try Chaosnet address.
|
||
JRST POPBAJ
|
||
MOVE N,B
|
||
MOVEM N,NTSITE
|
||
MOVEM N,NTHOST
|
||
MOVEI A,NT$CHM
|
||
MOVEM A,NTTYPE
|
||
JRST NETIC1 ]
|
||
NETIC9: JRST POPBAJ ; Already tried everything and lost.
|
||
|
||
; NTICPE - Output error message for ICP error value in A.
|
||
; Clobbers A, B.
|
||
|
||
NTICPE: HLRZ B,A
|
||
OUT(,TZ$(NCETAB(B)))
|
||
CAIE B,NCE$GR ; If problem is bad reply, show it.
|
||
CAIN B,NCE$HR
|
||
JRST [OUT(,(|="|),CALL(NTRSHO),(|"|))
|
||
RET]
|
||
HRRES A
|
||
SKIPE A
|
||
OUTCAL(,(","))
|
||
JUMPL A,[MOVMS A
|
||
OUT(,D(A))
|
||
RET]
|
||
CAIE A,
|
||
OUTCAL(,ERR(A))
|
||
RET
|
||
|
||
|
||
;;; Disconnecting
|
||
|
||
; NTDISC - closes telnet connections to remote server
|
||
; NKDISC is entry for CHAOS, which has to pretend that conns are still open.
|
||
; (I wonder if it is a bug if this these rtns are called
|
||
; with NETO closed, which has caused IOC errs.)
|
||
|
||
NTDISC: MOVE U1,NTHOST ; Check net host connected to.
|
||
SKIPE U1 ; If local
|
||
CAMN U1,[-1] ; or not connected
|
||
JRST NTDIS1 ; just zap conn state and close channels.
|
||
MOVE U1,NTTYPE ; Check protocol/transport.
|
||
CAIE U1,NT$ISM ; If this is SMTP
|
||
CAIN U1,NT$CSM ; on any medium
|
||
CALL NSMBYE ; be polite and say we are going away.
|
||
NOP
|
||
NTDIS1: SETOM NDHOST ; Say no longer connected to anything!
|
||
SETOM NTHOST
|
||
SETZM XRSQQ ; And no state here, either.
|
||
SETZM NTCCON
|
||
NKDISC: .CLOSE NETD, ; Close all channels, make clean sweep.
|
||
.CLOSE NETI,
|
||
XCTIOC [OUTCAL(NETO,CLS)]
|
||
NOP ; Close this way to flush any buffer.
|
||
.CLOSE NETO, ; Above doesn't always close the ITS channel
|
||
RET
|
||
|
||
|
||
|
||
; NTRDED - Here when unexpected disconnection is detected.
|
||
; Returns temporary host error.
|
||
|
||
NTRDED: CSTAT (,("...net conns gone."))
|
||
MOVEI A,MR$TEH
|
||
SETZ B,
|
||
RET
|
||
|
||
|
||
|
||
SUBTTL XRSQ Hacking routines
|
||
|
||
; NTXRSQ - Find which scheme (T or R) host prefers using.
|
||
; Returns after setting XRSQ variables.
|
||
; Skips if net conns still open.
|
||
|
||
NTXRSQ: CAME N,NDHOST
|
||
JRST NTRDED
|
||
IFN $$FTP,[
|
||
MOVE U1,NTTYPE ; Find protocol/transport type in use.
|
||
CAIN U1,NT$FTP ; If it is FTP
|
||
JRST NTXSR1 ; must negotiate scheme.
|
||
];$$FTP
|
||
;; The CHAOS SEND protocol does not do XRCP.
|
||
MOVE U1,NTTYPE
|
||
CAIN U1,NT$CHS
|
||
JRST [ SETZM XRSQPS ; No XRCP.
|
||
SETZM XRSQRS ; None in effect.
|
||
SETZM XRSQS ; None selected.
|
||
SETOM XRSQQ ; Say have asked host.
|
||
RET ]
|
||
|
||
;; The SMTP and all CHAOS MAIL protocols always use scheme "R".
|
||
SETOM XRSQPS ; Say R scheme preferred
|
||
SETOM XRSQRS ; and is in effect.
|
||
SETOM XRSQQ ; and have asked host.
|
||
SETZM XRSQS ; Clear just in case.
|
||
RET ; All done.
|
||
|
||
IFN $$FTP,[
|
||
;; NCP/FTP requires noegotiation.
|
||
|
||
NTXSR1: PUSHAE P,[A,B]
|
||
MOVE A,DEFTMO ; Allow 30 sec for XRSQ procedure.
|
||
CALL NETRAP
|
||
JRST NTXRS9 ; If error...
|
||
SETZM XRSQQ ; Zap all vars. Say haven't asked.
|
||
SETZM XRSQS ; Say none selected.
|
||
SETZM XRSQPS ; Say none preferred.
|
||
SETZM XRSQRS ; Say none in actual use.
|
||
|
||
FWRITE NETO,[[XRSQ ?
|
||
]] ; Ask question of host.
|
||
.NETS NETO,
|
||
MOVEI A,215. ; Look for this reply...
|
||
CALL NTRNXX ; Look for reply.
|
||
JRST NTXRS8 ; Lost.
|
||
;; Win, host hacks XRSQ! See which scheme to use.
|
||
MOVE A,NTRCNT ; Get # chars in reply buffer
|
||
CAIGE A,5 ; Need at least this many.
|
||
JRST NTXRS8 ; Sigh...
|
||
LDB A,[010700,,NTRBUF] ; Gross crock. Get 5th char...
|
||
SETZ B,
|
||
CAIE A,"T
|
||
CAIN A,"t ; Text-first scheme?
|
||
MOVEI B,1 ; Yep, use this.
|
||
CAIE A,"R
|
||
CAIN A,"r ; Rcpts-first scheme?
|
||
SETO B, ; Yep, use -1.
|
||
MOVEM B,XRSQPS ; Say which scheme host prefers.
|
||
JUMPE B,NTXRS8 ; Just return now if none preferred.
|
||
TRZ A,40 ; Make sure letter is uppercase...
|
||
FWRITE NETO,[[XRSQ ],TI,(A),[
|
||
]]
|
||
.NETS NETO, ; Try to select that scheme!
|
||
MOVEI A,200. ; Look for this reply exactly.
|
||
CALL NTRNXX
|
||
JRST NTXRS8 ; Couldn't get?? Oh well.
|
||
MOVE A,XRSQPS ; Hurray, got it!
|
||
MOVEM A,XRSQRS ; Mark that as scheme now in effect!!
|
||
; Drop thru to return.
|
||
|
||
NTXRS8: SETOM XRSQQ ; Have asked, don't do again this host.
|
||
CALL NERESET
|
||
AOS -2(P)
|
||
NTXRS9: PJRST POPBAJ
|
||
];$$FTP
|
||
|
||
|
||
; NTXRCP - Send an XRCP recipient specification.
|
||
; A - ASCNT ptr to rcpt name
|
||
; Returns .+1 if error (A and B as per usual)
|
||
; .+2 if win.
|
||
|
||
NTXRCP: CAME N,NDHOST ; Ensure still connected.
|
||
JRST NTRDED
|
||
MOVE B,A
|
||
MOVE A,DEFTMO
|
||
SKIPLE XRSQRS ; But if current scheme is Text-first,
|
||
LSH A,2 ; be more generous.
|
||
CALL NETRAP
|
||
JRST [ HLRZ B,A
|
||
CSTAT (,(" ..."),TZ$(NCETAB(B))) ; Timeout or IOC
|
||
JRST NTXRC9 ]
|
||
PROTCL A,PR$RCP
|
||
CALL (A) ; Do it.
|
||
JRST NTXRC5 ; Ananlyze error code.
|
||
CALL NERESET ; Win - flush network error trap.
|
||
SETZB A,B
|
||
JRST POPJ1
|
||
|
||
;;; Here to analyze error resulting from recipient spec.
|
||
|
||
NTXRC5: MOVE B,A ; Here to analyze rcpt error.
|
||
CALL NERESET ; Flush error trap.
|
||
IFN $$450, CAIE B,450.
|
||
CAIL B,500.
|
||
SKIPA A,[MR$PER] ; Permanent error
|
||
MOVEI A,MR$TER ; Else assume temp err. (4xx)
|
||
CAIA
|
||
NTXRC9: MOVEI A,MR$TEH ; Maybe change this later?
|
||
SETZ B,
|
||
CAIN A,MR$PER
|
||
JRST [ CALL RPLYER ; For permanent error, return message
|
||
CSTAT (,(" ...PERM ERR="),LBRC,CALL(NTRSHO),RBRC)
|
||
RET]
|
||
CAIE A,MR$TER
|
||
RET
|
||
CSTAT (,(" ...TEMP ERR="),LBRC,CALL(NTRSHO),RBRC)
|
||
RET
|
||
|
||
|
||
SUBTTL NTMINI - Dispatch to message transaction initialization
|
||
|
||
; NTMINI - A should have LP to rcpt list
|
||
|
||
NTMINI: MOVE A,DEFTMO
|
||
CALL NETRAP ; Set up timeout.
|
||
JRST [ HLRZ B,A ; If we lose, print error msg.
|
||
CSTAT (,("..."),TZ$(NCETAB(B)))
|
||
JRST NTMIN9 ]
|
||
PROTCL U1,PR$MIN
|
||
CALL (U1)
|
||
CAIA
|
||
JRST [ CALL NERESET ; Flush errset.
|
||
SETZB A,B
|
||
JRST POPJ1 ]
|
||
MOVE B,A ; Get reply from protocol initialization.
|
||
CALL NERESET ; Flush trap frame, etc.
|
||
CSTAT (,(|...init lost, R="|),CALL(NTRSHO),(|"|))
|
||
IFN $$450, CAIE B,450.
|
||
CAIL B,500.
|
||
JRST NTMIN8 ; Lossage...
|
||
SKIPA B,[MR$TER] ; Assume temp err. (4xx)
|
||
NTMIN8: MOVEI B,MR$PER
|
||
SKIPA A,B
|
||
NTMIN9: MOVEI A,MR$TEH
|
||
SETZ B,
|
||
CAIN A,MR$PER
|
||
CALL RPLYER ; For permanent error, return message
|
||
RET
|
||
|
||
SUBTTL NTMBEG - Dispatch to message setup routine
|
||
|
||
; NTMBEG -
|
||
; A - ASCNT ptr to name string
|
||
; B - Command type (0 for MAIL, -1 for FTP/MLFL, 1 for Send)
|
||
; This arg is only really used by the FTP routines.
|
||
;
|
||
; Haggles with remote server and returns when NETO channel
|
||
; (or NETD as case may be) is ready to send message text over.
|
||
; doesn't skip if error occurs.
|
||
;
|
||
; Returns .+1 if error:
|
||
; A - error code (see MR$ values)
|
||
; B - SLP to error message, or zero
|
||
; .+2 if success - NTMSND can now be used to send msg text.
|
||
|
||
NTMBEG: CAME N,NDHOST ; Ensure still connected.
|
||
JRST NTRDED
|
||
PUSHAE P,[C]
|
||
MOVE C,A ; Save ASCNT to rcpt name.
|
||
MOVE A,DEFTMO ; Get timeout arg
|
||
CALL NETRAP ; Set up error traps
|
||
JRST [ HLRZ B,A ; Get problem index.
|
||
CSTAT (,(" ...NTMBEG "),TZ$(NCETAB(B)))
|
||
JRST NTMBG9 ]
|
||
MOVE A,C ; Put back ASCNT to rcpt name
|
||
PROTCL C,PR$BEG
|
||
CALL (C) ; Do it
|
||
JRST [ MOVEM A,NTERRC ; If error, remember code.
|
||
CALL NERESET ; Flush trap frame.
|
||
MOVE A,NTERRC
|
||
JUMPGE A,NTMBGT ; Error, check it out.
|
||
MOVNS A ; Negative error is always soft/temporary
|
||
STAT (,("NTMBEG NET ERR="),D(A))
|
||
JRST NTMBG9 ]
|
||
;; Rcpt accepted, all set.
|
||
CALL NERESET ; Turn off error trapping.
|
||
SETZB A,B
|
||
PJRST POPCJ1 ; Win return skips.
|
||
|
||
;; Wrong error code, see if temporary or not.
|
||
NTMBGT: CALL NTECHK ; Classify error
|
||
JRST [ STAT (,("NTMBEG TEMP ERR="),LBRC,CALL(NTRSHO),RBRC)
|
||
JRST NTMBG9 ] ; Go claim temporary error.
|
||
JRST [ STAT (,("NTMBEG PERM ERR="),LBRC,CALL(NTRSHO),RBRC)
|
||
MOVEI A,MR$PER ; Claim permanent error for rcpt.
|
||
CALL RPLYER ; Set up error message
|
||
PJRST POPCJ ]
|
||
;; The error is not in our table, so we don't know which it is.
|
||
;; Assume it is temporary and blame it on the recipient's mailbox.
|
||
STAT (,("NTMBEG RCPT ERR="),LBRC,CALL(NTRSHO),RBRC)
|
||
MOVEI A,MR$TER ; Temp Err for Rcpt
|
||
SETZ B,
|
||
PJRST POPCJ
|
||
|
||
NTMBG9: MOVEI A,MR$TEH ; Note: IOC/timeouts also claim host temp err.
|
||
SETZ B,
|
||
PJRST POPCJ
|
||
|
||
;; Here to compose error receipt.
|
||
RPLYER: MAKELN B,[0 ; Net message failed, compose error string.
|
||
%LTSAO,,[[OUTCAL(,("Recipient name apparently rejected.
|
||
Last reply was: "),LBRC,CALL(NTRSHO),RBRC)]] ]
|
||
RET
|
||
|
||
SUBTTL Network Error Classification
|
||
|
||
; NTECHK - classify network error in A (smash B)
|
||
; Returns:
|
||
; .+1 - temporary
|
||
; .+2 - permanent
|
||
; .+3 - not known which
|
||
|
||
NTECHK: JUMPL A,APOPJ ; Negative means net error, always temporary.
|
||
PROTCL U1,PR$CHK
|
||
CALRET (U1)
|
||
|
||
; Table of reply codes that imply permanent error (sigh).
|
||
NTCTAB: -1 ; None at moment.
|
||
;454. ; NBS-10, WPAFB-AFWAL (these suckers use 454 for no such user!)
|
||
NTCTBL==<.-NTCTAB>
|
||
|
||
;;; Here to process SMTP reply codes.
|
||
NTERSM:
|
||
IFN $$450,{ ; Looks like plant food to me...
|
||
SKIPE SORMSW ; If this was an interactive send
|
||
JRST [ CAIN A,450. ; Check for "User not online".
|
||
JRST POPJ1 ; which is a permanent error.
|
||
JRST .+1 ] ; (That should work for SOML/SAML also.)
|
||
}
|
||
CAIL A,500. ; All 5xx are permanent
|
||
JRST POPJ1
|
||
CAIL A,400. ; and all 4xx are temporary
|
||
RET
|
||
AOS (P) ; If neither 4xx or 5xx, say dunno.
|
||
JRST POPJ1
|
||
|
||
;;; Here to process FTP reply codes.
|
||
NTERFT:
|
||
IFN $$450, CAIE B,450. ; No, FTP. Is it a 450?
|
||
CAIL B,500. ; Or a 5xx?
|
||
JRST POPJ1 ; Yes, lose.
|
||
MOVSI B,-NTCTBL
|
||
CAMN A,NTCTAB(B)
|
||
JRST POPJ1 ; Found one, so assume permanent.
|
||
AOBJN B,.-2
|
||
AOS (P)
|
||
JRST POPJ1
|
||
|
||
|
||
|
||
SUBTTL NTMSND - Dispatch to Text sending routines
|
||
|
||
; NTMSND - Takes ascnt ptr to message text in A and sends over net.
|
||
; Uses neto or NETD channel as necessary.
|
||
; Skips on success. Returns standard error code in A, msg in B
|
||
|
||
NTMSND: CAME N,NDHOST
|
||
JRST NTRDED
|
||
MOVE B,A ; Save arg
|
||
SETOM NTERRC ; Reset err val
|
||
MOVE A,DEFTMO ; Alert lifeguard to check every once in a while
|
||
CALL NETRAP
|
||
JRST [ SKIPL NTERRC ; If special IOC error (MLFL)
|
||
JRST NTMSN9 ; then already complained.
|
||
HLRZ B,A
|
||
CSTAT (,(" ...NTMSND "),TZ$(NCETAB(B)))
|
||
MOVEI A,MR$TEH
|
||
SETZ B,
|
||
RET ]
|
||
MOVE A,[SETZ NXFRLT] ; Use special RLT vector
|
||
MOVEM A,RLTVEC ; So we can check progress at interrupt level.
|
||
PROTCL A,PR$SND
|
||
CALL (A)
|
||
JRST NTMSN8 ; Error, reset frame and go lose.
|
||
CALL NERESET ; Win!
|
||
SETZB A,B
|
||
PJRST POPJ1
|
||
|
||
; Non-IOC/timeout SMTP data transfer error (only FINISH fail possible)
|
||
; All current error returns are known to provide valid MR$ codes in
|
||
; some manner.
|
||
NTMSN8: MOVE B,A
|
||
CALL NERESET ; IOC type error, flush err frame
|
||
SKIPA A,B
|
||
NTMSN9: MOVE A,NTERRC ; Entry pt for special IOC error
|
||
SETZ B,
|
||
RET
|
||
|
||
|
||
LVAR NXFRST: 0 ; Holds state of transfer
|
||
|
||
; Timeout interrupt for data xfer to net site.
|
||
; See if still active, or .IOT hung.
|
||
; This code runs at interrupt level!
|
||
NXFRLT: CAMN U3,NXFRST ; Check SIOT BP with last value
|
||
DISMISS [NXFRL5] ; Lose, no activity since last test!
|
||
MOVEM U3,NXFRST ; Tis different, xfer is active! Save value
|
||
DISMISS ; for next compare, and dismiss.
|
||
|
||
; Dispatch here from above handler if timeout on no activity.
|
||
NXFRL5: CLKOFF
|
||
STAT (,("Note: Net xfer lossage, no activity for 2 mins!"))
|
||
JRST NTRRLT ; Jump to regular RLT handler from here on.
|
||
|
||
SUBTTL NTMEND - Dispatch to message wrapup
|
||
|
||
; NTMEND - called when message transmission is finished, terminates
|
||
; message and gets back to normal ftp communication. may break
|
||
; data connection if exists, but doesn't close telnet connections.
|
||
; Non-skip return implies error, usually temporary.
|
||
; A - Error code (see MR$ values)
|
||
; B - 0 or error message
|
||
|
||
NTMEND: CAME N,NDHOST
|
||
JRST NTRDED
|
||
MOVE A,FINTMO ; Timeout arg
|
||
CALL NETRAP ; Setup to trap IOC and timeout.
|
||
JRST [ HLRZ B,A
|
||
STAT (,("INCOMPLETE, "),TZ$(NCETAB(B)))
|
||
JRST NTMEN9 ]
|
||
PROTCL A,PR$END
|
||
CALL (A) ; Invoke routine
|
||
JRST [ MOVEM A,NTERRC ; Failure, must examine reply code.
|
||
CALL NERESET
|
||
MOVE A,NTERRC
|
||
JRST NTMEN3] ; Failure, go examine reply code
|
||
CALL NERESET ; Winnage.
|
||
NTMEN6: SETZB A,B
|
||
PJRST POPJ1
|
||
|
||
;Wrong or no reply code after sending message
|
||
;If we get no reply, it's a temporary recipient error
|
||
;If we get a (wrong) reply between 200 and 299, complain but accept it
|
||
;If we get a 460 reply, it's a Chaosnet temporary error
|
||
;Don't trust 4xx replies on the Arpanet to be temporary
|
||
;If we get some other reply, take as permanent error since something is really fucked
|
||
NTMEN3: JUMPLE A,[
|
||
MOVNS A
|
||
STAT (,("INCOMPLETE, NET ERR="),D(A))
|
||
JRST NTMEN9]
|
||
STAT (,("NTMEND ERR="),D(A),(","),LBRC,CALL(NTRSHO),RBRC)
|
||
CAIL A,200.
|
||
CAILE A,299.
|
||
CAIA
|
||
JRST [CSTAT (,(" - but accepted."))
|
||
JRST NTMEN6]
|
||
CAIGE A,500. ; Permanent error?
|
||
JRST NTMEN9 ; No, temporary (4xx or less).
|
||
|
||
MOVEI A,MR$PER
|
||
MAKELN B,[0 ; Net message failed, compose error string.
|
||
%LTSAO,,[[OUTCAL(,("Funny reply from foreign host after sending message.
|
||
Last reply was: "),LBRC,CALL(NTRSHO),RBRC)]] ]
|
||
RET
|
||
|
||
NTMEN9: MOVEI A,MR$TER
|
||
SKIPG NTHOST ; Make sure net conns still alive
|
||
MOVEI A,MR$TEH ; Else a temp err for host.
|
||
SETZ B,
|
||
RET
|
||
|
||
|
||
SUBTTL Net input stuff (Read a reply)
|
||
|
||
BVAR
|
||
NTRCMX==:250. ; Max # chars in buffer
|
||
NTRBUF: BLOCK <NTRCMX+4>/5
|
||
0 ; Ensure fence if too-long reply truncated
|
||
NTRBOV: 0 ; -1 when buffer full (reply truncated).
|
||
NTRPT: 0 ; BP into NTRBUF
|
||
NTRCNT: 0 ; Cnt of chars in NTRBUF
|
||
REPLYC: 0 ; Holds # of last code received
|
||
NTRPKT: 0 ; -1 if datagram transaction stored reply here
|
||
EVAR
|
||
|
||
; NTRLGT - Get a FTP reply line.
|
||
; Skips unless ran out of input (net error).
|
||
; Over-long replies are simply truncated, without error.
|
||
|
||
NTRLGT: SKIPE NTRPKT ; Datagram transaction?
|
||
JRST NTRLG8 ; Yes, reply already in buffer.
|
||
SKIPA A,NTRCNT
|
||
NTRLG0: AOS A,NTRCNT
|
||
CAIL A,NTRCMX ; Make sure we still have room.
|
||
JRST NTRLG3 ; Nope, go to barfage section.
|
||
NTRLG1: CALL NTCHRI ; Get char
|
||
RET ; Whoops, net error!
|
||
CAIN A,^M ; Maybe end of reply line?
|
||
JRST NTRLG7 ; Go check.
|
||
IDPB A,NTRPT ; Deposit char in buffer.
|
||
JRST NTRLG0 ; Test for overflow and continue.
|
||
|
||
NTRLG3: SKIPE NTRBOV ; First-time overflow?
|
||
JRST NTRLG4 ; Nope, just output to stats.
|
||
SETOM NTRBOV ; First time, announce error.
|
||
STAT (,("Foo: NTRBUF Overflow: "),LBRC,CALL(NTRSHO),RBRC)
|
||
NTRLG4: CALL NTCHRI
|
||
RET ; Blug, net error.
|
||
CAIE A,^M ; Possible EOL?
|
||
JRST [ CSTAT (,C((A))) ; Just report to stats.
|
||
JRST NTRLG4]
|
||
NTRLG7: CALL NTCHRI ; Try next char
|
||
RET ; Sigh, lost.
|
||
CAIN A,^J ; LF follows?
|
||
NTRLG8: AOS (P) ; Won! Skip on return.
|
||
SETZM NTRPKT ; Datagram reply has been "used".
|
||
RET
|
||
|
||
|
||
; NTRPCD - Gobble a reply line and parse reply code.
|
||
; Given NTRPT, NTRCNT, NTRBOV.
|
||
; Returns .+1 if net error
|
||
; Returns .+2 otherwise:
|
||
; A - reply code (-1 if couldn't parse line)
|
||
; B - BP to rest of line after code, or 0 if no more (!).
|
||
|
||
NTRPCD: PUSHAE P,[C,D]
|
||
SKIPG A,NTRCNT ; See how many chars we've got.
|
||
JRST NTRPC2 ; Nothing, can skip CRLF addition.
|
||
CAIL A,NTRCMX-5 ; Need room for at least 5 more.
|
||
JRST [ SUBI A,6 ; If no room, make some!
|
||
MOVEM A,NTRCNT
|
||
MOVNI A,6
|
||
PTSKIP A,NTRPT
|
||
JRST .+1]
|
||
;; Some stuff is already in buffer, so append a CRLF first.
|
||
MOVEI B,^M ? IDPB B,NTRPT ? AOS NTRCNT
|
||
MOVEI B,^J ? IDPB B,NTRPT ? AOS NTRCNT
|
||
|
||
NTRPC2: MOVE B,NTRPT ; Save current ptr into buffer
|
||
MOVE C,NTRCNT ; and current cnt.
|
||
CALL NTRLGT ; Gobble a new line.
|
||
JRST NTRPC9 ; Net lossage.
|
||
MOVE D,NTRCNT ; OK, now get new count
|
||
SUBI D,(C) ; to see how many chars we read.
|
||
CAIGE D,3 ; Must be at least 3...
|
||
JRST NTRPC8 ; Fooey, say parsing error.
|
||
|
||
HRLI D,-3 ; 3 digits
|
||
SETZ A, ; Value goes here
|
||
NTRPC5: ILDB C,B
|
||
CAIL C,"0 ; Is it a digit?
|
||
CAILE C,"9
|
||
JRST NTRPC8 ; Nope, say parsing error.
|
||
IMULI A,10. ; Yes, power up A
|
||
ADDI A,-"0(C) ; and add in value of digit.
|
||
AOBJN D,NTRPC5 ; Get next
|
||
CAIG D,6. ; Skip if more chars on line.
|
||
SETZ B, ; No more, zap B to indicate this.
|
||
CAIA
|
||
NTRPC8: SETO A, ; Say parsing error.
|
||
AOS -2(P) ; Skip on return
|
||
NTRPC9: POPAE P,[D,C]
|
||
RET
|
||
|
||
|
||
; "NTRPLY"-- inputs one server reply into a
|
||
; buffer for inspection. Returns code in A and REPLYC.
|
||
|
||
NTRPLY: PUSH P,B
|
||
SETOM REPLYC
|
||
|
||
NTRPL1: MOVE A,[440700,,NTRBUF]
|
||
MOVEM A,NTRPT ; Initialize ptr
|
||
SETZM NTRCNT ; Zero char cnt
|
||
SETZM NTRBOV ; and overflow flag.
|
||
|
||
NTRPL2: CALL NTRPCD ; Get line and code.
|
||
JRST POPBJ ; Net error.
|
||
JUMPL A,[CSTAT (,LBRK,("NTRPLY: Bad reply syntax="),LBRC,CALL(NTRSHO),RBRC,RBRK)
|
||
JRST NTRPL1 ]
|
||
MOVEM A,REPLYC ; Save returned code
|
||
JUMPE B,NTRPL3 ; If nothing more, no continuation.
|
||
ILDB A,B ; Get char after code
|
||
CAIN A,"- ; Continuation mark?
|
||
JRST NTRPL2 ; Yes, bletch, get another line.
|
||
|
||
; I suppose there should be some code around here that checks
|
||
; to be sure that multi-line replies all have the same reply
|
||
; code, but it hardly seems to matter. If you care, change
|
||
; the preceeding two lines to JRST NTRPL3 if not continuation,
|
||
; and put the silly check/report here.
|
||
|
||
NTRPL3: MOVE A,REPLYC
|
||
CAILE A,599. ; Highest poss. code
|
||
JRST [ MOVN A,A ; Make neg. if too large
|
||
MOVEM A,REPLYC ; (fuck you and your 951's, BBN!!)
|
||
JRST .+1]
|
||
SKIPE NTRBOV ; Was reply truncated?
|
||
JRST [ CSTAT (,RBRC) ; Yes, terminate stats report.
|
||
JRST .+1]
|
||
POP P,B ; All done!
|
||
AOS (P)
|
||
RET
|
||
|
||
|
||
; NTSOCK - assumes reply in ftrbuf is a 255 sock nnnn and proceeds
|
||
; to convert decimal argument into socket number in a.
|
||
|
||
NTSOCK: PUSHAE P,[B,C,D]
|
||
MOVE D,NTRCNT
|
||
SUBI D,9. ; Allow for the "255 SOCK " (9 chars)
|
||
JUMPLE D,NTSCK9 ; Maybe reply not long enough?
|
||
MOVE B,[100700,,NTRBUF+1] ; BP to 10th char in buf.
|
||
SETZ A, ; Used for arg accumulation
|
||
NTSCK1: ILDB C,B ; Flush leading blanks.
|
||
CAIE C,40
|
||
JRST NTSCK3
|
||
SOJG D,NTSCK1
|
||
JRST NTSCK9
|
||
|
||
NTSCK2: ILDB C,B ; Get char
|
||
NTSCK3: CAIL C,"0
|
||
CAILE C,"9
|
||
JRST NTSCK8 ; Not a digit, stop parsing.
|
||
IMULI A,10. ; Power up #
|
||
ADDI A,-"0(C) ; Cvt and add digit
|
||
SOJG D,NTSCK2 ; Continue til count out.
|
||
NTSCK8: AOS -3(P)
|
||
NTSCK9: POPAE P,[D,C,B]
|
||
RET
|
||
|
||
|
||
; NTR2XX and NTR3XX - search for 2xx and 3xx codes respectively,
|
||
; flushing any 0xx or 1xx codes. Returns code in A
|
||
; whether fails or succeeds.
|
||
; Returns .+1 if code not in range or error.
|
||
; Returned "code" will be zero if failure due to error.
|
||
; Returns .+2 if code in range
|
||
|
||
NTR2XX: CALL NTRPLY ; Get net reply
|
||
JRST NTRPZ ; Net lossage.
|
||
CAIGE A,200. ; If an 0xx or 1xx code,
|
||
JRST NTR2XX ; flush and get another.
|
||
CAIGE A,300. ; If outside 2xx range, fail.
|
||
AOS (P)
|
||
RET
|
||
|
||
NTRPZ: SETZ A, ; Return zero "code".
|
||
RET
|
||
|
||
NTR3XX: CALL NTRPLY ; Get net reply
|
||
JRST NTRPZ
|
||
CAIGE A,300.
|
||
JRST NTR3XX
|
||
CAIGE A,400.
|
||
AOS (P)
|
||
RET
|
||
|
||
; NTRNXX - Given reply code in A to look for. Skips if found,
|
||
; else no skip.
|
||
; Ignores all 0xx and 1xx messages; ditto 6-9xx.
|
||
; Returns code in A whether succeed or fail.
|
||
|
||
NTRNXX: PUSH P,A
|
||
NTRNX0: CALL NTRPLY ; Get a reply.
|
||
JRST [ POP P,A ? JRST NTRPZ] ; error, return zero.
|
||
CAMN A,(P) ; Is it what we want?
|
||
JRST POPAJ1 ; Yep, win.
|
||
CAIGE A,200. ; Is code one of 3xx, 4xx or 5xx?
|
||
JRST NTRNX0 ; Nope, get another reply.
|
||
SUB P,[1,,1] ; Ugh, failed.
|
||
RET
|
||
|
||
; NTCHRI - returns one 7-bit ascii char in acc. A.
|
||
; If it sees any 8-bit telnet control chars, will flush them
|
||
; and wait for a 7-bit char. Hence will not win with new
|
||
; protocol, if foreign site sends anything spontaneously!
|
||
|
||
NTCHRI: .IOT NETI,A
|
||
JUMPGE A,NTCHI2 ; If get -1,,3 then assume input channel has closed,
|
||
SKIPN NTIOCV ; and simulate network IOC error
|
||
JSR AUTPSY ; with check to prevent blind hyperspace jump.
|
||
JRST @NTIOCV
|
||
NTCHI2: CAIL A,200
|
||
JRST NTCHRI ; Discard any 8-bit codes
|
||
AOS (P)
|
||
MOVE U1,NTTYPE
|
||
CAIE U1,NT$CSM
|
||
CAIN U1,NT$ISM
|
||
OUTCAL (NETD,C((A))) ; If SMTP, record char for transaction.
|
||
RET
|
||
|
||
; NTRSHO - Output current reply to std output
|
||
|
||
NTRSHO: OUT(,S(NTRCNT,[440700,,NTRBUF]))
|
||
RET
|
||
|
||
|
||
|
||
|
||
SUBTTL Network Time
|
||
|
||
NTMSOC: 45 ; Standard Binary "Time-server" socket
|
||
|
||
; NETIM - Hack to pluck 32-bit Network-time word from IP-TCP site
|
||
; specified by A. Returns value in A and skips,
|
||
; doesn't skip if couldn't get.
|
||
|
||
NETIM: PUSHAE P,[B,C]
|
||
SYSCAL TCPOPN,[CIMM NETI ? CIMM NETO ? [-1] ? NTMSOC ? A ? CERR A]
|
||
JRST NETIM9
|
||
MOVEI A,NETO
|
||
NETHANG 900.,A,%NSRFS,[%NSOPN,%NSRFN]
|
||
JRST NETIM9
|
||
SETZ A,
|
||
MOVE B,[401000,,A] ; Read in 32 bit word here.
|
||
MOVEI C,4. ; 8-bit bytes at a time.
|
||
SYSCAL SIOT,[MOVEI NETI ? B ? C]
|
||
.LOSE %LSFIL
|
||
AOS -2(P)
|
||
NETIM9: .CLOSE NETD,
|
||
POPAE P,[C,B]
|
||
RET
|
||
|
||
|
||
SUBTTL Host Database routines (Name/Address lookup, etc.)
|
||
|
||
IFE $$DQ,{
|
||
|
||
; HANLYZ - Server-oriented host-name search.
|
||
; A/ # chars
|
||
; B/ Bp to name
|
||
;
|
||
; Skip returns in A: host address
|
||
; If non-skip, A: -1 ==> host not found, whether server or anything else.
|
||
; ptr,,ptr ==> ambiguous server sites, 2 absolute ptrs to
|
||
; NAME table entroes are turned as examples.
|
||
|
||
HANLYZ: PUSHAE P,[B,C,D,E]
|
||
MOVEM B,NPTSAV' ;Save ptr to name
|
||
MOVEM A,NPTSVC' ; and save cnt.
|
||
HANL20: SETZM HFSAV1' ;Clear the regs used to store
|
||
SETZM HFSAV2' ;matches in.
|
||
SETZM HNSSAV' ;(This one is non-server slot).
|
||
SKIPN D,RESOLV"HSTADR
|
||
JSR AUTPSY
|
||
ADD D,RESOLV"NAMPTR(D) ;Address NAMES table of 1wd entries.
|
||
MOVN E,0(D) ;Get number of entries.
|
||
HRLZS E ;Make aobjn pointer.
|
||
HRRI E,2(D)
|
||
HANLZ1: HRRZ D,RESOLV"NMRNAM(E) ;Points to ASCIZ name.
|
||
ADD D,RESOLV"HSTADR
|
||
HRLI D,440700
|
||
MOVE C,NPTSAV
|
||
MOVE A,NPTSVC ;Get cnt.
|
||
MOVEM A,NPTCNT'
|
||
HANL11: ILDB B,D
|
||
SOSGE NPTCNT ;Decr char cnt.
|
||
TDCA A,A ;Clear A and skip if none left.
|
||
ILDB A,C
|
||
JUMPE B,[JUMPN A,HANLZ4 ;If our string longer, no match.
|
||
MOVEI A,(E) ;Both counted out, perfect match!
|
||
JRST HANLZ7 ] ;use this entry and go win.
|
||
JUMPE A,HANLZ2 ;Partial match if our string counts out first.
|
||
CAMN A,B
|
||
JRST HANL11
|
||
CAIL A,"a ;If chars don't match, try converting
|
||
CAILE A,"z ;input string to uppercase.
|
||
JRST HANLZ4 ;Twas uppercase already.
|
||
SUBI A,40
|
||
CAMN A,B
|
||
JRST HANL11
|
||
HANLZ4: AOBJN E,HANLZ1
|
||
;; All searching done, no perfect matches, see if partial matches.
|
||
SKIPE HFSAV2 ;Was an ambiguous server host found?
|
||
JRST [ HRLZ A,HFSAV1 ;Ambiguous; two or more found.
|
||
HRR A,HFSAV2 ;First in LH, second in RH.
|
||
JRST HANLZ9] ;Loss return.
|
||
SKIPE A,HFSAV1 ;Was unambiguous server host found?
|
||
JRST HANLZ7 ; Yes, only one partial match, win
|
||
SKIPN A,HNSSAV ;Was a non-server site found? (load with value)
|
||
JRST HANLZ8 ; Nope, go to loss return.
|
||
HANLZ7: HLRZ E,(A) ;Get adr of SITE entry.
|
||
ADD E,RESOLV"HSTADR
|
||
HRRZ B,RESOLV"STRADR(E) ;Get file addr of ADDRESS table entry.
|
||
;; Now decide which of the possible addresses to use.
|
||
;; priority is CHAOSnet, ARPAnet, random net.
|
||
SETOB A,C
|
||
HANLC2: ADD B,RESOLV"HSTADR ;Make abs ptr
|
||
MOVE D,RESOLV"ADDADR(B) ;Get net address of this entry
|
||
CAME D,OWNHST
|
||
CAMN D,OWNHS2 ;If this is our own host address
|
||
JRST [ MOVE A,OWNHST ; OWNHST is best possible address!
|
||
JRST HANL78 ]
|
||
RESOLV"GETNET D ;Else get net number it's on.
|
||
MOVEI E,4 ;Search for favorite networks.
|
||
CAME D,(E)[ RESOLV"NW%ARP ;Priority in reverse order.
|
||
RESOLV"NW%LCS
|
||
RESOLV"NW%AI
|
||
RESOLV"NW%CHS]-1 ;Chaos preferred over Internet.
|
||
SOJG E,.-1
|
||
CAIL C,(E)
|
||
JRST HANLC3
|
||
MOVE A,RESOLV"ADDADR(B) ;Aha, save address
|
||
MOVEI C,(E) ;and its priority
|
||
HANLC3: HRRZ B,RESOLV"ADRCDR(B) ;Check out more net addrs if any
|
||
JUMPN B,HANLC2 ;Yep, check next one.
|
||
JUMPG C,HANL78 ;If found a known winner, jump!
|
||
TLNN A,(RESOLV"NE%UNT) ;Else examine more closely...
|
||
JRST HANL78 ; Is Internet addr, shd be OK.
|
||
JRST HANL72 ;Ugh, non-Internet (and not CHAOS), so lose.
|
||
|
||
HANL72: MOVNI A,2
|
||
JRST HANLZ9 ;Nope, not right place after all, lose.
|
||
|
||
HANL78: AOSA -4(P) ;Come here for winning return
|
||
HANLZ8: SETO A,
|
||
HANLZ9: POPAE P,[E,D,C,B]
|
||
RET ;Failure return
|
||
|
||
;; Here when partial match found
|
||
HANLZ2: SKIPN HFSAV1 ;Skip if already have one partial match.
|
||
JRST [ HRRZM E,HFSAV1 ;Save table index to first partial match
|
||
HLRZ A,(E) ;Get file addr of SITE entry
|
||
ADD A,RESOLV"HSTADR
|
||
MOVE A,RESOLV"STLFLG(A) ;Get flags
|
||
TLNE A,RESOLV"STFSRV ;Skip if not server
|
||
JRST HANLZ4 ;Continue, to check for ambiguities
|
||
HRRZM E,HNSSAV ;Non-server, store entry # here.
|
||
SETZM HFSAV1 ;Rectify wrong assumption
|
||
JRST HANLZ4] ;and continue.
|
||
;; Not first partial match, save if server, ignore if not.
|
||
HLRZ A,(E) ;Get file addr of SITE entry
|
||
ADD A,RESOLV"HSTADR
|
||
MOVE A,RESOLV"STLFLG(A) ;Get flags
|
||
TLNN A,RESOLV"STFSRV ;Skip if server
|
||
JRST HANLZ4 ;Ignore if non-server
|
||
MOVEI B,(E)
|
||
CAMN B,HFSAV1 ;Test against entry of previously matched name
|
||
JRST HANLZ4 ;Ignore if already found same host.
|
||
CAMN B,HFSAV2 ;Same as first found?
|
||
JRST HANLZ4 ; No, ignore if this host already listed.
|
||
MOVEM B,HFSAV2' ;Different from both - "second-found" host.
|
||
JRST HANLZ4 ;Continue looking (may find exact match).
|
||
|
||
};IFE $$DQ
|
||
|
||
IFN $$DQ,{
|
||
|
||
; HANLYZ - Host Lookup
|
||
; A/ # chars
|
||
; B/ Bp to name
|
||
;
|
||
; Skip returns in A: host address
|
||
; If non-skip, A: -1 ==> host not found
|
||
; maybe someday other codes
|
||
;
|
||
; Uses the RESOLV library to query the DQ device for host address information.
|
||
; Asks for an address in the CH class; if none, asks for class IN.
|
||
|
||
HANLYZ: PUSHAE P,[B,C,D]
|
||
MOVE C,[440700,,DQBUF] ; Copy string (have to ASCIZify)
|
||
ILDB D,B
|
||
IDPB D,C ; Copy all bytes
|
||
SOJG A,.-2
|
||
IDPB A,C ; Null at end
|
||
MOVE A,[440700,,DQBUF] ; Point at ASCIZified string
|
||
CALL RESOLV"HSTADR ; Resolve string to HOSTS3 type address
|
||
SKIPA A,[-1] ; Lost, foo
|
||
AOS -3(P) ; Won, skip return
|
||
HANL99: POPAE P,[D,C,B]
|
||
RET
|
||
|
||
};$$DQ
|
||
|
||
SUBTTL NCP/FTP Routines - NNFICP
|
||
|
||
IFN $$FTP,[
|
||
|
||
NETDEV: SIXBIT /NET/
|
||
ICPSOC: 3 ; Standard FTP server socket
|
||
BVAR
|
||
NRLSOC: 0 ; Local Receive socket (U+2)
|
||
NSLSOC: 0 ; Local Send (U+3)
|
||
NDLSOC: 0 ; Local Data output skt (always output so always U+5)
|
||
NRFSOC: 0 ; Foreign Receive skt (S)
|
||
NSFSOC: 0 ; Foreign Send (S+1)
|
||
NDFSOC: 0 ; Foreign Data skt (always input, so defaults to S+2)
|
||
EVAR
|
||
|
||
|
||
|
||
; NNFICP - Make initial connection to server FTP
|
||
; Called by NETICP.
|
||
|
||
NNFICP: SYSCAL OPEN,[[40050+.UII,,NETD] ? NETDEV ? CIMM -1 ? ICPSOC ? NTHOST
|
||
CERR A]
|
||
JRST [HRLI A,NCE$SY ? RET]
|
||
MOVEI A,NETD ; Arg to NETHANG
|
||
NETHANG 900.,A,%NSRFS,[%NSOPN,%NSCLI,%NSINP] ; Wait til conn. opened or timeout
|
||
JRST [MOVNS A ? HRLI A,NCE$CS ? RET]
|
||
SYSCAL RCHST,[CIMM NETD ? CRET JUNK ? CRET A]
|
||
JSR AUTPSY ; Get generated local socket #
|
||
ADDI A,2 ; Get # for local receive
|
||
MOVEM A,NRLSOC
|
||
ADDI A,1 ; Get # for local transmit
|
||
MOVEM A,NSLSOC
|
||
ADDI A,2 ; Get U+5 as local output data socket for MLFL
|
||
MOVEM A,NDLSOC
|
||
MOVEI A,NETD
|
||
NETHANG 900.,A,%NSOPN,[%NSCLI,%NSINP] ; Wait til input avail
|
||
JRST [ MOVNS A
|
||
HRLI A,NCE$CS ? RET]
|
||
.IOT NETD,A ; Get foreign receive socket
|
||
MOVEM A,NRFSOC
|
||
ADDI A,1 ; Get # for foreign transmit
|
||
MOVEM A,NSFSOC
|
||
; Open Net output and input channels
|
||
SYSCAL OPEN,[[.UAO,,NETO] ? NETDEV ? NSLSOC ? NRFSOC ? NTHOST ? CERR A]
|
||
JRST [HRLI A,NCE$SY ? RET]
|
||
SYSCAL OPEN,[[40+.UAI,,NETI] ? NETDEV ? NRLSOC ? NSFSOC ? NTHOST ? CERR A]
|
||
JRST [HRLI A,NCE$SY ? RET]
|
||
; Wait til completely open
|
||
MOVEI A,NETO
|
||
NETHANG 900.,A,%NSRFS,[%NSOPN]
|
||
JRST [MOVNS A ? HRLI A,NCE$CS ? RET]
|
||
MOVEI A,NETI
|
||
NETHANG 900.,A,%NSRFS,[%NSOPN,%NSCLI,%NSINP]
|
||
JRST [MOVNS A ? HRLI A,NCE$CS ? RET]
|
||
.CLOSE NETD,
|
||
CLKOFF ; ICP completed, start another frame
|
||
CLKSET [60.*60.] ; for initial FTP negotiation
|
||
CLKON
|
||
OUT(NETO,OPEN(UC$IOT)) ; Open net output for UUO handling.
|
||
MOVEI A,300.
|
||
CALL NTRNXX ; Get the 300 initial reply
|
||
JRST [ HRLI A,NCE$GR ; Error or code not 300.
|
||
RET]
|
||
; Check for being faked-out by a loop-back plug
|
||
FWRITE NETO,[[XLBT ],HND,NTHOST,[
|
||
]]
|
||
.NETS NETO,
|
||
CALL NTR2XX
|
||
JUMPLE A,[ HRLI A,NCE$HR ; Fail if net error or weird code.
|
||
RET]
|
||
CAIN A,529. ; If this specific error # is returned,
|
||
JRST [ HRLI A,NCE$HR ; loop-back plug must be present.
|
||
RET]
|
||
;; Now log in if this is a Multics
|
||
;; It doesn't really log in, it just bludgeons its way past the answering
|
||
;; service into more maintainable code.
|
||
MOVE A,NTHOST
|
||
CALL NHMLTX ; Host = multics?
|
||
JRST POPJ1 ; No, thank goodness.
|
||
CALL NTMLTX ; Ick, do special hack (acct and passw)
|
||
JRST [HRLI A,NCE$HR ? RET] ; Lost, consider it temporary soft err
|
||
JRST POPJ1
|
||
|
||
|
||
; NTDLIS - Start listening on data connection
|
||
|
||
NTDLIS: SYSCAL OPEN,[[60+.UAO,,NETD] ; Open for listen
|
||
NETDEV ? NDLSOC ? NDFSOC ? NTHOST]
|
||
CAIA
|
||
AOS (P)
|
||
RET
|
||
|
||
; NTDCON - Complete data connection given foreign socket # in A
|
||
|
||
NTDCON: PUSHAE P,[A,B]
|
||
MOVEM A,NDFSOC ; Store forn socket
|
||
MOVEI B,NETD
|
||
NETHANG 900.,B,%NSLSN,[%NSRFC] ; Hang til RFC received
|
||
JRST POPBAJ ; Never came or something
|
||
.NETAC NETD, ; Accept it
|
||
JRST POPBAJ
|
||
MOVEI B,NETD
|
||
NETHANG 900.,B,%NSRFC,[%NSOPN] ; Wait til fully open
|
||
JRST POPBAJ
|
||
SYSCAL RCHST,[CIMM NETD ? CRET JUNK ? CRET JUNK ? CRET B]
|
||
JSR AUTPSY ; Find foreign socket #
|
||
CAMN A,B ; Socket same as 255 specified?
|
||
JRST POPBA1 ; Yes, take winning return.
|
||
.CLOSE NETD, ; No, lose. arg was bad, or someone else connected to us.
|
||
STAT (,(" ="),RABR,(" Foo! Data connection mismatched!"))
|
||
JRST POPBAJ
|
||
|
||
|
||
];$$FTP
|
||
|
||
|
||
SUBTTL NCP/FTP routines - NNFRCP, NNFBEG, NNFSND, NNFEND
|
||
|
||
IFN $$FTP,[
|
||
|
||
LVAR NT%FIL: 0 ; 0 = sending msg over telnet conns,
|
||
; -1 = over data conn (MLFL)
|
||
|
||
; NNFRCP - NCP/FTP routine to submit rcpt string to host
|
||
; B/ ASCNT to rcpt name
|
||
|
||
NNFRCP: OUT(NETO,("XRCP "),TC(B))
|
||
SKIPE NTRTSW ; Doing routing thru gateway?
|
||
OUTCAL(NETO,("@"),HST(NDHOST)) ; Yes, specify real dest.
|
||
NTXRC3: OUT(NETO,EOL)
|
||
.NETS NETO,
|
||
CALL NTR2XX ; Any 2xx reply is okay.
|
||
RET ; Sigh... must puzzle out.
|
||
JRST POPJ1
|
||
|
||
|
||
; NNFBEG - NCP/FTP message setup routine, called by NTMBEG.
|
||
; A/ ASCNT of rcpt name
|
||
; B/ cmd to use
|
||
|
||
; Now find what command to use for sending mail. B neg means MLFL.
|
||
; B zero means MAIL. B pos means figure out Sending command.
|
||
|
||
NNFBEG: MOVE C,A
|
||
JUMPL B,[SETOM NT%FIL ; Indicate MLFL
|
||
MOVE B,[ASCNT [MLFL]]
|
||
CSTAT (,(" (MLFL)"))
|
||
JRST NNFBG2]
|
||
NNFBG0: SETZM NT%FIL ; Indicate non-mlfl
|
||
SKIPG B
|
||
JRST [ MOVE B,[ASCNT [MAIL]] ; Zero gets default of "mail"
|
||
JRST NNFBG2 ]
|
||
SKIPLE SENDSW ; Positive means puzzle out Sending.
|
||
MOVE B,[ASCNT [XMAS]]
|
||
SKIPGE SENDSW
|
||
MOVE B,[ASCNT [XSEN]]
|
||
SKIPN SENDSW
|
||
MOVE B,[ASCNT [XSEM]]
|
||
; Send out appropriate command.
|
||
NNFBG2: OUT(NETO,TC(B)) ; Out with the command...
|
||
JUMPE C,NNFBG3
|
||
OUT(NETO,(" "),TC(C))
|
||
SKIPE NTRTSW ; Doing routing thru gateway?
|
||
OUTCAL(NETO,("@"),HST(NDHOST)) ; Yes, specify real dest.
|
||
NNFBG3: OUT(NETO,EOL)
|
||
.NETS NETO,
|
||
SKIPGE NT%FIL ; Now look for reply as per type
|
||
JRST NNFBG4 ; Look for MLFL reply
|
||
|
||
CALL NTR3XX ; Look for 3xx, ignore 0xx, 1xx, 2xx.
|
||
RET ; If error, return to check it out.
|
||
CAIN A,350. ; Is code right one right off?
|
||
JRST POPJ1 ; Yep, win instantly.
|
||
RET ; No, should check further.
|
||
|
||
; Hack MLFL reply and data conn setup.
|
||
NNFBG4: CALL NTDLIS ; Open data conn in listen mode NOW, to avoid
|
||
JRST [ MOVEI A,-24. ; synch problems with some cretinous systems.
|
||
RET ] ; Return temp error.
|
||
MOVEI A,255. ; Look for SOCK reply...
|
||
CALL NTRNXX ; and ignore 0xx, 1xx etc.
|
||
JRST [ CAIE A,504. ; Code not 2xx, maybe fail hard.
|
||
RET ; or maybe soft
|
||
MOVEI B,0 ; Cretinous TOPS-10
|
||
CSTAT (,(" (Rejected, trying MAIL)"))
|
||
JRST NNFBG0 ]
|
||
CALL NTSOCK ; Convert 255's arg into socket # in A
|
||
JRST [ MOVEI A,-25. ; Blah, bad argument, soft error.
|
||
RET ]
|
||
CALL NTDCON ; Complete data connection to socket # in A.
|
||
JRST NNFBG5 ; Couldn't, do something
|
||
MOVEI A,250. ; Now wait for 250 go-ahead...
|
||
CALL NTRNXX ; ignoring 0xx etc.
|
||
RET ; Funny reply, check for fail hard (CMU sends its
|
||
; user name reject here instead of in first reply)
|
||
OUT(NETD,OPEN(UC$IOT)) ; All won, set up UUO chan for output!
|
||
JRST POPJ1
|
||
|
||
; Here if MLFL data connection not established
|
||
; Normally a temporary error, but see if there is an
|
||
; accompanying FTP reply
|
||
NNFBG5: CALL MLFLRP ;Get reply if any
|
||
SETO A, ;None, net error.
|
||
RET ;Decide whether permanent or temporary
|
||
|
||
MLFLRP: .CALL [SETZ ? 'WHYINT ? MOVEI NETI ? MOVEM A ? MOVEM A ? SETZM A]
|
||
MOVEI A,0
|
||
JUMPE A,APOPJ ;No input available
|
||
CALL NTRPLY ;Input available, read it
|
||
RET ;Net error
|
||
CAIL A,400.
|
||
JRST POPJ1 ;Valid error code
|
||
STAT (,(" ="),RABR,(" Funny FTP reply after MLFL data connection failure:"))
|
||
STAT (,(" ="),RABR,(" "),LBRC,CALL(NTRSHO),RBRC)
|
||
JRST MLFLRP ;Look for more reply
|
||
|
||
|
||
NNFSND: SKIPE NT%FIL ; Skip unless MLFL'ing
|
||
JRST NNFSN2
|
||
FWRITE NETO,[TC,B]
|
||
.NETS NETO,
|
||
JRST POPJ1
|
||
|
||
;MLFL - TOPS-10's give us a hard time by opening the data connection,
|
||
;then immediately closing it and sending an FTP reply code saying the
|
||
;recipient was illegal. So if we get an IOC error, check for that.
|
||
NNFSN2: MOVEI A,NTMSF1
|
||
MOVEM A,NTIOCV
|
||
FWRITE NETD,[TC,B]
|
||
.NETS NETD,
|
||
JRST POPJ1
|
||
|
||
NTMSF1: MOVEI A,NTRIOC ;If another IOC error occurs, trap out
|
||
MOVEM A,NTIOCV
|
||
CSTAT (,(" IOC error in NNFSND"))
|
||
CALL MLFLRP ;Look for reply code
|
||
JRST NTRIOC ;None, treat normally
|
||
STAT (,("MLFL reply="),LBRC,CALL(NTRSHO),RBRC)
|
||
CALL NTECHK ;Classify error
|
||
JRST [ MOVEI A,MR$TER
|
||
JRST NTMSF2 ]
|
||
MOVEI A,MR$PER
|
||
MOVEI A,MR$PER
|
||
NTMSF2: MOVEM A,NTERRC
|
||
JRST NTRIOC ; Take normal exit
|
||
|
||
|
||
; NNFEND - NCP/FTP message transmission termination check.
|
||
; Returns
|
||
; .+1 if failed, reply code in A (negative if net error)
|
||
; .+2 if message sent successfully.
|
||
|
||
NNFEND: SKIPE NT%FIL ; Now terminate message according to type.
|
||
JRST [ .CLOSE NETD, ; for MLFL just close data connection to end.
|
||
JRST NNFEN2]
|
||
OUT(NETO,("
|
||
.
|
||
"))
|
||
.NETS NETO,
|
||
|
||
NNFEN2: CALL NTR2XX ; Look for 256 or 252 or something like that
|
||
RET ; Failed
|
||
SKIPE NT%FIL ; Check out type carefully
|
||
JRST [ CAIE A,252. ; If MLFL, look for 252. or 256.
|
||
CAIN A,256. ; aren't standards wonderful?
|
||
JRST POPJ1 ; Win.
|
||
JRST .+1] ; Hmm, accept but state suspicions.
|
||
CAIN A,256. ; 256. is "correct" reply for mail.
|
||
JRST POPJ1 ; Win
|
||
RET
|
||
|
||
];$$FTP
|
||
|
||
SUBTTL TCP/SMTP routines - NSMICP, NSMINI
|
||
|
||
NSMSOC: 31 ; Port number to use for TCP SMTP connections.
|
||
|
||
; NSMICP - Establish TCP connections with SMTP server
|
||
; NTHOST/ host addr to connect to
|
||
; Returns .+1 if failed, with A/ error #.
|
||
; Returns .+2 if wins.
|
||
|
||
NSMICP: SYSCAL TCPOPN,[ CIMM NETI ? CIMM NETO
|
||
[-1] ? NSMSOC ? NTHOST
|
||
CERR A]
|
||
JRST [ HRLI A,NCE$SY ; If fail, return syscal error # in RH(A)
|
||
RET]
|
||
;; Wait until TCP connection open.
|
||
;; Note that timeout of the NETBLK is unlikely since specified time
|
||
;; is larger than default global timeout ICPTMO.
|
||
;; [ Actually, this comment was false on 5/15/88 since ICPTMO had
|
||
;; been adjusted upwards far enough that the NETBLK sometimes timed
|
||
;; out. This resulted in a confusing message in the STATS file
|
||
;; complaining that %NSRFS was a "bad state"! I have just set the
|
||
;; timeout here to 5 minutes. Lets hope that ICPTMO never gets
|
||
;; -that- large! -Alan ]
|
||
MOVEI A,NETO
|
||
NETHANG 5*60.*30.,A,%NSRFS,[%NSOPN,%NSRFN]
|
||
JRST [ MOVNS A ; Negate final bad state
|
||
HRLI A,NCE$CS ; Bad State
|
||
TRNN A,-1 ; If state is closed (zero),
|
||
HRLI A,NCE$NO ; assume site is refusing.
|
||
RET ]
|
||
|
||
NXSICP: ; Entry point from Chaos/SMTP code
|
||
|
||
;; Open SMTP transaction script area on channel NETD
|
||
UAROPN [%ARTCH+%ARTZM,,NSMSAR ? [100]]
|
||
OUT(NETD,OPEN(UC$UAR,NSMSAR))
|
||
CALL NTR2XX ; Get initial greeting
|
||
JRST [ MOVNS A
|
||
JUMPE A,NSMICL
|
||
HRLI A,NCE$GR ; Bad greeting?
|
||
RET ]
|
||
OUT(NETO,OPEN(UC$BUF,,,[8.])) ; Set up buffered 8-bit chan
|
||
OUT(NETO,("HELO "),TZ(OWNNAM),EOL,FRC)
|
||
.NETS NETO,
|
||
OUT(NETD,("HELO "),TZ(OWNNAM),EOL) ; Record SMTP transaction
|
||
CALL NTR2XX ; Just flush the response...
|
||
CAIA
|
||
JRST POPJ1
|
||
MOVNS A
|
||
SKIPE A
|
||
JRST [ HRLI A,NCE$HR
|
||
RET ]
|
||
NSMICL: HRLI A,NCE$IO ;Here if unexplained net I/O lossage.
|
||
RET ;Do not skip if error.
|
||
|
||
|
||
; I think there is a bug which makes a Bad Greeting (code 0) error
|
||
; be returned before NTRPLY has been called. This looks like this:
|
||
;
|
||
; o A conn is made and an NCE$GR happens and is correctly processed.
|
||
; o A subsequent conn attempy to another host fails completely and
|
||
; the NTRBUF/NTRCNT string is still full.
|
||
; o An NCE$GR error is processed, using the old string.
|
||
;
|
||
;
|
||
; -- CSTACY 6:26pm Saturday, 12 October 1985
|
||
|
||
|
||
; NSMINI - Set up for a SMTP Mail or Send.
|
||
; Non-skip return if fails, with bad reply code in A.
|
||
|
||
NSMINI: CALL NSMDOP ; Get delivery option
|
||
OUT(NETO,TC(A),(" FROM:"),LABR,CALL(NSMRTP),RABR,EOL,FRC)
|
||
.NETS NETO,
|
||
; Record the SMTP transaction.
|
||
OUT(NETD,TC(A),(" FROM:"),LABR,CALL(NSMRTP),RABR,EOL)
|
||
CALL NTR2XX ; Get reply code.
|
||
CAIA
|
||
JRST POPJ1 ; Success!
|
||
CAIGE A,500. ; Bad syntax or something?
|
||
RET ; No, assume temp err.
|
||
CSTAT (,(|...error for |),LABR,CALL(NSMRTP),RABR,(|="|),CALL(NTRSHO),(|", trying <>.|),FRC)
|
||
OUT(NETO,("RSET"),EOL,FRC)
|
||
.NETS NETO, ; Some sites apparently want to reset
|
||
CALL NTR2XX ; Should always win.
|
||
NOP ; Eh?
|
||
CALL NSMDOP ; Get delivery option again
|
||
OUT(NETO,TC(A),(" FROM:<>"),EOL,FRC) ; This path is always valid.
|
||
.NETS NETO,
|
||
OUT(NETD,TC(A),(" FROM:<>"),EOL) ; Record SMTP transaction
|
||
CALL NTR2XX
|
||
RET
|
||
JRST POPJ1
|
||
|
||
|
||
; NSMDOP - figure out SMTP delivery option
|
||
|
||
NSMDOP: MOVE A,[ASCNT [MAIL]] ; Assume Mailing.
|
||
SKIPN SORMSW ; Hmmm, really sending?
|
||
RET ; Nope, bye.
|
||
SKIPLE SENDSW ; Yup, figure out what kind.
|
||
MOVE A,[ASCNT [SAML]] ; 1 => Send And MaiL.
|
||
SKIPE SENDSW
|
||
MOVE A,[ASCNT [SEND]] ;-1 => SEND only.
|
||
SKIPN SENDSW
|
||
MOVE A,[ASCNT [SOML]] ; 0 => Send Or MaiL.
|
||
RET ; Done
|
||
|
||
|
||
; NSMRTP - output return-path on standard output (doesnt have angle
|
||
; brackets or anything)
|
||
; Assumes current LSE is that of message being sent!!!!
|
||
|
||
NSMRTP: PUSHAE P,[A,B]
|
||
FINDA A,[A$SMRP,,[$LLLST(L)]] ; Maintainer for this mail?
|
||
CAIA ; If so, output verbatim.
|
||
JRST [ MOVE B,LISTAR(A)+1 ; Check length first.
|
||
TLNN B,-1 ; If null string,
|
||
JRST POPBAJ ; don't print anything.
|
||
OUT(,TLS(A)) ; (Don't add ourselves either!)
|
||
JRST POPBAJ ]
|
||
FINDA A,[A$SRTP,,[$LLLST(L)]] ; Return-path exists?
|
||
JRST NSMR20
|
||
; Moby KLUDGE to see if return-path already has routing in it.
|
||
; Goddam SMTP protocol!
|
||
NSMR10: MOVE B,LISTAR(A)+1 ; Get SPT to return path.
|
||
TLNN B,-1 ; See if it's null.
|
||
JRST POPBAJ ; Yeah, don't print anything.
|
||
OUT(,("@"),TZ(OWNNAM)) ; Aha, add ourselves.
|
||
ADD B,$LSLOC(L) ; Make ASCNT ptr to return-path.
|
||
HRLI B,440700
|
||
ILDB B,B ; Get 1st char of string.
|
||
CAIN B,"@
|
||
SKIPA B,[",] ; If already routing, delim is comma
|
||
MOVEI B,": ; Else gotta be colon (barf barf).
|
||
OUT(,C((B)),TLS(A))
|
||
JRST POPBAJ
|
||
NSMR20: FINDA A,[A$CSN,,[$LLLST(L)]] ; Claimed-from exists?
|
||
CAIA
|
||
JRST NSMR30
|
||
FINDA A,[A$SNM,,[$LLLST(L)]] ; Nope, plain sender-name?
|
||
JRST POPBAJ ; Ugh, couldn't find!
|
||
NSMR30: FINDA B,[A$SNH,,[$LLLST(L)]] ;Sender at foreign host?
|
||
JRST [ OUT(,TLS(A),("@"),TZ(OWNNAM)) ; No.
|
||
JRST POPBAJ ]
|
||
MOVE B,LISTAR(B)+1 ; Get host # it's from
|
||
OUT(,("@"),TZ(OWNNAM),(":"),TLS(A),("@"),HST(B)) ; Yes, cons path
|
||
JRST POPBAJ
|
||
|
||
|
||
|
||
; NSMRCP - Pass on a recipient name
|
||
; B/ ASCNT to name
|
||
;
|
||
; The argument to an SMTP "RCPT TO" command can be either
|
||
; a forward-path (which will end in a mailbox) or simply a mailbox.
|
||
; In the simpler case, our ASCNT rcpt name will be missing the @HOST
|
||
; part, so we need to put that back in. You might think it would be
|
||
; reasonable to leave it off, but some hosts (such as XEROX) don't
|
||
; default it to the local host; they complain.
|
||
|
||
NSMRCP: PUSHAE P,[A,B,C,D]
|
||
MOVE A,B ; Copy recipient name ptr.
|
||
OUT(NETO,("RCPT TO:"),LABR,TC(A))
|
||
HLRZ C,A ; Get rcpt string length
|
||
HRLI B,440700 ; Look at rcpt string.
|
||
NSMRC1: SOJL C,NSMRC2
|
||
ILDB D,B ; If not a source routing forward-path
|
||
CAIE D,"@ ; it needs to be a mailbox.
|
||
JRST NSMRC1
|
||
NSMRC2: SKIPGE C
|
||
OUTCAL(NETO,("@"),HST(N)) ; Output as <Foo@BAR>.
|
||
OUT(NETO,RABR,EOL,FRC) ; Finish off.
|
||
.NETS NETO, ; Force out.
|
||
;; Now record the SMTP transaction.
|
||
OUT(NETD,("RCPT TO:"),LABR,TC(A))
|
||
SKIPGE C
|
||
OUTCAL(NETD,("@"),HST(N))
|
||
OUT(NETD,RABR,EOL)
|
||
POPAE P,[D,C,B,A]
|
||
CALL NTR2XX
|
||
RET
|
||
JRST POPJ1
|
||
|
||
|
||
; NSMBEG - Initiate message transfer for SMTP.
|
||
; A/ ASCNT ptr to rcpt string to use. If nonzero,
|
||
; set up for this (single) recipient.
|
||
; Clobbers B
|
||
; Returns .+1 for error, A/ FTP-type reply code. -1 means temp net error.
|
||
; Returns .+2 if success
|
||
;
|
||
; Note that NSMINI has already called by NETSND to do the HELO command.
|
||
|
||
NSMBEG: JUMPE A,NSMBG5
|
||
MOVE B,A
|
||
CALL NSMRCP ; Arg in B
|
||
RET
|
||
NSMBG5: OUT(NETO,("DATA"),EOL,FRC)
|
||
.NETS NETO,
|
||
OUT(NETD,("DATA"),EOL) ; Record SMTP transaction
|
||
CALL NTR3XX
|
||
RET
|
||
CAIE A,354.
|
||
RET
|
||
JRST POPJ1
|
||
|
||
; NSMDAT - Send SMTP message text.
|
||
; Mainly must worry about transparency convention.
|
||
; B/ ASCNT ptr to message text.
|
||
; Clobbers B
|
||
|
||
NSMDAT: PUSH P,C
|
||
HLRZ C,B ; Get # chars in text
|
||
JUMPE C,NSMDT8
|
||
HRLI B,440700
|
||
PUSHAE P,[B,C]
|
||
NSMDT2: ILDB A,B
|
||
NSMDT3: CAIN A,". ; Line starts with period?
|
||
JRST NSMDT5
|
||
CAIA
|
||
NSMDT4: ILDB A,B
|
||
CAIN A,^M ; This is end of a line?
|
||
JRST [ SOJLE C,NSMDT5
|
||
ILDB A,B ; Get next char
|
||
CAIE A,^J
|
||
JRST NSMDT3 ; Not LF, but assume EOL seen anyway.
|
||
SOJG C,NSMDT2 ; CR-LF, so check next char (start of line)
|
||
JRST NSMDT5] ; EOF, send off what we've got.
|
||
SOJG C,NSMDT4
|
||
|
||
; Text up to this point is OK, send it off.
|
||
NSMDT5: D7BPT B ; Back up the BP to period
|
||
EXCH B,-1(P) ; Save it and restore old BP
|
||
EXCH C,(P) ; Save current cnt, restore old
|
||
SUB C,(P) ; Find # chars we went over
|
||
OUT(NETO,S(C,B)) ; Output text thus far!
|
||
CAIN A,". ; Did we stop cuz of a period?
|
||
OUTCAL(NETO,(".")) ; Yeah, must insert extra one.
|
||
MOVE B,-1(P)
|
||
MOVE C,(P)
|
||
SOJG C,[IBP B ? JRST NSMDT4]
|
||
|
||
POPAE P,[C,B]
|
||
NSMDT8: POP P,C
|
||
OUT(NETO,FRC) ; Ensure buffer forced out
|
||
ifn 0,[ ;; [BV] Hangs forever
|
||
SYSCAL FINISH,[MOVEI NETO] ; Wait for transmission ACK
|
||
JRST [ STAT (,("FINISH call failed - "),ERR)
|
||
MOVEI A,MR$TEH ; Temp err for host.
|
||
RET]
|
||
]
|
||
JRST POPJ1
|
||
|
||
; NSMDON - Terminate SMTP message transaction, see if it won or not.
|
||
; Returns .+1 if error, A/ reply code
|
||
; Returns .+2 if won
|
||
|
||
NSMDON: OUT(NETO,EOL,("."),EOL,FRC) ; Force out terminating line
|
||
.NETS NETO,
|
||
OUT(NETD,EOL,("."),EOL) ; Record SMTP transaction
|
||
CALL NTR2XX ; Expect a 2xx reply
|
||
RET ; Shit.
|
||
JRST POPJ1
|
||
|
||
|
||
; NSMBYE - Called before disconnecting from an SMTP server.
|
||
; Sends a QUIT command and skip returns.
|
||
|
||
LVAR BYEBYE: 0 ; Flag to prevent NSMBYE recursion.
|
||
|
||
NSMBYE: PUSHAE P,[A]
|
||
SKIPGE NDHOST ; Also, if no host to say bye to
|
||
JRST NSMBY9 ; punt.
|
||
MOVE A,BYETMO ; Whatever the timeout is.
|
||
CALL NETRAP ; Setup to trap IOC and timeout.
|
||
JRST [ CSTAT (,("...NSMBYE timed out"))
|
||
JRST NSMBY9 ]
|
||
OUT(NETO,("QUIT "),EOL,FRC)
|
||
.NETS NETO,
|
||
OUT(NETD,("QUIT "),EOL) ; Record transaction
|
||
CALL NTR2XX ; "221 See Ya - Closing transmission channel."
|
||
NOP ; Who cares?
|
||
; STAT (,(| Said SMTP goodbye, server replied "|),CALL(NTRSHO),(|"|))
|
||
CALL NERESET ; Flush error context off stack.
|
||
NSMBY9: POPAE P,[A]
|
||
JRST POPJ1
|
||
|
||
|
||
SUBTTL CHAOSnet ICP - NKMICP, NKSICP, NKXICP
|
||
|
||
.INSRT SYSTEM;CHSDEF ; For chaosnet defs
|
||
|
||
LVAR CHAPKT: BLOCK %CPMXW ; Chaosnet packet goes here
|
||
|
||
; NKMICP - Connect to Chaosnet host for MAIL.
|
||
; NTHOST - Host #
|
||
; Returns .+1 if failed,
|
||
; A - error #
|
||
; Skips if won.
|
||
|
||
NKMICP: MOVE A,[.BYTE 8 ? "M ? "A ? "I ? "L]
|
||
MOVEM A,CHAPKT+%CPKDT ; Contact name of MAIL
|
||
CALL NKXICP ; Try sending the RFC
|
||
RET ; Lost, pass back to caller
|
||
OUT(NETO,OPEN(UC$BUF,,,[8.])) ; Set up buffered 8-bit channel.
|
||
OUT(NETD,OPEN(UC$XCT,[CALL NKBOUT]))
|
||
AOS (P) ; Won!
|
||
RET ; Done.
|
||
|
||
; NKSICP - Connect to Chaosnet host for SMTP.
|
||
; Same args. Jumps off into the guts of the TCP/SMTP open routine.
|
||
; At the moment this causes it to return the same as NKMICP.
|
||
|
||
NKSICP: MOVE A,[.BYTE 8 ? "S ? "M ? "T ? "P]
|
||
MOVEM A,CHAPKT+%CPKDT ; Contact name of SMTP
|
||
CALL NKXICP ; Try sending the RFC
|
||
RET ; Lost, pass back to caller
|
||
JRST NXSICP ; Won, jump into common SMTP ICP code.
|
||
|
||
; NKXICP - common worker routine.
|
||
|
||
NKXICP: SYSCAL CHAOSO,[CIMM NETI ? CIMM NETO ? CIMM 5 ? CERR A]
|
||
JRST [ HRLI A,NCE$SY ? RET]
|
||
MOVE A,[.BYTE 8 ? %CORFC ? 0 ? 0 ? 4] ; 4 is byte count
|
||
MOVEM A,CHAPKT
|
||
SETZM CHAPKT+%CPKD ; Clear out destination
|
||
MOVE A,NTHOST ; Host might not be in N (internet forwarding)
|
||
DPB A,[CHAPKT+$CPKDA] ; Stick in host number.
|
||
SYSCAL PKTIOT,[CIMM NETO ? CIMM CHAPKT ? CERR A] ; Send out the RFC
|
||
JRST [ HRLI A,NCE$SY ? RET]
|
||
MOVEI A,NETO
|
||
.SEE NSMICP ; for the explanation of why this timeout is so large.
|
||
NETHANG 5*60.*30.,A,%CSRFS,[%CSOPN] ; Wait for it to become open.
|
||
JRST [ MOVSI A,NCE$CS ? RET]
|
||
AOS (P) ; Won, open!
|
||
RET
|
||
|
||
SUBTTL CHAOSnet routines - NKBEG, NKXRCP, NKSND, NKEND
|
||
|
||
LVAR NTCCON: 0 ; -1 if connection is already used
|
||
|
||
; NKMINI - Initializes for a Chaosnet mail connection.
|
||
; Necessary in order to do "invisible" reconnect if any
|
||
; messages have already been sent during this "connect", since
|
||
; the CHA/MAIL protocol closes the real connection after each message.
|
||
|
||
NKMINI: AOSE NTCCON ; If reconnect is necessary
|
||
JRST POPJ1 ; Nope, connection has had no messages yet.
|
||
MOVE A,ICPTMO
|
||
CALL NETRAP
|
||
JRST NKINI8 ; IOC error or timeout.
|
||
CALL NKDISC
|
||
MOVE A,NTHOST
|
||
CALL NKMICP
|
||
JRST NKINI7 ; Net error of some kind
|
||
CALL NERESET
|
||
JRST POPJ1 ; Won, return winningly.
|
||
|
||
NKINI7: MOVE B,A
|
||
CALL NERESET
|
||
MOVE A,B
|
||
NKINI8: CSTAT (,(" ...Re-ICP "),CALL(NTICPE),FRC)
|
||
CALL NTDISC
|
||
RET
|
||
|
||
; NKMBEG - Initiates mail-text transfer on Chaosnet connection.
|
||
; A - ASCNT ptr to rcpt string to use. If non-zero, must
|
||
; set up for this rcpt...
|
||
; Returns .+2 if success
|
||
; Returns .+1 for either temp or perm errors,
|
||
; A - FTP-type reply code. If -1, some type of net error.
|
||
|
||
NKMBEG: JUMPE A,NKBEG3
|
||
MOVE B,A
|
||
CALL NKXRCP ; Send rcpt name if any
|
||
RET ; Ugh, failed. Return error code of NKXRCP.
|
||
NKBEG3: OUT(NETD,EOL) ; Okay, send a null line to initiate.
|
||
AOS (P) ; Needn't wait for any reply.
|
||
RET
|
||
|
||
NKXRCP: TLNN B,-1 ; Ensure non-null
|
||
JRST [ STAT (,("NULL RCPT! Forcing failure."))
|
||
MOVEI A,599. ; Permanent failure code.
|
||
SETZ B, ; No error string available.
|
||
RET]
|
||
OUT(NETD,TC(B)) ; Output rcpt string
|
||
SKIPE NTRTSW ; If routing thru gateway,
|
||
OUTCAL(NETD,("@"),HST(NDHOST)) ; Specify real destination.
|
||
OUT(NETD,EOL)
|
||
CALRET NKREPX
|
||
|
||
|
||
; NKSEND - Tries to open a Chaosnet SEND connection.
|
||
; A - rcpt list
|
||
; Should be non-zero, must set up for this rcpt.
|
||
; N - host we should connect to.
|
||
;
|
||
; Chaosnet SENDs are weird because the recipient is specified as part
|
||
; of the connection process, rather than after a connection is open.
|
||
; This does not quite fit in the usual transaction model of things.
|
||
; We implement the SEND protocol by pretending that ICPs always
|
||
; win, and then we really do all the work during the "begin" phase.
|
||
; If you have a better idea of how to do this, let me know.
|
||
|
||
NKSEND: PUSHAE P,[C,D,E]
|
||
JUMPE A,[ MOVEI A,560.
|
||
SETZ B,
|
||
JRST NKSE80 ]
|
||
MOVE E,A ; Stash away ASCNT ptr.
|
||
SYSCAL CHAOSO,[CIMM NETI ? CIMM NETO ? CIMM 5 ? CERR A]
|
||
JRST [ SETO A,
|
||
SETZ B,
|
||
JRST NKSE90 ]
|
||
;; Form packet.
|
||
MOVEI TT,%CORFC ; Opcode is Request for Connection.
|
||
DPB TT,[$CPKOP+CHAPKT]
|
||
SETZM CHAPKT+%CPKD ; Clear out destination
|
||
DPB N,[CHAPKT+$CPKDA] ; Stick in host number.
|
||
;; Stuff the contact name and recipent name down the packet.
|
||
MOVE B,[440800,,CHAPKT+%CPKDT] ; Bp to packet.
|
||
MOVE A,[ASCII /SEND /] ; Contact name of SEND.
|
||
MOVE C,[440700,,A]
|
||
MOVEI D,5.
|
||
CALL RFCSTF ; Stuff it down.
|
||
HRLZI C,440700
|
||
HRR C,E ; Make Bp to ASCII rcpt string.
|
||
HLRZ D,E ; D gets number of bytes in it.
|
||
CALL RFCSTF ; Stuff it down.
|
||
ADDI D,5. ; Include contact name in count.
|
||
DPB D,[$CPKNB+CHAPKT] ; Remember how many bytes in packet.
|
||
;; Send out the RFC
|
||
SYSCAL PKTIOT,[CIMM NETO ? CIMM CHAPKT ? CERR A]
|
||
JRST [ SETO A,
|
||
JRST NKSE90 ]
|
||
MOVEI A,NETO ; Now wait for full connection.
|
||
NETHANG 15.*60.,A,%CSRFS,[%CSOPN]
|
||
CAIA
|
||
JRST [ MOVEM N,NDHOST ; Say connected to this host.
|
||
MOVEI A,250. ; If got this far, rcpt accepted.
|
||
OUT(NETO,OPEN(UC$BUF,,,[8.]))
|
||
OUT(NETD,OPEN(UC$XCT,[CALL NKBOUT]))
|
||
MOVEM N,NDHOST ; Say connected to this host!
|
||
AOS -3(P) ; Skip return if conn attempted.
|
||
JRST NKSE90 ]
|
||
NKSE70: SETZ B,
|
||
CALL NKBSRP ; Lost, get reply string and code.
|
||
MOVEI A,560. ; Else assume random permanent error.
|
||
NKSE80: CSTAT (,SP,("Conn="),D(A),SP)
|
||
NKSE90: POPAE P,[E,D,C]
|
||
RET
|
||
|
||
|
||
SUBTTL CHAOSnet Reply parsing
|
||
|
||
NKREPX: CALL NKOFRC ; Force previous output.
|
||
NKREP2: CALL NKIREP ; Get reply.
|
||
RET
|
||
CAIGE A,400. ; If less than 4xx,
|
||
AOS (P) ; consider it a win.
|
||
RET
|
||
|
||
NKIREP: MOVE U1,NTTYPE ; Check protocol.
|
||
CAIN U1,NT$CHS ; If SENDing
|
||
JRST [ MOVEI A,260. ; since we got this far
|
||
MOVEM A,REPLYC ; things must have worked.
|
||
CSTAT (,SP,LPAR,("SENT OK"),RPAR)
|
||
JRST NKIRP8 ]
|
||
MOVE A,[440700,,NTRBUF] ; Bp to reply buffer.
|
||
MOVEM A,NTRPT
|
||
SETZM NTRCNT
|
||
.IOT NETI,A ; Get 1st char...
|
||
CAMN A,[-1,,3] ; EOF?
|
||
JRST [ SETO A, ? RET]
|
||
PUSH P,B
|
||
SETZ B,
|
||
CAIN A,"- ; Negative response?
|
||
MOVEI B,560.
|
||
CAIN A,"% ; Temporary error?
|
||
MOVEI B,460.
|
||
CAIN A,"+ ; Positive response?
|
||
MOVEI B,260.
|
||
JUMPE B,[SETO A, ; None of them, assume network error.
|
||
PJRST POPBJ]
|
||
MOVEM B,REPLYC ; Got reply char, save result.
|
||
|
||
NKIRP3: AOS B,NTRCNT
|
||
CAIL B,NTRCMX
|
||
JRST [ SOS NTRCNT
|
||
JRST NKIRP4]
|
||
IDPB A,NTRPT ; Deposit char in buffer.
|
||
NKIRP4: .IOT NETI,A ; Get another
|
||
CAMN A,[-1,,3]
|
||
JRST [ SETO A, ? PJRST POPBJ]
|
||
CAIE A,215 ; Chaosnet <NL>?
|
||
JRST NKIRP3 ; Nope, loop to store.
|
||
POP P,B
|
||
MOVE A,REPLYC
|
||
NKIRP8: AOS (P)
|
||
RET
|
||
|
||
; NKBSRP - Process RFC failure (net reply from refusal datagram)
|
||
; A/ connection state
|
||
; Returns +1 if net lossage
|
||
; +2 if CLOSED,
|
||
; error string in the net reply buffer
|
||
; error code in A
|
||
|
||
NKBSRP: PUSHAE P,[B,C]
|
||
SETZM NTRCNT
|
||
SETZM NTRBUF ; Clear buffer.
|
||
MOVE T,[NTRBUF,,NTRBUF+1]
|
||
BLT T,NTRBOV
|
||
MOVE T,[440700,,NTRBUF]
|
||
MOVEM T,NTRPT ; Set up reply pointer.
|
||
CAIE A,%CSCLS ; If not received CLS packet
|
||
JRST NKBSR9 ; lossage.
|
||
SYSCAL PKTIOT,[ CIMM NETI ? CIMM CHAPKT ? CERR A]
|
||
JRST NKBSR9
|
||
LDB T,[$CPKOP CHAPKT] ; Get packet type.
|
||
CAIE T,%COCLS ; Should be CLS.
|
||
JRST NKBSR9 ; Read wrong packet??
|
||
LDB A,[$CPKNB CHAPKT] ; Count of chars in packet.
|
||
MOVE B,[440800,,%CPKDT+CHAPKT] ; Bp to packet data.
|
||
MOVE C,[440700,,NTRBUF] ; Bp to reply string.
|
||
SETZM NTRCNT ; Length of reply string.
|
||
NKBSR1: SOJL A,NKBSR7 ; Gobble it all down.
|
||
ILDB T,B ; Get a char.
|
||
ANDI T,177 ; ASCIIfy.
|
||
IDPB T,C ; Store.
|
||
AOS NTRCNT ; Keep count.
|
||
CAME T,^M ; ^M might end reply.
|
||
CAIA
|
||
CAIE T,^J ; ^J might end reply.
|
||
JUMPN T,NKBSR1 ; End of buffer ends reply.
|
||
NKBSR7: SETOM NTRPKT ; Say reply string set up.
|
||
LDB C,NTRPT ; Check first character.
|
||
IFN $$450, MOVEI A,450. ; Assume permanent error.
|
||
.ELSE MOVEI A,550. ; Assume permanent error.
|
||
CAIN C,"% ; If temporary error
|
||
MOVEI A,460. ; Say so.
|
||
NKBSR8: AOS -2(P) ;Winskip.
|
||
NKBSR9: POPAE P,[C,B]
|
||
RET
|
||
|
||
|
||
SUBTTL CHAOSnet subroutines
|
||
|
||
NKSND: OUT(NETD,TC(B))
|
||
CALL NKOFRC
|
||
JRST POPJ1
|
||
|
||
NKEND: CALL NKOFRC
|
||
MOVE A,[.BYTE 8 ? %COEOF ? 0 ? 0 ? 0] ; Send an EOF
|
||
MOVEM A,CHAPKT
|
||
SYSCAL PKTIOT,[CIMM NETO ? CIMM CHAPKT ? CERR A]
|
||
JRST [ MOVNS A ? RET]
|
||
SYSCAL FINISH,[CIMM NETO]
|
||
JFCL ;Wait for EOF acknowledged or connection closed
|
||
SETOM NTCCON ;Server will close connection after replying
|
||
CALRET NKREP2
|
||
|
||
|
||
; NKBOUT - Chaosnet output
|
||
|
||
NKBOUT: CAIL U1,10 ; Idiotic translations
|
||
CAILE U1,15
|
||
CAIA
|
||
XCT -10(U1)+[TRO U1,200 ; Backspace
|
||
TRO U1,200 ; Tab
|
||
RET ; Linefeed
|
||
JFCL ; Vert tab
|
||
TRO U1,200 ; Formfeed
|
||
TRO U1,200 ; Car ret
|
||
]
|
||
PUSH P,OC
|
||
MOVEI OC,NETO
|
||
STDOUT ; Output translated char on NETO channel.
|
||
POP P,OC
|
||
RET
|
||
|
||
NKOFRC: OUT(NETO,FRC) ; Force output,
|
||
.NETS NETO, ; and ask ITS to do same.
|
||
RET
|
||
|
||
|
||
|
||
; RFCSTF - Given an ASCII Bp in C and a count in D, stuff 8bit down B.
|
||
; Does not smash D. Always returns.
|
||
|
||
RFCSTF: MOVEI TT,0 ; TT counts bytes in packet.
|
||
RFCST1: ILDB T,C ; Get char of rcpt name.
|
||
CAML TT,D ; When all the bytes are stuffed
|
||
JRST RFCST9 ; all done.
|
||
IDPB T,B ; Stuff a byte.
|
||
CAIGE TT,%CPMXC-1 ; Make sure we are not overstuffed!
|
||
AOJA TT,RFCST1 ; Get another byte.
|
||
RFCST9: RET
|
||
|
||
|
||
SUBTTL Miscellaneous routines
|
||
|
||
IFE $$DQ,{ ; Non domain version
|
||
|
||
; "NHMLTX" - routine skips if host in A is a Multics.
|
||
NHMLTX: PUSHAE P,[A,B,D] ;save ACs clobbered by HSTSRC
|
||
MOVE B,A
|
||
CALL RESOLV"HSTSRC ;find out about this host
|
||
JRST NHMLT9 ;unknown host presumed not to be a Multics
|
||
HLRZ D,RESOLV"STLSYS(D) ;get pointer to system name
|
||
ADD D,RESOLV"HSTADR ;relocate
|
||
MOVE A,[ASCII/MULTI/]
|
||
MOVE B,[ASCII/CS/]
|
||
CAMN A,(D)
|
||
CAME B,1(D)
|
||
CAIA
|
||
AOS -3(P) ;It's a Multics; skip return
|
||
NHMLT9: POPAE P,[D,B,A]
|
||
RET
|
||
|
||
; "NHITS" - routine skips if host in A is an ITS
|
||
NHITS: PUSHAE P,[A,B,D] ;save ACs clobbered by HSTSRC
|
||
MOVE B,A
|
||
CALL RESOLV"HSTSRC ;find out about this host
|
||
JRST NHITS9 ;unknown host presumed not to be an ITS
|
||
HLRZ D,RESOLV"STLSYS(D) ;pointer to system name
|
||
ADD D,RESOLV"HSTADR ;relocate
|
||
MOVE A,[ASCII/ITS/]
|
||
CAMN A,(D)
|
||
AOS -3(P) ;It's ITS; skip return
|
||
NHITS9: POPAE P,[D,B,A]
|
||
RET
|
||
|
||
} ; Non-domain version
|
||
.ELSE { ; Domain version
|
||
|
||
; "NHMLTX" - routine skips if host in A is a Multics.
|
||
NHMLTX: PUSHAE P,[A,B,C,D] ; Save acs
|
||
|
||
IFN $$KA10,[
|
||
MOVE C,(B)
|
||
MOVE D,1(B)
|
||
]
|
||
IFE $$KA10, DMOVE C,[ASCII "MULTICS"] ; What we are looking for
|
||
|
||
JRST NHOPSY ; Join common code
|
||
|
||
; "NHITS" - routine skips if host in A is an ITS.
|
||
NHITS: PUSHAE P,[A,B,C,D] ; Save acs
|
||
MOVE C,[ASCII "ITS"] ; What we are looking for
|
||
MOVEI D,0
|
||
; JRST NHOPSY ; Join common code
|
||
|
||
|
||
; Common code for above routines. Beware pushing and popping,
|
||
; and beware of changes to QNAME consing in RESOLV"HSTINF.
|
||
NHOPSY: PUSHAE P,[C,D] ; Save argument for a little while
|
||
MOVE B,A ; B gets host number
|
||
MOVE A,[440700,,DQBUF] ; A gets buffer pointer
|
||
CALL RESOLV"HSTSRC ; Look up host name
|
||
JRST NHOPS8 ; Lost
|
||
MOVE A,[440700,,DQBUF] ; Use same buffer for input and output
|
||
MOVE B,[440700,,DQBUF] ; (at no time do my fingers leave my hand)
|
||
SETZM DQLUZ ; Paranoia (this -isn't- a 255. max hostname)
|
||
CALL RESOLV"HSTINF ; Look up the host's opsys
|
||
JRST NHOPS8 ; Lost
|
||
SKIPE DQLUZ ; Have we just randomly trashed memory?
|
||
JSR AUTPSY ; Oh shit.
|
||
MOVEI C,10. ; Ten chars max
|
||
SETO D, ; Haven't found null yet
|
||
NHOPS0: SKIPE D ; Copy second string (opsys), word aligned
|
||
ILDB D,B ; and null terminated. Pointers returned
|
||
IDPB D,A ; by HSTINF happen to do the right thing.
|
||
SOJG C,NHOPS0 ; Have interesting part of string
|
||
POPAE P,[D,C] ; Get back argument
|
||
CAMN C,DQBUF ; Got a match?
|
||
CAME D,DQBUF+1
|
||
JRST NHOPS9 ; Nope
|
||
AOS -4(P) ; Yup, skip return (cruft city, should be
|
||
JRST NHOPS9 ; a co-routine to handle this stuff)
|
||
NHOPS8: ADJSP P,-2 ; If the stack is intact after this it's
|
||
NHOPS9: POPAE P,[D,C,B,A] ; a bloody miracle.
|
||
RET
|
||
|
||
} ; .ELSE $$DQ
|
||
|
||
;special hack to get into multics
|
||
NTMLTX: PUSH P,A
|
||
FWRITE NETO,[[USER NETML
|
||
]]
|
||
.NETS NETO,
|
||
MOVEI A,330.
|
||
CALL NTR3XX ; First reply should be passwd request.
|
||
JRST POPAJ
|
||
FWRITE NETO,[[PASS NETML
|
||
]]
|
||
.NETS NETO,
|
||
MOVEI A,230. ; Look for "FTP server ready"
|
||
CALL NTRNXX
|
||
CAIA ; Lost...
|
||
AOS -1(P)
|
||
POP P,A
|
||
RET
|
||
|
||
CONSTANTS ;so as not to clutter up outside stuff if we can help it.
|