LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032691. :SYSTEM-TYPE :LOGICAL :VERSION 2. :TYPE "LISP" :NAME "KERMIT" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "KERMIT") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758741373. :AUTHOR "REL3" :LENGTH-IN-BYTES 108646. :LENGTH-IN-BLOCKS 107. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ;;; -*- Mode:COMMON-LISP; Package:KERMIT; Base:10 -*-;;; Copyright (c) 1981, 1982, 1983, 1984 Trustees of Columbia University, New York;;; Copyright (c) 1987 Unisys Corporation;;; Copyright (c) 1987 Texas Instruments Incorporated;;; Permission is granted to any individual or institution to copy or use this;;;  software but not to resell it for a price in excess of its media cost.;;; K e r m i t  File Transfer Utility;;;;;; Release 3.0 5/15/87;;; Remember @@TTY W,132 for 1100;;; Global constants(DEFCONSTANT  *ASCII-NUL*         0    "ASCII NUL")(DEFCONSTANT  *ASCII-SOH*         1    "ASCII Start of Header")(DEFCONSTANT  *ASCII-BS*          8    "ASCII back space")(DEFCONSTANT  *ASCII-TAB*         9    "ASCII tab")(DEFCONSTANT  *ASCII-LF*         10    "ASCII line feed")(DEFCONSTANT  *ASCII-FF*         12    "ASCII form feed")(DEFCONSTANT  *ASCII-CR*         13    "ASCII carriage return")(DEFCONSTANT  *ASCII-SP*         32    "ASCII space")(DEFCONSTANT  *ASCII-NS*         35    "ASCII quote")(DEFCONSTANT  *ASCII-AMP*        38    "ASCII ampersand - for 8-bit quoting")(DEFCONSTANT  *ASCII-1*          49    "ASCII 1")(DEFCONSTANT  *ASCII-N*          78    "ASCII N")(DEFCONSTANT  *ASCII-Y*          89    "ASCII Y")(DEFCONSTANT  *ASCII-TILDE*     126    "ASCII tilde - for repeat count prefixing")(DEFCONSTANT  *ASCII-DEL*       127    "ASCII delete - rubout")(DEFCONSTANT  *LISPM-RUBOUT*    135    "LISPM rubout")(DEFCONSTANT  *LISPM-BS*        136    "LISPM backspace")(DEFCONSTANT  *LISPM-TAB*       137    "LISPM tab")(DEFCONSTANT  *LISPM-LF*        138    "LISPM linefeed")(DEFCONSTANT  *LISPM-DEL*       139    "LISPM delete")(DEFCONSTANT  *LISPM-PAGE*      140    "LISPM page")(DEFCONSTANT  *LISPM-NEWLINE*   141    "LISPM version of CRLF");;; States - The letter doesn't matter as long as all are unique.(DEFCONSTANT  *ABORT-STATE*       #\A)(DEFCONSTANT  *SBREAK-STATE*      #\B)(DEFCONSTANT  *COMPLETE-STATE*    #\C)(DEFCONSTANT  *SDATA-STATE*       #\D)(DEFCONSTANT  *EXIT-STATE*        #\E)(DEFCONSTANT  *SFILE-STATE*       #\F)(DEFCONSTANT  *SGENERIC-STATE*    #\G)(DEFCONSTANT  *RSERVER-STATE*     #\I)(DEFCONSTANT  *RCANCEL-STATE*     #\K)(DEFCONSTANT  *RFILE-STATE*       #\L)(DEFCONSTANT  *RDATA-STATE*       #\M)(DEFCONSTANT  *LOGOUT-STATE*      #\Q)(DEFCONSTANT  *RINIT-STATE*       #\R)(DEFCONSTANT  *SINIT-STATE*       #\S)(DEFCONSTANT  *SSERVER-STATE*     #\V)(DEFCONSTANT  *SEOF-STATE*        #\Z)(DEFCONSTANT  *KERMIT-NAME*       "Explorer Kermit");;; Window variables.(DEFFLAVOR KERMIT-FRAME ()   (TV:INFERIORS-NOT-IN-SELECT-MENU-MIXIN    TV:ALIAS-FOR-INFERIORS-MIXIN    TV:BORDERED-CONSTRAINT-FRAME-WITH-SHARED-IO-BUFFER    TV:LABEL-MIXIN))(DEFMETHOD (KERMIT-FRAME :NAME-FOR-SELECTION) ()  (SEND SELF :NAME))(DEFVAR *KERMIT-FRAME*; Define the KERMIT frame (MAKE-INSTANCE 'KERMIT-FRAME:EDGES  '(94 110 930 480)      ; left,top,right,bottom:SAVE-BITS T:BORDERS 2:LABEL '(:TOP  :CENTERED  :STRING "Explorer Kermit - Release 3.0"  :FONT FONTS:HIGHER-MEDFNB):SELECTION-SUBSTITUTE 'INFO-PANE:PANES'((STATUS-PANE    TV:WINDOW    :LABEL NIL    :BORDERS (0 2 0 1)    :DEEXPOSED-TYPEOUT-ACTION :PERMIT)  (INFO-PANE    TV:WINDOW    :LABEL NIL    :BORDERS (0 1 0 1)    :DEEXPOSED-TYPEOUT-ACTION :PERMIT)  (MENU-PANE    TV:COMMAND-MENU    :BORDERS (0 1 0 0)    :ROWS 1    :COLUMNS 3    :ITEM-LIST    (("Abort"      :VALUE "Z"      :DOCUMENTATION "Abort the current operation.")     ("Abort-Save"      :VALUE "S"      :DOCUMENTATION "Abort the current operation but save the file.")     ("End"      :VALUE "E"      :DOCUMENTATION "Exit Kermit (valid only if an operation is complete).")))):CONSTRAINTS'((MAIN . ((STATUS-PANE INFO-PANE MENU-PANE)   ((STATUS-PANE 5 :LINES))   ((MENU-PANE 3 :LINES))   ((INFO-PANE :EVEN)))))))(DEFVAR *STATUS-WINDOW* (SEND *KERMIT-FRAME* :GET-PANE 'STATUS-PANE))(DEFVAR  *INFO-WINDOW* (SEND *KERMIT-FRAME* :GET-PANE 'INFO-PANE));;; Global variables - If values of these are changed, change in CHANGE-KERMIT-PARAMETERS function also(DEFVAR  *RARG1*          ""             "Receive argument for interactive KERMIT CVV")(DEFVAR  *RARG2*          ""             "Receive argument for interactive KERMIT CVV")(DEFVAR  *SARG1*          ""             "Send argument for interactive KERMIT CVV")(DEFVAR  *SARG2*          ""             "Send argument for interactive KERMIT CVV")(DEFVAR  *CARG1*          ""             "Command argument for interactive KERMIT CVV")(DEFVAR  *CARG2*          ""             "Command argument for interactive KERMIT CVV")(DEFVAR  *IMAGE*          NIL            "T means binary data - NIL means ASCII characters")(DEFVAR  *DEBUG*          NIL            "T means print debugging information")(DEFVAR  *MORE*           NIL            "T means enable **MORE** in kermit window")(DEFVAR  *LOGFILE*        NIL            "If a filename specified, log info to a file")(DEFVAR  *FILNAMCNV*      T              "T means convert filename to name.type - NIL means don't convert file names")(DEFVAR  *SAVEFILES*      NIL            "T means save partially received file if xfer interrupted - NIL means delete")(DEFVAR  *MYMAXTRY*       10             "Times to retry a packet")(DEFVAR  *MYMAXPACSIZ*    94             "Maximum packet size")(DEFVAR  *MYTIME*         10             "Seconds after which I should be timed out")(DEFVAR  *MYPAD*          0              "Number of padding characters I will need - I don't need any!")(DEFVAR  *MYPADCHAR*      0              "Padding character I need - none")(DEFVAR  *MYEOL*          *ASCII-CR*     "End-Of-Line character")(DEFVAR  *MYQUOTE*        *ASCII-NS*     "Quote character I will use");;; Macro Definitions:(DEFSUBST TOCHAR (ch)  "converts a control character to a printable one by adding a space"  (+ ch *ASCII-SP*))(DEFSUBST UNCHAR (ch)  "undoes TOCHAR by subtracting a space"  (- ch *ASCII-SP*))(DEFSUBST CTL (ch)  "converts between control characters and printable characters by togglingthe control bit (ie. ^A becomes A and A becomes ^A). #b1000000 is #o100."  (LOGXOR ch #b1000000))(DEFSUBST COMPUTE-FINAL-CHECKSUM (NUM)  "Compute final checksum by folding in bits 7 and 8.  #b11000000 is #o300, #b111111 is #o077."  (LOGAND (+ (LSH (LOGAND NUM #b11000000) -6) NUM) #b111111))(DEFSUBST CONVERT-FROM-ASCII (ch)  "Function to convert some characters from ASCII to Lisp."  (COND     ((OR       (AND (> ch *ASCII-CR*) (< ch  *ASCII-DEL*))       (AND (> ch *ASCII-DEL*) (< ch 256)))       ch)    ((= ch *ASCII-CR*)   *LISPM-NEWLINE*)    ((= ch *ASCII-TAB*)  *LISPM-TAB*)    ((= ch *ASCII-LF*)   *LISPM-LF*)     ((= ch *ASCII-FF*)   *LISPM-PAGE*)    ((= ch *ASCII-DEL*)  *LISPM-RUBOUT*)    ((= ch *ASCII-BS*)   *LISPM-BS*)    (T (IF (OR (< ch 0) (> ch 255))   NIL ch))))(DEFSUBST CONVERT-TO-ASCII (ch)  "Function to convert characters from Lisp to ASCII.  Converts any appropriatecontrol characters but maps the unimportant control chars to NIL."  (COND     ((<= ch *ASCII-DEL*)        ch)    ((= ch *LISPM-BS*)          *ASCII-BS*)    ((= ch *LISPM-TAB*)         *ASCII-TAB*)    ((= ch *LISPM-LF*)          *ASCII-LF*)      ((= ch *LISPM-PAGE*)        *ASCII-FF*)    ((= ch *LISPM-NEWLINE*)     *ASCII-CR*)    ((= ch *LISPM-RUBOUT*)      *ASCII-DEL*)    (T                          NIL)))(DEFUN INTERACTIVE-KERMIT (&OPTIONAL STREAM (EXECUTE T))  "Produce a selection menu.  If EXECUTE is non-nil, call KERMIT;otherwise, return a form that can be EVALed to call KERMIT."  (LET*    ((SELECTION        (tv:MENU-CHOOSE '(   ("Get File(s)     "    :VALUE (:GET "Get File(s)" ((*RARG1* "Remote File Name   "   :DOCUMENTATION "File(s) to transfer from the remote Kermit server." :STRING)  (*RARG2* "New Local File Name"   :DOCUMENTATION "Name to give to the transferred file(s)." :STRING)  (*IMAGE* "Image Mode         "   :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)."   :CHOOSE (NIL 8 16))))    :DOCUMENTATION "Transfer file(s) from a remote Kermit in server mode.")   ("Receive File(s) "    :VALUE (:RECEIVE "Receive File(s)"     ((*RARG1* "New Local File Name"       :DOCUMENTATION "Local name to give to the received file(s)." :STRING)      (*IMAGE* "Image Mode         "       :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)."       :CHOOSE (NIL 8 16))))    :DOCUMENTATION "Wait for the arrival of file(s) transferred by a remote Kermit executing a Send command.")   ("Send File(s)    "    :VALUE (:SEND "Send File(s)"  ((*SARG1* "Local File Name     "    :DOCUMENTATION "Local file(s) to transfer to the remote Kermit." :STRING)   (*SARG2* "New Remote File Name"    :DOCUMENTATION "Name to give to the transferred file(s) on the remote host." :STRING)   (*IMAGE* "Image Mode          "    :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)."    :CHOOSE (NIL 8 16))))    :DOCUMENTATION "Transfer file(s) to a remote Kermit in Server mode or executing a Receive command.")   (""    :NO-SELECT nil)   ("Bye             "    :VALUE (:BYE)    :DOCUMENTATION "Shut down and logout a remote Kermit server.")   ("Finish          "    :VALUE (:FINISH)    :DOCUMENTATION "Shut down a remote Kermit server without logging out the remote job.")   (""    :NO-SELECT nil)   ("Set Parameters  "    :VALUE (:SET)    :DOCUMENTATION "Modify local Kermit operating parameters.")   (""    :NO-SELECT nil)   ("Begin Logging   "    :VALUE (:LOG-BEGIN "Begin Logging to File" ((*CARG1* "Log File Pathname"   :DOCUMENTATION "Pathname used to write logging information." :STRING)))    :DOCUMENTATION "Begin logging local Kermit actions to a file.")   ("End Logging     "    :VALUE (:LOG-END)    :DOCUMENTATION "End logging local Kermit actions to a file.")   (""    :NO-SELECT nil)   ("Server Mode     "    :VALUE (:SERVER)    :DOCUMENTATION "Place local Kermit in server mode.")   (""    :NO-SELECT nil)   ("Remote Copy     "    :VALUE (:REMOTE-COPY "Remote Copy" ((*CARG1* "File Name     "   :DOCUMENTATION "File to copy on the remote KERMIT server." :STRING)  (*CARG2* "File Copy Name"   :DOCUMENTATION "Name to give to the copy file." :STRING)))    :DOCUMENTATION "Copy the specified file to another location on a remote KERMIT server.")   ("Remote CWD      "    :VALUE (:REMOTE-CWD "Remote Change Working Directory"((*CARG1* "New Remote Directory"  :DOCUMENTATION "New working directory pathname for the remote Kermit server."  :STRING)))    :DOCUMENTATION "Change the working directory of a remote Kermit server.")   ("Remote Delete   "    :VALUE (:REMOTE-DELETE "Remote Delete File"   ((*CARG1* "Remote File Name"     :DOCUMENTATION "Name of file to delete on remote Kermit server." :STRING)))    :DOCUMENTATION "Delete a file on a remote Kermit server.")   ("Remote Directory"    :VALUE (:REMOTE-DIRECTORY "Remote Directory"      ((*CARG1* "Remote Directory":DOCUMENTATION "Directory pathname for remote Kermit server." :STRING)))    :DOCUMENTATION "Display names of files in directory on remote Kermit server.")   ("Remote Help     "    :VALUE (:REMOTE-HELP "Remote Help" ((*CARG1* "Help Topic"   :DOCUMENTATION "Optional topic on which to obtain help." :STRING)))    :DOCUMENTATION "Display a list of remote KERMIT server help commands.")   ("Remote Host     "    :VALUE (:REMOTE-HOST "Remote Host" ((*CARG1* "Host Command"   :DOCUMENTATION "Command to pass to the remote host." :STRING)))    :DOCUMENTATION "Pass the given command to the remote KERMIT server host for processing.The command must be in the remote KERMIT server host's own command level syntax.")   ("Remote Kermit   "    :VALUE (:REMOTE-KERMIT "Remote Kermit"   ((*CARG1* "Kermit Command"     :DOCUMENTATION "Command to pass to the remote KERMIT server." :STRING)))    :DOCUMENTATION "Pass the given command to the remote KERMIT server for execution.The command must be in the remote KERMIT server's own interactive mode syntax.")   ("Remote Rename   "    :VALUE (:REMOTE-RENAME "Remote Rename File"   ((*CARG1* "File Name    "     :DOCUMENTATION "File to rename on the remote KERMIT server." :STRING)    (*CARG2* "New File Name"     :DOCUMENTATION "New name to give to the file." :STRING)))    :DOCUMENTATION "Rename the specified file on a remote KERMIT server.")   ("Remote Set      "    :VALUE (:REMOTE-SET "Remote Set Parameter" ((*CARG1* "Parameter"  :DOCUMENTATION "Name of parameter to set on remote KERMIT server." :STRING) (*CARG2* "Value    "  :DOCUMENTATION "New value to give to the parameter." :STRING)))    :DOCUMENTATION "Set a parameter to a given value on a remote KERMIT server.")   ("Remote Show     "    :VALUE (:REMOTE-SHOW "Remote Show Parameter"  ((*CARG1* "Parameter"    :DOCUMENTATION "Name of parameter to query on remote KERMIT server." :STRING)))    :DOCUMENTATION "Obtain the value of a parameter on a remote KERMIT server.")   ("Remote Space    "    :VALUE (:REMOTE-SPACE "Remote Disk Space"  ((*CARG1* "Remote Directory"    :DOCUMENTATION "Remote directory pathname." :STRING)))    :DOCUMENTATION "Display information about disk usage for a directory on remote Kermit server.")   ("Remote Type     "    :VALUE (:REMOTE-TYPE "Remote File Type" ((*CARG1* "File Name"   :DOCUMENTATION "Name of file to list." :STRING)))    :DOCUMENTATION "Display the specified filename from a remote KERMIT server.")) "KERMIT OPERATIONS" '(:POINT 500 400)))     (OPERATION (FIRST SELECTION))     (LABEL (SECOND SELECTION))     (CVV-LIST (THIRD SELECTION)))        (WHEN CVV-LIST; If a cvv is required, display it      (WHEN(CATCH 'END-CVV; Setup catch - if true, we used it  (TV:CHOOSE-VARIABLE-VALUES    CVV-LIST    :NEAR-MODE '(:POINT 500 400)    :WIDTH 60    :LABEL LABEL    :MARGIN-CHOICES '(("Abort" (THROW 'END-CVV T)) "Do It"))  NIL); Return nil from entire block(SETQ OPERATION NIL))); If we returned with T, the throw was used.        (WHEN OPERATION      (LET((FORM `(KERMIT ,OPERATION  :ARG1 ,(EVAL (FIRST (FIRST CVV-LIST))):ARG2 ,(EVAL (FIRST (SECOND CVV-LIST))):STREAM ,STREAM:VERBOSEP T)))(IF EXECUTE    (EVAL FORM)    FORM)))))  (DEFUN KERMIT (OPERATION &KEY ARG1 ARG2 STREAM VERBOSEP)  "Transfers files using the KERMIT protocol.OPERATION - :GET               Transfer file(s) from a remote Kermit in server mode            :RECEIVE           Wait for the arrival of file(s) transferred by a remote Kermit executing a Send command            :SEND              Transfer file(s) to a remote KERMIT in server mode or executing a Receive command            :BYE               Shut down and logout a remote KERMIT server            :FINISH            Shut down a remote KERMIT server without logging out the remote job            :SET               Modify the local KERMIT operating parameters            :LOG-BEGIN         Begin logging local KERMIT actions to a file            :LOG-END           End logging local KERMIT actions to a file             :SERVER            Place local KERMIT in server mode            :REMOTE-COPY       Copy the specified file to another location on a remote KERMIT server            :REMOTE-CWD        Change the working directory of a remote KERMIT server            :REMOTE-DELETE     Delete a file on a remote KERMIT server            :REMOTE-DIRECTORY  Display names of files in a directory on remote KERMIT server            :REMOTE-HELP       Display a list of remote KERMIT server help commands            :REMOTE-HOST       Pass the given command to the remote KERMIT server host for processing                               (the command must be in the remote KERMIT host's own command level syntax)            :REMOTE-KERMIT     Pass the given command to the remote KERMIT server for execution                               (the command must be in the remote KERMIT's own interactive mode syntax)            :REMOTE-RENAME     Rename the specified file on a remote KERMIT server            :REMOTE-SET        Set a parameter to a given value on a remote KERMIT server            :REMOTE-SHOW       Obtain the value of a parameter on a remote KERMIT serve            :REMOTE-SPACE      Display information about disk usage for a directory on remote KERMIT server            :REMOTE-TYPE       Display the specified filename from a remote KERMIT server:ARG1     -  Filename, directory, command or parameter:ARG2     -  New filename, destination name or parameter:STREAM   -  Serial stream to use:VERBOSEP -  T means verbose output."    ;;; All Kermit variables that are passed between functions (but not global via DEFVAR)  ;;; are defined here and prefixed with K*    (LET ((K*OPERATION OPERATION); Action to be taken(K*TTYFD STREAM); Serial stream for I/O(K*TTYFD-BITS NIL); Number of data bits in serial stream(K*VERBOSEP VERBOSEP); T means print things on the screen(K*STATE NIL); Represents the present state of RECSW or SENDSW(K*PCKT-NUM 0); Packet number(K*NUMTRY 0); Times this packet retried(K*SIZE 0); Size of data in the buffer(K*FILE-CHARS 0)                        ; Total number of file chars read or written(K*YOURMAXPACSIZ *MYMAXPACSIZ*); Maximum send packet size - default to my size(K*YOURTIME (+ 5 *MYTIME*)); Timeout on sends - default to longer(K*YOURPAD 0); Padding to send - assume none(K*YOURPADCHAR 0); Padding character to send - none(K*YOUREOL *ASCII-CR*); End-Of-Line character to send(K*YOURQUOTE *ASCII-NS*); Quote character in incoming data(K*BINQUOTE *ASCII-N*); 8-bit quoting character(K*REPEAT *ASCII-TILDE*); Repeat character(K*SPACKET; Send packet buffer  (MAKE-ARRAY (* 2 *MYMAXPACSIZ*)      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*RPACKET; Receive packet buffer  (MAKE-ARRAY (* 2 *MYMAXPACSIZ*)      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*BUFFER; Local packet buffer  (MAKE-ARRAY (* 2 *MYMAXPACSIZ*)      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*ARG1LIST  (IF (LISTP ARG1); Make sure ARG1 is a list      ARG1 (LIST ARG1)))(K*ARG2LIST  (IF (LISTP ARG2); Make sure ARG2 is a list      ARG2 (LIST ARG2)))(K*FILNAM NIL); Current file name(K*RECFILNAM NIL); Default pathname into which to place the received file(K*EMPTY-PATHNAME                       ; Empty pathname used for merging  (MAKE-PATHNAME :HOST 'lm))(K*FP NIL); File pointer to currently opened disk file(K*BUFILLPTR 0); Pointer to current location in K*BUFILLBUF(K*BUFILLBUF; Temporary file buffer for BUFILL to handle file input  (MAKE-ARRAY 2048                      ; Buffer size is 2 blocks      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*IGNORE-NEXT-LINEFEED NIL); Flag for ASCII conversion(K*SEND-TO-TTY NIL); Flag indicating whether to send data to TTY or file(K*FILES-TRANSFERRED NIL); List of files successfully sent or received(K*CANCEL NIL); Used to poll the keyboard to see if we should cancel xfer(K*ABORT-REASON NIL); Contains string with error(K*PACKETS-TRANSFERRED 0); Total number of packets transferred(K*PACKETS-RETRIED 0); Total number of packets retried(K*BYTES-TRANSFERRED 0); Total number of bytes transferred(K*START-TIME 0)); Time at which transfer began        (DECLARE (SPECIAL K*OPERATION K*TTYFD K*VERBOSEP K*STATE K*PCKT-NUM K*NUMTRY K*SIZE K*FILE-CHARS K*START-TIME      K*YOURMAXPACSIZ K*YOURTIME K*YOURPAD K*YOURPADCHAR K*YOUREOL K*YOURQUOTE K*EMPTY-PATHNAME      K*BINQUOTE K*REPEAT K*SPACKET K*RPACKET K*BUFFER K*ARG1LIST K*ARG2LIST K*FILNAM K*RECFILNAM      K*FP K*BUFILLBUF K*BUFILLPTR K*IGNORE-NEXT-LINEFEED K*SEND-TO-TTY K*BYTES-TRANSFERRED      K*FILES-TRANSFERRED K*CANCEL K*ABORT-REASON K*PACKETS-TRANSFERRED K*PACKETS-RETRIED))    ;  (CONDITION-CASE (K-ERROR)                           ; Setup error trap    (PROGN; First form is the body...            (WHEN K*VERBOSEP        ; Setup the KERMIT output window(INITIALIZE-STATUS-WINDOW); Initialize the status window(SEND *INFO-WINDOW* :CLEAR-WINDOW); Clear the Interactive window(SEND *KERMIT-FRAME* :SELECT)); Select and expose the entire frame            (WHEN (EQ OPERATION :SET)        ; If the SET operation was specified, (SETQ K*VERBOSEP NIL)); force quiet mode!      (WHEN (NOT K*TTYFD); If no stream was supplied, make one.(SETQ K*TTYFD (SI:MAKE-SERIAL-STREAM))) ; Could use SI:*SERIAL-PORT-OWNER* ;; BAC       (SEND K*TTYFD :CLEAR-INPUT)      (SEND K*TTYFD :CLEAR-OUTPUT)      (SETQ K*TTYFD-BITS; Determine the number of data bits in the stream    (SEND K*TTYFD :GET :NUMBER-OF-DATA-BITS))      (SETQ K*BINQUOTE; Set the initial value for the 8-bit quote char    (IF *IMAGE*; Image mode?(IF (= K*TTYFD-BITS 8)          ; - Yes, 8-bit?    *ASCII-Y*                   ; -- Yes, set to Y    *ASCII-AMP*)        ; -- No,  set to &*ASCII-N*)); - No, set to N            (WHEN ARG1; If a filename was specified,(GET-NEXT-FILE)); Set K*FILNAM to the first in the list            (UNWIND-PROTECT; Surround entire selection in unwind-protect  (CASE OPERATION    (:SEND        ; Send command     (IF K*FILNAM; Required filename specified? (LET                           ; - Yes   ((HOST-SPECIFIED? (FIND ":" K*RECFILNAM :TEST 'STRING-EQUAL))    (PATH-RECFILNAM (FS:PARSE-PATHNAME K*RECFILNAM NIL K*EMPTY-PATHNAME)))   (SETQ K*ARG1LIST (EXPAND-WILDS K*FILNAM)); Expand any wildcards in the filename   (SETQ K*ARG2LIST; expand the transfer name list (MAPCAR                ; Map over each of the send files    (FUNCTION            ; replacing any wildcard components     (LAMBDA (x)       (LET  ((EXPANDED-PATH (DEFAULT-ONLY-WILD-PATHNAME-COMPONENTS PATH-RECFILNAM x))) (IF HOST-SPECIFIED?     EXPANDED-PATH     (SEND EXPANDED-PATH :STRING-FOR-HOST)))))   K*ARG1LIST))   (GET-NEXT-FILE); Get the file to process   (SW *SINIT-STATE*)); - Yes, start with SINIT as initial state (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:GET     (IF K*FILNAM; Required filename specified? (PROGN; - Yes   (SETQ K*FILNAM (CREATE-KERMIT-FILENAME K*FILNAM)); Make a suitable packet filename   (SW *SGENERIC-STATE* #\R K*FILNAM)); SGENERIC is the initial state (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:RECEIVE     (SW *RINIT-STATE*)); Start with RINIT as initial state    (:BYE     (SW *SGENERIC-STATE* #\G "L")); SGENERIC is initial state    (:FINISH     (SW *SGENERIC-STATE* #\G "F")); SGENERIC is initial state    (:SET     (CHANGE-KERMIT-PARAMETERS))    (:LOG-BEGIN     (IF K*FILNAM; Required filename specified? (CONDITION-CASE (ERR); - Yes, try to open the logfile     (PROGN      (SETQ K*FILNAM; Merge the filename with the home directory    (SEND      (FS:MERGE-PATHNAME-DEFAULTSK*FILNAM(USER-HOMEDIR-PATHNAME))      :STRING-FOR-PRINTING))      (SETQ *LOGFILE*; Try to open the file     (OPEN K*FILNAM  :DIRECTION :OUTPUT  :IF-EXISTS ':NEW-VERSION  :IF-DOES-NOT-EXIST ':CREATE)))   (ERROR; If unable to merge the filename or open the file    (PRINTMSG "~%~A"      (SETQ K*ABORT-REASON    (FORMAT NIL "~A: Error <~A> opening log file ~A"    *KERMIT-NAME* (SEND ERR :REPORT-STRING) K*FILNAM))))   (:NO-ERROR    (MULTIPLE-VALUE-BIND (SS MM HH DY MN YR) (GET-DECODED-TIME)      (PRINTMSG "~%Begin logging at ~A:~A:~A  ~A/~A/~A  to file ~A"HH MM SS MN DY YR K*FILNAM)))) (PRINTMSG "~%~A"; - No, filename not specified   (SETQ K*ABORT-REASON "No log file name specified"))))    (:LOG-END     (IF *LOGFILE*      ; Is there an open logfile? (PROGN; - Yes   (MULTIPLE-VALUE-BIND (SS MM HH DY MN YR) (GET-DECODED-TIME)     (PRINTMSG "~%End logging to file ~A at ~A:~A:~A  ~A/~A/~A~%"       (SEND (SEND *LOGFILE* :TRUENAME) :STRING-FOR-PRINTING) HH MM SS MN DY YR))   (SEND *LOGFILE* :CLOSE); Close the file   (SETQ *LOGFILE* NIL)) (PRINTMSG "~%~A"; - No   (SETQ K*ABORT-REASON (FORMAT NIL "~A: No log file was opened" *KERMIT-NAME*)))))    (:SERVER     (SW *RSERVER-STATE*)); RSERVER is initial state    (:REMOTE-COPY     (IF (AND K*FILNAM K*RECFILNAM); Required filenames specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "K~C~A~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM     (TOCHAR (LENGTH K*RECFILNAM)) K*RECFILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Both files must be specified"))))    (:REMOTE-CWD     (SW *SGENERIC-STATE*; SGENERIC is initial state #\G; Start with G packet (FORMAT NIL "C~C~A"; Setup data packet                 (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)))    (:REMOTE-DELETE     (IF K*FILNAM; Required filename specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "E~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:REMOTE-DIRECTORY     (IF K*FILNAM; Required filename specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "D~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:REMOTE-HELP     (SW *SGENERIC-STATE*; SGENERIC is initial state #\G; Start with G packet (FORMAT NIL "H~C~A"; Setup data packet                 (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)))    (:REMOTE-HOST     (IF K*FILNAM; Required command specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\C; Start with C packet     (FORMAT NIL "~A"; Setup data packet                     K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No command specified"))))    (:REMOTE-KERMIT     (IF K*FILNAM; Required command specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\K; Start with K packet     (FORMAT NIL "~A"; Setup data packet                     K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No command specified"))))    (:REMOTE-RENAME     (IF (AND K*FILNAM K*RECFILNAM); Required filenames specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "R~C~A~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM     (TOCHAR (LENGTH K*RECFILNAM)) K*RECFILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Both files must be specified"))))    (:REMOTE-SET     (IF (AND K*FILNAM K*RECFILNAM); Required parameters specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "V~CS~C~A~C~A"; Setup data packet     (TOCHAR 1)     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM     (TOCHAR (LENGTH K*RECFILNAM)) K*RECFILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Both variable and value must be specified"))))    (:REMOTE-SHOW     (IF K*FILNAM; Required parameter specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "V~CQ~C~A"; Setup data packet                     (TOCHAR 1)     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Variable must be specified"))))    (:REMOTE-SPACE     (SW *SGENERIC-STATE*; SGENERIC is initial state #\G (FORMAT NIL "U~C~A"  (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)))    (:REMOTE-TYPE     (IF K*FILNAM; Required filename specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "T~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:OTHERWISE; Unknown command     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON "Invalid operation specified"))))(IF K*FP (SEND K*FP :CLOSE))); No matter what happened, close any opened file            (WHEN K*VERBOSEP        ; When not in quiet mode(PRINTMSG "~%KERMIT operation ~A ~A."  OPERATION  (IF K*ABORT-REASON "failed" "succeeded"))(WHEN K*FILES-TRANSFERRED  (PRINTMSG "~%Files transferred: ~A." K*FILES-TRANSFERRED))(PRINTMSG "~%Press any key or click on END to continue.")(SEND *INFO-WINDOW* :CLEAR-INPUT); Clear the input buffer(SEND *INFO-WINDOW* :ANY-TYI)           ; Wait for a keypress or mouse blip(SEND *KERMIT-FRAME* :BURY))        ; Bury the Interactive window            (IF K*ABORT-REASON  (VALUES NIL K*FILES-TRANSFERRED K*ABORT-REASON)  (VALUES T   K*FILES-TRANSFERRED NIL)))    ; (ERROR;  (PRINTMSG "~%~%ERROR: ~A" (SEND K-ERROR :REPORT-STRING));  (SIGNAL-CONDITION K-ERROR)))    ))(DEFUN SW (STATE &OPTIONAL SPACK-TYPE SPACK-DATA)  "This is the state table switcher for transferring files.  It loops untileither it finishes, or an error is encountered.  The routines called bythis function are responsible for returning a new state."    (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*NUMTRY K*OPERATION K*VERBOSEP K*CANCEL    K*FP K*ABORT-REASON))    (SETQ K*STATE STATE); Initialize the start state  (SETQ K*CANCEL NIL)  (SETQ K*PCKT-NUM 0); Initialize the packet number  (SETQ K*NUMTRY 0); Say no tries yet    (LOOP    UNTIL (NOT K*STATE)    DO        (WHEN *DEBUG*      (PRINTMSG "~%Function SW in state ~C" K*STATE))        (WHEN (>= K*NUMTRY *MYMAXTRY*)      (PRINTMSG "~%~A"(SETQ K*ABORT-REASON; Save the error      (FORMAT NIL "~A: No valid packet received after ~A retries." *KERMIT-NAME* K*NUMTRY)))      (SETQ K*STATE *ABORT-STATE*)      (SETQ K*NUMTRY 0))       (WHEN (AND K*VERBOSEP (NOT K*CANCEL)); When verbose and not already cancelled      (SETQ K*CANCEL    (SEND *INFO-WINDOW* :ANY-TYI-NO-HANG)); Get a char from the io buffer      (IF; Command menu blip?(AND  (CONSP K*CANCEL)  (EQ (FIRST K*CANCEL) :MENU))(PROGN; - Yes  (SETQ K*CANCEL(GET (SECOND K*CANCEL) :VALUE)); Set the value of K*CANCEL  (IF (STRING-EQUAL K*CANCEL "E")       ; End requsted?      (PROGN                            ; -- Yes(SETQ K*CANCEL NIL)             ; Reset K*CANCEL(PRINTMSG "~%~A: END not valid here; ABORT or ABORT-SAVE first." *KERMIT-NAME*))      (PRINTMSG "~%~A"                  ; -- No,       (SETQ K*ABORT-REASON; Save the error    (FORMAT NIL "~A: User requested cancellation." *KERMIT-NAME*)))))(SETQ K*CANCEL NIL))); - No    (SETQ K*STATE  (SELECTOR K*STATE EQL    (*RDATA-STATE*        (RDATA))    (*SDATA-STATE*        (SDATA))    (*RINIT-STATE*        (RINIT))    (*SINIT-STATE*        (SINIT))    (*RFILE-STATE*        (RFILE))    (*SFILE-STATE*        (SFILE))    (*SEOF-STATE*         (SEOF))    (*SBREAK-STATE*       (SBREAK))    (*SGENERIC-STATE*     (SGENERIC SPACK-TYPE SPACK-DATA))    (*SSERVER-STATE*      (SSERVER))    (*RSERVER-STATE*      (RSERVER))    (*COMPLETE-STATE*     (IF (EQ K*OPERATION :SERVER) *RSERVER-STATE* NIL))    (*RCANCEL-STATE*      (RCANCEL))    (*ABORT-STATE*        (IF K*FP (SEND K*FP :CLOSE))  (IF (AND (EQ K*OPERATION :SERVER) (NOT K*CANCEL))      *RSERVER-STATE*      NIL))    (:OTHERWISE           NIL)))))(DEFUN SINIT ()  "Send-Initiate function to send this host's parameters and get other side's back."  (DECLARE (SPECIAL K*YOUREOL K*STATE K*CANCEL K*PCKT-NUM K*YOURQUOTE K*ABORT-REASON K*SPACKET))  (SETQ K*PCKT-NUM 0); Initialize the packet number    (IF K*CANCEL; Cancelled?      *ABORT-STATE*; - Yes, abort      (PROGN; - No(SETQ K*SPACKET (SPAR K*SPACKET)); Fill up init info packet(SPACK #\S K*PCKT-NUM (LENGTH K*SPACKET) K*SPACKET); Send an S packet with type,number,length,packet(MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)    (RPACK); What was the reply?  (CASE TYPE;        (#\Y; ACK...     (IF (= K*PCKT-NUM NUM); Correct ACK? (PROGN; - Yes   (RPAR PACKET LEN); Get other side's init info   (INCREMENT-PACKET-NUMBER); Bump packet count   *SFILE-STATE*); OK, switch to SFILE-STATE K*STATE)); - No, stay in same K*STATE        (#\N; NAK     (INCREMENT-RETRIES); Increment the retries     K*STATE); stay in same state and try again        (#\E; Error packet received     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))     *ABORT-STATE*)        (NIL; No packet received - timeout     (INCREMENT-RETRIES); Increment the retries     K*STATE); and try again        (:OTHERWISE; Received unknown packet - abort     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))     *ABORT-STATE*))))))(DEFUN SFILE ()  "Send File Header."  (DECLARE (SPECIAL K*FP K*FILNAM K*RECFILNAM K*SPACKET K*STATE K*PCKT-NUM    K*CANCEL K*SIZE K*SEND-TO-TTY K*ABORT-REASON))    (IF K*CANCEL; Cancelled?      *ABORT-STATE*; - Yes            (PROGN; - No     (WHEN (NOT K*FP); If file is not already open,     (LET    ((FILNAM NIL))    (CONDITION-CASE (ERR)(PROGN (SETQ FILNAM; Merge the filename with the home directory       (SEND (FS:MERGE-PATHNAME-DEFAULTS       K*FILNAM       (USER-HOMEDIR-PATHNAME))     :STRING-FOR-PRINTING)) (WHEN *DEBUG*; Print debugging info   (PRINTMSG "~%Opening ~A for sending." FILNAM)) (SETQ K*FP; Try to open the file       (OPEN FILNAM     :BYTE-SIZE 8)))    ; using byte-size of 8 since we only send 8 at a time.       (ERROR; Error in opening?       (PRINTMSG "~%~A"; Print error (SETQ K*ABORT-REASON       (FORMAT NIL "~A: Error <~A> opening file ~A."       *KERMIT-NAME* (SEND ERR :REPORT-STRING) FILNAM)))        (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet       (SETQ K*FP NIL))))); Be sure the pointer is not set(IF (NOT K*FP); Did we get an error opening the file?    *ABORT-STATE*; - Yes, abort    (PROGN                ; - No, setup the filename to send      (SETQ K*RECFILNAM    (IF K*SEND-TO-TTY           ; Send to the other KERMIT'S tty?""                      ; - Yes, don't worry about any transfer name(CREATE-KERMIT-FILENAME ; - No, convert the transfer name  (IF K*RECFILNAM; Was a transfer filename specified?      K*RECFILNAM; -- Yes, use it      (SEND               ; -- No, use the true open file name(SEND K*FP :TRUENAME):STRING-FOR-PRINTING)))))      (SETQ K*SIZE (ENCODE-PREFIXED-DATA K*RECFILNAM K*SPACKET))      (INITIALIZE-STATUS-COUNTS); Reset the timing info      (PRINT-STATUS-FILE-INFO); update the filenames on the screen      (PRINTMSG "~%Sending data...")      (IF K*SEND-TO-TTY; Are we sending to other KERMIT's TTY?  (SPACK #\X K*PCKT-NUM K*SIZE K*SPACKET); - Yes, send an X packet  (SPACK #\F K*PCKT-NUM K*SIZE K*SPACKET)); - No, send an F packet            (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)  (RPACK); What was the reply?(CASE TYPE    (#\Y; ACK   (IF (= NUM K*PCKT-NUM); See if it's correct ACK       (PROGN; - Yes, (INCREMENT-PACKET-NUMBER); Increment the packet count (SETQ K*SIZE       (BUFILL K*SPACKET K*FP)); Get first data from file *SDATA-STATE*); Switch to DATA-STATE       K*STATE)); - No, stay in same K*STATE    (#\N; NAK   (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if this is a NAK for the previous packet  K*PCKT-NUM)       (PROGN; - Yes, so treat it as an ACK (INCREMENT-PACKET-NUMBER); Increment the packet count (SETQ K*SIZE       (BUFILL K*SPACKET K*FP)); Get first data from file *SDATA-STATE*); Switch to SDATA-STATE       (PROGN; - No, (INCREMENT-RETRIES); increment the retries K*STATE))); Remain in same K*STATE    (#\E; Error packet received   (SETQ K*ABORT-REASON; Save the error (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET))   (PRINTMSG "~%~A" K*ABORT-REASON)   *ABORT-STATE*)    (NIL; Timeout   (INCREMENT-RETRIES); Increment the retries   K*STATE); Remain in same K*STATE    (:OTHERWISE; Unknown packet - abort   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   *ABORT-STATE*))))))))(DEFUN SDATA ()  "Send File Data."  (DECLARE (SPECIAL K*FP K*STATE K*PCKT-NUM K*SIZE K*CANCEL K*SPACKET K*ABORT-REASON))  (SPACK #\D K*PCKT-NUM K*SIZE K*SPACKET); Send a D packet  (COUNT-AND-PRINT-PACKETS K*SIZE)        ; Keep track of packet totals    (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)      (RPACK); What was the reply?    (CASE TYPE            (#\Y; ACK       (IF (= NUM K*PCKT-NUM); See if it's correct ACK   (PROGN; - Yes,     (INCREMENT-PACKET-NUMBER); Increment the packet count     (SETQ K*SIZE   (BUFILL K*SPACKET K*FP))      ; Get more data from the file     (IF (OR (ZEROP K*SIZE) K*CANCEL); EOF or cancel flag? *SEOF-STATE*; -- Yes, switch to SEOF-STATE *SDATA-STATE*)); -- No, stay in SDATA-STATE   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\N; NAK       (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if it's a NAK for last packet      K*PCKT-NUM)   (PROGN; - Yes, treat as ACK     (INCREMENT-PACKET-NUMBER); Increment the packet count     (SETQ K*SIZE   (BUFILL K*SPACKET K*FP))        ; Get more date from the file     (IF (OR (ZEROP K*SIZE) K*CANCEL); EOF or cancel flag? *SEOF-STATE*; -- Yes, switch to SEOF-STATE *SDATA-STATE*)); -- No, stay in SDATA-STATE   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Timeout       (INCREMENT-RETRIES); Increment the retries       K*STATE); Remain in same K*STATE            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))       *ABORT-STATE*))))(DEFUN SEOF ()  "Send End-Of-File."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*FP K*FILNAM    K*CANCEL K*ABORT-REASON))  (IF K*CANCEL                        ; Has cancellation been requested?      (SPACK #\Z K*PCKT-NUM 1 "D"); - Yes, send a Z packet with a D for Discard!      (SPACK #\Z K*PCKT-NUM 0 NIL)); - No, send a Z packet to close    (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)      (RPACK); What was the reply?    (CASE TYPE            (#\Y; ACK       (IF (= NUM K*PCKT-NUM); See if it's correct ACK   (PROGN; - Yes     (INCREMENT-PACKET-NUMBER); Increment the packet count     (PRINTMSG "~%Sending completed.")     (SEND K*FP :CLOSE); Close the input file     (SETQ K*FP NIL); Set flag indicating no file open     (IF (GET-NEXT-FILE); Any more files? (PROGN; -- Yes   (IF *DEBUG*; Print debugging info       (PRINTMSG "~%New file is ~A." K*FILNAM))   *SFILE-STATE*); Switch to SFILE-STATE *SBREAK-STATE*)); -- No, Break (EOT) and all done   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\N; NAK       (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if it's a NAK for last packet      K*PCKT-NUM)   (PROGN; - Yes, treat as ACK     (INCREMENT-PACKET-NUMBER); Increment the packet count     (PRINTMSG "~%Sending completed.")     (SEND K*FP :CLOSE); Close the input file     (SETQ K*FP NIL); Set flag indicating no file open     (IF (GET-NEXT-FILE); Any more files? (PROGN; -- Yes,   (IF *DEBUG*; Print debugging info       (PRINTMSG "~%New file is ~A." K*FILNAM))   *SFILE-STATE*); Switch to SFILE-STATE *SBREAK-STATE*)); -- No, Break (EOT) and all done   (PROGN; - No,     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Timeout       (INCREMENT-RETRIES); Increment the retries       K*STATE); Remain in same K*STATE            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))       *ABORT-STATE*))))(DEFUN SBREAK ()  "Send Break (EOT)."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*ABORT-REASON))  (SPACK #\B K*PCKT-NUM 0 NIL); Send a B packet    (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)      (RPACK); What was the reply?    (CASE TYPE            (#\Y; ACK       (IF (= NUM K*PCKT-NUM); See if it's correct ACK   (PROGN; - Yes     (INCREMENT-PACKET-NUMBER); Increment the packet count     *COMPLETE-STATE*); Switch to COMPLETE-STATE   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\N; NAK       (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if it's a NAK for last packet      K*PCKT-NUM)   (PROGN; - Yes, treat as ACK     (INCREMENT-PACKET-NUMBER); Increment the packet count     *COMPLETE-STATE*); Switch to COMPLETE-STATE   (PROGN; - No,     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Timeout       (INCREMENT-RETRIES); Increment the retries       K*STATE); Remain in same K*STATE            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))       *ABORT-STATE*)))) (DEFUN RINIT ()  "Receive-Initiate function to receive other side's host's parameters and send ours back."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*CANCEL K*ABORT-REASON))  (SETQ K*PCKT-NUM 0); Initialize the packet number    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes, abort      (MULTIPLE-VALUE-BIND (TYPE LEN IGNORE PACKET); - No, get a packet  (RPACK)(CASE TYPE; What type was it?    (#\S; Send-Init   (RPAR PACKET LEN); Get other side's init info   (SETQ PACKET (SPAR PACKET)); Fill up my init info packet   (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); ACK with my parameters   (INCREMENT-PACKET-NUMBER); Bump packet number   *RFILE-STATE*); OK, enter File-Receive state    (#\E; Error packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))   *ABORT-STATE*)    (NIL; Didn't get a packet   (SPACK #\N 0 0 NIL); Return a NAK   (INCREMENT-RETRIES); Increment the retries   K*STATE); and keep trying    (:OTHERWISE; Unknown packet   (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   *ABORT-STATE*))))); and abort (DEFUN RFILE ()  "Receive File Header."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*FP K*RECFILNAM K*CANCEL    K*VERBOSEP K*ABORT-REASON K*EMPTY-PATHNAME))    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes, abort      (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET); - No...  (RPACK); Get a packet(CASE TYPE; What was the type?    (#\S; Send-Init   (IF (= NUM (IF (= K*PCKT-NUM 0)  63  (1- K*PCKT-NUM))); See if it's previous packet       (PROGN; - Yes (SETQ PACKET (SPAR PACKET)); Load in our Send-Init parameters (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); Send the ACK packet (INCREMENT-RETRIES); Increment the retries K*STATE); Stay in same state       (PROGN; - No, (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Otherwise set up error (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\Z; End-Of-File   (IF (= NUM (IF (= K*PCKT-NUM 0)  63  (1- K*PCKT-NUM))); See if it's previous packet       (PROGN; - Yes (SPACK #\Y K*PCKT-NUM 0 NIL); Send the ACK packet (INCREMENT-RETRIES); Increment the retries K*STATE); Finally, stay in this K*STATE       (PROGN; - No (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\F; File Header (just what we want)   (IF (= NUM K*PCKT-NUM); Correct packet number?       (LET; - Yes ((FILNAM (DECODE-PREFIXED-DATA PACKET LEN)); Decode the packet to get the filename    (NEWFILNAM NIL)) (CONDITION-CASE (ERR)     (PROGN      (SETQ NEWFILNAM; Determine the filename to use    (SEND      (FS:MERGE-PATHNAMES(IF K*RECFILNAM                 ; Was a transfer name specified?    (FS:DEFAULT-WILD-PATHNAME-COMPONENTS   ; Yes.  Use it.      (FS:PARSE-PATHNAME; Make a pathname from the transfer nameK*RECFILNAMNILK*EMPTY-PATHNAME); Merge with empty pathname      (FS:PARSE-PATHNAME(CREATE-KERMIT-FILENAME FILNAM); Create a suitible filename from FILNAMNILK*EMPTY-PATHNAME))    FILNAM)                     ; No.  Use the filename from packet.(USER-HOMEDIR-PATHNAME))      :STRING-FOR-PRINTING))      (SETQ K*FP; Try to open the file     (OPEN NEWFILNAM    :DIRECTION :OUTPUT  :IF-EXISTS ':NEW-VERSION  :IF-DOES-NOT-EXIST ':CREATE  :BYTE-SIZE 8                       ; always use a byte-size of 8 initially  :CHARACTERS (IF *IMAGE* NIL T))))  ; If in image mode, open with :CHARACTERS NIL   (ERROR    (PRINTMSG "~%~A"; Print error      (SETQ K*ABORT-REASON    (FORMAT NIL "~A: Error <~A> while creating file."    *KERMIT-NAME* (SEND ERR :REPORT-STRING))))    (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON)    *ABORT-STATE*); abort   (:NO-ERROR    (INITIALIZE-STATUS-COUNTS); Reset the timing info    (PRINT-STATUS-FILE-INFO); update the filenames on the screen    (PRINTMSG "~%Receiving ~A as ~A." FILNAM NEWFILNAM)    (SPACK #\Y K*PCKT-NUM (LENGTH NEWFILNAM) NEWFILNAM); ACKnowledge the file header    (INCREMENT-PACKET-NUMBER); Bump packet count    *RDATA-STATE*))); Switch to RDATA-STATE       (PROGN; - No, incorrect packet number (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect S packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\X                                  ; Print to TTY   (IF (= NUM K*PCKT-NUM); Correct packet number?       (PROGN; - Yes (SETQ K*FP; Direct the output to the TTY       (IF K*VERBOSEP   *INFO-WINDOW*   (MAKE-STRING-OUTPUT-STREAM))) (INITIALIZE-STATUS-COUNTS); Reset the timing info (PRINT-STATUS-FILE-INFO); update the filenames on the screen (PRINTMSG "~%Receiving ~A on screen.~%" PACKET) (SPACK #\Y K*PCKT-NUM 0 NIL); ACKnowledge the file header (INCREMENT-PACKET-NUMBER); Bump packet count *RDATA-STATE*); Switch to RDATA-STATE       (PROGN; - No (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect S packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\B; Break transmission (EOT)   (IF (= NUM K*PCKT-NUM); Correct packet number?       (PROGN; - Yes (SPACK #\Y K*PCKT-NUM 0 NIL); Say OK *COMPLETE-STATE*); Switch to COMPLETE-STATE       (PROGN; - No (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect S packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\E; Error packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))   *ABORT-STATE*)    (NIL; Didn't get packet - timeout   (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK   (INCREMENT-RETRIES); Increment the retries   K*STATE); Stay in same K*STATE and keep trying    (:OTHERWISE; Unknown packet - abort   (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   *ABORT-STATE*))))) (DEFUN RDATA ()  "Receive Data."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*CANCEL K*ABORT-REASON K*FILE-CHARS K*FP))    (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)      (RPACK); Get a packet    (CASE TYPE; What was the type?            (#\D; Data packet       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes,     (COUNT-AND-PRINT-PACKETS LEN); Keep track of packet totals     (INCF K*FILE-CHARS (BUFEMP PACKET LEN K*FP)) ; Write the data to the file and increment total chars     (IF K*CANCEL; Should the transfer be interrupted? (PROGN; -- Yes   (SPACK #\Y K*PCKT-NUM 1 "Z"); Send the ACK with cancel   (INCREMENT-PACKET-NUMBER); Bump packet count   *RCANCEL-STATE*); Switch to RCANCEL-STATE (PROGN; -- No   (SPACK #\Y K*PCKT-NUM 0 NIL); Send regular ACK   (INCREMENT-PACKET-NUMBER); Bump packet count   *RDATA-STATE*))); Remain in RDATA-STATE   (PROGN; - No, wrong packet number     (IF (= NUM (IF (= K*PCKT-NUM 0)    63    (1- K*PCKT-NUM))); See if it's previous packet (PROGN; -- Yes   (SPACK #\Y K*PCKT-NUM 0 NIL); Send an ACK   (INCREMENT-RETRIES); Increment the retries   K*STATE); Finally, stay in this K*STATE so no data will be written (PROGN; -- No   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Otherwise, set up error   (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))))); abort            (#\F; File header       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Otherwise, set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\X; File header       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\Z; End-Of-File       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes     (IF (AND (> LEN 0);      (EQUAL (SUBSEQ PACKET 0 1) "D")) ; Is D specified? (PROGN        ; -- Yes   (IF (OR *SAVEFILES*          ; Should the file be saved?  e.g., is *SAVEFILES* true    (STRING-EQUAL K*CANCEL "S")) ; or K*CANCEL save?       (PROGN                   ; --- Yes (SEND K*FP :CLOSE); Close but save the file (PRINTMSG "~%Receive aborted - file saved."))       (PROGN                   ; --- No (SEND K*FP :CLOSE T); Close with abort (discard) (PRINTMSG "~%Receive aborted - file discarded.")))) (PROGN; -- No   (SEND K*FP :CLOSE); Close the file [NOTE IF SEND-TO-TTY must save stream BAC]   (WHEN (TYPEP K*FP 'SYS:FILE-STREAM-MIXIN)     (FS:CHANGE-FILE-PROPERTIES K*FP NIL :BYTE-SIZE (IF *IMAGE* *IMAGE* 8)))   (PRINTMSG "~%Receive completed - file closed.")))     (SETQ K*FP NIL); Clear the file pointer     (SPACK #\Y K*PCKT-NUM 0 NIL); Say OK     (INCREMENT-PACKET-NUMBER); Bump packet count     *RFILE-STATE*); Go back to Receive File K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Didn't get packet - timeout       (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK       (INCREMENT-RETRIES); Increment the retries       K*STATE); Stay in same K*STATE and keep trying            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))       (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send an error packet       *ABORT-STATE*))))(DEFUN RCANCEL ()  "We cancelled receive - now send an ERROR packet when we get a DATA packet."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*CANCEL K*ABORT-REASON K*FP))    (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)      (RPACK); Get a packet    (CASE TYPE; What was the type?            (#\D; Data packet       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes     (SEND K*FP :CLOSE T); Close with abort (discard)     (PRINTMSG "~%Receive aborted - file discarded")     (SETQ K*FP NIL); Clear the file pointer     (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send an error packet     (INCREMENT-PACKET-NUMBER); Bump packet count     (IF K*CANCEL         ; Cancel all further transfers? (really not valid, since only Z supported) *ABORT-STATE*; -- Yes, abort (PROGN; -- No   (SETQ K*CANCEL NIL); Reset K*CANCEL and   *RFILE-STATE*))); switch to RFILE-STATE   (PROGN; - No, wrong packet number     (IF (= NUM (IF (= K*PCKT-NUM 0)    63    (1- K*PCKT-NUM))); See if it's previous packet (PROGN; -- Yes   (SPACK #\Y K*PCKT-NUM 0 NIL); Send an ACK   (INCREMENT-RETRIES); Increment the retries   K*STATE); Finally, stay in this K*STATE so no data will be written (PROGN; -- No   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Set up error   (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))))); abort            (#\F; File header       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\X; TTY       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\Z; End-Of-File       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes     (IF (AND (> LEN 0); D specified to discard file?      (EQUAL (SUBSEQ PACKET 0 1) "D")) (PROGN        ; -- Yes   (IF (OR *SAVEFILES*          ; Should the file be saved?  e.g., is *SAVEFILES* true    (STRING-EQUAL K*CANCEL "S")) ; or K*CANCEL save?       (PROGN                   ; --- Yes (SEND K*FP :CLOSE); Close but save the file (PRINTMSG "~%Receive aborted - file saved."))       (PROGN                   ; --- No (SEND K*FP :CLOSE T); Close with abort (discard) (PRINTMSG "~%Receive aborted - file discarded.")))) (PROGN; -- No   (SEND K*FP :CLOSE); Close the file [NOTE IF SEND-TO-TTY must save stream BAC]   (PRINTMSG "~%Receive aborted - file ~A closed")))     (SETQ K*FP NIL); Clear the file pointer     (SPACK #\Y K*PCKT-NUM 0 NIL); Say OK     (INCREMENT-PACKET-NUMBER); Bump packet count     (IF K*CANCEL        ; Cancel all further transfers? (not needed, since only Z supported) *ABORT-STATE*; -- Yes, abort (PROGN; -- No   (SETQ K*CANCEL NIL); reset K*CANCEL and   *RFILE-STATE*))); switch to RFILE-STATE   (PROGN; - No, incorrect packet number     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Didn't get packet       (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK       (INCREMENT-RETRIES); Increment the retries       K*STATE); Stay in same K*STATE and keep trying            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))       (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send an error packet       *ABORT-STATE*))))(DEFUN SGENERIC (SPACK-TYPE &OPTIONAL SPACK-DATA)  "Used for server commands expecting short response such as ACK.SPACK-TYPE should be a G, R or C packet type."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*NUMTRY K*SPACKET K*VERBOSEP    K*CANCEL K*SERVER-PACK-TYPE K*FP K*PACKETS-RETRIED K*ABORT-REASON))    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes      (PROGN; - No(INITIALIZE-STATUS-COUNTS); Initialize the packet counts and timing(ENCODE-PREFIXED-DATA SPACK-DATA K*SPACKET)           ; Prefix encode the data(SETQ SPACK-DATA K*SPACKET)(SPACK SPACK-TYPE 0 (LENGTH SPACK-DATA) SPACK-DATA); Send a G, R or C packet(MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)    (RPACK); What was the reply?  (CASE TYPE        (#\S; Send-Init     (IF (ZEROP NUM); Packet number 0? (PROGN; - Yes,         (RPAR PACKET LEN); Get other side's init info   (SETQ PACKET (SPAR PACKET)); Fill up my init info packet   (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); ACK with my parameters   (INCREMENT-PACKET-NUMBER); Bump packet number   *RFILE-STATE*); OK, enter File-Receive state (PROGN; - No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\X; Text header     (IF (ZEROP NUM); Correct packet number? ; maybe K*PCKT-NUM instead? ; BAC (PROGN; - Yes    (SETQ K*FP; set the file pointer to (IF K*VERBOSEP; either the info window or a string stream     *INFO-WINDOW*     (MAKE-STRING-OUTPUT-STREAM)))           (PRINTMSG "~%Receiving ~A on the screen.~%" PACKET)   (SPACK #\Y K*PCKT-NUM 0 NIL); ACKnowledge the file header   (INCREMENT-PACKET-NUMBER); Bump packet count   *RDATA-STATE*); switch to RDATA-STATE (PROGN; - No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\N; NAK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Stay in same K*STATE        (#\Y; ACK     (IF (ZEROP NUM); See if it's correct ACK (PROGN; - Yes        (PRINTMSG "~%~A" PACKET); print data on tty   *COMPLETE-STATE*); Switch to COMPLETE-STATE (PROGN; - No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\E; Error packet received     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))     *ABORT-STATE*)        (NIL; Timeout     (IF (AND (= SPACK-TYPE #\G); Did we just request      (OR (EQUAL (SUBSEQ SPACK-DATA 0 1) "L"); a remote logout   (EQUAL (SUBSEQ SPACK-DATA 0 1) "F"))); or a remote finish? *COMPLETE-STATE*; - Yes, the remote KERMIT will never respond so we're finished (PROGN; - No   (INCREMENT-RETRIES); Increment the retries   K*STATE))); remain in same K*STATE        (:OTHERWISE; Unknown packet - abort     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))     *ABORT-STATE*))))))(DEFUN SSERVER ()  "Used for server commands expecting large responses."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*SPACKET K*CANCEL    K*YOUREOL K*YOURQUOTE K*VERBOSEP K*FP K*ABORT-REASON))    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes, so abort      (PROGN; - No(SETQ K*SPACKET (SPAR K*SPACKET)); Fill up init info packet(SPACK #\I K*PCKT-NUM (LENGTH K*SPACKET) K*SPACKET); Send an I packet with type,number,length,packet(MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)    (RPACK); What was the reply?  (CASE TYPE        (#\Y; ACK     (IF (ZEROP NUM); Correct packet number (0)? (PROGN; -- Yes   (RPAR PACKET LEN); Get other side's init info   *SGENERIC-STATE*); Move to SGENERIC-STATE (PROGN; -- No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\N; NAK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Stay in same K*STATE        (#\E; Error packet received - use defaults - but how? ;; BAC     *SGENERIC-STATE*); Switch to SGENERIC-STATE        (NIL; Timeout     (INCREMENT-RETRIES); Increment the retries     K*STATE); remain in same K*STATE        (:OTHERWISE; Unknown packet - abort     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))     *ABORT-STATE*))))))(DEFUN RSERVER ()  "Receive Server - This KERMIT in server mode, idle and waiting for a message."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*NUMTRY K*FILNAM K*SPACKET K*ABORT-REASON    K*PACKETS-RETRIED K*CANCEL K*YOURMAXPACSIZ K*FP K*SEND-TO-TTY    K*ARG1LIST))    (SETQ K*PCKT-NUM 0); Initialize the packet number  (SETQ K*NUMTRY 0); Zero the number of tries - can't exceed maxtry in this state  (SETQ K*ABORT-REASON ""); Reset the abort reason string  (SETQ K*SEND-TO-TTY NIL)  (INITIALIZE-STATUS-COUNTS); Initialize the packet counts and timing info    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes      (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET); - No  (RPACK 900); Get a packet - wait 15 seconds (60 * 15) for it (CASE TYPE    (#\I; INIT   (IF (ZEROP NUM); Correct packet number (0)?       (PROGN; -- Yes  (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK K*STATE); Stay in same K*STATE       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet K*STATE))); Stay in same K*STATE    (#\S; SEND-INIT   (IF (ZEROP NUM); Correct packet number (0)?       (PROGN; -- Yes (RPAR PACKET LEN); Get other side's init info (SETQ PACKET (SPAR PACKET)); Fill up my init info packet (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); ACK with my parameters (INCREMENT-PACKET-NUMBER); Bump packet number *RFILE-STATE*); OK, enter File-Receive state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); and stay in same K*STATE    (#\R; RECEIVE-INIT   (IF (ZEROP NUM); Correct packet number (0)?       (PROGN; -- Yes (SETQ K*ARG1LIST       (EXPAND-WILDS; Expand any wildcards in the filename (DECODE-PREFIXED-DATA PACKET LEN))); Decode the packet to get the requested filename (GET-NEXT-FILE); Get the file to process *SINIT-STATE*); Proceed to SINIT-STATE       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); and stay in same K*STATE    (#\K; KERMIT command   (IF (ZEROP NUM); Correct packet number (0)?       (LET ((RESULT (PROCESS-KERMIT-COMMAND PACKET LEN))) (IF (OR       K*FILNAM                 ; Filename specified for transfer?       (> (LENGTH RESULT)       ; or long reply?  (FLOOR K*YOURMAXPACSIZ 1.5)))      (PROGN                     ; - Yes       (SETQ K*SEND-TO-TTY T)   ; Set tty flag       (WHEN (NOT K*FILNAM) (SETQ K*FP       (MAKE-STRING-INPUT-STREAM RESULT)))       *SINIT-STATE*)           ; Go to SINIT-STATE     (PROGN                     ; - No       (SPACK #\Y K*PCKT-NUM (LENGTH RESULT) RESULT); ACK with the requested info       K*STATE)))                ; Stay in same state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); Stay in same state    (#\C; HOST command   (IF (ZEROP NUM); Correct packet number (0)?       (LET ((RESULT (PROCESS-HOST-COMMAND PACKET LEN))) (IF (OR       K*FILNAM                 ; Filename specified for tranfer?       (> (LENGTH RESULT)       ; or long reply?  (FLOOR K*YOURMAXPACSIZ 1.5)))      (PROGN                     ; - Yes       (SETQ K*SEND-TO-TTY T)   ; Set tty flag       (WHEN (NOT K*FILNAM) (SETQ K*FP       (MAKE-STRING-INPUT-STREAM RESULT)))       *SINIT-STATE*)           ; Go to SINIT-STATE     (PROGN                     ; - No       (SPACK #\Y K*PCKT-NUM (LENGTH RESULT) RESULT); ACK with the requested info       K*STATE)))                ; Stay in same state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); Stay in same state    (#\G; GENERIC command   (IF (ZEROP NUM); Correct packet number (0)?       (LET ((RESULT (PROCESS-GENERIC-COMMAND PACKET LEN))) (IF (OR       K*FILNAM                 ; Filename specified for tranfer?       (> (LENGTH RESULT)       ; or long reply?  (FLOOR K*YOURMAXPACSIZ 1.5)))      (PROGN                     ; - Yes       (SETQ K*SEND-TO-TTY T)   ; Set tty flag       (WHEN (NOT K*FILNAM) (SETQ K*FP       (MAKE-STRING-INPUT-STREAM RESULT)))       *SINIT-STATE*)           ; Go to SINIT-STATE     (PROGN                     ; - No       (SPACK #\Y K*PCKT-NUM (LENGTH RESULT) RESULT); ACK with the requested info       K*STATE)))                ; Stay in same state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); Stay in same state    (#\E; Error packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON (FORMAT NIL "~%~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))   K*STATE); Stay in same K*STATE  (#\N; NAK packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Server received NAK packet, but cannot resend last packet."   *KERMIT-NAME*)))   (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet with an error message   K*STATE)    (NIL; Timeout   (SPACK #\N 0 0 NIL); Return a NAK   K*STATE); and keep trying    (:OTHERWISE; Unknown packet   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Server received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet with an error message   K*STATE)))));;; KERMIT utilities.(DEFUN SPACK (TYPE NUM LEN DATA)  "Send a packet.  Returns T."  (DECLARE (SPECIAL K*BUFFER K*YOURPAD K*YOURPADCHAR K*YOUREOL K*TTYFD K*YOURMAXPACSIZ))  (SEND K*TTYFD :CLEAR-INPUT); clear the input buffer    (LET ((IND 0)(CHECKSUM 0))    (DOTIMES (i K*YOURPAD)                          (SETF (AREF K*BUFFER i) K*YOURPADCHAR); Issue any padding      (INCF IND))        (SETF (AREF K*BUFFER IND) *ASCII-SOH*); Packet marker, ASCII 1 SOH    (INCF IND); Increment    (WHEN (> LEN (- K*YOURMAXPACSIZ 2))         ; Be sure outgoing message fits in packet      (WHEN *DEBUG*(PRINTMSG  "~%SPACK: Message length <~A> was too large - truncating." LEN))      (SETQ LEN (- K*YOURMAXPACSIZ 2)))    (SETF (AREF K*BUFFER IND) (TOCHAR (+ LEN 3))); Character count    (INCF IND); Increment    (SETQ CHECKSUM (TOCHAR (+ LEN 3))); Initialize the checksum        (SETF (AREF K*BUFFER IND) (TOCHAR NUM)); Packet number    (INCF IND); Increment    (SETQ CHECKSUM (+ CHECKSUM (TOCHAR NUM))); Update checksum to include NUM        (SETF (AREF K*BUFFER IND) TYPE); Packet type    (INCF IND); Increment    (SETQ CHECKSUM (+ CHECKSUM TYPE)); Update checksum to include TYPE        (DOTIMES (i LEN); Loop for all data characters      (SETF (AREF K*BUFFER IND) (AREF DATA i)); Get a character      (INCF IND); Increment      (SETQ CHECKSUM (+ CHECKSUM (AREF DATA i)))); Update checksum to include character        (SETQ CHECKSUM (COMPUTE-FINAL-CHECKSUM CHECKSUM)); Compute final checksum    (SETF (AREF K*BUFFER IND) (TOCHAR CHECKSUM)); Put it in the packet    (INCF IND); Increment        (SETF (AREF K*BUFFER IND) K*YOUREOL); Extra-packet line terminator    (INCF IND); Increment        (SETF (FILL-POINTER K*BUFFER) IND); Setup the length of the buffer    (SEND K*TTYFD :STRING-OUT K*BUFFER 0 IND); Send the packet        (WHEN *DEBUG*; For Debugging display outgoing packet      (PRINTMSG"~%SPACK:  type=~A  num=~D  len=~D  data=~S  buffer=~S" type num len data K*BUFFER)))      T); Finally, return T(DEFUN RPACK (&OPTIONAL (TIMEOUT (* *MYTIME* 60)))  "Read a packet from the K*TTYFD stream.  Returns values TYPE, LEN, NUM and DATA.:TYI-WITH-TIMEOUT added to Explorer serial stream.  Optional timeout supplied toallow server mode to have longer timeouts."  (DECLARE (SPECIAL K*TTYFD K*YOURMAXPACSIZ K*RPACKET))    (LET ((CCHECKSUM 0) (RCHECKSUM 0) (DATA-COUNT 0)(TYPE NIL) (LEN 0) (NUM 0) (READ-STATE 0))        (SETF (FILL-POINTER K*RPACKET) 0); Say no data in array yet    (LOOP      UNTIL (> READ-STATE 7)      FOR T-CHAR = (SEND K*TTYFD :TYI-WITH-TIMEOUT TIMEOUT)      WHEN (NULL T-CHAR)      DO      (SETQ READ-STATE 99)      ELSE      DO            (WHEN (NOT *IMAGE*); If not in *IMAGE* mode,(SETQ T-CHAR (LOGAND T-CHAR #b1111111))); handle the parity - #b1111111 is #o177            (WHEN (= T-CHAR *ASCII-SOH*); If *ASCII-SOH*(SETQ READ-STATE 1)); resynchronize!            (CASE READ-STATE(0; Never had a Start Header NIL); Do nothing(1; Start Header (INCF READ-STATE)); ... on to next state(2; Length (SETQ CCHECKSUM T-CHAR); Start the checksum (SETQ LEN (- (UNCHAR T-CHAR) 3)); Character count (SETQ LEN (ABS LEN)); temp - must handle this BAC (WHEN (OR (> LEN K*YOURMAXPACSIZ) (< LEN 0)); BAC - carefull   (SETQ TYPE NIL); Error in packet length   (SETQ READ-STATE 99); Get out of loop!   (PRINTMSG "~%RPACK:  Error reading length <~A>~%" LEN)) (INCF READ-STATE)); ... on to the next state(3; Packet number (SETQ CCHECKSUM (+ CCHECKSUM T-CHAR)); Update checksum (SETQ NUM (UNCHAR T-CHAR)); Packet number (INCF READ-STATE)); ... on to the next state(4; Packet type (SETQ CCHECKSUM (+ CCHECKSUM T-CHAR)); Update checksum (SETQ TYPE (CODE-CHAR T-CHAR)); Packet type - make number into a character (IF (ZEROP LEN); Check for any data     (SETQ READ-STATE 6); If no data, skip to checksum state     (PROGN; data ...       (SETQ DATA-COUNT 0); set up DATA-COUNT for next state       (INCF READ-STATE)))); ... on to the next state(5; Data characters (SETQ CCHECKSUM (+ CCHECKSUM T-CHAR)); Update checksum (SETF (AREF K*RPACKET DATA-COUNT) T-CHAR); Get a character (INCF DATA-COUNT); Increment the data count (WHEN (= DATA-COUNT LEN); If no more data characters   (INCF READ-STATE))); ... on to the next state(6; Checksum (SETQ RCHECKSUM (UNCHAR T-CHAR)); Convert to numeric (SETQ CCHECKSUM (COMPUTE-FINAL-CHECKSUM CCHECKSUM)); Compute the checksum (WHEN (NOT (= CCHECKSUM RCHECKSUM)); If checksum is not ok,   (SETQ TYPE NIL); indicate an error so that we'll loop again   (WHEN *DEBUG*; For debugging, print checksum errors     (PRINTMSG       "~%RPACK:  Error comparing received checksum <~A> to computed checksum <~A> in packet number <~A>~%"       RCHECKSUM CCHECKSUM NUM))) (SETF (AREF K*RPACKET LEN) 0); Mark the end of the data (SETF (FILL-POINTER K*RPACKET) LEN); (INCF READ-STATE)); ... on to the next state(7; EOL character - throw it away! (INCF READ-STATE)))); ... on to the next state DONE!!!        (WHEN *DEBUG*; For Debugging display incoming packet      (PRINTMSG"~%RPACK:  type=~A  num=~D  len=~D  data=~A" TYPE NUM LEN K*RPACKET))        (VALUES TYPE LEN NUM K*RPACKET))); Return values(DEFUN BUFILL (BUFFER FILEPOINTER)  "Fill a packet buffer with data from a file.   Input parameters are the buffer in which to place the file data,   and a file pointer from which to read the data.  As a result of   processing, BUFFER is filled and the position in FILEPOINTER is   advanced.  Returned value is the length of the buffer.   K*BUFILLPTR and K*BUFILLBUF are used to buffer the file data   for look-ahead processing."    (DECLARE (SPECIAL K*BUFILLBUF K*BUFILLPTR K*YOURMAXPACSIZ K*YOURQUOTE    K*REPEAT K*BINQUOTE K*FILE-CHARS))  (LET    ((7-CHAR NIL)     (8-CHAR NIL)     (EOF NIL)     (INDEX 0)     (TMPBUFILLPTR NIL)     (LENBUFILLBUF (LENGTH K*BUFILLBUF))     (ACTUALMAXPACSIZ (- K*YOURMAXPACSIZ 8))     (QUOTABLES (LIST K*YOURQUOTE      (WHEN (NOT (= K*BINQUOTE *ASCII-N*)) K*BINQUOTE)      (WHEN (NOT (= K*REPEAT *ASCII-SP*)) K*REPEAT))))        (LOOP      UNTIL (OR (>= INDEX  ACTUALMAXPACSIZ) EOF); Until we exceed length of the packet or are at EOF            WHEN (= K*BUFILLPTR LENBUFILLBUF); When we run out of data in the buffer      DO      (SETQ K*BUFILLPTR 0); Reset the pointer      (WHEN (ZEROP (SEND FILEPOINTER :STRING-IN NIL K*BUFILLBUF)); and get more(SETQ EOF T)); If no more, set EOF      (SETQ LENBUFILLBUF (LENGTH K*BUFILLBUF)); Newly filled buffer so get the length      ELSE      DO      (SETQ 8-CHAR (AREF K*BUFILLBUF K*BUFILLPTR)); Get the next character from the file buffer      (INCF K*BUFILLPTR); Increment the pointer      (INCF K*FILE-CHARS)                       ; Increment the total number of file chars read            (WHEN (NOT (= K*REPEAT *ASCII-SP*)); If we have agreed to do repeat processing,(SETQ TMPBUFILLPTR K*BUFILLPTR); handle the repeat characters(LOOP; Loop until  UNTIL (OR (= TMPBUFILLPTR LENBUFILLBUF)       ; either we run out of chars from the buffer     (NOT (= 8-CHAR (AREF K*BUFILLBUF TMPBUFILLPTR)))) ; or we get one that's not equal to 8-char  DO (INCF TMPBUFILLPTR))(SETQ TMPBUFILLPTR (1+ (- TMPBUFILLPTR K*BUFILLPTR))); We repeat the char TMPBUFILLPTR times(WHEN (> TMPBUFILLPTR 3); If this is more than 3, do repeat prefixing!  (WHEN (> TMPBUFILLPTR 94) (SETQ TMPBUFILLPTR 94)); Also, truncate the number of repeats to 94  (SETF (AREF BUFFER INDEX) K*REPEAT); Put repeat character in the packet  (INCF INDEX); Increment  (SETF (AREF BUFFER INDEX) (TOCHAR TMPBUFILLPTR)); Put my repeat count in the packet  (INCF INDEX); Increment  (SETQ K*BUFILLPTR (+ K*BUFILLPTR TMPBUFILLPTR -1)); adjust the buffer index for the next character  (SETQ K*FILE-CHARS (+ K*FILE-CHARS TMPBUFILLPTR -1)))) ; Adjust the total file chars read           (WHEN (AND (NOT (= K*BINQUOTE *ASCII-N*)); Handle 8-bit quoting (> 8-CHAR *ASCII-DEL*)); If the 8-bit char is > 127(SETF (AREF BUFFER INDEX) K*BINQUOTE); Put K*BINQUOTE in buffer(INCF INDEX)); Increment             (WHEN (NOT *IMAGE*); As long as we're not in image mode(SETQ 8-CHAR (CONVERT-TO-ASCII 8-CHAR))); force characters to ASCII             (SETQ 7-CHAR (LOGAND 8-CHAR #b1111111)); Get low order 7 bits - #b1111111 is #o177      (WHEN (OR (< 7-CHAR *ASCII-SP*); Does char require special handling?(MEMBER 7-CHAR QUOTABLES)(= 7-CHAR *ASCII-DEL*))(WHEN (AND (= 7-CHAR *ASCII-CR*); Map CR->CRLF when   (NOT *IMAGE*)); not in image mode  (SETF (AREF BUFFER INDEX) K*YOURQUOTE); Put K*YOURQUOTE in buffer  (INCF INDEX); Increment  (SETF (AREF BUFFER INDEX) (CTL *ASCII-CR*)); Put the character in buffer  (INCF INDEX); Increment  (SETQ 8-CHAR *ASCII-LF*); Replace the char with a linefeed  (SETQ 7-CHAR (LOGAND 8-CHAR #b1111111))); Get low order 7 bits - #b1111111 is #o177(SETF (AREF BUFFER INDEX) K*YOURQUOTE); Put K*YOURQUOTE in buffer(INCF INDEX); Increment(WHEN; Make printable characters  (NOT(MEMBER 7-CHAR QUOTABLES))        ; As long as it's not the active quote, binquote or repeat   (SETQ 7-CHAR (CTL 7-CHAR))  (SETQ 8-CHAR (CTL 8-CHAR))))            (IF *IMAGE*  (SETF (AREF BUFFER INDEX) 8-CHAR)  (SETF (AREF BUFFER INDEX) 7-CHAR))      (INCF INDEX))        (SETF (FILL-POINTER BUFFER) INDEX)    INDEX)); Return the index(DEFUN BUFEMP (BUFFER LEN FILEPOINTER)  "Put data from an incoming packet buffer into a file.   Input parameters are the packet, it's length, and a   pointer to the file in which to store the data.  As a   result of processing, data is written to the file.   This function returns the total number of characters   written to the file."    (DECLARE (SPECIAL K*IGNORE-NEXT-LINEFEED K*REPEAT K*BINQUOTE))    (LET (T-CHAR 7-CHAR REPEAT BINQUOTED(FILE-CHARS 0)(QUOTABLES (LIST *MYQUOTE*      (WHEN (NOT (= K*BINQUOTE *ASCII-N*)) K*BINQUOTE)      (WHEN (NOT (= K*REPEAT *ASCII-SP*)) K*REPEAT))))    (LOOP      WITH IND = 0      UNTIL (= IND LEN)      DO      (SETQ T-CHAR (AREF BUFFER IND)); Get a character            (SETQ REPEAT 1)      (SETQ BINQUOTED NIL)            (WHEN (AND (NOT (= K*REPEAT *ASCII-SP*)) (= T-CHAR K*REPEAT)); Is it the repeat prefix?(INCF IND)(SETQ REPEAT (UNCHAR (LOGAND (AREF BUFFER IND) #b1111111))); Get the repeat count(INCF IND); Increment(SETQ T-CHAR (AREF BUFFER IND))); Get next char            (WHEN (AND (NOT (= K*BINQUOTE *ASCII-N*)) (= T-CHAR K*BINQUOTE)); Is it the binary quote prefix?(SETQ BINQUOTED T); flag it(INCF IND)(SETQ T-CHAR (AREF BUFFER IND))); Get next char            (WHEN (= T-CHAR *MYQUOTE*); Control quote?(INCF IND); Increment(SETQ T-CHAR (AREF BUFFER IND)); Get the quoted character(SETQ 7-CHAR (LOGAND T-CHAR #b1111111)); and strip off the parity bit(WHEN (NOT (MEMBER 7-CHAR QUOTABLES)); Low order bits match active quote, binquote or repeat char?  (SETQ T-CHAR (CTL T-CHAR)))); - No, uncontrollify it            (WHEN BINQUOTED; If the binary prefix was set(SETQ T-CHAR (LOGXOR T-CHAR #b10000000))); set the 8th bit            (LOOPFOR I FROM 1 TO REPEAT; Now do the repeat count processingDO(IF *IMAGE*; Image mode?    (PROGN                              ; - Yes      (SEND FILEPOINTER :TYO T-CHAR); send the character      (INCF FILE-CHARS))                ; Increment the total file chars written    (PROGN; - No,       (SETQ T-CHAR (LOGAND T-CHAR #b1111111)); Strip off the parity bit      (IF (AND (= T-CHAR *ASCII-LF*); Is it a linefeed       K*IGNORE-NEXT-LINEFEED); after a CR?   (SETQ K*IGNORE-NEXT-LINEFEED NIL); -- Yes, ignore the LF and clear the flag  (PROGN; -- No,    (SETQ K*IGNORE-NEXT-LINEFEED; setup the flag  (IF (= T-CHAR *ASCII-CR*) T NIL)); T If it's a CR; otherwise NIL    (SETQ T-CHAR (CONVERT-FROM-ASCII T-CHAR)); Convert the character    (WHEN T-CHAR; If it has an appropriate conversion,      (SEND FILEPOINTER :TYO T-CHAR)   ; Write char to the file      (INCF FILE-CHARS))))))); Increment the total file chars written            (INCF IND)); Increment the index    FILE-CHARS))                                ; Return the total number of chars written(DEFUN GET-NEXT-FILE ()  "Get next file in a file group.  Returns NIL if no more files."  (DECLARE (SPECIAL K*FILNAM K*RECFILNAM K*ARG1LIST K*ARG2LIST))    (SETQ K*FILNAM (CAR K*ARG1LIST)); Get the next file  (SETQ K*ARG1LIST (CDR K*ARG1LIST)); Shorten the list  (SETQ K*RECFILNAM (CAR K*ARG2LIST)); Get the next recfile  (SETQ K*ARG2LIST (CDR K*ARG2LIST)); Shorten the list  (WHEN (AND (STRINGP K*FILNAM)     (ZEROP (LENGTH K*FILNAM))); If its an empty string, make it nil    (SETQ K*FILNAM NIL))  (WHEN (AND (STRINGP K*RECFILNAM)     (ZEROP (LENGTH K*RECFILNAM))); If its an empty string, make it nil    (SETQ K*RECFILNAM NIL))  (WHEN *DEBUG*; Print debugging info    (PRINTMSG      "~%Function GET-NEXT-FILE:  k*filnam=~A  k*recfilnam=~A  k*arg1list=~A  k*arg2list=~A"      K*FILNAM K*RECFILNAM K*ARG1LIST K*ARG2LIST))  (IF K*FILNAM; More files?      T      NIL))(DEFUN SPAR (DATA)  "Fill the data array with my send-init parameters.Returns the data array."  (DECLARE (SPECIAL K*BINQUOTE K*REPEAT))  (SETF (FILL-POINTER DATA) 9); Set array length to 9  (SETF (AREF DATA 0) (TOCHAR *MYMAXPACSIZ*)); Biggest packet I can receive  (SETF (AREF DATA 1) (TOCHAR *MYTIME*)); When I will time out  (SETF (AREF DATA 2) (TOCHAR *MYPAD*)); How much padding I need  (SETF (AREF DATA 3) (CTL *MYPADCHAR*)); Padding character I want  (SETF (AREF DATA 4) (TOCHAR *MYEOL*)); End-Of-Line character I want  (SETF (AREF DATA 5) *MYQUOTE*); Quote character I use  (SETF (AREF DATA 6) K*BINQUOTE); 8-bit quote character I use  (SETF (AREF DATA 7) *ASCII-1*); Only know how to do 1 char checksum  (SETF (AREF DATA 8) K*REPEAT); Repeat count character I use  DATA)(DEFUN RPAR (DATA LEN)  "Read the data array to get the other host's send-init parameters.Returns the data array."  (DECLARE (SPECIAL K*YOURMAXPACSIZ K*YOURTIME K*YOURPAD K*YOURPADCHAR    K*YOUREOL K*YOURQUOTE K*BINQUOTE K*REPEAT K*STATE K*TTYFD-BITS))  (LET    ((REPEAT 0)     (BINQUOTE 0))        (WHEN (> LEN 0)      (SETQ K*YOURMAXPACSIZ    (UNCHAR (AREF DATA 0)))); Maximum send packet size    (WHEN (> LEN 1)      (SETQ K*YOURTIME    (UNCHAR (AREF DATA 1)))); When you will time out    (WHEN (> LEN 2)      (SETQ K*YOURPAD    (UNCHAR (AREF DATA 2)))); Number of pads to send    (WHEN (> LEN 3)      (SETQ K*YOURPADCHAR    (CTL (AREF DATA 3)))); Padding character to send    (WHEN (> LEN 4)      (SETQ K*YOUREOL    (UNCHAR (AREF DATA 4)))); EOL character to send    (WHEN (> LEN 5)      (SETQ K*YOURQUOTE    (CHAR-CODE (AREF DATA 5)))); quote character to send    (WHEN (> LEN 6)      (SETQ K*BINQUOTE    (CHAR-CODE (AREF DATA 6)))); 8-bit quote character to send    (WHEN (> LEN 8)      (SETQ REPEAT    (CHAR-CODE (AREF DATA 8)))); Repeat character to send    (WHEN *DEBUG*      (PRINTMSG"~%RPAR (unadjusted):  pacsiz=~A/~A  time=~A/~A  pad=~A/~A  padchar=~A/~A  eol=~A/~A  quote=~A/~A  binquote=~A  repeat=~A" *MYMAXPACSIZ* K*YOURMAXPACSIZ *MYTIME* K*YOURTIME *MYPAD* K*YOURPAD *MYPADCHAR* K*YOURPADCHAR *MYEOL* K*YOUREOL *MYQUOTE* K*YOURQUOTE K*BINQUOTE K*REPEAT))        (IF (ZEROP K*YOURMAXPACSIZ); Is other KERMIT packet size unspecified?(SETQ K*YOURMAXPACSIZ *MYMAXPACSIZ*); - Yes, use our size(IF (< K*YOURMAXPACSIZ *MYMAXPACSIZ*); - No, is other KERMIT's smaller?    (SETQ *MYMAXPACSIZ* K*YOURMAXPACSIZ))); -- Yes - we'll both use other KERMIT's        (WHEN (ZEROP K*YOUREOL); Is other KERMIT EOL character unspecified?      (SETQ K*YOUREOL *MYEOL*)); - Yes, use *MYEOL*        (WHEN (ZEROP K*YOURQUOTE); Is other KERMIT quote character unspecified?      (SETQ K*YOURQUOTE *MYQUOTE*)); - Yes, use *MYQUOTE*        (IF (AND (= K*STATE *RINIT-STATE*); If we have never sent our parameters     (= K*STATE *SGENERIC-STATE*); and are processing the other     (= K*STATE *RSERVER-STATE*)); KERMIT's parameters first (e.g., he did the init)(PROGN; - Yes, we never sent  (COND; Process the 8-bit quoting char    ((AND; If the other KERMIT has a valid 8-bit quote char...       (OR (AND (> BINQUOTE 32) (< BINQUOTE 63))   (AND (> BINQUOTE 95) (< BINQUOTE 127)))       (NOT (= BINQUOTE K*YOURQUOTE)))     (SETQ K*BINQUOTE BINQUOTE)); use it        ((= BINQUOTE *ASCII-Y*); If 8-bit quote char is a Y     (IF *IMAGE*; Are we in image mode? (IF (= K*TTYFD-BITS 8); -- Yes, do we have an 8-bit stream?     (SETQ K*BINQUOTE *ASCII-N*); -- Yes, say no quoting     (SETQ K*BINQUOTE *ASCII-AMP*)); -- No, say we'll quote with & (SETQ K*BINQUOTE *ASCII-N*))); -- No, not in image mode so don't do 8-bit        (T; Otherwise...say no 8-bit quoting     (SETQ K*BINQUOTE *ASCII-N*)))  (IF; Process the repeat char    (AND (OR (AND (> REPEAT 32) (< REPEAT 63)); Is it valid?     (AND (> REPEAT 95) (< REPEAT 127))) (NOT (= REPEAT K*YOURQUOTE)) (NOT (= REPEAT K*BINQUOTE)))    (SETQ K*REPEAT REPEAT); -- Yes, setup the repeat char    (SETQ K*REPEAT *ASCII-SP*))); -- No...say no repeating(PROGN; - No, our parameters have been sent (we did the init)    (WHEN (AND (NOT (= BINQUOTE K*BINQUOTE)); Process the 8-bit quote char     (NOT (= BINQUOTE *ASCII-Y*)); If it's not what we sent, and its not a Y     (SETQ K*BINQUOTE *ASCII-N*))); say no 8-bit quoting    (WHEN (NOT (= REPEAT K*REPEAT)); Process the repeat char - If it's not what we sent,    (SETQ K*REPEAT *ASCII-SP*)))); say no repeating        (WHEN *DEBUG*      (PRINTMSG"~%RPAR   (adjusted):  pacsiz=~A/~A  time=~A/~A  pad=~A/~A  padchar=~A/~A  eol=~A/~A  quote=~A/~A  binquote=~A  repeat=~A" *MYMAXPACSIZ* K*YOURMAXPACSIZ *MYTIME* K*YOURTIME *MYPAD* K*YOURPAD *MYPADCHAR* K*YOURPADCHAR *MYEOL* K*YOUREOL *MYQUOTE* K*YOURQUOTE K*BINQUOTE K*REPEAT)))    DATA); Finally, return DATA as the value of the function;;; Support functions(DEFUN PROCESS-KERMIT-COMMAND (PACKET IGNORE)  "Given a packet containing the command, try to process it.Return a flag indicating success or failure, and the response."  (FORMAT NIL "~A: Unimplemented KERMIT server command <~A>." *KERMIT-NAME* PACKET))(DEFUN PROCESS-HOST-COMMAND (PACKET IGNORE)  "Process a host command.  If an error is encountered, returns an error string."  (LET    ((RESULT NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(SETQ RESPONSE      (WITH-OUTPUT-TO-STRING (STANDARD-OUTPUT); Force the output to go to the string(SETQ RESULT (EVAL (READ-FROM-STRING PACKET))))); Evaluate the command      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing HOST command <~A>."     *KERMIT-NAME* (SEND ERR :REPORT-STRING) PACKET)))      (:NO-ERROR       (FORMAT NIL "~A~A" RESPONSE RESULT))))); Just return the response(DEFUN PROCESS-GENERIC-COMMAND (PACKET LEN)  "Generic Kermit Command.  Single character in data field (possibly followedby operands, shown in {braces}, optional fields  in  [brackets]):    I   Login [{*user[*password[*account]]}]    C   CWD, Change Working Directory [{*directory[*password]}]    L   Bye (Logout)  * F   Finish (Shut down the server, but don't logout).  * D   Directory [{*filespec}]  * U   Disk Space Query (Usage) [{*area}]  * E   Delete (Erase) {*filespec}  * T   Type {*filespec}  * R   Rename {*oldname*newname}  * K   Copy {*source*destination}  * W   Who's logged in? (Finger) [{*user ID or network host[*options]}]    M   Send a short Message {*destination*text}    H   Help [{*topic}]  * Q   Server Status Query    P   Program {*[program-filespec][*program-commands]}    J   Journal {*command[*argument]}    V   Variable {*command[*argument[*argument]]}"    (DECLARE (SPECIAL K*FILNAM K*CANCEL))  (LET    ((COMD NIL)     (ARGS (DECODE-PREFIXED-DATA PACKET LEN))        ; Decode the data     (ARG1 NIL)     (ARG2 NIL)     (ARG3 NIL)     (LNTH 0)     (INDX 0))        (SETQ COMD (SUBSEQ ARGS 0 1))    (INCF INDX)    (WHEN (< INDX (LENGTH ARGS))                     ; Get the first argument      (SETQ LNTH (UNCHAR (COERCE (SUBSEQ ARGS INDX (1+ INDX)) 'CHARACTER)))      (INCF INDX)      (SETQ ARG1 (SUBSEQ ARGS INDX (+ INDX LNTH)))      (INCF INDX LNTH)          (WHEN (< INDX (LENGTH ARGS))                   ; Get the second argument(SETQ LNTH (UNCHAR (COERCE (SUBSEQ ARGS INDX (1+ INDX)) 'CHARACTER)))(INCF INDX)(SETQ ARG2 (SUBSEQ ARGS INDX (+ INDX LNTH)))(INCF INDX LNTH)(WHEN (< INDX (LENGTH ARGS))                 ; Get the third argument  (SETQ LNTH (UNCHAR (COERCE (SUBSEQ ARGS INDX (1+ INDX)) 'CHARACTER)))  (INCF INDX)  (SETQ ARG3 (SUBSEQ ARGS INDX (+ INDX LNTH)))  (INCF INDX LNTH))))    (COND      ((EQUAL COMD "D")       (GENERIC-DIRECTORY ARG1))      ((EQUAL COMD "E")       (GENERIC-DELETE ARG1))      ((EQUAL COMD "F")       (SETQ K*CANCEL "Z"))      ((EQUAL COMD "K")       (GENERIC-COPY ARG1 ARG2))      ((EQUAL COMD "Q")       (GENERIC-STATUS))      ((EQUAL COMD "R")       (GENERIC-RENAME ARG1 ARG2))      ((EQUAL COMD "T")       (SETQ K*FILNAM ARG1))      ((EQUAL COMD "U")       (GENERIC-DISK-USAGE ARG1))      ((EQUAL COMD "W")       (GENERIC-WHO))      (T       (FORMAT NIL "~A: Unimplemented server GENERIC command <~A>" *KERMIT-NAME* COMD)))))(DEFUN GENERIC-COPY (FILE1 FILE2)  "Copies FILE1 to FILE2.  If an error is encountered, returns an error string."  (LET    ((F1 NIL)     (F2 NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(PROGN (SETQ F1 (MERGE-PATHNAMES FILE1 (USER-HOMEDIR-PATHNAME))) (SETQ F2 (MERGE-PATHNAMES FILE2 (USER-HOMEDIR-PATHNAME))) (COPY-FILE F1 F2 :CREATE-DIRECTORIES T))      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC COPY command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (FORMAT NIL "FIle ~A copied to ~A." F1 F2))))))(DEFUN GENERIC-RENAME (FILE1 FILE2)  "Renames FILE1 to FILE2.  If an error is encountered, returns an error string."  (LET    ((F1 NIL)     (F2 NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(PROGN (SETQ F1 (MERGE-PATHNAMES FILE1 (USER-HOMEDIR-PATHNAME))) (SETQ F2 (MERGE-PATHNAMES FILE2 (USER-HOMEDIR-PATHNAME))) (RENAME-FILE F1 F2))      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC RENAME command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (FORMAT NIL "FIle ~A renamed to ~A." F1 F2))))))(DEFUN GENERIC-DELETE (FILE1)  "Deletes FILE1.  If an error is encountered, returns an error string."  (LET    ((F1 NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(PROGN (SETQ F1 (MERGE-PATHNAMES FILE1 (USER-HOMEDIR-PATHNAME))) (DELETE-FILE F1))      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC DELETE command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (FORMAT NIL "FIle ~A deleted." F1))))))(DEFUN GENERIC-DIRECTORY (&OPTIONAL DIRECTORY-NAME)  "Returns a string containing the contents of current directory or directory-name.If an error is encountered, returns an error string."  (LET    ((DIR NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(SETQ DIR      (FS:DIRECTORY-LIST(MERGE-PATHNAMES  (IF DIRECTORY-NAME      DIRECTORY-NAME      (USER-HOMEDIR-PATHNAME))  "*.*#*")))      (ERROR; If unable to get the directory-list       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC DIRECTORY command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE     (FORMAT NIL "Directory listing for ~A~%~A~%~:{~A~35T~@8A (~A)~51T~A~73T~A~%~}"     (SEND (GET (CAR DIR) :PATHNAME) :STRING-FOR-PRINTING)     (GET (CAR DIR) :DISK-SPACE-DESCRIPTION)     (MAPCAR       (FUNCTION (LAMBDA (flist)   (LIST     (SEND (CAR flist) :STRING-FOR-DIRED)     (GET flist :LENGTH-IN-BYTES)     (GET flist :BYTE-SIZE)     (MULTIPLE-VALUE-BIND (SS MM HH DY MN YEAR) (DECODE-UNIVERSAL-TIME   (GET flist :CREATION-DATE))       (FORMAT NIL "~A/~A/~A~11T~A:~A:~A"       MN DY YEAR HH MM SS))     (GET flist :AUTHOR))))       (CDR DIR))))))))(DEFUN GENERIC-DISK-USAGE (&OPTIONAL DIRECTORY-NAME)  "Returns a string containing the disk-usage of current directory or directory-name.If an error is encountered, returns an error string."  (LET    ((DIR NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(SETQ DIR      (FS:DIRECTORY-LIST(MERGE-PATHNAMES  (IF DIRECTORY-NAME      DIRECTORY-NAME      (USER-HOMEDIR-PATHNAME))  "*.*#*")))      (ERROR; If unable to get the directory-list       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC DISK-USAGE command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (GET (CAR DIR) :DISK-SPACE-DESCRIPTION))))))(DEFUN GENERIC-STATUS ()  "Returns a string containing the status of the current Kermit environment."  (FORMAT NIL "Status of the current ~A environment:~%Image Mode:~26T~A~%Debug Mode:~26T~A~%More Processing:~26T~A~%Maximum Tries:~26T~A~%Maximum packet size:~26T~A~%Timeout seconds:~26T~A~%Number of pad characters:~26T~A~%Padding character:~26T~A~%EOL character:~26T~A~%Quote character:~26T~A~%Filename conversion:~26T~A~%Save partial files:~26T~A" *KERMIT-NAME* *IMAGE* *DEBUG* *MORE* *MYMAXTRY* *MYMAXPACSIZ* *MYTIME* *MYPAD* *MYPADCHAR* *MYEOL* *MYQUOTE* *FILNAMCNV* *SAVEFILES*))(DEFUN GENERIC-WHO ()  "Returns a string describing who's logged on each machine on the network."  (LET    ((STREAM (MAKE-STRING-OUTPUT-STREAM)))      ; make an output stream for FINGER-LISPMS to write to    (CHAOS:FINGER-LISPMS STREAM)    (GET-OUTPUT-STREAM-STRING STREAM)))     (DEFUN CHANGE-KERMIT-PARAMETERS ()  "Change local operating parameters"  (LET ((IMAGE *IMAGE*) (DEBUG *DEBUG*) (MORE *MORE*) (MYMAXTRY *MYMAXTRY*)(MYMAXPACSIZ *MYMAXPACSIZ*) (MYTIME *MYTIME*) (MYPAD *MYPAD*)(MYPADCHAR *MYPADCHAR*) (MYEOL *MYEOL*) (MYQUOTE *MYQUOTE*)(FILNAMCNV *FILNAMCNV*) (SAVEFILES *SAVEFILES*) (RESET NIL))        (DECLARE (SPECIAL IMAGE DEBUG MORE MYMAXTRY MYMAXPACSIZ MYTIME      MYPAD MYPADCHAR MYEOL MYQUOTE FILNAMCNV SAVEFILES RESET))        (CATCH 'QUIT-CVV      (TV:CHOOSE-VARIABLE-VALUES'((IMAGE "Image Mode      " :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)." :CHOOSE (NIL 8 16))  (DEBUG "Debug Mode      " :DOCUMENTATION "YES: Print debugging information.  NO: Do not print debugging information." :BOOLEAN)  (MORE  "More Processing " :DOCUMENTATION "YES: Enable **MORE** in the KERMIT window.  NO: Do not use **MORE**." :BOOLEAN)  ""  (MYMAXTRY    "Maximum tries            "       :DOCUMENTATION "Maximum number of times to retry a packet"       :NUMBER)  (MYMAXPACSIZ "Maximum packet size      "       :DOCUMENTATION "Maximum packet size - must not be greater than 94"       :NUMBER)  (MYTIME      "Timeout seconds          "       :DOCUMENTATION "Number of seconds after which I should be timed out"       :NUMBER)  (MYPAD       "Number of pad characters "       :DOCUMENTATION "Number of padding characters to use"       :NUMBER)  (MYPADCHAR   "Padding character        "       :DOCUMENTATION "Padding character to use - enter the character number"       :NUMBER)  (MYEOL       "EOL character            "       :DOCUMENTATION "End-Of-Line character to use - enter the character number"       :NUMBER)  (MYQUOTE     "Quote character          "       :DOCUMENTATION "Quote character to use - enter the character number"       :NUMBER)  ""  (FILNAMCNV "Filename conversion "     :DOCUMENTATION "YES: Convert filenames to name.type format.  NO: Do not convert filenames."     :BOOLEAN)  (SAVEFILES "Save partial files  "     :DOCUMENTATION "YES: Save partially received file if transfer is interrupted.  NO: Delete the file."     :BOOLEAN)  ""  (RESET "Reset parameters " :DOCUMENTATION "YES: Immediately reset parameters to default values.  NO: Use current parameter values." :BOOLEAN)):NEAR-MODE '(:POINT 500 400):WIDTH 50:LABEL "Change Parameters":MARGIN-CHOICES '(("Abort" (THROW 'QUIT-CVV T)) "Do It"))      (SETQ *IMAGE* IMAGE)      (SETQ *DEBUG* DEBUG)      (SETQ *MORE* MORE)      (SETQ *MYMAXTRY* MYMAXTRY)      (SETQ *MYMAXPACSIZ* MYMAXPACSIZ)      (SETQ *MYTIME* MYTIME)      (SETQ *MYPAD* MYPAD)      (SETQ *MYPADCHAR* MYPADCHAR)      (SETQ *MYEOL* MYEOL)      (SETQ *MYQUOTE* MYQUOTE)      (SETQ *FILNAMCNV* FILNAMCNV)      (SETQ *SAVEFILES* SAVEFILES))    (WHEN RESET; If these values are changed, change in DEFVAR as well      (SETQ *IMAGE* NIL)      (SETQ *DEBUG* NIL)      (SETQ *MORE* NIL)      (SETQ *MYMAXTRY* 10)      (SETQ *MYMAXPACSIZ* 94)      (SETQ *MYTIME* 10)      (SETQ *MYPAD* 0)      (SETQ *MYPADCHAR* 0)      (SETQ *MYEOL* *ASCII-CR*)      (SETQ *MYQUOTE* *ASCII-NS*)      (SETQ *FILNAMCNV* T)      (SETQ *SAVEFILES* NIL))     (SEND *INFO-WINDOW* :SET-MORE-P *MORE*))); Set in window;;; Kermit printing routines:(DEFUN PRINTMSG (MSG-CTL-STRING &OPTIONAL &REST ARGS)  "Print message on standard output if in verbose mode."  (DECLARE (SPECIAL K*VERBOSEP K*ERROR-MESSAGE))  (WHEN K*VERBOSEP; When verbose,    (APPLY 'FORMAT *INFO-WINDOW* MSG-CTL-STRING ARGS)); print to the window.  (WHEN *LOGFILE*; If a logfile has been specified,    (APPLY 'FORMAT *LOGFILE* MSG-CTL-STRING ARGS))); write to the file.(DEFUN INCREMENT-PACKET-NUMBER ()  "Increments packet number by +1 but resets after 63.  Also zeros K*NUMTRY."  (DECLARE (SPECIAL K*PCKT-NUM K*NUMTRY))  (SETQ K*PCKT-NUM (IF (< K*PCKT-NUM 63) (1+ K*PCKT-NUM) 0))  (SETQ K*NUMTRY 0))(DEFUN INCREMENT-RETRIES ()  "Increments the number of retries."  (DECLARE (SPECIAL K*NUMTRY K*PACKETS-RETRIED))  (INCF K*NUMTRY); Increment the retries  (INCF K*PACKETS-RETRIED)); Increment the total retries(DEFUN INITIALIZE-STATUS-COUNTS ()  "Initialize the status counting for packet numbers and transfer times."  (DECLARE (SPECIAL K*PACKETS-TRANSFERRED K*PACKETS-RETRIED    K*BYTES-TRANSFERRED K*FILE-CHARS K*START-TIME))  (SETQ K*PACKETS-TRANSFERRED 0); Initialize total packet count  (SETQ K*PACKETS-RETRIED 0); Initialize total retry count  (SETQ K*BYTES-TRANSFERRED 0); Reset the bytes transferred counter  (SETQ K*FILE-CHARS 0)                         ; Reset the total file chars  (SETQ K*START-TIME (TIME))); Save the current internal time in 60ths of a second(DEFUN COUNT-AND-PRINT-PACKETS (PACKET-LENGTH); called in RDATA and SDATA   "Increment total packet count and print totals."  (DECLARE (SPECIAL K*PACKETS-TRANSFERRED K*BYTES-TRANSFERRED K*VERBOSEP))  (INCF K*PACKETS-TRANSFERRED)  (INCF K*BYTES-TRANSFERRED PACKET-LENGTH)  (WHEN K*VERBOSEP    (PRINT-STATUS-PACKET-INFO)))(DEFUN INITIALIZE-STATUS-WINDOW ()  (DECLARE (SPECIAL K*OPERATION))  (SEND *STATUS-WINDOW* :CLEAR-WINDOW)  (FORMAT *STATUS-WINDOW* "~%~10,1TOperation ~25,1T: ~A~60,1TRate (packet/file) ~80,1T:~%~10,1TFile Name ~25,1T:~60,1TNumber of Packets ~80,1T:~%~10,1TTransfer name ~25,1T:~60,1TNumber of Retries ~80,1T:" K*OPERATION)  (TV:TURN-OFF-SHEET-BLINKERS *STATUS-WINDOW*))(DEFUN PRINT-STATUS-PACKET-INFO ()  (DECLARE (SPECIAL K*OPERATION K*FILNAM K*RECFILNAM K*PACKETS-TRANSFERRED    K*BYTES-TRANSFERRED K*FILE-CHARS K*START-TIME K*PACKETS-RETRIED))  (LET    ((TIME-DIFF (MAX 1 (FLOOR (TIME-DIFFERENCE (TIME) K*START-TIME) 60))))      (SEND *STATUS-WINDOW* :SET-CURSORPOS 82 1 :CHARACTER)    (SEND *STATUS-WINDOW* :CLEAR-STRING "            ")    (FORMAT *STATUS-WINDOW* "~5A/~@5A"    (FLOOR K*BYTES-TRANSFERRED TIME-DIFF)    (FLOOR K*FILE-CHARS TIME-DIFF))    (SEND *STATUS-WINDOW* :SET-CURSORPOS 82 2 :CHARACTER)    (SEND *STATUS-WINDOW* :CLEAR-STRING "       ")    (FORMAT *STATUS-WINDOW* "~A" K*PACKETS-TRANSFERRED)    (SEND *STATUS-WINDOW* :SET-CURSORPOS 82 3 :CHARACTER)    (SEND *STATUS-WINDOW* :CLEAR-STRING "       ")    (FORMAT *STATUS-WINDOW* "~A" K*PACKETS-RETRIED)))    (DEFUN PRINT-STATUS-FILE-INFO ()  (DECLARE (SPECIAL K*VERBOSEP K*FILNAM K*RECFILNAM))  (WHEN K*VERBOSEP    (SEND *STATUS-WINDOW* :SET-CURSORPOS 27 2 :CHARACTER)    (SEND *STATUS-WINDOW* :CLEAR-STRING "                               ")    (FORMAT *STATUS-WINDOW* "~A" (IF K*FILNAM K*FILNAM ""))    (SEND *STATUS-WINDOW* :SET-CURSORPOS 27 3 :CHARACTER)    (SEND *STATUS-WINDOW* :CLEAR-STRING "                               ")    (FORMAT *STATUS-WINDOW* "~A" (IF K*RECFILNAM K*RECFILNAM ""))))(DEFUN CREATE-KERMIT-FILENAME (FILENAME)  "Create a filename sutable for sending to another machine. Return file.type"  (IF *FILNAMCNV*      (LET* ((PATHNAME (FS:PARSE-PATHNAME FILENAME))     (NAME (SEND PATHNAME :NAME))     (TYPE (SEND PATHNAME :TYPE)))(IF (EQL NAME ':WILD)    (SETQ NAME "*")    (IF (EQL NAME ':UNSPECIFIC)(SETQ NAME "")(UNLESS (STRINGP NAME)  (SETQ NAME ""))))(IF (EQL TYPE ':WILD)    (SETQ TYPE "*")    (IF (EQL TYPE ':UNSPECIFIC)(SETQ TYPE "")(UNLESS (STRINGP TYPE)  (SETQ TYPE ""))))(FORMAT NIL "~A.~A" NAME TYPE))      FILENAME))(DEFUN ENCODE-PREFIXED-DATA (DATA BUFFER)  "Encode string of data by passing it through BUFILL.   Inputs are a string of data and a buffer to fill.   Returned value is the size of the buffer."  (DECLARE (SPECIAL K*BUFILLBUF K*BUFILLPTR))  (LET    ((SIZE 0))    (WHEN                                       ; As long as noone is using BUFILL already...      (AND (ZEROP (FILL-POINTER K*BUFILLBUF))   (ZEROP K*BUFILLPTR))      (SETQ SIZE    (BUFILL BUFFER (MAKE-STRING-INPUT-STREAM DATA))); Use BUFILL to encode the data      (SETQ K*BUFILLPTR 0); Reset the BUFILL pointer      (SETF (FILL-POINTER K*BUFILLBUF) 0); Clear the BUFILL buffer      SIZE))); Return the SIZE of the buffer(DEFUN DECODE-PREFIXED-DATA (PACKET LEN)  "Decode a packet of data by passing it through BUFEMP.   Inputs are a packet and length.  Returned value is the   decoded string."  (LET    ((FILE (MAKE-STRING-OUTPUT-STREAM)))             ; Make a temporary output stream for BUFEMP    (BUFEMP PACKET LEN FILE)                         ; Use BUFEMP to decode the data    (GET-OUTPUT-STREAM-STRING FILE)))                ; Get the decoded data(DEFUN EXPAND-WILDS (FILE-NAME)  "Expand wildcards in a filename.  Returns a list   of expanded filenames."  (LET    ((DIR NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(LET ((MERGED-FILE-NAME (MERGE-PATHNAMES  FILE-NAME  (MERGE-PATHNAMES    (USER-HOMEDIR-PATHNAME)    "FOO.BAR#>"))))  (UNLESS (SETQ DIR (FS:DIRECTORY MERGED-FILE-NAME))    (SETQ DIR (LIST MERGED-FILE-NAME))))      (ERROR; If unable to get the directory due to error       (SETQ RESPONSE; such as invalid host, pass on the file-name     (LIST FILE-NAME))); so it will error again at open time!      (:NO-ERROR       (SETQ RESPONSE     (MAPCAR 'NAMESTRING DIR))))    RESPONSE)); Return RESPONSE(DEFUN DEFAULT-ONLY-WILD-PATHNAME-COMPONENTS (PATH1 PATH2)  "Fill in only the wild parts of PATH1 with the corresponding parts of PATH2."  (FS:FAST-NEW-PATHNAME PATH1(WHEN (EQUAL (PATHNAME-DEVICE PATH1) :WILD) (PATHNAME-DEVICE PATH2))(WHEN (EQUAL (PATHNAME-DIRECTORY PATH1) :WILD) (PATHNAME-DIRECTORY PATH2))(WHEN (EQUAL (PATHNAME-NAME PATH1) :WILD) (PATHNAME-NAME PATH2))(WHEN (EQUAL (PATHNAME-TYPE PATH1) :WILD) (PATHNAME-TYPE PATH2))(WHEN (EQUAL (PATHNAME-VERSION PATH1) :WILD) (PATHNAME-VERSION PATH2))))mes ^A). #b1000000 is #o100."  (LOGXOR ch #b1000000))(DEFSUBST COMPUTE-FINAL-CHECKSUM (NUM)  "Compute final checksum by folding in bits 7 and 8.  #b11000000 is #o300, #b111111 is #o077."  (LOGAND (+ (LSH (LOGAND NUM #b11000000) -6) NUM) #b111111))(DEFSUBST CONVERT-FROM-ASCII (ch)  "Function to convert some characters from ASCII to Lisp."  (COND     ((OR       (AND (> ch *ASCII-CR*) (< ch  *ASCII-DEL*))       (AND (> ch *ASCII-DEL*) (< ch 256)))       ch)    ((= ch *ASCII-CR*)   *LISPM-NEWLINE*)    ((= ch *ASCII-TAB*)  *LISPM-TAB*)    ((= ch *ASCII-LF*)   *LISPM-LF*)     ((= ch *ASCII-FF*)   *LISPM-PAGE*)    ((= ch *ASCII-DEL*)  *LISPM-RUBOUT*)    ((= ch *ASCII-BS*)   *LISPM-BS*)    (T (IF (OR (< ch 0) (> ch 255))   NIL ch))))(DEFSUBST CONVERT-TO-ASCII (ch)  "Function to convert characters from Lisp to ASCII.  Converts any appropriatecontrol characters but maps the unimportant control chars to NIL."  (COND     ((<= ch *ASCII-DEL*)        ch)    ((= ch *LISPM-BS*)          *ASCII-BS*)    ((= ch *LISPM-TAB*)         *ASCII-TAB*)    ((= ch *LISPM-LF*)          *ASCII-LF*)      ((= ch *LISPM-PAGE*)        *ASCII-FF*)    ((= ch *LISPM-NEWLINE*)     *ASCII-CR*)    ((= ch *LISPM-RUBOUT*)      *ASCII-DEL*)    (T                          NIL)))(DEFUN INTERACTIVE-KERMIT (&OPTIONAL STREAM (EXECUTE T))  "Produce a selection menu.  If EXECUTE is non-nil, call KERMIT;otherwise, return a form that can be EVALed to call KERMIT."  (LET*    ((SELECTION        (tv:MENU-CHOOSE '(   ("Get File(s)     "    :VALUE (:GET "Get File(s)" ((*RARG1* "Remote File Name   "   :DOCUMENTATION "File(s) to transfer from the remote Kermit server." :STRING)  (*RARG2* "New Local File Name"   :DOCUMENTATION "Name to give to the transferred file(s)." :STRING)  (*IMAGE* "Image Mode         "   :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)."   :CHOOSE (NIL 8 16))))    :DOCUMENTATION "Transfer file(s) from a remote Kermit in server mode.")   ("Receive File(s) "    :VALUE (:RECEIVE "Receive File(s)"     ((*RARG1* "New Local File Name"       :DOCUMENTATION "Local name to give to the received file(s)." :STRING)      (*IMAGE* "Image Mode         "       :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)."       :CHOOSE (NIL 8 16))))    :DOCUMENTATION "Wait for the arrival of file(s) transferred by a remote Kermit executing a Send command.")   ("Send File(s)    "    :VALUE (:SEND "Send File(s)"  ((*SARG1* "Local File Name     "    :DOCUMENTATION "Local file(s) to transfer to the remote Kermit." :STRING)   (*SARG2* "New Remote File Name"    :DOCUMENTATION "Name to give to the transferred file(s) on the remote host." :STRING)   (*IMAGE* "Image Mode          "    :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)."    :CHOOSE (NIL 8 16))))    :DOCUMENTATION "Transfer file(s) to a remote Kermit in Server mode or executing a Receive command.")   (""    :NO-SELECT nil)   ("Bye             "    :VALUE (:BYE)    :DOCUMENTATION "Shut down and logout a remote Kermit server.")   ("Finish          "    :VALUE (:FINISH)    :DOCUMENTATION "Shut down a remote Kermit server without logging out the remote job.")   (""    :NO-SELECT nil)   ("Set Parameters  "    :VALUE (:SET)    :DOCUMENTATION "Modify local Kermit operating parameters.")   (""    :NO-SELECT nil)   ("Begin Logging   "    :VALUE (:LOG-BEGIN "Begin Logging to File" ((*CARG1* "Log File Pathname"   :DOCUMENTATION "Pathname used to write logging information." :STRING)))    :DOCUMENTATION "Begin logging local Kermit actions to a file.")   ("End Logging     "    :VALUE (:LOG-END)    :DOCUMENTATION "End logging local Kermit actions to a file.")   (""    :NO-SELECT nil)   ("Server Mode     "    :VALUE (:SERVER)    :DOCUMENTATION "Place local Kermit in server mode.")   (""    :NO-SELECT nil)   ("Remote Copy     "    :VALUE (:REMOTE-COPY "Remote Copy" ((*CARG1* "File Name     "   :DOCUMENTATION "File to copy on the remote KERMIT server." :STRING)  (*CARG2* "File Copy Name"   :DOCUMENTATION "Name to give to the copy file." :STRING)))    :DOCUMENTATION "Copy the specified file to another location on a remote KERMIT server.")   ("Remote CWD      "    :VALUE (:REMOTE-CWD "Remote Change Working Directory"((*CARG1* "New Remote Directory"  :DOCUMENTATION "New working directory pathname for the remote Kermit server."  :STRING)))    :DOCUMENTATION "Change the working directory of a remote Kermit server.")   ("Remote Delete   "    :VALUE (:REMOTE-DELETE "Remote Delete File"   ((*CARG1* "Remote File Name"     :DOCUMENTATION "Name of file to delete on remote Kermit server." :STRING)))    :DOCUMENTATION "Delete a file on a remote Kermit server.")   ("Remote Directory"    :VALUE (:REMOTE-DIRECTORY "Remote Directory"      ((*CARG1* "Remote Directory":DOCUMENTATION "Directory pathname for remote Kermit server." :STRING)))    :DOCUMENTATION "Display names of files in directory on remote Kermit server.")   ("Remote Help     "    :VALUE (:REMOTE-HELP "Remote Help" ((*CARG1* "Help Topic"   :DOCUMENTATION "Optional topic on which to obtain help." :STRING)))    :DOCUMENTATION "Display a list of remote KERMIT server help commands.")   ("Remote Host     "    :VALUE (:REMOTE-HOST "Remote Host" ((*CARG1* "Host Command"   :DOCUMENTATION "Command to pass to the remote host." :STRING)))    :DOCUMENTATION "Pass the given command to the remote KERMIT server host for processing.The command must be in the remote KERMIT server host's own command level syntax.")   ("Remote Kermit   "    :VALUE (:REMOTE-KERMIT "Remote Kermit"   ((*CARG1* "Kermit Command"     :DOCUMENTATION "Command to pass to the remote KERMIT server." :STRING)))    :DOCUMENTATION "Pass the given command to the remote KERMIT server for execution.The command must be in the remote KERMIT server's own interactive mode syntax.")   ("Remote Rename   "    :VALUE (:REMOTE-RENAME "Remote Rename File"   ((*CARG1* "File Name    "     :DOCUMENTATION "File to rename on the remote KERMIT server." :STRING)    (*CARG2* "New File Name"     :DOCUMENTATION "New name to give to the file." :STRING)))    :DOCUMENTATION "Rename the specified file on a remote KERMIT server.")   ("Remote Set      "    :VALUE (:REMOTE-SET "Remote Set Parameter" ((*CARG1* "Parameter"  :DOCUMENTATION "Name of parameter to set on remote KERMIT server." :STRING) (*CARG2* "Value    "  :DOCUMENTATION "New value to give to the parameter." :STRING)))    :DOCUMENTATION "Set a parameter to a given value on a remote KERMIT server.")   ("Remote Show     "    :VALUE (:REMOTE-SHOW "Remote Show Parameter"  ((*CARG1* "Parameter"    :DOCUMENTATION "Name of parameter to query on remote KERMIT server." :STRING)))    :DOCUMENTATION "Obtain the value of a parameter on a remote KERMIT server.")   ("Remote Space    "    :VALUE (:REMOTE-SPACE "Remote Disk Space"  ((*CARG1* "Remote Directory"    :DOCUMENTATION "Remote directory pathname." :STRING)))    :DOCUMENTATION "Display information about disk usage for a directory on remote Kermit server.")   ("Remote Type     "    :VALUE (:REMOTE-TYPE "Remote File Type" ((*CARG1* "File Name"   :DOCUMENTATION "Name of file to list." :STRING)))    :DOCUMENTATION "Display the specified filename from a remote KERMIT server.")) "KERMIT OPERATIONS" '(:POINT 500 400)))     (OPERATION (FIRST SELECTION))     (LABEL (SECOND SELECTION))     (CVV-LIST (THIRD SELECTION)))        (WHEN CVV-LIST; If a cvv is required, display it      (WHEN(CATCH 'END-CVV; Setup catch - if true, we used it  (TV:CHOOSE-VARIABLE-VALUES    CVV-LIST    :NEAR-MODE '(:POINT 500 400)    :WIDTH 60    :LABEL LABEL    :MARGIN-CHOICES '(("Abort" (THROW 'END-CVV T)) "Do It"))  NIL); Return nil from entire block(SETQ OPERATION NIL))); If we returned with T, the throw was used.        (WHEN OPERATION      (LET((FORM `(KERMIT ,OPERATION  :ARG1 ,(EVAL (FIRST (FIRST CVV-LIST))):ARG2 ,(EVAL (FIRST (SECOND CVV-LIST))):STREAM ,STREAM:VERBOSEP T)))(IF EXECUTE    (EVAL FORM)    FORM)))))  (DEFUN KERMIT (OPERATION &KEY ARG1 ARG2 STREAM VERBOSEP)  "Transfers files using the KERMIT protocol.OPERATION - :GET               Transfer file(s) from a remote Kermit in server mode            :RECEIVE           Wait for the arrival of file(s) transferred by a remote Kermit executing a Send command            :SEND              Transfer file(s) to a remote KERMIT in server mode or executing a Receive command            :BYE               Shut down and logout a remote KERMIT server            :FINISH            Shut down a remote KERMIT server without logging out the remote job            :SET               Modify the local KERMIT operating parameters            :LOG-BEGIN         Begin logging local KERMIT actions to a file            :LOG-END           End logging local KERMIT actions to a file             :SERVER            Place local KERMIT in server mode            :REMOTE-COPY       Copy the specified file to another location on a remote KERMIT server            :REMOTE-CWD        Change the working directory of a remote KERMIT server            :REMOTE-DELETE     Delete a file on a remote KERMIT server            :REMOTE-DIRECTORY  Display names of files in a directory on remote KERMIT server            :REMOTE-HELP       Display a list of remote KERMIT server help commands            :REMOTE-HOST       Pass the given command to the remote KERMIT server host for processing                               (the command must be in the remote KERMIT host's own command level syntax)            :REMOTE-KERMIT     Pass the given command to the remote KERMIT server for execution                               (the command must be in the remote KERMIT's own interactive mode syntax)            :REMOTE-RENAME     Rename the specified file on a remote KERMIT server            :REMOTE-SET        Set a parameter to a given value on a remote KERMIT server            :REMOTE-SHOW       Obtain the value of a parameter on a remote KERMIT serve            :REMOTE-SPACE      Display information about disk usage for a directory on remote KERMIT server            :REMOTE-TYPE       Display the specified filename from a remote KERMIT server:ARG1     -  Filename, directory, command or parameter:ARG2     -  New filename, destination name or parameter:STREAM   -  Serial stream to use:VERBOSEP -  T means verbose output."    ;;; All Kermit variables that are passed between functions (but not global via DEFVAR)  ;;; are defined here and prefixed with K*    (LET ((K*OPERATION OPERATION); Action to be taken(K*TTYFD STREAM); Serial stream for I/O(K*TTYFD-BITS NIL); Number of data bits in serial stream(K*VERBOSEP VERBOSEP); T means print things on the screen(K*STATE NIL); Represents the present state of RECSW or SENDSW(K*PCKT-NUM 0); Packet number(K*NUMTRY 0); Times this packet retried(K*SIZE 0); Size of data in the buffer(K*FILE-CHARS 0)                        ; Total number of file chars read or written(K*YOURMAXPACSIZ *MYMAXPACSIZ*); Maximum send packet size - default to my size(K*YOURTIME (+ 5 *MYTIME*)); Timeout on sends - default to longer(K*YOURPAD 0); Padding to send - assume none(K*YOURPADCHAR 0); Padding character to send - none(K*YOUREOL *ASCII-CR*); End-Of-Line character to send(K*YOURQUOTE *ASCII-NS*); Quote character in incoming data(K*BINQUOTE *ASCII-N*); 8-bit quoting character(K*REPEAT *ASCII-TILDE*); Repeat character(K*SPACKET; Send packet buffer  (MAKE-ARRAY (* 2 *MYMAXPACSIZ*)      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*RPACKET; Receive packet buffer  (MAKE-ARRAY (* 2 *MYMAXPACSIZ*)      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*BUFFER; Local packet buffer  (MAKE-ARRAY (* 2 *MYMAXPACSIZ*)      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*ARG1LIST  (IF (LISTP ARG1); Make sure ARG1 is a list      ARG1 (LIST ARG1)))(K*ARG2LIST  (IF (LISTP ARG2); Make sure ARG2 is a list      ARG2 (LIST ARG2)))(K*FILNAM NIL); Current file name(K*RECFILNAM NIL); Default pathname into which to place the received file(K*EMPTY-PATHNAME                       ; Empty pathname used for merging  (MAKE-PATHNAME :HOST 'lm))(K*FP NIL); File pointer to currently opened disk file(K*BUFILLPTR 0); Pointer to current location in K*BUFILLBUF(K*BUFILLBUF; Temporary file buffer for BUFILL to handle file input  (MAKE-ARRAY 2048                      ; Buffer size is 2 blocks      :TYPE 'ART-STRING      :FILL-POINTER 0))(K*IGNORE-NEXT-LINEFEED NIL); Flag for ASCII conversion(K*SEND-TO-TTY NIL); Flag indicating whether to send data to TTY or file(K*FILES-TRANSFERRED NIL); List of files successfully sent or received(K*CANCEL NIL); Used to poll the keyboard to see if we should cancel xfer(K*ABORT-REASON NIL); Contains string with error(K*PACKETS-TRANSFERRED 0); Total number of packets transferred(K*PACKETS-RETRIED 0); Total number of packets retried(K*BYTES-TRANSFERRED 0); Total number of bytes transferred(K*START-TIME 0)); Time at which transfer began        (DECLARE (SPECIAL K*OPERATION K*TTYFD K*VERBOSEP K*STATE K*PCKT-NUM K*NUMTRY K*SIZE K*FILE-CHARS K*START-TIME      K*YOURMAXPACSIZ K*YOURTIME K*YOURPAD K*YOURPADCHAR K*YOUREOL K*YOURQUOTE K*EMPTY-PATHNAME      K*BINQUOTE K*REPEAT K*SPACKET K*RPACKET K*BUFFER K*ARG1LIST K*ARG2LIST K*FILNAM K*RECFILNAM      K*FP K*BUFILLBUF K*BUFILLPTR K*IGNORE-NEXT-LINEFEED K*SEND-TO-TTY K*BYTES-TRANSFERRED      K*FILES-TRANSFERRED K*CANCEL K*ABORT-REASON K*PACKETS-TRANSFERRED K*PACKETS-RETRIED))    ;  (CONDITION-CASE (K-ERROR)                           ; Setup error trap    (PROGN; First form is the body...            (WHEN K*VERBOSEP        ; Setup the KERMIT output window(INITIALIZE-STATUS-WINDOW); Initialize the status window(SEND *INFO-WINDOW* :CLEAR-WINDOW); Clear the Interactive window(SEND *KERMIT-FRAME* :SELECT)); Select and expose the entire frame            (WHEN (EQ OPERATION :SET)        ; If the SET operation was specified, (SETQ K*VERBOSEP NIL)); force quiet mode!      (WHEN (NOT K*TTYFD); If no stream was supplied, make one.(SETQ K*TTYFD (SI:MAKE-SERIAL-STREAM))) ; Could use SI:*SERIAL-PORT-OWNER* ;; BAC       (SEND K*TTYFD :CLEAR-INPUT)      (SEND K*TTYFD :CLEAR-OUTPUT)      (SETQ K*TTYFD-BITS; Determine the number of data bits in the stream    (SEND K*TTYFD :GET :NUMBER-OF-DATA-BITS))      (SETQ K*BINQUOTE; Set the initial value for the 8-bit quote char    (IF *IMAGE*; Image mode?(IF (= K*TTYFD-BITS 8)          ; - Yes, 8-bit?    *ASCII-Y*                   ; -- Yes, set to Y    *ASCII-AMP*)        ; -- No,  set to &*ASCII-N*)); - No, set to N            (WHEN ARG1; If a filename was specified,(GET-NEXT-FILE)); Set K*FILNAM to the first in the list            (UNWIND-PROTECT; Surround entire selection in unwind-protect  (CASE OPERATION    (:SEND        ; Send command     (IF K*FILNAM; Required filename specified? (LET                           ; - Yes   ((HOST-SPECIFIED? (FIND ":" K*RECFILNAM :TEST 'STRING-EQUAL))    (PATH-RECFILNAM (FS:PARSE-PATHNAME K*RECFILNAM NIL K*EMPTY-PATHNAME)))   (SETQ K*ARG1LIST (EXPAND-WILDS K*FILNAM)); Expand any wildcards in the filename   (SETQ K*ARG2LIST; expand the transfer name list (MAPCAR                ; Map over each of the send files    (FUNCTION            ; replacing any wildcard components     (LAMBDA (x)       (LET  ((EXPANDED-PATH (DEFAULT-ONLY-WILD-PATHNAME-COMPONENTS PATH-RECFILNAM x))) (IF HOST-SPECIFIED?     EXPANDED-PATH     (SEND EXPANDED-PATH :STRING-FOR-HOST)))))   K*ARG1LIST))   (GET-NEXT-FILE); Get the file to process   (SW *SINIT-STATE*)); - Yes, start with SINIT as initial state (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:GET     (IF K*FILNAM; Required filename specified? (PROGN; - Yes   (SETQ K*FILNAM (CREATE-KERMIT-FILENAME K*FILNAM)); Make a suitable packet filename   (SW *SGENERIC-STATE* #\R K*FILNAM)); SGENERIC is the initial state (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:RECEIVE     (SW *RINIT-STATE*)); Start with RINIT as initial state    (:BYE     (SW *SGENERIC-STATE* #\G "L")); SGENERIC is initial state    (:FINISH     (SW *SGENERIC-STATE* #\G "F")); SGENERIC is initial state    (:SET     (CHANGE-KERMIT-PARAMETERS))    (:LOG-BEGIN     (IF K*FILNAM; Required filename specified? (CONDITION-CASE (ERR); - Yes, try to open the logfile     (PROGN      (SETQ K*FILNAM; Merge the filename with the home directory    (SEND      (FS:MERGE-PATHNAME-DEFAULTSK*FILNAM(USER-HOMEDIR-PATHNAME))      :STRING-FOR-PRINTING))      (SETQ *LOGFILE*; Try to open the file     (OPEN K*FILNAM  :DIRECTION :OUTPUT  :IF-EXISTS ':NEW-VERSION  :IF-DOES-NOT-EXIST ':CREATE)))   (ERROR; If unable to merge the filename or open the file    (PRINTMSG "~%~A"      (SETQ K*ABORT-REASON    (FORMAT NIL "~A: Error <~A> opening log file ~A"    *KERMIT-NAME* (SEND ERR :REPORT-STRING) K*FILNAM))))   (:NO-ERROR    (MULTIPLE-VALUE-BIND (SS MM HH DY MN YR) (GET-DECODED-TIME)      (PRINTMSG "~%Begin logging at ~A:~A:~A  ~A/~A/~A  to file ~A"HH MM SS MN DY YR K*FILNAM)))) (PRINTMSG "~%~A"; - No, filename not specified   (SETQ K*ABORT-REASON "No log file name specified"))))    (:LOG-END     (IF *LOGFILE*      ; Is there an open logfile? (PROGN; - Yes   (MULTIPLE-VALUE-BIND (SS MM HH DY MN YR) (GET-DECODED-TIME)     (PRINTMSG "~%End logging to file ~A at ~A:~A:~A  ~A/~A/~A~%"       (SEND (SEND *LOGFILE* :TRUENAME) :STRING-FOR-PRINTING) HH MM SS MN DY YR))   (SEND *LOGFILE* :CLOSE); Close the file   (SETQ *LOGFILE* NIL)) (PRINTMSG "~%~A"; - No   (SETQ K*ABORT-REASON (FORMAT NIL "~A: No log file was opened" *KERMIT-NAME*)))))    (:SERVER     (SW *RSERVER-STATE*)); RSERVER is initial state    (:REMOTE-COPY     (IF (AND K*FILNAM K*RECFILNAM); Required filenames specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "K~C~A~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM     (TOCHAR (LENGTH K*RECFILNAM)) K*RECFILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Both files must be specified"))))    (:REMOTE-CWD     (SW *SGENERIC-STATE*; SGENERIC is initial state #\G; Start with G packet (FORMAT NIL "C~C~A"; Setup data packet                 (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)))    (:REMOTE-DELETE     (IF K*FILNAM; Required filename specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "E~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:REMOTE-DIRECTORY     (IF K*FILNAM; Required filename specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "D~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:REMOTE-HELP     (SW *SGENERIC-STATE*; SGENERIC is initial state #\G; Start with G packet (FORMAT NIL "H~C~A"; Setup data packet                 (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)))    (:REMOTE-HOST     (IF K*FILNAM; Required command specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\C; Start with C packet     (FORMAT NIL "~A"; Setup data packet                     K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No command specified"))))    (:REMOTE-KERMIT     (IF K*FILNAM; Required command specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\K; Start with K packet     (FORMAT NIL "~A"; Setup data packet                     K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No command specified"))))    (:REMOTE-RENAME     (IF (AND K*FILNAM K*RECFILNAM); Required filenames specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "R~C~A~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM     (TOCHAR (LENGTH K*RECFILNAM)) K*RECFILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Both files must be specified"))))    (:REMOTE-SET     (IF (AND K*FILNAM K*RECFILNAM); Required parameters specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "V~CS~C~A~C~A"; Setup data packet     (TOCHAR 1)     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM     (TOCHAR (LENGTH K*RECFILNAM)) K*RECFILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Both variable and value must be specified"))))    (:REMOTE-SHOW     (IF K*FILNAM; Required parameter specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "V~CQ~C~A"; Setup data packet                     (TOCHAR 1)     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "Variable must be specified"))))    (:REMOTE-SPACE     (SW *SGENERIC-STATE*; SGENERIC is initial state #\G (FORMAT NIL "U~C~A"  (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)))    (:REMOTE-TYPE     (IF K*FILNAM; Required filename specified? (SW *SGENERIC-STATE*; - Yes, SGENERIC is initial state     #\G; Start with G packet     (FORMAT NIL "T~C~A"; Setup data packet                     (TOCHAR (LENGTH K*FILNAM)) K*FILNAM)) (PRINTMSG "~%~A"; - No, setup error   (SETQ K*ABORT-REASON "No file(s) specified"))))    (:OTHERWISE; Unknown command     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON "Invalid operation specified"))))(IF K*FP (SEND K*FP :CLOSE))); No matter what happened, close any opened file            (WHEN K*VERBOSEP        ; When not in quiet mode(PRINTMSG "~%KERMIT operation ~A ~A."  OPERATION  (IF K*ABORT-REASON "failed" "succeeded"))(WHEN K*FILES-TRANSFERRED  (PRINTMSG "~%Files transferred: ~A." K*FILES-TRANSFERRED))(PRINTMSG "~%Press any key or click on END to continue.")(SEND *INFO-WINDOW* :CLEAR-INPUT); Clear the input buffer(SEND *INFO-WINDOW* :ANY-TYI)           ; Wait for a keypress or mouse blip(SEND *KERMIT-FRAME* :BURY))        ; Bury the Interactive window            (IF K*ABORT-REASON  (VALUES NIL K*FILES-TRANSFERRED K*ABORT-REASON)  (VALUES T   K*FILES-TRANSFERRED NIL)))    ; (ERROR;  (PRINTMSG "~%~%ERROR: ~A" (SEND K-ERROR :REPORT-STRING));  (SIGNAL-CONDITION K-ERROR)))    ))(DEFUN SW (STATE &OPTIONAL SPACK-TYPE SPACK-DATA)  "This is the state table switcher for transferring files.  It loops untileither it finishes, or an error is encountered.  The routines called bythis function are responsible for returning a new state."    (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*NUMTRY K*OPERATION K*VERBOSEP K*CANCEL    K*FP K*ABORT-REASON))    (SETQ K*STATE STATE); Initialize the start state  (SETQ K*CANCEL NIL)  (SETQ K*PCKT-NUM 0); Initialize the packet number  (SETQ K*NUMTRY 0); Say no tries yet    (LOOP    UNTIL (NOT K*STATE)    DO        (WHEN *DEBUG*      (PRINTMSG "~%Function SW in state ~C" K*STATE))        (WHEN (>= K*NUMTRY *MYMAXTRY*)      (PRINTMSG "~%~A"(SETQ K*ABORT-REASON; Save the error      (FORMAT NIL "~A: No valid packet received after ~A retries." *KERMIT-NAME* K*NUMTRY)))      (SETQ K*STATE *ABORT-STATE*)      (SETQ K*NUMTRY 0))       (WHEN (AND K*VERBOSEP (NOT K*CANCEL)); When verbose and not already cancelled      (SETQ K*CANCEL    (SEND *INFO-WINDOW* :ANY-TYI-NO-HANG)); Get a char from the io buffer      (IF; Command menu blip?(AND  (CONSP K*CANCEL)  (EQ (FIRST K*CANCEL) :MENU))(PROGN; - Yes  (SETQ K*CANCEL(GET (SECOND K*CANCEL) :VALUE)); Set the value of K*CANCEL  (IF (STRING-EQUAL K*CANCEL "E")       ; End requsted?      (PROGN                            ; -- Yes(SETQ K*CANCEL NIL)             ; Reset K*CANCEL(PRINTMSG "~%~A: END not valid here; ABORT or ABORT-SAVE first." *KERMIT-NAME*))      (PRINTMSG "~%~A"                  ; -- No,       (SETQ K*ABORT-REASON; Save the error    (FORMAT NIL "~A: User requested cancellation." *KERMIT-NAME*)))))(SETQ K*CANCEL NIL))); - No    (SETQ K*STATE  (SELECTOR K*STATE EQL    (*RDATA-STATE*        (RDATA))    (*SDATA-STATE*        (SDATA))    (*RINIT-STATE*        (RINIT))    (*SINIT-STATE*        (SINIT))    (*RFILE-STATE*        (RFILE))    (*SFILE-STATE*        (SFILE))    (*SEOF-STATE*         (SEOF))    (*SBREAK-STATE*       (SBREAK))    (*SGENERIC-STATE*     (SGENERIC SPACK-TYPE SPACK-DATA))    (*SSERVER-STATE*      (SSERVER))    (*RSERVER-STATE*      (RSERVER))    (*COMPLETE-STATE*     (IF (EQ K*OPERATION :SERVER) *RSERVER-STATE* NIL))    (*RCANCEL-STATE*      (RCANCEL))    (*ABORT-STATE*        (IF K*FP (SEND K*FP :CLOSE))  (IF (AND (EQ K*OPERATION :SERVER) (NOT K*CANCEL))      *RSERVER-STATE*      NIL))    (:OTHERWISE           NIL)))))(DEFUN SINIT ()  "Send-Initiate function to send this host's parameters and get other side's back."  (DECLARE (SPECIAL K*YOUREOL K*STATE K*CANCEL K*PCKT-NUM K*YOURQUOTE K*ABORT-REASON K*SPACKET))  (SETQ K*PCKT-NUM 0); Initialize the packet number    (IF K*CANCEL; Cancelled?      *ABORT-STATE*; - Yes, abort      (PROGN; - No(SETQ K*SPACKET (SPAR K*SPACKET)); Fill up init info packet(SPACK #\S K*PCKT-NUM (LENGTH K*SPACKET) K*SPACKET); Send an S packet with type,number,length,packet(MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)    (RPACK); What was the reply?  (CASE TYPE;        (#\Y; ACK...     (IF (= K*PCKT-NUM NUM); Correct ACK? (PROGN; - Yes   (RPAR PACKET LEN); Get other side's init info   (INCREMENT-PACKET-NUMBER); Bump packet count   *SFILE-STATE*); OK, switch to SFILE-STATE K*STATE)); - No, stay in same K*STATE        (#\N; NAK     (INCREMENT-RETRIES); Increment the retries     K*STATE); stay in same state and try again        (#\E; Error packet received     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))     *ABORT-STATE*)        (NIL; No packet received - timeout     (INCREMENT-RETRIES); Increment the retries     K*STATE); and try again        (:OTHERWISE; Received unknown packet - abort     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))     *ABORT-STATE*))))))(DEFUN SFILE ()  "Send File Header."  (DECLARE (SPECIAL K*FP K*FILNAM K*RECFILNAM K*SPACKET K*STATE K*PCKT-NUM    K*CANCEL K*SIZE K*SEND-TO-TTY K*ABORT-REASON))    (IF K*CANCEL; Cancelled?      *ABORT-STATE*; - Yes            (PROGN; - No     (WHEN (NOT K*FP); If file is not already open,     (LET    ((FILNAM NIL))    (CONDITION-CASE (ERR)(PROGN (SETQ FILNAM; Merge the filename with the home directory       (SEND (FS:MERGE-PATHNAME-DEFAULTS       K*FILNAM       (USER-HOMEDIR-PATHNAME))     :STRING-FOR-PRINTING)) (WHEN *DEBUG*; Print debugging info   (PRINTMSG "~%Opening ~A for sending." FILNAM)) (SETQ K*FP; Try to open the file       (OPEN FILNAM     :BYTE-SIZE 8)))    ; using byte-size of 8 since we only send 8 at a time.       (ERROR; Error in opening?       (PRINTMSG "~%~A"; Print error (SETQ K*ABORT-REASON       (FORMAT NIL "~A: Error <~A> opening file ~A."       *KERMIT-NAME* (SEND ERR :REPORT-STRING) FILNAM)))        (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet       (SETQ K*FP NIL))))); Be sure the pointer is not set(IF (NOT K*FP); Did we get an error opening the file?    *ABORT-STATE*; - Yes, abort    (PROGN                ; - No, setup the filename to send      (SETQ K*RECFILNAM    (IF K*SEND-TO-TTY           ; Send to the other KERMIT'S tty?""                      ; - Yes, don't worry about any transfer name(CREATE-KERMIT-FILENAME ; - No, convert the transfer name  (IF K*RECFILNAM; Was a transfer filename specified?      K*RECFILNAM; -- Yes, use it      (SEND               ; -- No, use the true open file name(SEND K*FP :TRUENAME):STRING-FOR-PRINTING)))))      (SETQ K*SIZE (ENCODE-PREFIXED-DATA K*RECFILNAM K*SPACKET))      (INITIALIZE-STATUS-COUNTS); Reset the timing info      (PRINT-STATUS-FILE-INFO); update the filenames on the screen      (PRINTMSG "~%Sending data...")      (IF K*SEND-TO-TTY; Are we sending to other KERMIT's TTY?  (SPACK #\X K*PCKT-NUM K*SIZE K*SPACKET); - Yes, send an X packet  (SPACK #\F K*PCKT-NUM K*SIZE K*SPACKET)); - No, send an F packet            (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)  (RPACK); What was the reply?(CASE TYPE    (#\Y; ACK   (IF (= NUM K*PCKT-NUM); See if it's correct ACK       (PROGN; - Yes, (INCREMENT-PACKET-NUMBER); Increment the packet count (SETQ K*SIZE       (BUFILL K*SPACKET K*FP)); Get first data from file *SDATA-STATE*); Switch to DATA-STATE       K*STATE)); - No, stay in same K*STATE    (#\N; NAK   (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if this is a NAK for the previous packet  K*PCKT-NUM)       (PROGN; - Yes, so treat it as an ACK (INCREMENT-PACKET-NUMBER); Increment the packet count (SETQ K*SIZE       (BUFILL K*SPACKET K*FP)); Get first data from file *SDATA-STATE*); Switch to SDATA-STATE       (PROGN; - No, (INCREMENT-RETRIES); increment the retries K*STATE))); Remain in same K*STATE    (#\E; Error packet received   (SETQ K*ABORT-REASON; Save the error (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET))   (PRINTMSG "~%~A" K*ABORT-REASON)   *ABORT-STATE*)    (NIL; Timeout   (INCREMENT-RETRIES); Increment the retries   K*STATE); Remain in same K*STATE    (:OTHERWISE; Unknown packet - abort   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   *ABORT-STATE*))))))))(DEFUN SDATA ()  "Send File Data."  (DECLARE (SPECIAL K*FP K*STATE K*PCKT-NUM K*SIZE K*CANCEL K*SPACKET K*ABORT-REASON))  (SPACK #\D K*PCKT-NUM K*SIZE K*SPACKET); Send a D packet  (COUNT-AND-PRINT-PACKETS K*SIZE)        ; Keep track of packet totals    (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)      (RPACK); What was the reply?    (CASE TYPE            (#\Y; ACK       (IF (= NUM K*PCKT-NUM); See if it's correct ACK   (PROGN; - Yes,     (INCREMENT-PACKET-NUMBER); Increment the packet count     (SETQ K*SIZE   (BUFILL K*SPACKET K*FP))      ; Get more data from the file     (IF (OR (ZEROP K*SIZE) K*CANCEL); EOF or cancel flag? *SEOF-STATE*; -- Yes, switch to SEOF-STATE *SDATA-STATE*)); -- No, stay in SDATA-STATE   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\N; NAK       (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if it's a NAK for last packet      K*PCKT-NUM)   (PROGN; - Yes, treat as ACK     (INCREMENT-PACKET-NUMBER); Increment the packet count     (SETQ K*SIZE   (BUFILL K*SPACKET K*FP))        ; Get more date from the file     (IF (OR (ZEROP K*SIZE) K*CANCEL); EOF or cancel flag? *SEOF-STATE*; -- Yes, switch to SEOF-STATE *SDATA-STATE*)); -- No, stay in SDATA-STATE   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Timeout       (INCREMENT-RETRIES); Increment the retries       K*STATE); Remain in same K*STATE            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))       *ABORT-STATE*))))(DEFUN SEOF ()  "Send End-Of-File."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*FP K*FILNAM    K*CANCEL K*ABORT-REASON))  (IF K*CANCEL                        ; Has cancellation been requested?      (SPACK #\Z K*PCKT-NUM 1 "D"); - Yes, send a Z packet with a D for Discard!      (SPACK #\Z K*PCKT-NUM 0 NIL)); - No, send a Z packet to close    (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)      (RPACK); What was the reply?    (CASE TYPE            (#\Y; ACK       (IF (= NUM K*PCKT-NUM); See if it's correct ACK   (PROGN; - Yes     (INCREMENT-PACKET-NUMBER); Increment the packet count     (PRINTMSG "~%Sending completed.")     (SEND K*FP :CLOSE); Close the input file     (SETQ K*FP NIL); Set flag indicating no file open     (IF (GET-NEXT-FILE); Any more files? (PROGN; -- Yes   (IF *DEBUG*; Print debugging info       (PRINTMSG "~%New file is ~A." K*FILNAM))   *SFILE-STATE*); Switch to SFILE-STATE *SBREAK-STATE*)); -- No, Break (EOT) and all done   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\N; NAK       (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if it's a NAK for last packet      K*PCKT-NUM)   (PROGN; - Yes, treat as ACK     (INCREMENT-PACKET-NUMBER); Increment the packet count     (PRINTMSG "~%Sending completed.")     (SEND K*FP :CLOSE); Close the input file     (SETQ K*FP NIL); Set flag indicating no file open     (IF (GET-NEXT-FILE); Any more files? (PROGN; -- Yes,   (IF *DEBUG*; Print debugging info       (PRINTMSG "~%New file is ~A." K*FILNAM))   *SFILE-STATE*); Switch to SFILE-STATE *SBREAK-STATE*)); -- No, Break (EOT) and all done   (PROGN; - No,     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Timeout       (INCREMENT-RETRIES); Increment the retries       K*STATE); Remain in same K*STATE            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))       *ABORT-STATE*))))(DEFUN SBREAK ()  "Send Break (EOT)."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*ABORT-REASON))  (SPACK #\B K*PCKT-NUM 0 NIL); Send a B packet    (MULTIPLE-VALUE-BIND (TYPE IGNORE NUM PACKET)      (RPACK); What was the reply?    (CASE TYPE            (#\Y; ACK       (IF (= NUM K*PCKT-NUM); See if it's correct ACK   (PROGN; - Yes     (INCREMENT-PACKET-NUMBER); Increment the packet count     *COMPLETE-STATE*); Switch to COMPLETE-STATE   (PROGN; - No     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\N; NAK       (IF (= (IF (> NUM 0 ) (1- NUM) 63); See if it's a NAK for last packet      K*PCKT-NUM)   (PROGN; - Yes, treat as ACK     (INCREMENT-PACKET-NUMBER); Increment the packet count     *COMPLETE-STATE*); Switch to COMPLETE-STATE   (PROGN; - No,     (INCREMENT-RETRIES); Increment the retries     K*STATE))); Stay in same K*STATE            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Timeout       (INCREMENT-RETRIES); Increment the retries       K*STATE); Remain in same K*STATE            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))       *ABORT-STATE*)))) (DEFUN RINIT ()  "Receive-Initiate function to receive other side's host's parameters and send ours back."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*CANCEL K*ABORT-REASON))  (SETQ K*PCKT-NUM 0); Initialize the packet number    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes, abort      (MULTIPLE-VALUE-BIND (TYPE LEN IGNORE PACKET); - No, get a packet  (RPACK)(CASE TYPE; What type was it?    (#\S; Send-Init   (RPAR PACKET LEN); Get other side's init info   (SETQ PACKET (SPAR PACKET)); Fill up my init info packet   (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); ACK with my parameters   (INCREMENT-PACKET-NUMBER); Bump packet number   *RFILE-STATE*); OK, enter File-Receive state    (#\E; Error packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))   *ABORT-STATE*)    (NIL; Didn't get a packet   (SPACK #\N 0 0 NIL); Return a NAK   (INCREMENT-RETRIES); Increment the retries   K*STATE); and keep trying    (:OTHERWISE; Unknown packet   (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   *ABORT-STATE*))))); and abort (DEFUN RFILE ()  "Receive File Header."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*FP K*RECFILNAM K*CANCEL    K*VERBOSEP K*ABORT-REASON K*EMPTY-PATHNAME))    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes, abort      (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET); - No...  (RPACK); Get a packet(CASE TYPE; What was the type?    (#\S; Send-Init   (IF (= NUM (IF (= K*PCKT-NUM 0)  63  (1- K*PCKT-NUM))); See if it's previous packet       (PROGN; - Yes (SETQ PACKET (SPAR PACKET)); Load in our Send-Init parameters (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); Send the ACK packet (INCREMENT-RETRIES); Increment the retries K*STATE); Stay in same state       (PROGN; - No, (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Otherwise set up error (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\Z; End-Of-File   (IF (= NUM (IF (= K*PCKT-NUM 0)  63  (1- K*PCKT-NUM))); See if it's previous packet       (PROGN; - Yes (SPACK #\Y K*PCKT-NUM 0 NIL); Send the ACK packet (INCREMENT-RETRIES); Increment the retries K*STATE); Finally, stay in this K*STATE       (PROGN; - No (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\F; File Header (just what we want)   (IF (= NUM K*PCKT-NUM); Correct packet number?       (LET; - Yes ((FILNAM (DECODE-PREFIXED-DATA PACKET LEN)); Decode the packet to get the filename    (NEWFILNAM NIL)) (CONDITION-CASE (ERR)     (PROGN      (SETQ NEWFILNAM; Determine the filename to use    (SEND      (FS:MERGE-PATHNAMES(IF K*RECFILNAM                 ; Was a transfer name specified?    (FS:DEFAULT-WILD-PATHNAME-COMPONENTS   ; Yes.  Use it.      (FS:PARSE-PATHNAME; Make a pathname from the transfer nameK*RECFILNAMNILK*EMPTY-PATHNAME); Merge with empty pathname      (FS:PARSE-PATHNAME(CREATE-KERMIT-FILENAME FILNAM); Create a suitible filename from FILNAMNILK*EMPTY-PATHNAME))    FILNAM)                     ; No.  Use the filename from packet.(USER-HOMEDIR-PATHNAME))      :STRING-FOR-PRINTING))      (SETQ K*FP; Try to open the file     (OPEN NEWFILNAM    :DIRECTION :OUTPUT  :IF-EXISTS ':NEW-VERSION  :IF-DOES-NOT-EXIST ':CREATE  :BYTE-SIZE 8                       ; always use a byte-size of 8 initially  :CHARACTERS (IF *IMAGE* NIL T))))  ; If in image mode, open with :CHARACTERS NIL   (ERROR    (PRINTMSG "~%~A"; Print error      (SETQ K*ABORT-REASON    (FORMAT NIL "~A: Error <~A> while creating file."    *KERMIT-NAME* (SEND ERR :REPORT-STRING))))    (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON)    *ABORT-STATE*); abort   (:NO-ERROR    (INITIALIZE-STATUS-COUNTS); Reset the timing info    (PRINT-STATUS-FILE-INFO); update the filenames on the screen    (PRINTMSG "~%Receiving ~A as ~A." FILNAM NEWFILNAM)    (SPACK #\Y K*PCKT-NUM (LENGTH NEWFILNAM) NEWFILNAM); ACKnowledge the file header    (INCREMENT-PACKET-NUMBER); Bump packet count    *RDATA-STATE*))); Switch to RDATA-STATE       (PROGN; - No, incorrect packet number (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect S packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\X                                  ; Print to TTY   (IF (= NUM K*PCKT-NUM); Correct packet number?       (PROGN; - Yes (SETQ K*FP; Direct the output to the TTY       (IF K*VERBOSEP   *INFO-WINDOW*   (MAKE-STRING-OUTPUT-STREAM))) (INITIALIZE-STATUS-COUNTS); Reset the timing info (PRINT-STATUS-FILE-INFO); update the filenames on the screen (PRINTMSG "~%Receiving ~A on screen.~%" PACKET) (SPACK #\Y K*PCKT-NUM 0 NIL); ACKnowledge the file header (INCREMENT-PACKET-NUMBER); Bump packet count *RDATA-STATE*); Switch to RDATA-STATE       (PROGN; - No (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect S packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\B; Break transmission (EOT)   (IF (= NUM K*PCKT-NUM); Correct packet number?       (PROGN; - Yes (SPACK #\Y K*PCKT-NUM 0 NIL); Say OK *COMPLETE-STATE*); Switch to COMPLETE-STATE       (PROGN; - No (PRINTMSG "~%~A"   (SETQ K*ABORT-REASON; Set up error (FORMAT NIL "~A: Received incorrect S packet number <~A>." *KERMIT-NAME* NUM))) *ABORT-STATE*))); abort    (#\E; Error packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))   *ABORT-STATE*)    (NIL; Didn't get packet - timeout   (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK   (INCREMENT-RETRIES); Increment the retries   K*STATE); Stay in same K*STATE and keep trying    (:OTHERWISE; Unknown packet - abort   (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Save the error   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   *ABORT-STATE*))))) (DEFUN RDATA ()  "Receive Data."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*CANCEL K*ABORT-REASON K*FILE-CHARS K*FP))    (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)      (RPACK); Get a packet    (CASE TYPE; What was the type?            (#\D; Data packet       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes,     (COUNT-AND-PRINT-PACKETS LEN); Keep track of packet totals     (INCF K*FILE-CHARS (BUFEMP PACKET LEN K*FP)) ; Write the data to the file and increment total chars     (IF K*CANCEL; Should the transfer be interrupted? (PROGN; -- Yes   (SPACK #\Y K*PCKT-NUM 1 "Z"); Send the ACK with cancel   (INCREMENT-PACKET-NUMBER); Bump packet count   *RCANCEL-STATE*); Switch to RCANCEL-STATE (PROGN; -- No   (SPACK #\Y K*PCKT-NUM 0 NIL); Send regular ACK   (INCREMENT-PACKET-NUMBER); Bump packet count   *RDATA-STATE*))); Remain in RDATA-STATE   (PROGN; - No, wrong packet number     (IF (= NUM (IF (= K*PCKT-NUM 0)    63    (1- K*PCKT-NUM))); See if it's previous packet (PROGN; -- Yes   (SPACK #\Y K*PCKT-NUM 0 NIL); Send an ACK   (INCREMENT-RETRIES); Increment the retries   K*STATE); Finally, stay in this K*STATE so no data will be written (PROGN; -- No   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Otherwise, set up error   (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))))); abort            (#\F; File header       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Otherwise, set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\X; File header       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\Z; End-Of-File       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes     (IF (AND (> LEN 0);      (EQUAL (SUBSEQ PACKET 0 1) "D")) ; Is D specified? (PROGN        ; -- Yes   (IF (OR *SAVEFILES*          ; Should the file be saved?  e.g., is *SAVEFILES* true    (STRING-EQUAL K*CANCEL "S")) ; or K*CANCEL save?       (PROGN                   ; --- Yes (SEND K*FP :CLOSE); Close but save the file (PRINTMSG "~%Receive aborted - file saved."))       (PROGN                   ; --- No (SEND K*FP :CLOSE T); Close with abort (discard) (PRINTMSG "~%Receive aborted - file discarded.")))) (PROGN; -- No   (SEND K*FP :CLOSE); Close the file [NOTE IF SEND-TO-TTY must save stream BAC]   (WHEN (TYPEP K*FP 'SYS:FILE-STREAM-MIXIN)     (FS:CHANGE-FILE-PROPERTIES K*FP NIL :BYTE-SIZE (IF *IMAGE* *IMAGE* 8)))   (PRINTMSG "~%Receive completed - file closed.")))     (SETQ K*FP NIL); Clear the file pointer     (SPACK #\Y K*PCKT-NUM 0 NIL); Say OK     (INCREMENT-PACKET-NUMBER); Bump packet count     *RFILE-STATE*); Go back to Receive File K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Didn't get packet - timeout       (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK       (INCREMENT-RETRIES); Increment the retries       K*STATE); Stay in same K*STATE and keep trying            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))       (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send an error packet       *ABORT-STATE*))))(DEFUN RCANCEL ()  "We cancelled receive - now send an ERROR packet when we get a DATA packet."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*CANCEL K*ABORT-REASON K*FP))    (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)      (RPACK); Get a packet    (CASE TYPE; What was the type?            (#\D; Data packet       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes     (SEND K*FP :CLOSE T); Close with abort (discard)     (PRINTMSG "~%Receive aborted - file discarded")     (SETQ K*FP NIL); Clear the file pointer     (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send an error packet     (INCREMENT-PACKET-NUMBER); Bump packet count     (IF K*CANCEL         ; Cancel all further transfers? (really not valid, since only Z supported) *ABORT-STATE*; -- Yes, abort (PROGN; -- No   (SETQ K*CANCEL NIL); Reset K*CANCEL and   *RFILE-STATE*))); switch to RFILE-STATE   (PROGN; - No, wrong packet number     (IF (= NUM (IF (= K*PCKT-NUM 0)    63    (1- K*PCKT-NUM))); See if it's previous packet (PROGN; -- Yes   (SPACK #\Y K*PCKT-NUM 0 NIL); Send an ACK   (INCREMENT-RETRIES); Increment the retries   K*STATE); Finally, stay in this K*STATE so no data will be written (PROGN; -- No   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON; Set up error   (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))))); abort            (#\F; File header       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\X; TTY       (IF (= NUM (IF (= K*PCKT-NUM 0)      63      (1- K*PCKT-NUM))); See if it's previous packet   (PROGN; - Yes     (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Finally, stay in this K*STATE   (PROGN; - No     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\Z; End-Of-File       (IF (= NUM K*PCKT-NUM); Correct packet number?   (PROGN; - Yes     (IF (AND (> LEN 0); D specified to discard file?      (EQUAL (SUBSEQ PACKET 0 1) "D")) (PROGN        ; -- Yes   (IF (OR *SAVEFILES*          ; Should the file be saved?  e.g., is *SAVEFILES* true    (STRING-EQUAL K*CANCEL "S")) ; or K*CANCEL save?       (PROGN                   ; --- Yes (SEND K*FP :CLOSE); Close but save the file (PRINTMSG "~%Receive aborted - file saved."))       (PROGN                   ; --- No (SEND K*FP :CLOSE T); Close with abort (discard) (PRINTMSG "~%Receive aborted - file discarded.")))) (PROGN; -- No   (SEND K*FP :CLOSE); Close the file [NOTE IF SEND-TO-TTY must save stream BAC]   (PRINTMSG "~%Receive aborted - file ~A closed")))     (SETQ K*FP NIL); Clear the file pointer     (SPACK #\Y K*PCKT-NUM 0 NIL); Say OK     (INCREMENT-PACKET-NUMBER); Bump packet count     (IF K*CANCEL        ; Cancel all further transfers? (not needed, since only Z supported) *ABORT-STATE*; -- Yes, abort (PROGN; -- No   (SETQ K*CANCEL NIL); reset K*CANCEL and   *RFILE-STATE*))); switch to RFILE-STATE   (PROGN; - No, incorrect packet number     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Set up error     (FORMAT NIL "~A: Received incorrect packet number <~A>." *KERMIT-NAME* NUM)))     *ABORT-STATE*))); abort            (#\E; Error packet received       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))       *ABORT-STATE*)            (NIL; Didn't get packet       (SPACK #\N K*PCKT-NUM 0 NIL); Return a NAK       (INCREMENT-RETRIES); Increment the retries       K*STATE); Stay in same K*STATE and keep trying            (:OTHERWISE; Unknown packet - abort       (PRINTMSG "~%~A" (SETQ K*ABORT-REASON; Save the error       (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))       (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send an error packet       *ABORT-STATE*))))(DEFUN SGENERIC (SPACK-TYPE &OPTIONAL SPACK-DATA)  "Used for server commands expecting short response such as ACK.SPACK-TYPE should be a G, R or C packet type."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*NUMTRY K*SPACKET K*VERBOSEP    K*CANCEL K*SERVER-PACK-TYPE K*FP K*PACKETS-RETRIED K*ABORT-REASON))    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes      (PROGN; - No(INITIALIZE-STATUS-COUNTS); Initialize the packet counts and timing(ENCODE-PREFIXED-DATA SPACK-DATA K*SPACKET)           ; Prefix encode the data(SETQ SPACK-DATA K*SPACKET)(SPACK SPACK-TYPE 0 (LENGTH SPACK-DATA) SPACK-DATA); Send a G, R or C packet(MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)    (RPACK); What was the reply?  (CASE TYPE        (#\S; Send-Init     (IF (ZEROP NUM); Packet number 0? (PROGN; - Yes,         (RPAR PACKET LEN); Get other side's init info   (SETQ PACKET (SPAR PACKET)); Fill up my init info packet   (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); ACK with my parameters   (INCREMENT-PACKET-NUMBER); Bump packet number   *RFILE-STATE*); OK, enter File-Receive state (PROGN; - No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\X; Text header     (IF (ZEROP NUM); Correct packet number? ; maybe K*PCKT-NUM instead? ; BAC (PROGN; - Yes    (SETQ K*FP; set the file pointer to (IF K*VERBOSEP; either the info window or a string stream     *INFO-WINDOW*     (MAKE-STRING-OUTPUT-STREAM)))           (PRINTMSG "~%Receiving ~A on the screen.~%" PACKET)   (SPACK #\Y K*PCKT-NUM 0 NIL); ACKnowledge the file header   (INCREMENT-PACKET-NUMBER); Bump packet count   *RDATA-STATE*); switch to RDATA-STATE (PROGN; - No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\N; NAK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Stay in same K*STATE        (#\Y; ACK     (IF (ZEROP NUM); See if it's correct ACK (PROGN; - Yes        (PRINTMSG "~%~A" PACKET); print data on tty   *COMPLETE-STATE*); Switch to COMPLETE-STATE (PROGN; - No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\E; Error packet received     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))     *ABORT-STATE*)        (NIL; Timeout     (IF (AND (= SPACK-TYPE #\G); Did we just request      (OR (EQUAL (SUBSEQ SPACK-DATA 0 1) "L"); a remote logout   (EQUAL (SUBSEQ SPACK-DATA 0 1) "F"))); or a remote finish? *COMPLETE-STATE*; - Yes, the remote KERMIT will never respond so we're finished (PROGN; - No   (INCREMENT-RETRIES); Increment the retries   K*STATE))); remain in same K*STATE        (:OTHERWISE; Unknown packet - abort     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))     *ABORT-STATE*))))))(DEFUN SSERVER ()  "Used for server commands expecting large responses."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*SPACKET K*CANCEL    K*YOUREOL K*YOURQUOTE K*VERBOSEP K*FP K*ABORT-REASON))    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes, so abort      (PROGN; - No(SETQ K*SPACKET (SPAR K*SPACKET)); Fill up init info packet(SPACK #\I K*PCKT-NUM (LENGTH K*SPACKET) K*SPACKET); Send an I packet with type,number,length,packet(MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET)    (RPACK); What was the reply?  (CASE TYPE        (#\Y; ACK     (IF (ZEROP NUM); Correct packet number (0)? (PROGN; -- Yes   (RPAR PACKET LEN); Get other side's init info   *SGENERIC-STATE*); Move to SGENERIC-STATE (PROGN; -- No   (PRINTMSG "~%~A"; setup error     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))   *ABORT-STATE*))); abort        (#\N; NAK     (INCREMENT-RETRIES); Increment the retries     K*STATE); Stay in same K*STATE        (#\E; Error packet received - use defaults - but how? ;; BAC     *SGENERIC-STATE*); Switch to SGENERIC-STATE        (NIL; Timeout     (INCREMENT-RETRIES); Increment the retries     K*STATE); remain in same K*STATE        (:OTHERWISE; Unknown packet - abort     (PRINTMSG "~%~A"       (SETQ K*ABORT-REASON; Save the error     (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))     *ABORT-STATE*))))))(DEFUN RSERVER ()  "Receive Server - This KERMIT in server mode, idle and waiting for a message."  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*NUMTRY K*FILNAM K*SPACKET K*ABORT-REASON    K*PACKETS-RETRIED K*CANCEL K*YOURMAXPACSIZ K*FP K*SEND-TO-TTY    K*ARG1LIST))    (SETQ K*PCKT-NUM 0); Initialize the packet number  (SETQ K*NUMTRY 0); Zero the number of tries - can't exceed maxtry in this state  (SETQ K*ABORT-REASON ""); Reset the abort reason string  (SETQ K*SEND-TO-TTY NIL)  (INITIALIZE-STATUS-COUNTS); Initialize the packet counts and timing info    (IF K*CANCEL; Cancel?      *ABORT-STATE*; - Yes      (MULTIPLE-VALUE-BIND (TYPE LEN NUM PACKET); - No  (RPACK 900); Get a packet - wait 15 seconds (60 * 15) for it (CASE TYPE    (#\I; INIT   (IF (ZEROP NUM); Correct packet number (0)?       (PROGN; -- Yes  (SPACK #\Y K*PCKT-NUM 0 NIL); Send ACK K*STATE); Stay in same K*STATE       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet K*STATE))); Stay in same K*STATE    (#\S; SEND-INIT   (IF (ZEROP NUM); Correct packet number (0)?       (PROGN; -- Yes (RPAR PACKET LEN); Get other side's init info (SETQ PACKET (SPAR PACKET)); Fill up my init info packet (SPACK #\Y K*PCKT-NUM (LENGTH PACKET) PACKET); ACK with my parameters (INCREMENT-PACKET-NUMBER); Bump packet number *RFILE-STATE*); OK, enter File-Receive state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); and stay in same K*STATE    (#\R; RECEIVE-INIT   (IF (ZEROP NUM); Correct packet number (0)?       (PROGN; -- Yes (SETQ K*ARG1LIST       (EXPAND-WILDS; Expand any wildcards in the filename (DECODE-PREFIXED-DATA PACKET LEN))); Decode the packet to get the requested filename (GET-NEXT-FILE); Get the file to process *SINIT-STATE*); Proceed to SINIT-STATE       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); and stay in same K*STATE    (#\K; KERMIT command   (IF (ZEROP NUM); Correct packet number (0)?       (LET ((RESULT (PROCESS-KERMIT-COMMAND PACKET LEN))) (IF (OR       K*FILNAM                 ; Filename specified for transfer?       (> (LENGTH RESULT)       ; or long reply?  (FLOOR K*YOURMAXPACSIZ 1.5)))      (PROGN                     ; - Yes       (SETQ K*SEND-TO-TTY T)   ; Set tty flag       (WHEN (NOT K*FILNAM) (SETQ K*FP       (MAKE-STRING-INPUT-STREAM RESULT)))       *SINIT-STATE*)           ; Go to SINIT-STATE     (PROGN                     ; - No       (SPACK #\Y K*PCKT-NUM (LENGTH RESULT) RESULT); ACK with the requested info       K*STATE)))                ; Stay in same state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); Stay in same state    (#\C; HOST command   (IF (ZEROP NUM); Correct packet number (0)?       (LET ((RESULT (PROCESS-HOST-COMMAND PACKET LEN))) (IF (OR       K*FILNAM                 ; Filename specified for tranfer?       (> (LENGTH RESULT)       ; or long reply?  (FLOOR K*YOURMAXPACSIZ 1.5)))      (PROGN                     ; - Yes       (SETQ K*SEND-TO-TTY T)   ; Set tty flag       (WHEN (NOT K*FILNAM) (SETQ K*FP       (MAKE-STRING-INPUT-STREAM RESULT)))       *SINIT-STATE*)           ; Go to SINIT-STATE     (PROGN                     ; - No       (SPACK #\Y K*PCKT-NUM (LENGTH RESULT) RESULT); ACK with the requested info       K*STATE)))                ; Stay in same state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); Stay in same state    (#\G; GENERIC command   (IF (ZEROP NUM); Correct packet number (0)?       (LET ((RESULT (PROCESS-GENERIC-COMMAND PACKET LEN))) (IF (OR       K*FILNAM                 ; Filename specified for tranfer?       (> (LENGTH RESULT)       ; or long reply?  (FLOOR K*YOURMAXPACSIZ 1.5)))      (PROGN                     ; - Yes       (SETQ K*SEND-TO-TTY T)   ; Set tty flag       (WHEN (NOT K*FILNAM) (SETQ K*FP       (MAKE-STRING-INPUT-STREAM RESULT)))       *SINIT-STATE*)           ; Go to SINIT-STATE     (PROGN                     ; - No       (SPACK #\Y K*PCKT-NUM (LENGTH RESULT) RESULT); ACK with the requested info       K*STATE)))                ; Stay in same state       (PROGN; -- No (PRINTMSG "~%~A"; setup error   (SETQ K*ABORT-REASON (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM))) (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON) K*STATE))); Stay in same state    (#\E; Error packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON (FORMAT NIL "~%~A: Received error packet <~A>." *KERMIT-NAME* PACKET)))   K*STATE); Stay in same K*STATE  (#\N; NAK packet received   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Server received NAK packet, but cannot resend last packet."   *KERMIT-NAME*)))   (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet with an error message   K*STATE)    (NIL; Timeout   (SPACK #\N 0 0 NIL); Return a NAK   K*STATE); and keep trying    (:OTHERWISE; Unknown packet   (PRINTMSG "~%~A"     (SETQ K*ABORT-REASON   (FORMAT NIL "~A: Server received unknown packet type <~A>." *KERMIT-NAME* TYPE)))   (SPACK #\E K*PCKT-NUM (LENGTH K*ABORT-REASON) K*ABORT-REASON); Send E packet with an error message   K*STATE)))));;; KERMIT utilities.(DEFUN SPACK (TYPE NUM LEN DATA)  "Send a packet.  Returns T."  (DECLARE (SPECIAL K*BUFFER K*YOURPAD K*YOURPADCHAR K*YOUREOL K*TTYFD K*YOURMAXPACSIZ))  (SEND K*TTYFD :CLEAR-INPUT); clear the input buffer    (LET ((IND 0)(CHECKSUM 0))    (DOTIMES (i K*YOURPAD)                          (SETF (AREF K*BUFFER i) K*YOURPADCHAR); Issue any padding      (INCF IND))        (SETF (AREF K*BUFFER IND) *ASCII-SOH*); Packet marker, ASCII 1 SOH    (INCF IND); Increment    (WHEN (> LEN (- K*YOURMAXPACSIZ 2))         ; Be sure outgoing message fits in packet      (WHEN *DEBUG*(PRINTMSG  "~%SPACK: Message length <~A> was too large - truncating." LEN))      (SETQ LEN (- K*YOURMAXPACSIZ 2)))    (SETF (AREF K*BUFFER IND) (TOCHAR (+ LEN 3))); Character count    (INCF IND); Increment    (SETQ CHECKSUM (TOCHAR (+ LEN 3))); Initialize the checksum        (SETF (AREF K*BUFFER IND) (TOCHAR NUM)); Packet number    (INCF IND); Increment    (SETQ CHECKSUM (+ CHECKSUM (TOCHAR NUM))); Update checksum to include NUM        (SETF (AREF K*BUFFER IND) TYPE); Packet type    (INCF IND); Increment    (SETQ CHECKSUM (+ CHECKSUM TYPE)); Update checksum to include TYPE        (DOTIMES (i LEN); Loop for all data characters      (SETF (AREF K*BUFFER IND) (AREF DATA i)); Get a character      (INCF IND); Increment      (SETQ CHECKSUM (+ CHECKSUM (AREF DATA i)))); Update checksum to include character        (SETQ CHECKSUM (COMPUTE-FINAL-CHECKSUM CHECKSUM)); Compute final checksum    (SETF (AREF K*BUFFER IND) (TOCHAR CHECKSUM)); Put it in the packet    (INCF IND); Increment        (SETF (AREF K*BUFFER IND) K*YOUREOL); Extra-packet line terminator    (INCF IND); Increment        (SETF (FILL-POINTER K*BUFFER) IND); Setup the length of the buffer    (SEND K*TTYFD :STRING-OUT K*BUFFER 0 IND); Send the packet        (WHEN *DEBUG*; For Debugging display outgoing packet      (PRINTMSG"~%SPACK:  type=~A  num=~D  len=~D  data=~S  buffer=~S" type num len data K*BUFFER)))      T); Finally, return T(DEFUN RPACK (&OPTIONAL (TIMEOUT (* *MYTIME* 60)))  "Read a packet from the K*TTYFD stream.  Returns values TYPE, LEN, NUM and DATA.:TYI-WITH-TIMEOUT added to Explorer serial stream.  Optional timeout supplied toallow server mode to have longer timeouts."  (DECLARE (SPECIAL K*TTYFD K*YOURMAXPACSIZ K*RPACKET))    (LET ((CCHECKSUM 0) (RCHECKSUM 0) (DATA-COUNT 0)(TYPE NIL) (LEN 0) (NUM 0) (READ-STATE 0))        (SETF (FILL-POINTER K*RPACKET) 0); Say no data in array yet    (LOOP      UNTIL (> READ-STATE 7)      FOR T-CHAR = (SEND K*TTYFD :TYI-WITH-TIMEOUT TIMEOUT)      WHEN (NULL T-CHAR)      DO      (SETQ READ-STATE 99)      ELSE      DO            (WHEN (NOT *IMAGE*); If not in *IMAGE* mode,(SETQ T-CHAR (LOGAND T-CHAR #b1111111))); handle the parity - #b1111111 is #o177            (WHEN (= T-CHAR *ASCII-SOH*); If *ASCII-SOH*(SETQ READ-STATE 1)); resynchronize!            (CASE READ-STATE(0; Never had a Start Header NIL); Do nothing(1; Start Header (INCF READ-STATE)); ... on to next state(2; Length (SETQ CCHECKSUM T-CHAR); Start the checksum (SETQ LEN (- (UNCHAR T-CHAR) 3)); Character count (SETQ LEN (ABS LEN)); temp - must handle this BAC (WHEN (OR (> LEN K*YOURMAXPACSIZ) (< LEN 0)); BAC - carefull   (SETQ TYPE NIL); Error in packet length   (SETQ READ-STATE 99); Get out of loop!   (PRINTMSG "~%RPACK:  Error reading length <~A>~%" LEN)) (INCF READ-STATE)); ... on to the next state(3; Packet number (SETQ CCHECKSUM (+ CCHECKSUM T-CHAR)); Update checksum (SETQ NUM (UNCHAR T-CHAR)); Packet number (INCF READ-STATE)); ... on to the next state(4; Packet type (SETQ CCHECKSUM (+ CCHECKSUM T-CHAR)); Update checksum (SETQ TYPE (CODE-CHAR T-CHAR)); Packet type - make number into a character (IF (ZEROP LEN); Check for any data     (SETQ READ-STATE 6); If no data, skip to checksum state     (PROGN; data ...       (SETQ DATA-COUNT 0); set up DATA-COUNT for next state       (INCF READ-STATE)))); ... on to the next state(5; Data characters (SETQ CCHECKSUM (+ CCHECKSUM T-CHAR)); Update checksum (SETF (AREF K*RPACKET DATA-COUNT) T-CHAR); Get a character (INCF DATA-COUNT); Increment the data count (WHEN (= DATA-COUNT LEN); If no more data characters   (INCF READ-STATE))); ... on to the next state(6; Checksum (SETQ RCHECKSUM (UNCHAR T-CHAR)); Convert to numeric (SETQ CCHECKSUM (COMPUTE-FINAL-CHECKSUM CCHECKSUM)); Compute the checksum (WHEN (NOT (= CCHECKSUM RCHECKSUM)); If checksum is not ok,   (SETQ TYPE NIL); indicate an error so that we'll loop again   (WHEN *DEBUG*; For debugging, print checksum errors     (PRINTMSG       "~%RPACK:  Error comparing received checksum <~A> to computed checksum <~A> in packet number <~A>~%"       RCHECKSUM CCHECKSUM NUM))) (SETF (AREF K*RPACKET LEN) 0); Mark the end of the data (SETF (FILL-POINTER K*RPACKET) LEN); (INCF READ-STATE)); ... on to the next state(7; EOL character - throw it away! (INCF READ-STATE)))); ... on to the next state DONE!!!        (WHEN *DEBUG*; For Debugging display incoming packet      (PRINTMSG"~%RPACK:  type=~A  num=~D  len=~D  data=~A" TYPE NUM LEN K*RPACKET))        (VALUES TYPE LEN NUM K*RPACKET))); Return values(DEFUN BUFILL (BUFFER FILEPOINTER)  "Fill a packet buffer with data from a file.   Input parameters are the buffer in which to place the file data,   and a file pointer from which to read the data.  As a result of   processing, BUFFER is filled and the position in FILEPOINTER is   advanced.  Returned value is the length of the buffer.   K*BUFILLPTR and K*BUFILLBUF are used to buffer the file data   for look-ahead processing."    (DECLARE (SPECIAL K*BUFILLBUF K*BUFILLPTR K*YOURMAXPACSIZ K*YOURQUOTE    K*REPEAT K*BINQUOTE K*FILE-CHARS))  (LET    ((7-CHAR NIL)     (8-CHAR NIL)     (EOF NIL)     (INDEX 0)     (TMPBUFILLPTR NIL)     (LENBUFILLBUF (LENGTH K*BUFILLBUF))     (ACTUALMAXPACSIZ (- K*YOURMAXPACSIZ 8))     (QUOTABLES (LIST K*YOURQUOTE      (WHEN (NOT (= K*BINQUOTE *ASCII-N*)) K*BINQUOTE)      (WHEN (NOT (= K*REPEAT *ASCII-SP*)) K*REPEAT))))        (LOOP      UNTIL (OR (>= INDEX  ACTUALMAXPACSIZ) EOF); Until we exceed length of the packet or are at EOF            WHEN (= K*BUFILLPTR LENBUFILLBUF); When we run out of data in the buffer      DO      (SETQ K*BUFILLPTR 0); Reset the pointer      (WHEN (ZEROP (SEND FILEPOINTER :STRING-IN NIL K*BUFILLBUF)); and get more(SETQ EOF T)); If no more, set EOF      (SETQ LENBUFILLBUF (LENGTH K*BUFILLBUF)); Newly filled buffer so get the length      ELSE      DO      (SETQ 8-CHAR (AREF K*BUFILLBUF K*BUFILLPTR)); Get the next character from the file buffer      (INCF K*BUFILLPTR); Increment the pointer      (INCF K*FILE-CHARS)                       ; Increment the total number of file chars read            (WHEN (NOT (= K*REPEAT *ASCII-SP*)); If we have agreed to do repeat processing,(SETQ TMPBUFILLPTR K*BUFILLPTR); handle the repeat characters(LOOP; Loop until  UNTIL (OR (= TMPBUFILLPTR LENBUFILLBUF)       ; either we run out of chars from the buffer     (NOT (= 8-CHAR (AREF K*BUFILLBUF TMPBUFILLPTR)))) ; or we get one that's not equal to 8-char  DO (INCF TMPBUFILLPTR))(SETQ TMPBUFILLPTR (1+ (- TMPBUFILLPTR K*BUFILLPTR))); We repeat the char TMPBUFILLPTR times(WHEN (> TMPBUFILLPTR 3); If this is more than 3, do repeat prefixing!  (WHEN (> TMPBUFILLPTR 94) (SETQ TMPBUFILLPTR 94)); Also, truncate the number of repeats to 94  (SETF (AREF BUFFER INDEX) K*REPEAT); Put repeat character in the packet  (INCF INDEX); Increment  (SETF (AREF BUFFER INDEX) (TOCHAR TMPBUFILLPTR)); Put my repeat count in the packet  (INCF INDEX); Increment  (SETQ K*BUFILLPTR (+ K*BUFILLPTR TMPBUFILLPTR -1)); adjust the buffer index for the next character  (SETQ K*FILE-CHARS (+ K*FILE-CHARS TMPBUFILLPTR -1)))) ; Adjust the total file chars read           (WHEN (AND (NOT (= K*BINQUOTE *ASCII-N*)); Handle 8-bit quoting (> 8-CHAR *ASCII-DEL*)); If the 8-bit char is > 127(SETF (AREF BUFFER INDEX) K*BINQUOTE); Put K*BINQUOTE in buffer(INCF INDEX)); Increment             (WHEN (NOT *IMAGE*); As long as we're not in image mode(SETQ 8-CHAR (CONVERT-TO-ASCII 8-CHAR))); force characters to ASCII             (SETQ 7-CHAR (LOGAND 8-CHAR #b1111111)); Get low order 7 bits - #b1111111 is #o177      (WHEN (OR (< 7-CHAR *ASCII-SP*); Does char require special handling?(MEMBER 7-CHAR QUOTABLES)(= 7-CHAR *ASCII-DEL*))(WHEN (AND (= 7-CHAR *ASCII-CR*); Map CR->CRLF when   (NOT *IMAGE*)); not in image mode  (SETF (AREF BUFFER INDEX) K*YOURQUOTE); Put K*YOURQUOTE in buffer  (INCF INDEX); Increment  (SETF (AREF BUFFER INDEX) (CTL *ASCII-CR*)); Put the character in buffer  (INCF INDEX); Increment  (SETQ 8-CHAR *ASCII-LF*); Replace the char with a linefeed  (SETQ 7-CHAR (LOGAND 8-CHAR #b1111111))); Get low order 7 bits - #b1111111 is #o177(SETF (AREF BUFFER INDEX) K*YOURQUOTE); Put K*YOURQUOTE in buffer(INCF INDEX); Increment(WHEN; Make printable characters  (NOT(MEMBER 7-CHAR QUOTABLES))        ; As long as it's not the active quote, binquote or repeat   (SETQ 7-CHAR (CTL 7-CHAR))  (SETQ 8-CHAR (CTL 8-CHAR))))            (IF *IMAGE*  (SETF (AREF BUFFER INDEX) 8-CHAR)  (SETF (AREF BUFFER INDEX) 7-CHAR))      (INCF INDEX))        (SETF (FILL-POINTER BUFFER) INDEX)    INDEX)); Return the index(DEFUN BUFEMP (BUFFER LEN FILEPOINTER)  "Put data from an incoming packet buffer into a file.   Input parameters are the packet, it's length, and a   pointer to the file in which to store the data.  As a   result of processing, data is written to the file.   This function returns the total number of characters   written to the file."    (DECLARE (SPECIAL K*IGNORE-NEXT-LINEFEED K*REPEAT K*BINQUOTE))    (LET (T-CHAR 7-CHAR REPEAT BINQUOTED(FILE-CHARS 0)(QUOTABLES (LIST *MYQUOTE*      (WHEN (NOT (= K*BINQUOTE *ASCII-N*)) K*BINQUOTE)      (WHEN (NOT (= K*REPEAT *ASCII-SP*)) K*REPEAT))))    (LOOP      WITH IND = 0      UNTIL (= IND LEN)      DO      (SETQ T-CHAR (AREF BUFFER IND)); Get a character            (SETQ REPEAT 1)      (SETQ BINQUOTED NIL)            (WHEN (AND (NOT (= K*REPEAT *ASCII-SP*)) (= T-CHAR K*REPEAT)); Is it the repeat prefix?(INCF IND)(SETQ REPEAT (UNCHAR (LOGAND (AREF BUFFER IND) #b1111111))); Get the repeat count(INCF IND); Increment(SETQ T-CHAR (AREF BUFFER IND))); Get next char            (WHEN (AND (NOT (= K*BINQUOTE *ASCII-N*)) (= T-CHAR K*BINQUOTE)); Is it the binary quote prefix?(SETQ BINQUOTED T); flag it(INCF IND)(SETQ T-CHAR (AREF BUFFER IND))); Get next char            (WHEN (= T-CHAR *MYQUOTE*); Control quote?(INCF IND); Increment(SETQ T-CHAR (AREF BUFFER IND)); Get the quoted character(SETQ 7-CHAR (LOGAND T-CHAR #b1111111)); and strip off the parity bit(WHEN (NOT (MEMBER 7-CHAR QUOTABLES)); Low order bits match active quote, binquote or repeat char?  (SETQ T-CHAR (CTL T-CHAR)))); - No, uncontrollify it            (WHEN BINQUOTED; If the binary prefix was set(SETQ T-CHAR (LOGXOR T-CHAR #b10000000))); set the 8th bit            (LOOPFOR I FROM 1 TO REPEAT; Now do the repeat count processingDO(IF *IMAGE*; Image mode?    (PROGN                              ; - Yes      (SEND FILEPOINTER :TYO T-CHAR); send the character      (INCF FILE-CHARS))                ; Increment the total file chars written    (PROGN; - No,       (SETQ T-CHAR (LOGAND T-CHAR #b1111111)); Strip off the parity bit      (IF (AND (= T-CHAR *ASCII-LF*); Is it a linefeed       K*IGNORE-NEXT-LINEFEED); after a CR?   (SETQ K*IGNORE-NEXT-LINEFEED NIL); -- Yes, ignore the LF and clear the flag  (PROGN; -- No,    (SETQ K*IGNORE-NEXT-LINEFEED; setup the flag  (IF (= T-CHAR *ASCII-CR*) T NIL)); T If it's a CR; otherwise NIL    (SETQ T-CHAR (CONVERT-FROM-ASCII T-CHAR)); Convert the character    (WHEN T-CHAR; If it has an appropriate conversion,      (SEND FILEPOINTER :TYO T-CHAR)   ; Write char to the file      (INCF FILE-CHARS))))))); Increment the total file chars written            (INCF IND)); Increment the index    FILE-CHARS))                                ; Return the total number of chars written(DEFUN GET-NEXT-FILE ()  "Get next file in a file group.  Returns NIL if no more files."  (DECLARE (SPECIAL K*FILNAM K*RECFILNAM K*ARG1LIST K*ARG2LIST))    (SETQ K*FILNAM (CAR K*ARG1LIST)); Get the next file  (SETQ K*ARG1LIST (CDR K*ARG1LIST)); Shorten the list  (SETQ K*RECFILNAM (CAR K*ARG2LIST)); Get the next recfile  (SETQ K*ARG2LIST (CDR K*ARG2LIST)); Shorten the list  (WHEN (AND (STRINGP K*FILNAM)     (ZEROP (LENGTH K*FILNAM))); If its an empty string, make it nil    (SETQ K*FILNAM NIL))  (WHEN (AND (STRINGP K*RECFILNAM)     (ZEROP (LENGTH K*RECFILNAM))); If its an empty string, make it nil    (SETQ K*RECFILNAM NIL))  (WHEN *DEBUG*; Print debugging info    (PRINTMSG      "~%Function GET-NEXT-FILE:  k*filnam=~A  k*recfilnam=~A  k*arg1list=~A  k*arg2list=~A"      K*FILNAM K*RECFILNAM K*ARG1LIST K*ARG2LIST))  (IF K*FILNAM; More files?      T      NIL))(DEFUN SPAR (DATA)  "Fill the data array with my send-init parameters.Returns the data array."  (DECLARE (SPECIAL K*BINQUOTE K*REPEAT))  (SETF (FILL-POINTER DATA) 9); Set array length to 9  (SETF (AREF DATA 0) (TOCHAR *MYMAXPACSIZ*)); Biggest packet I can receive  (SETF (AREF DATA 1) (TOCHAR *MYTIME*)); When I will time out  (SETF (AREF DATA 2) (TOCHAR *MYPAD*)); How much padding I need  (SETF (AREF DATA 3) (CTL *MYPADCHAR*)); Padding character I want  (SETF (AREF DATA 4) (TOCHAR *MYEOL*)); End-Of-Line character I want  (SETF (AREF DATA 5) *MYQUOTE*); Quote character I use  (SETF (AREF DATA 6) K*BINQUOTE); 8-bit quote character I use  (SETF (AREF DATA 7) *ASCII-1*); Only know how to do 1 char checksum  (SETF (AREF DATA 8) K*REPEAT); Repeat count character I use  DATA)(DEFUN RPAR (DATA LEN)  "Read the data array to get the other host's send-init parameters.Returns the data array."  (DECLARE (SPECIAL K*YOURMAXPACSIZ K*YOURTIME K*YOURPAD K*YOURPADCHAR    K*YOUREOL K*YOURQUOTE K*BINQUOTE K*REPEAT K*STATE K*TTYFD-BITS))  (LET    ((REPEAT 0)     (BINQUOTE 0))        (WHEN (> LEN 0)      (SETQ K*YOURMAXPACSIZ    (UNCHAR (AREF DATA 0)))); Maximum send packet size    (WHEN (> LEN 1)      (SETQ K*YOURTIME    (UNCHAR (AREF DATA 1)))); When you will time out    (WHEN (> LEN 2)      (SETQ K*YOURPAD    (UNCHAR (AREF DATA 2)))); Number of pads to send    (WHEN (> LEN 3)      (SETQ K*YOURPADCHAR    (CTL (AREF DATA 3)))); Padding character to send    (WHEN (> LEN 4)      (SETQ K*YOUREOL    (UNCHAR (AREF DATA 4)))); EOL character to send    (WHEN (> LEN 5)      (SETQ K*YOURQUOTE    (CHAR-CODE (AREF DATA 5)))); quote character to send    (WHEN (> LEN 6)      (SETQ K*BINQUOTE    (CHAR-CODE (AREF DATA 6)))); 8-bit quote character to send    (WHEN (> LEN 8)      (SETQ REPEAT    (CHAR-CODE (AREF DATA 8)))); Repeat character to send    (WHEN *DEBUG*      (PRINTMSG"~%RPAR (unadjusted):  pacsiz=~A/~A  time=~A/~A  pad=~A/~A  padchar=~A/~A  eol=~A/~A  quote=~A/~A  binquote=~A  repeat=~A" *MYMAXPACSIZ* K*YOURMAXPACSIZ *MYTIME* K*YOURTIME *MYPAD* K*YOURPAD *MYPADCHAR* K*YOURPADCHAR *MYEOL* K*YOUREOL *MYQUOTE* K*YOURQUOTE K*BINQUOTE K*REPEAT))        (IF (ZEROP K*YOURMAXPACSIZ); Is other KERMIT packet size unspecified?(SETQ K*YOURMAXPACSIZ *MYMAXPACSIZ*); - Yes, use our size(IF (< K*YOURMAXPACSIZ *MYMAXPACSIZ*); - No, is other KERMIT's smaller?    (SETQ *MYMAXPACSIZ* K*YOURMAXPACSIZ))); -- Yes - we'll both use other KERMIT's        (WHEN (ZEROP K*YOUREOL); Is other KERMIT EOL character unspecified?      (SETQ K*YOUREOL *MYEOL*)); - Yes, use *MYEOL*        (WHEN (ZEROP K*YOURQUOTE); Is other KERMIT quote character unspecified?      (SETQ K*YOURQUOTE *MYQUOTE*)); - Yes, use *MYQUOTE*        (IF (AND (= K*STATE *RINIT-STATE*); If we have never sent our parameters     (= K*STATE *SGENERIC-STATE*); and are processing the other     (= K*STATE *RSERVER-STATE*)); KERMIT's parameters first (e.g., he did the init)(PROGN; - Yes, we never sent  (COND; Process the 8-bit quoting char    ((AND; If the other KERMIT has a valid 8-bit quote char...       (OR (AND (> BINQUOTE 32) (< BINQUOTE 63))   (AND (> BINQUOTE 95) (< BINQUOTE 127)))       (NOT (= BINQUOTE K*YOURQUOTE)))     (SETQ K*BINQUOTE BINQUOTE)); use it        ((= BINQUOTE *ASCII-Y*); If 8-bit quote char is a Y     (IF *IMAGE*; Are we in image mode? (IF (= K*TTYFD-BITS 8); -- Yes, do we have an 8-bit stream?     (SETQ K*BINQUOTE *ASCII-N*); -- Yes, say no quoting     (SETQ K*BINQUOTE *ASCII-AMP*)); -- No, say we'll quote with & (SETQ K*BINQUOTE *ASCII-N*))); -- No, not in image mode so don't do 8-bit        (T; Otherwise...say no 8-bit quoting     (SETQ K*BINQUOTE *ASCII-N*)))  (IF; Process the repeat char    (AND (OR (AND (> REPEAT 32) (< REPEAT 63)); Is it valid?     (AND (> REPEAT 95) (< REPEAT 127))) (NOT (= REPEAT K*YOURQUOTE)) (NOT (= REPEAT K*BINQUOTE)))    (SETQ K*REPEAT REPEAT); -- Yes, setup the repeat char    (SETQ K*REPEAT *ASCII-SP*))); -- No...say no repeating(PROGN; - No, our parameters have been sent (we did the init)    (WHEN (AND (NOT (= BINQUOTE K*BINQUOTE)); Process the 8-bit quote char     (NOT (= BINQUOTE *ASCII-Y*)); If it's not what we sent, and its not a Y     (SETQ K*BINQUOTE *ASCII-N*))); say no 8-bit quoting    (WHEN (NOT (= REPEAT K*REPEAT)); Process the repeat char - If it's not what we sent,    (SETQ K*REPEAT *ASCII-SP*)))); say no repeating        (WHEN *DEBUG*      (PRINTMSG"~%RPAR   (adjusted):  pacsiz=~A/~A  time=~A/~A  pad=~A/~A  padchar=~A/~A  eol=~A/~A  quote=~A/~A  binquote=~A  repeat=~A" *MYMAXPACSIZ* K*YOURMAXPACSIZ *MYTIME* K*YOURTIME *MYPAD* K*YOURPAD *MYPADCHAR* K*YOURPADCHAR *MYEOL* K*YOUREOL *MYQUOTE* K*YOURQUOTE K*BINQUOTE K*REPEAT)))    DATA); Finally, return DATA as the value of the function;;; Support functions(DEFUN PROCESS-KERMIT-COMMAND (PACKET IGNORE)  "Given a packet containing the command, try to process it.Return a flag indicating success or failure, and the response."  (FORMAT NIL "~A: Unimplemented KERMIT server command <~A>." *KERMIT-NAME* PACKET))(DEFUN PROCESS-HOST-COMMAND (PACKET IGNORE)  "Process a host command.  If an error is encountered, returns an error string."  (LET    ((RESULT NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(SETQ RESPONSE      (WITH-OUTPUT-TO-STRING (STANDARD-OUTPUT); Force the output to go to the string(SETQ RESULT (EVAL (READ-FROM-STRING PACKET))))); Evaluate the command      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing HOST command <~A>."     *KERMIT-NAME* (SEND ERR :REPORT-STRING) PACKET)))      (:NO-ERROR       (FORMAT NIL "~A~A" RESPONSE RESULT))))); Just return the response(DEFUN PROCESS-GENERIC-COMMAND (PACKET LEN)  "Generic Kermit Command.  Single character in data field (possibly followedby operands, shown in {braces}, optional fields  in  [brackets]):    I   Login [{*user[*password[*account]]}]    C   CWD, Change Working Directory [{*directory[*password]}]    L   Bye (Logout)  * F   Finish (Shut down the server, but don't logout).  * D   Directory [{*filespec}]  * U   Disk Space Query (Usage) [{*area}]  * E   Delete (Erase) {*filespec}  * T   Type {*filespec}  * R   Rename {*oldname*newname}  * K   Copy {*source*destination}  * W   Who's logged in? (Finger) [{*user ID or network host[*options]}]    M   Send a short Message {*destination*text}    H   Help [{*topic}]  * Q   Server Status Query    P   Program {*[program-filespec][*program-commands]}    J   Journal {*command[*argument]}    V   Variable {*command[*argument[*argument]]}"    (DECLARE (SPECIAL K*FILNAM K*CANCEL))  (LET    ((COMD NIL)     (ARGS (DECODE-PREFIXED-DATA PACKET LEN))        ; Decode the data     (ARG1 NIL)     (ARG2 NIL)     (ARG3 NIL)     (LNTH 0)     (INDX 0))        (SETQ COMD (SUBSEQ ARGS 0 1))    (INCF INDX)    (WHEN (< INDX (LENGTH ARGS))                     ; Get the first argument      (SETQ LNTH (UNCHAR (COERCE (SUBSEQ ARGS INDX (1+ INDX)) 'CHARACTER)))      (INCF INDX)      (SETQ ARG1 (SUBSEQ ARGS INDX (+ INDX LNTH)))      (INCF INDX LNTH)          (WHEN (< INDX (LENGTH ARGS))                   ; Get the second argument(SETQ LNTH (UNCHAR (COERCE (SUBSEQ ARGS INDX (1+ INDX)) 'CHARACTER)))(INCF INDX)(SETQ ARG2 (SUBSEQ ARGS INDX (+ INDX LNTH)))(INCF INDX LNTH)(WHEN (< INDX (LENGTH ARGS))                 ; Get the third argument  (SETQ LNTH (UNCHAR (COERCE (SUBSEQ ARGS INDX (1+ INDX)) 'CHARACTER)))  (INCF INDX)  (SETQ ARG3 (SUBSEQ ARGS INDX (+ INDX LNTH)))  (INCF INDX LNTH))))    (COND      ((EQUAL COMD "D")       (GENERIC-DIRECTORY ARG1))      ((EQUAL COMD "E")       (GENERIC-DELETE ARG1))      ((EQUAL COMD "F")       (SETQ K*CANCEL "Z"))      ((EQUAL COMD "K")       (GENERIC-COPY ARG1 ARG2))      ((EQUAL COMD "Q")       (GENERIC-STATUS))      ((EQUAL COMD "R")       (GENERIC-RENAME ARG1 ARG2))      ((EQUAL COMD "T")       (SETQ K*FILNAM ARG1))      ((EQUAL COMD "U")       (GENERIC-DISK-USAGE ARG1))      ((EQUAL COMD "W")       (GENERIC-WHO))      (T       (FORMAT NIL "~A: Unimplemented server GENERIC command <~A>" *KERMIT-NAME* COMD)))))(DEFUN GENERIC-COPY (FILE1 FILE2)  "Copies FILE1 to FILE2.  If an error is encountered, returns an error string."  (LET    ((F1 NIL)     (F2 NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(PROGN (SETQ F1 (MERGE-PATHNAMES FILE1 (USER-HOMEDIR-PATHNAME))) (SETQ F2 (MERGE-PATHNAMES FILE2 (USER-HOMEDIR-PATHNAME))) (COPY-FILE F1 F2 :CREATE-DIRECTORIES T))      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC COPY command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (FORMAT NIL "FIle ~A copied to ~A." F1 F2))))))(DEFUN GENERIC-RENAME (FILE1 FILE2)  "Renames FILE1 to FILE2.  If an error is encountered, returns an error string."  (LET    ((F1 NIL)     (F2 NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(PROGN (SETQ F1 (MERGE-PATHNAMES FILE1 (USER-HOMEDIR-PATHNAME))) (SETQ F2 (MERGE-PATHNAMES FILE2 (USER-HOMEDIR-PATHNAME))) (RENAME-FILE F1 F2))      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC RENAME command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (FORMAT NIL "FIle ~A renamed to ~A." F1 F2))))))(DEFUN GENERIC-DELETE (FILE1)  "Deletes FILE1.  If an error is encountered, returns an error string."  (LET    ((F1 NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(PROGN (SETQ F1 (MERGE-PATHNAMES FILE1 (USER-HOMEDIR-PATHNAME))) (DELETE-FILE F1))      (ERROR       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC DELETE command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (FORMAT NIL "FIle ~A deleted." F1))))))(DEFUN GENERIC-DIRECTORY (&OPTIONAL DIRECTORY-NAME)  "Returns a string containing the contents of current directory or directory-name.If an error is encountered, returns an error string."  (LET    ((DIR NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(SETQ DIR      (FS:DIRECTORY-LIST(MERGE-PATHNAMES  (IF DIRECTORY-NAME      DIRECTORY-NAME      (USER-HOMEDIR-PATHNAME))  "*.*#*")))      (ERROR; If unable to get the directory-list       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC DIRECTORY command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE     (FORMAT NIL "Directory listing for ~A~%~A~%~:{~A~35T~@8A (~A)~51T~A~73T~A~%~}"     (SEND (GET (CAR DIR) :PATHNAME) :STRING-FOR-PRINTING)     (GET (CAR DIR) :DISK-SPACE-DESCRIPTION)     (MAPCAR       (FUNCTION (LAMBDA (flist)   (LIST     (SEND (CAR flist) :STRING-FOR-DIRED)     (GET flist :LENGTH-IN-BYTES)     (GET flist :BYTE-SIZE)     (MULTIPLE-VALUE-BIND (SS MM HH DY MN YEAR) (DECODE-UNIVERSAL-TIME   (GET flist :CREATION-DATE))       (FORMAT NIL "~A/~A/~A~11T~A:~A:~A"       MN DY YEAR HH MM SS))     (GET flist :AUTHOR))))       (CDR DIR))))))))(DEFUN GENERIC-DISK-USAGE (&OPTIONAL DIRECTORY-NAME)  "Returns a string containing the disk-usage of current directory or directory-name.If an error is encountered, returns an error string."  (LET    ((DIR NIL)     (RESPONSE NIL))        (CONDITION-CASE (ERR)(SETQ DIR      (FS:DIRECTORY-LIST(MERGE-PATHNAMES  (IF DIRECTORY-NAME      DIRECTORY-NAME      (USER-HOMEDIR-PATHNAME))  "*.*#*")))      (ERROR; If unable to get the directory-list       (SETQ RESPONSE     (FORMAT NIL "~A: Error <~A> while processing GENERIC DISK-USAGE command."     *KERMIT-NAME* (SEND ERR :REPORT-STRING))))      (:NO-ERROR       (SETQ RESPONSE (GET (CAR DIR) :DISK-SPACE-DESCRIPTION))))))(DEFUN GENERIC-STATUS ()  "Returns a string containing the status of the current Kermit environment."  (FORMAT NIL "Status of the current ~A environment:~%Image Mode:~26T~A~%Debug Mode:~26T~A~%More Processing:~26T~A~%Maximum Tries:~26T~A~%Maximum packet size:~26T~A~%Timeout seconds:~26T~A~%Number of pad characters:~26T~A~%Padding character:~26T~A~%EOL character:~26T~A~%Quote character:~26T~A~%Filename conversion:~26T~A~%Save partial files:~26T~A" *KERMIT-NAME* *IMAGE* *DEBUG* *MORE* *MYMAXTRY* *MYMAXPACSIZ* *MYTIME* *MYPAD* *MYPADCHAR* *MYEOL* *MYQUOTE* *FILNAMCNV* *SAVEFILES*))(DEFUN GENERIC-WHO ()  "Returns a string describing who's logged on each machine on the network."  (LET    ((STREAM (MAKE-STRING-OUTPUT-STREAM)))      ; make an output stream for FINGER-LISPMS to write to    (CHAOS:FINGER-LISPMS STREAM)    (GET-OUTPUT-STREAM-STRING STREAM)))     (DEFUN CHANGE-KERMIT-PARAMETERS ()  "Change local operating parameters"  (LET ((IMAGE *IMAGE*) (DEBUG *DEBUG*) (MORE *MORE*) (MYMAXTRY *MYMAXTRY*)(MYMAXPACSIZ *MYMAXPACSIZ*) (MYTIME *MYTIME*) (MYPAD *MYPAD*)(MYPADCHAR *MYPADCHAR*) (MYEOL *MYEOL*) (MYQUOTE *MYQUOTE*)(FILNAMCNV *FILNAMCNV*) (SAVEFILES *SAVEFILES*) (RESET NIL))        (DECLARE (SPECIAL IMAGE DEBUG MORE MYMAXTRY MYMAXPACSIZ MYTIME      MYPAD MYPADCHAR MYEOL MYQUOTE FILNAMCNV SAVEFILES RESET))        (CATCH 'QUIT-CVV      (TV:CHOOSE-VARIABLE-VALUES'((IMAGE "Image Mode      " :DOCUMENTATION "NIL: Send/store file as ASCII characters.  8: Send/store file as 8-BIT binary.  16: Send/store data as 16-BIT binary (Explorer binary)." :CHOOSE (NIL 8 16))  (DEBUG "Debug Mode      " :DOCUMENTATION "YES: Print debugging information.  NO: Do not print debugging information." :BOOLEAN)  (MORE  "More Processing " :DOCUMENTATION "YES: Enable **MORE** in the KERMIT window.  NO: Do not use **MORE**." :BOOLEAN)  ""  (MYMAXTRY    "Maximum tries            "       :DOCUMENTATION "Maximum number of times to retry a packet"       :NUMBER)  (MYMAXPACSIZ "Maximum packet size      "       :DOCUMENTATION "Maximum packet size - must not be greater than 94"       :NUMBER)  (MYTIME      "Timeout seconds          "       :DOCUMENTATION "Number of seconds after which I should be timed out"       :NUMBER)  (MYPAD       "Number of pad characters "       :DOCUMENTATION "Number of padding characters to use"       :NUMBER)  (MYPADCHAR   "Padding character        "       :DOCUMENTATION "Padding character to use - enter the character number"       :NUMBER)  (MYEOL       "EOL character            "       :DOCUMENTATION "End-Of-Line character to use - enter the character number"       :NUMBER)  (MYQUOTE     "Quote character          "       :DOCUMENTATION "Quote character to use - enter the character number"       :NUMBER)  ""  (FILNAMCNV "Filename conversion "     :DOCUMENTATION "YES: Convert filenames to name.type format.  NO: Do not convert filenames."     :BOOLEAN)  (SAVEFILES "Save partial files  "     :DOCUMENTATION "YES: Save partially received file if transfer is interrupted.  NO: Delete the file."     :BOOLEAN)  ""  (RESET "Reset parameters " :DOCUMENTATION "YES: Immediately reset parameters to default values.  NO: Use current parameter values." :BOOLEAN)):NEAR-MODE '(:POINT 500 400):WIDTH 50:LABEL "Change Parameters":MARGIN-CHOICES '(("Abort" (THROW 'QUIT-CVV T)) "Do It"))      (SETQ *IMAGE* IMAGE)      (SETQ *DEBUG* DEBUG)      (SETQ *MORE* MORE)      (SETQ *MYMAXTRY* MYMAXTRY)      (SETQ *MYMAXPACSIZ* MYMAXPACSIZ)      (SETQ *MYTIME* MYTIME)      (SETQ *MYPAD* MYPAD)      (SETQ *MYPADCHAR* MYPADCHAR)      (SETQ *MYEOL* MYEOL)      (SETQ *MYQUOTE* MYQUOTE)      (SETQ *FILNAMCNV* FILNAMCNV)      (SETQ *SAVEFILES* SAVEFILES))    (WHEN RESET; If these values are changed, change in DEFVAR as well      (SETQ *IMAGE* NIL)      (SETQ *DEBUG* NIL)      (SETQ *MORE* NIL)      (SETQ *MYMAXTRY* 10)      (SETQ *MYMAXPACSIZ* 94)      (SETQ *MYTIME* 10)      (SETQ *MYPAD* 0)      (SETQ *MYPADCHAR* 0)      (SETQ *MYEOL* *ASCII-CR*)      (SETQ *MYQUOTE* *ASCII-NS*)      (SETQ *FILNAMCNV* T)      (SETQ *SAVEFILES* NIL))     (SEND *INFO-WINDOW* :SET-MORE-P *MORE*))); Set in window;;; Kermit printing routines:(DEFUN PRINTMSG (MSG-CTL-STRING &OPTIONAL &REST ARGS)  "Print message on standard output if in verbose mode."  (DECLARE (SPECIAL K*VERBOSEP K*ERROR-MESSAGE))  (WHEN K*VERBOSEP; When verbose,    (APPLY 'FORMAT *INFO-WINDOW* MSG-CTL-STRING ARGS))