;-*-MIDAS-*-
TITLE IPLIST
.SYMTAB 6001.,6001.

comment |
	IPLIST is a program for debugging ITS TCP/IP and is not
for casual use!  Currently its main function is that of writing
a file CRASH;TCPOUT > containing an ASCII log of "filtered" IP
traffic.  Eventually it ought to also be capable of writing a binary
datagram log which can be used to re-insert selected datagrams into
the traffic stream for debugging and testing.

Format of disk binary log file (not implemented yet):
	-<# wds following>,,<block type>
	<# wds of block data>

Block types:
	0 - IP input from IMP
	1 - IP output to IMP
	2 - file description, block is ASCIZ string.
	
IP blocks (types 0 and 1) have the format:
	-N,,0
	timestamp
	<IP datagram, N-1 wds>
|

F=:0
A=:1
B=:2
C=:3
D=:4
E=:5
FRK=:6
S=:7
T=:10
TT=:11
OC=:12
U1=:13
U2=:14
U3=:15
U4=:16
P=:17

LOGC==1
LOG2C==2
IPIC==3
IPOC==4
ERRCHN==5
TYOC==6
DKOC==7

.insrt ksc;macros >
%%main==1
	$$out==1
	$$oerr==1
	$$otim==1
	$$obuf==1
its==os%its
ifn its,.insrt ksc;out >
ifn its,.insrt ksc;pagser >

ifn its,{
$$dstb==1
$$abs==1
$$outt==1
$$uptm==1
.insrt dsk:syseng;datime >
};ifn its
	 
syslos:
autpsy:	0
ifn its,.value	

define log (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
	out(logc,call(logpre),out(a,b,c,d,e,f,g,h,i,j,k,l,m,n),call(logpst))
termin
define log2 (a,b,c,d,e,f,g,h,i,j,k,l,m,n)
	out(log2c,call(logpre),out(a,b,c,d,e,f,g,h,i,j,k,l,m,n),call(logpst))
termin
logpre:	out(,tim(mdyt),sp,tz(@lognam),(": "))
	ret
logpst:	out(,eol,frc)
	ret

ip%ver==740000,,	; 0 IP Version # (= 4)
ip%ihl==036000,,	; 0 IP Header Length in 32-bit wds - at least 5
ip%tos==001774,,	; 0 Type Of Service
ip%tol==000003,,777760	; 0 Total Length in octets (including header)
ip%id== 777774,,	; 1 Identification
ip%flg==     3,,400000	; 1 Flags
ip%frg==     0,,377760	; 1 Fragment Offset
ip%ttl==776000,,	; 2 Time To Live
ip%ptc==  1774,,	; 2 Protocol
ip%cks==     3,,777760	; 2 Header Checksum
ip%src==777777,,777760	; 3 Source Address
ip%dst==777777,,777760	; 4 Destination Address
			; 5 Start of options
ip.ver==<.bp ip%ver,0>
ip.ihl==<.bp ip%ihl,0>
ip.tos==<.bp ip%tos,0>
ip.tol==<.bp ip%tol,0>
ip.id== <.bp ip%id, 1>
ip.flg==<.bp ip%flg,1>
ip.frg==<.bp ip%frg,1>
ip.ttl==<.bp ip%ttl,2>
ip.ptc==<.bp ip%ptc,2>
ip.cks==<.bp ip%cks,2>
ip.src==<.bp ip%src,3>
ip.dst==<.bp ip%dst,4>

;;; UDP definitions

UD$SRC==<242000,,0>		; 0 wd 1 Source port
UD$DST==<042000,,0>		; 0 wd 2 Dest port
UD$LEN==<242000,,1>		; 1 wd 1 # octets in data
UD$CKS==<042000,,1>		; 1 wd 2 UDP checksum
UD$DAT==<441000,,2>		; 2 Data - actually an ILDB pointer!

;;; TCP definitions

TH%SRC==:777774,,	; 0 Source Port
TH%DST==:     3,,777760	; 0 Destination Port
TH%SEQ==:777777,,777760	; 1 Sequence Number
TH%ACK==:777777,,777760	; 2 Acknowledgement Number
TH%THL==:740000,,	; 3 Data Offset (TCP Header Length in 32-bit wds)
TH%RES==: 37400,,	; 3 Reserved (should be 0)
TH%CTL==:   374,,	; 3 Control bits
TH%WIN==:     3,,777760	; 3 Window
TH%CKS==:777774,,	; 4 Checksum
TH%URG==:     3,,777760	; 4 Urgent Pointer
			; 5 Start of Options/Data

TH$SRC==:<.BP TH%SRC,0>
TH$DST==:<.BP TH%DST,0 >
TH$SEQ==:<.BP TH%SEQ,1>
TH$ACK==:<.BP TH%ACK,2>
TH$THL==:<.BP TH%THL,3>
TH$RES==:<.BP TH%RES,3>
TH$CTL==:<.BP TH%CTL,3>
TH$WIN==:<.BP TH%WIN,3>
TH$CKS==:<.BP TH%CKS,4>
TH$URG==:<.BP TH%URG,4>
TH$OPT==:<441000,,5>	; An ILDB-type pointer to start of options.

	; Control bit definitions (as located in full word)
%THURG==:<200,,>		; Urgent Pointer significant
%THACK==:<100,,>		; Ack field significant
%THPSH==:< 40,,>		; Push Function
%THRST==:< 20,,>		; Reset connection
%THSYN==:< 10,,>		; Synchronize sequence numbers
%THFIN==:<  4,,>		; Finalize - no more data from sender

	; ICMP fields
IC$TYP==<341000,,0>		; 0 Type of message
IC$COD==<241000,,0>		; 0 Code (subtype)
IC$CKS==<042000,,0>		; 0 ICMP Checksum
IC$GWA==<044000,,1>		; 1 Random arg, usually Gateway Addr
IC$IPH==2			; 2 Random data, usually an IP header

; IPQ dev OPEN control/mode bits
	%IQSYS==100	; Set up System Queue (0 or 1)
	%IQSOU==200	; System Queue 1 if set, otherwise 0
	%IQUDP==400	; Set up random queue for UDP (port # in FN1)


; .CALL IPKIOT - Internet Protocol Packet Transfer.
;	Arg 1 is channel (must be open on TCP:, specifies queue #)
;	Arg 2 is address of buffer
;	Arg 3 is count of words
;	Val 1 is count of words read into user space (if any)
;	Control bits specify function.  If none, "read" is assumed.
; Get datagram from:
	%IPIUS==100	; 1 = Get datagram from user space, not from a queue
	%IPNOC==200	; Global input no-check flag, suppresses normal check.
			;   For User Space, "check" means verify, set cksum.
			;   For Input Queue, "check" means verify IP header.
			;   For SysIn Queue, "check" means verify IP hdr.
			;   For SysOut Queue, means nothing.
	%IPNOH==400	; Don't Hang waiting for datagram (Queues only)
	%IPIQK==1000	; Keep on queue, don't remove (only for %IPOUS)
; Put datagram to:
	%IPOUS==0	; User space
	%IPOUT==1	; Output to network (bypasses SysOut queue)
	%IPOFL==2	; Flush it
	%IPORV==3	; Re-vector to input queues past this one

RCVLEN==500
lognam:	[asciz /UDPTST/]		; Name of program
srvprt:	0				; Port # of serve

popj1:	aos (p)
apopj:	ret
LISTSW:	-1	; If -1, write to DSK:TCPOUT >  (else TTY)
FLOWSW:	0	; -1 input only, 0 both, 1 output only

UDPPRT:	0	; Only show UDP datagrams with this source or dest port.
FHSTSW:	-1	; Only show IP datagrams with this host #
LPRTSW:	0	; If set, shows only TCP segments with given local port #.
FPRTSW:	0	; Ditto for foreign port #
DROPSW:	0	; If non-zero, allows only N successful input dgms, then
		;	drops an input dgm.  -1 drops all.

dropct:	0	; Auxiliary for dropsw operation
lstdev:	sixbit /dsk/
lstdir:	sixbit /crash/
lstfn1:	sixbit /tcpout/
lstfn2:	sixbit />/

GO:	MOVE P,[-PDLL,,PDL]
	SETZB F,BSSBEG			; Clear flags
	MOVE A,[BSSBEG,,BSSBEG+1]
	BLT A,BSSEND-1			; Clear all that needs clearing
	.SUSET [.RXJNAM,,A]
	CAMN A,[SIXBIT /IPLIST/]
	 JRST [	SETOM LISTSW
		SETZM FLOWSW
		JRST .+1]
	CAMN A,[SIXBIT /IPSHOW/]
	 JRST [	SETZM LISTSW
		SETZM FLOWSW
		JRST .+1]
	CAMN A,[SIXBIT /IPIN/]
	 SETOM FLOWSW
	CAMN A,[SIXBIT /IPOUT/]
	 AOS FLOWSW
	MOVE U1,[-100,,200]
	CALL PSRINI

	.open tyoc,[.uao,,'TTY]
	 .value
	out(,ch(tyoc),open(uc$iot))
	skipn listsw
	 jrst go20
	syscal open,[[.uao,,dkoc] ? lstdev ? lstfn1 ? lstfn2 ? lstdir]
	 .lose %lsfil
	out(,ch(dkoc),open(uc$buf))
go20:
	.OPEN IPIC,[%IQSYS,,'IPQ]
	 jrst [	out(tyoc,("Can't open IP SysIn Queue - "),err,eol)
		jsr autpsy]
	.OPEN IPOC,[%IQSYS+%IQSOU,,'IPQ]
	 jrst [	out(tyoc,("Can't open IP SysOut Queue - "),err,eol)
		jsr autpsy]
	
	skipe listsw
	 .value [asciz |: Listing System IP I/O to CRASH;TCPOUT > 
|]
	.rdtime a,
	movem a,tmbase
	out(,("IP datagram log started at "),tim(mdyt),eol)
	out(,("Sys time 0:00:00.00 (h:mm:ss.tt, tt = ticks in 1/60ths)"),eol)
	skipl a,fhstsw
	 outcal(,("Logging host "),call(inetad),sp,lpar,hv(fhstsw),rpar,eol)
	skipe lprtsw
	 outcal(,("Logging TCP local port "),d(lprtsw),("."),sp,lpar,o(lprtsw),rpar,eol)
	skipe fprtsw
	 outcal(,("Logging TCP foreign port "),d(fprtsw),("."),sp,lpar,o(fprtsw),rpar,eol)
	out(,eol,eol)

LOOP:	syscal ipkiot,[%clbit,,%IPNOC+%IPNOH+%IPIQK
		movei ipic ? movei rcvbuf ? movei rcvlen
		movem rcvcnt]
	 .lose 
	skipn rcvcnt		; Get anything?
	 jrst loop2		; No, go to next
	skipe a,udpprt
	 jrst [ ldb b,[ip.ptc rcvbuf]
		caie b,21
		 jrst loop1
		jumpl a,loop04
		ldb b,[ip.ihl rcvbuf]
		addi b,rcvbuf
		ldb c,[ud$src (b)]
		ldb d,[ud$dst (b)]
		came c,a
		 camn d,a
		  jrst loop04
		jrst loop1 ]
	skipl a,fhstsw
	 jrst [	ldb b,[ip.src rcvbuf]
		came a,b
		 jrst loop1
		jrst .+1]
	skipe a,lprtsw
	 jrst [	call prtcki
		 jrst loop1	; re-vector it.
		jrst .+1]
	skipe a,fprtsw
	 jrst [	call prtcko
		 jrst loop1
		jrst .+1]
	skipe a,dropsw		; Are we dropping input dgms?
	 jrst [	sosl dropct
		 jrst .+1
		out(,("DROPPED "))
		jrst loop05]
loop04:	out(,("RECEIVED "))
loop05:	out(,call(stime),tab,d(rcvcnt),(". words"),eol)
	call ipshow
	out(,("    ------------------------------------------------"),eol,frc)
	skipge dropct			; Do special stuff if dropping.
	 jrst [	move a,dropsw		; Reset drop count
		movem a,dropct
		syscal ipkiot,[%clbit,,%IPNOC+%IPNOH+%IPOFL	; Flush it
			movei ipic ? movem rcvcnt]
		 .lose
		jrst loop12]
loop1:	syscal ipkiot,[%clbit,,%IPNOC+%IPNOH+%IPORV	; Re-vector it.
		movei ipic ? movem rcvcnt]
	 .lose
loop12:	skipa c,[-1]

	; Now check outgoing stuff
loop2:	setz c,
	syscal ipkiot,[%clbit,,%IPNOC+%IPNOH+%IPIQK
		movei ipoc ? movei rcvbuf ? movei rcvlen
		movem rcvcnt]
	 .lose 
	skipn rcvcnt		; Get anything?
	 jrst [	jumpn c,loop		; No, go back if input unchecked
		jrst loop4]	; else go sleep for a bit.

	skipe a,udpprt
	 jrst [ ldb b,[ip.ptc rcvbuf]
		caie b,21
		 jrst loop3
		jumpl a,loop03
		ldb b,[ip.ihl rcvbuf]
		addi b,rcvbuf
		ldb c,[ud$src (b)]
		ldb d,[ud$dst (b)]
		came c,a
		 camn d,a
		  jrst loop03
		jrst loop3 ]
	skipl a,fhstsw
	 jrst [	ldb b,[ip.dst rcvbuf]
		came a,b
		 jrst loop3
		jrst .+1]
	skipe a,lprtsw
	 jrst [	call prtcko
		 jrst loop3
		jrst .+1]
	skipe a,fprtsw
	 jrst [	call prtcki
		 jrst loop3
		jrst .+1]
loop03:	out(,("SENT     "),call(stime),tab,d(rcvcnt),(". words"),eol)
	call ipshow
	out(,("    ------------------------------------------------"),eol,frc)
loop3:	syscal ipkiot,[%clbit,,%IPNOC+%IPNOH+%IPOUT	; Re-vector
		movei ipoc ? movem rcvcnt]
	 .lose
	jrst loop		; Back to get more input

	; No output or input.  Sleep for a while (gasp choke)
loop4:	out(,frc)		; Ensure any pending output gets out.
	movei a,1.
	.sleep a,
	jrst loop

; PRTCKI - Check incoming TCP port # (dest)
; PRTCKO - ditto for output (src)
;	Skips if current datagram has port # matching one in A.
; Clobbers everything.

prtcki:	tdza d,d	; D zero for input
prtcko:	 movei d,1	; D 1 for output
	movei e,rcvbuf
	caig e,10.	; must have at least 10 wds
	 ret
	ldb b,[ip.ptc (e)]
	caie b,6
	 ret
	ldb c,[ip.ihl (e)]
	addi c,(e)	; Get addr of TCP header
	ldb b,(d)[th$dst (c) ? th$src (c)]	; Get right port #
	camn a,b
	 aos (p)
	ret

; STIME - outputs system time on std output.

tmbase:	0		; Base time, set at startup
stime:	.rdtime t,
	sub t,tmbase
	lsh t,1.	; Get 30ths into 60ths.
	idivi t,60.	; Get rem # ticks
	push p,tt
	idivi t,60.	; Get rem # secs
	push p,tt
	idivi t,60.	; Get rem # mins
	out(,d(t),(":"))	; Print hrs
	movei t,(tt)	; Get back mins
	idivi t,10.
	out(,c("0(t)),c("0(tt)),(":"))	; print mins
	pop p,t
	idivi t,10.
	out(,c("0(t)),c("0(tt)),("."))	; print secs
	pop p,t
	idivi t,10.
	out(,c("0(t)),c("0(tt)))	; print ticks
	ret

ipshow:	movei e,rcvbuf
	move s,rcvcnt
	caige s,5	; Should be at least 5 words for IP header
	 jrst .+1	; Ugh, complain, treat as data?
	movns s
	movsi s,(s)
	hrri s,(e)	; Now have AOBJN to datagram.

ipsh05:	irp fld,,[ver,ihl,tos,tol,id,flg,frg,ttl,ptc,cks,src,dst]
	ldb a,[ip.!fld (s)]
	movem a,iv.!fld'
	termin

	out(,("IP header:"),eol)
	out(,tab,h((s)))
	out(,tab,("V="),o(iv.ver),(", IHL="),o(iv.ihl),(", Tos="),o(iv.tos),(", Len="),d(iv.tol),("."),eol)
	aobjp s,ipshot
	out(,tab,h((s)))
	out(,tab,("Id="),o(iv.id),(", Flgs="),o(iv.flg),(", Frag="),d(iv.frg),("."),eol)
	aobjp s,ipshot
	out(,tab,h((s)))
	out(,tab,("Ttl="),o(iv.ttl),(", Ptcl="),o(iv.ptc),(", Cksm="),o(iv.cks))
	movei a,(e)
	call ipcksm
	camn b,iv.cks
	 jrst [	out(,(" OK"),eol)
		jrst .+2]
	outcal(,(" BAD, shd be= "),o(b),eol)
	aobjp s,ipshot
	out(,tab,h((s)))
	move a,iv.src
	out(,tab,("Source addr "),call(inetad),eol)
	aobjp s,ipshot
	out(,tab,h((s)))
	move a,iv.dst
	out(,tab,("Dest   addr "),call(inetad),eol)

	aobjp s,ipshod

	; If still here, we have more than just IP header.
	move b,ip.ihl		; Find # of words in header
	addi b,rcvbuf		; Find 1st non-header addr
	caig b,(s)		; If we haven't gotten that far, skip
	 jrst ipsh50
	out(,("IP options:"),eol)
ipsh31:	out(,tab,h((s)),tab,call(bytsho),eol)
	caig b,(s)
	 jrst ipsh50
	aobjn s,ipsh31
	jrst ipshot

	; S now points to start of IP data (ie higher level header).
	; See if it's any protocol we know about, and vector off
	; to pretty-print if so.
ipsh50:	skipe a,iv.frg		; If fragment offset is set,
	 jrst ipsh80		; no hope of making sense, so just show data.
	move a,iv.ptc		; Get protocol #
	cain a,6		; TCP?
	 jrst ipsh60		; Yeah, moby hair, go do it.
	cain a,1		; ICMP?
	 jrst ipsh51		;  Do it.
	caie a,17.		; UDP?
	 jrst ipsh80		; Nope, unknown, treat as data.

	; Handle UDP header
	irp fld,,[src,dst,len,cks,dat]
	ldb a,[ud$!fld (s)]
	movem a,uv.!fld'
	termin

	out(,("UDP header:"),eol)
	out(,tab,h((s)),tab,("Src port="),o(uv.src),(",  Dst port="),o(uv.dst),eol)
	aobjp s,ipshot
	out(,tab,h((s)),tab,("Len="),o(uv.len),(",  Cksm="),o(uv.cks))
	movei a,rcvbuf
	call chksum
	camn a,uv.cks
	 jrst [	out(,(" OK"),eol)
		jrst .+2]
	outcal(,(" BAD, shd be="),o(a),eol)
	aobjp s,ipshod
	movei a,8.		; Header done, now print data.  Say 8 bytes
	jrst ipsh80		; constitute the UDP header.

	; Handle ICMP datagram
ipsh51:	irp fld,,[typ,cod,cks,gwa]
	ldb a,[ic$!fld (s)]
	movem a,xv.!fld'
	termin

	out(,("ICMP header:"),eol)
	out(,tab,h((s)),tab,("Type="),d(xv.typ),(", Code="),d(xv.cod),(", Cksm="),o(xv.cks),eol)
	; Should check ICMP checksum here.
	aobjp s,ipshot
	out(,tab,h((s)),tab)
	move a,xv.gwa
	move d,xv.typ		; Do right thing depending on type
	caie d,0	; Echo Reply
	 cain d,8.	; Echo
	  jrst ipsh53
	caie d,13.	; Timestamp
	 cain d,14.	; Timestamp Reply
	  jrst ipsh53
	caie d,15.	; Info Req
	 cain d,16.	; Info Reply
	  jrst ipsh53
	cain d,5	; Redirect
	 jrst [	out(,("Gateway "),call(inetad),eol)
		jrst ipsh52]
	cain d,12.	; Parameter problem
	 jrst [	lsh a,-24.
		out(,("Pointer="),d(a),("."),eol)
		jrst ipsh52]
	caie d,3	; Dest unreachable
	 cain d,4	; Source Quench
	  jrst [out(,(" -"),eol)
		jrst ipsh52]
	cain d,11.	; Time Exceeded
	 jrst .-2
	out(,("??"),eol)
	jrst ipsh54
ipsh52:	aobjn s,ipsh05	; Go display the included IP header!
	jrst ipshot
ipsh53:	ldb b,[202000,,a]
	ldb c,[002000,,a]
	out(,("ID="),o(b),(", Seq="),o(c),eol)
ipsh54:	aobjp s,ipshot
	movei a,8.	; 8 bytes in this variant of ICMP header
	jrst ipsh80

	; Handle TCP header!
ipsh60:	jumpge s,ipshod
	irp fld,,[src,dst,seq,ack,thl,res,ctl,win,cks,urg]
	ldb a,[th$!fld (s)]
	movem a,tv.!fld'
	termin

	out(,("TCP header:"),eol)
	out(,tab,h((s)))
	out(,tab,("Src port="),o(tv.src),(", Dst port="),o(tv.dst),eol)
	aobjp s,ipshot
	out(,tab,h((s)))
	out(,tab,("Seq no="),o(tv.seq),eol)
	aobjp s,ipshot
	out(,tab,h((s)))
	out(,tab,("Ack no="),o(tv.ack),eol)
	aobjp s,ipshot
	out(,tab,h((s)))
	out(,tab,("THL="),o(tv.thl),(", res="),o(tv.res),(", Ctl="),o(tv.ctl),sp,call(ctlsho),(", Wind="),o(tv.win),eol)
	aobjp s,ipshot

	out(,tab,h((s)))
	out(,tab,("Cksm="),o(tv.cks))
	movei a,rcvbuf
	call tcpcks		; Get TCP checksum
	camn a,tv.cks
	 jrst [	out(,(" OK"))
		jrst .+2]
	outcal(,sp,lpar,("BAD, shd be="),o(a),rpar)
	out(,(", Urgp="),o(tv.urg),eol)

	; Here maybe print TCP options.
	move b,tv.thl		; Get TCP header length
	subi b,5
	caig b,
	 aobjp s,ipshod
	caile b,
	 aobjp s,ipshot		; Different stop msg if expect more.
	jumple b,ipsh68		; Nothing more in header.
	out(,("TCP options:"),eol)
ipsh65:	out(,tab,h((s)),eol)
	aobjp s,ipshot
	sojg b,ipsh65

ipsh68:	move a,tv.thl		; Get length of TCP header, in words
	lsh a,2			; make it bytes
	jrst ipsh80		; Go print out data.

	; Come here to print straight data.
	; Set up A with # bytes in the protocol header (TCP, UDP, etc).
	; Code figures from IP header how many bytes of data remain, and
	; puts that in D. (S still has AOBJN to # words,
	; they may not agree)
ipsh80:	move d,iv.tol		; Get total length of datagram in bytes
	subi d,(a)		; Find length minus protocol header
	move a,iv.ihl		; Get length of TCP header
	lsh a,2
	subi d,(a)		; Find # bytes of real data
	jumpl d,[out(,tab,("---- Error: IHL+header > TOL ----"),eol)
		jrst ipsh85]
	jumpe d,ipsh85		; If no data, go print junk.
	jumpge s,ipshot
	out(,("Data:"),eol)
	movei t,4
ipsh82:	out(,tab,h((s)),tab,call(bytsho),tab,call(chrsho),eol)
	subi d,4
	jumpe d,[aobjn s,ipsh85
		jrst ipshod]
	jumpl d,[movei t,4(d)
		jrst ipsh86]
	aobjn s,ipsh82
	out(,tab,("---- Datagram Truncated ---- should have "),d(d),(" bytes of following data."),eol)
	jrst ipshod

ipsh85:	jumpge s,ipshod
	seto t,
ipsh86:	out(,("Junk:"))
	caige t,
	 outcal(,eol)
	cail t,
	 outcal(,tab,tab,tab)
	caige t,
ipsh87:	 outcal(,tab,h((s)),tab)
	out(,call(bytsho),tab,call(chrsho),eol)
	subi d,4
	seto t,
	aobjn s,ipsh87
	jrst ipshod

ipshot:	out(,tab,("--truncated--"),eol)	; Unexpected end of datagram

ipshod:	out(,eol)
	ret

	; Print control flags in TV.CTL.
	; Clobbers A
ctlsho:	skipn a,tv.ctl
	 ret		; Nothing to output.
	out(,lpar)
	irp fld,,[URG,ACK,PSH,RST,SYN,FIN]
	trne a,<%th!fld>_-<16.+4>
	 jrst [	caige a,
		 outcal(,(","))
		tlo a,(setz)
		out(,("fld"))
		jrst .+1]
	termin
	out(,rpar)
	ret

	; Print 4 8-bit chars in word S points to.
	; Decrements D prior to each char; if result negative,
	; then T is also decremented and action depends on result:
	;	T pos/zero - Skip char (print spaces)
	;	T neg - print char anyway
	; Clobbers A.
chrsho:	pushae p,[d,t]
	push p,[441000,,(s)]
	repeat 4,[
		ildb a,(p)
		sojl d,[sojl t,.+1
			out(,("   "))
			jrst .+2]
		call chrsh2
	]
	sub p,[1,,1]
	popae p,[t,d]
	ret
chrsh2:	out(,sp)
	trze a,200		; Meta bit set?
	 jrst [	trnn a,140	; Yes, see if it's a control char
		 jrst [	out(,("|"),c(100(a)))	; Yeah, special hack for that.
			ret]
		cain a,177		; Special case, sigh
		 jrst [	out(,("|?"))
			ret]
		out(,("~"),c((a)))
		ret]
	trnn a,140	; A control char?
	 jrst [	out(,("^"),c(100(a)))
		ret]
	cain a,177
	 jrst [	out(,("^?"))
		ret]
	out(,sp,c((a)))
	ret

	; Print bytes in word S points to.
	; Args as for above routine, including D and T.
	; Clobbers A
bytsho:	pushae p,[d,t]
	push p,[441000,,(s)]
repeat 4,[
	ildb a,(p)
	sojl d,[sojl t,.+1
		out(,("    "))
		jrst .+2]
	outcal(,o(a,4))
]
	sub p,[1,,1]
	popae p,[t,d]
	ret

INETAD:	MOVE C,[401000,,A]
	ILDB B,C
	OUT(,D(B),C(".))
	ILDB B,C
	OUT(,D(B),C(".))
	ILDB B,C
	OUT(,D(B),C(".))
	ILDB B,C
	OUT(,D(B))
	RET

; CHKSUM - Compute checksum for received UDP message.
;	A/ address of receive buffer (1st wd of message)
; Returns .+1
;	A/ checksum

chksum:	pushae p,[b,c,d,e]
	movei d,(a)
	; First compute pseudo header
	ldb a,[ip.src (d)]	; Source addr
	ldb b,[ip.dst (d)]	; Dest addr
	add a,b
	ldb b,[ip.ptc (d)]	; Protocol
	addi a,(b)
	ldb b,[ip.tol (d)]	; Get total length in octets
	ldb c,[ip.ihl (d)]	; Find IP header length in 32-bit wds
	addi d,(c)		; Change pointer to TCP seg
	lsh c,2			; mult by 4 to get # octets
	subi b,(c)		; Find # octets of IP data (TCP segment)
	cail b,			; If negative, skip this one.
	 addi a,(b)

	; Done with pseudo header (not folded yet, though).
	; B has # octets in the UDP segment.
	; D now points to the UDP segment.
	ldb c,[ud$src (d)]
	addi a,(c)
	ldb c,[ud$dst (d)]
	addi a,(c)
	ldb c,[ud$len (d)]
	addi a,(c)

	movei c,-<2*4>(b)	; Get # bytes of remaining data in C
	lshc a,-16.
	lsh b,-<16.+4>
	addi a,(b)		; Now have it folded up.
	jumple c,udpck7
	movei e,2(d)
	hrli e,442000		; Set up 16-bit byte ptr
	lshc c,-1
	jumple c,udpck6
udpck5:	ildb b,e
	addi a,(b)
	sojg c,udpck5
udpck6:	jumpl d,[		; Jump if odd byte left.
		ildb b,e	; get it
		andcmi b,377	; mask off low (unused) byte.
		addi a,(b)	
		jrst .+1]
carmsk==<-1,,600000>
udpck7:	tdne a,[carmsk]			; If any carries, add them in.
	 jrst [	ldb b,[.bp carmsk,a]
		tdz a,[carmsk]
		add a,b
		jrst udpck7]
	andcai a,177777			; Complement sum and mask off.
	popae p,[e,d,c,b]
	ret

; IPCKSM - Figures IP checksum
;	A/ addr of datagram
; Returns
;	B/ checksum

IPCKSM:
IFN 0,[	PUSH P,C
	PUSH P,D
	MOVEI C,(A)
	HRLI C,442000		; Gobble 16-bit bytes
	ILDB B,C		; wd 0 byte 1
	ILDB D,C
	ADDI B,(D)		; Add 2nd byte of 1st wd
	ILDB D,C ? ADDI B,(D) ? ILDB D,C ? ADDI B,(D)	; 1 ID,frag
	ILDB D,C ? ADDI B,(D) ? IBP C		 	; 2 Skip chksum field
	ILDB D,C ? ADDI B,(D) ? ILDB D,C ? ADDI B,(D)	; 3 source addr
	ILDB D,C ? ADDI B,(D) ? ILDB D,C ? ADDI B,(D)	; 4 dest addr
IPCKS8:	CAIG B,177777
	 JRST IPCKS9
	LDB D,[202400,,B]	; Get any overflow
	ANDI B,177777
	ADDI B,(D)
	JRST IPCKS8
IPCKS9:	SETCA B,
	ANDI B,177777
	POP P,D
	POP P,C
	RET
] ;ifn 1
ifn 1,[
IFNDEF JCRY0,JCRY0==:<JFCL 4,>

	PUSH P,W
	MOVEI W,(A)
	PUSH P,C
	CALL IPCKS0
	POP P,C
	MOVE B,A
	MOVEI A,(W)
	POP P,W
	RET

IPCKS0:	SETZ A,
	LDB C,[IP.IHL (W)]	; Get IP header length
	MOVE B,IP.CKS(W)	; Get 3rd word
	ANDCM B,[IP%CKS]	; Mask out the checksum field
	JFCL 17,.+1		; Clear flags
	ADD B,IP.VER(W)		; Add 1st wd
	JCRY0 [AOJA A,.+1]
	ADD B,IP.ID(W)		; Add 2nd
	JCRY0 [AOJA A,.+1]
	ADD B,IP.SRC(W)		; Add 4th
	JCRY0 [AOJA A,.+1]
	ADD B,IP.DST(W)		; Add 5th
	JCRY0 [AOJA A,.+1]
	CAILE C,5
	 JRST IPCKS4		; Longer than 5 words, must hack options.
IPCKS2:	LSHC A,16.		; Get high 2 bytes (plus carries) in A
	LSH B,-<16.+4>		; Get low 2 bytes in B
IPCKS3:	ADDI A,(B)		; Get total sum
	CAILE A,177777		; Fits?
	 JRST [	LDB B,[202400,,A]	; No, must get overflow bits
		ANDI A,177777		; then clear them
		JRST IPCKS3]		; and add in at low end.
	ANDCAI A,177777		; Return ones complement
	RET

IPCKS4:	SUBI C,5		; C has a 4 bit value.
	MOVN C,C		; Get neg of # words left
	LSH C,1			; Double it
	JUMPL C,IPCKS5(C)	
	RET			; Something is wrong, so just return bad val.

REPEAT 10.,[
	ADD B,5+<10.-.RPCNT>(W)
	JCRY0 [AOJA A,.+1]
]
IPCKS5:	JRST IPCKS2		; Options all added, now go fold sum.

] ;ifn 0

; TCPCKS - Figures TCP checksum.
;	A/ ptr to start of IP datagram
; Returns
;	A/ checksum

w==tt+1
h==w+1
TCPCKS:	pushae p,[b,c,d,e,t,tt,w,h]
	movei w,(a)
	movei h,5(w)

ifn 1,[
	movei d,(a)
	; First compute pseudo header
	ldb a,[ip.src (d)]	; Source addr
	ldb b,[ip.dst (d)]	; Dest addr
	add a,b
	ldb b,[ip.ptc (d)]	; Protocol
	addi a,(b)
	ldb b,[ip.tol (d)]	; Get total length in octets
	ldb c,[ip.ihl (d)]	; Find IP header length in 32-bit wds
	addi d,(c)		; Change pointer to TCP seg
	lsh c,2			; mult by 4 to get # octets
	subi b,(c)		; Find # octets of IP data (TCP segment)
	cail b,			; If negative, skip this one.
	 addi a,(b)

	; Done with pseudo header (not folded yet, though).
	; B has # octets in the TCP segment.
	; D now points to the TCP segment.
	ldb c,[044000,,0(d)]	; Get wd 0 (src/dest)
	add a,c
	ldb c,[th$seq (d)]	; Get wd 1 (seqno)
	add a,c
	ldb c,[th$ack (d)]	; wd 2
	add a,c
	ldb c,[044000,,3(d)]	; wd 3
	add a,c
	ldb c,[th$urg (d)]	; wd 4 (part of)
	addi a,(c)
	movei c,-<5*4>(b)	; Get # bytes of remaining data in C
;---------
	lshc a,-16.
	lsh b,-<16.+4>
	addi a,(b)		; Now have it folded up.
	jumple c,tcpck7
	movei e,5(d)
	hrli e,442000		; Set up 16-bit byte ptr
	lshc c,-1
	jumple c,tcpck6
tcpck5:	ildb b,e
	addi a,(b)
	sojg c,tcpck5
tcpck6:	jumpl d,[		; Jump if odd byte left.
		ildb b,e	; get it
		andcmi b,377	; mask off low (unused) byte.
		addi a,(b)	
		jrst .+1]
carmsk==<-1,,600000>
tcpck7:	tdne a,[carmsk]			; If any carries, add them in.
	 jrst [	ldb b,[.bp carmsk,a]
		tdz a,[carmsk]
		add a,b
		jrst tcpck7]
	andcai a,177777		; Complement sum and mask off.
]

	popae p,[h,w,tt,t,e,d,c,b]
	ret

ifn 1,[
TCPCKX:	pushae p,[b,c,d,e,t,tt,w,h]
	movei w,(a)
	movei h,5(w)
ip$src==ip.src
ip$dst==ip.dst
ip$tol==ip.tol
%ptctc==6
ip$ihl==ip.ihl
th$up==th$urg
THCKSI:	 MOVNI C,5*4
	; First compute pseudo header
	LDB A,[IP$SRC (W)]	; Source addr
	LDB B,[IP$DST (W)]	; Dest addr
	ADDI A,%PTCTC(B)	; Add TCP protocol number
	LDB TT,[IP$TOL (W)]	; Get total length in octets
	JUMPE C,THCKS2
	LDB B,[IP$IHL (W)]	; Find IP header length in 32-bit wds
	LSH B,2			; mult by 4 to get # octets
	SUBI TT,(B)		; Find # octets of IP data (TCP segment)
THCKS2:	ADDI A,(TT)		; Add in.
	MOVEI C,-<5*4>(TT)	; Get # bytes in segment after 1st 5 wds
	LDB T,[TH$THL (H)]	; Find TCP header length - not needed for
	LSH T,2			; checksum, but easy to find here.
	SUBI TT,(T)		; TT now has # octets of segment data.

	; Done with pseudo header (not folded yet, though).
	; TT has # octets in the TCP segment.
	LDB B,[044000,,0(H)]	; Get wd 0 (src/dest)
	ADD A,B
	LDB B,[TH$SEQ (H)]	; Get wd 1 (seqno)
	ADD A,B
	LDB B,[TH$ACK (H)]	; wd 2
	ADD A,B
	LDB B,[044000,,3(H)]	; wd 3
	ADD A,B
	LDB B,[TH$UP (H)]	; wd 4 (part of)
	ADDI A,(B)

	LSHC A,-16.
	LSH B,-<16.+4>
	ADDI A,(B)		; Now have it folded up.
	JUMPLE C,THCKS7		; If nothing more, can leave now.
	MOVEI E,5(H)
	HRLI E,442000		; Set up 16-bit byte ptr to options/data
	LSHC C,-1
	JUMPLE C,THCKS6
THCKS5:	ILDB B,E
	ADDI A,(B)
	SOJG C,THCKS5
THCKS6:	JUMPL D,[		; Jump if odd byte left.
		ILDB B,E	; get it
		ANDCMI B,377	; mask off low (unused) byte.
		ADDI A,(B)	
		JRST .+1]
%CKMSK==<-1#177777>		; Mask for stuff above 16 bits
THCKS7:	TDNE A,[%CKMSK]		; If any carries, add them in.
	 JRST [	LDB B,[.BP %CKMSK,A]
		TDZ A,[%CKMSK]
		ADD A,B
		JRST THCKS7]
	ANDCAI A,177777		; Complement sum and mask off.
]

	popae p,[h,w,tt,t,e,d,c,b]
	ret


; Counters and other statistics that are never reset
OPNERR:	0		; # open errors
RCVCNT:	0
BSSBEG:
RCVBUF:	BLOCK RCVLEN
STRBFL==500.
STRBUF:	BLOCK STRBFL/5
ARGCT:	0
ARGBP:	0
JCLLN==300.
JCLFLG:	0
JCLBUF:	BLOCK <JCLLN/5>
CLSNUM:	0		; # JCN's stored in close tables
	VARIABLES
PDLL==200
PDL:	BLOCK PDLL+1

BSSEND:
	END GO