;; termios.ffi				-*- Scheme -*-

;; Copyright (C) 2020,2022 Matthew R. Wette
;; 
;; Copying and distribution of this file, with or without modification,
;; are permitted in any medium without royalty provided the copyright
;; notice and this notice are preserved.  This file is offered as-is,
;; without any warranty.

;; provides (getpass) OR (getpass "pw: ") to get pw from terminal

(define-ffi-module (ffi termios)
  #:include '("termios.h")
  #:inc-filter (lambda (file-spec path-spec)
		 (string-contains path-spec "termios"))
  #:def-keepers '("IGNBRK" "BRKINT" "IGNPAR" "PARMRK" "INPCK" "ISTRIP" "INLCR"
		  "IGNCR" "ICRNL" "IUCLC" "IXON" "IXANY" "IXOFF" "IMAXBEL"
		  "IUTF8" "OPOST" "OLCUC" "ONLCR" "OCRNL" "ONOCR" "ONLRET"
		  "OFILL" "OFDEL" "NLDLY" "CRDLY" "TABDLY" "BSDLY" "VTDLY"
		  "FFDLY" "CBAUD" "CBAUDEX" "CSIZE" "CSTOPB" "CREAD" "PARENB"
		  "PARODD" "HUPCL" "CLOCAL" "LOBLK" "CIBAUD" "CMPAR" "CRTSCTS"
		  "ISIG" "ICANON" "XCASE" "ECHO" "ECHOE" "ECHOK" "ECHONL"
		  "ECHOCTL" "ECHOPRT" "ECHOKE" "DEFECHO" "FLUSHO" "NOFLSH"
		  "TOSTOP" "PENDING" "IEXTEN" "VDISCARD" "VDSUSP" "VEOF" "VEOL"
		  "VEOL2" "VERASE" "VINTR" "VKILL" "VLNEXT" "VMIN" "VQUIT"
		  "VREPRINT" "VSTART" "VSTATUS" "VSTOP" "VSUSP" "VSUSP" "VSWTCH"
		  "VTIME" "VWERASE" "TCSANOW" "TCSADRAIN" "TCSAFLUSH" "TCIFLUSH"
		  "TCOFLUSH" "TCIOFLUSH" "TCOOFF" "TCOON" "TCIOFF" "TCION" "B0"
		  "B50" "B75" "B110" "B134" "B150" "B200" "B300" "B600" "B1200"
		  "B1800" "B2400" "B4800" "B9600" "B19200" "B38400" "B57600"
		  "B115200" "B230400"))

;; you can get username from (getlogin)
(use-modules (ice-9 rdelim))
(define* (get-passwd #:optional (prompt "password: "))
  (let* ((pt (open "/dev/tty" (logior O_RDWR O_NOCTTY)))
	 (fd (port->fdes pt)) ;; or (fileno pt)
	 (old (make-struct-termios))
	 (new (make-struct-termios))
	 (TCSANOW (ffi-termios-symbol-val 'TCSANOW)))
    (dynamic-wind
      (lambda ()
	(tcgetattr fd (pointer-to old))
	(tcgetattr fd (pointer-to new))
	(let* ((ECHO (ffi-termios-symbol-val 'ECHO))
	       (old_flag (fh-object-ref new 'c_lflag))
	       (new_flag (logand old_flag (lognot ECHO))))
	  (fh-object-set! new 'c_lflag new_flag)
	  (tcsetattr fd TCSANOW (pointer-to new))))
      (lambda ()
	(display prompt pt) (force-output pt)
	(let ((pw (read-line pt)))
	  (newline)
	  pw))
      (lambda ()
	(tcsetattr fd TCSANOW (pointer-to old))))))
(export get-passwd)


;; --- last line ---
