home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / lispmachine / lmisrv.lsp < prev    next >
Text File  |  2020-01-01  |  8KB  |  176 lines
  1. ;;; -*- mode:lisp; base:8; ibase:8; package:KERMIT -*-
  2.  
  3.  
  4. ;******************************************************************************
  5. ; Copyright (c) 1984, 1985 by Lisp Machine Inc.
  6. ; Symbolics-specific portions Copyright (c) 1985 by Honeywell, Inc.
  7. ; Permission to copy all or part of this material is granted, provided
  8. ; that the copies are not made or distributed for resale, and the 
  9. ; copyright notices and reference to the source file and the software
  10. ; distribution version appear, and that notice is given that copying is
  11. ; by permission of Lisp Machine Inc.  LMI reserves for itself the 
  12. ; sole commercial right to use any part of this KERMIT/H19-Emulator
  13. ; not covered by any Columbia University copyright.  Inquiries concerning
  14. ; copyright should be directed to Mr. Damon Lawrence at (213) 642-1116.
  15. ;
  16. ; Version Information:
  17. ;      LMKERMIT 1.0     --      Original LMI code, plus edit ;1; for 3600 port
  18. ;
  19. ; Authorship Information:
  20. ;      Mark David (LMI)           Original version, using KERMIT.C as a guide
  21. ;      George Carrette (LMI)      Various enhancements
  22. ;      Mark Ahlstrom (Honeywell)  Port to 3600 (edits marked with ";1;" comments)
  23. ;
  24. ; Author Addresses:
  25. ;      George Carrette     ARPANET: GJC at MIT-MC
  26. ;
  27. ;      Mark Ahlstrom       ARPANET: Ahlstrom at HI-Multics
  28. ;                          PHONE:   (612) 887-4006
  29. ;                          USMAIL:  Honeywell MN09-1400
  30. ;                                   Computer Sciences Center
  31. ;                                   10701 Lyndale Avenue South
  32. ;                                   Bloomington, MN  55420
  33. ;******************************************************************************
  34.  
  35.  
  36.  
  37. ;;; A KERMIT server is a KERMIT program running remotely with no "user
  38. ;;; interface". All commands to the server arrive in packets from the
  39. ;;; local KERMIT....
  40.  
  41. ;;; Between transactions, a KERMIT server waits for packets containing
  42. ;;; server commands. The packet sequence number is always set back to 0
  43. ;;; after a transaction. A KERMIT server in command wait should be
  44. ;;; looking for packet 0. Certain server commands will result in the
  45. ;;; exchange of multiple packets. Those operations proceed exactly like
  46. ;;; file transfer.
  47.  
  48. ;;; Server operation must be implemented in two places: in the server
  49. ;;; itself, and in any KERMIT program that will be communicating with a
  50. ;;; server. The server must have code to read the server commands from
  51. ;;; packets and respond to them. the user KERMIT must have code to parse
  52. ;;; commands to send requests to servers, to form the server command
  53. ;;; packets, and to handle the responses to those server commands....
  54.  
  55. ;;; Server commands are as follows:
  56. ;;; S  Send Initiate (exchange parameters, server waits for a file).
  57. ;;; R  Receive Initiate (ask the server to send the specified files).
  58. ;;; I  Initialize (exchange parameters)....
  59. ;;; G  Generic KERMIT Command.  Single character in data field (possibly
  60. ;;;    followed by operands, shown in {braces}, optional fields in
  61. ;;;    [brackets]) specifies the command:
  62. ;;;
  63. ;;;    ...
  64. ;;;    L  Logout, Bye
  65. ;;;    F  Finish (Shut down the server, but don't logout).
  66. ;;;    ...
  67.  
  68. ;;; Between transactions, when the server has no tasks pending, it may
  69. ;;; send out periodic NAKs (always with type 1 checksums) to prevent a
  70. ;;; deadlock in case a command was sent to it but was lost.  These NAKs
  71. ;;; can pile up in the local "user" KERMIT's unput buffer (if it has
  72. ;;; one), so the user KERMIT should be prepared to clear its input
  73. ;;; buffer before sending a command to a server.
  74.  
  75.  
  76.  
  77. (declare (special kstate)                         ;in calls.lisp
  78.            )
  79.  
  80. (defconst *timint-for-server-wait* 45 "Amount of time to wait before timeout when in server mode")
  81.  
  82.  
  83. (defun kermit-remote-server (tty &optional working-directory)
  84.   (send kstate ':remote-server tty working-directory))
  85.  
  86.  
  87. (defun receive-file-header (packet num &aux ourfilename)
  88.   num
  89.   (multiple-value-bind (ignore num ignore data) (rpack)
  90.     data
  91.     (cond ((not (= num *packet-number*))
  92.              #\A)
  93.             (t (setq ourfilename (string-for-kermit-outfile packet))
  94.                (cond ((setq *fp* (open-file-out-or-not ourfilename))
  95.                         (format interaction-pane "~&Receiving ~A as ~A"
  96.                                   packet
  97.                                   ourfilename)
  98.                         (or *remote* (update-status-label ourfilename nil))
  99.                         (spack #\Y *packet-number* 0 nil)
  100.                         (setq *oldtry* *numtry*)
  101.                         (setq *numtry* 0)
  102.                         (bump-packet-number)
  103.                         #\D)
  104.                        (t (format interaction-pane "~&Cannot create ~S" packet)
  105.                                                             ;experimental error packet sending--mhd
  106.                           (spack #\E *packet-number* 45     ;
  107.                                    "Kermit-Q: Error in file header.")
  108.                           #\A))))))
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115. (DEFUN SERVER-COMMAND-WAIT ()
  116.  
  117.   (CONDITION-CASE ()                                        ;; in case of a sys:abort condition
  118.                                                             ;; just return nil; thus they just
  119.                                                             ;; abort out of kermit server, not
  120.                                                             ;; the login server too.
  121.  
  122.  
  123.                                                             ;; PS-terminal doesn't die then!!
  124.  
  125.   (LOOP INITIALLY (AND *DEBUG* (FORMAT T "~&Entering Kermit Server Command Wait...~%"))
  126.           WITH *TIMINT* = *TIMINT-FOR-SERVER-WAIT*
  127.           WITH *REMOTE* = T
  128.           WITH *STATE* = #\W                      ;my own name: WAIT
  129.           FOR *BYTECOUNT* = NIL
  130.           FOR *NUMTRY* = 0 AND *PACKET-NUMBER* = 0 AND *OLDTRY* = 0
  131.  
  132.           DOING
  133.           (FLUSHINPUT)
  134.           (MULTIPLE-VALUE-BIND (TYPE NUM LEN DATA) (RPACK) LEN
  135.             (SELECT TYPE
  136.               (#\S (COND ((EQ NUM 0)              ;you do the job of Rinit and Rfile
  137.                               (RPAR DATA)                   ;here, then jump into Recsw at Rdata
  138.                               (SETQ DATA (SPAR DATA))
  139.                               (SPACK #\Y *PACKET-NUMBER* 6 DATA)
  140.                               (SETQ *OLDTRY* *NUMTRY*)
  141.                               (SETQ *NUMTRY* 0)
  142.                               (BUMP-PACKET-NUMBER)
  143.                               (RECEIVE-FILE-HEADER DATA NUM)
  144.                               (SETQ DATA-XFER-START-TIME (TIME) *BYTECOUNT* 0)
  145.                               (RECSW #\D *PACKET-NUMBER* *NUMTRY*))))
  146.               (#\R (COND ((NOT (= *PACKET-NUMBER* NUM)))
  147.                            (T
  148.                                 (COND ((SETQ *FILELIST* (KERMIT-FILELIST DATA)
  149.                                                *FILNAM* (CAR *FILELIST*))
  150.                                          (IF *DEBUG* (FORMAT INTERACTION-PANE
  151.                                                                  "Files to send:~A" *FILELIST*))
  152.                                          (BUMP-PACKET-NUMBER)
  153.                                          (SENDSW #\S *PACKET-NUMBER*))
  154.                                         (T (SPACK #\E *PACKET-NUMBER*
  155.                                                     25 "Error: File Not Found"))))))
  156.               (#\G (COND ((EQ LEN 1)
  157.                               (COND ((EQ (AREF DATA 0) #\L) ;generic logout
  158.                                      (SPACK #\Y *PACKET-NUMBER* 0 NIL)
  159.                                      (AND *DEBUG* (FORMAT T "...logout on ~A"
  160.                                                                 (time:print-current-date nil)))
  161.                                      (RETURN ':LOGOUT))
  162.                                     ((EQ (AREF DATA 0) #\F) ;generic finish
  163.                                      (SPACK #\Y *PACKET-NUMBER* 0 NIL)
  164.                                      (AND *DEBUG* (FORMAT T "...finishing on ~A"
  165.                                                                 (time:print-current-date nil)))
  166.                                      (RETURN NIL))))))
  167.  
  168.               (*FALSE* (SPACK #\A *PACKET-NUMBER* 0 NIL))
  169.  
  170.               (:OTHERWISE
  171.                (SPACK #\E *PACKET-NUMBER* 60
  172.                         "unimplemented server command                               "))))
  173.  
  174.   )
  175.     (SYS:ABORT NIL)))
  176.