diff options
| -rw-r--r-- | AUTHORS | 3 | ||||
| -rw-r--r-- | COPYING | 3 | ||||
| -rw-r--r-- | ChangeLog | 35 | ||||
| -rw-r--r-- | HACKING | 47 | ||||
| -rw-r--r-- | Makefile | 12 | ||||
| -rw-r--r-- | Makefile.am | 78 | ||||
| -rw-r--r-- | NEWS | 15 | ||||
| l--------- | README | 1 | ||||
| -rw-r--r-- | README.md | 33 | ||||
| -rw-r--r-- | README.org | 35 | ||||
| -rw-r--r-- | build-aux/test-driver.scm | 180 | ||||
| -rw-r--r-- | configure.ac | 35 | ||||
| -rw-r--r-- | doc/pinentry-rofi.texi | 69 | ||||
| -rw-r--r-- | guix.scm | 87 | ||||
| -rw-r--r-- | hall.scm | 30 | ||||
| -rwxr-xr-x | pinentry-rofi.scm | 78 | ||||
| -rw-r--r-- | pre-inst-env.in | 14 | ||||
| -rw-r--r-- | scripts/pinentry-rofi.in | 63 | ||||
| -rwxr-xr-x | tests/pinentry-rofi.scm (renamed from test.scm) | 221 |
19 files changed, 806 insertions, 233 deletions
@@ -0,0 +1,3 @@ +Contributers to Pinentry-Rofi 2.0.0: + + Fredrik Salomonsson <plattfot@gmail.com> @@ -0,0 +1,3 @@ +This project's license is GPL 3+. + +You can read the full license at https://www.gnu.org/licenses/gpl.html. diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..18282b2 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,35 @@ +2020-06-14 Fredrik Salomonsson <plattfot@gmail.com> + * 2.0.0: + Using Hall to handle the project. +2020-05-11 Fredrik Salomonsson <plattfot@gmail.com> + * 1.0.2: + Fixed crash when rofi is aborted. +2020-05-11 Fredrik Salomonsson <plattfot@gmail.com> + * 1.0.1: + Propper newline between error and description. + More unit test coverage. + Fixed hang when run via gpg, that was introduced in 1.0.0. +2020-05-11 Fredrik Salomonsson <plattfot@gmail.com> + * 1.0.0: + Added unit tests. + Added support for popup. + Added support for underline characters in message. + Fixed high CPU usage bug - thanks to em0lar and n0emis. +2020-04-21 Fredrik Salomonsson <plattfot@gmail.com> + * 0.5.0 : + Added support to ask again if password is wrong. +2019-06-06 Fredrik Salomonsson <plattfot@gmail.com> + * 0.4.0 : + Removed compiling of script. + Behaves better with the REPL. +2018-11-10 Fredrik Salomonsson <plattfot@gmail.com> + * 0.3.0 : + Removed dependency on systemd. + Works with gpg. + Removed conflict with pinentry-rofi. +2018-11-04 Fredrik Salomonsson <plattfot@gmail.com> + * 0.2.0 : + Forcing the output. +2018-11-04 Fredrik Salomonsson <plattfot@gmail.com> + * 0.1.0 : + Initial release. Matching functionality as the pinentry-rofi gist. @@ -0,0 +1,47 @@ +# -*- mode: org; coding: utf-8; -*- + +#+TITLE: Hacking pinentry-rofi + +* Contributing + +By far the easiest way to hack on pinentry-rofi is to develop using Guix: + +#+BEGIN_SRC bash + # Obtain the source code + cd /path/to/source-code + guix environment -l guix.scm + # In the new shell, run: + hall dist --execute && autoreconf -vif && ./configure && make check +#+END_SRC + +You can now hack this project's files to your heart's content, whilst +testing them from your `guix environment' shell. + +To try out any scripts in the project you can now use + +#+BEGIN_SRC bash + ./pre-inst-env scripts/${script-name} +#+END_SRC + +If you'd like to tidy the project again, but retain the ability to test the +project from the commandline, simply run: + +#+BEGIN_SRC bash + ./hall clean --skip "scripts/${script-name},pre-inst-env" --execute +#+END_SRC + +** Manual Installation + +If you do not yet use Guix, you will have to install this project's +dependencies manually: + - autoconf + - automake + - pkg-config + - texinfo + - guile-hall + +Once those dependencies are installed you can run: + +#+BEGIN_SRC bash + hall dist -x && autoreconf -vif && ./configure && make check +#+END_SRC diff --git a/Makefile b/Makefile deleted file mode 100644 index 18d9f8a..0000000 --- a/Makefile +++ /dev/null @@ -1,12 +0,0 @@ - -PREFIX ?= -PREFIX_BIN ?= $(PREFIX)/usr/bin - -.PHONY: install -install: - @install -DT pinentry-rofi.scm $(PREFIX_BIN)/pinentry-rofi-guile - -.PHONY: test -test: - @./test.scm - diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..d499bf6 --- /dev/null +++ b/Makefile.am @@ -0,0 +1,78 @@ + + +bin_SCRIPTS = scripts/pinentry-rofi + +# Handle substitution of fully-expanded Autoconf variables. +do_subst = $(SED) \ + -e 's,[@]GUILE[@],$(GUILE),g' \ + -e 's,[@]guilemoduledir[@],$(guilemoduledir),g' \ + -e 's,[@]guileobjectdir[@],$(guileobjectdir),g' \ + -e 's,[@]localedir[@],$(localedir),g' + +nodist_noinst_SCRIPTS = pre-inst-env + +GOBJECTS = $(SOURCES:%.scm=%.go) + +moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) +godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache +ccachedir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_go_DATA = $(GOBJECTS) + +# Make sure source files are installed first, so that the mtime of +# installed compiled files is greater than that of installed source +# files. See +# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html> +# for details. +guile_install_go_files = install-nobase_goDATA +$(guile_install_go_files): install-nobase_modDATA + +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<" + +SOURCES = pinentry-rofi.scm + +TESTS = tests/pinentry-rofi.scm + +TEST_EXTENSIONS = .scm +SCM_LOG_DRIVER = \ + $(top_builddir)/pre-inst-env \ + $(GUILE) --no-auto-compile -e main \ + $(top_srcdir)/build-aux/test-driver.scm + +# Tell 'build-aux/test-driver.scm' to display only source file names, +# not indivdual test names. +AM_SCM_LOG_DRIVER_FLAGS = --brief=yes + +AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)" + +AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" + +info_TEXINFOS = doc/pinentry-rofi.texi +dvi: # Don't build dvi docs + +EXTRA_DIST += README.org \ + README \ + AUTHORS \ + NEWS \ + HACKING \ + COPYING \ + ChangeLog \ + guix.scm \ + hall.scm \ + build-aux/test-driver.scm \ + $(TESTS) + +ACLOCAL_AMFLAGS = -I m4 + +clean-go: + -$(RM) $(GOBJECTS) +.PHONY: clean-go + +CLEANFILES = \ + $(GOBJECTS) \ + $(TESTS:tests/%.scm=%.log) @@ -0,0 +1,15 @@ +# -*- mode: org; coding: utf-8; -*- + +#+TITLE: Pinentry-Rofi NEWS – history of user-visible changes +#+STARTUP: content hidestars + +Copyright © (2020) Fredrik Salomonsson <plattfot@gmail.com> + + 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. + +Please file bugs for pinentry-rofi at [[https://github.com/plattfot/pinentry-rofi]] + +Please see the [[file:ChangeLog][ChangeLog]] for what changed in pinentry-rofi. + @@ -0,0 +1 @@ +README.org
\ No newline at end of file diff --git a/README.md b/README.md deleted file mode 100644 index cedc669..0000000 --- a/README.md +++ /dev/null @@ -1,33 +0,0 @@ - -# Description -Based on [this gist](https://gist.github.com/sardemff7/759cbf956bea20d382a6128c641d2746) - -Simple pinentry gui using rofi written in GNU guile. - -It's similar in functionality as the gist but this one doesn't force -the width to be 27 and doesn't depend on systemd. - -I also wanted a small project which I could use to practice writing -GNU guile. - -# Install -## From source - -```bash -$ git clone https://github.com/plattfot/pinentry-rofi.git -$ cd pinentry-rofi -$ make PREFIX=<install dir> -``` - -Where <install dir> is where you want to install it. By default it -will install the script in /usr/bin and the compiled source to where -the site cache for guile is configured to. - -## Arch Linux -Clone my aur reop and the build the package using the PKGBUILD: - -```bash -$ git clone https://github.com/plattfot/pinentry-rofi-aur.git -$ cd pinentry-rofi-aur -$ makepkg -ic -``` diff --git a/README.org b/README.org new file mode 100644 index 0000000..1d97413 --- /dev/null +++ b/README.org @@ -0,0 +1,35 @@ +# -*- mode: org; coding: utf-8; -*- + +#+TITLE: README for Pinentry-Rofi + +* Description + Based on [[https://gist.github.com/sardemff7/759cbf956bea20d382a6128c641d2746][this gist]] + + Simple pinentry gui using rofi written in GNU guile. + + It's similar in functionality as the gist but this one doesn't force + the width to be 27 and doesn't depend on systemd. + + I also wanted a small project which I could use to practice writing + GNU guile. + +* 2.0.0 Breaking changes please read + + As of version 2.0.0, =pinentry-rofi= is now built using [[https://www.gnu.org/software/automake][automake]]. + See [[file:HACKING][HACKING]] for more info on that. It also lost its =-guile= suffix + for the executable. And it is no longer just one file, most of its + content is now a [[https://www.gnu.org/software/guile/manual/html_node/General-Information-about-Modules.html][guile module]], which the executable now calls. + +* Install +** From Source + + See [[file:HACKING][HACKING]] on how to build this from source + +** Arch Linux + Clone my aur reop and the build the package using the PKGBUILD: + + #+begin_src bash + git clone https://github.com/plattfot/pinentry-rofi-aur.git + cd pinentry-rofi-aur + makepkg -ic + #+end_src diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm new file mode 100644 index 0000000..a818968 --- /dev/null +++ b/build-aux/test-driver.scm @@ -0,0 +1,180 @@ + +;;;; test-driver.scm - Guile test driver for Automake testsuite harness + +(define script-version "2019-01-15.13") ;UTC + +;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2019 Alex Sassmannshausen <alex@pompo.co> +;;; +;;; This program is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;;; Commentary: +;;; +;;; This script provides a Guile test driver using the SRFI-64 Scheme API for +;;; test suites. SRFI-64 is distributed with Guile since version 2.0.9. +;;; +;;; This script is a lightly modified version of the orignal written by +;;; Matthieu Lirzin. The changes make it suitable for use as part of the +;;; guile-hall infrastructure. +;;; +;;;; Code: + +(use-modules (ice-9 getopt-long) + (ice-9 pretty-print) + (srfi srfi-26) + (srfi srfi-64)) + +(define (show-help) + (display "Usage: + test-driver --test-name=NAME --log-file=PATH --trs-file=PATH + [--expect-failure={yes|no}] [--color-tests={yes|no}] + [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] + TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] +The '--test-name', '--log-file' and '--trs-file' options are mandatory. +")) + +(define %options + '((test-name (value #t)) + (log-file (value #t)) + (trs-file (value #t)) + (color-tests (value #t)) + (expect-failure (value #t)) ;XXX: not implemented yet + (enable-hard-errors (value #t)) ;not implemented in SRFI-64 + (brief (value #t)) + (help (single-char #\h) (value #f)) + (version (single-char #\V) (value #f)))) + +(define (option->boolean options key) + "Return #t if the value associated with KEY in OPTIONS is 'yes'." + (and=> (option-ref options key #f) (cut string=? <> "yes"))) + +(define* (test-display field value #:optional (port (current-output-port)) + #:key pretty?) + "Display 'FIELD: VALUE\n' on PORT." + (if pretty? + (begin + (format port "~A:~%" field) + (pretty-print value port #:per-line-prefix "+ ")) + (format port "~A: ~S~%" field value))) + +(define* (result->string symbol #:key colorize?) + "Return SYMBOL as an upper case string. Use colors when COLORIZE is #t." + (let ((result (string-upcase (symbol->string symbol)))) + (if colorize? + (string-append (case symbol + ((pass) "[0;32m") ;green + ((xfail) "[1;32m") ;light green + ((skip) "[1;34m") ;blue + ((fail xpass) "[0;31m") ;red + ((error) "[0;35m")) ;magenta + result + "[m") ;no color + result))) + +(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port) + "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the +file name of the current the test. COLOR? specifies whether to use colors, +and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The +current output port is supposed to be redirected to a '.log' file." + + (define (test-on-test-begin-gnu runner) + ;; Procedure called at the start of an individual test case, before the + ;; test expression (and expected value) are evaluated. + (let ((result (cute assq-ref (test-result-alist runner) <>))) + (format #t "test-name: ~A~%" (result 'test-name)) + (format #t "location: ~A~%" + (string-append (result 'source-file) ":" + (number->string (result 'source-line)))) + (test-display "source" (result 'source-form) #:pretty? #t))) + + (define (test-on-test-end-gnu runner) + ;; Procedure called at the end of an individual test case, when the result + ;; of the test is available. + (let* ((results (test-result-alist runner)) + (result? (cut assq <> results)) + (result (cut assq-ref results <>))) + (unless brief? + ;; Display the result of each test case on the console. + (format out-port "~A: ~A - ~A~%" + (result->string (test-result-kind runner) #:colorize? color?) + test-name (test-runner-test-name runner))) + (when (result? 'expected-value) + (test-display "expected-value" (result 'expected-value))) + (when (result? 'expected-error) + (test-display "expected-error" (result 'expected-error) #:pretty? #t)) + (when (result? 'actual-value) + (test-display "actual-value" (result 'actual-value))) + (when (result? 'actual-error) + (test-display "actual-error" (result 'actual-error) #:pretty? #t)) + (format #t "result: ~a~%" (result->string (result 'result-kind))) + (newline) + (format trs-port ":test-result: ~A ~A~%" + (result->string (test-result-kind runner)) + (test-runner-test-name runner)))) + + (define (test-on-group-end-gnu runner) + ;; Procedure called by a 'test-end', including at the end of a test-group. + (let ((fail (or (positive? (test-runner-fail-count runner)) + (positive? (test-runner-xpass-count runner)))) + (skip (or (positive? (test-runner-skip-count runner)) + (positive? (test-runner-xfail-count runner))))) + ;; XXX: The global results need some refinements for XPASS. + (format trs-port ":global-test-result: ~A~%" + (if fail "FAIL" (if skip "SKIP" "PASS"))) + (format trs-port ":recheck: ~A~%" + (if fail "yes" "no")) + (format trs-port ":copy-in-global-log: ~A~%" + (if (or fail skip) "yes" "no")) + (when brief? + ;; Display the global test group result on the console. + (format out-port "~A: ~A~%" + (result->string (if fail 'fail (if skip 'skip 'pass)) + #:colorize? color?) + test-name)) + #f)) + + (let ((runner (test-runner-null))) + (test-runner-on-test-begin! runner test-on-test-begin-gnu) + (test-runner-on-test-end! runner test-on-test-end-gnu) + (test-runner-on-group-end! runner test-on-group-end-gnu) + (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple) + runner)) + +;;; +;;; Entry point. +;;; + +(define (main . args) + (let* ((opts (getopt-long (command-line) %options)) + (option (cut option-ref opts <> <>))) + (cond + ((option 'help #f) (show-help)) + ((option 'version #f) (format #t "test-driver.scm ~A" script-version)) + (else + (let ((log (open-file (option 'log-file "") "w0")) + (trs (open-file (option 'trs-file "") "wl")) + (out (duplicate-port (current-output-port) "wl"))) + (redirect-port log (current-output-port)) + (redirect-port log (current-warning-port)) + (redirect-port log (current-error-port)) + (test-with-runner + (test-runner-gnu (option 'test-name #f) + #:color? (option->boolean opts 'color-tests) + #:brief? (option->boolean opts 'brief) + #:out-port out #:trs-port trs) + (load-from-path (option 'test-name #f))) + (close-port log) + (close-port trs) + (close-port out)))) + (exit 0))) diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..3b625aa --- /dev/null +++ b/configure.ac @@ -0,0 +1,35 @@ + +dnl -*- Autoconf -*- + +AC_INIT(pinentry-rofi, 2.0.0) +AC_SUBST(HVERSION, "\"2.0.0\"") +AC_SUBST(AUTHOR, "\"Fredrik Salomonsson\"") +AC_SUBST(COPYRIGHT, "'(2020)") +AC_SUBST(LICENSE, gpl3+) +AC_CONFIG_SRCDIR(pinentry-rofi.scm) +AC_CONFIG_AUX_DIR([build-aux]) +AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects color-tests parallel-tests -Woverride -Wno-portability]) +AM_SILENT_RULES([yes]) + +AC_CONFIG_FILES([Makefile]) +AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) +AC_CONFIG_FILES([scripts/pinentry-rofi],[chmod +x scripts/pinentry-rofi]) +dnl Search for 'guile' and 'guild'. This macro defines +dnl 'GUILE_EFFECTIVE_VERSION'. +GUILE_PKG([3.0 2.2 2.0]) +GUILE_PROGS +GUILE_SITE_DIR +if test "x$GUILD" = "x"; then + AC_MSG_ERROR(['guild' binary not found; please check your guile-2.x installation.]) +fi + +dnl Hall auto-generated guile-module dependencies + + +dnl Installation directories for .scm and .go files. +guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION" +guileobjectdir="${libdir}/guile/$GUILE_EFFECTIVE_VERSION/site-ccache" +AC_SUBST([guilemoduledir]) +AC_SUBST([guileobjectdir]) + +AC_OUTPUT diff --git a/doc/pinentry-rofi.texi b/doc/pinentry-rofi.texi new file mode 100644 index 0000000..288de38 --- /dev/null +++ b/doc/pinentry-rofi.texi @@ -0,0 +1,69 @@ + +\input texinfo +@c -*-texinfo-*- + +@c %**start of header +@setfilename pinentry-rofi.info +@documentencoding UTF-8 +@settitle Pinentry-Rofi Reference Manual +@c %**end of header + +@include version.texi + +@copying +Copyright @copyright{} 2020 Fredrik Salomonsson + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A +copy of the license is included in the section entitled ``GNU Free +Documentation License''. +@end copying + +@dircategory The Algorithmic Language Scheme +@direntry +* Pinentry-Rofi: (pinentry-rofi). +@end direntry + +@titlepage +@title The Pinentry-Rofi Manual +@author Fredrik Salomonsson + +@page +@vskip 0pt plus 1filll +Edition @value{EDITION} @* +@value{UPDATED} @* + +@insertcopying +@end titlepage + +@contents + +@c ********************************************************************* +@node Top +@top Pinentry-Rofi + +This document describes Pinentry-Rofi version @value{VERSION}. + +@menu +* Introduction:: Why Pinentry-Rofi? +@end menu + +@c ********************************************************************* +@node Introduction +@chapter Introduction + +Based on +@url{https://gist.github.com/sardemff7/759cbf956bea20d382a6128c641d2746,this +gist} + +Simple pinentry gui using @command{rofi} written in GNU guile. + +It's similar in functionality as the gist but this one doesn't force +the width to be 27 and doesn't depend on systemd. + +I also wanted a small project which I could use to practice writing +GNU guile. + +@bye diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..0734e8a --- /dev/null +++ b/guix.scm @@ -0,0 +1,87 @@ +(use-modules + (guix packages) + ((guix licenses) #:prefix license:) + (guix download) + (guix build-system gnu) + (gnu packages) + (gnu packages autotools) + (gnu packages guile) + (gnu packages guile-xyz) + (gnu packages pkg-config) + (gnu packages texinfo)) + +(package + (name "pinentry-rofi") + (version "2.0.0") + (source "./pinentry-rofi-2.0.0.tar.gz") + (build-system gnu-build-system) + (arguments + `(#:modules + ((ice-9 match) + (ice-9 ftw) + ,@%gnu-build-system-modules) + #:phases + (modify-phases + %standard-phases + (add-after + 'install + 'hall-wrap-binaries + (lambda* (#:key inputs outputs #:allow-other-keys) + (let* ((compiled-dir + (lambda (out version) + (string-append + out + "/lib/guile/" + version + "/site-ccache"))) + (uncompiled-dir + (lambda (out version) + (string-append + out + "/share/guile/site" + (if (string-null? version) "" "/") + version))) + (dep-path + (lambda (env modules path) + (list env + ":" + 'prefix + (cons modules + (map (lambda (input) + (string-append + (assoc-ref inputs input) + path)) + ,''()))))) + (out (assoc-ref outputs "out")) + (bin (string-append out "/bin/")) + (site (uncompiled-dir out ""))) + (match (scandir site) + (("." ".." version) + (for-each + (lambda (file) + (wrap-program + (string-append bin file) + (dep-path + "GUILE_LOAD_PATH" + (uncompiled-dir out version) + (uncompiled-dir "" version)) + (dep-path + "GUILE_LOAD_COMPILED_PATH" + (compiled-dir out version) + (compiled-dir "" version)))) + ,''("pinentry-rofi")) + #t)))))))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo))) + (inputs `(("guile" ,guile-3.0))) + (propagated-inputs `()) + (synopsis "Rofi frontend to pinentry") + (description + "Simple pinentry gui using rofi, it is written in GNU guile.") + (home-page + "https://github.com/plattfot/pinentry-rofi/") + (license license:gpl3+)) + diff --git a/hall.scm b/hall.scm new file mode 100644 index 0000000..3a2178c --- /dev/null +++ b/hall.scm @@ -0,0 +1,30 @@ +(hall-description + (name "pinentry-rofi") + (prefix "") + (version "2.0.0") + (author "Fredrik Salomonsson") + (copyright (2020)) + (synopsis "Rofi frontend to pinentry") + (description + "Simple pinentry gui using rofi, it is written in GNU guile.") + (home-page + "https://github.com/plattfot/pinentry-rofi/") + (license gpl3+) + (dependencies `()) + (files (libraries ((scheme-file "pinentry-rofi"))) + (tests ((directory + "tests" + ((scheme-file "pinentry-rofi"))))) + (programs + ((directory "scripts" ((in-file "pinentry-rofi"))))) + (documentation + ((org-file "README") + (symlink "README" "README.org") + (text-file "AUTHORS") + (text-file "NEWS") + (text-file "HACKING") + (text-file "COPYING") + (directory "doc" ((texi-file "pinentry-rofi"))) + (text-file "ChangeLog"))) + (infrastructure + ((scheme-file "guix") (scheme-file "hall"))))) diff --git a/pinentry-rofi.scm b/pinentry-rofi.scm index d016e04..aec9acd 100755 --- a/pinentry-rofi.scm +++ b/pinentry-rofi.scm @@ -1,7 +1,3 @@ -#! /usr/bin/guile \ ---no-auto-compile -e (pinentry-rofi) -s -!# - ;; Copyright © 2016 Quentin "Sardem FF7" Glidic ;; Copyright © 2018-2020 Fredrik "PlaTFooT" Salomonsson ;; @@ -30,10 +26,7 @@ #:use-module (srfi srfi-9) ;; For records #:use-module (ice-9 format) #:use-module (ice-9 regex) - #:use-module (ice-9 getopt-long) - #:export (main - pinentry-rofi-guile-version - make-pinentry + #:export (make-pinentry pinentry? pinentry-ok set-pinentry-ok! pinentry-prompt set-pinentry-prompt! @@ -76,9 +69,6 @@ pinentry-bye pinentry-loop)) - -(define pinentry-rofi-guile-version "1.0.1") - (when (equal? (system-file-name-convention) 'windows) (format #t "Only support posix systems!") (exit #f)) @@ -213,7 +203,7 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" ((set-and-return! regex-match (regexp-exec option-re line)))) regex-match)) -(define (pinentry-getinfo pinentry line) +(define* (pinentry-getinfo pinentry line #:key (port #t)) "Process line if it starts with GETINFO" (let ((getinfo-re (make-regexp "^GETINFO (.+)$")) (regex-match #f)) @@ -221,8 +211,7 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent" (let ((info (match:substring regex-match 1))) (cond ((string=? info "pid") - (format #t "D ~a\n" (getpid)) - (force-output)))) + (format port "D ~a~%~!" (getpid))))) (set-pinentry-ok! pinentry #t)) regex-match)) @@ -344,7 +333,7 @@ Return the input from the user if succeeded else #f." (pinentry-desc pinentry)) (pinentry-desc pinentry))) -(define (pinentry-getpin pinentry line pin-program) +(define* (pinentry-getpin pinentry line pin-program #:key (port #t)) "Get pin using PIN-PROGRAM if LINE is equal to GETPIN." (let ((getpin-re (make-regexp "^GETPIN$")) (regex-match #f)) @@ -355,16 +344,14 @@ Return the input from the user if succeeded else #f." #:env `(("DISPLAY" . ,(pinentry-display pinentry)))))) (if (and pass (not (string-empty? (string-trim-both pass)))) (begin - (format #t "D ~a" pass) - (force-output) + (format port "D ~a~!" pass) (set-pinentry-ok! pinentry #t)) (begin - (format #t "ERR 83886179 Operation cancelled <rofi>\n") - (force-output) + (format port "ERR 83886179 Operation cancelled <rofi>~%~!") (set-pinentry-ok! pinentry #f))))) regex-match)) -(define (pinentry-confirm pinentry line confirm-program) +(define* (pinentry-confirm pinentry line confirm-program #:key (port #t)) (let ((confirm-re (make-regexp "^CONFIRM$")) (confirm-one-button-re (make-regexp "^CONFIRM[[:blank:]]+--one-button[[:blank:]]*$")) @@ -386,8 +373,7 @@ Return the input from the user if succeeded else #f." (string=? (string-trim-right button) (pinentry-ok-button pinentry))) (set-pinentry-ok! pinentry #t) (begin - (format #t "ERR 277 Operation cancelled\n") - (force-output) + (format port "ERR 277 Operation cancelled~%~!") (set-pinentry-ok! pinentry #f))))) ((or (set-and-return! regex-match (regexp-exec confirm-one-button-re line)) (set-and-return! regex-match (regexp-exec message-re line))) @@ -401,8 +387,7 @@ Return the input from the user if succeeded else #f." (string=? (string-trim-right button) (pinentry-ok-button pinentry))) (set-pinentry-ok! pinentry #t) (begin - (format #t "ERR 277 Operation cancelled\n") - (force-output) + (format port "ERR 277 Operation cancelled~%~!") (set-pinentry-ok! pinentry #f)))))) regex-match)) @@ -432,49 +417,10 @@ Return the input from the user if succeeded else #f." (#t (begin (let ((log (pinentry-logfile pinentry))) (when (file-port? log) - (format log "Unknown command: ~s\n" line) - (force-output log))) + (format log "Unknown command: ~s~%~!" line))) ;; GPG_ERR_ASS_UNKNOWN_CMD = 275, - (format #t "ERR 275 Unknown command ~s\n" line) - (force-output) + (format #t "ERR 275 Unknown command ~s~%~!" line) (set-pinentry-ok! pinentry #f)))) (when (pinentry-ok pinentry) - (format #t "OK\n") - (force-output)) + (format #t "OK~%~!")) (pinentry-loop pinentry input-port)))) - -(define (main args) - (let* ((option-spec - '((display (single-char #\d) (value #t)) - (xauthority (single-char #\a) (value #t)) - (version (single-char #\v) (value #f)) - (log (value #t)) - (help (single-char #\h) (value #f)))) - (default-display ":0") - (options (getopt-long (command-line) option-spec)) - (pinentry (make-pinentry #t "Passphrase:" "Ok" "Cancel" - (option-ref options 'display default-display) - (let ((logfile (option-ref options 'log #f))) - (when logfile - (open-output-file - (format #f "~a.~a" logfile (getpid)))))))) - (when (option-ref options 'help #f) - (format #t "\ -Usage: ~a [OPTIONS] -Options: - -d, --display DISPLAY Set display, default is ~s. - --log LOGFILE Log unknown commands to LOGFILE - -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)))) diff --git a/pre-inst-env.in b/pre-inst-env.in new file mode 100644 index 0000000..1556fcd --- /dev/null +++ b/pre-inst-env.in @@ -0,0 +1,14 @@ + +#!/bin/sh + +abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" +abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" + +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH + +PATH="$abs_top_builddir/scripts:$PATH" +export PATH + +exec "$@" diff --git a/scripts/pinentry-rofi.in b/scripts/pinentry-rofi.in new file mode 100644 index 0000000..47a85e5 --- /dev/null +++ b/scripts/pinentry-rofi.in @@ -0,0 +1,63 @@ +#! /usr/bin/guile \ +--no-auto-compile -e main -s +!# +;; bin/pinentry-rofi --- pinentry-rofi cli -*- coding: utf-8 -*- +;; Copyright © 2016 Quentin "Sardem FF7" Glidic +;; Copyright © 2018-2020 Fredrik "PlaTFooT" Salomonsson +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy +;; of this software and associated documentation files (the "Software"), to deal +;; in the Software without restriction, including without limitation the rights +;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +;; copies of the Software, and to permit persons to whom the Software is +;; furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in +;; all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +;; THE SOFTWARE. + +(use-modules (ice-9 getopt-long) + (ice-9 format) + (pinentry-rofi)) +(define (main args) + (let* ((option-spec + '((display (single-char #\d) (value #t)) + (xauthority (single-char #\a) (value #t)) + (version (single-char #\v) (value #f)) + (log (value #t)) + (help (single-char #\h) (value #f)))) + (default-display ":0") + (options (getopt-long (command-line) option-spec)) + (pinentry (make-pinentry #t "Passphrase:" "Ok" "Cancel" + (option-ref options 'display default-display) + (let ((logfile (option-ref options 'log #f))) + (when logfile + (open-output-file + (format #f "~a.~a" logfile (getpid)))))))) + (when (option-ref options 'help #f) + (format #t "\ +Usage: ~a [OPTIONS] +Options: + -d, --display DISPLAY Set display, default is ~s. + --log LOGFILE Log unknown commands to LOGFILE + -v, --version Display version. + -h, --help Display this help. +Author: +@AUTHOR@ +" + (car (command-line)) + default-display) + (exit #t)) + (when (option-ref options 'version #f) + (format #t "@HVERSION@\n") + (exit #t)) + (format #t "OK Please go ahead\n") + (force-output) + (pinentry-loop pinentry (current-input-port)))) diff --git a/test.scm b/tests/pinentry-rofi.scm index e7051b3..b0b7b87 100755 --- a/test.scm +++ b/tests/pinentry-rofi.scm @@ -1,7 +1,3 @@ -#!/usr/bin/guile \ ---no-auto-compile -l pinentry-rofi.scm -s -!# - ;; Copyright © 2020 Fredrik "PlaTFooT" Salomonsson ;; ;; Permission is hereby granted, free of charge, to any person obtaining a copy @@ -22,16 +18,15 @@ ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN ;; THE SOFTWARE. - -(use-modules (srfi srfi-64) - (ice-9 popen) - (ice-9 textual-ports) - (pinentry-rofi)) +(define-module (tests-pinentry-rofi) + #:use-module (srfi srfi-64) + #:use-module (ice-9 popen) + #:use-module (ice-9 textual-ports) + #:use-module (pinentry-rofi)) (test-begin "pinentry-rofi") -(test-assert (string? pinentry-rofi-guile-version)) -(test-begin "pinentry") +;; (test-begin "pinentry") (let ((pinentry (make-pinentry #t "Prompt" "Ok" "Cancel" ":1" "test.log"))) (test-assert (pinentry? pinentry)) (test-assert (pinentry-ok pinentry)) @@ -47,9 +42,9 @@ (let ((pinentry (make-pinentry #f "Prompt" "Ok" "Cancel" ":1" "test.log"))) (test-assert (not (pinentry-ok pinentry)))) -(test-end "pinentry") +;; (test-end "pinentry") -(test-begin "utils") +;; (test-begin "utils") (test-equal "Ok" (remove-underline "_Ok")) (test-equal " Ok" (remove-underline " _Ok")) @@ -71,12 +66,12 @@ (test-assert (string-empty? "")) (test-assert (not (string-empty? "foo"))) -(test-end "utils") +;; (test-end "utils") (test-equal "This is one line\nThis is another%OA" (hex->char "%54his is one line%0AThis is another%OA")) -(test-begin "html") +;; (test-begin "html") (test-equal "%54his is one line This is another%OA" (html-newline "%54his is one line%0AThis is another%OA")) (test-equal "%54his is one line\nThis is another%OA" @@ -91,7 +86,7 @@ (test-equal "<u>O</u>k%0A<u>C</u>ancel" (html-underline "_Ok%0A_Cancel")) (test-equal "<u>O</u>k <u>C</u>ancel" (html-underline "_Ok _Cancel")) -(test-end "html") +;; (test-end "html") (test-equal "<u>T</u>his is one line <u>T</u>his is another%OA" (pango-markup "_%54his is one line%0A_This is another%OA")) @@ -149,12 +144,8 @@ #f (lambda () #t)) "w"))) - (with-output-to-port - fake-port - (lambda () - (test-assert (pinentry-getinfo pinentry "GETINFO pid")) - (test-equal (format #f "D ~a\n" (getpid)) output))) - + (test-assert (pinentry-getinfo pinentry "GETINFO pid" #:port fake-port)) + (test-equal (format #f "D ~a\n" (getpid)) output) (test-assert (pinentry-getinfo pinentry "GETINFO foo bar")) (test-assert (not (pinentry-getinfo pinentry " GETINFO foo bar"))) (test-assert (not (pinentry-getinfo pinentry "GETINFO"))) @@ -264,89 +255,77 @@ (display ":1")) (set-pinentry-desc! pinentry description) (set-pinentry-display! pinentry display) - (with-output-to-port - fake-port - (lambda () - (test-assert (pinentry-getpin pinentry "GETPIN" - (lambda* (#:key (env '()) - visibility - (prompt ">") - message - buttons - only-match) - (test-equal "Prompt" prompt) - (test-equal description message) - (test-assert (not visibility)) - (test-assert (not only-match)) - (test-assert (not buttons)) - (test-equal `(("DISPLAY" . ,display)) env) - "password"))) - (test-equal (format #f "D password") output))) - + (test-assert (pinentry-getpin pinentry "GETPIN" + (lambda* (#:key (env '()) + visibility + (prompt ">") + message + buttons + only-match) + (test-equal "Prompt" prompt) + (test-equal description message) + (test-assert (not visibility)) + (test-assert (not only-match)) + (test-assert (not buttons)) + (test-equal `(("DISPLAY" . ,display)) env) + "password") + #:port fake-port)) + (test-equal (format #f "D password") output) (set-pinentry-error! pinentry error) (set! output "") - (with-output-to-port - fake-port - (lambda () - (test-assert (pinentry-getpin pinentry "GETPIN" - (lambda* (#:key (env '()) - visibility - (prompt ">") - message - buttons - only-match) - (test-equal "Prompt" prompt) - (test-equal (format #f "~a ~a" error description) - message) - (test-assert (not visibility)) - (test-assert (not only-match)) - (test-assert (not buttons)) - (test-equal `(("DISPLAY" . ,display)) env) - "password"))) - (test-equal (format #f "D password") output))) - + (test-assert (pinentry-getpin pinentry "GETPIN" + (lambda* (#:key (env '()) + visibility + (prompt ">") + message + buttons + only-match) + (test-equal "Prompt" prompt) + (test-equal (format #f "~a ~a" error description) + message) + (test-assert (not visibility)) + (test-assert (not only-match)) + (test-assert (not buttons)) + (test-equal `(("DISPLAY" . ,display)) env) + "password") + #:port fake-port)) + (test-equal (format #f "D password") output) (set! output "") - (with-output-to-port - fake-port - (lambda () - (test-assert (pinentry-getpin pinentry "GETPIN" - (lambda* (#:key (env '()) - visibility - (prompt ">") - message - buttons - only-match) - (test-equal "Prompt" prompt) - (test-equal (format #f "~a ~a" error description) - message) - (test-assert (not visibility)) - (test-assert (not only-match)) - (test-assert (not buttons)) - (test-equal `(("DISPLAY" . ,display)) env) - ""))) - (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output))) - + (test-assert (pinentry-getpin pinentry "GETPIN" + (lambda* (#:key (env '()) + visibility + (prompt ">") + message + buttons + only-match) + (test-equal "Prompt" prompt) + (test-equal (format #f "~a ~a" error description) + message) + (test-assert (not visibility)) + (test-assert (not only-match)) + (test-assert (not buttons)) + (test-equal `(("DISPLAY" . ,display)) env) + "") + #:port fake-port)) + (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output) (set! output "") - (with-output-to-port - fake-port - (lambda () - (test-assert (pinentry-getpin pinentry "GETPIN" - (lambda* (#:key (env '()) - visibility - (prompt ">") - message - buttons - only-match) - (test-equal "Prompt" prompt) - (test-equal (format #f "~a ~a" error description) - message) - (test-assert (not visibility)) - (test-assert (not only-match)) - (test-assert (not buttons)) - (test-equal `(("DISPLAY" . ,display)) env) - " "))) - (test-equal (format #f "ERR 83886179 Operation cancelled <rofi>\n") output))) - + (test-assert (pinentry-getpin pinentry "GETPIN" + (lambda* (#:key (env '()) + visibility + (prompt ">") + message + buttons + only-match) + (test-equal "Prompt" prompt) + (test-equal (format #f "~a ~a" error description) + message) + (test-assert (not visibility)) + (test-assert (not only-match)) + (test-assert (not buttons)) + (test-equal `(("DISPLAY" . ,display)) 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")))) @@ -381,27 +360,25 @@ #f (lambda () #t)) "w"))) - (with-output-to-port - fake-port - (lambda () - (test-assert (pinentry-confirm - pinentry - "CONFIRM" - (lambda* (#:key (env '()) - visibility - (prompt ">") - message - buttons - only-match) - (test-equal ">" prompt) - (test-equal (format #f "~a ~a" error description) - message) - (test-assert visibility) - (test-assert only-match) - (test-equal `("Ok" "Cancel") buttons) - (test-equal `(("DISPLAY" . ,display)) env) - "Cancel"))) - (test-equal (format #f "ERR 277 Operation cancelled\n") output)))) + (test-assert (pinentry-confirm + pinentry + "CONFIRM" + (lambda* (#:key (env '()) + visibility + (prompt ">") + message + buttons + only-match) + (test-equal ">" prompt) + (test-equal (format #f "~a ~a" error description) + message) + (test-assert visibility) + (test-assert only-match) + (test-equal `("Ok" "Cancel") buttons) + (test-equal `(("DISPLAY" . ,display)) env) + "Cancel") + #:port fake-port)) + (test-equal (format #f "ERR 277 Operation cancelled\n") output)) (test-assert (not (pinentry-ok pinentry))) (test-assert (not (pinentry-getinfo pinentry " CONFIRM"))) (test-assert (not (pinentry-getinfo pinentry "Foo")))) |