diff options
author | David Thompson <dthompson2@worcester.edu> | 2015-08-17 22:27:26 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2015-08-17 22:27:26 -0400 |
commit | 288969b63fa8492f741fe89ba194920b5efd0400 (patch) | |
tree | 4278439f4a53179535a50f04de7ac1f01085f1b5 | |
parent | 9b3a17e3817fb47b1414aa0480948cbbcc03ca16 (diff) |
Add X clipboard support.
* configure.ac (XCLIP): New variable.
* package.scm: Add xclip dependency.
* shroud/config.scm: Untrack. Now automatically generated.
* shroud/config.scm.in: New file.
* shroud/utils.scm (call-with-clipboard): New procedure.
* shroud/ui/show.scm (%options): Add --clipboard option.
(show-help): Add help text for --clipboard.
(display-secret): New procedure.
(shroud-show): Handle --clipboard option.
-rw-r--r-- | .gitignore | 1 | ||||
-rw-r--r-- | configure.ac | 3 | ||||
-rw-r--r-- | package.scm | 6 | ||||
-rw-r--r-- | shroud/config.scm.in (renamed from shroud/config.scm) | 7 | ||||
-rw-r--r-- | shroud/ui/show.scm | 51 | ||||
-rw-r--r-- | shroud/utils.scm | 6 |
6 files changed, 53 insertions, 21 deletions
@@ -9,3 +9,4 @@ /scripts/shroud /Makefile *.go +/shroud/config.scm diff --git a/configure.ac b/configure.ac index 4b6de58..3ddbac9 100644 --- a/configure.ac +++ b/configure.ac @@ -9,7 +9,10 @@ AM_SILENT_RULES([yes]) AC_CONFIG_FILES([Makefile]) AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) AC_CONFIG_FILES([scripts/shroud], [chmod +x scripts/shroud]) +AC_CONFIG_FILES([shroud/config.scm]) GUILE_PROGS([2.0.11]) +AC_PATH_PROG([XCLIP], [xclip]) + AC_OUTPUT diff --git a/package.scm b/package.scm index 8bda732..2cb202f 100644 --- a/package.scm +++ b/package.scm @@ -24,7 +24,8 @@ (guix licenses) (guix build-system gnu) (gnu)) -(use-package-modules autotools pkg-config guile gnupg) + +(use-package-modules autotools pkg-config guile gnupg xdisorg) (package (name "shroud") @@ -37,7 +38,8 @@ ("automake" ,automake))) (inputs `(("guile" ,guile-2.0) - ("gnupg" ,gnupg))) + ("gnupg" ,gnupg) + ("xclip" ,xclip))) (synopsis "Simple password manager") (description "Shroud is a simple password manager with a command-line interface. The password database is stored as a Scheme diff --git a/shroud/config.scm b/shroud/config.scm.in index 803a3ac..00d6f39 100644 --- a/shroud/config.scm +++ b/shroud/config.scm.in @@ -1,3 +1,5 @@ +;;; -*- scheme -*- +;;; ;;; Shroud ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; @@ -15,6 +17,9 @@ ;;; along with Shroud. If not, see <http://www.gnu.org/licenses/>. (define-module (shroud config) - #:export (%shroud-version)) + #:export (%shroud-version + %xclip)) (define %shroud-version "0.1") + +(define %xclip "@XCLIP@") diff --git a/shroud/ui/show.scm b/shroud/ui/show.scm index fd076eb..21a35e2 100644 --- a/shroud/ui/show.scm +++ b/shroud/ui/show.scm @@ -28,6 +28,8 @@ (format #t "Usage: shroud show [OPTION] ID [KEY ...] Show secret named ID.~%") (display " + -c, --clipboard copy output to the X clipboard") + (display " -h, --help display this help and exit") (display " --version display version information and exit") @@ -40,7 +42,10 @@ Show secret named ID.~%") (exit 0))) (option '("version") #f #f (lambda args - (show-version-and-exit))))) + (show-version-and-exit))) + (option '("clipboard" #\c) #f #f + (lambda (opt name arg result) + (alist-cons 'clipboard? #t result))))) (define %default-options '()) @@ -54,28 +59,38 @@ Show secret named ID.~%") (alist-cons 'id arg result))) %default-options)) +(define* (display-secret secret keys #:optional (port (current-output-port))) + (match keys + (() + (for-each (match-lambda + ((key . value) + (format port "~a\t~a~%" key value))) + (secret-contents secret))) + ((keys ...) + (for-each (match-lambda + ((key . value) + (when (member key keys) + (format port "~a~%" value)))) + (secret-contents secret))))) + (define (shroud-show config db . args) - (let* ((opts (process-args args)) - (id (leave-if-false (assq-ref opts 'id) - "no secret ID given")) - (keys (alist-pick opts 'key)) - (secret (vhash-ref (secrets-by-id (force db)) id))) + (let* ((opts (process-args args)) + (id (leave-if-false (assq-ref opts 'id) + "no secret ID given")) + (keys (alist-pick opts 'key)) + (clipboard? (assq-ref opts 'clipboard?)) + (secret (vhash-ref (secrets-by-id (force db)) id))) (unless secret (leave "secret '~a' does not exist" id)) - (match keys - (() - (for-each (match-lambda - ((key . value) - (format #t "~a\t~a~%" key value))) - (secret-contents secret))) - ((keys ...) - (for-each (match-lambda - ((key . value) - (when (member key keys) - (format #t "~a~%" value)))) - (secret-contents secret)))) + (if clipboard? + (call-with-clipboard + (lambda (port) + (display-secret secret keys port) + (display "copied secret to clipboard\n" + (current-error-port)))) + (display-secret secret keys)) ;; Database remains unaltered. db)) diff --git a/shroud/utils.scm b/shroud/utils.scm index 3f28840..58695e4 100644 --- a/shroud/utils.scm +++ b/shroud/utils.scm @@ -20,6 +20,7 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) + #:use-module (shroud config) #:export (vhash-ref vhash-replace vhash-values @@ -28,6 +29,7 @@ gpg-binary call-with-encrypted-output-file call-with-decrypted-input-file + call-with-clipboard mkdir-p)) (define (vhash-ref vhash key) @@ -115,6 +117,10 @@ FILE." "--decrypt" ,file) proc))))) +(define (call-with-clipboard proc) + "Call PROC with an open output port to the X clipboard." + (call-with-output-pipe* (list %xclip "-selection" "clipboard") proc)) + ;; Written by Ludovic Courtès for GNU Guix. (define (mkdir-p dir) "Create directory DIR and all its ancestors." |