(FILECREATED "11-Oct-85 16:04:27" {ERIS}<LISPCORE>LIBRARY>KERMIT.;19 74738
changes to: (FNS \MODEM.RECEIVE.FILE.BYTES)
previous date: " 7-Oct-85 10:32:02" {ERIS}<LISPCORE>LIBRARY>KERMIT.;18)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT KERMITCOMS)
(RPAQQ KERMITCOMS ((COMS (* KERMIT terminal stream based file transfer protocol)
(DECLARE: DONTCOPY
(EXPORT (CONSTANTS * KERMIT.PACKET.TYPES)
(CONSTANTS * KERMIT.PACKET.OFFSETS)
(CONSTANTS * \KERMIT.INIT.PARAMETER.OFFSETS)
(CONSTANTS (\KERMITOVLEN 5))
(RECORDS KERMITSTATE)
(MACROS \KERMIT.CHAR \KERMIT.CTL \KERMIT.DEFAULT.CHECKSUM
\KERMIT.UNCHAR \KERMIT.PARAM.DEFAULT
\KERMIT.SEND.ACK \KERMIT.SEND.NAK \KERMIT.ABORT
\KERMIT.DATASECTION \KERMITMSG \KERMITTRACE
\KERMIT.SEND.BREAK \KERMIT.SEND.DATA
\KERMIT.SEND.EOF \KERMIT.INCREMENT.SEQNO
\KERMIT.SEND.ERROR)))
(INITRECORDS KERMITSTATE)
(CONSTANTS (KERMIT.MAX.PACKET.SIZE 94))
(INITVARS (KERMIT.DEFAULT.MARK.CHARACTER (CHARCODE ↑A))
(KERMIT.DEFAULT.RECV.PACKET.SIZE 80)
(KERMIT.DEFAULT.TIMEOUT.TIME (ITIMES 10 1000))
(KERMIT.DEFAULT.PAD.CHARS 0)
(KERMIT.DEFAULT.PAD.CHARACTER 0)
(KERMIT.DEFAULT.EOL.CHARACTER (CHARCODE EOL))
(KERMIT.DEFAULT.PREFIX.CHARACTER (CHARCODE #))
(KERMIT.DEFAULT.RETRY.COUNT 10)
(\KERMITTRACEFILE NIL)
(KERMIT.DEFAULT.FILETYPE (QUOTE TEXT))
(KERMIT.DEFAULT.CHATWINDOW))
(GLOBALVARS KERMIT.DEFAULT.MARK.CHARACTER KERMIT.DEFAULT.RECV.PACKET.SIZE
KERMIT.DEFAULT.TIMEOUT.TIME KERMIT.DEFAULT.PAD.CHARS
KERMIT.DEFAULT.PAD.CHARACTER KERMIT.DEFAULT.EOL.CHARACTER
KERMIT.DEFAULT.PREFIX.CHARACTER KERMIT.DEFAULT.RETRY.COUNT
\KERMITTRACEFILE KERMIT.DEFAULT.FILETYPE
KERMIT.DEFAULT.CHATWINDOW)
(FNS \KERMIT.CLEAR.INPUT.BUFFER \KERMIT.DO.FILE.HEADER \KERMIT.GET.PACKET
\KERMIT.INITIALIZE \KERMIT.NEGOTIATE \KERMIT.PARSE.REMOTE.PARAMETERS
\KERMIT.RECEIVE.FILE \KERMIT.RECEIVE.FILE.BYTES \KERMIT.SEND.FILE
\KERMIT.SEND.FILE.BYTES \KERMIT.SEND.FILE.HEADER \KERMIT.SEND.PACKET
\KERMIT.SEND.PARAMETERS \KERMIT.SEND.STRING \KERMIT.SHOW.PACKET
\KERMIT.TIMED.BIN \KERMIT.UNPREFIXIFY \KERMIT.WRITE))
(COMS (* User callable functions)
(FNS KERMIT.RECEIVE KERMIT.SEND KERMIT.SERVER.COMMAND))
(COMS (* Kermit TTY executive, for running Kermit without the TEdit menu)
(FNS KERMIT KERMIT.EXEC.DEBUGGING KERMIT.EXEC.FILE KERMIT.EXEC.FILE.TYPE
KERMIT.EXEC.ON.OFF KERMIT.EXEC.RECEIVE KERMIT.EXEC.SEND KERMIT.EXEC.SET
KERMIT.SET.KERMIT.WINDOW \KERMIT.LIVE.CHATWINDOW))
(COMS (* The MODEM program. A sad subset and precursor to KERMIT, but here only for the sake
of compatibility)
[DECLARE: DONTCOPY (EXPORT (CONSTANTS * MODEMCOMMANDS)
(CONSTANTS (MODEM.PACKET.LENGTH 128]
(INITVARS (MODEM.MAX.RETRIES 10)
(MODEM.TIMEOUT 10000))
(GLOBALVARS MODEM.TIMEOUT MODEM.MAX.RETRIES)
(FNS MODEM.RECEIVE MODEM.SEND \MODEM.INITIALIZE \MODEM.SEND.FILE \MODEM.SEND.FILE.BYTES
\MODEM.SEND.PACKET \MODEM.CLEAR.INPUT \MODEM.RECEIVE.FILE.BYTES
\MODEM.RECEIVE.PACKET))))
(* KERMIT terminal stream based file transfer protocol)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(RPAQQ KERMIT.PACKET.TYPES ((KERMIT.DATA.PACKET (CHARCODE D))
(KERMIT.ACK.PACKET (CHARCODE Y))
(KERMIT.NAK.PACKET (CHARCODE N))
(KERMIT.SENDINIT.PACKET (CHARCODE S))
(KERMIT.BREAK.PACKET (CHARCODE B))
(KERMIT.FILEHEADER.PACKET (CHARCODE F))
(KERMIT.EOF.PACKET (CHARCODE Z))
(KERMIT.ERROR.PACKET (CHARCODE E))
(KERMIT.ILLEGAL.PACKET (CHARCODE T))
(KERMIT.GENERIC.SERVER.COMMAND (CHARCODE G))))
(DECLARE: EVAL@COMPILE
(RPAQ KERMIT.DATA.PACKET (CHARCODE D))
(RPAQ KERMIT.ACK.PACKET (CHARCODE Y))
(RPAQ KERMIT.NAK.PACKET (CHARCODE N))
(RPAQ KERMIT.SENDINIT.PACKET (CHARCODE S))
(RPAQ KERMIT.BREAK.PACKET (CHARCODE B))
(RPAQ KERMIT.FILEHEADER.PACKET (CHARCODE F))
(RPAQ KERMIT.EOF.PACKET (CHARCODE Z))
(RPAQ KERMIT.ERROR.PACKET (CHARCODE E))
(RPAQ KERMIT.ILLEGAL.PACKET (CHARCODE T))
(RPAQ KERMIT.GENERIC.SERVER.COMMAND (CHARCODE G))
(CONSTANTS (KERMIT.DATA.PACKET (CHARCODE D))
(KERMIT.ACK.PACKET (CHARCODE Y))
(KERMIT.NAK.PACKET (CHARCODE N))
(KERMIT.SENDINIT.PACKET (CHARCODE S))
(KERMIT.BREAK.PACKET (CHARCODE B))
(KERMIT.FILEHEADER.PACKET (CHARCODE F))
(KERMIT.EOF.PACKET (CHARCODE Z))
(KERMIT.ERROR.PACKET (CHARCODE E))
(KERMIT.ILLEGAL.PACKET (CHARCODE T))
(KERMIT.GENERIC.SERVER.COMMAND (CHARCODE G)))
)
(RPAQQ KERMIT.PACKET.OFFSETS ((KERMIT.PACKET.MARK 1)
(KERMIT.PACKET.LEN 2)
(KERMIT.PACKET.SEQ 3)
(KERMIT.PACKET.TYPE 4)
(KERMIT.PACKET.DATA 5)))
(DECLARE: EVAL@COMPILE
(RPAQQ KERMIT.PACKET.MARK 1)
(RPAQQ KERMIT.PACKET.LEN 2)
(RPAQQ KERMIT.PACKET.SEQ 3)
(RPAQQ KERMIT.PACKET.TYPE 4)
(RPAQQ KERMIT.PACKET.DATA 5)
(CONSTANTS (KERMIT.PACKET.MARK 1)
(KERMIT.PACKET.LEN 2)
(KERMIT.PACKET.SEQ 3)
(KERMIT.PACKET.TYPE 4)
(KERMIT.PACKET.DATA 5))
)
(RPAQQ \KERMIT.INIT.PARAMETER.OFFSETS ((\KPARM.MAXL 1)
(\KPARM.TIME 2)
(\KPARM.NPAD 3)
(\KPARM.PADC 4)
(\KPARM.EOL 5)
(\KPARM.QCTL 6)
(\KPARM.QBIN 7)))
(DECLARE: EVAL@COMPILE
(RPAQQ \KPARM.MAXL 1)
(RPAQQ \KPARM.TIME 2)
(RPAQQ \KPARM.NPAD 3)
(RPAQQ \KPARM.PADC 4)
(RPAQQ \KPARM.EOL 5)
(RPAQQ \KPARM.QCTL 6)
(RPAQQ \KPARM.QBIN 7)
(CONSTANTS (\KPARM.MAXL 1)
(\KPARM.TIME 2)
(\KPARM.NPAD 3)
(\KPARM.PADC 4)
(\KPARM.EOL 5)
(\KPARM.QCTL 6)
(\KPARM.QBIN 7))
)
(DECLARE: EVAL@COMPILE
(RPAQQ \KERMITOVLEN 5)
(CONSTANTS (\KERMITOVLEN 5))
)
[DECLARE: EVAL@COMPILE
(DATATYPE KERMITSTATE ((LASTPACKETIN POINTER)
(LASTPACKETOUT POINTER)
(STATE POINTER)
(INSTREAM POINTER)
(OUTSTREAM POINTER)
(EOLCONVENTION POINTER)
(EOL POINTER)
(QBIN POINTER)
(TIME FIXP)
(CURRENTSEQNO BYTE)
(MARKCHAR BYTE)
(MAXL BYTE)
(NPAD BYTE)
(PADC BYTE)
(QCTL BYTE)
(CHKT BYTE)
(REPT BYTE))
CURRENTSEQNO ← 0 MARKCHAR ← KERMIT.DEFAULT.MARK.CHARACTER MAXL ←
KERMIT.DEFAULT.RECV.PACKET.SIZE TIME ← KERMIT.DEFAULT.TIMEOUT.TIME NPAD ←
KERMIT.DEFAULT.PAD.CHARS PADC ← KERMIT.DEFAULT.PAD.CHARACTER QCTL ←
KERMIT.DEFAULT.PREFIX.CHARACTER EOL ← KERMIT.DEFAULT.EOL.CHARACTER)
]
(/DECLAREDATATYPE (QUOTE KERMITSTATE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FIXP BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE))
[QUOTE ((KERMITSTATE 0 POINTER)
(KERMITSTATE 2 POINTER)
(KERMITSTATE 4 POINTER)
(KERMITSTATE 6 POINTER)
(KERMITSTATE 8 POINTER)
(KERMITSTATE 10 POINTER)
(KERMITSTATE 12 POINTER)
(KERMITSTATE 14 POINTER)
(KERMITSTATE 16 FIXP)
(KERMITSTATE 14 (BITS . 7))
(KERMITSTATE 12 (BITS . 7))
(KERMITSTATE 10 (BITS . 7))
(KERMITSTATE 8 (BITS . 7))
(KERMITSTATE 6 (BITS . 7))
(KERMITSTATE 4 (BITS . 7))
(KERMITSTATE 2 (BITS . 7))
(KERMITSTATE 0 (BITS . 7]
(QUOTE 18))
(DECLARE: EVAL@COMPILE
(DEFMACRO \KERMIT.CHAR (X)
(BQUOTE (IPLUS (\, X)
32)))
[DEFMACRO \KERMIT.CTL (X)
(BQUOTE (LOGAND (MASK.1'S 0 8)
(LOGXOR , X 64]
[DEFMACRO \KERMIT.DEFAULT.CHECKSUM (S)
(BQUOTE (\KERMIT.CHAR (LOGAND (IPLUS (\, S)
(FOLDLO (LOGAND (\, S)
192)
64))
(MASK.1'S 0 6]
[DEFMACRO \KERMIT.UNCHAR (X)
(BQUOTE (LOGAND (IDIFFERENCE (\, X)
32)
(MASK.1'S 0 7]
[DEFMACRO \KERMIT.PARAM.DEFAULT (DEFAULTVALUE PACKETVALUE)
(BQUOTE (COND ((EQ , PACKETVALUE 0)
, DEFAULTVALUE)
(T , PACKETVALUE]
[DEFMACRO \KERMIT.SEND.ACK (KERMITSTATE &OPTIONAL (SEQNO NIL))
(BQUOTE (\KERMIT.SEND.DATA "" KERMIT.ACK.PACKET (\, KERMITSTATE)
(\, SEQNO]
[DEFMACRO \KERMIT.SEND.NAK (KERMITSTATE)
(BQUOTE (\KERMIT.SEND.STRING "" KERMIT.NAK.PACKET (\, KERMITSTATE]
[DEFMACRO \KERMIT.ABORT (KERMITSTATE)
(BQUOTE (PROGN (\KERMIT.SEND.NAK , KERMITSTATE)
(replace (KERMITSTATE STATE)
of , KERMITSTATE with 'ABORT]
(DEFMACRO \KERMIT.DATASECTION (STRING)
(BQUOTE (SUBSTRING , STRING KERMIT.PACKET.DATA -2)))
[DEFMACRO \KERMITMSG (&OPTIONAL (MSG))
(BQUOTE (PROGN (CLEARW KERMITSTATUSWINDOW)
(COND ((LISTP (\, MSG))
(printout KERMITSTATUSWINDOW .PPVTL (\, MSG)))
((\, MSG)
(printout KERMITSTATUSWINDOW (\, MSG]
[DEFMACRO \KERMITTRACE (MSG)
(BQUOTE (COND (\KERMITTRACEFILE (PRIN1 (\, MSG)
\KERMITTRACEFILE]
[DEFMACRO \KERMIT.SEND.BREAK (KERMITSTATE)
(BQUOTE (\KERMIT.SEND.PACKET "" KERMIT.BREAK.PACKET (\, KERMITSTATE]
[DEFMACRO \KERMIT.SEND.DATA (STRING TYPE KERMITSTATE &OPTIONAL (SEQNO))
(BQUOTE (PROGN (\KERMIT.SEND.STRING (\, STRING)
(\, TYPE)
(\, KERMITSTATE)
(\, SEQNO))
(COND ((NOT (\, SEQNO))
(\KERMIT.INCREMENT.SEQNO (\, KERMITSTATE]
[DEFMACRO \KERMIT.SEND.EOF (KERMITSTATE &OPTIONAL (DISCARD))
(BQUOTE (COND ((\, DISCARD)
(\KERMIT.SEND.PACKET "D" KERMIT.EOF.PACKET (\, KERMITSTATE)))
(T (\KERMIT.SEND.PACKET "" KERMIT.EOF.PACKET (\, KERMITSTATE]
[DEFMACRO \KERMIT.INCREMENT.SEQNO (KERMITSTATE)
(BQUOTE (change (fetch (KERMITSTATE CURRENTSEQNO)
of
(\, KERMITSTATE))
(IMOD (ADD1 DATUM)
64]
[DEFMACRO \KERMIT.SEND.ERROR (STRING KERMITSTATE)
(BQUOTE (\KERMIT.SEND.STRING (\, STRING)
KERMIT.ERROR.PACKET
(\, KERMITSTATE]
)
(* END EXPORTED DEFINITIONS)
)
(/DECLAREDATATYPE (QUOTE KERMITSTATE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FIXP BYTE
BYTE BYTE BYTE BYTE BYTE BYTE BYTE))
[QUOTE ((KERMITSTATE 0 POINTER)
(KERMITSTATE 2 POINTER)
(KERMITSTATE 4 POINTER)
(KERMITSTATE 6 POINTER)
(KERMITSTATE 8 POINTER)
(KERMITSTATE 10 POINTER)
(KERMITSTATE 12 POINTER)
(KERMITSTATE 14 POINTER)
(KERMITSTATE 16 FIXP)
(KERMITSTATE 14 (BITS . 7))
(KERMITSTATE 12 (BITS . 7))
(KERMITSTATE 10 (BITS . 7))
(KERMITSTATE 8 (BITS . 7))
(KERMITSTATE 6 (BITS . 7))
(KERMITSTATE 4 (BITS . 7))
(KERMITSTATE 2 (BITS . 7))
(KERMITSTATE 0 (BITS . 7]
(QUOTE 18))
(DECLARE: EVAL@COMPILE
(RPAQQ KERMIT.MAX.PACKET.SIZE 94)
(CONSTANTS (KERMIT.MAX.PACKET.SIZE 94))
)
(RPAQ? KERMIT.DEFAULT.MARK.CHARACTER (CHARCODE ↑A))
(RPAQ? KERMIT.DEFAULT.RECV.PACKET.SIZE 80)
(RPAQ? KERMIT.DEFAULT.TIMEOUT.TIME (ITIMES 10 1000))
(RPAQ? KERMIT.DEFAULT.PAD.CHARS 0)
(RPAQ? KERMIT.DEFAULT.PAD.CHARACTER 0)
(RPAQ? KERMIT.DEFAULT.EOL.CHARACTER (CHARCODE EOL))
(RPAQ? KERMIT.DEFAULT.PREFIX.CHARACTER (CHARCODE #))
(RPAQ? KERMIT.DEFAULT.RETRY.COUNT 10)
(RPAQ? \KERMITTRACEFILE NIL)
(RPAQ? KERMIT.DEFAULT.FILETYPE (QUOTE TEXT))
(RPAQ? KERMIT.DEFAULT.CHATWINDOW )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS KERMIT.DEFAULT.MARK.CHARACTER KERMIT.DEFAULT.RECV.PACKET.SIZE KERMIT.DEFAULT.TIMEOUT.TIME
KERMIT.DEFAULT.PAD.CHARS KERMIT.DEFAULT.PAD.CHARACTER KERMIT.DEFAULT.EOL.CHARACTER
KERMIT.DEFAULT.PREFIX.CHARACTER KERMIT.DEFAULT.RETRY.COUNT \KERMITTRACEFILE
KERMIT.DEFAULT.FILETYPE KERMIT.DEFAULT.CHATWINDOW)
)
(DEFINEQ
(\KERMIT.CLEAR.INPUT.BUFFER
(LAMBDA (STREAM) (* ejs: " 7-Jun-85 20:31")
(while (READP STREAM) do (BIN STREAM))))
(\KERMIT.DO.FILE.HEADER
[LAMBDA (LOCALFILE FILETYPE KERMITSTATE) (* ejs: " 5-Jul-85 17:42")
(* * Receive the file header, open the file according to TYPE, and return)
(LET* ((FILEHEADERPACKET (\KERMIT.GET.PACKET KERMITSTATE))
(TYPE (AND FILEHEADERPACKET (NTHCHARCODE FILEHEADERPACKET KERMIT.PACKET.TYPE)))
FILESTREAM)
(SELECTC TYPE
[KERMIT.FILEHEADER.PACKET (COND
([SETQ FILESTREAM (OPENSTREAM LOCALFILE (QUOTE OUTPUT)
(QUOTE NEW)
(BQUOTE ((TYPE ,
FILETYPE)
(SEQUENTIAL
T]
(\KERMIT.SEND.ACK KERMITSTATE)
(replace (KERMITSTATE STATE) of KERMITSTATE
with (QUOTE REC.DATA))
FILESTREAM)
(T (\KERMIT.ABORT KERMITSTATE]
(KERMIT.BREAK.PACKET (\KERMIT.SEND.ACK KERMITSTATE)
(replace (KERMITSTATE STATE) of KERMITSTATE
with (QUOTE COMPLETE))
NIL)
(KERMIT.ERROR.PACKET (ERROR (\KERMIT.DATASECTION FILEHEADERPACKET)))
(ERROR "Unexpected packet type in DO.FILE.HEADER" (CHARACTER TYPE])
(\KERMIT.GET.PACKET
(LAMBDA (KERMITSTATE) (* ejs: " 7-Oct-85 09:03")
(* * Called to get the next packet on the kermit connection. Handles timeout, retransmission, etc)
(LET ((STREAM (fetch (KERMITSTATE INSTREAM) of KERMITSTATE))
(OUTSTREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
(TIMEOUT (fetch (KERMITSTATE TIME) of KERMITSTATE))
PACKET.TIMER PACKET SEQ LEN TYPE CHAR (CHECKSUM 0))
(\KERMIT.CLEAR.INPUT.BUFFER STREAM)
(\KERMITTRACE "G:")
(for RETRIES from 1 to KERMIT.DEFAULT.RETRY.COUNT until PACKET
do (COND
((NEQ RETRIES 1)
(PRIN1 "." KERMITSTATUSWINDOW)))
(COND
((bind GOTIT until (OR (AND (EQ (SETQ CHAR (\KERMIT.TIMED.BIN
STREAM TIMEOUT))
(fetch (KERMITSTATE MARKCHAR)
of KERMITSTATE))
(SETQ GOTIT T))
(NULL CHAR))
finally (RETURN GOTIT))
(\KERMITTRACE "[")
(COND
((NOT (SETQ CHECKSUM (\KERMIT.TIMED.BIN STREAM TIMEOUT)))
(\KERMIT.SEND.NAK KERMITSTATE)
(GO $$ITERATE)))
(SETQ LEN (\KERMIT.UNCHAR CHECKSUM))
(SETQ PACKET (ALLOCSTRING (IPLUS LEN KERMIT.PACKET.LEN)))
(\KERMITTRACE LEN)
(RPLCHARCODE PACKET KERMIT.PACKET.LEN LEN)
(COND
((NOT (for I from KERMIT.PACKET.SEQ to (IPLUS LEN (SUB1
KERMIT.PACKET.LEN))
do (COND
((NOT (SETQ CHAR (\KERMIT.TIMED.BIN STREAM TIMEOUT)))
(RETURN)))
(add CHECKSUM CHAR)
(RPLCHARCODE PACKET I CHAR)
finally (RETURN T)))
(SETQ PACKET NIL)
(\KERMIT.SEND.NAK KERMITSTATE)
(GO $$ITERATE)))
(SETQ TYPE (NTHCHARCODE PACKET KERMIT.PACKET.TYPE))
(\KERMITTRACE (CONCAT " " (CHARACTER TYPE)
"]"))
(COND
((ILESSP (SETQ SEQ (\KERMIT.UNCHAR (NTHCHARCODE PACKET
KERMIT.PACKET.SEQ)))
0)
(SETQ PACKET NIL)
(\KERMIT.SEND.NAK KERMITSTATE)
(GO $$ITERATE)))
(RPLCHARCODE PACKET KERMIT.PACKET.SEQ SEQ)
(COND
((NEQ (\KERMIT.DEFAULT.CHECKSUM CHECKSUM)
(\KERMIT.TIMED.BIN STREAM TIMEOUT))
(\KERMITTRACE "X ")
(\KERMIT.SEND.NAK KERMITSTATE)
(SETQ PACKET NIL))
((EQ TYPE KERMIT.NAK.PACKET)
(SETQ PACKET NIL)
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
OUTSTREAM))
((EQ SEQ (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE))
(replace (KERMITSTATE LASTPACKETIN) of KERMITSTATE with PACKET)
(\KERMITTRACE "A ")
(RETURN))
((ILESSP SEQ (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE))
(\KERMITTRACE "O ")
(COND
((EQ (NTHCHARCODE PACKET KERMIT.PACKET.TYPE)
KERMIT.EOF.PACKET)
(\KERMIT.SEND.ACK (SUB1 (fetch (KERMITSTATE CURRENTSEQNO)
of KERMITSTATE))
KERMITSTATE))
(T (\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of
KERMITSTATE)
KERMITSTATE)))
(SETQ PACKET NIL))
(T (\KERMITTRACE (CONCAT "E(" SEQ ")"))
(\KERMIT.SEND.NAK KERMITSTATE)
(SETQ PACKET NIL))))
(T (\KERMIT.SEND.NAK KERMITSTATE))))
(COND
(PACKET PACKET)
(T (\KERMITMSG "Remote KERMIT is not responding")
(ERROR!))))))
(\KERMIT.INITIALIZE
[LAMBDA (KERMITSTATE FORWHAT) (* ejs: " 8-Jun-85 20:38")
(with KERMITSTATE KERMITSTATE (SETQ CURRENTSEQNO 0)
(COND
((NOT (OPENP OUTSTREAM (QUOTE OUTPUT)))
(ERROR "KERMIT output stream is not open for output!" OUTSTREAM))
((NOT (OPENP INSTREAM (QUOTE INPUT)))
(ERROR "KERMIT input stream is not open for input!" INSTREAM)))
(SELECTQ FORWHAT
(RECEIVE (SETQ STATE (QUOTE REC.INIT)))
(STORE (SETQ STATE (QUOTE SEND.INIT)))
(ERROR "Illegal Kermit operation" FORWHAT))
KERMITSTATE])
(\KERMIT.NEGOTIATE
[LAMBDA (KERMITSTATE) (* ejs: " 5-Jul-85 17:46")
(LET (PARAMETER.PACKET)
(SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(REC.INIT (SETQ PARAMETER.PACKET (\KERMIT.GET.PACKET KERMITSTATE))
(SELECTC (NTHCHARCODE PARAMETER.PACKET KERMIT.PACKET.TYPE)
(KERMIT.SENDINIT.PACKET (\KERMIT.PARSE.REMOTE.PARAMETERS
PARAMETER.PACKET
KERMITSTATE))
(KERMIT.ERROR.PACKET (HELP (\KERMIT.DATASECTION PARAMETER.PACKET)
))
(ERROR "Unexpected packet type: " PARAMETER.PACKET))
[LET ((QBIN (fetch (KERMITSTATE QBIN) of KERMITSTATE)))
(SELECTC QBIN
((CHARCODE N)
(replace (KERMITSTATE QBIN) of KERMITSTATE with NIL))
((CHARCODE Y)
(replace (KERMITSTATE QBIN) of KERMITSTATE
with (CHARCODE &)))
(COND
((OR (AND (GEQ QBIN 33)
(LEQ QBIN 62))
(AND (GEQ QBIN 96)
(LEQ QBIN 126)))
(replace (KERMITSTATE QBIN) of KERMITSTATE
with QBIN]
(\KERMIT.SEND.PARAMETERS KERMITSTATE)
(replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE REC.FILE)))
(SEND.INIT (SETQ PARAMETER.PACKET (\KERMIT.SEND.PARAMETERS KERMITSTATE))
(\KERMIT.PARSE.REMOTE.PARAMETERS PARAMETER.PACKET KERMITSTATE)
(LET ((QBIN (fetch (KERMITSTATE QBIN) of KERMITSTATE)))
(SELECTC QBIN
((CHARCODE &))
((CHARCODE Y)
(replace (KERMITSTATE QBIN) of KERMITSTATE
with (CHARCODE &)))
(replace (KERMITSTATE QBIN) of KERMITSTATE with NIL)))
(replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE SEND.FILE)))
(HELP "Illegal Kermit state" (fetch (KERMITSTATE STATE) of KERMITSTATE])
(\KERMIT.PARSE.REMOTE.PARAMETERS
[LAMBDA (PACKET KERMITSTATE) (* ejs: " 8-Jun-85 17:40")
(LET* ((PARAMETERS (\KERMIT.DATASECTION PACKET))
(NPARAMS (NCHARS PARAMETERS))
(OFFSET 1))
(COND
((ILEQ OFFSET NPARAMS)
[replace (KERMITSTATE MAXL) of KERMITSTATE with (\KERMIT.PARAM.DEFAULT
KERMIT.DEFAULT.RECV.PACKET.SIZE
(\KERMIT.UNCHAR (NTHCHARCODE
PARAMETERS
\KPARM.MAXL]
(add OFFSET 1)))
(COND
((ILEQ OFFSET NPARAMS)
[replace (KERMITSTATE TIME) of KERMITSTATE
with (ITIMES 1000 (\KERMIT.PARAM.DEFAULT (IQUOTIENT KERMIT.DEFAULT.TIMEOUT.TIME 1000)
(\KERMIT.UNCHAR (NTHCHARCODE PARAMETERS
\KPARM.TIME]
(add OFFSET 1)))
(COND
((ILEQ OFFSET NPARAMS)
[replace (KERMITSTATE NPAD) of KERMITSTATE with (\KERMIT.PARAM.DEFAULT
0
(\KERMIT.UNCHAR (NTHCHARCODE
PARAMETERS
\KPARM.NPAD]
(add OFFSET 1)))
(COND
((ILEQ OFFSET NPARAMS)
[replace (KERMITSTATE PADC) of KERMITSTATE with (\KERMIT.PARAM.DEFAULT
0
(\KERMIT.CTL (NTHCHARCODE PARAMETERS
\KPARM.PADC]
(add OFFSET 1)))
(COND
((ILEQ OFFSET NPARAMS)
[replace (KERMITSTATE EOL) of KERMITSTATE with (\KERMIT.PARAM.DEFAULT
NIL
(\KERMIT.UNCHAR (NTHCHARCODE
PARAMETERS
\KPARM.EOL]
(add OFFSET 1)))
(COND
((ILEQ OFFSET NPARAMS)
(replace (KERMITSTATE QCTL) of KERMITSTATE with (\KERMIT.PARAM.DEFAULT
KERMIT.DEFAULT.PREFIX.CHARACTER
(NTHCHARCODE
PARAMETERS
\KPARM.QCTL)))
(add OFFSET 1)))
(COND
((ILEQ OFFSET NPARAMS)
(replace (KERMITSTATE QBIN) of KERMITSTATE with (\KERMIT.PARAM.DEFAULT NIL
(NTHCHARCODE
PARAMETERS
\KPARM.QBIN)))
(add OFFSET 1])
(\KERMIT.RECEIVE.FILE
[LAMBDA (LOCALFILE KERMITSTATE KERMITSTATUSWINDOW) (* ejs: " 3-Jul-85 21:50")
(LET [FILESTREAM (TYPE (COND
((fetch (KERMITSTATE EOLCONVENTION) of KERMITSTATE)
(QUOTE TEXT))
(T (QUOTE BINARY]
(\KERMIT.INITIALIZE KERMITSTATE (QUOTE RECEIVE))
(\KERMITMSG "Kermit initialized. Waiting for server.")
(COND
((\KERMIT.NEGOTIATE KERMITSTATE)
(\KERMITMSG "Connection established. Waiting for file")
(while (EQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(QUOTE REC.FILE))
do (SETQ FILESTREAM (\KERMIT.DO.FILE.HEADER LOCALFILE TYPE KERMITSTATE))
(SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(REC.DATA (\KERMITMSG (LIST (QUOTE Retrieving)
(FULLNAME FILESTREAM)))
(RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(AND RESETSTATE
(CLOSEF? STREAM)
(DELFILE (FULLNAME
STREAM]
FILESTREAM))
(\KERMIT.RECEIVE.FILE.BYTES FILESTREAM KERMITSTATE
TYPE)))
(COMPLETE (\KERMITMSG "Done")
(RETURN (FULLNAME FILESTREAM)))
(ABORT (ERROR "Remote kermit aborted"))
(ERROR "Unexpected state after REC.FILE" KERMITSTATE])
(\KERMIT.RECEIVE.FILE.BYTES
[LAMBDA (FILESTREAM KERMITSTATE FILETYPE) (* ejs: " 4-Sep-85 03:12")
(bind DONE STRING STRINGSTREAM NOEOLWORRIES SKIPFIRST FILEOLCHAR (FILEOL ←(fetch (STREAM
EOLCONVENTION)
of FILESTREAM))
first [COND
((OR (EQ FILETYPE (QUOTE BINARY))
(EQ FILEOL CRLF.EOLC))
(SETQ NOEOLWORRIES T))
(T (SETQ FILEOLCHAR (SELECTC FILEOL
(CR.EOLC (CHARCODE CR))
(LF.EOLC (CHARCODE LF))
(SHOULDNT]
until DONE as I from 1
do (LET* ((DATA (\KERMIT.GET.PACKET KERMITSTATE))
(TYPE (NTHCHARCODE DATA KERMIT.PACKET.TYPE))
NBYTES)
(SELECTC TYPE
(KERMIT.DATA.PACKET (SETQ STRING (\KERMIT.UNPREFIXIFY (\KERMIT.DATASECTION
DATA)
(fetch (KERMITSTATE
QCTL)
of KERMITSTATE)
(fetch (KERMITSTATE
QBIN)
of KERMITSTATE)
STRING))
(SETQ STRINGSTREAM (\MAKEBASEBYTESTREAM
(fetch (STRINGP BASE) of STRING)
(fetch (STRINGP OFFST) of STRING)
(fetch (STRINGP LENGTH) of STRING)
(QUOTE INPUT)
NIL STRINGSTREAM))
[COND
(SKIPFIRST (SETQ SKIPFIRST NIL)
(LET ((CH (BIN STRINGSTREAM)))
(COND
((EQ CH (CHARCODE LF))
(BOUT FILESTREAM FILEOLCHAR))
(T (BOUT FILESTREAM CH]
[COND
(NOEOLWORRIES (COPYBYTES STRINGSTREAM FILESTREAM))
(T (* The file's eol convention is not CRLF)
[COND
[(EQ (CHARCODE CR)
(NTHCHARCODE STRING (NCHARS STRING)))
(SETQ SKIPFIRST T)
(SETQ NBYTES (SUB1 (NCHARS STRING]
(T (SETQ NBYTES (NCHARS STRING]
(bind CH for I from (ADD1 (GETFILEPTR STRINGSTREAM))
to NBYTES
do (SETQ CH (BIN STRINGSTREAM))
(COND
((NEQ CH (CHARCODE CR))
(BOUT FILESTREAM CH))
((NEQ (SETQ CH (PROGN (add I 1)
(BIN STRINGSTREAM)))
(CHARCODE LF))
(BOUT FILESTREAM CH))
(T (BOUT FILESTREAM FILEOLCHAR]
(\KERMITMSG I)
(\KERMIT.SEND.ACK KERMITSTATE))
(KERMIT.EOF.PACKET (\KERMIT.SEND.ACK KERMITSTATE)
(CLOSEF FILESTREAM)
(\KERMITMSG (CONCAT "Received " (FULLNAME FILESTREAM)))
(replace (KERMITSTATE STATE) of KERMITSTATE
with (QUOTE REC.FILE))
(SETQ DONE T))
(KERMIT.ERROR.PACKET (ERROR (\KERMIT.DATASECTION DATA)
(fetch (KERMITSTATE LASTPACKETOUT) of
KERMITSTATE)))
(ERROR "Unexpected packet type" (CHARACTER TYPE])
(\KERMIT.SEND.FILE
(LAMBDA (LOCALFILE REMOTEFILE TYPE KERMITSTATE KERMITSTATUSWINDOW)
(* ejs: " 7-Oct-85 08:19")
(* * Send a file)
(LET (FILESTREAM)
(\KERMIT.INITIALIZE KERMITSTATE (QUOTE STORE))
(\KERMITMSG "Kermit initialized. Waiting for server.")
(COND
((\KERMIT.NEGOTIATE KERMITSTATE)
(\KERMITMSG (CONCAT "Connection established. Sending file header for "
(FULLNAME LOCALFILE)))
(while (EQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(QUOTE SEND.FILE))
do (SETQ FILESTREAM (OPENSTREAM LOCALFILE (QUOTE INPUT)
(QUOTE OLD)
(BQUOTE ((TYPE , TYPE)
(SEQUENTIAL T)))))
(SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(SEND.FILE (\KERMIT.SEND.FILE.HEADER REMOTEFILE KERMITSTATE)
(\KERMITMSG (LIST (QUOTE Sending)
(FULLNAME FILESTREAM)))
(RESETLST (RESETSAVE NIL
(LIST
(FUNCTION (LAMBDA (STREAM)
(CLOSEF? STREAM)
(COND
((NOT RESETSTATE)
(\KERMIT.SEND.EOF
KERMITSTATE
RESETSTATE)
(\KERMIT.SEND.BREAK
KERMITSTATE)))
(replace (KERMITSTATE
STATE)
of KERMITSTATE
with (QUOTE
COMPLETE))))
FILESTREAM))
(\KERMIT.SEND.FILE.BYTES FILESTREAM
KERMITSTATE TYPE))
)
(COMPLETE (\KERMITMSG "Done")
(RETURN))
(ABORT (ERROR "Remote kermit aborted"))
(ERROR "Unexpected state after SEND.FILE" KERMITSTATE))))))))
(\KERMIT.SEND.FILE.BYTES
[LAMBDA (FILESTREAM KERMITSTATE TYPE) (* ejs: " 3-Jul-85 22:33")
(* * Send all the bytes of file)
(replace (STREAM ENDOFSTREAMOP) of FILESTREAM with (FUNCTION [LAMBDA NIL -1]))
(bind (PACKET ←(ALLOCSTRING (fetch (KERMITSTATE MAXL) of KERMITSTATE)))
(QCTL ←(fetch (KERMITSTATE QCTL) of KERMITSTATE))
(QBIN ←(fetch (KERMITSTATE QBIN) of KERMITSTATE))
(EOLWORRIES ←(AND (NEQ TYPE (QUOTE BINARY))
(NEQ (fetch (STREAM EOLCONVENTION) of FILESTREAM)
CRLF.EOLC)))
(FILEOLCHAR ←(AND (NEQ TYPE (QUOTE BINARY))
(SELECTC (fetch (STREAM EOLCONVENTION) of FILESTREAM)
(LF.EOLC (CHARCODE LF))
(CR.EOLC (CHARCODE CR))
NIL)))
DONE CHAR MASKEDCHAR WAITINGCHAR DATASECTION FILLEDATASECTION MAXCHARS CHARINDEX LFPENDING
first (SETQ DATASECTION (\KERMIT.DATASECTION PACKET))
(SETQ MAXCHARS (NCHARS DATASECTION))
until DONE as I from 1
do (for old CHARINDEX from 1 to MAXCHARS
do [SETQ CHAR (COND
(WAITINGCHAR (PROG1 (COND
(LFPENDING
(* The waiting char must have been the eol char of the input file, which could would have been changed below if
input file eol char is LF)
FILEOLCHAR)
(T WAITINGCHAR))
(SETQ LFPENDING NIL)
(SETQ WAITINGCHAR NIL)))
(LFPENDING (COND
((EQ FILEOLCHAR (CHARCODE CR))
(* Have to set LFPENDING to NIL here, otherwise it will
stay on forever)
(SETQ LFPENDING NIL)))
(CHARCODE LF))
(T (BIN FILESTREAM]
(COND
((EQ -1 CHAR)
(SETQ DONE T)
(RETURN)))
[COND
((EQ CHAR FILEOLCHAR) (* Have to fix up eol convention)
(COND
((NOT LFPENDING)
(SETQ CHAR (CHARCODE CR))
(SETQ LFPENDING T))
(T (* If CHAR=EOLCHAR and LFPENDING is T, EOL char must be
LF)
(SETQ LFPENDING NIL]
(COND
((AND QBIN (IGREATERP CHAR (MASK.1'S 0 7)))
(SETQ MASKEDCHAR (LOGAND CHAR (MASK.1'S 0 7)))
(COND
([OR (EQ CHARINDEX MAXCHARS)
(AND (EQ CHARINDEX (SUB1 MAXCHARS))
(OR (ILESSP MASKEDCHAR (CHARCODE SPACE))
(EQ MASKEDCHAR QBIN)
(EQ MASKEDCHAR QCTL)
(EQ MASKEDCHAR (CHARCODE DEL]
(* No room for possible quoted and controlified
character)
(SETQ WAITINGCHAR CHAR)
(RETURN)))
(RPLCHARCODE DATASECTION CHARINDEX QBIN)
(SETQ CHAR (LOGAND CHAR (MASK.1'S 0 7)))
(add CHARINDEX 1)))
(COND
((OR (ILESSP CHAR (CHARCODE SPACE))
(EQ CHAR QBIN)
(EQ CHAR QCTL)
(EQ CHAR (CHARCODE DEL)))
(COND
((EQ CHARINDEX MAXCHARS) (* No room for both prefix and controlified character)
(SETQ WAITINGCHAR CHAR)
(RETURN)))
(RPLCHARCODE DATASECTION CHARINDEX QCTL)
[COND
((OR (EQ CHAR QBIN)
(EQ CHAR QCTL)))
(T (SETQ CHAR (\KERMIT.CTL CHAR]
(add CHARINDEX 1)))
(RPLCHARCODE DATASECTION CHARINDEX CHAR))
(SETQ FILLEDATASECTION (SUBSTRING DATASECTION 1 (SUB1 CHARINDEX)
FILLEDATASECTION))
(COND
((NEQ 0 (NCHARS FILLEDATASECTION))
(\KERMIT.SEND.PACKET FILLEDATASECTION KERMIT.DATA.PACKET KERMITSTATE)
(\KERMITMSG I))
((NOT DONE)
(ERROR "No characters to send, but not done either." KERMITSTATE])
(\KERMIT.SEND.FILE.HEADER
[LAMBDA (FILENAME KERMITSTATE) (* ejs: " 3-Jul-85 16:10")
(* * Receive the file header, open the file according to TYPE, and return)
(\KERMIT.SEND.PACKET (PACKFILENAME.STRING (QUOTE NAME)
(FILENAMEFIELD FILENAME (QUOTE NAME))
(QUOTE EXTENSION)
(FILENAMEFIELD FILENAME (QUOTE EXTENSION)))
KERMIT.FILEHEADER.PACKET KERMITSTATE)
(replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE SEND.DATA])
(\KERMIT.SEND.PACKET
(LAMBDA (CONTENTS TYPE KERMITSTATE SEQNO) (* ejs: " 4-Oct-85 16:36")
(* * Send a packet and wait for the response)
(DECLARE (USEDFREE KERMITSTATUSWINDOW))
(LET ((INSTREAM (fetch (KERMITSTATE INSTREAM) of KERMITSTATE))
(OUTSTREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
(CURRENTSEQNO (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE))
ANSWER.PACKET LENGTH SEQ ANSWER.TYPE CHAR (CHECKSUM 0))
(\KERMIT.CLEAR.INPUT.BUFFER INSTREAM)
(\KERMITTRACE "P:")
(\KERMIT.SEND.STRING CONTENTS TYPE KERMITSTATE SEQNO)
(COND
((AND (EQ TYPE KERMIT.GENERIC.SERVER.COMMAND)
(FMEMB (CHCON1 CONTENTS)
(CONSTANT (BQUOTE (, (CHARCODE F)
,
(CHARCODE L))))))
(SETQ ANSWER.PACKET T))
(T (for RETRIES from 1 to KERMIT.DEFAULT.RETRY.COUNT until ANSWER.PACKET
do (COND
((NEQ RETRIES 1)
(PRIN1 "." KERMITSTATUSWINDOW)))
(COND
((bind GOTIT until (OR (AND (EQ (SETQ CHAR (\KERMIT.TIMED.BIN
INSTREAM
KERMIT.DEFAULT.TIMEOUT.TIME))
(fetch (KERMITSTATE MARKCHAR)
of KERMITSTATE))
(SETQ GOTIT T))
(NULL CHAR))
finally (RETURN GOTIT))
(\KERMITTRACE "[")
(COND
((NOT (SETQ CHECKSUM (\KERMIT.TIMED.BIN INSTREAM
KERMIT.DEFAULT.TIMEOUT.TIME)))
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
KERMITSTATE)
(GO $$ITERATE)))
(COND
((ILEQ (SETQ LENGTH (\KERMIT.UNCHAR CHECKSUM))
0)
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
KERMITSTATE)
(GO $$ITERATE)))
(SETQ ANSWER.PACKET (ALLOCSTRING (IPLUS LENGTH KERMIT.PACKET.LEN)))
(\KERMITTRACE LENGTH)
(RPLCHARCODE ANSWER.PACKET KERMIT.PACKET.LEN LENGTH)
(COND
((NOT (for I from KERMIT.PACKET.SEQ
to (IPLUS LENGTH (CONSTANT (SUB1 KERMIT.PACKET.LEN)))
do (COND
((NOT (SETQ CHAR (\KERMIT.TIMED.BIN INSTREAM
KERMIT.DEFAULT.TIMEOUT.TIME)))
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT)
of KERMITSTATE)
KERMITSTATE)
(SETQ ANSWER.PACKET NIL)
(RETURN)))
(add CHECKSUM CHAR)
(RPLCHARCODE ANSWER.PACKET I CHAR)
finally (RETURN T)))
(GO $$ITERATE)))
(SETQ TYPE (NTHCHARCODE ANSWER.PACKET KERMIT.PACKET.TYPE))
(\KERMITTRACE (CONCAT " " (CHARACTER TYPE)
"]"))
(COND
((ILESSP (SETQ SEQ (\KERMIT.UNCHAR (NTHCHARCODE ANSWER.PACKET
KERMIT.PACKET.SEQ)))
0)
(SETQ ANSWER.PACKET NIL)
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
KERMITSTATE)
(GO $$ITERATE)))
(RPLCHARCODE ANSWER.PACKET KERMIT.PACKET.SEQ SEQ)
(COND
((NEQ (\KERMIT.DEFAULT.CHECKSUM CHECKSUM)
(\KERMIT.TIMED.BIN INSTREAM KERMIT.DEFAULT.TIMEOUT.TIME))
(\KERMITTRACE "X ")
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
KERMITSTATE)
(SETQ ANSWER.PACKET NIL))
((OR (AND (EQ SEQ CURRENTSEQNO)
(EQ TYPE KERMIT.ACK.PACKET))
(AND (EQ SEQ (ADD1 CURRENTSEQNO))
(EQ TYPE KERMIT.NAK.PACKET)))
(replace (KERMITSTATE LASTPACKETIN) of KERMITSTATE with
ANSWER.PACKET)
(\KERMITTRACE SEQ)
(\KERMIT.INCREMENT.SEQNO KERMITSTATE)
(RETURN))
((EQ TYPE KERMIT.ERROR.PACKET)
(ERROR (\KERMIT.DATASECTION ANSWER.PACKET)
(fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)))
((EQ TYPE KERMIT.NAK.PACKET)
(\KERMITTRACE SEQ)
(BREAK1 NIL T)
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
KERMITSTATE)
(SETQ ANSWER.PACKET NIL))
(T (\KERMITTRACE (CONCAT "E(" SEQ "-" CURRENTSEQNO ")"))
(\KERMITTRACE (\KERMIT.DATASECTION ANSWER.PACKET))
(\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
KERMITSTATE)
(SETQ ANSWER.PACKET NIL))))
(T (\KERMIT.WRITE (fetch (KERMITSTATE LASTPACKETOUT) of KERMITSTATE)
KERMITSTATE))))))
(COND
(ANSWER.PACKET)
(T (ERROR "Remote Kermit not responding"))))))
(\KERMIT.SEND.PARAMETERS
[LAMBDA (KERMITSTATE) (* ejs: " 8-Jun-85 17:48")
(LET [(MYPARAMETERS (ALLOCSTRING (CONSTANT (LENGTH \KERMIT.INIT.PARAMETER.OFFSETS]
(RPLCHARCODE MYPARAMETERS \KPARM.MAXL (\KERMIT.CHAR KERMIT.DEFAULT.RECV.PACKET.SIZE))
(RPLCHARCODE MYPARAMETERS \KPARM.TIME (\KERMIT.CHAR (IQUOTIENT KERMIT.DEFAULT.TIMEOUT.TIME
1000)))
(RPLCHARCODE MYPARAMETERS \KPARM.NPAD (\KERMIT.CHAR 0))
(RPLCHARCODE MYPARAMETERS \KPARM.PADC (\KERMIT.CHAR 0))
(RPLCHARCODE MYPARAMETERS \KPARM.EOL (\KERMIT.CHAR 0))
(RPLCHARCODE MYPARAMETERS \KPARM.QCTL KERMIT.DEFAULT.PREFIX.CHARACTER)
(RPLCHARCODE MYPARAMETERS \KPARM.QBIN (CHARCODE &))
(SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(REC.INIT (\KERMIT.SEND.DATA MYPARAMETERS KERMIT.ACK.PACKET KERMITSTATE))
(SEND.INIT (\KERMIT.SEND.PACKET MYPARAMETERS KERMIT.SENDINIT.PACKET KERMITSTATE))
(ERROR "Illegal Kermit state"])
(\KERMIT.SEND.STRING
(LAMBDA (STRING TYPE KERMITSTATE SEQNO) (* ejs: " 7-Oct-85 09:06")
(* * Send a string of data to the remote kermit. The string MUST have been prefixified already)
(LET* ((STREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
(LENGTH (NCHARS STRING))
(PACKET (ALLOCSTRING (IPLUS LENGTH \KERMITOVLEN)))
(CHECKSUM 0)
TEMP)
(RPLCHARCODE PACKET KERMIT.PACKET.MARK (fetch (KERMITSTATE MARKCHAR) of KERMITSTATE))
(RPLCHARCODE PACKET KERMIT.PACKET.LEN (SETQ CHECKSUM
(\KERMIT.CHAR (IPLUS LENGTH (CONSTANT (IDIFFERENCE \KERMITOVLEN
KERMIT.PACKET.LEN)))))
)
(SETQ TEMP (\KERMIT.CHAR (OR SEQNO (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE)
)))
(add CHECKSUM TEMP)
(RPLCHARCODE PACKET KERMIT.PACKET.SEQ TEMP)
(add CHECKSUM TYPE)
(RPLCHARCODE PACKET KERMIT.PACKET.TYPE TYPE)
(COND
((NEQ 0 LENGTH)
(bind CHAR for I from \KERMITOVLEN to (IPLUS LENGTH (CONSTANT (SUB1
\KERMITOVLEN)))
as J from 1 to LENGTH
do (SETQ CHAR (NTHCHARCODE STRING J))
(COND
((ILESSP CHAR (CHARCODE SPACE))
(ERROR "Call to \KERMIT.SEND.STRING with unprefixed characters: " STRING))
)
(add CHECKSUM CHAR)
(RPLCHARCODE PACKET I CHAR))))
(RPLCHARCODE PACKET (NCHARS PACKET)
(\KERMIT.DEFAULT.CHECKSUM CHECKSUM))
(\KERMIT.WRITE PACKET KERMITSTATE)
(replace (KERMITSTATE LASTPACKETOUT) of KERMITSTATE with PACKET)
PACKET)))
(\KERMIT.SHOW.PACKET
(LAMBDA (PACKET) (* ejs: " 8-Jun-85 16:03")
(printout T T "[1]" 20 (CHARACTER (NTHCHARCODE PACKET 1))
T "[2]" 20 (\KERMIT.UNCHAR (NTHCHARCODE PACKET 2))
T "[3]" 20 (NTHCHARCODE PACKET 3)
T "[4]" 20 (CHARACTER (NTHCHARCODE PACKET 4))
T)
(LET ((LEN (\KERMIT.UNCHAR (NTHCHARCODE PACKET 2))))
(for I from KERMIT.PACKET.DATA to (IPLUS KERMIT.PACKET.DATA (IDIFFERENCE LEN KERMIT.PACKET.DATA)
)
do (printout T "[" I "]" 20 (CHARACTER (NTHCHARCODE PACKET I))
T))
(printout T "[" (NCHARS PACKET)
"]" 20 (\KERMIT.UNCHAR (NTHCHARCODE PACKET (NCHARS PACKET)))
T))))
(\KERMIT.TIMED.BIN
(LAMBDA (STREAM TIMER.OR.TIMEOUT TIMERP) (* ejs: " 5-Jul-85 17:20")
(* * If stream is READP, does a BIN, otherwise, waits for the stream's READPEVENT to be notified, using
TIMER.OR.TIMEOUT arg to AWAIT.EVENT. If stream is not READP at the end of this interval, returns NIL)
(COND
((READP STREAM)
(BIN STREAM))
(T (bind (EVENT ←(STREAMPROP STREAM (QUOTE READPEVENT)))
(TIMER ←(COND
(TIMERP TIMER.OR.TIMEOUT)
(T (SETUPTIMER TIMER.OR.TIMEOUT))))
READP until (OR (SETQ READP (READP STREAM))
(TIMEREXPIRED? TIMER))
do (COND
(EVENT (AWAIT.EVENT EVENT TIMER T))
(T (BLOCK)))
finally (RETURN (COND
(READP (BIN STREAM)))))))))
(\KERMIT.UNPREFIXIFY
(LAMBDA (STRING QCTL QBIN OLDSUBSTRING) (* ejs: " 3-Jul-85 21:04")
(* * Return a string in which all prefix chars have been undone)
(LET* ((ORIGINALLENGTH (NCHARS STRING))
(NEWSTRING (ALLOCSTRING ORIGINALLENGTH)))
(bind CHAR 8BITPREFIX for I from 1 to ORIGINALLENGTH as J from 1
do (SETQ CHAR (NTHCHARCODE STRING I))
(COND
((EQ CHAR QBIN)
(add I 1)
(SETQ CHAR (NTHCHARCODE STRING I))
(SETQ 8BITPREFIX T)))
(COND
((EQ CHAR QCTL)
(add I 1)
(SETQ CHAR (NTHCHARCODE STRING I))
(COND
((AND (NEQ CHAR QCTL)
(NEQ CHAR QBIN))
(SETQ CHAR (\KERMIT.CTL CHAR))))))
(COND
(8BITPREFIX (SETQ 8BITPREFIX NIL)
(RPLCHARCODE NEWSTRING J (LOGOR CHAR 128)))
(T (RPLCHARCODE NEWSTRING J CHAR)))
finally (RETURN (SUBSTRING NEWSTRING 1 (SUB1 J)
OLDSUBSTRING))))))
(\KERMIT.WRITE
[LAMBDA (STRING KERMITSTATE) (* ejs: " 8-Jun-85 13:25")
(* * Sends STRING out on STREAM with FORCEOUTPUT)
(LET ((STREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
(EOL (fetch (KERMITSTATE EOL) of KERMITSTATE))
(NPAD (fetch (KERMITSTATE NPAD) of KERMITSTATE))
PADC)
[COND
((NEQ 0 NPAD)
(SETQ PADC (fetch (KERMITSTATE PADC) of KERMITSTATE))
(for I from 1 to NPAD do (BOUT STREAM PADC]
(PRIN3 STRING STREAM)
(COND
(EOL (BOUT STREAM EOL)))
(FORCEOUTPUT STREAM])
)
(* User callable functions)
(DEFINEQ
(KERMIT.RECEIVE
(LAMBDA (REMOTEFILE LOCALFILE WINDOW TYPE) (* ejs: " 4-Oct-85 17:47")
(* * Receive a file from a remote Kermit)
(DECLARE (SPECVARS KERMITSTATUSWINDOW))
(OR WINDOW (SETQ WINDOW (GETTOPVAL (QUOTE CHATWINDOW))))
(COND
((NOT (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(ERROR WINDOW "is not a Chat window"))
((AND REMOTEFILE LOCALFILE)
(LET* ((CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(TYPEOUTPROC (fetch (CHAT.STATE TYPEOUTPROC) of CHATSTATE))
(KERMITSTATUSWINDOW (GETPROMPTWINDOW WINDOW))
(OUTSTREAM (fetch (CHAT.STATE OUTSTREAM) of CHATSTATE))
(KERMITSTATE (create KERMITSTATE
INSTREAM ←(fetch (CHAT.STATE INSTREAM) of CHATSTATE)
OUTSTREAM ← OUTSTREAM
EOLCONVENTION ←(COND
((EQ TYPE (QUOTE TEXT))
CRLF.EOLC)
(T NIL)))))
(\KERMIT.SEND.STRING (MKSTRING REMOTEFILE)
(CHARCODE R)
KERMITSTATE 0)
(RESETLST (RESETSAVE (PROGN (SUSPEND.PROCESS TYPEOUTPROC)
(CLEARW WINDOW))
(LIST (FUNCTION (LAMBDA NIL
(AND RESETSTATE (\KERMIT.SEND.ERROR
"User aborted transaction"
KERMITSTATE))
(RESTART.PROCESS TYPEOUTPROC)
(\KERMITMSG (COND
(RESETSTATE "Kermit aborted")
(T "Kermit file transfer completed"))
)))))
(\KERMIT.RECEIVE.FILE LOCALFILE KERMITSTATE KERMITSTATUSWINDOW))))
(T (printout (GETPROMPTWINDOW WINDOW)
T "You must specify both a local and remote file name")))))
(KERMIT.SEND
(LAMBDA (LOCALFILE REMOTEFILE WINDOW TYPE) (* ejs: " 7-Oct-85 08:19")
(* * Send a file to a remote kermit)
(DECLARE (SPECVARS KERMITSTATUSWINDOW))
(OR WINDOW (SETQ WINDOW (GETTOPVAL (QUOTE CHATWINDOW))))
(COND
(LOCALFILE (LET* ((CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(TYPEOUTPROC (fetch (CHAT.STATE TYPEOUTPROC) of CHATSTATE))
(KERMITSTATUSWINDOW (GETPROMPTWINDOW WINDOW))
(OUTSTREAM (fetch (CHAT.STATE OUTSTREAM) of CHATSTATE))
(KERMITSTATE (create KERMITSTATE
INSTREAM ← (fetch (CHAT.STATE INSTREAM)
of CHATSTATE)
OUTSTREAM ← OUTSTREAM
EOL ← (CHARCODE EOL)
EOLCONVENTION ← (COND
((EQ TYPE (QUOTE TEXT))
CRLF.EOLC)
(T NIL)))))
(RESETLST (RESETSAVE (PROGN (SUSPEND.PROCESS TYPEOUTPROC)
(CLEARW WINDOW))
(LIST (FUNCTION (LAMBDA NIL
(COND
(RESETSTATE (\KERMIT.SEND.ERROR
"Kermit aborted"
KERMITSTATE)))
(RESTART.PROCESS TYPEOUTPROC)
(\KERMITMSG (COND
(RESETSTATE
"Kermit aborted")
(T
"Kermit file transfer completed")))))
))
(\KERMIT.SEND.FILE LOCALFILE REMOTEFILE TYPE KERMITSTATE
KERMITSTATUSWINDOW))))
(T "You must specify a file name"))))
(KERMIT.SERVER.COMMAND
(LAMBDA (COMMAND SUBCOMMAND WINDOW) (* ejs: " 4-Oct-85 16:33")
(* * Cause the remote Kermit to execute a subcommand)
(LET* ((CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(TYPEOUTPROC (fetch (CHAT.STATE TYPEOUTPROC) of CHATSTATE))
(KERMITSTATUSWINDOW (GETPROMPTWINDOW WINDOW NIL NIL T))
(OUTSTREAM (fetch (CHAT.STATE OUTSTREAM) of CHATSTATE))
(KERMITSTATE (create KERMITSTATE
INSTREAM ←(fetch (CHAT.STATE INSTREAM) of CHATSTATE)
OUTSTREAM ← OUTSTREAM)))
(\KERMIT.SEND.PACKET (MKSTRING SUBCOMMAND)
(COND
((SMALLP COMMAND)
COMMAND)
((OR (ATOM COMMAND)
(STRINGP COMMAND))
(CHCON1 COMMAND))
(T (ERROR "Bad command" COMMAND)))
KERMITSTATE 0))))
)
(* Kermit TTY executive, for running Kermit without the TEdit menu)
(DEFINEQ
(KERMIT
(LAMBDA NIL (* ejs: " 7-Jul-85 23:11")
(bind COMMAND while T
do (COND
((NEQ 1 (POSITION))
(TERPRI)))
(SETQ COMMAND (ASKUSER NIL NIL "Kermit> " (QUOTE ((PUSH
" (to a lower Interlisp exec--type OK to return to Kermit)")
(QUIT " (Kermit)")
(RECEIVE " (file) ")
(SEND " (file) ")
(SET " (parameter) ")))))
(SELECTQ COMMAND
(PUSH (TERPRI)
(USEREXEC "←←"))
(QUIT (TERPRI)
(RETURN))
(RECEIVE (KERMIT.EXEC.RECEIVE))
(SEND (KERMIT.EXEC.SEND))
(SET (KERMIT.EXEC.SET))
NIL))))
(KERMIT.EXEC.DEBUGGING
(LAMBDA NIL (* ejs: " 7-Jul-85 22:47")
(COND
((KERMIT.EXEC.ON.OFF NIL)
(SETQ \KERMITTRACEFILE PROMPTWINDOW))
(T (SETQ \KERMITTRACEFILE NIL)))))
(KERMIT.EXEC.FILE
(LAMBDA NIL (* ejs: " 7-Jul-85 22:57")
(SELECTQ (ASKUSER NIL NIL NIL (QUOTE ((TYPE " (of files transferred) "))))
(TYPE (KERMIT.EXEC.FILE.TYPE))
NIL)))
(KERMIT.EXEC.FILE.TYPE
(LAMBDA (PROMPT) (* ejs: " 7-Jul-85 23:19")
(SETQ KERMIT.DEFAULT.FILETYPE (ASKUSER NIL NIL PROMPT (QUOTE ((BINARY " (files)")
(TEXT " (files)")))))))
(KERMIT.EXEC.ON.OFF
(LAMBDA (PROMPT) (* ejs: " 7-Jul-85 22:43")
(ASKUSER NIL NIL PROMPT (QUOTE ((ON "" RETURN T)
(OFF "" RETURN NIL))))))
(KERMIT.EXEC.RECEIVE
(LAMBDA NIL (* ejs: " 7-Jul-85 23:21")
(LET ((REMOTEFILE (bind F until (SETQ F (PROMPTFORWORD " (remote file) ")) finally (RETURN F)))
(LOCALFILE (bind F until (SETQ F (PROMPTFORWORD " (to local file) ")) finally (RETURN F))))
(COND
((NOT (\KERMIT.LIVE.CHATWINDOW KERMIT.DEFAULT.CHATWINDOW))
(printout T T "You must choose a valid Chat window first")
(KERMIT.SET.KERMIT.WINDOW)))
(COND
((NOT (FMEMB KERMIT.DEFAULT.FILETYPE (QUOTE (TEXT BINARY))))
(KERMIT.EXEC.FILE.TYPE "Kermit> SET (parameter) FILE (mode) TYPE (of files transferred) ")))
(KERMIT.RECEIVE REMOTEFILE LOCALFILE KERMIT.DEFAULT.CHATWINDOW KERMIT.DEFAULT.FILETYPE))))
(KERMIT.EXEC.SEND
(LAMBDA NIL (* ejs: " 7-Jul-85 23:18")
(LET ((LOCALFILE (bind F until (INFILEP (SETQ F (PROMPTFORWORD))) do (printout T " (local file) ")
finally (RETURN F)))
(REMOTEFILE (bind F until (SETQ F (PROMPTFORWORD " (to remote file) ")) finally (RETURN F))))
(COND
((NOT (\KERMIT.LIVE.CHATWINDOW KERMIT.DEFAULT.CHATWINDOW))
(printout T T "You must choose a valid Chat window first")
(KERMIT.SET.KERMIT.WINDOW)))
(COND
((NOT (FMEMB KERMIT.DEFAULT.FILETYPE (QUOTE (TEXT BINARY))))
(KERMIT.EXEC.FILE.TYPE "Kermit> SET (parameter) FILE (mode) TYPE (of files transferred) ")))
(KERMIT.SEND LOCALFILE REMOTEFILE KERMIT.DEFAULT.CHATWINDOW KERMIT.DEFAULT.FILETYPE))))
(KERMIT.EXEC.SET
(LAMBDA NIL (* ejs: " 7-Jul-85 23:11")
(LET ((MODE (ASKUSER NIL NIL NIL (QUOTE ((DEBUGGING " (mode) ")
(FILE " (mode) ")
(WINDOW " (for Kermit operations) "))))))
(SELECTQ MODE
(DEBUGGING (KERMIT.EXEC.DEBUGGING))
(FILE (KERMIT.EXEC.FILE))
(WINDOW (KERMIT.SET.KERMIT.WINDOW))
NIL))))
(KERMIT.SET.KERMIT.WINDOW
(LAMBDA NIL (* ejs: " 7-Jul-85 23:06")
(printout PROMPTWINDOW T "Please button inside an open Chat window")
(bind WINDOW until (\KERMIT.LIVE.CHATWINDOW (SETQ WINDOW (WHICHW (GETPOSITION))))
do (COND
(WINDOW (printout PROMPTWINDOW T "That window is not a live Chat window"))
(T printout PROMPTWINDOW T "Please button INSIDE an open Chat window"))
finally (RETURN (SETQ KERMIT.DEFAULT.CHATWINDOW WINDOW)))))
(\KERMIT.LIVE.CHATWINDOW
(LAMBDA (WINDOW) (* ejs: " 7-Jul-85 23:02")
(COND
((WINDOWP WINDOW)
(COND
((WINDOWPROP WINDOW (QUOTE CHATSTATE))
T))))))
)
(* The MODEM program. A sad subset and precursor to KERMIT, but here only for the sake of
compatibility)
(DECLARE: DONTCOPY
(* FOLLOWING DEFINITIONS EXPORTED)
(RPAQQ MODEMCOMMANDS ((MODEM.SOH 1)
(MODEM.ACK 6)
(MODEM.NAK 21)
(MODEM.EOT 4)))
(DECLARE: EVAL@COMPILE
(RPAQQ MODEM.SOH 1)
(RPAQQ MODEM.ACK 6)
(RPAQQ MODEM.NAK 21)
(RPAQQ MODEM.EOT 4)
(CONSTANTS (MODEM.SOH 1)
(MODEM.ACK 6)
(MODEM.NAK 21)
(MODEM.EOT 4))
)
(DECLARE: EVAL@COMPILE
(RPAQQ MODEM.PACKET.LENGTH 128)
(CONSTANTS (MODEM.PACKET.LENGTH 128))
)
(* END EXPORTED DEFINITIONS)
)
(RPAQ? MODEM.MAX.RETRIES 10)
(RPAQ? MODEM.TIMEOUT 10000)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MODEM.TIMEOUT MODEM.MAX.RETRIES)
)
(DEFINEQ
(MODEM.RECEIVE
(LAMBDA (LOCALFILE WINDOW TYPE EOLCONVENTION) (* ejs: " 7-Oct-85 09:01")
(DECLARE (SPECVARS KERMITSTATUSWINDOW))
(OR WINDOW (SETQ WINDOW (GETTOPVAL (QUOTE CHATWINDOW))))
(LET* ((CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(TYPEOUTPROC (fetch (CHAT.STATE TYPEOUTPROC) of CHATSTATE))
(KERMITSTATUSWINDOW (GETPROMPTWINDOW WINDOW))
(OUTSTREAM (fetch (CHAT.STATE OUTSTREAM) of CHATSTATE))
(EOLTYPE (SELECTQ EOLCONVENTION
(CR CR.EOLC)
(LF LF.EOLC)
(CRLF CRLF.EOLC)
(\ILLEGAL.ARG EOLCONVENTION)))
(FILESTREAM (OPENSTREAM LOCALFILE (QUOTE OUTPUT)
(QUOTE NEW)
(BQUOTE ((TYPE (\, TYPE)))))))
(RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STR)
(CLOSEF STR)
(COND
(RESETSTATE (DELFILE (FULLNAME STR))))))
FILESTREAM))
(RESETSAVE (PROGN (SUSPEND.PROCESS TYPEOUTPROC)
(CLEARW WINDOW))
(LIST (FUNCTION (LAMBDA NIL
(RESTART.PROCESS TYPEOUTPROC)
(\KERMITMSG (COND
(RESETSTATE "Modem aborted")
(T "Modem file transfer completed")))))))
(\KERMITMSG (BQUOTE (Receiving file (\, (FULLNAME FILESTREAM)))))
(\MODEM.RECEIVE.FILE.BYTES FILESTREAM (\MODEM.INITIALIZE
(create KERMITSTATE
INSTREAM ← (fetch (CHAT.STATE
INSTREAM)
of CHATSTATE)
OUTSTREAM ← OUTSTREAM
EOLCONVENTION ←
(COND
((EQ TYPE (QUOTE TEXT))
EOLTYPE)
(T NIL)))
(QUOTE RECEIVE))
TYPE)))))
(MODEM.SEND
[LAMBDA (LOCALFILE WINDOW TYPE EOLCONVENTION) (* ejs: "15-Sep-85 17:23")
(* * Send a file to a remote modem program)
(DECLARE (SPECVARS KERMITSTATUSWINDOW))
[OR WINDOW (SETQ WINDOW (GETTOPVAL (QUOTE CHATWINDOW]
(COND
[(AND LOCALFILE (SETQ LOCALFILE (INFILEP LOCALFILE)))
(LET* [(CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(TYPEOUTPROC (fetch (CHAT.STATE TYPEOUTPROC) of CHATSTATE))
(KERMITSTATUSWINDOW (GETPROMPTWINDOW WINDOW))
(OUTSTREAM (fetch (CHAT.STATE OUTSTREAM) of CHATSTATE))
(EOLTYPE (SELECTQ EOLCONVENTION
(CR CR.EOLC)
(LF LF.EOLC)
(CRLF CRLF.EOLC)
(\ILLEGAL.ARG EOLCONVENTION)))
(KERMITSTATE (create KERMITSTATE
INSTREAM ←(fetch (CHAT.STATE INSTREAM) of CHATSTATE)
OUTSTREAM ← OUTSTREAM
EOLCONVENTION ←(COND
((EQ TYPE (QUOTE TEXT))
EOLTYPE)
(T NIL]
(RESETLST [RESETSAVE (PROGN (SUSPEND.PROCESS TYPEOUTPROC)
(CLEARW WINDOW))
(LIST (FUNCTION (LAMBDA NIL
(RESTART.PROCESS TYPEOUTPROC)
(\KERMITMSG (COND
(RESETSTATE "Modem aborted")
(T "Modem file transfer completed"]
(\MODEM.SEND.FILE LOCALFILE REMOTEFILE TYPE KERMITSTATE KERMITSTATUSWINDOW]
(T (HELP "Can't find input file"])
(\MODEM.INITIALIZE
[LAMBDA (KERMITSTATE FORWHAT) (* ejs: " 3-Sep-85 20:31")
(with KERMITSTATE KERMITSTATE (COND
((NOT (OPENP OUTSTREAM (QUOTE OUTPUT)))
(ERROR "KERMIT output stream is not open for output!" OUTSTREAM))
((NOT (OPENP INSTREAM (QUOTE INPUT)))
(ERROR "KERMIT input stream is not open for input!" INSTREAM)))
(SELECTQ FORWHAT
(RECEIVE (SETQ CURRENTSEQNO 1)
(SETQ STATE (QUOTE REC.INIT)))
(STORE (SETQ CURRENTSEQNO 0)
(SETQ STATE (QUOTE SEND.INIT)))
(ERROR "Illegal Kermit operation" FORWHAT))
KERMITSTATE])
(\MODEM.SEND.FILE
[LAMBDA (LOCALFILE REMOTEFILE TYPE KERMITSTATE KERMITSTATUSWINDOW)
(* ejs: " 3-Sep-85 12:25")
(* * Send a file)
(LET (FILESTREAM)
(\MODEM.INITIALIZE KERMITSTATE (QUOTE STORE))
[SETQ FILESTREAM (OPENSTREAM LOCALFILE (QUOTE INPUT)
(QUOTE OLD)
(BQUOTE ((TYPE , TYPE)
(SEQUENTIAL T]
(SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(SEND.INIT (\KERMITMSG (LIST (QUOTE Sending)
(FULLNAME FILESTREAM)))
(RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (STREAM)
(CLOSEF? STREAM)
(\MODEM.SEND.PACKET NIL MODEM.EOT
KERMITSTATE)
(replace (KERMITSTATE STATE)
of KERMITSTATE
with (QUOTE COMPLETE]
FILESTREAM))
(\MODEM.SEND.FILE.BYTES FILESTREAM KERMITSTATE TYPE)))
(COMPLETE (\KERMITMSG "Done"))
(ABORT (ERROR "Remote kermit aborted"))
(ERROR "Unexpected state after SEND.FILE" KERMITSTATE])
(\MODEM.SEND.FILE.BYTES
[LAMBDA (FILESTREAM KERMITSTATE TYPE) (* ejs: "15-Sep-85 15:38")
(* * Send all the bytes of file)
(replace (STREAM ENDOFSTREAMOP) of FILESTREAM with (FUNCTION [LAMBDA NIL -1]))
(LET ([EOLWORRIES (AND (NEQ TYPE (QUOTE BINARY))
(NEQ (fetch (STREAM EOLCONVENTION) of FILESTREAM)
(fetch (KERMITSTATE EOLCONVENTION) of KERMITSTATE]
(INPUT.EOL.IS.CRLF (EQ (fetch (STREAM EOLCONVENTION) of FILESTREAM)
CRLF.EOLC)))
(bind (PACKET ←(ALLOCSTRING MODEM.PACKET.LENGTH))
[EASYEOLWORRIES ←(AND EOLWORRIES (OR (AND (EQ (fetch (STREAM EOLCONVENTION)
of FILESTREAM)
CR.EOLC)
(EQ (fetch (KERMITSTATE EOLCONVENTION)
of KERMITSTATE)
LF.EOLC))
(AND (EQ (fetch (STREAM EOLCONVENTION)
of FILESTREAM)
LF.EOLC)
(EQ (fetch (KERMITSTATE EOLCONVENTION)
of KERMITSTATE)
CR.EOLC]
[FILEOLCHAR ←(AND EOLWORRIES (SELECTC (fetch (STREAM EOLCONVENTION) of FILESTREAM)
(LF.EOLC (CHARCODE LF))
(CR.EOLC (CHARCODE CR))
[CRLF.EOLC (CONSTANT (LIST (CHARCODE CR)
(CHARCODE LF]
(ERROR "Illegal EOL convention on file"
(fetch (STREAM EOLCONVENTION)
of FILESTREAM]
[MODEMEOLCHAR ←(AND EOLWORRIES (SELECTC (fetch (KERMITSTATE EOLCONVENTION)
of KERMITSTATE)
(LF.EOLC (CHARCODE LF))
(CR.EOLC (CHARCODE CR))
[CRLF.EOLC (CONSTANT (LIST (CHARCODE CR)
(CHARCODE LF]
(ERROR
"Illegal EOL convention on modem connection"
(fetch (STREAM EOLCONVENTION)
of FILESTREAM]
DONE CHAR WAITINGCHAR LFPENDING CHARINDEX until DONE as I from 1
do (\ZEROBYTES (\ADDBASE (fetch (STRINGP BASE) of PACKET)
(fetch (STRINGP OFFST) of PACKET))
0
(SUB1 (fetch (STRINGP LENGTH) of PACKET)))
(for old CHARINDEX from 1 to MODEM.PACKET.LENGTH
do [SETQ CHAR (COND
(LFPENDING (SETQ LFPENDING NIL)
(CHARCODE LF))
(T (BIN FILESTREAM]
[COND
((EQ -1 CHAR) (* Reached EOL on input file)
(SETQ DONE T)
(RETURN))
((NULL EOLWORRIES) (* EOL conventions are no problem)
)
[EASYEOLWORRIES (* EOL convention can be taken care of easily)
(COND
((EQ CHAR FILEOLCHAR)
(SETQ CHAR MODEMEOLCHAR]
[INPUT.EOL.IS.CRLF
(* EOL convention will be hard. This means that the input file's EOL convention is CRLF, while the remote file's
convention is CR or LF alone.)
(COND
((EQ CHAR (CHARCODE CR))
(* Perhaps an EOL)
(COND
((EQ (\PEEKBIN FILESTREAM T)
(CHARCODE LF))
(* Yes)
(BIN FILESTREAM)
(SETQ CHAR MODEMEOLCHAR]
(T
(* EOL convention is even harder. The input file's EOL convention is CR or LF, while the output file's convention is
CRLF. We may have the buffer the LF char across packets)
(COND
((EQ CHAR FILEOLCHAR)
(SETQ CHAR (CHARCODE CR))
(SETQ LFPENDING T]
(RPLCHARCODE PACKET CHARINDEX CHAR))
(COND
((NEQ 1 CHARINDEX)
(\MODEM.SEND.PACKET PACKET MODEM.SOH KERMITSTATE)
(\KERMITMSG I))
((NOT DONE)
(ERROR "No characters to send, but not done either." KERMITSTATE])
(\MODEM.SEND.PACKET
(LAMBDA (STRING TYPE KERMITSTATE) (* ejs: " 7-Oct-85 10:00")
(LET ((INSTREAM (fetch (KERMITSTATE INSTREAM) of KERMITSTATE))
(OUTSTREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
SEQNO NOTSEQNO RESPONSE CHECKSUM)
(COND
((EQ TYPE MODEM.SOH)
(* * This packet contains data, and we expect an ack)
(SETQ SEQNO (replace (KERMITSTATE CURRENTSEQNO) of KERMITSTATE
with (LOGAND (ADD1 (fetch (KERMITSTATE CURRENTSEQNO)
of KERMITSTATE))
(MASK.1'S 0 BITSPERBYTE))))
(SETQ NOTSEQNO (LOGAND (LOGNOT SEQNO)
(MASK.1'S 0 BITSPERBYTE)))
(\KERMITTRACE (CONCAT "P:SOH--" SEQNO "->" NOTSEQNO))
(SETQ CHECKSUM (LOGAND (IPLUS MODEM.SOH SEQNO NOTSEQNO
(for CHAR instring STRING sum CHAR))
(MASK.1'S 0 BITSPERBYTE)))
(bind ACKNOWLEDGED (RETRYCOUNT ← 0) until ACKNOWLEDGED
do (BOUT OUTSTREAM MODEM.SOH) (* Send the start of packet indicator)
(BOUT OUTSTREAM SEQNO) (* Send the sequence number)
(BOUT OUTSTREAM NOTSEQNO) (* Send the 1's complement of the seqno)
(\BOUTS OUTSTREAM (fetch (STRINGP BASE) of STRING)
(fetch (STRINGP OFFST) of STRING)
(fetch (STRINGP LENGTH) of STRING))
(* Send the data)
(BOUT OUTSTREAM CHECKSUM) (* Send the checksum)
(COND
((fetch (FDEV BUFFERED) of (fetch (STREAM DEVICE) of OUTSTREAM))
(FORCEOUTPUT OUTSTREAM))) (* If necessary, force the block on its way)
(SETQ RESPONSE (\KERMIT.TIMED.BIN INSTREAM MODEM.TIMEOUT))
(SELECTC RESPONSE
(MODEM.ACK (SETQ ACKNOWLEDGED T)
(\KERMITTRACE "! "))
(MODEM.NAK (\KERMITTRACE "R")
(COND
((EQ (add RETRYCOUNT 1)
MODEM.MAX.RETRIES)
(\KERMITMSG "Remote MODEM program not responding")
(ERROR!))))
(PROGN (PRIN1 "." KERMITSTATUSWINDOW)
(\KERMITTRACE (COND
(RESPONSE (CHARACTER RESPONSE))
(T "?")))))))
((EQ TYPE MODEM.EOT)
(\KERMITTRACE "P:EOT--")
(bind ACKNOWLEDGED (RETRYCOUNT ← 0) until ACKNOWLEDGED
do (BOUT OUTSTREAM MODEM.EOT)
(COND
((fetch (FDEV BUFFERED) of (fetch (STREAM DEVICE) of OUTSTREAM))
(FORCEOUTPUT OUTSTREAM)))
(COND
((EQ (\KERMIT.TIMED.BIN INSTREAM MODEM.TIMEOUT)
MODEM.ACK)
(SETQ ACKNOWLEDGED T)
(\KERMITTRACE "! "))
(T (COND
((EQ (add RETRYCOUNT 1)
MODEM.MAX.RETRIES)
(\KERMITTRACE "R")
(\KERMITMSG "Remote MODEM program not responding")
(ERROR!)))))))
(T (BOUT OUTSTREAM TYPE)
(FORCEOUTPUT OUTSTREAM)
(\KERMITTRACE "P:")
(\KERMITTRACE (CHARACTER TYPE)))))))
(\MODEM.CLEAR.INPUT
(LAMBDA (STREAM) (* ejs: " 3-Sep-85 19:59")
(while (READP STREAM) do (BIN STREAM))))
(\MODEM.RECEIVE.FILE.BYTES
[LAMBDA (FILESTREAM KERMITSTATE TYPE) (* jmh "11-Oct-85 15:58")
(LET* ([EOLWORRIES (AND (NEQ TYPE (QUOTE BINARY))
(NEQ (fetch (STREAM EOLCONVENTION) of FILESTREAM)
(fetch (KERMITSTATE EOLCONVENTION) of KERMITSTATE]
[FILEOLCHAR (AND (NEQ TYPE (QUOTE BINARY))
(SELECTC (fetch (STREAM EOLCONVENTION) of FILESTREAM)
(CR.EOLC (CHARCODE CR))
(LF.EOLC (CHARCODE LF))
[CRLF.EOLC (CONSTANT (LIST (CHARCODE CR)
(CHARCODE LF]
(HELP "Unknown file EOL convention"]
[MODEMEOLCHAR (AND (NEQ TYPE (QUOTE BINARY))
(SELECTC (fetch (KERMITSTATE EOLCONVENTION) of KERMITSTATE)
(CR.EOLC (CHARCODE CR))
(LF.EOLC (CHARCODE LF))
[CRLF.EOLC (CONSTANT (LIST (CHARCODE CR)
(CHARCODE LF]
(HELP "Unknown file EOL convention"]
[EASYEOLWORRIES (AND EOLWORRIES (OR (AND (EQ FILEOLCHAR (CHARCODE CR))
(EQ MODEMEOLCHAR (CHARCODE LF)))
(AND (EQ FILEOLCHAR (CHARCODE LF))
(EQ MODEMEOLCHAR (CHARCODE CR]
(REMOTE.EOL.IS.CRLF (EQ (fetch (KERMITSTATE EOLCONVENTION) of KERMITSTATE)
CRLF.EOLC))
PACKET LASTWASCR)
(for I from 1 while (STRINGP (SETQ PACKET (\MODEM.RECEIVE.PACKET KERMITSTATE MODEM.SOH)))
do (COND
(\KERMITTRACEFILE (TERPRI \KERMITTRACEFILE)
[for CH instring PACKET do (COND
((ILESSP CH (CHARCODE SPACE))
(printout \KERMITTRACEFILE "[" CH
"]"))
(T (PRIN1 (CHARACTER CH)
\KERMITTRACEFILE]
(TERPRI \KERMITTRACEFILE)))
[COND
((NULL EOLWORRIES) (* EOL convention is no problem.
Dump out the packet in one shot)
(\BOUTS FILESTREAM (fetch (STRINGP BASE) of PACKET)
(fetch (STRINGP OFFST) of PACKET)
(fetch (STRINGP LENGTH) of PACKET)))
(EASYEOLWORRIES (* EOL convention switch is a simple character mapping)
(for CHAR instring PACKET
do (COND
((EQ CHAR MODEMEOLCHAR)
(SETQ CHAR FILEOLCHAR)))
(BOUT FILESTREAM CHAR)))
[(NOT REMOTE.EOL.IS.CRLF) (* The local EOL convention is CRLF while the remote is
either CR or LF)
(for CHAR instring PACKET do (COND
((EQ CHAR MODEMEOLCHAR)
(BOUT FILESTREAM (CHARCODE CR))
(BOUT FILESTREAM (CHARCODE LF)))
(T (BOUT FILESTREAM CHAR]
(T (* This is hard. The remote eol convention is CRLF and
ours is either CR or LF)
(LET ((BASE (\ADDBASE (fetch (STRINGP BASE) of PACKET)
(fetch (STRINGP OFFST) of PACKET)))
(LENGTH (fetch (STRINGP LENGTH) of PACKET))
(START 0))
[COND
(LASTWASCR
(* The last character of the last packet was a CR. If the first character of the current packet is an LF, we output
a file eol character)
(SETQ LASTWASCR NIL)
(COND
((EQ (\GETBASEBYTE BASE 0)
(CHARCODE LF))
(BOUT FILESTREAM FILEOLCHAR)
(* Yes. Output the right EOL char and skip the first
character in this packet)
(SETQ START 1))
(T (* No, output the CR on its own)
(BOUT FILESTREAM (CHARCODE CR]
(bind CHAR for I from START to (SUB1 LENGTH)
do (SETQ CHAR (\GETBASEBYTE BASE I))
(COND
[(EQ CHAR (CHARCODE CR)) (* Possible CRLF coming in)
(COND
((EQ I (SUB1 LENGTH))
(* This was the last character in the packet)
(SETQ LASTWASCR T))
((EQ (\GETBASEBYTE BASE (ADD1 I))
(CHARCODE LF)) (* Reading a CRLF)
(add I 1)
(BOUT FILESTREAM FILEOLCHAR))
(T (BOUT FILESTREAM CHAR]
(T (BOUT FILESTREAM CHAR]
(\KERMITMSG I)
finally (RETURN (COND
((EQ PACKET (QUOTE DONE))
T])
(\MODEM.RECEIVE.PACKET
(LAMBDA (KERMITSTATE TYPE) (* ejs: " 7-Oct-85 08:49")
(LET ((INSTREAM (fetch (KERMITSTATE INSTREAM) of KERMITSTATE))
(OUTSTREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
(PACKET (fetch (KERMITSTATE LASTPACKETIN) of KERMITSTATE))
CHAR PACKETSEQNO CHECKSUM)
(COND
((NOT PACKET)
(SETQ PACKET (replace (KERMITSTATE LASTPACKETIN) of KERMITSTATE
with (ALLOCSTRING MODEM.PACKET.LENGTH))))
(T (\ZEROBYTES (\ADDBASE (fetch (STRINGP BASE) of PACKET)
(fetch (STRINGP OFFST) of PACKET))
0
(SUB1 (fetch (STRINGP LENGTH) of PACKET)))))
(bind OK (RETRYCOUNT ← 0) until OK
do (COND
((EQ (add RETRYCOUNT 1)
MODEM.MAX.RETRIES)
(\KERMITMSG "Remote MODEM not responding.")
(ERROR!)))
(COND
((EQ (SETQ CHAR (\KERMIT.TIMED.BIN INSTREAM MODEM.TIMEOUT))
TYPE)
(SETQ CHECKSUM CHAR)
(COND
((EQ CHAR MODEM.SOH) (* There's more to come)
(\KERMITTRACE "G:")
(\KERMITTRACE (CHARACTER CHAR))
(COND
((SMALLP (SETQ PACKETSEQNO (\KERMIT.TIMED.BIN INSTREAM
MODEM.TIMEOUT)))
(add CHECKSUM PACKETSEQNO))
(T (PRIN1 "." KERMITSTATUSWINDOW)
(\MODEM.CLEAR.INPUT INSTREAM)
(\MODEM.SEND.PACKET NIL MODEM.NAK KERMITSTATE)
(GO $$ITERATE)))
(COND
((SMALLP (SETQ CHAR (\KERMIT.TIMED.BIN INSTREAM MODEM.TIMEOUT)))
(add CHECKSUM CHAR))
(T (PRIN1 "." KERMITSTATUSWINDOW)
(\MODEM.CLEAR.INPUT INSTREAM)
(\MODEM.SEND.PACKET NIL MODEM.NAK KERMITSTATE)
(GO $$ITERATE)))
(\KERMITTRACE PACKETSEQNO)
(COND
((NEQ 0 (LOGAND CHECKSUM (MASK.1'S 0 BITSPERBYTE)))
(\MODEM.CLEAR.INPUT INSTREAM)
(\MODEM.SEND.PACKET NIL MODEM.NAK KERMITSTATE))
((EQ PACKETSEQNO (SUB1 (fetch (KERMITSTATE CURRENTSEQNO)
of KERMITSTATE)))
(\MODEM.CLEAR.INPUT INSTREAM)
(\MODEM.SEND.PACKET NIL MODEM.ACK KERMITSTATE))
((NEQ PACKETSEQNO (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE)
)
(\MODEM.CLEAR.INPUT INSTREAM)
(\MODEM.SEND.PACKET NIL MODEM.NAK KERMITSTATE))
(T (for I from 1 to MODEM.PACKET.LENGTH
do (COND
((SMALLP (SETQ CHAR (\KERMIT.TIMED.BIN INSTREAM
MODEM.TIMEOUT)))
(add CHECKSUM CHAR)
(RPLCHARCODE PACKET I CHAR))
(T (PRIN1 "." KERMITSTATUSWINDOW)
(\MODEM.CLEAR.INPUT INSTREAM)
(\MODEM.SEND.PACKET NIL MODEM.NAK KERMITSTATE)
(GO $$ITERATE))))
(COND
((NEQ (\KERMIT.TIMED.BIN INSTREAM MODEM.TIMEOUT)
(LOGAND CHECKSUM (MASK.1'S 0 BITSPERBYTE)))
(PRIN1 "." KERMITSTATUSWINDOW)
(\MODEM.SEND.PACKET NIL MODEM.NAK KERMITSTATE))
(T (SETQ OK T)
(replace (KERMITSTATE CURRENTSEQNO) of KERMITSTATE
with (LOGAND (ADD1 (fetch (KERMITSTATE CURRENTSEQNO)
of KERMITSTATE))
(MASK.1'S 0 BITSPERBYTE)))
(\MODEM.SEND.PACKET NIL MODEM.ACK KERMITSTATE))))))))
((EQ CHAR MODEM.EOT)
(* * We're done)
(\KERMITTRACE "EOT")
(SETQ OK T)
(\MODEM.SEND.PACKET NIL MODEM.ACK KERMITSTATE)
(SETQ PACKET (QUOTE DONE)))
(T (\KERMITTRACE "?")
(COND
(CHAR (\KERMITTRACE (CHARACTER CHAR))))
(\MODEM.CLEAR.INPUT INSTREAM)
(\MODEM.SEND.PACKET NIL MODEM.NAK KERMITSTATE))))
PACKET)))
)
(PUTPROPS KERMIT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (11473 43592 (\KERMIT.CLEAR.INPUT.BUFFER 11483 . 11667) (\KERMIT.DO.FILE.HEADER 11669 .
12855) (\KERMIT.GET.PACKET 12857 . 16581) (\KERMIT.INITIALIZE 16583 . 17238) (\KERMIT.NEGOTIATE 17240
. 19272) (\KERMIT.PARSE.REMOTE.PARAMETERS 19274 . 21543) (\KERMIT.RECEIVE.FILE 21545 . 22958) (
\KERMIT.RECEIVE.FILE.BYTES 22960 . 26011) (\KERMIT.SEND.FILE 26013 . 27867) (\KERMIT.SEND.FILE.BYTES
27869 . 31881) (\KERMIT.SEND.FILE.HEADER 31883 . 32450) (\KERMIT.SEND.PACKET 32452 . 37341) (
\KERMIT.SEND.PARAMETERS 37343 . 38427) (\KERMIT.SEND.STRING 38429 . 40224) (\KERMIT.SHOW.PACKET 40226
. 40998) (\KERMIT.TIMED.BIN 41000 . 41851) (\KERMIT.UNPREFIXIFY 41853 . 42905) (\KERMIT.WRITE 42907
. 43590)) (43629 47806 (KERMIT.RECEIVE 43639 . 45374) (KERMIT.SEND 45376 . 46911) (
KERMIT.SERVER.COMMAND 46913 . 47804)) (47883 52579 (KERMIT 47893 . 48633) (KERMIT.EXEC.DEBUGGING 48635
. 48891) (KERMIT.EXEC.FILE 48893 . 49151) (KERMIT.EXEC.FILE.TYPE 49153 . 49404) (KERMIT.EXEC.ON.OFF
49406 . 49620) (KERMIT.EXEC.RECEIVE 49622 . 50458) (KERMIT.EXEC.SEND 50460 . 51327) (KERMIT.EXEC.SET
51329 . 51773) (KERMIT.SET.KERMIT.WINDOW 51775 . 52339) (\KERMIT.LIVE.CHATWINDOW 52341 . 52577)) (
53355 74661 (MODEM.RECEIVE 53365 . 55196) (MODEM.SEND 55198 . 56684) (\MODEM.INITIALIZE 56686 . 57375)
(\MODEM.SEND.FILE 57377 . 58551) (\MODEM.SEND.FILE.BYTES 58553 . 62629) (\MODEM.SEND.PACKET 62631 .
65811) (\MODEM.CLEAR.INPUT 65813 . 65989) (\MODEM.RECEIVE.FILE.BYTES 65991 . 70688) (
\MODEM.RECEIVE.PACKET 70690 . 74659)))))
STOP