(FILECREATED " 3-Jan-86 17:10:20" {ERIS}<LISPCORE>LIBRARY>DIGEST.;3 14384
changes to: (FNS DIGEST.FILE \DIGEST.FILE.FOR.TRANSMISSION \DIGEST.INITIALIZE
\DIGEST.SEND.FILE.BYTES \DIGEST.SEND.PARAMETERS \DIGEST.WRITE
\DIGEST.PREAMBLE \DIGEST.SEND.STRING \DIGEST.SEND.HEADER \DIGEST.SEND.PACKET)
(MACROS \DIGEST.INCREMENT.SEQNO \DIGEST.DEFAULT.CHECKSUM \DIGEST.CTL \DIGEST.CHAR)
(VARS DIGESTCOMS DIGEST.PACKET.TYPES \DIGESTOVLEN \DIGEST.INIT.PARAMETER.OFFSETS)
previous date: " 3-Jan-86 16:49:25" {ERIS}<LISPCORE>LIBRARY>DIGEST.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DIGESTCOMS)
(RPAQQ DIGESTCOMS ((MACROS \DIGEST.CHAR \DIGEST.CTL \DIGEST.DEFAULT.CHECKSUM
\DIGEST.INCREMENT.SEQNO)
(VARS DIGEST.PACKET.TYPES \DIGEST.INIT.PARAMETER.OFFSETS \DIGESTOVLEN)
(FNS DIGEST.FILE \DIGEST.FILE.FOR.TRANSMISSION \DIGEST.INITIALIZE
\DIGEST.PREAMBLE \DIGEST.SEND.FILE.BYTES \DIGEST.SEND.HEADER
\DIGEST.SEND.PACKET \DIGEST.SEND.PARAMETERS \DIGEST.SEND.STRING
\DIGEST.WRITE)
(RECORDS KERMITSTATE)))
(DECLARE: EVAL@COMPILE
(DEFMACRO \DIGEST.CHAR (X)
(BQUOTE (IPLUS (\, X)
32)))
(DEFMACRO \DIGEST.CTL (X)
(BQUOTE (LOGAND (MASK.1'S 0 8)
(LOGXOR , X 64))))
(DEFMACRO \DIGEST.DEFAULT.CHECKSUM (S)
(BQUOTE (\KERMIT.CHAR (LOGAND (IPLUS (\, S)
(FOLDLO (LOGAND (\, S)
192)
64))
(MASK.1'S 0 6)))))
(DEFMACRO \DIGEST.INCREMENT.SEQNO (KERMITSTATE)
(BQUOTE (change (fetch (KERMITSTATE CURRENTSEQNO)
of
(\, KERMITSTATE))
(IMOD (ADD1 DATUM)
64))))
)
(RPAQQ DIGEST.PACKET.TYPES ((DIGEST.DATA.PACKET (CHARCODE D))
(DIGEST.ACK.PACKET (CHARCODE Y))
(DIGEST.NAK.PACKET (CHARCODE N))
(DIGEST.SENDINIT.PACKET (CHARCODE S))
(DIGEST.BREAK.PACKET (CHARCODE B))
(DIGEST.FILEHEADER.PACKET (CHARCODE F))
(DIGEST.EOF.PACKET (CHARCODE Z))
(DIGEST.ERROR.PACKET (CHARCODE E))
(DIGEST.ILLEGAL.PACKET (CHARCODE T))
(DIGEST.GENERIC.SERVER.COMMAND (CHARCODE G))))
(RPAQQ \DIGEST.INIT.PARAMETER.OFFSETS ((\KPARM.MAXL 1)
(\KPARM.TIME 2)
(\KPARM.NPAD 3)
(\KPARM.PADC 4)
(\KPARM.EOL 5)
(\KPARM.QCTL 6)
(\KPARM.QBIN 7)))
(RPAQQ \DIGESTOVLEN 5)
(DEFINEQ
(DIGEST.FILE
(LAMBDA (INPUTFILE OUTPUTFILE) (* ejs: " 3-Jan-86 17:01")
(* * Send a file to a remote kermit)
(COND
((AND (SETQ INPUTFILE (INFILEP INPUTFILE))
OUTPUTFILE)
(LET* ((KERMITSTATE (create KERMITSTATE
EOL ←(CHARCODE EOL)
EOLCONVENTION ← NIL)))
(\DIGEST.FILE.FOR.TRANSMISSION INPUTFILE OUTPUTFILE KERMITSTATE)))
(OUTPUTFILE (ERROR "Can't find input file")))))
(\DIGEST.FILE.FOR.TRANSMISSION
(LAMBDA (LOCALFILE REMOTEFILE KERMITSTATE) (* ejs: " 3-Jan-86 17:04")
(* * Send a file)
(LET ((OUTPUTSTREAM (COND
((STREAMP REMOTEFILE)
REMOTEFILE)
(T (OPENSTREAM REMOTEFILE (QUOTE OUTPUT)
(QUOTE NEW)
(QUOTE ((TYPE BINARY)
(SEQUENTIAL T)))))))
INPUTSTREAM)
(\DIGEST.INITIALIZE KERMITSTATE OUTPUTSTREAM (QUOTE STORE))
(COND
((\DIGEST.PREAMBLE KERMITSTATE)
(SETQ INPUTSTREAM (OPENSTREAM LOCALFILE (QUOTE INPUT)
(QUOTE OLD)
(QUOTE ((TYPE BINARY)
(SEQUENTIAL T)))))
(RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (STREAM)
(CLOSEF? STREAM)))
INPUTSTREAM))
(\DIGEST.SEND.HEADER LOCALFILE KERMITSTATE)
(\DIGEST.SEND.FILE.BYTES INPUTSTREAM KERMITSTATE))
(replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE COMPLETE)))))))
(\DIGEST.INITIALIZE
(LAMBDA (KERMITSTATE OUTPUTSTREAM FORWHAT) (* ejs: " 3-Jan-86 17:09")
(with KERMITSTATE KERMITSTATE (SETQ CURRENTSEQNO 0)
(SETQ OUTSTREAM OUTPUTSTREAM)
(SETQ QBIN (CHARCODE &))
(SELECTQ FORWHAT
(RECEIVE (SETQ STATE (QUOTE REC.INIT)))
(STORE (SETQ STATE (QUOTE SEND.INIT)))
(ERROR "Illegal Kermit operation" FORWHAT))
KERMITSTATE)))
(\DIGEST.PREAMBLE
(LAMBDA (KERMITSTATE) (* ejs: " 3-Jan-86 16:54")
(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)))))
(\DIGEST.SEND.PARAMETERS KERMITSTATE)
(replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE
REC.FILE)))
(SEND.INIT (\DIGEST.SEND.PARAMETERS KERMITSTATE)
(replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE
SEND.FILE)))
(HELP "Illegal Kermit state" (fetch (KERMITSTATE STATE) of KERMITSTATE))))))
(\DIGEST.SEND.FILE.BYTES
(LAMBDA (FILESTREAM KERMITSTATE) (* ejs: " 3-Jan-86 17:02")
(* * 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))
DONE CHAR MASKEDCHAR DATASECTION FILLEDATASECTION MAXCHARS CHARINDEX
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 (BIN FILESTREAM))
(COND
((EQ -1 CHAR)
(SETQ DONE T)
(RETURN)))
(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))
(\DIGEST.SEND.PACKET FILLEDATASECTION KERMIT.DATA.PACKET KERMITSTATE))
((NOT DONE)
(ERROR "No characters to send, but not done either." KERMITSTATE))))))
(\DIGEST.SEND.HEADER
(LAMBDA (FILENAME KERMITSTATE) (* ejs: " 3-Jan-86 16:41")
(* * Receive the file header, open the file according to TYPE, and return)
(\DIGEST.SEND.PACKET (PACKFILENAME.STRING (QUOTE NAME)
(FILENAMEFIELD FILENAME (QUOTE NAME))
(QUOTE EXTENSION)
(FILENAMEFIELD FILENAME (QUOTE EXTENSION)))
DIGEST.FILEHEADER.PACKET KERMITSTATE)
(replace (KERMITSTATE STATE) of KERMITSTATE with (QUOTE SEND.DATA))))
(\DIGEST.SEND.PACKET
(LAMBDA (CONTENTS TYPE KERMITSTATE SEQNO) (* ejs: " 3-Jan-86 16:40")
(* * Send a packet and wait for the response)
(DECLARE (USEDFREE KERMITSTATUSWINDOW))
(LET ((OUTSTREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
(CURRENTSEQNO (fetch (KERMITSTATE CURRENTSEQNO) of KERMITSTATE))
ANSWER.PACKET LENGTH SEQ ANSWER.TYPE CHAR (CHECKSUM 0))
(\DIGEST.SEND.STRING CONTENTS TYPE KERMITSTATE SEQNO)
(\DIGEST.INCREMENT.SEQNO KERMITSTATE))))
(\DIGEST.SEND.PARAMETERS
(LAMBDA (KERMITSTATE) (* ejs: " 3-Jan-86 16:51")
(LET ((MYPARAMETERS (ALLOCSTRING (CONSTANT (LENGTH \DIGEST.INIT.PARAMETER.OFFSETS)))))
(RPLCHARCODE MYPARAMETERS \KPARM.MAXL (\KERMIT.CHAR 72))
(RPLCHARCODE MYPARAMETERS \KPARM.TIME (\KERMIT.CHAR 10))
(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 (CHARCODE #))
(RPLCHARCODE MYPARAMETERS \KPARM.QBIN (CHARCODE &))
(SELECTQ (fetch (KERMITSTATE STATE) of KERMITSTATE)
(REC.INIT (\DIGEST.SEND.PACKET MYPARAMETERS KERMIT.ACK.PACKET KERMITSTATE))
(SEND.INIT (\DIGEST.SEND.PACKET MYPARAMETERS DIGEST.SENDINIT.PACKET KERMITSTATE)
)
(ERROR "Illegal Kermit state")))))
(\DIGEST.SEND.STRING
(LAMBDA (STRING TYPE KERMITSTATE SEQNO) (* ejs: " 3-Jan-86 16:44")
(* * 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 \DIGESTOVLEN)))
(CHECKSUM 0)
TEMP)
(RPLCHARCODE PACKET KERMIT.PACKET.MARK (fetch (KERMITSTATE MARKCHAR) of KERMITSTATE))
(RPLCHARCODE PACKET KERMIT.PACKET.LEN (SETQ CHECKSUM
(\DIGEST.CHAR (IPLUS LENGTH (CONSTANT (IDIFFERENCE \DIGESTOVLEN
KERMIT.PACKET.LEN)))))
)
(SETQ TEMP (\DIGEST.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 \DIGESTOVLEN to (IPLUS LENGTH (CONSTANT (SUB1
\DIGESTOVLEN)))
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)
(\DIGEST.DEFAULT.CHECKSUM CHECKSUM))
(\DIGEST.WRITE PACKET KERMITSTATE)
(replace (KERMITSTATE LASTPACKETOUT) of KERMITSTATE with PACKET)
PACKET)))
(\DIGEST.WRITE
(LAMBDA (STRING KERMITSTATE) (* ejs: " 3-Jan-86 17:07")
(* * Sends STRING out on STREAM with FORCEOUTPUT)
(LET ((STREAM (fetch (KERMITSTATE OUTSTREAM) of KERMITSTATE))
PADC)
(PRIN3 STRING STREAM)
(TERPRI STREAM))))
)
[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))
(PUTPROPS DIGEST COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2343 12905 (DIGEST.FILE 2353 . 2857) (\DIGEST.FILE.FOR.TRANSMISSION 2859 . 3909) (
\DIGEST.INITIALIZE 3911 . 4383) (\DIGEST.PREAMBLE 4385 . 6032) (\DIGEST.SEND.FILE.BYTES 6034 . 8644) (
\DIGEST.SEND.HEADER 8646 . 9203) (\DIGEST.SEND.PACKET 9205 . 9765) (\DIGEST.SEND.PARAMETERS 9767 .
10781) (\DIGEST.SEND.STRING 10783 . 12574) (\DIGEST.WRITE 12576 . 12903)))))
STOP