(in-package :cl-user)

#| ######################################################################

 Client end for the UNIX remote shell protocol.

Copyright © 1994-95 Michael Travers 

Permission is given to use and modify this code
as long as the copyright notice is preserved.

Send questions, comments, and fixes to mt@media.mit.edu.

-------------------------------------------------------------------------

 There seem to be several variants of the unix rsh (or rexec)
 protocol, and the documentation is unclear (big suprise there).
 This version works on Ultrix 4.1, and if it works on other systems
 I'll be pleasantly surprised.

Warning: this saves passwords inside Lisp. If you are worried about that,
you can comment out the lines marked with ***


###################################################################### |#

(require :mactcp)

;;; Remote Shell Protocol

;;; These parameters are sticky.
(defvar *host* "mahler.media.mit.edu")
(defvar *user* "mt")
(defvar *password*)

;;; Single command
(defun rsh (cmd &key (host *host*) (user *user*) (password *password*) (output-stream *standard-output*))
  (setf *user* user
        *password* password             ; *** comment out this line for security
        *host* host)
  (let ((stream (open-tcp-stream host "exec")))
    (unwind-protect 
      (progn
        (net-out "" stream)
        (net-out user stream)
        (net-out password stream)
        (net-out cmd stream)
        (force-output stream)
        (let ((error (char-code (read-char stream))))
          (unless (zerop error)
            (warn "error ~D" error)))
        (copy-until-eof stream output-stream))
      (close stream))))

;;; Command loop with prompt
(defun remote-shell (&key (host *host*) (user *user*) (password *password*) (prompt host))
  (setf *host* host
        *password* password            ; *** comment out this line for security
        *user* user)
  (do (line) (())
    (format t "~%~A> " prompt)
    (setq line (read-line))
    (rsh line :host host :user user :password password)))

(defun copy-until-eof (instream outstream)
  (do (char) ((eq char :eof)) 
    (when (stream-eofp instream) (return-from copy-until-eof))
    (setq char (read-char  instream nil :eof))
    (case char
      (:eof)
      (t (write-char char outstream)))))

(defun net-out (string stream)
  (write-string string stream)
  (write-char #\Null stream))