home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / tiexplorer.zip / stlnet.lsp < prev    next >
Text File  |  1986-09-22  |  19KB  |  490 lines
  1.  
  2. ;;; -*- Mode:LISP; Package:TELNET; Base:8; Patch-File:T -*-
  3.  
  4. ;;;                           RESTRICTED RIGHTS LEGEND
  5.  
  6. ;;;Use, duplication, or disclosure by the Government is subject to
  7. ;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
  8. ;;;Technical Data and Computer Software clause at 52.227-7013.
  9. ;;;
  10. ;;;                     TEXAS INSTRUMENTS INCORPORATED.
  11. ;;;                              P.O. BOX 2909
  12. ;;;                           AUSTIN, TEXAS 78769
  13. ;;;                                 MS 2151
  14. ;;;
  15. ;;; Copyright (c) 1986, Texas Instruments Incorporated.  All rights reserved.
  16. ;;; Copyright (c) 1986, Sperry Corporation.  All rights reserved.
  17.  
  18. ;;; NOTES:
  19. ;;;   This code will need review and possibly reimplementation for
  20. ;;;   Release 3.0 because of GENI's release.
  21.  
  22. ;;; To eliminate compilation warnings, create required packages
  23. ;;; if they don't already exist ;; BAC
  24. (EVAL-WHEN (EVAL COMPILE)
  25.   (PKG-FIND-PACKAGE "KERMIT" T)
  26.   (PKG-FIND-PACKAGE "IP" T))
  27.  
  28. ;;; MAKE-SERIAL-STREAM-FROM-CVV
  29. ;;;
  30.  
  31. (DEFVAR  *BAUD*                  #10r1200    "Baud rate.")
  32. (DEFVAR  *FORCE-OUTPUT*          T           "Force output.")
  33. (DEFVAR  *NUMBER-OF-DATA-BITS*   #10r8       "Number of data bits.")
  34. (DEFVAR  *NUMBER-OF-STOP-BITS*   #10r2       "Number of stop bits.")
  35. (DEFVAR  *PARITY*                :NONE       "Parity.")
  36. (DEFVAR  *XON-XOFF-PROTOCOL*     NIL         "XON-XOFF protocol.")
  37. (DEFVAR  *ASCII-CHARACTERS*      NIL         "Ascii-characters.")
  38. (DEFVAR  *INPUT-BUFFER-SIZE*     #10r180     "Input buffer.")
  39. (DEFVAR  *OUTPUT-BUFFER-SIZE*    #10r180     "Output buffer.")
  40.  
  41. (DEFUN MAKE-SERIAL-STREAM-FROM-CVV ()
  42.   "Produces a CVV to select serial stream parameters, then creates a stream
  43. using SI:MAKE-SERIAL-STREAM.  Returns the created stream."
  44.   (DECLARE (SPECIAL *BAUD* *FORCE-OUTPUT* *NUMBER-OF-DATA-BITS*
  45.             *NUMBER-OF-STOP-BITS* *PARITY* *XON-XOFF-PROTOCOL*
  46.             *ASCII-CHARACTERS* *INPUT-BUFFER-SIZE* *OUTPUT-BUFFER-SIZE*))
  47.  
  48.   (TV:CHOOSE-VARIABLE-VALUES
  49.     '((*BAUD* "Baud rate"
  50.           :DOCUMENTATION "Line speed.  (Most asynchronous modems use 1200 or 300)"
  51.           :CHOOSE (#10r300 #10r1200 #10r2400 #10r4800 #10r9600 #10r19200))
  52.       (*FORCE-OUTPUT* "Force output"
  53.               :DOCUMENTATION "YES: send characters immediately.  NO: send characters when buffer is full."
  54.               :BOOLEAN)
  55.       (*NUMBER-OF-DATA-BITS* "Data Bits"
  56.                  :DOCUMENTATION "Number of data bits."
  57.                  :CHOOSE (#10r5 #10r6 #10r7 #10r8))
  58.       (*NUMBER-OF-STOP-BITS* "Stop Bits"
  59.                  :DOCUMENTATION "Number of stop bits."
  60.                  :CHOOSE (1 2))
  61.       (*PARITY* "Parity"
  62.         :DOCUMENTATION "Type of parity to use."
  63.         :CHOOSE (:NONE :EVEN :ODD))
  64.       (*XON-XOFF-PROTOCOL* "XON-XOFF"
  65.                :DOCUMENTATION "YES: use XON-XOFF characters.  NO: don't implement XON-XOFF characters."
  66.                :BOOLEAN)
  67.       (*ASCII-CHARACTERS* "Translate ASCII"
  68.               :DOCUMENTATION "YES: Automatically translate between ASCII and LISPM characters.  NO: don't translate."
  69.               :BOOLEAN)
  70.       (*INPUT-BUFFER-SIZE* "Input Buffer size"
  71.                :DOCUMENTATION "Size (in words) to allocate for the input buffers."
  72.                :NUMBER)
  73.       (*OUTPUT-BUFFER-SIZE* "Output Buffer size"
  74.                 :DOCUMENTATION "Size (in words) to allocate for the output buffers."
  75.                 :NUMBER))
  76.     :NEAR-MODE '(:POINT 500 400)
  77.     :LABEL "Choose Serial Stream Parameters"
  78.     :MARGIN-CHOICES '("Do It"))
  79.  
  80.   (SI:MAKE-SERIAL-STREAM
  81.     :BAUD *BAUD*
  82.     :FORCE-OUTPUT *FORCE-OUTPUT*
  83.     :NUMBER-OF-DATA-BITS *NUMBER-OF-DATA-BITS*
  84.     :NUMBER-OF-STOP-BITS *NUMBER-OF-STOP-BITS*
  85.     :PARITY *PARITY*
  86.     :XON-XOFF-PROTOCOL *XON-XOFF-PROTOCOL*
  87.     :ASCII-CHARACTERS *ASCII-CHARACTERS*
  88.     :INPUT-BUFFER-SIZE *INPUT-BUFFER-SIZE*
  89.     :OUTPUT-BUFFER-SIZE *OUTPUT-BUFFER-SIZE*))
  90.  
  91.  
  92. ;;; Autodial
  93. ;;;
  94.  
  95. (DEFVAR  *AUTODIAL-PREFIX*  "ATDT"            "Prefix to send to autodialer modem")
  96. (DEFVAR  *AUTODIAL-NUMBER*  "8,8005551212"    "Number to dial")
  97.  
  98. (DEFUN AUTODIAL (&KEY
  99.          (PREFIX *AUTODIAL-PREFIX*)
  100.          (NUMBER *AUTODIAL-NUMBER*)
  101.          STREAM                ; could bind this to *SERIAL-PORT-OWNER*
  102.          MENU
  103.          VERBOSE)
  104.   "Dial a number using an autodialer.  If :NUMBER is not specified,
  105. use the last number dialed.  If :MENU is specified, display a menu
  106. to select the number to dial."
  107.  
  108.   (LET
  109.     ((PRE PREFIX)
  110.      (NUM NUMBER)
  111.      (CONTINUE T))
  112.     (DECLARE (SPECIAL PRE NUM))
  113.     (WHEN MENU
  114.       (SETQ CONTINUE
  115.         (*CATCH 'END-CVV
  116.           (TV:CHOOSE-VARIABLE-VALUES
  117.         '((PRE
  118.             "Prefix"
  119.             :DOCUMENTATION "Modem's autodial prefix (e.g., ATDT)."
  120.             :STRING)
  121.           (NUM
  122.             "Number"
  123.             :DOCUMENTATION "Telephone number to dial.  A comma <,> causes a 2 second wait."
  124.             :STRING))
  125.         :NEAR-MODE '(:POINT 500 400)
  126.         :LABEL "Serial Port Autodial"
  127.         :MARGIN-CHOICES '("Do It" ("Quit" (*THROW 'END-CVV NIL))))
  128.           T)))
  129.  
  130.     (WHEN CONTINUE
  131.       (IF (NOT (STREAMP STREAM))
  132.       (WHEN VERBOSE
  133.         (FORMAT T "~&Stream <~A> is not a valid stream." STREAM))
  134.       (PROGN
  135.         (SETQ *AUTODIAL-PREFIX* PRE)
  136.         (SETQ *AUTODIAL-NUMBER* NUM)
  137.         (SEND STREAM :CLEAR-INPUT)
  138.         (SEND STREAM :CLEAR-OUTPUT)
  139.         (SEND STREAM :LINE-OUT (FORMAT NIL "~A~A" *AUTODIAL-PREFIX* *AUTODIAL-NUMBER*))
  140.         (PROCESS-WAIT-WITH-TIMEOUT
  141.           "Dialing..."
  142.           3600
  143.           (FUNCTION (LAMBDA (STREAM)
  144.               (SEND STREAM :GET :DATA-CARRIER-DETECT)))
  145.           STREAM)
  146.         (SEND STREAM :CLEAR-INPUT)
  147.         (SEND STREAM :CLEAR-OUTPUT)
  148.         T)))))
  149.  
  150.  
  151. ;;; RUN-SCRIPT
  152. ;;;
  153.  
  154. (DEFUN RUN-SCRIPT (script &KEY (stream *TERMINAL-IO*) (debug-stream *DEBUG-IO*)
  155.            &AUX (response (make-array 5000. :type art-string :fill-pointer 0))
  156.                 (return-value nil))
  157.   "Simulate an interactive user session with a script.
  158. SCRIPT is a list of the form ((SEND RECEIVE ACTION)...).
  159. SEND is a list of a format control string and its arguments that specify the output to be sent to STREAM.
  160. RECEIVE is a list of a format control string and its arguments that specify the input expected from STREAM.
  161. ACTION specifies what to do if the data received doesn't contain the string specified by RECEIVE.
  162.   It can be :L (loop forever), :Q (quit,the default), a number indicating the number of times to loop and
  163.   before quitting, or a list of a format control string and its arguments that specify an alternative output
  164.   to be sent to STREAM.
  165. For each element of SCRIPT, first SEND is sent to STREAM, then STREAM is checked for input that matches
  166.   RECEIVE, if it is found, the next form is processed, else, the ACTION is processed, and STREAM is again
  167.   checked for input that matches RECEIVE.
  168. STREAM is an I/O stream.
  169. When DEBUG-STREAM is specified, it should be an I/O stream where debug info is sent.
  170. RUN-SCRIPT returns :SUCCESSFUL if the last RECEIVE in SCRIPT was successful, :UNSUCCESSFUL otherwise."
  171.  
  172.   (CHECK-ARG SCRIPT LISTP "a list")
  173.   (CHECK-ARG STREAM STREAMP "a stream")
  174.   (CHECK-ARG DEBUG-STREAM STREAMP "a stream")
  175.   (DOLIST (item script return-value)
  176.     (SETQ return-value
  177.       (LET* ((send (FIRST item))
  178.          (receive (SECOND item))
  179.          (action (THIRD item)))
  180.         (DO ()
  181.         (NIL)
  182.           (WHEN send
  183.         (LET ((formatted-string (APPLY #'FORMAT NIL (CAR send) (CDR send))))
  184.           (SEND stream :STRING-OUT formatted-string)
  185.           (WHEN debug-stream (FORMAT debug-stream "~%Sending:~A" formatted-string))))
  186.           (IF receive
  187.           (PROGN
  188.             (SETF (FILL-POINTER response) 0)
  189.             (WHEN debug-stream (FORMAT debug-stream "~%Receiving:"))
  190.             (DO ((char (SEND stream :TYI-WITH-TIMEOUT 1800.)(SEND stream :TYI-WITH-TIMEOUT 1800.)))
  191.             ((NULL char) T)
  192.               (WHEN (> char 0)
  193.             (SETF (AREF response (FILL-POINTER response)) (LOGAND char #o177))
  194.             (INCF (FILL-POINTER response))
  195.             (WHEN debug-stream (FORMAT debug-stream "~C" (LOGAND char #o177)))))
  196.             (WHEN debug-stream (FORMAT debug-stream "~%Searching:~A" (APPLY #'FORMAT NIL (CAR receive) nil)))
  197.             (SEND stream :CLEAR-INPUT)
  198.             (IF (STRING-SEARCH (APPLY #'FORMAT NIL (CAR receive) (CDR receive)) response)
  199.             (RETURN :SUCCESSFUL)
  200.             (IF action
  201.                 (IF (EQ action :Q)
  202.                 (RETURN :UNSUCCESSFUL)
  203.                 (IF (INTEGERP action)
  204.                     (IF (< action 1)
  205.                     (RETURN :UNSUCCESSFUL)
  206.                     (DECF action))
  207.                     (IF (LISTP action)
  208.                     (SETQ send action)
  209.                     (UNLESS (EQ action :L)
  210.                       (FERROR t "The third element, ACTION, of an element of SCRIPT, ~A, was ~A, which is not :Q, :L, an integer, or a list." ITEM ACTION)))))
  211.                 (RETURN :UNSUCCESSFUL))))
  212.           (RETURN :SUCCESSFUL)))))))
  213.  
  214.  
  215. ;;; Serial stream flavor addition: TYI-WITH-TIMEOUT
  216.  
  217. SI:(DEFMETHOD (SERIAL-STREAM-MIXIN :TYI-WITH-TIMEOUT) (INTERVAL-IN-60THS)
  218.      (IF (SI:PROCESS-WAIT-WITH-TIMEOUT
  219.        "Serial Waiting"
  220.        INTERVAL-IN-60THS
  221.        (FUNCTION (LAMBDA (STREAM) (SEND STREAM :INPUT-CHARS-AVAILABLE-P)))
  222.        SELF)
  223.      (SEND SELF :TYI)))
  224.  
  225.  
  226. ;;;  From sys:telnet;basic-telnet (sort of):
  227. ;;;
  228. ;;;  This method is almost identical to (:method basic-telnet :net-output),
  229. ;;;  which vt100-frame inherits, except that this version doesn't
  230. ;;;  automatically send a linefeed after a carriage-return unless the
  231. ;;;  connection is a chaos connection.  Thus, it preserves the existing
  232. ;;;  behavior for normal connections (and it seems to be the right thing)
  233. ;;;  while removing the spurious linefeed from serial-port connections.
  234. ;;;  There may well be a better way to do it.  - pf, Sept 11, 1985
  235. (DEFMETHOD (vt100-frame :NET-OUTPUT) (ch)
  236.   (lock-output
  237.     (when (ldb-test 1701 ch)            ;An NVT char from TELNET-KEYS
  238.       (if new-telnet-p
  239.       (send stream ':tyo NVT-IAC))
  240.       (setq ch (ldb 0010 ch)))
  241.     (send stream ':tyo ch)
  242.     (cond ((and (typep connection 'chaos:conn) (= ch 15))
  243.        (send stream ':tyo 12))        ;CR is two chars, CR LF
  244.       ((and (= ch NVT-IAC) new-telnet-p)
  245.        (send stream ':tyo NVT-IAC)))))      ;IAC's must be quoted
  246.  
  247.  
  248. ;;; Autodial command method
  249. ;;;
  250.  
  251. (DEFCOMMAND (VT100-FRAME :AUTODIAL) ()
  252.   '(:DESCRIPTION "Display a pop-up menu with commands to use an auto dialer."
  253.          :NAMES ("Autodial"))
  254.   (DECLARE (SPECIAL *AUTODIAL-PREFIX* *AUTODIAL-NUMBER*))
  255.   (COND (CONNECTION
  256.      (IF (NOT (FUNCTIONP 'AUTODIAL))
  257.          (FORMAT T "~&AUTODIAL not loaded. Can't Autodial."))
  258.          (FUNCALL 'AUTODIAL :STREAM STREAM :MENU T))
  259.     (T
  260.      (FORMAT T "~&Not connected.  Can't Autodial.")
  261.      (WHEN (NOT UCL:PREEMPTING?)
  262.        (SEND SELF ':HANDLE-PROMPT)))))
  263.  
  264.  
  265. ;;; Kermit command method
  266. ;;;
  267.  
  268. (DEFCOMMAND (VT100-FRAME :KERMIT) ()
  269.   '(:DESCRIPTION "Display a pop-up menu of KERMIT file-transfer commands."
  270.          :Names ("Kermit"))
  271.   (COND (CONNECTION
  272.      (IF (NOT (FUNCTIONP 'KERMIT:INTERACTIVE-KERMIT))
  273.          (FORMAT T "~&KERMIT not loaded. Can't run KERMIT.")
  274.          (LET
  275.            ((VT100-SUBSTITUTE (SEND SELF :SELECTION-SUBSTITUTE))
  276.         (KERMIT-SUPERIOR (SEND KERMIT:*KERMIT-FRAME* :SUPERIOR))
  277.         (MENU-PANE (SEND SELF :GET-PANE 'MENU-TELNET)))
  278.            (UNWIND-PROTECT
  279.            (LET
  280.              ((FORM NIL))
  281.              (SEND TYPEOUT-PROCESS :ARREST-REASON 'KERMIT)    ; Stop the vt100 process from using serial stream
  282.              (SETQ FORM (KERMIT:INTERACTIVE-KERMIT STREAM NIL)) ; Get the Kermit arguments
  283.              (WHEN FORM
  284.                (SETF (SEND MENU-PANE :INVISIBLE-TO-MOUSE-P) T)    ; Make the vt100 menu items non-mousable
  285.                (SEND KERMIT:*KERMIT-FRAME* :SET-SUPERIOR SELF)
  286.                (SEND SELF :SET-SELECTION-SUBSTITUTE KERMIT:*KERMIT-FRAME*)    ; Attach the kermit frame to vt100
  287.                (EVAL FORM)))        ; Call Kermit
  288.          (SEND TYPEOUT-PROCESS :REVOKE-ARREST-REASON 'KERMIT)    ; Reallow vt100 to use serial
  289.          (SETF (SEND MENU-PANE :INVISIBLE-TO-MOUSE-P) NIL)    ; Make menu items mousable
  290.          (SEND SELF :SET-SELECTION-SUBSTITUTE VT100-SUBSTITUTE)
  291.          (SEND KERMIT:*KERMIT-FRAME* :SET-SUPERIOR KERMIT-SUPERIOR)))))
  292.     (T
  293.      (FORMAT T "~&Not connected.  Can't run KERMIT.")
  294.      (WHEN (NOT UCL:PREEMPTING?)
  295.        (SEND SELF ':HANDLE-PROMPT)))))
  296.  
  297.  
  298. ;;; Local echo command method
  299. ;;;
  300.  
  301. (DEFCOMMAND (vt100-frame :LOCAL-ECHO-COMMAND) ()
  302.   '(:DESCRIPTION "Toggle local echo mode of Vt100 screen pane."
  303.          :NAMES ("Local Echo"))
  304.   (SETF ECHO-FLAG (IF ECHO-FLAG NIL T))
  305.   (FORMAT T "~&Local echo now ~A.~%"
  306.       (IF ECHO-FLAG "off" "on"))                  ; echo-flag=T means local echo is off!
  307.   (WHEN (AND (NULL CONNECTION) (NOT UCL:PREEMPTING?))
  308.       (SEND SELF ':HANDLE-PROMPT)))
  309.  
  310.  
  311. ;;; Redefine the VT100 layout and menu
  312. ;;;
  313.  
  314. (DEFFLAVOR VT100-TELNET-MENU
  315.        (TV:INVISIBLE-TO-MOUSE-P)
  316.        (TV:DYNAMIC-ITEM-LIST-MIXIN TV:COMMAND-MENU)
  317.   (:SETTABLE-INSTANCE-VARIABLES TV:INVISIBLE-TO-MOUSE-P)
  318.   (:DEFAULT-INIT-PLIST
  319.     :LABEL (LIST :TOP :FONT FONTS:HL12B :STRING "VT100 & Telnet Commands")
  320.     :ROWS 3                       ; BAC changed from 2
  321.     :COLUMNS 7                    ; BAC changed from 7
  322.     :VSP 8.
  323.     :FONT-MAP (list fonts:MEDFNT)
  324.     :LABEL-BOX-P nil
  325.     :ITEM-LIST nil)
  326.   (:DOCUMENTATION :COMBINATION
  327.     "Command menu needs dynamic-item-list-mixin for UCL."))
  328.  
  329. (BUILD-COMMAND-TABLE 'VT100-TELNET-CMD-TABLE 'VT100-FRAME
  330.   '((:method telnet-frame :exit-command)        
  331.     (:method telnet-frame :disconnect-command)
  332.     (:method telnet-frame :interrupt-process-command)
  333.     :send-answerback-command
  334.     :reverse-video-command
  335.     :reset-command
  336.     :escape-processing-command
  337.     (:method telnet-frame :quit-and-disconnect-command)
  338.     (:method telnet-frame :status-command)
  339.     (:method telnet-frame :abort-output-command)
  340.     :column-command
  341.     :truncate-command
  342.     :set-vt100-lines
  343.     :network-help-command
  344.     (:method telnet-frame :clear-input-command)
  345.     (:method vt100-frame :autodial)                   ; BAC
  346.     (:method vt100-frame :kermit)                     ; BAC
  347.     :local-echo-command                               ; BAC
  348.     )
  349.   :INIT-OPTIONS
  350.   '(:NAME "Vt100 & Telnet Commands"
  351.       :DOCUMENTATION "The Vt100 & Telnet commands."))
  352.  
  353. (BUILD-MENU 'UCL-VT100-TELNET-MENU 'VT100-FRAME
  354.   :DEFAULT-ITEM-OPTIONS
  355.   '(:FONT FONTS:MEDFNT)
  356.   :ITEM-LIST-ORDER
  357.     '( ;Row 1
  358.       (:method telnet-frame :exit-command)        
  359.       (:method telnet-frame :disconnect-command)
  360.       (:method telnet-frame :interrupt-process-command)
  361.       :send-answerback-command
  362.       :reverse-video-command
  363.       :reset-command
  364.       :escape-processing-command
  365.        ;Row 2
  366.       (:method telnet-frame :quit-and-disconnect-command)
  367.       (:method telnet-frame :status-command)
  368.       (:method telnet-frame :abort-output-command)
  369.       :column-command
  370.       :truncate-command
  371.       :set-vt100-lines
  372.       :network-help-command
  373.        ;Row 3                                           ; BAC
  374.       (:method vt100-frame :autodial)                   ; BAC
  375.       (:method vt100-frame :kermit)                     ; BAC
  376.       :local-echo-command                               ; BAC
  377.       ))
  378.  
  379.  
  380. ;;; The following add Serial streams to the TELNET and VT100 base system.
  381. ;;;
  382.  
  383. (DEFVAR telnet:file NIL)
  384.  
  385. (DEFMETHOD (vt100-frame :TYPEOUT-TOP-LEVEL) (&aux (terminal-io vt100-pane))
  386.   "Redefines (:METHOD BASIC-NVT :TYPOUT-TOP-LEVEL) to use :PROCESS-ESCAPE"
  387.   (declare (special telnet:file))
  388.   (process-wait "Never-open" #'car (locate-in-instance self 'connection))
  389.   (ucl:ignore-errors-query-loop
  390.     (condition-bind (((sys:remote-network-error
  391.                ip:illegal-connection
  392.                ip:connection-reset) 'typeout-net-error self))
  393.       (do-forever
  394.     (do ((ch (nvt-neti) (send stream :tyi-no-hang)))
  395.         ((null ch) (if output-buffer (send self :force-output)))
  396.       (when (not (null telnet:file))
  397.         (send telnet:file :tyo ch))
  398.       (send self :process-escape
  399.         (IF (EQ CONNECTION T)
  400.             (logand #b01111111 ch)   ; if we don't strip parity we get an error ;; BAC
  401.             ch)))))))
  402.  
  403.  
  404. ;;; This method should return the network connection. This can
  405. ;;; be a stream or a connection object depending on the network type.
  406. ;;;
  407. ;;; The method :NETWORK-NEW-CONNECTION is not needed for serial telnet.
  408. (DEFMETHOD (basic-nvt :case :network-new-connection :serial)
  409.        (host &optional (contact "TELNET") (window nil) )
  410.   window contact host nil)                                       ; BAC to eliminate compile warnings
  411.  
  412. (RECOMPILE-FLAVOR 'vt100-frame :NETWORK-NEW-CONNECTION)
  413.  
  414. ;;; Return nil if the connection is not connected.
  415. (DEFMETHOD (basic-nvt :case :network-connected-p :serial)()
  416.   (and stream connection))
  417.  
  418. (RECOMPILE-FLAVOR 'vt100-frame :NETWORK-CONNECTED-P)
  419.  
  420. ;;; The method :NETWORK-NEW-CONNECTION passes the arguement which we
  421. ;;; ignore for the serial implementation.
  422. ;;;
  423. ;;; Set stream to be the serial stream.
  424. ;;; Connection should be something non nil, but does not need to be a connection.
  425. ;;; The connection instance variable is used by CHAOSNET.
  426. (DEFMETHOD (basic-nvt :case :set-connection :serial) (ignore)
  427.   (SEND typein-process :reset)
  428.   (SEND typeout-process :reset)
  429.   (SETF stream (MAKE-SERIAL-STREAM-FROM-CVV))
  430. ;;  (SEND self :gobble-greeting)
  431.   (SETF connection t)
  432.   (SETQ black-on-white nil))
  433.  
  434. (RECOMPILE-FLAVOR 'vt100-frame :SET-CONNECTION)
  435.  
  436. ;;; This method should close the serial TELNET connection.
  437. ;;; Make sure to set both instance variables, STREAM and CONNECTION,
  438. ;;; to nil.
  439. (DEFMETHOD (basic-nvt :case :network-disconnect :serial)()
  440.   (WHEN stream
  441.     (SEND stream :close)
  442.     (SETF stream nil
  443.       connection nil)))
  444.  
  445. (RECOMPILE-FLAVOR 'vt100-frame :NETWORK-DISCONNECT)
  446.  
  447. ;;; This method should indicate the connection state.
  448. ;;; It would be nice if you could signal errors in the connection
  449. ;;; state by throwing 'NVT-DONE because TELNET will try to eloquently
  450. ;;; close the connection.
  451. (defmethod (basic-nvt :case :check-connection-state :serial)()
  452.   (unless stream
  453.       (*THROW 'TELNET:NVT-DONE "Stream never opened.")))
  454.  
  455. (RECOMPILE-FLAVOR 'vt100-frame :CHECK-CONNECTION-STATE)
  456.  
  457. ;;; Send the TELNET command interrupt process (IP) to the remote host.
  458. ;;; (Note: IP should not be confused with the acronym for a well known
  459. ;;; network type.)
  460. ;;; An IP command is defined to be the following two bytes: NVT-IAC NVT-IP.
  461. ;;; Many implementations send the IP in urgent mode as the following sequence of bytes
  462. ;;; NVT-IAC, NVT-IP, NVT-IAC, NVT-DM.  This is technically a SYNC signal but
  463. ;;; most systems handle no differently. The TCP/IP network sends a SYNC signal
  464. ;;; in urgent mode, the CHAOS network sends a SYNC signal not in urgent mode
  465. ;;; because there is no concept of urgent data, Wollongong sends just an IP command
  466. ;;; and the MIT PC software sends a SYNC signal in urgent mode.
  467. ;;;
  468. ;;; You may choose to send a SYNC signal or just IP command I think it makes little
  469. ;;; difference (except with Wollongong which can't handle SYNC signals successfully).
  470. ;;; However, since serial streams do not have a concept of
  471. ;;; urgent mode I choose to send a SYNC signal.
  472. (DEFMETHOD (basic-telnet :case :network-send-ip :serial)()
  473.   (lock-output
  474.     (SEND stream :tyo NVT-IAC)
  475.     (SEND stream :tyo NVT-IP)
  476.     (SEND stream :tyo NVT-IAC)
  477.     (SEND stream :tyo NVT-DM)
  478.     ))
  479.  
  480. (RECOMPILE-FLAVOR 'vt100-frame :NETWORK-SEND-IP)
  481.  
  482. (UNLESS (MEMBER :serial protocols-supporting-telnet)
  483.   (PUSH :serial protocols-supporting-telnet))
  484.  
  485. ;;; This is a kludge to make serial telnet work correctly.
  486. ;;; If there were serial host objects then this would not
  487. ;;; be necessary.
  488. (setq default-network-type :serial)
  489.  
  490.