(FILECREATED "10-Feb-85 00:15:37" {ERIS}<LISPCORE>LIBRARY>TFTP.;4 16721
changes to: (VARS TFTPCOMS \TFTPOVLEN \TFTP.ERROR \TFTP.ACK \TFTP.DATA \TFTP.WRQ \TFTP.RRQ
\TFTP.SOCKET TFTPOPCODES)
(FNS \TFTP.OPENFILE TFTP.PUT TFTP.GET \TFTP.CLOSEFILE \TFTP.GETNEXTBUFFER
\TFTP.ACKNOWLEDGE \TFTP.INIT \TFTP.SETUP \TFTP.ERROR \TFTP.INPUT.BUFFER
\TFTP.EOFP \TFTP.READP)
(RECORDS TFTPCON TFTP TFTPSTREAM)
previous date: " 9-Feb-85 21:31:49" {ERIS}<LISPCORE>LIBRARY>TFTP.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TFTPCOMS)
(RPAQQ TFTPCOMS ((COMS (* Trivial File Transfer Protocol)
(GLOBALVARS \TFTP.DEVICE)
(RECORDS TFTPCON TFTP TFTPSTREAM)
(CONSTANTS (\TFTPOVLEN 4)
(\TFTP.SOCKET 69))
(CONSTANTS * TFTPOPCODES)
(FNS \TFTP.ACKNOWLEDGE \TFTP.CLOSEFILE \TFTP.EOFP \TFTP.ERROR
\TFTP.GETNEXTBUFFER \TFTP.INIT \TFTP.INPUT.BUFFER \TFTP.OPENFILE
\TFTP.READP \TFTP.SETUP)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
UDP))
(COMS (* User functions)
(FNS TFTP.GET TFTP.PUT))
(P (\TFTP.INIT))))
(* Trivial File Transfer Protocol)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TFTP.DEVICE)
)
[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))
)
(DEFINEQ
(\TFTP.ACKNOWLEDGE
(LAMBDA (STREAM ACK#) (* ejs: " 9-Feb-85 21:38")
(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)
(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) (* ejs: " 9-Feb-85 23:46")
(LET* ((TFTPCON (fetch (TFTPSTREAM TFTPCON) of STREAM))
(IPSOCKET (fetch (TFTPCON UDPSOCKET) of TFTPCON))
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 (BLOCK)
(PROG NIL
LP (for I from 1 to \MAXETHERTRIES until UDP
do (SETQ UDP (UDP.GET IPSOCKET \ETHERTIMEOUT))
(COND
((NOT UDP)
(\TFTP.ACKNOWLEDGE STREAM (fetch (TFTP BLOCK#)
of (fetch (STREAM CBUFPTR)
of STREAM))))))
(COND
(UDP (COND
((ILEQ (fetch (TFTP BLOCK#) of UDP)
(fetch (TFTP BLOCK#) of (fetch (STREAM CBUFPTR)
of STREAM)))
(\TFTP.ACKNOWLEDGE STREAM (fetch (TFTP BLOCK#)
of UDP))
(\RELEASE.ETHERPACKET UDP)
(GO LP))
(T (\TFTP.INPUT.BUFFER STREAM UDP)
(\TFTP.ACKNOWLEDGE STREAM (fetch (TFTP BLOCK#)
of (fetch (STREAM CBUFPTR)
of STREAM)))
(RETURN T))))
(T (RETURN NIL)))))))
(WRITE (COND
((fetch (TFTPSTREAM LASTPACKETIN) of STREAM)
(replace (STREAM ACCESS) of STREAM with NIL)
(COND
(NOERRORFLG NIL)
(T (\EOF.ACTION STREAM))))
(T (PROG ((BUFFER (fetch (STREAM CBUFPTR) of STREAM))
ACK# NBYTES)
(SETQ ACK# (fetch (TFTP BLOCK#) of (fetch (STREAM CBUFPTR)
of STREAM)))
(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 \MAXETHERTRIES until UDP do (SETQ UDP
(UDP.EXCHANGE
IPSOCKET
BUFFER)))
(COND
((AND UDP (EQ (fetch (TFTP OPCODE) of UDP)
\TFTP.ACK))
(COND
((ILESSP (fetch (TFTP BLOCK#) of UDP)
ACK#)
(\RELEASE.ETHERPACKET UDP)
(SETQ UDP NIL)
(GO LP))
((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))))
(T (RETURN NIL)))))))
(ERROR "Illegal ACCESS" WHATFOR)))))
(\TFTP.INIT
(LAMBDA NIL (* ejs: " 9-Feb-85 22:02")
(DECLARE (GLOBALVARS \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)
FLUSHOUTPUT ←(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: "10-Feb-85 00:09")
(* * Open a file using TFTP)
(LET* ((DEVICE (create FDEV using \TFTP.DEVICE DEVICENAME ←(FILENAMEFIELD FILENAME (QUOTE HOST))))
(STREAM (create STREAM
DEVICE ← DEVICE))
(TFTPCON (replace (FDEV DEVICEINFO) of DEVICE with (create TFTPCON
UDPSOCKET ←(UDP.OPEN.SOCKET)
STREAM ← STREAM
HOST ←(DODIP.HOSTP
(fetch (FDEV DEVICENAME)
of DEVICE)))))
(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)))))))))
(\TFTP.READP
(LAMBDA (STREAM) (* ejs: " 9-Feb-85 20:48")
(ILESSP (fetch (STREAM COFFSET) of STREAM)
(fetch (STREAM CBUFSIZE) of STREAM))))
(\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)
UDP)
(* User functions)
(DEFINEQ
(TFTP.GET
(LAMBDA (FROM TO PARAMETERS) (* ejs: "10-Feb-85 00:13")
(LET ((EOLCONVENTION (CADR (FASSOC (QUOTE EOLCONVENTION)
PARAMETERS)))
(TYPE (FASSOC (QUOTE TYPE)
PARAMETERS)))
(RESETLST (SETQ TO (OPENSTREAM TO (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(COND
(TYPE (LIST TYPE)))))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
(AND RESETSTATE (CLOSEF STREAM)
(DELFILE STREAM))))
TO))
(SETQ FROM (\TFTP.OPENFILE FROM (QUOTE INPUT)
(QUOTE OLD)
PARAMETERS))
(RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
(AND RESETSTATE (CLOSEF STREAM))))
FROM))
(COND
(EOLCONVENTION (replace (STREAM EOLCONVENTION) of FROM with EOLCONVENTION)))
(COPYCHARS FROM TO)
(AND (OPENP FROM)
(CLOSEF FROM))
(FULLNAME (CLOSEF TO))))))
(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))))))
)
(\TFTP.INIT)
(PUTPROPS TFTP COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2493 14564 (\TFTP.ACKNOWLEDGE 2503 . 3138) (\TFTP.CLOSEFILE 3140 . 3774) (\TFTP.EOFP
3776 . 4120) (\TFTP.ERROR 4122 . 4841) (\TFTP.GETNEXTBUFFER 4843 . 8752) (\TFTP.INIT 8754 . 9592) (
\TFTP.INPUT.BUFFER 9594 . 10675) (\TFTP.OPENFILE 10677 . 13949) (\TFTP.READP 13951 . 14170) (
\TFTP.SETUP 14172 . 14562)) (14656 16633 (TFTP.GET 14666 . 15716) (TFTP.PUT 15718 . 16631)))))
STOP