aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xrofi-pinentry.scm86
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 &lt;"
+ (regexp-substitute/global #f "<" str 'pre "&lt;" '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 "&lt;" '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)))