;;; -*- Mode:Common-Lisp; Package:NET; Base:10; Fonts:(COURIER TR12I TR12BI TR12 MEDFNTB) -*- ;1 File name: REXEC-SERVICE.LISP* ;1 Defines the EXEC and SHELL services for the TIs.* ;1 Started 2-23-88 by Eric Karlson, UC-Berkeley under Robert Wilensky* ;1 Phone: (415) 642-9076, E-mail Address: karlson@ucbarpa.berkeley.edu* ;1 Defines two new services:* ;1 EXEC - Performs a remote execute (UNIX REXEC funtion) to a remote host. The protocol is defined* ; 1in the REXECD manual entry on the UNIX machines. Additions to Service Lists:* ; 1Machines with a TCP address -> (:EXEC :TCP-STREAM :UNIX-EXEC)* ; 1Machines with a CHAOS address -> (:EXEC :CHAOS-STREAM :CHAOS-EXEC)* ;1 SHELL - Performs a remote shell (UNIX RSH function) to a remote host. The protocol is defined in the* ; 1 RSHD manual entry on the UNIX machines. Additions to Service Lists:* ; 1 Machines with a TCP address -> (:SHELL :TCP-STREAM :UNIX-SHELL)* ;1 The normal protocol for EXEC and SHELL requires a certain amount of security to validate the request.* ;1 Part of this validation procedure uses passwords and equivalent hosts. This is not part of the normal* ;1 operating system for the TIs so these protocols by default look for this information in the following* ;1 files (which should be in the home directory of the concerned user):* ; 1PASSWORD.REMOTE - Should contain one line which is the password that has to be given* ; 1 for someone to REXEC to this machine as this user. If not present,* ; 1 no attempt to REXEC will work.* ; 1HOSTS.REMOTE - This file should contain a number of lines of the form:* ; 1 * ; 1 Each tells that the given USER can log onto this Lisp machine from the* ; 1 given HOST as the concerned user. If this file is not present then it is* ; 1 assumed that no users can log in as the concerned user.* ;1 Note that the above files are local to each Lisp machine.* ;1 There is one more feature for these protocols. The variable *REMOTE-LOG* can enable logging of* ;1 all remote requests made to this machine, along with the information passed over in the request* ;1 and the time of the request. If the variable is a pathname, then logging is enabled. If it is NIL* ;1 then no logging is performed.* ;1 The information about the REXEC and RSH protocols was found on the UNIX machines by using* ;1 MAN on REXECD and RSHD.* ;1 There are a few differences between the protocol here and the "official" protocol. Most notably, the* ;1 server for the EXEC and SHELL services do not require that the UIDs or passwords be 16 characters* ;1 or less. There is also no limit on how long the command can be. (However, the client sides DO enforce* ;1 the 16 character limit by truncating the strings).* ;1 In addition, the UNIX version of the protocol will start by only sending the port number of stderr and* ;1 then wait for that connection to be made before the rest of the information is sent. The clients on the* ;1 TIs do not wait, all the information is sent in one lump.* ;1 The Chaosnet version of the protocol is a little different in that the vital parameters for the connection* ;1 (stderr port and so forth) come across in the initial contact string and are not part of the actual* ;1 stream connection that gets set up. In addition, since the SHELL protocol is based on a security scheme,* ;1 and the Explorers don't have a notion of security, there is no Chaos version of the SHELL protocol.* ;1 Known Bugs* ;1 The biggest bug is that I still seem to need to abort connections with the UNIX machines to* ;1 to force them to close. This cannot be right, but I can't get it to work any other way (unless* ;1 I want to let the connection sit around long enough to time out). There must be something that* ;1 the UNIX side is waiting for before closing the connection that I am not sending.* ;1-----------------------* ;1 Some global parameters* ;1-----------------------* (defconstant 4*MAX-ID-LEN* *16 "2Maximum length of a user ID for SHELL.*") ;1------------------------------------------------* ;1 A number of general functions for the the servers* ;1------------------------------------------------* (defun 4read-chaos-port *(connect-stream initial-stream log) "2Reads a CHAOS connection name from the indicated stream and returns a stream to that port.*" (declare (function read-chaos-port (STREAM STREAM) STREAM) (values RETURN-STREAM)) ;1 If the contact name = "same connection" then return STDERR back over the initial connection.* (let ((contact-name (read-line connect-stream nil "3same connection*"))) (declare (STRING contact-name)) ;1 Log info.* (format log "3; Error Port = ~A*" contact-name) 3 *(if (string= contact-name "3same connection*") initial-stream (chaos:open-stream (send initial-stream :foreign-host) contact-name :timeout *SHELL-TIMEOUT* :ascii-translation NIL :direction :output :error NIL)))) (defun 4execute-command *(stream errors command) "2This will evaluate the given command with the standard IO streams bound back to the connection that started the remote execution. The result of the command is also forced back into the stream.*" (declare (function execute-command (STREAM STREAM STRING) T)) ;1 Temporarily bind the standard IO streams to the connection* (let ((*STANDARD-INPUT* stream) (*STANDARD-OUTPUT* stream) (*TRACE-OUTPUT* stream) (*ERROR-OUTPUT* errors) (*DEBUG-IO* stream) (*QUERY-IO* stream)) (declare (special *STANDARD-INPUT* *STANDARD-OUTPUT* *TRACE-OUTPUT* *ERROR-OUTPUT* *DEBUG-IO* *QEURY-IO*)) ;1 Start with a null byte to indicate no errors.* (ignore-errors (send stream :tyo #\)) (catch-error (pprint (eval (read-from-string command nil nil)))) ;1 Write out some final NewLines.* (send stream :tyo #\NewLine) (unless (eq errors stream) (send stream :tyo #\NewLine)))) ;1----------------------* ;1 PUBLIC FUNCTIONS* ;1----------------------* ;1 The client side of the EXEC service* (defun 4rexec *(host command &key (stdout *STANDARD-OUTPUT*) (stderr *ERROR-OUTPUT*) (stdin *NULL-STREAM*) (uid (format nil "3~(~A~)*" USER-ID)) (force-prompt nil)) "2Does a remote execute of the COMMAND on HOST. If the REXEC is successful then the output is piped to STDOUT and REXEC returns T. If there was an error setting up the REXEC call then the error message is piped to STDERR and NIL is returned. When there is a problem with setting up the connection, an error message is printed and the error stream is returned. The various keywords are: :STDOUT - A stream to pipe the standard output to. Defaults to *STANDARD-OUTPUT*. :STDERR - A stream to pipe the error output to. Defaults to *ERROR-OUTPUT*. :STDIN - A stream to copy to the remote process to use as standard input. Defaults to *NULL-STREAM*. :UID - A string to user for the User Id. Defaults to a lower case version of USER-ID. :FORCE-PROMPT - If non-nil it will prompt the user for a UID and password, even* 2 if they have already been cached. Defaults to NIL. Note that STDIN will only be copied if the RXEC makes a successful connection.*" (declare (function rexec (HOST STRING &key (:stdout STREAM) (:stderr STREAM) (:stdin STREAM) (:uid STRING) (:force-prompt T)) (or SYMBOL STREAM)) (values T-NIL-OR-ERROR-STREAM)) ;1 First prompt for a User Id and Password if needed.* (multiple-value-bind (uid password) (fs:file-get-password-etc (parse-host host) uid nil force-prompt) (declare (STRING uid password)) ;1 Now open up the connection and read the result from it.* (with-open-stream (stream (send (parse-host host) :exec :connect uid password command)) (declare (STREAM stream)) (cond ;1 Check to make sure the connection opened* ((errorp stream) (format stderr "3~%Connection failure - *") (apply #'format stderr (send stream :format-string) (send stream :format-args)) stream) ;1 First byte indicates if the server had a problem with the connection.* ((zerop (char-int (send stream :tyi))) (stream-copy-until-eof stdin stream) (send stream :eof) (format stdout "3~%*") (stream-copy-until-eof stream stdout) T ) ( T (format stderr "3~%Error on REXEC - *") (stream-copy-until-eof stream stderr) nil))))) ;1 The client side of the SHELL service* (defun 4rshell *(host command &key (stdout *STANDARD-OUTPUT*) (stderr *ERROR-OUTPUT*) (stdin *NULL-STREAM*) 3 *(uid (format nil "3~(~A~)*" USER-ID))) "2Does a remote shell of the COMMAND on HOST. If the RSHELL is successful then the output is piped to STDOUT and RSHELL returns T. If there was an error setting up the RSHELL call then the error message is piped to STDERR and NIL is returned. When there is a problem with setting up the connection, an error message is printed and the error stream is returned. The various keywords are: :STDOUT - A stream to pipe the standard output to. Defaults to *STANDARD-OUTPUT*. :STDERR - A stream to pipe the error output to. Defaults to *ERROR-OUTPUT*. :STDIN - A stream to copy to the remote process to use as standard input. Defaults to *NULL-STREAM*. :UID - A string to user for the User Id on the remote host. Defaults to a lower case version of USER-ID. Note that STDIN will only be copied if the RSHELL makes a successful connection.*" (declare (function rshell (HOST STRING &key (:stdout STREAM) (:stderr STREAM) (:stdin STREAM) (:uid STRING)) (or SYMBOL STREAM)) (values T-NIL-OR-ERROR-STREAM)) ;1 Now open up the connection and read the result from it.* (with-open-stream (stream (send (parse-host host) :shell :connect uid command)) (declare (STREAM stream)) (cond ;1 Check to make sure the connection opened* ((errorp stream) (format stderr "3~%Connection failure - *") (apply #'format stderr (send stream :format-string) (send stream :format-args)) stream) ;1 First byte indicates if the server had a problem with the connection.* ((zerop (char-int (send stream :tyi))) (stream-copy-until-eof stdin stream) (send stream :eof) (format stdout "3~%*") (stream-copy-until-eof stream stdout) T ) ( T (format stderr "3~%Error on RSHELL - *") (stream-copy-until-eof stream stderr) nil)))) ;1------------------------* ;1 Define the EXEC service* ;1------------------------* (define-service 4:EXEC *(&rest args) (medium self args) "2Start a remote execution.*") (defflavor 4unix-exec* ((name :unix-exec) (desirability .75)) (service-implementation-mixin) :gettable-instance-variables :settable-instance-variables :initable-instance-variables (:documentation "3This is the implemention of the :EXEC service for TCP connections.*")) (define-service-implementation 4'unix-exec*) (define-logical-contact-name 4"unix-exec" *'((:tcp 512))) (defmethod 4(unix-exec :connect)* (medium host uid password command &optional (error-port 0)) "2Opens a connection and performs a remote execute on the indicated host. The stream returned can be read to get the results.*" (declare (function (:METHOD unix-exec :connect) (MEDIUM HOST STRING STRING STRING &optional FIXNUM) STREAM) (values RESULT-STREAM)) ;1 Make sure we are using some sort of BYTE STREAM* (unless (superior-medium-p medium :BYTE-STREAM) (ferror 'gni-service-error "3Service ~A cannot connect using ~A medium*" self medium)) (open-connection-on-medium host medium "3unix-exec*" :connect-string (format nil "3~D~A~A~A*" error-port (subseq uid 0 *MAX-ID-LEN*) (subseq password 0 *MAX-ID-LEN*) command) :stream-type :unix-translating-character-stream :timeout *SHELL-TIMEOUT* :timeout-after-open nil :error nil)) (compile-flavor-methods unix-exec) (defflavor 4chaos-exec* ((name :chaos-exec) (desirability .75)) (service-implementation-mixin) :gettable-instance-variables :settable-instance-variables :initable-instance-variables (:documentation "3This is the implemention of the :EXEC service for CHAOS connections.*")) (define-service-implementation 4'chaos-exec*) (define-logical-contact-name 4"chaos-exec" *'((:chaos "3EXEC*"))) (defmethod 4(chaos-exec :connect)* (medium host uid password command &optional (error-port "3same connection*")) "2Opens a connection and performs a remote execute on the indicated host. The stream returned can be read to get the results.*" (declare (function (:METHOD chaos-exec :connect) (MEDIUM HOST STRING STRING STRING &optional STRING) STREAM) (values RESULT-STREAM)) ;1 Make sure that we are using some sort of BYTE STREAM.* (unless (superior-medium-p medium :BYTE-STREAM) (ferror 'gni-service-error "3Service ~A cannot connect using ~A medium*" self medium)) (open-connection-on-medium host medium "3chaos-exec*" :connect-string (format nil "3~A~%~A~%~A~%~S*" error-port (subseq uid 0 *MAX-ID-LEN*) (subseq password 0 *MAX-ID-LEN*) command) :stream-type :character-stream :timeout *SHELL-TIMEOUT* :timeout-after-open nil :error nil)) (compile-flavor-methods unix-exec) ;1-----------------------------------* ;1 The server side of the EXEC service* ;1-----------------------------------* (add-server-for-medium :BYTE-STREAM "4unix-exec*" '(process-run-function "3UNIX EXEC Server*" #'unix-exec-server)) (defun 4unix-exec-server *() "2This is the server for the :EXEC service over a TCP connection.*" ;1 As implemented here, the limits on the length of the User Name, Password and Command* ;1 are unbounded. Furthermore, there is no such thing as a current directory on the TIs, so* ;1 that part of the protocol is ignored. Finally, there is no fork done, since one was already* ;1 done to start executing this function.* ;1 As a result, the only error messages that one can get back are LOGIN INCORRECT* ;1 and CANNOT MAKE PIPE.* ;1 If an error occurs, the first byte written back is a 1, otherwise it is a 0.* (declare (function unix-exec-server () SYMBOL) (values T-OR-NIL)) (condition-case () (catch 'close-connections (with-open-stream (server-stream (listen-for-connection-on-medium :byte-stream "3unix-exec*" :stream-type :unix-translating-character-stream :timeout-after-open nil)) (declare (STREAM server-stream)) (with-open-log (log server-stream "3Unix Exec*") ;1 Let who line know about the new server.* (send w:WHO-LINE-FILE-STATE-SHEET :add-server (make-instance 'generic-peek-bs-server :stream server-stream) 3 *"3EXEC*" si:current-process) ;1 First we have to open up the error stream. We cannot read the other arguments until then.* (let ((port (parse-integer (read-delimited-string '(#\) server-stream nil) :radix 10 :junk-allowed T))) (declare (FIXNUM port)) ;1 Log info* (format log "3; Error Port = ~D*") ;1 Open the stderr stream.* (with-open-stream (error-stream (make-privileged-unix-stream port server-stream)) (declare (STREAM error-stream)) ;1 Make sure we got the stream open.* (when (errorp error-stream) (format server-stream "3Cannot make pipe*") (send server-stream :eof) (format log "3; *** Aborted - Could not open Error Port ****") (throw 'close-connections nil)) ;1 Get the parameters from the RSHELL request and execute it.* (let ((USER-ID (read-delimited-string '(#\) server-stream nil)) (password (read-delimited-string '(#\) server-stream nil)) (command (read-delimited-string '(#\) server-stream nil))) (declare (special USER-ID) (STRING USER-ID password command)) ;1 Log info* (format log "3; User Id = ~A; Password = ~A; Command = ~A*" USER-ID password command) ;1 Attempt to valid the password and eval the command.* (unless (validate-password password) (format server-stream "3Login incorrect*") (send server-stream :eof) (format log "3; *** Aborted - Incorrect Login ****") (throw 'close-connections nil)) (execute-command server-stream error-stream command) (send server-stream :eof) (send error-stream :eof) (send log :close) (throw 'close-connection T))))))) (sys:NETWORK-ERROR nil))) (add-server-for-medium :BYTE-STREAM "4chaos-exec*" '(process-run-function "3CHAOS EXEC Server*" #'chaos-exec-server)) (defun 4chaos-exec-server *() "2This is the server for the :EXEC service over a CHAOS connection.*" ;1 As implemented here, the limits on the length of the User Name, Password and Command* ;1 are unbounded. Furthermore, there is no such thing as a current directory on the TIs, so* ;1 that part of the protocol is ignored. Finally, there is no fork done, since one was already* ;1 done to start executing this function.* ;1 As a result, the only error messages that one can get back are LOGIN INCORRECT* ;1 and CANNOT MAKE PIPE.* ;1 If an error occurs, the first byte written back is a 1, otherwise it is a 0.* (declare (function chaos-exec-server () T)) (condition-case () (with-open-stream (server-stream (listen-for-connection-on-medium :byte-stream "3chaos-exec*" :stream-type :character-stream :timeout-after-open nil)) (declare (STREAM server-stream)) (with-open-log (log server-stream "3Chaos Exec*") ;1 Let who line know about the new server.* (send w:WHO-LINE-FILE-STATE-SHEET :add-server (make-instance 'generic-peek-bs-server :stream server-stream) "3EXEC*" si:current-process) ;1 Put the connection string into a stream to read it.* (with-input-from-string (connection (get (locf (chaos:conn-plist (send server-stream :connection))) 'chaos:RFC-ARGUMENTS)) (declare (STREAM connection)) ;1 Extract the contact name to be used for STDERR.* (with-open-stream (error-stream (read-chaos-port connection server-stream log)) (declare (STREAM error-stream)) ;1 Parse the remaining connection arguments.* (let ((USER-ID (read-line connection nil "")) (password (read-line connection nil "")) (command (with-output-to-string (comm) (declare (STREAM comm)) (stream-copy-until-eof connection comm)))) (declare (special USER-ID) (STRING USER-ID password command)) ;1 Log info* (format log "3; User Id = ~A; Password = ~A; Command = ~A*" USER-ID password command) ;1 Make sure we have an error port and then attempt to valid the password and eval the command.* (cond ((errorp error-stream) (format server-stream "3Could not open Error Stream*") (send server-stream :eof) (format log "3; *** Aborted - Could not open Error Port ****")) ( T (if (validate-password password) (progn (execute-command server-stream error-stream command) (send server-stream :eof) (send error-stream :eof)) (format server-stream "3Login incorrect*") (send server-stream :eof) 3 *(format log "3; *** Aborted - Incorrect Login ****"))))))))) (sys:NETWORK-ERROR nil))) ;1--------------------------* ;1 Define the SHELL Service* ;1--------------------------* (define-service 4:SHELL *(&rest args) (medium self args) "2Start a remote shell.*") (defflavor 4unix-shell* ((name :unix-shell) (desirability .75)) (service-implementation-mixin) :gettable-instance-variables :settable-instance-variables :initable-instance-variables (:documentation "3This flavor implements the network service :SHELL for TCP connections.*")) (define-service-implementation 4'unix-shell)* (define-logical-contact-name 4"unix-shell" *'((:tcp 514))) (defmethod 4(unix-shell :connect)* (medium host uid command &optional (error-port 0)) "2Opens a connection and performs a remote shell on the indicated host. The stream returned can be read to get the results.*" (declare (function (:METHOD unix-shell :connect) (MEDIUM HOST STRING STRING &optional FIXNUM) STREAM) (values RESULT-STREAM)) ;1 Make sure we are using some sort of BYTE STREAM.* (unless (superior-medium-p medium :BYTE-STREAM) (ferror 'gni-service-error "3Service ~A cannot connect using ~A medium*" self medium)) (do ((stream nil) (port *MAX-PRIV-PORT-NUM* (1- port))) ((or stream (= port *MIN-PRIV-PORT-NUM*)) (or stream (ferror 'gni-service-error "3Service ~A cannot find a Privileged Port using ~A medium*" self medium))) (declare (type (or NULL STREAM) stream) (FIXNUM port)) (setq stream (condition-case () (open-connection-on-medium host medium "3unix-shell*" :local-port port :connect-string (format nil "3~D~A~A~A*" error-port (subseq USER-ID 0 *MAX-ID-LEN*) (subseq uid 0 *MAX-ID-LEN*) command) :stream-type :unix-translating-character-stream :timeout *SHELL-TIMEOUT* :timeout-after-open nil :error nil) (ip:connection-already-exists nil))))) (compile-flavor-methods unix-shell) ;1---------------------------* ;1 The server side of RSHELL* ;1---------------------------* (add-server-for-medium :byte-stream "4unix-shell*" '(process-run-function "3UNIX SHELL Server*" #'unix-shell-server)) (defun 4unix-shell-server *() "2Handles any requests for an SHELL on this machine. The form to evaluate is assumed to be the COMMAND. All output is passed back to the client host. The function returns a value indicating if the operation was successful.*" ;1 The first thing to do is read the command from the stream. Then temporarily bind all of the IO streams* ;1 back to the channel so that all output returns to the sender of the request.* ;1 Notice that there is not yet a check to make sure the request is coming from a privledged port. The problem* ;1 is I am not quite sure how to find that information from the stream...* (declare (function unix-shell-server () SYMBOL) (values T-OR-NIL)) (condition-case () (catch 'close-connections (with-open-stream (server-stream (listen-for-connection-on-medium :byte-stream "3unix-shell*" :stream-type :unix-translating-character-stream :timeout-after-open nil)) (declare (STREAM server-stream)) (with-open-log (log server-stream "3Unix Shell*") ;1 Let who line know about the new server.* (send w:WHO-LINE-FILE-STATE-SHEET :add-server (make-instance 'generic-peek-bs-server :stream server-stream) 3 *"3SHELL*" si:current-process) ;1 Should really check to make sure that the connection was coming from a privileged port.* (when (< *MAX-PRIV-PORT-NUM* (send (send server-stream :connection) :destination-port)) (format log "3; *** Aborted - RSHELL coming from non-privileged port: ~D ****" (send (send server-stream :connection) :destination-port)) (throw 'close-connections nil)) ;1 Now we have to open up the error stream. We cannot read the other arguments until then.* (let ((port (parse-integer (read-delimited-string '(#\) server-stream nil) :radix 10 :junk-allowed T))) (declare (FIXNUM port)) ;1 Log info* (format log "3; Error Port = ~D*" port) ;1 Open the stderr stream.* (with-open-stream (error-stream (make-privileged-unix-stream port server-stream)) (declare (STREAM error-stream)) ;1 Make sure we got the stream open.* (when (errorp error-stream) (format server-stream "3Cannot make pipe~%*") (send server-stream :eof) (format log "3; *** Aborted - Could not open Error Port ****") (throw 'close-connections nil)) ;1 Get the parameters from the RSHELL request and execute it.* (let ((uid (read-delimited-string '(#\) server-stream nil)) (USER-ID (read-delimited-string '(#\) server-stream nil)) (command (read-delimited-string '(#\) server-stream nil)) error) (declare (special USER-ID) (STRING USER-ID uid command)) ;1 Log info* (format log "3; Remote UID = ~A; Local UID = ~A; Command = ~A*" uid USER-ID command) ;1 Attempt to valid the password and eval the command.* (when (setq error (validate-user uid server-stream)) (format server-stream "3~A~%*" error) (send server-stream :eof) (format log ";1 3*** Aborted - ~A *****" error) (throw 'close-connections nil)) (execute-command server-stream error-stream command) (send server-stream :eof) (send error-stream :eof) (send log :close) (throw 'close-connections T))))))) (sys:NETWORK-ERROR nil)))