diff options
| -rwxr-xr-x | pinentry-rofi.scm | 125 |
1 files changed, 97 insertions, 28 deletions
diff --git a/pinentry-rofi.scm b/pinentry-rofi.scm index 630377a..c025c37 100755 --- a/pinentry-rofi.scm +++ b/pinentry-rofi.scm @@ -38,7 +38,7 @@ (exit #f)) (define-record-type <pinentry> - (make-pinentry ok prompt desc visibility display logfile) + (make-pinentry ok prompt ok-button cancel-button display logfile) pinentry? (ok pinentry-ok set-pinentry-ok!) (prompt pinentry-prompt set-pinentry-prompt!) @@ -59,10 +59,26 @@ "Evaluates to #t if string is empty." (string=? str "")) +(define (pinentry-remove-underline str) + "Replace _ followed by a character with just the character." + (regexp-substitute/global #f "(^|[[:blank:]])_([[:alpha:]])" str + 'pre 1 2 'post)) + +(define (pinentry-escape-underscore str) + "Replace __ followed by a character with _ and said character. +Always call this after `pinentry-remove-underline' or +`html-underline'." + (regexp-substitute/global #f "(^|[[:blank:]])__([[:alpha:]])" str + 'pre 1 "_" 2 'post)) + (define (html-newline str) "Replace %0A with " (regexp-substitute/global #f "%0A" str 'pre " " 'post)) +(define (html-underline str) + "Underscore followed by a character, underlines that character." + (regexp-substitute/global #f "(^|[[:blank:]])_([[:alpha:]])" str + 'pre 1"<u>"2"</u>" 'post)) (define (html-< str) "Replace < with <" (regexp-substitute/global #f "<" str 'pre "<" 'post)) @@ -77,7 +93,32 @@ (define (pango-markup str) "Transform string to pango." - (hex->char (html-< (html-newline str)))) + (hex->char + (pinentry-escape-underscore + (html-underline + (html-< + (html-newline str)))))) + +(define (input-string str) + "Transform string to input for rofi. +Input strings does not support pango markup" + (pinentry-escape-underscore + (pinentry-remove-underline str))) + +(define* (pinentry-set set-func pinentry label) + "Using SET-FUNC, set the entry in PINENTRY to LABEL." + (set-func pinentry label) + (set-pinentry-ok! pinentry #t)) + +(define (pinentry-set-button set-func pinentry label) + "Using SET-BUTTON-FUNC, set the entry in PINENTRY to LABEL. +LABEL will be transformed using `input-string'" + (pinentry-set set-func pinentry (input-string label))) + +(define (pinentry-set-mesg set-func pinentry label) + "Using SET-FUNC, set the entry in PINENTRY to LABEL. +LABEL will be transformed using `pango-markup'" + (pinentry-set set-func pinentry (pango-markup label))) (define (pinentry-option pinentry line) "Process line if it starts with OPTION. @@ -99,8 +140,32 @@ default-cf-visi=Do you really want to make your passphrase visible on the screen default-tt-visi=Make passphrase visible default-tt-hide=Hide passphrase touch-file=/run/user/1000/gnupg/S.gpg-agent" - (let ((option-re (make-regexp "^OPTION (.+)$"))) - (regexp-exec option-re line))) + (let ((regex-match #f) + (option-re (make-regexp "^OPTION (.+)$"))) + (cond + ((set-and-return! regex-match + (regexp-exec + (make-regexp "^OPTION[[:blank:]]+default-ok=(.+)$") line)) + (pinentry-set-button + set-pinentry-ok-button! + pinentry + (match:substring regex-match 1))) + ((set-and-return! regex-match + (regexp-exec + (make-regexp "^OPTION[[:blank:]]+default-cancel=(.+)$") line)) + (pinentry-set-button + set-pinentry-cancel-button! + pinentry + (match:substring regex-match 1))) + ((set-and-return! regex-match + (regexp-exec + (make-regexp "^OPTION[[:blank:]]+default-prompt=(.+)$") line)) + (pinentry-set-mesg + set-pinentry-prompt! + pinentry + (match:substring regex-match 1))) + ((set-and-return! regex-match (regexp-exec option-re line)))) + regex-match)) (define (pinentry-getinfo pinentry line) "Process line if it starts with GETINFO" @@ -128,9 +193,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((setok-button-re (make-regexp "^SETOK (.+)$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec setok-button-re line)) - (let ((label (pango-markup (match:substring regex-match 1)))) - (set-pinentry-ok-button! pinentry label) - (set-pinentry-ok! pinentry #t))) + (pinentry-set-button + set-pinentry-ok-button! + pinentry + (match:substring regex-match 1))) regex-match)) (define (pinentry-setcancel pinentry line) @@ -138,9 +204,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((setcancel-button-re (make-regexp "^SETCANCEL (.+)$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec setcancel-button-re line)) - (let ((label (pango-markup (match:substring regex-match 1)))) - (set-pinentry-cancel-button! pinentry label) - (set-pinentry-ok! pinentry #t))) + (pinentry-set-button + set-pinentry-cancel-button! + pinentry + (match:substring regex-match 1))) regex-match)) (define (pinentry-setnotok pinentry line) @@ -148,9 +215,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((setnotok-button-re (make-regexp "^SETNOTOK (.+)$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec setnotok-button-re line)) - (let ((label (pango-markup (match:substring regex-match 1)))) - (set-pinentry-notok-button! pinentry label) - (set-pinentry-ok! pinentry #t))) + (pinentry-set-button + set-pinentry-notok-button! + pinentry + (match:substring regex-match 1))) regex-match)) (define (pinentry-setdesc pinentry line) @@ -158,9 +226,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((setdesc-re (make-regexp "^SETDESC (.+)$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec setdesc-re line)) - (let ((mesg (pango-markup (match:substring regex-match 1)))) - (set-pinentry-desc! pinentry mesg)) - (set-pinentry-ok! pinentry #t)) + (pinentry-set-mesg + set-pinentry-desc! + pinentry + (match:substring regex-match 1))) regex-match)) (define (pinentry-seterror pinentry line) @@ -168,9 +237,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((seterror-re (make-regexp "^SETERROR (.+)$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec seterror-re line)) - (let ((mesg (pango-markup (match:substring regex-match 1)))) - (set-pinentry-error! pinentry mesg) - (set-pinentry-ok! pinentry #t))) + (pinentry-set-mesg + set-pinentry-error! + pinentry + (match:substring regex-match 1))) regex-match)) (define (pinentry-setprompt pinentry line) @@ -178,8 +248,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((setprompt-re (make-regexp "^SETPROMPT (.+)$")) (regex-match #f)) (when (set-and-return! regex-match (regexp-exec setprompt-re line)) - (set-pinentry-prompt! pinentry (match:substring regex-match 1)) - (set-pinentry-ok! pinentry #t)) + (pinentry-set-mesg + set-pinentry-prompt! + pinentry + (match:substring regex-match 1))) regex-match)) (define (pinentry-getpin pinentry line) @@ -230,11 +302,9 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (string-join `("echo -e " ,(format #f "'~a\n~a'" - ;; Find a cleaner way, e.g. or - (or (pinentry-ok-button pinentry) "ok") + (pinentry-ok-button pinentry) (or (pinentry-notok-button pinentry) - (pinentry-cancel-button pinentry) - "cancel")) + (pinentry-cancel-button pinentry))) "|" ,(format #f "env DISPLAY=~a" (pinentry-display pinentry)) "rofi -dmenu -disable-history -only-match -l 2 -i" @@ -248,8 +318,7 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (pass (get-string-all pipe)) (status (close-pipe pipe))) (if (and (equal? (status:exit-val status) 0) - (string=? (string-trim-right pass) - (or (pinentry-ok-button pinentry) "ok"))) + (string=? (string-trim-right pass) (pinentry-ok-button pinentry))) (set-pinentry-ok! pinentry #t) (begin (format #t "ERR 277 Operation cancelled\n") @@ -320,7 +389,7 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (help (single-char #\h) (value #f)))) (default-display ":0") (options (getopt-long (command-line) option-spec)) - (pinentry (make-pinentry #t "Passphrase:" "" #f + (pinentry (make-pinentry #t "Passphrase:" "Ok" "Cancel" (option-ref options 'display default-display) (let ((logfile (option-ref options 'log #f))) (when logfile |