(FILECREATED "21-Jun-85 19:38:29" {ERIS}<LISPCORE>LIBRARY>TCPDEBUG.;12 23615
changes to: (VARS TCPDEBUGCOMS)
previous date: "21-Jun-85 17:17:31" {ERIS}<LISPCORE>LIBRARY>TCPDEBUG.;10)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPDEBUGCOMS)
(RPAQQ TCPDEBUGCOMS ((COMS (* standard TCP small servers)
(FNS TCP.SINK.SERVER TCP.TELNET.SERVER \TCP.SINK.PROCESS TCP.ECHO.SERVER
\TCP.ECHO.PROCESS))
(COMS (* TCP tracing and debugging info)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS LIGHTGRAYSHADE))
(GLOBALVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME
\TCP.DEBUGGABLE)
(INITVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME
NETTRACETITLEREG)
(VARS (\TCP.DEBUGGABLE T))
(BITMAPS NETTRACEICON NETTRACEMASK)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCP)
(FNS TCP.PRINT.SEGMENT \TCP.PRINT.OPTIONS \TCP.PRINT.ELAPSED.TIME
\TCP.PRINT.SEGMENT.QUEUE TCPTRACE \TCPTRACEMENU.ITEMFN
\TCPTRACEMENU.DISPLAYFN TCP.DRIBBLE))
(COMS (* miscellaneous TCP debugging)
(GLOBALVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT
\TCP.MASTER.SOCKET)
(INITVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT)
(FNS TCP.DEBUG TCP.WATCHER DUMMY\IP\Transmit\Packet \TCP.CHECK.INPUT.QUEUE
TCP.FAUCET TCP.ECHOTEST TCP.QUIET.ECHOTEST TCP.SINKTEST
GENERATE.RANDOM.CHARS COPYBYTESTREAM TCP.COPYTOWINDOW TEST.CHECKSUM)))
)
(* standard TCP small servers)
(DEFINEQ
(TCP.SINK.SERVER
(LAMBDA (PORT) (* ecc "14-May-84 16:32")
(bind STREAM do (if (SETQ STREAM (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT)
(QUOTE PASSIVE)
(QUOTE INPUT)
T))
then (ADD.PROCESS (BQUOTE (\TCP.SINK.PROCESS , STREAM))
(QUOTE NAME)
"TCP Sink")))))
(TCP.TELNET.SERVER
(LAMBDA NIL (* ejs: "20-Jun-85 12:38")
(LET ((INSTREAM (TCP.OPEN NIL NIL \TCP.TELNET.PORT (QUOTE PASSIVE)
(QUOTE INPUT)))
OUTSTREAM)
(COND
(INSTREAM (SETQ OUTSTREAM (TCP.OTHER.STREAM INSTREAM))
(ADD.PROCESS (LIST (QUOTE \TCP.ECHO.PROCESS)
(KWOTE INSTREAM)
(KWOTE OUTSTREAM))
(QUOTE NAME)
"Telnet echo")
(ADD.PROCESS (QUOTE (TCP.TELNET.SERVER)))
(GENERATE.RANDOM.CHARS OUTSTREAM))))))
(\TCP.SINK.PROCESS
(LAMBDA (STREAM) (* ejs: " 7-Jun-85 13:11")
(RESETSAVE NIL (LIST (FUNCTION CLOSEF)
STREAM))
(replace (STREAM ENDOFSTREAMOP) of STREAM with (FUNCTION NILL))
(until (EOFP STREAM) do (BIN STREAM))))
(TCP.ECHO.SERVER
(LAMBDA (PORT) (* ecc "14-May-84 16:35")
(bind STREAM do (if (SETQ STREAM (TCP.OPEN NIL NIL (OR PORT \TCP.ECHO.PORT)
(QUOTE PASSIVE)
(QUOTE INPUT)
T))
then (ADD.PROCESS (BQUOTE (\TCP.ECHO.PROCESS , STREAM , (TCP.OTHER.STREAM
STREAM)))
(QUOTE NAME)
"TCP Echo")))))
(\TCP.ECHO.PROCESS
(LAMBDA (INSTR OUTSTR) (* ejs: "13-Apr-85 16:59")
(RESETSAVE NIL (LIST (FUNCTION CLOSEF)
INSTR))
(RESETSAVE NIL (LIST (FUNCTION CLOSEF)
OUTSTR))
(until (OR (NOT (OPENP INSTR (QUOTE INPUT)))
(EOFP INSTR))
do (SETQ C (CAR (NLSETQ (BIN INSTR))))
(COND
(C (BOUT OUTSTR C)))
(if (OR (NOT (READP INSTR))
(NOT (OPENP INSTR (QUOTE INPUT)))
(EOFP INSTR))
then (FORCEOUTPUT OUTSTR)))))
)
(* TCP tracing and debugging info)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ LIGHTGRAYSHADE 1025)
(CONSTANTS LIGHTGRAYSHADE)
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TCPTRACEFLG TCPTRACEFILE TCPTRACEMENU \TCP.ELAPSED.TIME \TCP.DEBUGGABLE)
)
(RPAQ? TCPTRACEFLG NIL)
(RPAQ? TCPTRACEFILE NIL)
(RPAQ? TCPTRACEMENU NIL)
(RPAQ? \TCP.ELAPSED.TIME NIL)
(RPAQ? NETTRACETITLEREG NIL)
(RPAQQ \TCP.DEBUGGABLE T)
(RPAQ NETTRACEICON (READBITMAP))
(72 72
"AOOOOOOOOOOOOOOOL@@@"
"COOOOOOOOOOOOOOON@@@"
"G@@@@@@@@@@@@@@@G@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"F@@@@@@@@@@@@@@@C@@@"
"G@@@@@@@@@@@@@@@G@@@"
"COOOOOOOOOOOOOOON@@@"
"AOOOOOOOOOOOOOOOL@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"F@@@DIBDL@@@@@@@@@@@"
"F@@@DIBDL@@@@@@@@@@@"
"F@@@DIBDL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"F@@@@@@@L@@@@@L@@@@@"
"F@@@@@@@L@@@@@N@@@@@"
"F@@@@@@@L@@@@@K@@@@@"
"GH@@@@@CLCOOOOIH@@@@"
"F@@@@@@@LGOOOOHL@@@@"
"F@@@@@@@LD@@@@@F@@@@"
"F@@@@@@@LD@@@@@C@@@@"
"GOOOOOOOLD@@@@@A@@@@"
"F@@@@@@@LD@@@@@B@@@@"
"F@@@@@@@LD@@@@@D@@@@"
"F@@@@@@@LGOOOOHH@@@@"
"GH@@@@@CL@@@@@I@@@@@"
"F@@@@@@@L@@@@@J@@@@@"
"F@@@@@@@L@@@@@L@@@@@"
"F@@@@@@@L@@@@@H@@@@@"
"GH@@@@@CL@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"GOOOOOOOL@@D@@@@@@@@"
"F@@@@@@@L@@L@@@@@@@@"
"F@@@@@@@L@AL@@@@@@@@"
"F@@@@@@@L@BL@@@@@@@@"
"GH@@@@@CL@DOOOOOH@@@"
"F@@@@@@@L@HOOOOOH@@@"
"F@@@@@@@LA@@@@@AH@@@"
"F@@@@@@@LB@@@@@AH@@@"
"GOOOOOOOLD@@@@@AH@@@"
"F@@@@@@@LB@@@@@AH@@@"
"F@@@D@@@LA@@@@@AH@@@"
"F@@@D@@@L@HOOOOO@@@@"
"F@@@@@@@L@DL@@@@@@@@"
"F@@@D@@@L@BL@@@@@@@@"
"F@@@D@@@L@AL@@@@@@@@"
"F@@@@@@@L@@H@@@@@@@@"
"F@@@D@@@L@@@@@@@@@@@"
"F@@@D@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"F@@@@@@@L@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@")
(RPAQ NETTRACEMASK (READBITMAP))
(72 72
"AOOOOOOOOOOOOOOOL@@@"
"COOOOOOOOOOOOOOON@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"GOOOOOOOOOOOOOOOO@@@"
"COOOOOOOOOOOOOOON@@@"
"AOOOOOOOOOOOOOOOL@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@L@@@@@"
"GOOOOOOOL@@@@@N@@@@@"
"GOOOOOOOL@@@@@O@@@@@"
"GOOOOOOOLCOOOOOH@@@@"
"GOOOOOOOLGOOOOOL@@@@"
"GOOOOOOOLGOOOOON@@@@"
"GOOOOOOOLGOOOOOO@@@@"
"GOOOOOOOLGOOOOOO@@@@"
"GOOOOOOOLGOOOOON@@@@"
"GOOOOOOOLGOOOOOL@@@@"
"GOOOOOOOLGOOOOOH@@@@"
"GOOOOOOOL@@@@@O@@@@@"
"GOOOOOOOL@@@@@N@@@@@"
"GOOOOOOOL@@@@@L@@@@@"
"GOOOOOOOL@@@@@H@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@D@@@@@@@@"
"GOOOOOOOL@@L@@@@@@@@"
"GOOOOOOOL@AL@@@@@@@@"
"GOOOOOOOL@CL@@@@@@@@"
"GOOOOOOOL@GOOOOOH@@@"
"GOOOOOOOL@OOOOOOH@@@"
"GOOOOOOOLAOOOOOOH@@@"
"GOOOOOOOLCOOOOOOH@@@"
"GOOOOOOOLGOOOOOOH@@@"
"GOOOOOOOLCOOOOOOH@@@"
"GOOOOOOOLAOOOOOOH@@@"
"GOOOOOOOL@OOOOOO@@@@"
"GOOOOOOOL@GL@@@@@@@@"
"GOOOOOOOL@CL@@@@@@@@"
"GOOOOOOOL@AL@@@@@@@@"
"GOOOOOOOL@@H@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@"
"GOOOOOOOL@@@@@@@@@@@")
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCP)
(DEFINEQ
(TCP.PRINT.SEGMENT
(LAMBDA (SEGMENT FILE NOFROMTOFLG DATAFLG) (* ejs: "20-Jun-85 16:06")
(PROG ((SEPR "")
(COMMA ",")
(SEQ (fetch TCP.SEQ of SEGMENT))
(LEN (\TCP.DATA.LENGTH SEGMENT))
(FLAGS (fetch TCP.CTRL of SEGMENT))
TOP BASE)
(if (NOT NOFROMTOFLG)
then (printout FILE "from " # (\IP.PRINT.ADDRESS (fetch TCP.SRC.ADDR of SEGMENT)
FILE)
":"
(fetch TCP.SRC.PORT of SEGMENT)
" to " # (\IP.PRINT.ADDRESS (fetch TCP.DST.ADDR of SEGMENT)
FILE)
":"
(fetch TCP.DST.PORT of SEGMENT)
T))
(printout FILE SEQ)
(SETQ TOP (SUB1 (IPLUS SEQ LEN (\TCP.SYN.OR.FIN FLAGS T))))
(if (\32BIT.LT SEQ TOP)
then (printout FILE ".." TOP))
(printout FILE "/" (fetch TCP.ACK of SEGMENT)
" [")
(if (BITTEST FLAGS \TCP.CTRL.URG)
then (printout FILE SEPR "URG")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.ACK)
then (printout FILE SEPR "ACK")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.PSH)
then (printout FILE SEPR "PSH")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.RST)
then (printout FILE SEPR "RST")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.SYN)
then (printout FILE SEPR "SYN")
(SETQ SEPR COMMA))
(if (BITTEST FLAGS \TCP.CTRL.FIN)
then (printout FILE SEPR "FIN")
(SETQ SEPR COMMA))
(printout FILE "] window = " (fetch TCP.WINDOW of SEGMENT)
" checksum = "
(fetch TCP.CHECKSUM of SEGMENT)
" length = " LEN T)
(if (IGREATERP (fetch TCP.DATA.OFFSET of SEGMENT)
\TCP.MIN.DATA.OFFSET)
then (\TCP.PRINT.OPTIONS SEGMENT FILE))
(if (AND DATAFLG (NOT (ZEROP LEN)))
then (printout FILE "Contents:")
(SETQ BASE (fetch TCP.CONTENTS of SEGMENT))
(for (I ← 0) to (SUB1 LEN) do (PRIN1 (CHARACTER (\GETBASEBYTE BASE I))
FILE))
(TERPRI FILE)))))
(\TCP.PRINT.OPTIONS
(LAMBDA (SEGMENT FILE) (* ejs: "20-Jun-85 13:22")
(* * Process the options in a TCP header)
(printout FILE "Options: ")
(bind (OPTIONBASE ←(fetch (TCPSEGMENT TCP.OPTIONS) of SEGMENT))
(OPTIONOFFSET ← 0)
OPTION eachtime (SETQ OPTION (\GETBASEBYTE OPTIONBASE OPTIONOFFSET))
until (EQ OPTION \TCPOPT.END)
do (SELECTC OPTION
(\TCPOPT.END (printout FILE "end")
(add OPTIONOFFSET 1))
(\TCPOPT.NOP (printout FILE "nop")
(add OPTIONOFFSET 1))
(\TCPOPT.MAXSEG (printout FILE "maxseg: " (LOGOR (LLSH (\GETBASEBYTE OPTIONBASE
(IPLUS
OPTIONOFFSET 2))
BITSPERBYTE)
(\GETBASEBYTE OPTIONBASE
(IPLUS OPTIONOFFSET
3))))
(add OPTIONOFFSET (\GETBASEBYTE OPTIONBASE (ADD1 OPTIONOFFSET))))
(RETURN))
(printout FILE " "))))
(\TCP.PRINT.ELAPSED.TIME
(LAMBDA (FILE) (* ecc "23-Apr-84 12:32")
(if (MEMB (QUOTE TIME)
TCPTRACEFLG)
then (PROG ((NOW (SETUPTIMER 0 NIL (QUOTE MILLISECONDS)))
INTERVAL)
(SETQ INTERVAL (IDIFFERENCE NOW (OR \TCP.ELAPSED.TIME NOW)))
(SETQ \TCP.ELAPSED.TIME NOW)
(printout FILE (IQUOTIENT INTERVAL 1000)
"." .I3..T (IMOD INTERVAL 1000)
" ")))))
(\TCP.PRINT.SEGMENT.QUEUE
(LAMBDA (CALLER QUEUE FILE) (* ecc "18-Apr-84 14:38")
(PROG ((SEGMENT (fetch SYSQUEUEHEAD of QUEUE)))
(printout FILE .TAB0 0 CALLER ":" T)
(while SEGMENT
do (TCP.PRINT.SEGMENT SEGMENT FILE T)
(SETQ SEGMENT (fetch QLINK of SEGMENT))))))
(TCPTRACE
(LAMBDA NIL (* ejs: " 7-Jun-85 12:40")
(PROG (MW)
(if (WINDOWP TCPTRACEFILE)
then (TOTOPW TCPTRACEFILE)
(RETURN))
(SETQ TCPTRACEFILE (CREATEW))
(WINDOWADDPROP TCPTRACEFILE (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW)
(if (EQ WINDOW TCPTRACEFILE)
then (SETQ TCPTRACEFLG NIL)
(SETQ TCPTRACEFILE T)))))
(DSPFONT (FONTCREATE (QUOTE GACHA)
8)
TCPTRACEFILE)
(DSPSCROLL T TCPTRACEFILE)
(if (NOT (type? MENU TCPTRACEMENU))
then (SETQ TCPTRACEMENU (create MENU
TITLE ← "TCP Trace Window"
ITEMS ←(QUOTE (("Incoming" RECV
"Trace incoming segments")
("Time" TIME
"Print elapsed time between events")
("Transitions" TRANSITION
"Trace connection state transitions")
("Outgoing" SEND
"Trace outgoing segments")
("Contents" CONTENTS
"Print contents of segments when tracing")
("Checksums" CHECKSUM
"Trace segments with bad checksums")))
MENUROWS ← 2
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION \TCPTRACEMENU.ITEMFN))))
(ATTACHMENU TCPTRACEMENU TCPTRACEFILE (QUOTE TOP))
(SETQ MW (CAR (WINDOWPROP TCPTRACEFILE (QUOTE ATTACHEDWINDOWS))))
(WINDOWADDPROP MW (QUOTE REPAINTFN)
(FUNCTION \TCPTRACEMENU.DISPLAYFN))
(WINDOWADDPROP MW (QUOTE RESHAPEFN)
(FUNCTION \TCPTRACEMENU.DISPLAYFN)))))
(\TCPTRACEMENU.ITEMFN
(LAMBDA (ITEM MENU MOUSEKEY) (* ecc "23-Apr-84 13:37")
(PROG (FLG)
(if (NULL ITEM)
then (RETURN))
(SETQ FLG (CADR ITEM))
(if (MEMB FLG TCPTRACEFLG)
then (SHADEITEM ITEM MENU WHITESHADE)
(SETQ TCPTRACEFLG (DREMOVE FLG TCPTRACEFLG))
else (SHADEITEM ITEM MENU LIGHTGRAYSHADE)
(SETQ TCPTRACEFLG (CONS FLG TCPTRACEFLG))))))
(\TCPTRACEMENU.DISPLAYFN
(LAMBDA (WINDOW) (* ecc "23-Apr-84 13:49")
(PROG ((MENU (CAR (WINDOWPROP WINDOW (QUOTE MENU)))))
(for ITEM in (fetch ITEMS of MENU) when (MEMB (CADR ITEM)
TCPTRACEFLG)
do (SHADEITEM ITEM MENU LIGHTGRAYSHADE)))))
(TCP.DRIBBLE
(LAMBDA (FORM FILE) (* ecc "18-Apr-84 14:39")
(if (NULL FILE)
then (SETQ FILE (QUOTE {DSK}TCP.Transcript)))
(RESETLST (RESETSAVE TCPTRACEFILE (OPENFILE FILE (QUOTE OUTPUT)))
(RESETSAVE TCPTRACEFLG T)
(RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
TCPTRACEFILE))
(PRINT FORM TCPTRACEFILE)
(TERPRI TCPTRACEFILE)
(EVAL FORM))))
)
(* miscellaneous TCP debugging)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TCP.LOSSAGE \TCP.LOOPBACK.QUEUE \TCP.LOOPBACK.EVENT \TCP.MASTER.SOCKET)
)
(RPAQ? \TCP.LOSSAGE NIL)
(RPAQ? \TCP.LOOPBACK.QUEUE NIL)
(RPAQ? \TCP.LOOPBACK.EVENT NIL)
(DEFINEQ
(TCP.DEBUG
(LAMBDA (ON?) (* edited: "21-May-84 13:56")
(if ON?
then (TCP.STOP)
(if (NOT (DEFINEDP (QUOTE REAL\IP\Transmit\Packet)))
then (MOVD (QUOTE IP\Transmit\Packet)
(QUOTE REAL\IP\Transmit\Packet)))
(MOVD (QUOTE DUMMY\IP\Transmit\Packet)
(QUOTE IP\Transmit\Packet))
(if (NULL \TCP.LOOPBACK.EVENT)
then (SETQ \TCP.LOOPBACK.EVENT (CREATE.EVENT)))
(if (NULL \TCP.LOOPBACK.QUEUE)
then (SETQ \TCP.LOOPBACK.QUEUE (create SYSQUEUE)))
(if (NOT (FIND.PROCESS (QUOTE TCP.WATCHER)))
then (ADD.PROCESS (QUOTE (TCP.WATCHER))))
else (if (DEFINEDP (QUOTE REAL\IP\Transmit\Packet))
then (MOVD (QUOTE REAL\IP\Transmit\Packet)
(QUOTE IP\Transmit\Packet)))
(DEL.PROCESS (QUOTE TCP.WATCHER))
(\TCP.INIT))))
(TCP.WATCHER
(LAMBDA NIL (* ecc " 3-May-84 11:10")
(* process to handle software loopback of segments)
(RESETSAVE NIL (LIST (FUNCTION \FLUSH.PACKET.QUEUE)
\TCP.LOOPBACK.QUEUE))
(bind SEGMENT
do (SETQ SEGMENT (\DEQUEUE \TCP.LOOPBACK.QUEUE))
(if SEGMENT
then (\TCP.PACKET.FILTER SEGMENT \TCP.PROTOCOL)
else (AWAIT.EVENT \TCP.LOOPBACK.EVENT)))))
(DUMMY\IP\Transmit\Packet
(LAMBDA (EPKT) (* ejs: " 5-Jan-85 16:57")
(* Software loopback.)
(PROG ((OK (NOT (AND \TCP.LOSSAGE (EQ (RAND 1 \TCP.LOSSAGE)
1))))
SEGMENT)
(CHECK (OR (NULL (fetch QLINK of EPKT))
(SHOULDNT "transmitting queued segment")))
(if OK
then (SETQ SEGMENT (\ALLOCATE.ETHERPACKET))
(\BLT (\IPDATABASE SEGMENT)
(\IPDATABASE EPKT)
(FOLDHI (ADD1 (fetch (IP IPTOTALLENGTH) of EPKT))
BYTESPERWORD)))
(if (EQ (fetch EPREQUEUE of EPKT)
(QUOTE FREE))
then (\RELEASE.ETHERPACKET EPKT)
elseif (type? SYSQUEUE (fetch EPREQUEUE of EPKT))
then (\ENQUEUE (fetch EPREQUEUE of EPKT)
EPKT))
(if OK
then (\ENQUEUE \TCP.LOOPBACK.QUEUE SEGMENT)
(NOTIFY.EVENT \TCP.LOOPBACK.EVENT)))))
(\TCP.CHECK.INPUT.QUEUE
(LAMBDA (TCB) (* edited: "22-May-84 15:32")
(* perform consistency check on the input queue)
(PROG ((QUEUE (fetch TCB.INPUT.QUEUE of TCB))
CURSEG SEQ1 TOP1 NEXTSEG SEQ2 TOP2)
(SETQ CURSEG (fetch SYSQUEUEHEAD of QUEUE))
LOOP(if (NULL CURSEG)
then (RETURN T))
(SETQ SEQ1 (fetch TCP.SEQ of CURSEG))
(SETQ TOP1 (IPLUS SEQ1 (fetch TCP.DATA.LENGTH of CURSEG)))
(if (AND (\32BIT.LEQ SEQ1 (fetch TCB.RCV.NXT of TCB))
(\32BIT.GT TOP1 (fetch TCB.RCV.NXT of TCB)))
then (SHOULDNT "incorrect RCV.NXT")
(RETURN NIL))
(SETQ NEXTSEG (fetch QLINK of CURSEG))
(if (NULL NEXTSEG)
then (RETURN T))
(SETQ SEQ2 (fetch TCP.SEQ of NEXTSEG))
(SETQ TOP2 (IPLUS SEQ2 (fetch TCP.DATA.LENGTH of NEXTSEG)))
(if (\32BIT.LT SEQ2 SEQ1)
then (SHOULDNT "input queue out of order")
(RETURN NIL))
(SETQ CURSEG NEXTSEG)
(GO LOOP))))
(TCP.FAUCET
(LAMBDA (HOST PORT NLINES) (* ejs: "20-Jun-85 12:20")
(PROG ((STREAM (if HOST
then (TCP.OPEN HOST (OR PORT \TCP.SINK.PORT)
NIL
(QUOTE ACTIVE)
(QUOTE OUTPUT))
else (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT)
(QUOTE PASSIVE)
(QUOTE OUTPUT)))))
(RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF)
STREAM))
(GENERATE.RANDOM.CHARS STREAM NLINES)))))
(TCP.ECHOTEST
(LAMBDA (HOST NLINES) (* ecc "14-May-84 17:07")
(PROG ((STREAM (TCP.OPEN HOST \TCP.ECHO.PORT NIL (QUOTE ACTIVE)
(QUOTE OUTPUT))))
(ADD.PROCESS (BQUOTE (TCP.COPYTOWINDOW , (TCP.OTHER.STREAM STREAM))
(QUOTE NAME)
"TCP Echo Tester"))
(GENERATE.RANDOM.CHARS STREAM NLINES)
(TCP.CLOSE.SENDER STREAM))))
(TCP.QUIET.ECHOTEST
(LAMBDA (HOST NLINES) (* ecc "25-May-84 13:24")
(PROG ((STREAM (TCP.OPEN HOST \TCP.ECHO.PORT NIL (QUOTE ACTIVE)
(QUOTE OUTPUT))))
(ADD.PROCESS (BQUOTE (\TCP.SINK.PROCESS , (TCP.OTHER.STREAM STREAM))
(QUOTE NAME)
"TCP Echo Tester"))
(GENERATE.RANDOM.CHARS STREAM NLINES)
(TCP.CLOSE.SENDER STREAM))))
(TCP.SINKTEST
(LAMBDA (PORT VISIBLEFLG) (* ecc "14-May-84 17:28")
(TCP.COPYTOWINDOW (TCP.OPEN NIL NIL (OR PORT \TCP.SINK.PORT)
(QUOTE PASSIVE)
(QUOTE INPUT))
VISIBLEFLG)))
(GENERATE.RANDOM.CHARS
(LAMBDA (STREAM NLINES) (* ejs: " 7-Jun-85 12:34")
(bind (N ← 0) while (NEQ N NLINES)
do (add N 1)
(printout STREAM "This is byte number " (GETFILEPTR STREAM)
"." T)
(BLOCK))))
(COPYBYTESTREAM
(LAMBDA (INSTR OUTSTR VISIBLEFLG) (* ejs: " 7-Jun-85 13:44")
(if VISIBLEFLG
then (bind (N ← 1)
(C ← NIL) while (OPENP INSTR (QUOTE INPUT))
do (SETQ C (BIN INSTR))
(printout OUTSTR N ": " C)
(if (AND (ILEQ C 127)
(IGEQ C 32))
then (printout OUTSTR " (" # (BOUT OUTSTR C)
")"))
(TERPRI OUTSTR)
(add N 1))
else (bind C while (AND (OPENP INSTR (QUOTE INPUT))
(NOT (EOFP INSTR)))
do (COND
((SETQ C (BIN INSTR))
(BOUT OUTSTR C)))))))
(TCP.COPYTOWINDOW
(LAMBDA (STREAM VISIBLEFLG) (* ejs: "13-Apr-85 16:01")
(RESETLST (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
STREAM))
(PROG ((WIN (CREATEW NIL "Stream Output")))
(DSPSCROLL T WIN)
(COPYBYTESTREAM STREAM WIN VISIBLEFLG)
(printout WIN .TAB0 0 "[End of stream]")))))
(TEST.CHECKSUM
(LAMBDA (STR STR2) (* ecc "24-Apr-84 13:11")
(if (NULL STR2)
then (\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE) of STR)
(fetch (STRINGP OFFST) of STR))
(fetch (STRINGP LENGTH) of STR))
else (\16BIT.COMPLEMENT (\16BIT.1C.PLUS (\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE)
of STR)
(fetch (STRINGP OFFST)
of STR))
(fetch (STRINGP LENGTH)
of STR)
T)
(\COMPUTE.CHECKSUM (\ADDBASE (fetch (STRINGP BASE)
of STR2)
(fetch (STRINGP OFFST)
of STR2))
(fetch (STRINGP LENGTH)
of STR2)
T))))))
)
(PUTPROPS TCPDEBUG COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1584 4024 (TCP.SINK.SERVER 1594 . 2009) (TCP.TELNET.SERVER 2011 . 2611) (
\TCP.SINK.PROCESS 2613 . 2939) (TCP.ECHO.SERVER 2941 . 3403) (\TCP.ECHO.PROCESS 3405 . 4022)) (7961
15328 (TCP.PRINT.SEGMENT 7971 . 10289) (\TCP.PRINT.OPTIONS 10291 . 11304) (\TCP.PRINT.ELAPSED.TIME
11306 . 11823) (\TCP.PRINT.SEGMENT.QUEUE 11825 . 12195) (TCPTRACE 12197 . 13946) (\TCPTRACEMENU.ITEMFN
13948 . 14457) (\TCPTRACEMENU.DISPLAYFN 14459 . 14830) (TCP.DRIBBLE 14832 . 15326)) (15595 23536 (
TCP.DEBUG 15605 . 16609) (TCP.WATCHER 16611 . 17157) (DUMMY\IP\Transmit\Packet 17159 . 18237) (
\TCP.CHECK.INPUT.QUEUE 18239 . 19529) (TCP.FAUCET 19531 . 20081) (TCP.ECHOTEST 20083 . 20547) (
TCP.QUIET.ECHOTEST 20549 . 21020) (TCP.SINKTEST 21022 . 21276) (GENERATE.RANDOM.CHARS 21278 . 21573) (
COPYBYTESTREAM 21575 . 22265) (TCP.COPYTOWINDOW 22267 . 22653) (TEST.CHECKSUM 22655 . 23534)))))
STOP