home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
lispmachine.tar.gz
/
lispmachine.tar
/
lmisrv.lsp
< prev
next >
Wrap
Text File
|
1988-08-16
|
8KB
|
176 lines
;;; -*- 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)))