(FILECREATED " 2-Feb-86 12:00:23" {ERIS}<SCHOEN>TCP>TCPTFTP.;3 38057
changes to: (VARS TCPTFTPCOMS TFTPOPCODES)
(FNS \TFTP.ACKNOWLEDGE \TFTP.CLOSEFILE \TFTP.EOFP \TFTP.ERROR \TFTP.GETNEXTBUFFER
\TFTP.INIT \TFTP.INPUT.BUFFER \TFTP.OPENFILE \TFTP.READP \TFTP.SEND.ERROR
\TFTP.SETUP TFTP.SERVER.PROCESS \TFTP.GET.FILE \TFTP.SEND.FILE TFTP.SERVER
TFTP.GET TFTP.PUT PRINTTFTP \TFTP.PRINT.ACK \TFTP.PRINT.DATA
\TFTP.PRINT.ERROR \TFTP.PRINT.REQUEST)
previous date: "15-Sep-85 17:56:51" {ERIS}<SCHOEN>TCP>TCPTFTP.;2)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPTFTPCOMS)
(RPAQQ TCPTFTPCOMS ((COMS (* Trivial File Transfer Protocol)
(INITVARS (\TFTP.DEVICE)
(TFTP.MAXRETRIES 20))
(GLOBALVARS \TFTP.DEVICE TFTP.MAXRETRIES)
(RECORDS TFTPCON TFTP TFTPSTREAM)
(CONSTANTS (\TFTPOVLEN 4)
(\TFTP.SOCKET 69))
(CONSTANTS * TFTPOPCODES)
(INITVARS (TFTP.MAXRETRIES 20))
(FNS \TFTP.ACKNOWLEDGE \TFTP.CLOSEFILE \TFTP.EOFP \TFTP.ERROR
\TFTP.GETNEXTBUFFER \TFTP.INIT \TFTP.INPUT.BUFFER \TFTP.OPENFILE
\TFTP.READP \TFTP.SEND.ERROR \TFTP.SETUP)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCPUDP))
(COMS (* TFTP Server functions)
(INITVARS (\TFTP.SERVER.CONNECTIONS))
(GLOBALVARS \TFTP.SERVER.CONNECTIONS)
(FNS TFTP.SERVER.PROCESS \TFTP.GET.FILE \TFTP.SEND.FILE))
(COMS (* User functions)
(FNS TFTP.SERVER TFTP.GET TFTP.PUT))
(COMS (* Tracing functions)
(FNS PRINTTFTP \TFTP.PRINT.ACK \TFTP.PRINT.DATA \TFTP.PRINT.ERROR
\TFTP.PRINT.REQUEST))
(P (\TFTP.INIT))))
(* Trivial File Transfer Protocol)
(RPAQ? \TFTP.DEVICE )
(RPAQ? TFTP.MAXRETRIES 20)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TFTP.DEVICE TFTP.MAXRETRIES)
)
[DECLARE: EVAL@COMPILE
(RECORD TFTPCON (UDPSOCKET DESTSOCKET STREAM HOST))
(ACCESSFNS TFTP ((TFTPBASE (fetch (UDP UDPCONTENTS) of DATUM)))
(BLOCKRECORD TFTPBASE ((OPCODE WORD)
(BLOCK# WORD)))
(ACCESSFNS TFTP ((TFTPCONTENTS (\ADDBASE (fetch (UDP UDPCONTENTS)
of DATUM)
(FOLDHI \TFTPOVLEN BYTESPERWORD)))))
(BLOCKRECORD TFTPBASE ((NIL WORD)
(ERRORCODE WORD))))
(ACCESSFNS TFTPSTREAM ((TFTPCON (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(LASTPACKETIN (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \TFTPOVLEN 4)
(RPAQQ \TFTP.SOCKET 69)
(CONSTANTS (\TFTPOVLEN 4)
(\TFTP.SOCKET 69))
)
(RPAQQ TFTPOPCODES ((\TFTP.RRQ 1)
(\TFTP.WRQ 2)
(\TFTP.DATA 3)
(\TFTP.ACK 4)
(\TFTP.ERROR 5)))
(DECLARE: EVAL@COMPILE
(RPAQQ \TFTP.RRQ 1)
(RPAQQ \TFTP.WRQ 2)
(RPAQQ \TFTP.DATA 3)
(RPAQQ \TFTP.ACK 4)
(RPAQQ \TFTP.ERROR 5)
(CONSTANTS (\TFTP.RRQ 1)
(\TFTP.WRQ 2)
(\TFTP.DATA 3)
(\TFTP.ACK 4)
(\TFTP.ERROR 5))
)
(RPAQ? TFTP.MAXRETRIES 20)
(DEFINEQ
(\TFTP.ACKNOWLEDGE
(LAMBDA (STREAM ACK#) (* MPL " 2-Jun-85 17:07")
(LET ((TFTPCON (fetch (TFTPSTREAM TFTPCON) of STREAM))
(ACK (\ALLOCATE.ETHERPACKET)))
(\TFTP.SETUP ACK TFTPCON \TFTP.ACK (QUOTE FREE))
(UDP.APPEND.WORD ACK ACK#)
(UDP.SEND (fetch (TFTPCON UDPSOCKET) of TFTPCON)
ACK)
(BLOCK)
(COND
((AND (EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(fetch (TFTPSTREAM LASTPACKETIN) of STREAM))
(UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)))))))
(\TFTP.CLOSEFILE
(LAMBDA (STREAM) (* ejs: " 9-Feb-85 23:47")
(LET ((TFTPCON (fetch (TFTPSTREAM TFTPCON) of STREAM)))
(SELECTQ (fetch (STREAM ACCESS) of STREAM)
(OUTPUT (COND
((AND (fetch (STREAM CBUFPTR) of STREAM)
(NOT (fetch (TFTPSTREAM LASTPACKETIN) of STREAM)))
(\TFTP.GETNEXTBUFFER STREAM (QUOTE WRITE)))))
NIL)
(UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)
T)
(replace (STREAM ACCESS) of STREAM with NIL)
STREAM)))
(\TFTP.EOFP
(LAMBDA (STREAM) (* ejs: " 9-Feb-85 21:23")
(OR (NULL (fetch (STREAM CBUFPTR) of STREAM))
(AND (fetch (TFTPSTREAM LASTPACKETIN) of STREAM)
(EQ (fetch (STREAM COFFSET) of STREAM)
(fetch (STREAM CBUFSIZE) of STREAM))))))
(\TFTP.ERROR
(LAMBDA (TFTP TFTPCON) (* ejs: " 9-Feb-85 19:04")
(* * Called upon receipt of error packet in TFTP stream)
(LET ((ERRORSTRING (ALLOCSTRING (IDIFFERENCE (fetch (UDP UDPLENGTH) of TFTP)
(CONSTANT (IPLUS \UDPOVLEN (ADD1
\TFTPOVLEN)))))
))
(\MOVEBYTES (fetch (TFTP TFTPCONTENTS) of TFTP)
0
(fetch (STRINGP BASE) of ERRORSTRING)
(fetch (STRINGP OFFST) of ERRORSTRING)
(fetch (STRINGP LENGTH) of ERRORSTRING))
(ERROR (CONCAT "TFTP error message: " ERRORSTRING " for code")
(fetch (TFTP ERRORCODE) of TFTP)))))
(\TFTP.GETNEXTBUFFER
(LAMBDA (STREAM WHATFOR NOERRORFLG) (* MPL " 2-Jun-85 19:48")
(DECLARE (GLOBALVARS TFTP.MAXRETRIES))
(LET* ((TFTPCON (fetch (TFTPSTREAM TFTPCON) of STREAM))
(IPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON))
(RETRYCOUNT 0)
(BUFFER (fetch (STREAM CBUFPTR) of STREAM))
UDP)
(SELECTQ
WHATFOR
(READ
(COND
((fetch (TFTPSTREAM LASTPACKETIN) of STREAM)
(replace (STREAM ACCESS) of STREAM with NIL)
(\RELEASE.ETHERPACKET (fetch (STREAM CBUFPTR) of STREAM))
(replace (STREAM CBUFPTR) of STREAM with NIL)
(COND
(NOERRORFLG NIL)
(T (\EOF.ACTION STREAM))))
(T (PROG ((NEXT# (COND
(BUFFER (ADD1 (fetch (TFTP BLOCK#) of BUFFER)))
(T 1))))
LP (for I from 1 to TFTP.MAXRETRIES until UDP
do (SETQ UDP (UDP.GET IPSOCKET \ETHERTIMEOUT))
(COND
((NOT UDP)
(\TFTP.ACKNOWLEDGE STREAM (SUB1 NEXT#)))))
(COND
(UDP (COND
((EQ (fetch (TFTP OPCODE) of UDP)
\TFTP.DATA)
(COND
((IEQP (fetch (TFTP BLOCK#) of UDP)
NEXT#)
(\TFTP.INPUT.BUFFER STREAM UDP)
(\TFTP.ACKNOWLEDGE STREAM NEXT#)
(RETURN T))
((ILESSP (fetch (TFTP BLOCK#) of UDP)
NEXT#)
(COND
(IPTRACEFLG (COND
((EQ IPTRACEFLG T)
(printout IPTRACEFILE
"Retransmitting ACK for block "
(SUB1 NEXT#)
T))
(T (PRIN1 "R" IPTRACEFILE)))))
(\TFTP.ACKNOWLEDGE STREAM (SUB1 NEXT#))
(\RELEASE.ETHERPACKET UDP)
(SETQ UDP NIL)
(COND
((EQ (add RETRYCOUNT 1)
TFTP.MAXRETRIES)
(\TFTP.SEND.ERROR TFTPCON 0
"Timeout awaiting next data packet; aborting")
(replace (STREAM STRMBINFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(ERROR "Timeout awaiting next data packet; aborting"
STREAM))
(T (GO LP))))
(T (\TFTP.SEND.ERROR TFTPCON 0
"Protocol error: Block # too high. Aborting...")
(replace (STREAM STRMBINFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(ERROR "Protocol error: Block # too high. Aborting..."
STREAM))))
((EQ (fetch (TFTP OPCODE) of UDP)
\TFTP.ERROR)
(replace (STREAM STRMBINFN) of STREAM
with (FUNCTION STREAM.NOT.OPEN))
(\TFTP.ERROR UDP TFTPCON))
(T (\TFTP.SEND.ERROR TFTPCON 0
(CONCAT
"Protocol error: Illegal TFTP opcode, expected DATA but got "
(SELECTC (fetch (TFTP OPCODE)
of UDP)
(\TFTP.RRQ "read request.")
(\TFTP.WRQ "write request.")
(\TFTP.ACK "ack.")
(CONCAT
"unknown type "
(fetch (TFTP OPCODE)
of UDP)
"."))))
(replace (STREAM STRMBINFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(ERROR "Illegal TFTP opcode rec'd" STREAM))))
(T (\TFTP.SEND.ERROR TFTPCON 0
"Timeout awaiting next data packet; aborting")
(replace (STREAM STRMBINFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(ERROR "Timeout awaiting next data packet; aborting" STREAM)))))))
(WRITE (COND
((fetch (TFTPSTREAM LASTPACKETIN) of STREAM)
(replace (STREAM ACCESS) of STREAM with NIL)
(COND
(NOERRORFLG NIL)
(T (\EOF.ACTION STREAM))))
(T (PROG (ACK# NBYTES)
(SETQ ACK# (fetch (TFTP BLOCK#) of BUFFER))
(SETQ NBYTES (IDIFFERENCE
(fetch (STREAM COFFSET) of STREAM)
(UNFOLD (IDIFFERENCE (\LOLOC (fetch (TFTP TFTPCONTENTS)
of BUFFER))
(\LOLOC BUFFER))
BYTESPERWORD)))
(replace (IP IPTOTALLENGTH) of BUFFER
with (IPLUS NBYTES (CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN
\IPOVLEN))))
(replace (UDP UDPLENGTH) of BUFFER
with (IPLUS NBYTES (CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN)))
)
(COND
((ILESSP NBYTES 512)
(replace (TFTPSTREAM LASTPACKETIN) of STREAM with T)))
LP (for I from 1 to TFTP.MAXRETRIES until UDP
do (SETQ UDP (UDP.EXCHANGE IPSOCKET BUFFER)))
(COND
((AND UDP (EQ (fetch (TFTP OPCODE) of UDP)
\TFTP.ACK))
(COND
((EQ (fetch (TFTP BLOCK#) of UDP)
ACK#)
(COND
((EQ NBYTES 512)
(\TFTP.SETUP UDP TFTPCON \TFTP.DATA NIL)
(UDP.APPEND.WORD UDP (ADD1 ACK#))
(replace (UDP UDPLENGTH) of UDP
with (CONSTANT (IPLUS 512 \UDPOVLEN \TFTPOVLEN)))
(\TFTP.INPUT.BUFFER STREAM UDP))
(T (replace (STREAM CBUFPTR) of STREAM with NIL)
(replace (STREAM ACCESS) of STREAM with NIL)
(UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET)
of TFTPCON))))
(RETURN T))
((ILESSP (fetch (TFTP BLOCK#) of UDP)
ACK#)
(COND
(IPTRACEFLG (COND
((EQ IPTRACEFLG T)
(printout IPTRACEFILE
"TFTP retransmission on block# "
ACK# T))
(T (PRIN1 "R" IPTRACEFILE)))))
(\RELEASE.ETHERPACKET UDP)
(SETQ UDP NIL)
(COND
((EQ (add RETRYCOUNT 1)
TFTP.MAXRETRIES)
(\TFTP.SEND.ERROR TFTPCON 0
"Timeout awaiting acknowledgement. Aborting...")
(replace (STREAM STRMBOUTFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(COND
(NOERRORFLG NIL)
(T (\EOF.ACTION STREAM))))
(T (GO LP))))
(T (\TFTP.SEND.ERROR TFTPCON 0
"Protocol error: Block # too high. Aborting...")
(replace (STREAM STRMBOUTFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(COND
(NOERRORFLG NIL)
(T (\EOF.ACTION STREAM))))))
((AND UDP (EQ (fetch (TFTP OPCODE) of UDP)
\TFTP.ERROR))
(replace (STREAM STRMBOUTFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(\TFTP.ERROR UDP TFTPCON))
(UDP (\TFTP.SEND.ERROR TFTPCON 0
(CONCAT
"Protocol error: Illegal TFTP opcode, expected ACK but got "
(SELECTC (fetch (TFTP OPCODE)
of UDP)
(\TFTP.RRQ "read request.")
(\TFTP.WRQ "write request.")
(\TFTP.DATA "data.")
(CONCAT
"unknown type "
(fetch (TFTP OPCODE)
of UDP)
"."))))
(replace (STREAM STRMBOUTFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(COND
(NOERRORFLG NIL)
(T (\EOF.ACTION STREAM))))
(T (\TFTP.SEND.ERROR TFTPCON 0 "Protocol error, aborting...")
(replace (STREAM STRMBOUTFN) of STREAM
with (FUNCTION \STREAM.NOT.OPEN))
(COND
(NOERRORFLG NIL)
(T (\EOF.ACTION STREAM)))))))))
(ERROR "Illegal ACCESS" WHATFOR)))))
(\TFTP.INIT
(LAMBDA NIL (* ejs: " 2-Feb-86 12:00")
(DECLARE (GLOBALVARS \TFTP.DEVICE))
(OR \TFTP.DEVICE
(\DEFINEDEVICE NIL
(SETQ \TFTP.DEVICE
(create FDEV
FDBINABLE ← T
FDBOUTABLE ← T
NODIRECTORIES ← T
RESETABLE ← NIL
RANDOMACCESSP ← NIL
BUFFERED ← T
PAGEMAPPED ← NIL
DEVICENAME ← (QUOTE TFTP)
HOSTNAMEP ← (FUNCTION NILL)
EVENTFN ← (FUNCTION NILL)
FORCEOUTPUT ← (FUNCTION NILL)
BIN ← (FUNCTION \BUFFERED.BIN)
BOUT ← (FUNCTION \BUFFERED.BOUT)
GETNEXTBUFFER ← (FUNCTION \TFTP.GETNEXTBUFFER)
READP ← (FUNCTION \TFTP.READP)
EOFP ← (FUNCTION \TFTP.EOFP)
CLOSEFILE ← (FUNCTION \TFTP.CLOSEFILE)))))))
(\TFTP.INPUT.BUFFER
(LAMBDA (STREAM UDP) (* ejs: " 9-Feb-85 20:51")
(* * Sets up the fields of the stream necessary to support buffered operation, with UDP as the next packet)
(LET ((OFFSET (UNFOLD (IDIFFERENCE (\LOLOC (fetch (TFTP TFTPCONTENTS) of UDP))
(\LOLOC UDP))
BYTESPERWORD))
(LENGTH (IDIFFERENCE (fetch (UDP UDPLENGTH) of UDP)
(CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN)))))
(COND
((type? ETHERPACKET (fetch (STREAM CBUFPTR) of STREAM))
(\RELEASE.ETHERPACKET (fetch (STREAM CBUFPTR) of STREAM))))
(replace (STREAM CBUFPTR) of STREAM with UDP)
(replace (STREAM COFFSET) of STREAM with OFFSET)
(replace (STREAM CBUFSIZE) of STREAM with (replace (STREAM CBUFMAXSIZE)
of STREAM with (IPLUS OFFSET LENGTH)
))
(COND
((ILESSP LENGTH 512)
(replace (TFTPSTREAM LASTPACKETIN) of STREAM with T))))))
(\TFTP.OPENFILE
(LAMBDA (FILENAME ACCESS RECOG PARAMETERS) (* ejs: "15-Sep-85 17:48")
(* * Open a file using TFTP)
(LET* ((HOSTNAME (FILENAMEFIELD FILENAME (QUOTE HOST)))
(DEVICE (COND
((DODIP.HOSTP HOSTNAME)
(create FDEV using \TFTP.DEVICE DEVICENAME ← HOSTNAME))
(T (ERROR "Unknown IP host: " HOSTNAME))))
(STREAM (create STREAM
DEVICE ← DEVICE))
(TFTPCON (replace (FDEV DEVICEINFO) of DEVICE with (create TFTPCON
UDPSOCKET ← (
UDP.OPEN.SOCKET)
STREAM ← STREAM
HOST ← (DODIP.HOSTP
HOSTNAME))))
(UDP (\ALLOCATE.ETHERPACKET))
UDPIN)
(RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (SOCKET)
(AND RESETSTATE (UDP.CLOSE.SOCKET SOCKET T))))
(fetch (TFTPCON UDPSOCKET) of TFTPCON)))
(replace (TFTPCON DESTSOCKET) of TFTPCON with \TFTP.SOCKET)
(\TFTP.SETUP UDP TFTPCON (SELECTQ ACCESS
(INPUT \TFTP.RRQ)
(OUTPUT \TFTP.WRQ)
(ERROR "ACCESS must be INPUT or OUTPUT"
ACCESS)))
(UDP.APPEND.STRING UDP (SUBATOM FILENAME (STRPOS (QUOTE })
FILENAME NIL NIL NIL T)))
(UDP.APPEND.BYTE UDP 0)
(UDP.APPEND.STRING UDP (COND
((EQ (CADR (FASSOC (QUOTE TYPE)
PARAMETERS))
(QUOTE BINARY))
"OCTET")
(T "NETASCII")))
(UDP.APPEND.BYTE UDP 0)
(for I from 1 to \MAXETHERTRIES do (SETQ UDPIN
(UDP.EXCHANGE
(fetch (TFTPCON UDPSOCKET)
of TFTPCON)
UDP))
until UDPIN finally (\RELEASE.ETHERPACKET UDP))
(COND
(UDPIN (SELECTC (fetch (TFTP OPCODE) of UDPIN)
(\TFTP.ACK (COND
((AND (EQ ACCESS (QUOTE OUTPUT))
(EQ (fetch (TFTP BLOCK#)
of UDPIN)
0))
(replace (TFTPSTREAM TFTPCON)
of STREAM with TFTPCON)
(replace (STREAM ACCESS) of STREAM
with ACCESS)
(replace (STREAM FULLFILENAME)
of STREAM with FILENAME)
(replace (TFTPCON DESTSOCKET)
of TFTPCON with (fetch
(UDP UDPSOURCEPORT)
of UDPIN))
(\TFTP.SETUP UDPIN TFTPCON \TFTP.DATA NIL)
(UDP.APPEND.WORD UDPIN 1)
(add (fetch (UDP UDPLENGTH)
of UDPIN)
512)
(\TFTP.INPUT.BUFFER STREAM UDPIN)
STREAM)))
(\TFTP.DATA (COND
((AND (EQ ACCESS (QUOTE INPUT))
(EQ (fetch (TFTP BLOCK#)
of UDPIN)
1))
(replace (TFTPSTREAM TFTPCON)
of STREAM with TFTPCON)
(replace (STREAM ACCESS) of STREAM
with ACCESS)
(replace (STREAM FULLFILENAME)
of STREAM with FILENAME)
(replace (TFTPCON DESTSOCKET)
of TFTPCON with (fetch
(UDP UDPSOURCEPORT)
of UDPIN))
(\TFTP.INPUT.BUFFER STREAM UDPIN)
(\TFTP.ACKNOWLEDGE STREAM 1)
STREAM)))
(\TFTP.ERROR (\TFTP.ERROR UDPIN))
(ERROR "Unknown TFTP opcode" (fetch (TFTP OPCODE)
of UDPIN))))
(T (UDP.CLOSE.SOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON)
T)
NIL))))))
(\TFTP.READP
(LAMBDA (STREAM) (* ejs: " 9-Feb-85 20:48")
(ILESSP (fetch (STREAM COFFSET) of STREAM)
(fetch (STREAM CBUFSIZE) of STREAM))))
(\TFTP.SEND.ERROR
(LAMBDA (TFTPCON ERRORCODE ERRORSTRING) (* ejs: " 1-Jun-85 15:34")
(* * Send an error back to the requestor)
(LET ((TFTP (\ALLOCATE.ETHERPACKET)))
(\TFTP.SETUP TFTP TFTPCON \TFTP.ERROR NIL)
(UDP.APPEND.WORD TFTP ERRORCODE)
(UDP.APPEND.STRING TFTP ERRORSTRING)
(UDP.APPEND.BYTE TFTP 0)
(UDP.SEND (fetch (TFTPCON UDPSOCKET) of TFTPCON)
TFTP))))
(\TFTP.SETUP
(LAMBDA (UDP TFTPCON OPCODE REQUEUE) (* ejs: " 9-Feb-85 20:32")
(UDP.SETUP UDP (fetch (TFTPCON HOST) of TFTPCON)
(fetch (TFTPCON DESTSOCKET) of TFTPCON)
0
(fetch (TFTPCON UDPSOCKET) of TFTPCON))
(replace EPREQUEUE of UDP with REQUEUE)
(UDP.APPEND.WORD UDP OPCODE)))
)
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCPUDP)
(* TFTP Server functions)
(RPAQ? \TFTP.SERVER.CONNECTIONS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TFTP.SERVER.CONNECTIONS)
)
(DEFINEQ
(TFTP.SERVER.PROCESS
(LAMBDA (LOGSTREAM) (* ejs: " 3-Jun-85 01:52")
(* * A server for TFTP file transfer)
(DECLARE (GLOBALVARS \TFTP.SERVER.CONNECTIONS))
(LET* ((DEVICE (create FDEV using \TFTP.DEVICE DEVICENAME ← (QUOTE TFTPSERVER)))
(SERVERSOCKET (UDP.OPEN.SOCKET \TFTP.SOCKET T))
CONNECTION)
(COND
((NULL LOGSTREAM)
(COND
((NOT (HASTTYWINDOWP))
(\CREATE.TTYDISPLAYSTREAM)))
(SETQ LOGSTREAM (TTYDISPLAYSTREAM))))
(SETQ \TFTP.SERVER.CONNECTIONS NIL)
(COND
(SERVERSOCKET
(RESETLST
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (SOCKET)
(UDP.CLOSE.SOCKET SOCKET T)))
SERVERSOCKET))
(while T
do (LET ((UDP (UDP.GET SERVERSOCKET T)))
(SETQ CONNECTION (CONS (fetch (IP IPSOURCEADDRESS) of UDP)
(fetch (UDP UDPSOURCEPORT) of UDP)))
(COND
((NOT (MEMBER CONNECTION \TFTP.SERVER.CONNECTIONS))
(push \TFTP.SERVER.CONNECTIONS CONNECTION)
(SELECTC (fetch (TFTP OPCODE) of UDP)
(\TFTP.RRQ (ADD.PROCESS
(BQUOTE (\TFTP.SEND.FILE
, UDP
(QUOTE ,
(create TFTPCON
UDPSOCKET ←
(
UDP.OPEN.SOCKET)))
, DEVICE , LOGSTREAM))))
(\TFTP.WRQ (ADD.PROCESS
(BQUOTE (\TFTP.GET.FILE
, UDP
(QUOTE ,
(create TFTPCON
UDPSOCKET ←
(
UDP.OPEN.SOCKET)))
, DEVICE , LOGSTREAM))))
(PROGN (printout LOGSTREAM
"TFTP Server: Unexpected opcode "
(fetch (TFTP OPCODE) of UDP)
T)
(SETQ \TFTP.SERVER.CONNECTIONS
(DREMOVE CONNECTION \TFTP.SERVER.CONNECTIONS)
)
(\RELEASE.ETHERPACKET UDP))))
(T (* Duplicate request)
(\RELEASE.ETHERPACKET UDP)))))))))))
(\TFTP.GET.FILE
(LAMBDA (UDP TFTPCON DEVICE LOGSTREAM) (* ejs: "15-Sep-85 17:55")
(* * Try to start receiving a file to the requestor as directed by the contents of the received UDP packet)
(DECLARE (GLOBALVARS \TFTP.SERVER.CONNECTIONS))
(LET* ((FILENAMELENGTH (for I from BYTESPERWORD until (EQ 0 (\GETBASEBYTE
(fetch (TFTP TFTPBASE)
of UDP)
I))
finally (RETURN (IDIFFERENCE I BYTESPERWORD))))
(FILENAME (ALLOCSTRING FILENAMELENGTH))
(MODELENGTH (for I from (IPLUS BYTESPERWORD FILENAMELENGTH 1)
until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of UDP)
I))
finally (RETURN (IDIFFERENCE I (IPLUS BYTESPERWORD FILENAMELENGTH 1)
))))
(MODE (ALLOCSTRING MODELENGTH))
(HOST (fetch (IP IPSOURCEADDRESS) of UDP))
FILE TYPE TFTPSTREAM)
(RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (TFTPCON)
(LET* ((UDPSOCKET (fetch (TFTPCON UDPSOCKET)
of TFTPCON))
(CONNECTION (CONS (fetch (TFTPCON
HOST)
of TFTPCON)
(fetch (UDP
UDPDESTPORT)
of UDPSOCKET))))
(SETQ \TFTP.SERVER.CONNECTIONS
(REMOVE CONNECTION
\TFTP.SERVER.CONNECTIONS))
(AND RESETSTATE (UDP.CLOSE.SOCKET
UDPSOCKET T)))
))
TFTPCON))
(replace (TFTPCON DESTSOCKET) of TFTPCON with (fetch (UDP UDPSOURCEPORT)
of UDP))
(replace (TFTPCON HOST) of TFTPCON with HOST)
(* * Read the filename out of the packet)
(\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP)
BYTESPERWORD
(fetch (STRINGP BASE) of FILENAME)
(fetch (STRINGP OFFST) of FILENAME)
FILENAMELENGTH)
(* * Read the mode out of the packet)
(\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP)
(IPLUS BYTESPERWORD FILENAMELENGTH 1)
(fetch (STRINGP BASE) of MODE)
(fetch (STRINGP OFFST) of MODE)
MODELENGTH)
(SETQ MODE (U-CASE MODE))
(printout LOGSTREAM "TFTP Server: Will attempt to receive " FILENAME " in "
MODE " mode to host " (\IP.ADDRESS.TO.STRING HOST)
T)
(COND
((AND (SETQ TYPE (COND
((STREQUAL MODE "NETASCII")
(QUOTE TEXT))
((STREQUAL MODE "OCTET")
(QUOTE BINARY))
(T (\TFTP.SEND.ERROR TFTPCON 0 (CONCAT
"Unknown transfer type--"
MODE))
NIL)))
(SETQ FILE
(LET ((OUTSTREAM (CAR (NLSETQ
(OPENSTREAM FILENAME (QUOTE OUTPUT)
(QUOTE NEW)
(LIST
(LIST (QUOTE TYPE)
TYPE)))))))
(COND
((NULL OUTSTREAM)
(\TFTP.SEND.ERROR TFTPCON 1 (CONCAT
"Can't open file--"
FILENAME))
NIL)
(T OUTSTREAM)))))
(* * Mode is OK, and file is open for input. Open the TFTP stream back to the requestor)
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (FILE)
(COND
(RESETSTATE (CLOSEF? FILE)
(DELFILE (FULLNAME FILE))))))
FILE))
(SETQ TFTPSTREAM (create STREAM
DEVICE ← DEVICE))
(replace (TFTPCON STREAM) of TFTPCON with TFTPSTREAM)
(replace (STREAM ACCESS) of TFTPSTREAM with (QUOTE INPUT))
(replace (TFTPSTREAM TFTPCON) of TFTPSTREAM with TFTPCON)
(* * Send the first acknowledgement)
(\TFTP.ACKNOWLEDGE TFTPSTREAM 0)
(\RELEASE.ETHERPACKET UDP)
(printout LOGSTREAM "TFTP Server: receiving " (FULLNAME FILE)
T)
(COND
((NLSETQ (COPYBYTES TFTPSTREAM FILE))
(printout LOGSTREAM "TFTP Server: Done receiving " (FULLNAME FILE)
T)
(CLOSEF? FILE))
(T (printout LOGSTREAM "TFTP Server: Failed to receive " (FULLNAME
FILE)
T)
(DELFILE (FULLNAME (CLOSEF? FILE))))))
(T (printout LOGSTREAM "TFTP Server: Failed to receive " (FULLNAME FILE)
T)
(\RELEASE.ETHERPACKET UDP)
NIL))))))
(\TFTP.SEND.FILE
(LAMBDA (UDP TFTPCON DEVICE LOGSTREAM) (* ejs: "15-Sep-85 17:53")
(* * Try to start sending a file to the requestor as directed by the contents of the received UDP packet)
(DECLARE (GLOBALVARS \TFTP.SERVER.CONNECTIONS))
(LET* ((FILENAMELENGTH (for I from BYTESPERWORD until (EQ 0 (\GETBASEBYTE
(fetch (TFTP TFTPBASE)
of UDP)
I))
finally (RETURN (IDIFFERENCE I BYTESPERWORD))))
(FILENAME (ALLOCSTRING FILENAMELENGTH))
(MODELENGTH (for I from (IPLUS BYTESPERWORD FILENAMELENGTH 1)
until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of UDP)
I))
finally (RETURN (IDIFFERENCE I (IPLUS BYTESPERWORD FILENAMELENGTH 1)
))))
(MODE (ALLOCSTRING MODELENGTH))
(HOST (fetch (IP IPSOURCEADDRESS) of UDP))
FILE TYPE TFTPSTREAM)
(RESETLST
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (TFTPCON)
(LET* ((UDPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON))
(CONNECTION (CONS (fetch (TFTPCON HOST)
of TFTPCON)
(fetch (TFTPCON DESTSOCKET)
of TFTPCON))))
(SETQ \TFTP.SERVER.CONNECTIONS (REMOVE CONNECTION
\TFTP.SERVER.CONNECTIONS))
(AND RESETSTATE (UDP.CLOSE.SOCKET UDPSOCKET T)))))
TFTPCON))
(replace (TFTPCON DESTSOCKET) of TFTPCON with (fetch (UDP UDPSOURCEPORT)
of UDP))
(replace (TFTPCON HOST) of TFTPCON with HOST)
(* * Read the filename out of the packet)
(\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP)
BYTESPERWORD
(fetch (STRINGP BASE) of FILENAME)
(fetch (STRINGP OFFST) of FILENAME)
FILENAMELENGTH)
(* * Read the mode out of the packet)
(\MOVEBYTES (fetch (TFTP TFTPBASE) of UDP)
(IPLUS BYTESPERWORD FILENAMELENGTH 1)
(fetch (STRINGP BASE) of MODE)
(fetch (STRINGP OFFST) of MODE)
MODELENGTH)
(SETQ MODE (U-CASE MODE))
(printout LOGSTREAM "TFTP Server: Will attempt to send " FILENAME " in " MODE
" mode to host "
(\IP.ADDRESS.TO.STRING HOST)
T)
(COND
((AND (SETQ TYPE (COND
((STREQUAL MODE "NETASCII")
(QUOTE TEXT))
((STREQUAL MODE "OCTET")
(QUOTE BINARY))
(T (\TFTP.SEND.ERROR TFTPCON 0 (CONCAT "Unknown transfer type--" MODE))
NIL)))
(SETQ FILE
(LET* ((FULLFILENAME (INFILEP FILENAME))
(INSTREAM (AND FULLFILENAME
(CAR (NLSETQ (OPENSTREAM
FULLFILENAME
(QUOTE INPUT)
(QUOTE OLD)
(LIST (LIST (QUOTE TYPE)
TYPE))))))))
(COND
((NULL INSTREAM)
(\TFTP.SEND.ERROR TFTPCON 1 (CONCAT "Can't open file--"
FILENAME))
NIL)
(T INSTREAM)))))
(* * Mode is OK, and file is open for input. Open the TFTP stream back to the requestor)
(SETQ TFTPSTREAM (create STREAM
DEVICE ← DEVICE))
(replace (TFTPCON STREAM) of TFTPCON with TFTPSTREAM)
(replace (STREAM ACCESS) of TFTPSTREAM with (QUOTE OUTPUT))
(replace (TFTPSTREAM TFTPCON) of TFTPSTREAM with TFTPCON)
(* * Use the incoming packet as the first data packet on the way out)
(\TFTP.SETUP UDP TFTPCON \TFTP.DATA NIL)
(* * This is block number 1)
(UDP.APPEND.WORD UDP 1)
(add (fetch (UDP UDPLENGTH) of UDP)
512)
(\TFTP.INPUT.BUFFER TFTPSTREAM UDP)
(printout LOGSTREAM "TFTP Server: Sending " FILENAME T)
(COND
((NLSETQ (PROGN (COPYBYTES FILE TFTPSTREAM)
(\TFTP.GETNEXTBUFFER TFTPSTREAM (QUOTE WRITE)
T)))
(printout LOGSTREAM "TFTP Server: Done sending " FILENAME T))
(T (printout LOGSTREAM "TFTP Server: Failed to send " FILENAME T)))
(CLOSEF? FILE))
(T (printout LOGSTREAM "TFTP Server: Failed to send " FILENAME T)
(\RELEASE.ETHERPACKET UDP)
NIL))))))
)
(* User functions)
(DEFINEQ
(TFTP.SERVER
(LAMBDA (LOGSTREAM) (* MPL " 2-Jun-85 19:39")
(* * Create a new TFTP server. LOGSTREAM defaults to a popup window)
(ADD.PROCESS (BQUOTE (TFTP.SERVER.PROCESS , LOGSTREAM))
(QUOTE RESTARTABLE)
(QUOTE HARDRESET))))
(TFTP.GET
(LAMBDA (FROM TO PARAMETERS) (* MPL " 2-Jun-85 17:15")
(LET ((EOLCONVENTION (CADR (FASSOC (QUOTE EOLCONVENTION)
PARAMETERS)))
(TYPE (FASSOC (QUOTE TYPE)
PARAMETERS))
(FROMNAME FROM)
(TONAME TO))
(RESETLST (SETQ TO (OPENSTREAM TO (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(COND
(TYPE (LIST TYPE)))))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
(COND
((AND STREAM RESETSTATE)
(CLOSEF? STREAM)
(DELFILE (FULLNAME STREAM))))))
TO))
(SETQ FROM (\TFTP.OPENFILE FROM (QUOTE INPUT)
(QUOTE OLD)
PARAMETERS))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
(AND STREAM RESETSTATE (CLOSEF STREAM))))
FROM))
(COND
(EOLCONVENTION (replace (STREAM EOLCONVENTION) of FROM with
EOLCONVENTION)))
(COND
((AND FROM TO)
(COPYCHARS FROM TO)
(AND (OPENP FROM)
(CLOSEF FROM))
(FULLNAME (CLOSEF TO)))
(TO (ERRORX (LIST 9 FROMNAME)))
(FROM (ERRORX (LIST 9 TONAME))))))))
(TFTP.PUT
(LAMBDA (FROM TO PARAMETERS) (* ejs: "10-Feb-85 00:10")
(LET ((EOLCONVENTION (CADR (FASSOC (QUOTE EOLCONVENTION)
PARAMETERS)))
(TYPE (FASSOC (QUOTE TYPE)
PARAMETERS)))
(RESETLST (SETQ FROM (OPENSTREAM TO (QUOTE INPUT)
(QUOTE OLD)))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
(AND RESETSTATE (CLOSEF STREAM))))
FROM))
(SETQ TO (\TFTP.OPENFILE FROM (QUOTE OUTPUT)
(QUOTE NEW)
PARAMETERS))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
(AND RESETSTATE (CLOSEF STREAM))))
TO))
(COND
(EOLCONVENTION (replace (STREAM EOLCONVENTION) of TO with EOLCONVENTION))
)
(COPYCHARS FROM TO)
(CLOSEF FROM)
(FULLNAME (CLOSEF TO))))))
)
(* Tracing functions)
(DEFINEQ
(PRINTTFTP
(LAMBDA (TFTP FILE) (* ejs: " 2-Jun-85 14:00")
(DECLARE (GLOBALVARS TFTPOPCODES))
(PRINTCONSTANT (fetch (TFTP OPCODE) of TFTP)
TFTPOPCODES FILE "TFTP Opcode: ")
(SELECTC (fetch (TFTP OPCODE) of TFTP)
(\TFTP.RRQ (printout FILE " ")
(\TFTP.PRINT.REQUEST TFTP FILE))
(\TFTP.WRQ (printout FILE " ")
(\TFTP.PRINT.REQUEST TFTP FILE))
(\TFTP.ACK (printout FILE " ")
(\TFTP.PRINT.ACK TFTP FILE))
(\TFTP.DATA (printout FILE " ")
(\TFTP.PRINT.DATA TFTP FILE))
(\TFTP.ERROR (printout FILE " ")
(\TFTP.PRINT.ERROR TFTP FILE))
NIL)
(TERPRI FILE)
(TERPRI FILE)))
(\TFTP.PRINT.ACK
(LAMBDA (TFTP FILE) (* ejs: " 2-Jun-85 12:48")
(printout FILE "Block #: " (fetch (TFTP BLOCK#) of TFTP)
T)))
(\TFTP.PRINT.DATA
(LAMBDA (TFTP FILE) (* ejs: " 2-Jun-85 14:00")
(printout FILE "Block #: " (fetch (TFTP BLOCK#) of TFTP)
T)
(PRINTPACKETDATA (fetch (TFTP TFTPCONTENTS) of TFTP)
\TFTPOVLEN
(QUOTE (CHARS 12 ...))
(IDIFFERENCE (fetch (UDP UDPLENGTH) of TFTP)
(CONSTANT (IPLUS \TFTPOVLEN \UDPOVLEN))))))
(\TFTP.PRINT.ERROR
(LAMBDA (TFTP FILE) (* ejs: " 2-Jun-85 13:15")
(printout FILE "Error code: " (fetch (TFTP ERRORCODE) of TFTP)
T)
(PRINTPACKETDATA (fetch (TFTP TFTPCONTENTS) of TFTP)
0
(QUOTE (CHARS ...))
(IDIFFERENCE (fetch (UDP UDPLENGTH) of TFTP)
(CONSTANT (IPLUS \UDPOVLEN \TFTPOVLEN)))
FILE)))
(\TFTP.PRINT.REQUEST
(LAMBDA (TFTP FILE) (* ejs: " 2-Jun-85 13:16")
(* * Try to start sending a file to the requestor as directed by the contents of the received TFTP packet)
(LET* ((FILENAMELENGTH (for I from BYTESPERWORD until (EQ 0 (\GETBASEBYTE
(fetch (TFTP TFTPBASE)
of TFTP)
I))
finally (RETURN (IDIFFERENCE I BYTESPERWORD))))
(FILENAME (ALLOCSTRING FILENAMELENGTH))
(MODELENGTH (for I from (IPLUS BYTESPERWORD FILENAMELENGTH 1)
until (EQ 0 (\GETBASEBYTE (fetch (TFTP TFTPBASE) of TFTP)
I))
finally (RETURN (IDIFFERENCE I (IPLUS BYTESPERWORD FILENAMELENGTH 1)
))))
(MODE (ALLOCSTRING MODELENGTH)))
(* * Read the filename out of the packet)
(\MOVEBYTES (fetch (TFTP TFTPBASE) of TFTP)
BYTESPERWORD
(fetch (STRINGP BASE) of FILENAME)
(fetch (STRINGP OFFST) of FILENAME)
FILENAMELENGTH)
(* * Read the mode out of the packet)
(\MOVEBYTES (fetch (TFTP TFTPBASE) of TFTP)
(IPLUS BYTESPERWORD FILENAMELENGTH 1)
(fetch (STRINGP BASE) of MODE)
(fetch (STRINGP OFFST) of MODE)
MODELENGTH)
(printout FILE (SELECTC (fetch (TFTP OPCODE) of TFTP)
(\TFTP.RRQ "Read request for ")
(\TFTP.WRQ "Write request for ")
(SHOULDNT))
FILENAME " in mode " MODE T))))
)
(\TFTP.INIT)
(PUTPROPS TCPTFTP COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3152 20339 (\TFTP.ACKNOWLEDGE 3162 . 3834) (\TFTP.CLOSEFILE 3836 . 4474) (\TFTP.EOFP
4476 . 4825) (\TFTP.ERROR 4827 . 5599) (\TFTP.GETNEXTBUFFER 5601 . 13460) (\TFTP.INIT 13462 . 14388) (
\TFTP.INPUT.BUFFER 14390 . 15504) (\TFTP.OPENFILE 15506 . 19241) (\TFTP.READP 19243 . 19464) (
\TFTP.SEND.ERROR 19466 . 19960) (\TFTP.SETUP 19962 . 20337)) (20555 31773 (TFTP.SERVER.PROCESS 20565
. 22782) (\TFTP.GET.FILE 22784 . 27380) (\TFTP.SEND.FILE 27382 . 31771)) (31801 34441 (TFTP.SERVER
31811 . 32135) (TFTP.GET 32137 . 33477) (TFTP.PUT 33479 . 34439)) (34472 37966 (PRINTTFTP 34482 .
35259) (\TFTP.PRINT.ACK 35261 . 35454) (\TFTP.PRINT.DATA 35456 . 35901) (\TFTP.PRINT.ERROR 35903 .
36357) (\TFTP.PRINT.REQUEST 36359 . 37964)))))
STOP