first commit

This commit is contained in:
frese 2004-07-27 16:15:28 +00:00
parent 22db3628ab
commit dd1583ad55
1 changed files with 64 additions and 0 deletions

examples/ssh-same-path.scm Executable file
View File

@ -0,0 +1,64 @@
exec scsh -lel expect/load.scm -o threads -o chat -o expect -o let-opt -e main -s "$0" "$@"
;; this script runs the SSH program and passes all it's arguments to
;; it. If ssh asks for a password, this script asks you for it, and
;; passes it to ssh. After logged in successfully, the script tries to
;; change the current directory of the remote shell to the same
;; directory that you were in on the machine running the script. After
;; that you can normally work with the remote shell.
;; TODO:
;; - detect if the arguments for ssh do not cause a log in, like --help ?
;; time to wait after logged in until we enter commands - we cannot
;; wait for a prompt, since we don't know how it will look like.
(define *time-until-prompt* 3)
(define (main args)
(let ((dir (cwd))
(user-out (current-output-port))
(user-in (current-input-port))
(task (spawn (ssh . ,(cdr args)))))
(chat task
(chat-abort "Last login:")
(let lp ((first? #t))
(look-for "Password:")
(if (not first?)
(display "Incorrect password. Try again.\n" user-out))
(let ((pw (read-password "Password: "
user-in user-out)))
(send/cr pw)
(lp #f))))
(sleep *time-until-prompt*)
(tsend/cr task (string-append "cd " dir))
(run (stty -echo raw)) ;; TODO: do this interally
(interact task)
(run (stty echo -raw))))
;; read string without echoing it
;; optionals arguments:
;; prompt - a string to be display before reading (default none)
;; inport - the port to read from (default current-input-port)
;; outport - the port to write to (default current-output-port)
(define (read-password . args)
(let-optionals args ((prompt #f)
(inport (current-input-port))
(outport (current-output-port)))
(let* ((tty-before (tty-info inport))
(tty-sans-echo (copy-tty-info tty-before)))
(if prompt
(display prompt outport)
(force-output outport)))
tty-sans-echo (bitwise-and (tty-info:local-flags tty-sans-echo)
(bitwise-not ttyl/echo)))
(set-tty-info/now inport tty-sans-echo)
(let ((password (read-line inport)))
(set-tty-info/now inport tty-before)
(flush-tty/both inport)
(newline outport)
(force-output outport)