Add logic for passing locale to rofi

Using the options `lc-ctype` and `lc-messages` to set the LC_ALL
option that is then set in the environment when calling rofi. Having
issues with rofi failing to set locale when using guix.

3 files changed, 110 insertions, 35 deletions

diff --git a/pinentry-rofi.scm b/pinentry-rofi.scm
index aec9acd..2a6771d 100755
--- a/pinentry-rofi.scm
+++ b/pinentry-rofi.scm
@@ -38,6 +38,8 @@
             pinentry-ok-button set-pinentry-ok-button!
             pinentry-notok-button set-pinentry-notok-button!
             pinentry-cancel-button set-pinentry-cancel-button!
+            pinentry-lc-ctype set-pinentry-lc-ctype!
+            pinentry-lc-messages set-pinentry-lc-messages!
 
             remove-underline
             escape-underscore
@@ -74,7 +76,7 @@
   (exit #f))
 
 (define-record-type <pinentry>
-  (make-pinentry ok prompt ok-button cancel-button display logfile)
+  (make-pinentry ok prompt ok-button cancel-button display logfile lc-ctype lc-messages)
   pinentry?
   (ok pinentry-ok set-pinentry-ok!)
   (prompt pinentry-prompt set-pinentry-prompt!)
@@ -85,7 +87,9 @@
   (logfile pinentry-logfile set-pinentry-logfile!)
   (ok-button pinentry-ok-button set-pinentry-ok-button!)
   (notok-button pinentry-notok-button set-pinentry-notok-button!)
-  (cancel-button pinentry-cancel-button set-pinentry-cancel-button!))
+  (cancel-button pinentry-cancel-button set-pinentry-cancel-button!)
+  (lc-ctype pinentry-lc-ctype set-pinentry-lc-ctype!)
+  (lc-messages pinentry-lc-messages set-pinentry-lc-messages!))
 
 (define-syntax-rule (set-and-return! val expr)
   "Set val to expr and return val."
@@ -164,6 +168,7 @@ Known options are:
 grab
 ttyname=/dev/pts/1
 ttytype=tmux-256color
+lc-ctype=C
 lc-messages=C
 allow-external-password-cache
 default-ok=_OK
@@ -200,6 +205,20 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent"
        set-pinentry-prompt!
        pinentry
        (match:substring regex-match 1)))
+     ((set-and-return! regex-match
+                       (regexp-exec
+                        (make-regexp "^OPTION[[:blank:]]+lc-ctype=(.+)$") line))
+      (pinentry-set
+       set-pinentry-lc-ctype!
+       pinentry
+       (match:substring regex-match 1)))
+     ((set-and-return! regex-match
+                       (regexp-exec
+                        (make-regexp "^OPTION[[:blank:]]+lc-messages=(.+)$") line))
+      (pinentry-set
+       set-pinentry-lc-messages!
+       pinentry
+       (match:substring regex-match 1)))
      ((set-and-return! regex-match (regexp-exec option-re line))))
     regex-match))
 
@@ -341,7 +360,9 @@ Return the input from the user if succeeded else #f."
       (let ((pass (pin-program #:prompt (pinentry-prompt pinentry)
                                #:message (compose-message pinentry)
                                #:visibility (pinentry-visibility pinentry)
-                               #:env `(("DISPLAY" . ,(pinentry-display pinentry))))))
+                               #:env `(("DISPLAY" . ,(pinentry-display pinentry))
+                                       ("LC_CTYPE" . ,(pinentry-lc-ctype pinentry))
+                                       ("LC_MESSAGES" . ,(pinentry-lc-messages pinentry))))))
         (if (and pass (not (string-empty? (string-trim-both pass))))
             (begin
               (format port "D ~a~!" pass)
@@ -362,7 +383,9 @@ Return the input from the user if succeeded else #f."
       ;; Can probably do this with a pipe in both direction, but
       ;; manual warns about deadlocks so sticking with this for now.
       (let ((button (confirm-program
-                     #:env `(("DISPLAY" . ,(pinentry-display pinentry)))
+                     #:env `(("DISPLAY" . ,(pinentry-display pinentry))
+                             ("LC_CTYPE" . ,(pinentry-lc-ctype pinentry))
+                             ("LC_MESSAGES" . ,(pinentry-lc-messages pinentry)))
                      #:visibility #t
                      #:only-match #t
                      #:buttons `(,(pinentry-ok-button pinentry)
@@ -378,7 +401,9 @@ Return the input from the user if succeeded else #f."
      ((or (set-and-return! regex-match (regexp-exec confirm-one-button-re line))
           (set-and-return! regex-match (regexp-exec message-re line)))
       (let ((button (confirm-program
-                     #:env `(("DISPLAY" . ,(pinentry-display pinentry)))
+                     #:env `(("DISPLAY" . ,(pinentry-display pinentry))
+                             ("LC_CTYPE" . ,(pinentry-lc-ctype pinentry))
+                             ("LC_MESSAGES" . ,(pinentry-lc-messages pinentry)))
                      #:visibility #t
                      #:only-match #t
                      #:buttons `(,(pinentry-ok-button pinentry))
diff --git a/scripts/pinentry-rofi.in b/scripts/pinentry-rofi.in
index d7c0d16..84c2f9b 100644
--- a/scripts/pinentry-rofi.in
+++ b/scripts/pinentry-rofi.in
@@ -46,7 +46,9 @@
                                   (let ((logfile (option-ref options 'log #f)))
                                     (when logfile
                                       (open-output-file
-                                       (format #f "~a.~a" logfile (getpid))))))))
+                                       (format #f "~a.~a" logfile (getpid)))))
+                                  "C"
+                                  "C")))
     (when (option-ref options 'help #f)
       (format #t "\
 Usage: ~a [OPTIONS]
diff --git a/tests/pinentry-rofi.scm b/tests/pinentry-rofi.scm
index b0b7b87..ac159b1 100755
--- a/tests/pinentry-rofi.scm
+++ b/tests/pinentry-rofi.scm
@@ -27,7 +27,7 @@
 (test-begin "pinentry-rofi")
 
 ;; (test-begin "pinentry")
-(let ((pinentry (make-pinentry #t "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #t "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry? pinentry))
   (test-assert (pinentry-ok pinentry))
   (test-equal "Prompt" (pinentry-prompt pinentry))
@@ -39,7 +39,7 @@
   (test-assert (not (pinentry-visibility pinentry)))
   (test-assert (not (pinentry-error pinentry))))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (not (pinentry-ok pinentry))))
 
 ;; (test-end "pinentry")
@@ -97,44 +97,68 @@
 (test-equal "Ok\n_Cancel"
   (input-string "_Ok\n__Cancel"))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (pinentry-set set-pinentry-notok-button! pinentry "Not ok")
   (test-equal "Not ok" (pinentry-notok-button pinentry))
   (test-assert (pinentry-ok pinentry)))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-error #t (pinentry-set pinentry-notok-button pinentry "Not ok")))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-option pinentry "OPTION default-ok=Okay"))
   (test-equal "Okay" (pinentry-ok-button pinentry))
   (test-equal "Cancel" (pinentry-cancel-button pinentry))
   (test-equal "Prompt" (pinentry-prompt pinentry))
+  (test-equal "C" (pinentry-lc-ctype pinentry))
+  (test-equal "C" (pinentry-lc-messages pinentry))
   (test-assert (pinentry-ok pinentry)))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-option pinentry "OPTION default-cancel=No"))
   (test-equal "Ok" (pinentry-ok-button pinentry))
   (test-equal "No" (pinentry-cancel-button pinentry))
   (test-equal "Prompt" (pinentry-prompt pinentry))
+  (test-equal "C" (pinentry-lc-ctype pinentry))
+  (test-equal "C" (pinentry-lc-messages pinentry))
   (test-assert (pinentry-ok pinentry)))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-option pinentry "OPTION default-prompt=Password:"))
   (test-equal "Ok" (pinentry-ok-button pinentry))
   (test-equal "Cancel" (pinentry-cancel-button pinentry))
   (test-equal "Password:" (pinentry-prompt pinentry))
+  (test-equal "C" (pinentry-lc-ctype pinentry))
+  (test-equal "C" (pinentry-lc-messages pinentry))
   (test-assert (pinentry-ok pinentry)))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+  (test-assert (pinentry-option pinentry "OPTION lc-ctype=en_US.UTF-8"))
+  (test-equal "Ok" (pinentry-ok-button pinentry))
+  (test-equal "Cancel" (pinentry-cancel-button pinentry))
+  (test-equal "Prompt" (pinentry-prompt pinentry))
+  (test-equal "en_US.UTF-8" (pinentry-lc-ctype pinentry))
+  (test-equal "C" (pinentry-lc-messages pinentry))
+  (test-assert (pinentry-ok pinentry)))
+
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
+  (test-assert (pinentry-option pinentry "OPTION lc-messages=en_US.UTF-8"))
+  (test-equal "Ok" (pinentry-ok-button pinentry))
+  (test-equal "Cancel" (pinentry-cancel-button pinentry))
+  (test-equal "Prompt" (pinentry-prompt pinentry))
+  (test-equal "C" (pinentry-lc-ctype pinentry))
+  (test-equal "en_US.UTF-8" (pinentry-lc-messages pinentry))
+  (test-assert (pinentry-ok pinentry)))
+
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-option pinentry "OPTION foo bar")))
 
-(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (not (pinentry-option pinentry " OPTION foo bar")))
   (test-assert (not (pinentry-option pinentry "OPTION")))
   (test-assert (not (pinentry-option pinentry "Foo"))))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log"))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C"))
        (output "")
        (fake-port (make-soft-port
                   (vector
@@ -151,14 +175,14 @@
   (test-assert (not (pinentry-getinfo pinentry "GETINFO")))
   (test-assert (not (pinentry-getinfo pinentry "Foo"))))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-setkeyinfo pinentry "SETKEYINFO Foo"))
   (test-assert (pinentry-ok pinentry))
   (test-assert (not (pinentry-setkeyinfo pinentry " SETKEYINFO foo bar")))
   (test-assert (not (pinentry-setkeyinfo pinentry "SETKEYINFO")))
   (test-assert (not (pinentry-setkeyinfo pinentry "Foo"))))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-setok pinentry "SETOK Foo"))
   (test-equal "Foo" (pinentry-ok-button pinentry))
   (test-assert (pinentry-ok pinentry))
@@ -171,7 +195,7 @@
   (test-assert (not (pinentry-setok pinentry "Foo")))
   (test-equal "Ok okay" (pinentry-ok-button pinentry)))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-setnotok pinentry "SETNOTOK Foo"))
   (test-equal "Foo" (pinentry-notok-button pinentry))
   (test-assert (pinentry-ok pinentry))
@@ -184,7 +208,7 @@
   (test-assert (not (pinentry-setnotok pinentry "Foo")))
   (test-equal "Not Ok" (pinentry-notok-button pinentry)))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-setcancel pinentry "SETCANCEL Foo"))
   (test-equal "Foo" (pinentry-cancel-button pinentry))
   (test-assert (pinentry-ok pinentry))
@@ -197,7 +221,7 @@
   (test-assert (not (pinentry-setcancel pinentry "Foo")))
   (test-equal "Abort" (pinentry-cancel-button pinentry)))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Desc" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Desc" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-setdesc pinentry "SETDESC Foo"))
   (test-equal "Foo" (pinentry-desc pinentry))
   (test-assert (pinentry-ok pinentry))
@@ -210,7 +234,7 @@
   (test-assert (not (pinentry-setdesc pinentry "Foo")))
   (test-equal "<u>T</u>his is a description&#10;<u>O</u>n two lines" (pinentry-desc pinentry)))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Error" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Error" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-seterror pinentry "SETERROR Foo"))
   (test-equal "Foo" (pinentry-error pinentry))
   (test-assert (pinentry-ok pinentry))
@@ -223,7 +247,7 @@
   (test-assert (not (pinentry-seterror pinentry "Foo")))
   (test-equal "<u>T</u>his is an error&#10;<u>O</u>n two lines" (pinentry-error pinentry)))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log" "C" "C")))
   (test-assert (pinentry-setprompt pinentry "SETPROMPT Foo"))
   (test-equal "Foo" (pinentry-prompt pinentry))
   (test-assert (pinentry-ok pinentry))
@@ -236,11 +260,11 @@
   (test-assert (not (pinentry-setprompt pinentry "Foo")))
   (test-equal "<u>T</u>his is a prompt&#10;<u>O</u>n two lines" (pinentry-prompt pinentry)))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log")))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Prompt" ":1" "test.log" "C" "C")))
   (test-error "(quit #t)" (pinentry-bye pinentry "BYE"))
   (test-assert (not (pinentry-bye pinentry "Hej då"))))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log"))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
        (output "")
        (fake-port (make-soft-port
                   (vector
@@ -267,7 +291,10 @@
                                   (test-assert (not visibility))
                                   (test-assert (not only-match))
                                   (test-assert (not buttons))
-                                  (test-equal `(("DISPLAY" . ,display)) env)
+                                  (test-equal `(("DISPLAY" . ,display)
+                                                ("LC_CTYPE" . "C")
+                                                ("LC_MESSAGES" . "en_US.UTF-8"))
+                                    env)
                                   "password")
                                 #:port fake-port))
   (test-equal (format #f "D password") output)
@@ -286,7 +313,10 @@
                                   (test-assert (not visibility))
                                   (test-assert (not only-match))
                                   (test-assert (not buttons))
-                                  (test-equal `(("DISPLAY" . ,display)) env)
+                                  (test-equal `(("DISPLAY" . ,display)
+                                                ("LC_CTYPE" . "C")
+                                                ("LC_MESSAGES" . "en_US.UTF-8"))
+                                    env)
                                   "password")
                                 #:port fake-port))
   (test-equal (format #f "D password") output)
@@ -304,7 +334,10 @@
                                   (test-assert (not visibility))
                                   (test-assert (not only-match))
                                   (test-assert (not buttons))
-                                  (test-equal `(("DISPLAY" . ,display)) env)
+                                  (test-equal `(("DISPLAY" . ,display)
+                                                ("LC_CTYPE" . "C")
+                                                ("LC_MESSAGES" . "en_US.UTF-8"))
+                                    env)
                                   "")
                                 #:port fake-port))
   (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output)
@@ -322,14 +355,17 @@
                                   (test-assert (not visibility))
                                   (test-assert (not only-match))
                                   (test-assert (not buttons))
-                                  (test-equal `(("DISPLAY" . ,display)) env)
+                                  (test-equal `(("DISPLAY" . ,display)
+                                                ("LC_CTYPE" . "C")
+                                                ("LC_MESSAGES" . "en_US.UTF-8"))
+                                    env)
                                   "  ")
                                 #:port fake-port))
   (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output)
   (test-assert (not (pinentry-getinfo pinentry " GETPIN")))
   (test-assert (not (pinentry-getinfo pinentry "Foo"))))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log"))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
        (description "This is a description")
        (error "Something went wrong")
        (display ":1"))
@@ -347,7 +383,10 @@
                                   (test-assert visibility)
                                   (test-assert only-match)
                                   (test-equal `("Ok" "Cancel") buttons)
-                                  (test-equal `(("DISPLAY" . ,display)) env)
+                                  (test-equal `(("DISPLAY" . ,display)
+                                                ("LC_CTYPE" . "C")
+                                                ("LC_MESSAGES" . "en_US.UTF-8"))
+                                    env)
                                   "Ok")))
   (test-assert (pinentry-ok pinentry))
   (set-pinentry-error! pinentry error)
@@ -375,7 +414,10 @@
                     (test-assert visibility)
                     (test-assert only-match)
                     (test-equal `("Ok" "Cancel") buttons)
-                    (test-equal `(("DISPLAY" . ,display)) env)
+                    (test-equal `(("DISPLAY" . ,display)
+                                  ("LC_CTYPE" . "C")
+                                  ("LC_MESSAGES" . "en_US.UTF-8"))
+                      env)
                     "Cancel")
                   #:port fake-port))
     (test-equal (format #f "ERR 277 Operation cancelled\n") output))
@@ -383,7 +425,7 @@
   (test-assert (not (pinentry-getinfo pinentry " CONFIRM")))
   (test-assert (not (pinentry-getinfo pinentry "Foo"))))
 
-(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log"))
+(let* ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log" "C" "en_US.UTF-8"))
        (description "This is a description")
        (display ":1"))
   (set-pinentry-desc! pinentry description)
@@ -400,7 +442,10 @@
                                   (test-assert visibility)
                                   (test-assert only-match)
                                   (test-equal `("Ok") buttons)
-                                  (test-equal `(("DISPLAY" . ,display)) env)
+                                  (test-equal `(("DISPLAY" . ,display)
+                                                ("LC_CTYPE" . "C")
+                                                ("LC_MESSAGES" . "en_US.UTF-8"))
+                                    env)
                                   "Ok")))
   (test-assert (pinentry-ok pinentry))
   (set-pinentry-ok! pinentry #f)
@@ -416,7 +461,10 @@
                                    (test-assert visibility)
                                    (test-assert only-match)
                                    (test-equal `("Ok") buttons)
-                                   (test-equal `(("DISPLAY" . ,display)) env)
+                                   (test-equal `(("DISPLAY" . ,display)
+                                                 ("LC_CTYPE" . "C")
+                                                 ("LC_MESSAGES" . "en_US.UTF-8"))
+                                     env)
                                    "Ok")))
   (test-assert (pinentry-ok pinentry))
   (test-assert (not (pinentry-getinfo pinentry " CONFIRM --one-button")))