diff options
| -rwxr-xr-x | rofi-pinentry.scm | 86 |
1 files changed, 62 insertions, 24 deletions
diff --git a/rofi-pinentry.scm b/rofi-pinentry.scm index c484f9a..ab333c3 100755 --- a/rofi-pinentry.scm +++ b/rofi-pinentry.scm @@ -27,15 +27,23 @@ (ice-9 textual-ports) (srfi srfi-9) ;; For records (ice-9 format) - (ice-9 regex)) + (ice-9 regex) + (ice-9 getopt-long)) + +(define pinentry-rofi-guile-version "0.1.0") + +(when (equal? (system-file-name-convention) 'windows) + (format #t "Only support posix systems!") + (exit #f)) (define-record-type <pinentry> - (make-pinentry ok prompt desc visibility) + (make-pinentry ok prompt desc visibility display) pinentry? (ok pinentry-ok set-pinentry-ok!) (prompt pinentry-prompt set-pinentry-prompt!) (desc pinentry-desc set-pinentry-desc!) - (visibility pinentry-visibility set-pinentry-visibility!)) + (visibility pinentry-visibility set-pinentry-visibility!) + (display pinentry-display set-pinentry-display!)) (define-syntax-rule (set-and-return! val expr) "Set val to expr and return val" @@ -85,18 +93,24 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((setkeyinfo-re (make-regexp "^SETKEYINFO (.+)$"))) (regexp-exec setkeyinfo-re line))) +(define (html-< str) + "Replace < with <" + (regexp-substitute/global #f "<" str 'pre "<" 'post)) + +(define (hex->char str) + "Replace matching'%XX' where X ∈ {0-F} with their respective char." + (regexp-substitute/global + #f "%([[:xdigit:]]{2})" str 'pre + (lambda (m) (integer->char + (string->number + (match:substring m 1) 16))) 'post)) + (define (pinentry-setdesc pinentry line) "SETDESC Please enter the passphrase for the ssh key%0A ke:yf:in:ge:rp:ri:nt" (let ((setdesc-re (make-regexp "^SETDESC (.+)$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec setdesc-re line)) - (let* ((mesg (match:substring regex-match 1)) - (mesg (regexp-substitute/global #f "<" mesg 'pre "<" 'post)) - (mesg (regexp-substitute/global - #f "%([[:xdigit:]]{2})" mesg 'pre - (lambda (m) (integer->char - (string->number - (match:substring m 1) 16))) 'post))) + (let ((mesg (hex->char (html-< (match:substring regex-match 1))))) (set-pinentry-desc! pinentry mesg))) regex-match)) @@ -109,21 +123,21 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" regex-match)) (define (pinentry-getpin pinentry line) - (let ((rofi "env ~a rofi -dmenu ~a -disable-history -lines 1 ~a -p ~s ~a ~s") - (getpin-re (make-regexp "^GETPIN$")) + (let ((getpin-re (make-regexp "^GETPIN$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec getpin-re line)) - (let* ((pipe (open-input-pipe "systemctl --user show-environment")) - (env (get-string-all pipe)) - (status (close-pipe pipe)) - (rofi-cmd (format #f rofi - (regexp-substitute/global #f "[\n]" env 'pre " " 'post) - "-input /dev/null" - (if (pinentry-visibility pinentry) "" "-password") - (pinentry-prompt pinentry) - (if (string-empty? (pinentry-desc pinentry)) "" "-mesg") - (pinentry-desc pinentry))) - (pipe (open-input-pipe rofi-cmd)) + (let* ((pipe (open-pipe* + OPEN_READ + "env" + (format #f "DISPLAY=~a" (pinentry-display pinentry)) + "rofi" + "-dmenu" + "-input" "/dev/null" + "-disable-history" + "-lines" "1" + (if (pinentry-visibility pinentry) "" "-password") + "-p" (pinentry-prompt pinentry) + "-mesg" (pinentry-desc pinentry))) (pass (get-string-all pipe)) (status (close-pipe pipe))) (if (equal? (status:exit-val status) 0) @@ -163,7 +177,31 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (force-output)) (pinentry-loop pinentry input-port)))) -(let ((pinentry (make-pinentry #t "Passphrase:" "" #f))) +(let* ((option-spec + '((display (single-char #\d) (value #t)) + (xauthority (single-char #\a) (value #t)) + (version (single-char #\v) (value #f)) + (help (single-char #\h) (value #f)))) + (default-display ":0") + (options (getopt-long (command-line) option-spec)) + (pinentry (make-pinentry #t "Passphrase:" "" #f + (option-ref options 'display default-display)))) + (when (option-ref options 'help #f) + (format #t "\ +Usage: ~a [OPTIONS] +Options: + -d, --display DISPLAY Set display, default is ~s. + -v, --version Display version. + -h, --help Display this help. +Author: +Fredrik \"PlaTFooT\" Salomonsson +" +(car (command-line)) +default-display) + (exit #t)) + (when (option-ref options 'version #f) + (format #t "pinentry-rofi-guile version ~a\n" pinentry-rofi-guile-version) + (exit #t)) (format #t "OK Please go ahead\n") (force-output) (pinentry-loop pinentry (current-input-port))) |