scsh-expect/examples/ssh-same-path.scm

86 lines
2.7 KiB
Scheme
Executable File

#!/bin/sh
exec scsh -lel expect/load.scm -o threads -o tty-utils -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 ?
;; - detect if machine does not answer
(define *connect-timeout* 5)
(define *prompt-timeout* 3)
(define *prompt-regexp*
(let ((env (getenv "PROMPT_REGEXP")))
(or env
(rx (+ ,(char-set-difference char-set:full
(string->char-set " ")))
"[" (* any) "] "))))
(define (main args)
(let ((dir (cwd))
(user-out (current-output-port))
(user-in (current-input-port))
(task (spawn (ssh . ,(cdr args)))))
(chat task
(chat-monitor (lambda (ev msg)
(cond
((eq? ev 'abort)
(if (task:pre-match task)
(write-string (task:pre-match task) user-out))
(write-string (match:substring msg) user-out)
(write-string (task:buf task) user-out))
((eq? ev 'timeout)
(if (task:pre-match task)
(write-string (task:pre-match task) user-out))
(write-string (task:buf task) user-out)))))
(chat-abort *prompt-regexp*)
(let lp ((first? #t))
(chat-timeout (if first?
*connect-timeout*
*prompt-timeout*))
(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))))
(tsend/cr task (string-append "cd " dir))
(interact task)))
;; 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
(begin
(display prompt outport)
(force-output outport)))
(set-tty-info:local-flags
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)
password))))