;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Allow *abort-reason* to be accessable globally.  LER 4/06/88
;;;			      RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;			TEXAS INSTRUMENTS INCORPORATED.
;;;				 P.O. BOX 2909
;;;			      AUSTIN, TEXAS 78769
;;;				    MS 2151
;;;
;;; Copyright (C) 1988 Texas Instruments Incorporated. All rights reserved.

;;; Written 04/06/88 17:14:16 by REINER,
;;; while running on NOVEMBER from band LOD2
;;; With Experimental SYSTEM 4.25, Experimental VIRTUAL-MEMORY 4.0, Experimental EH 4.0,
;;;  Experimental MAKE-SYSTEM 4.0, Experimental MICRONET 4.0, Experimental LOCAL-FILE 4.0,
;;;  Experimental BASIC-PATHNAME 4.0, Experimental DISK-IO 4.0, Experimental DISK-LABEL 4.0,
;;;  Experimental BASIC-FILE 4.0, Experimental MAC-PATHNAME 4.0, Experimental NETWORK-PATHNAME 4.0,
;;;  Experimental COMPILER 4.1, Experimental NETWORK-NAMESPACE 4.3, Experimental TV 4.22,
;;;  Experimental DATALINK 4.10, Experimental CHAOSNET 4.3, Experimental GC 4.2, Experimental MEMORY-AUX 4.0,
;;;  Experimental NVRAM 4.3, Experimental SYSLOG 4.0, Experimental STREAMER-TAPE 4.0,
;;;  Experimental UCL 4.0, Experimental INPUT-EDITOR 4.0, Experimental METER 4.1,
;;;  Experimental ZWEI 4.8, Experimental DEBUG-TOOLS 4.0, Experimental NETWORK-SUPPORT 4.0,
;;;  Experimental NETWORK-SERVICE 4.0, Experimental DATALINK-DISPLAYS 4.0, Experimental FONT-EDITOR 4.0,
;;;  Experimental SERIAL 4.0, Experimental PRINTER 4.2, Experimental PRINTER-TYPES 4.0,
;;;  Experimental IMAGEN 4.0, Experimental SUGGESTIONS 4.0, Experimental MAIL-DAEMON 4.0,
;;;  Experimental MAIL-READER 4.4, Experimental TELNET 4.0, Experimental VT100 4.2,
;;;  Experimental NAMESPACE-EDITOR 4.2, Experimental PROFILE 4.0, Experimental VISIDOC 4.0,
;;;  Experimental NAMESPACE 4.3, Experimental BUG 11.0, Experimental IP 3.0, Experimental KERMIT 3.7,
;;;  Experimental TESTBRIDGE 9.0,  microcode 518, Band Name: 4.0*+KC+Tbuilder 3/21/88

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(DEFVAR *abort-reason* nil)

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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*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 *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 *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-DEFAULTS
				K*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 *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 *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 *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 *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 *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 *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 *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 *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 *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 *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 *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 *ABORT-REASON* "No file(s) specified"))))
	    (:OTHERWISE				; Unknown command
	     (PRINTMSG "~%~A"
		       (SETQ *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 *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 *ABORT-REASON*
	  (VALUES NIL K*FILES-TRANSFERRED *ABORT-REASON*)
	  (VALUES T   K*FILES-TRANSFERRED NIL)))
    
						; (ERROR
						;  (PRINTMSG "~%~%ERROR: ~A" (SEND K-ERROR :REPORT-STRING))
						;  (SIGNAL-CONDITION K-ERROR)))
    ))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(DEFUN SW (STATE &OPTIONAL SPACK-TYPE SPACK-DATA)
  "This is the state table switcher for transferring files.  It loops until
either it finishes, or an error is encountered.  The routines called by
this 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))
  
  (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 *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 *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)))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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*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 *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 *ABORT-REASON*	; Save the error
			     (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
	     *ABORT-STATE*))))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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))
  
  (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 *ABORT-REASON*
			       (FORMAT NIL "~A: Error <~A> opening file ~A."
				       *KERMIT-NAME* (SEND ERR :REPORT-STRING) FILNAM))) 
	       (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *ABORT-REASON*		; Save the error
			 (FORMAT NIL "~A: Received error packet <~A>." *KERMIT-NAME* PACKET))
		   (PRINTMSG "~%~A" *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 *ABORT-REASON*	; Save the error
				   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
		   *ABORT-STATE*))))))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(DEFUN SDATA ()
  "Send File Data."
  (DECLARE (SPECIAL K*FP K*STATE K*PCKT-NUM K*SIZE K*CANCEL K*SPACKET))
  (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 *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 *ABORT-REASON*		; Save the error
		       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
       *ABORT-STATE*))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(DEFUN SEOF ()
  "Send End-Of-File."
  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*FP K*FILNAM
		    K*CANCEL))
  (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 *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 *ABORT-REASON*		; Save the error
		       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
       *ABORT-STATE*))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(DEFUN SBREAK ()
  "Send Break (EOT)."
  (DECLARE (SPECIAL K*STATE K*PCKT-NUM))
  (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 *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 *ABORT-REASON*		; Save the error
		       (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
       *ABORT-STATE*)))) 

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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))
  (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 *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 *ABORT-REASON*	; Save the error
			   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
	   *ABORT-STATE*)))))			; and abort 

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(DEFUN RFILE ()
  "Receive File Header."
  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*FP K*RECFILNAM K*CANCEL
		    K*VERBOSEP 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 *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 *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 name
					K*RECFILNAM
					NIL
					K*EMPTY-PATHNAME)	; Merge with empty pathname
				      (FS:PARSE-PATHNAME
					(CREATE-KERMIT-FILENAME FILNAM)	; Create a suitible filename from FILNAM
					NIL
					K*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 *ABORT-REASON*
				    (FORMAT NIL "~A: Error <~A> while creating file."
					    *KERMIT-NAME* (SEND ERR :REPORT-STRING))))
		    (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *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 *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 *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 *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 *ABORT-REASON*	; Save the error
			   (FORMAT NIL "~A: Received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
	   *ABORT-STATE*))))) 

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(DEFUN RDATA ()
  "Receive Data."
  (DECLARE (SPECIAL K*STATE K*PCKT-NUM K*CANCEL 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 *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 *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 *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 *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 *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 *ABORT-REASON*		; Save the error
		       (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))
       (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *ABORT-REASON*)	; Send an error packet
       *ABORT-STATE*))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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*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 *ABORT-REASON*) *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 *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 *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 *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 *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 *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 *ABORT-REASON*		; Save the error
		       (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))
       (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *ABORT-REASON*)	; Send an error packet
       *ABORT-STATE*))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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))
  
  (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 *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 *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 *ABORT-REASON*
				   (FORMAT NIL "~A: Received non-zero packet number <~A>." *KERMIT-NAME* NUM)))
		   *ABORT-STATE*)))		; abort
	    
	    (#\E				; Error packet received
	     (PRINTMSG "~%~A"
		       (SETQ *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 *ABORT-REASON*	; Save the error
			     (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))
	     *ABORT-STATE*))))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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))
  
  (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 *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 *ABORT-REASON*	; Save the error
			     (FORMAT NIL "~A: Received unknown packet type <~A>." TYPE)))
	     *ABORT-STATE*))))))

))

#!C
; From file KERMIT.LISP#> PUBLIC.KERMIT; SYS:
#10R KERMIT#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "KERMIT"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: PUBLIC.KERMIT; KERMIT.#"


(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*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 *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 *ABORT-REASON*
				 (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM)))
		 (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *ABORT-REASON*
				 (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM)))
		 (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *ABORT-REASON*
				 (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM)))
		 (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *ABORT-REASON*
				 (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM)))
		 (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *ABORT-REASON*
				 (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM)))
		 (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *ABORT-REASON*
				 (FORMAT NIL "~A: Server received non-zero packet number <~A>." *KERMIT-NAME* NUM)))
		 (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *ABORT-REASON*)
		 K*STATE)))			; Stay in same state
	  
	  (#\E					; Error packet received
	   (PRINTMSG "~%~A"
		     (SETQ *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 *ABORT-REASON*
			   (FORMAT NIL "~A: Server received NAK packet, but cannot resend last packet."
				   *KERMIT-NAME*)))
	   (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *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 *ABORT-REASON*
			   (FORMAT NIL "~A: Server received unknown packet type <~A>." *KERMIT-NAME* TYPE)))
	   (SPACK #\E K*PCKT-NUM (LENGTH *ABORT-REASON*) *ABORT-REASON*)	; Send E packet with an error message
	   K*STATE)))))

))