getpass in Chez Scheme

get-pass.ss

;;; Chez Scheme clone of Python `getpass'
;;; Based on github.com/smitchell556/get-pass
(library (get-pass)
  (export get-pass)
  (import (chezscheme))

;;; FFI portion
;;; See termios(3) for more info
  (define-ftype termios
    (struct
      (c_iflag unsigned)
      (c_oflag unsigned)
      (c_cflag unsigned)
      (c_lflag unsigned)
      (c_cc (array 32 unsigned))
      (c_ispeed unsigned)
      (c_ospeed unsigned)))

  (define tcgetattr
    (foreign-procedure
     "tcgetattr" (int (* termios)) int))
  (define tcsetattr
    (foreign-procedure
     "tcsetattr" (int int (* termios)) int))

  (define echo 8)      ; Echo input to output
  (define tcsanow 0)   ; Apply changes right away
  (define tcsadrain 1) ; Apply changes after output is written

  ;; Turn off the ECHO bit on the local modes field of the termios struct
  (define (echo-off! t)
    (ftype-set! termios (c_lflag) t
                (bitwise-and
                 (ftype-ref termios (c_lflag) t)
                 (bitwise-not echo))))

  ;; Turn on the ECHO bit
  (define (echo-on! t)
    (ftype-set! termios (c_lflag) t
                (bitwise-ior
                 (ftype-ref termios (c_lflag) t)
                 echo)))

  (define (get-pass prompt in out)
    (display prompt out)
    (flush-output-port out)
    (let ((fd (port-file-descriptor in)) ; Get the input port's fd
          (t #f))                        ; termios struct pointer
      (dynamic-wind
        (lambda ()
          ;; Allocate a termios struct
          (set! t (make-ftype-pointer
                   termios (foreign-alloc (ftype-sizeof termios))))
          ;; Fill t with fd's terminal properties
          (tcgetattr fd t)
          ;; Disable the ECHO bit on t
          (echo-off! t)
          ;; Push t back to fd, effective once the port is flushed
          (tcsetattr fd tcsadrain t))
        ;; Read line and return it
        (lambda () (get-line in))
        (lambda ()
          ;; Enable the ECHO bit on t
          (echo-on! t)
          ;; Push t to fd again, effective immediately
          (tcsetattr fd tcsanow t)
          ;; Free the termios struct
          (foreign-free (ftype-pointer-address t))
          ;; Line break if necessary
          (fresh-line out))))))

;;; Usage example:
(import (get-pass))

(load-shared-object "libc.so.6")
(display (string-append "The password entered was: "
                        (get-pass "Password: " (current-input-port) (current-output-port))))
(newline)