first commit

examples/ssh-same-path.scm

@@ -0,0 +1,64 @@
+#!/bin/sh
+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
+	  (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))))