;;; -*- mode:lisp; base:8; ibase:8; package:KERMIT -*- ;****************************************************************************** ; Copyright (c) 1984, 1985 by Lisp Machine Inc. ; Symbolics-specific portions Copyright (c) 1985 by Honeywell, Inc. ; Permission to copy all or part of this material is granted, provided ; that the copies are not made or distributed for resale, and the ; copyright notices and reference to the source file and the software ; distribution version appear, and that notice is given that copying is ; by permission of Lisp Machine Inc. LMI reserves for itself the ; sole commercial right to use any part of this KERMIT/H19-Emulator ; not covered by any Columbia University copyright. Inquiries concerning ; copyright should be directed to Mr. Damon Lawrence at (213) 642-1116. ; ; Version Information: ; LMKERMIT 1.0 -- Original LMI code, plus edit ;1; for 3600 port ; ; Authorship Information: ; Mark David (LMI) Original version, using KERMIT.C as a guide ; George Carrette (LMI) Various enhancements ; Mark Ahlstrom (Honeywell) Port to 3600 (edits marked with ";1;" comments) ; ; Author Addresses: ; George Carrette ARPANET: GJC at MIT-MC ; ; Mark Ahlstrom ARPANET: Ahlstrom at HI-Multics ; PHONE: (612) 887-4006 ; USMAIL: Honeywell MN09-1400 ; Computer Sciences Center ; 10701 Lyndale Avenue South ; Bloomington, MN 55420 ;****************************************************************************** ;;; A KERMIT server is a KERMIT program running remotely with no "user ;;; interface". All commands to the server arrive in packets from the ;;; local KERMIT.... ;;; Between transactions, a KERMIT server waits for packets containing ;;; server commands. The packet sequence number is always set back to 0 ;;; after a transaction. A KERMIT server in command wait should be ;;; looking for packet 0. Certain server commands will result in the ;;; exchange of multiple packets. Those operations proceed exactly like ;;; file transfer. ;;; Server operation must be implemented in two places: in the server ;;; itself, and in any KERMIT program that will be communicating with a ;;; server. The server must have code to read the server commands from ;;; packets and respond to them. the user KERMIT must have code to parse ;;; commands to send requests to servers, to form the server command ;;; packets, and to handle the responses to those server commands.... ;;; Server commands are as follows: ;;; S Send Initiate (exchange parameters, server waits for a file). ;;; R Receive Initiate (ask the server to send the specified files). ;;; I Initialize (exchange parameters).... ;;; G Generic KERMIT Command. Single character in data field (possibly ;;; followed by operands, shown in {braces}, optional fields in ;;; [brackets]) specifies the command: ;;; ;;; ... ;;; L Logout, Bye ;;; F Finish (Shut down the server, but don't logout). ;;; ... ;;; Between transactions, when the server has no tasks pending, it may ;;; send out periodic NAKs (always with type 1 checksums) to prevent a ;;; deadlock in case a command was sent to it but was lost. These NAKs ;;; can pile up in the local "user" KERMIT's unput buffer (if it has ;;; one), so the user KERMIT should be prepared to clear its input ;;; buffer before sending a command to a server. (declare (special kstate) ;in calls.lisp ) (defconst *timint-for-server-wait* 45 "Amount of time to wait before timeout when in server mode") (defun kermit-remote-server (tty &optional working-directory) (send kstate ':remote-server tty working-directory)) (defun receive-file-header (packet num &aux ourfilename) num (multiple-value-bind (ignore num ignore data) (rpack) data (cond ((not (= num *packet-number*)) #\A) (t (setq ourfilename (string-for-kermit-outfile packet)) (cond ((setq *fp* (open-file-out-or-not ourfilename)) (format interaction-pane "~&Receiving ~A as ~A" packet ourfilename) (or *remote* (update-status-label ourfilename nil)) (spack #\Y *packet-number* 0 nil) (setq *oldtry* *numtry*) (setq *numtry* 0) (bump-packet-number) #\D) (t (format interaction-pane "~&Cannot create ~S" packet) ;experimental error packet sending--mhd (spack #\E *packet-number* 45 ; "Kermit-Q: Error in file header.") #\A)))))) (DEFUN SERVER-COMMAND-WAIT () (CONDITION-CASE () ;; in case of a sys:abort condition ;; just return nil; thus they just ;; abort out of kermit server, not ;; the login server too. ;; PS-terminal doesn't die then!! (LOOP INITIALLY (AND *DEBUG* (FORMAT T "~&Entering Kermit Server Command Wait...~%")) WITH *TIMINT* = *TIMINT-FOR-SERVER-WAIT* WITH *REMOTE* = T WITH *STATE* = #\W ;my own name: WAIT FOR *BYTECOUNT* = NIL FOR *NUMTRY* = 0 AND *PACKET-NUMBER* = 0 AND *OLDTRY* = 0 DOING (FLUSHINPUT) (MULTIPLE-VALUE-BIND (TYPE NUM LEN DATA) (RPACK) LEN (SELECT TYPE (#\S (COND ((EQ NUM 0) ;you do the job of Rinit and Rfile (RPAR DATA) ;here, then jump into Recsw at Rdata (SETQ DATA (SPAR DATA)) (SPACK #\Y *PACKET-NUMBER* 6 DATA) (SETQ *OLDTRY* *NUMTRY*) (SETQ *NUMTRY* 0) (BUMP-PACKET-NUMBER) (RECEIVE-FILE-HEADER DATA NUM) (SETQ DATA-XFER-START-TIME (TIME) *BYTECOUNT* 0) (RECSW #\D *PACKET-NUMBER* *NUMTRY*)))) (#\R (COND ((NOT (= *PACKET-NUMBER* NUM))) (T (COND ((SETQ *FILELIST* (KERMIT-FILELIST DATA) *FILNAM* (CAR *FILELIST*)) (IF *DEBUG* (FORMAT INTERACTION-PANE "Files to send:~A" *FILELIST*)) (BUMP-PACKET-NUMBER) (SENDSW #\S *PACKET-NUMBER*)) (T (SPACK #\E *PACKET-NUMBER* 25 "Error: File Not Found")))))) (#\G (COND ((EQ LEN 1) (COND ((EQ (AREF DATA 0) #\L) ;generic logout (SPACK #\Y *PACKET-NUMBER* 0 NIL) (AND *DEBUG* (FORMAT T "...logout on ~A" (time:print-current-date nil))) (RETURN ':LOGOUT)) ((EQ (AREF DATA 0) #\F) ;generic finish (SPACK #\Y *PACKET-NUMBER* 0 NIL) (AND *DEBUG* (FORMAT T "...finishing on ~A" (time:print-current-date nil))) (RETURN NIL)))))) (*FALSE* (SPACK #\A *PACKET-NUMBER* 0 NIL)) (:OTHERWISE (SPACK #\E *PACKET-NUMBER* 60 "unimplemented server command ")))) ) (SYS:ABORT NIL)))