getpass in Chez Scheme
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; 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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment