[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
in search of suggestions
Date: Fri, 9 Jun 89 11:10 EDT
From: barmar@Think.COM (Barry Margolin)
Date: Thu, 8 Jun 89 18:16 PDT
From: pwtc!hamscher@labrea.stanford.edu (Walter Hamscher)
The Select-T Program lets me dial up a remote host, log in, type
commands, look at the output, etc. I want to figure out what it would
take to have a program do the same thing.
...
The question is, how do I create a stream with that functionality? I
know that somewhere deep in the code for telnet:nvt-window there has to
be SOMETHING that creates a full duplex character stream, and does :tyi
and :tyo operations on it, but how do I create this beast outside of
Select-T ?
Unfortunately, the mechanisms used by the terminal program aren't that
simple. There are no streams you can just read and write characters
from/to.
Opening the connection is done with
(net:invoke-service-on-host :login host)
But this doesn't return a simple character stream. It returns a binary
stream (the raw network or serial connection), a list of input filters,
and a list of output filters. The filters are the names of flavors that
must be instantiated, and which do appropriate conversions depending on
the protocol being used. This facility is really designed only for the
terminal emulator to use: the input and output filters take as
parameters an input and output stream, respectively, and pass the
characters from the connection stream to these streams; the output
filters frequently perform window-specific operations (e.g., when the
ANSI emulator filter sees an escape sequence, it sends appropriate
messages to the window); and the input filters assume they're being used
within the terminal program, and look for the Network key.
And you can't just ignore the filters, because some of them perform
essential services. They do character set translation, and they handle
various aspects of the network protocols (e.g., the TELNET filter
recognizes TELNET IAC codes and implements option negotiation).
The Terminal emulator program has grown quite complex over the years,
and SYS:NETWORK;TELNET.LISP is probably one of the largest source files
in the Symbolics system. But this complexity isn't completely
gratuitous. The protocol modules need to be able to communicate with
the user interface routines, for instance, so that when a TELNET server
negotiates which end will do the echoing, the user interface will know
whether it should be echoing typein. And if you just did READ-CHARs on
the stream, what would you expect to get when a SUPDUP server sends the
CLEAR-SCREEN character?
barmar
I'm not that familiar with all the complexities of the terminal emulator
program but here's a hack I did to perform "background" operations on a
mentor (apollo) that is on our ethernet network. I've never tried it
with dial but I would assume that it would work since the stream
interface is based on TELNET:GET-LOGIN-CONNECTION. It allows me to do
things like (execute-mentor-command "ld" "mentor-ld") and the results of
executing the "ld" on the mentor are stored in a command history.
I believe I've included everything but if you decide to use this code
and discover I've left something out let me know and I'll send it to
you.
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: MENTAL; Base: 10 -*-
;;;
;;;****************************CADR*************************************
;;;
;;; (C) Copyright 1988,1989 American Microsystems, Inc.
;;; All rights reserved.
;;;
;;; The material contained in this program remains the property of
;;; American Microsystems, Inc., (AMI) and is copyrighted. It may
;;; not be reproduced, adapted, merged, translated, stored, or used
;;; without the prior written consent of the copyright owner.
;;;
;;; 7/13/88 kma -- Created.
;;;
;;;****************************CADR*************************************
;;;
;;;********************************************************************************
;;;********************************************************************************
;;;
;;; Stream support for mentor command execution facilities.
;;;
;;;********************************************************************************
;;;********************************************************************************
;;;********************************************************************************
;;;
;;; Globals
;;;
(defvar *mentor-telnet-stream-resource* ()
"Holds telnet streams to mentor for processing on the mentor in the background.")
(defvar *mentor-telnet-debug-echo-on* ()
"For printing out mentor's echo of what is sent to it.")
(defvar *mentor-prompt-string* "
$ "
"The famous mentor prompt.")
(defvar *mentor-last-return-string* nil
"The value of the last string returned by the mentor.")
(defvar *max-mentor-telnet-stream-resource-size* 10
"Maximum number of streams that can be connected to the mentor at once
(not necessarily active).")
;;;********************************************************************************
;;;
;;; Histories
;;;
(defflavor command-history
((name nil)
(pretty-name nil)
(history nil))
()
:initable-instance-variables
:readable-instance-variables
:writable-instance-variables
(:required-init-keywords :name)
(:conc-name history-))
(defmethod (:print-self command-history) (stream &rest ignore)
(si:printing-random-object (self stream :typep)
(prin1 name stream)))
(defun-in-flavor (strip-off-directory-garbage-if-necessary command-history) (string)
"Gets down to the raw command if there area any directory componenet specs in string."
(let ((dir-slash-idx (string-search "/" string)))
(if dir-slash-idx
(strip-off-directory-garbage-if-necessary (substring string (1+ dir-slash-idx)))
string)))
(defmethod (:init command-history :after) (&rest ignore)
"Sets the pretty-name of the command."
(setq pretty-name (strip-off-directory-garbage-if-necessary name)))
(defmethod (history-update command-history) (string)
"Updates the history with string."
(push string history))
(defmethod (history-format-latest command-history) (&optional (stream *standard-output*))
"Formats the last output to this history."
(format stream "~A" (first history)))
(defmethod (history-format-all command-history) (&optional (stream *standard-output*))
"Formats full history to stream."
(format stream "~%Full history for ~a command." pretty-name)
(loop for string in history
do (format stream "~2%~a" string)))
;;;********************************************************************************
;;;
;;; Resource flavor and support
;;;
(defflavor mentor-telnet-stream-resource
((inactive-streams nil)
(active-streams nil)
(histories nil))
()
:initable-instance-variables
:readable-instance-variables
:writable-instance-variables)
(defmethod (create-stream mentor-telnet-stream-resource)
(&optional (to-be-active-p t))
"Creates a stream and puts it on the active list if to-be-active-p is T(default). Otherwise
it puts it on the inactive list."
(let* ((host-object (si:parse-host 'mentor))
(stream (telnet:get-login-connection host-object))
success)
(unwind-protect
(progn
;; wait for ack from mentor
(send stream :input-wait)
;; Mentorrrr, we're ready.
(force-output-to-mentor stream)
;; Login
(read-mentor-response stream #'(lambda (x) (string-search "log in:" x)))
(mentor-line-out stream "user")
(read-mentor-response stream #'(lambda (x) (string-search "password" x)))
(force-output-to-mentor stream)
;; make sure mentor is ready
(read-mentor-response stream 'mentor-prompt-p)
(setq success t)
;; put the stream on the appropriate list
(if to-be-active-p
(push stream active-streams)
(push stream inactive-streams))
;; give the user his stream
stream)
(when (and stream (not success))
(send stream :close :abort)))))
(defmethod (kill-active-streams mentor-telnet-stream-resource) ()
"Kills all active streams. Use with caution, could waste the mentor."
(when (y-or-n-p "Do you really want to kill all the active mentor telnet streams and~
~%run the risk of thrashing the mentor (Ohhh, please, please!)? ")
(loop for stream in active-streams
do (send stream :close :abort))
(setq active-streams nil)))
(defmethod (kill-inactive-streams mentor-telnet-stream-resource) ()
"Kills all inactive streams."
(loop for stream in inactive-streams
do (send stream :close :abort))
(setq inactive-streams nil))
(defmethod (kill-all-streams mentor-telnet-stream-resource) ()
"Kills all streams."
(kill-active-streams self)
(kill-inactive-streams self))
(defmethod (get-stream mentor-telnet-stream-resource) ()
"Returns a stream to do mental things on (telnet to mentor)."
(or (loop for stream in inactive-streams ;re-use an inactive stream if possible
do (cond ((send stream :connected-p)
(return (make-stream-active self stream)))
(t (setq inactive-streams (delete stream inactive-streams)))))
;; otherwise create a new stream
(create-stream self)))
(defmethod (make-stream-inactive mentor-telnet-stream-resource) (stream)
"Puts stream back on the inactive list or kills it off if there are too many."
(setq active-streams (delete stream active-streams))
(if (< (length inactive-streams) *max-mentor-telnet-stream-resource-size*)
(pushnew stream inactive-streams)
(send stream :close :abort)))
(defmethod (make-stream-active mentor-telnet-stream-resource) (stream)
"Puts stream on the active list and deletes it from the inactive list."
(setq inactive-streams (delete stream inactive-streams))
(push stream active-streams)
stream)
(defun-in-flavor (ensure-no-args mentor-telnet-stream-resource) (command-string)
"Given a command-string for the mentor this makes sure that the args are stripped off, if
any."
(let ((space (string-search-char #\space command-string)))
(if space
(substring command-string 0 space)
command-string)))
(defmethod (execute-command mentor-telnet-stream-resource) (command notify)
"Execute command on the mentor. If :notify is in options we notify the user when done."
(let ((mentor-stream (get-stream self)))
(unwind-protect
(progn
;; make sure the stream is clear
(send mentor-stream :clear-input)
;; send the command
(mentor-line-out mentor-stream command)
;; read the response
(let ((response (string-left-trim command (read-mentor-response mentor-stream))))
;; notify when desired
(when notify
(tv:notify NIL
"The `~a' command has finished executing on the Mentor." command))
;; update the history, this also returns the last reponse for viewing
(update-command-history self command response)))
(make-stream-inactive self mentor-stream))))
(defun-in-flavor (find-command-history mentor-telnet-stream-resource)
(command &optional error-p)
"Finds the command history cell for a given command."
(loop with real-command = (ensure-no-args command)
for history in histories
when (or (string-equal real-command (history-name history))
(string-equal real-command (history-pretty-name history)))
return history
finally (if error-p
(error "Can't find the ~a command history." real-command)
(return
(let ((new-history
(make-instance 'command-history :name real-command)))
(push new-history histories)
new-history)))))
(defmethod (update-command-history mentor-telnet-stream-resource) (command string)
"Updates the history for the stream in the histories list. Returns the string for viewing."
(history-update (find-command-history command) string)
string)
(defmethod (show-command-history mentor-telnet-stream-resource) (command)
"Returns the last history string for the given command."
(history-format-all (find-command-history command t)))
(defmethod (show-last-response-to-command mentor-telnet-stream-resource) (command)
"Shows the last response given to command."
(history-format-latest (find-command-history command t)))
(defmethod (clear-history-for-command mentor-telnet-stream-resource) (command)
"Clears out the history for a command."
(setq histories (delete (find-command-history command t) histories)))
(defmethod (clear-histories mentor-telnet-stream-resource) ()
"Clears out entire histories slot."
(setq histories nil))
;;;********************************************************************************
;;;
;;; Interface to stream functions
;;;
(defun read-mentor-response (stream &optional (end-test 'mentor-prompt-p) timeout)
"Returns a response line or signals an error if timeout passes."
(let ((response (make-array 5 :element-type 'string-char :fill-pointer 0 :adjustable t)))
(loop with previous-ch ;needed for MENTOR-PROMPT-P function
doing (mentor-wait-for-input stream timeout) ;wait for mental mentor
for ch = (send stream :tyi-no-hang)
when ch
do (cond ((= ch 13) (vector-push-extend #\return response)) ;cr character
((= ch 10)) ;translation
(t (vector-push-extend (code-char ch) response)))
(when (funcall end-test response) ;test to return string
(when *mentor-telnet-debug-echo-on*
(format t "~%~a" response))
(return response))
(setq previous-ch ch))))
(defun mentor-prompt-p (string)
"Tests for mentor $ prompt."
(string-search *mentor-prompt-string* string :start2 (if (> (length string) 10)
(- (length string) 4)
0)))
(defun force-output-to-mentor (stream)
"Sends a CR to stream and then forces output."
(send stream :tyo 13)
(send stream :tyo 10)
(send stream :force-output))
(defun mentor-wait-for-input (stream &optional (timeout 3600))
"Waits for input from the mental mentor. Default timeout is 1 minute."
(if timeout
(send stream :input-wait "Waiting for Mental!" #'time-elapsed-p timeout (zl:time))
(send stream :input-wait "Waiting for Mental!"))
(unless (send stream :listen)
(error "Exceeded timeout.")))
(defun mentor-line-out (stream string)
"Sends string to stream with a cr appended to it and then forces the output."
(loop for char being the array-elements of string
do
(send stream :tyo (char-code char))
finally (force-output-to-mentor stream)))
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: MENTAL; Base: 10 -*-
;;;
;;;****************************CADR*************************************
;;;
;;; (C) Copyright 1988, 1989 American Microsystems, Inc.
;;; All rights reserved.
;;;
;;; The material contained in this program remains the property of
;;; American Microsystems, Inc., (AMI) and is copyrighted. It may
;;; not be reproduced, adapted, merged, translated, stored, or used
;;; without the prior written consent of the copyright owner.
;;;
;;; 7/14/88 kma -- Created.
;;;
;;;****************************CADR*************************************
;;;
;;;********************************************************************************
;;;********************************************************************************
;;;
;;; Top level interfaces to commands on the mentor.
;;;
;;;********************************************************************************
;;;********************************************************************************
;;;********************************************************************************
;;;
;;; For executing OS and arbitrary shell commands on the mentor.
;;;
(defun execute-mentor-command (command &optional process-name notify)
"Runs COMMAND on the mental mentor. Command must be a string which is the name of a
DOMAIN/OS command, a script file, or top-level command on the mentor. It must include
arguments if any. Currently there is no error detection interface for the mentor so
you must examine the string that gets returned to determine program success or failure.
If :notify is in options we notify the user when done. Currently no other options are
supported."
(declare (values mentor-response-string))
;; make sure the resource is there
(ensure-mentor-telnet-resource-manager)
;; execute the command
(if process-name
(progn
(format t "~%Starting the ~a background process." process-name)
(process-run-function
process-name #'execute-command *mentor-telnet-stream-resource* command notify))
(execute-command *mentor-telnet-stream-resource* command notify)))
(defun show-mentor-command-history (command-string)
"Shows history for command."
(ensure-mentor-telnet-resource-manager t)
(show-command-history *mentor-telnet-stream-resource* command-string))
(defun show-last-response-to-mentor-command (command-string)
"Shows mentor's last response to command."
(ensure-mentor-telnet-resource-manager t)
(show-last-response-to-command *mentor-telnet-stream-resource* command-string))
(defun ensure-mentor-telnet-resource-manager (&optional warn)
"Makes a resource manager for mentor telnet streams if necessary."
(unless *mentor-telnet-stream-resource*
(when warn
(format t "~%No mentor telnet stream resource yet, making..."))
(setq *mentor-telnet-stream-resource*
(make-instance 'mentor-telnet-stream-resource))
(when warn
(format t "~%Done.")))
*mentor-telnet-stream-resource*)
(defun clear-mentor-history-for-command (command)
"Clears out history for a command on the mentor telnet stream resource objece."
(clear-history-for-command *mentor-telnet-stream-resource* command))
(defun clear-mentor-histories ()
"Clears out all histories on the mentor telnet stream resource objece."
(clear-histories *mentor-telnet-stream-resource*))
(defun describe-mentor-resource ()
"Describes the mentor telnet stream resource object."
(send *mentor-telnet-stream-resource* :describe))
;;; -*- Mode: LISP; Syntax: Zetalisp; Package: ZWEI; Base: 10 -*-
;;;
;;;****************************CADR*************************************
;;;
;;; (C) Copyright 1988, 1989 American Microsystems, Inc.
;;; All rights reserved.
;;;
;;; The material contained in this program remains the property of
;;; American Microsystems, Inc., (AMI) and is copyrighted. It may
;;; not be reproduced, adapted, merged, translated, stored, or used
;;; without the prior written consent of the copyright owner.
;;;
;;; 7/21/88 kma -- Created.
;;;
;;;****************************CADR*************************************
;;;
;;;********************************************************************************
;;;********************************************************************************
;;;
;;; Some convenient MENTAL key bindings for zmacs.
;;;
;;;********************************************************************************
;;;********************************************************************************
(set-comtab
*standard-comtab*
'(#\hyper-super-c com-mentor-execute
#\hyper-super-shift-c com-background-mentor-execute
#\hyper-super-shift-h com-show-mentor-command-history
#\hyper-super-h com-show-last-response-to-mentor-command
#\hyper-super-shift-d com-mentor-describe-resource
#\hyper-super-k com-mentor-kill-inactive-streams
#\hyper-super-shift-k com-mentor-kill-active-streams
#\hyper-super-shift-a com-mentor-kill-all-streams)
'(("Mentor Execute" . com-mentor-execute)
("Mentor Execute In Background" . com-background-mentor-execute)
("Mentor Show Command History" . com-show-mentor-command-history)
("Mentor Show Last Response To Command" . com-show-last-response-to-mentor-command)
("Mentor Describe Resource" . com-mentor-describe-resource)
("CC" . com-mentor-c-compile)
("Mentor Kill Inactive Streams" . com-mentor-kill-inactive-streams)
("Mentor Kill Active Streams" . com-mentor-kill-active-streams)
("Mentor Kill All Streams" . com-mentor-kill-all-streams)
("Mentor Clear All Histories" . com-mentor-clear-histories)))
(defcom com-mentor-execute
"Prompts for a command to execute on the mentor." ()
(let* ((command (scl:accept
'sys:string :prompt "Enter a command to execute on the mentor")))
(format t "~a" (mental::execute-mentor-command command))
dis-none))
(defcom com-background-mentor-execute
"Prompts for a command to execute on the mentor. Does it in the background." ()
(let* ((command (scl:accept
'sys:string :prompt "Enter a command to execute on the mentor")))
(mental::execute-mentor-command command "Mental Execute" t)
dis-none))
(defcom com-mentor-c-compile
"Compiles a file on the mentor. Prompts for input and output file names.
Does compile in the background." ()
(let* ((input-file (scl:accept 'fs:apollo-pathname :prompt "Input file"))
(output-file
(scl:accept 'fs:apollo-pathname :prompt "Output file"
:default (cl:make-pathname :type "bin" :defaults input-file)))
(command (format nil "cc ~a -b ~a"
(send input-file :string-for-host)
(send output-file :string-for-host))))
(mental::execute-mentor-command command "Mental C Compile" t)
dis-none))
(defcom com-show-mentor-command-history
"Shows full history for command. Prompts for a command."
()
(let ((command (scl:accept 'sys:string :prompt "Enter command name")))
(mental::show-mentor-command-history command))
dis-none)
(defcom com-show-last-response-to-mentor-command
"Shows the last reponse the mentor had for a command. Prompts for a command."
()
(let ((command (scl:accept 'sys:string :prompt "Enter command name")))
(mental::show-last-response-to-mentor-command command))
dis-none)
(defcom com-mentor-describe-resource
"Describes the mentor telnet stream resource object."
()
(mental::describe-mentor-resource)
dis-none)
(defcom com-mentor-kill-active-streams
"Kills all active telnet background streams connected to the mentor."
()
(mental::kill-active-streams mental::*mentor-telnet-stream-resource*)
dis-none)
(defcom com-mentor-kill-inactive-streams
"Kills all inactive telnet background streams connected to the mentor."
()
(mental::kill-inactive-streams mental::*mentor-telnet-stream-resource*)
dis-none)
(defcom com-mentor-kill-all-streams
"Kills all telnet background streams connected to the mentor."
()
(mental::kill-all-streams mental::*mentor-telnet-stream-resource*)
dis-none)
(defcom com-mentor-clear-histories
"Clears out all histories on the MENTOR-TELNET-STREAM-RESOURCE."
()
(mental::clear-histories mental::*mentor-telnet-stream-resource*)
dis-none)