diff options
Diffstat (limited to 'shroud/ui')
| -rw-r--r-- | shroud/ui/hide.scm | 90 | ||||
| -rw-r--r-- | shroud/ui/remove.scm | 63 | ||||
| -rw-r--r-- | shroud/ui/show.scm | 79 |
3 files changed, 232 insertions, 0 deletions
diff --git a/shroud/ui/hide.scm b/shroud/ui/hide.scm new file mode 100644 index 0000000..934abf8 --- /dev/null +++ b/shroud/ui/hide.scm @@ -0,0 +1,90 @@ +;;; Shroud +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; Shroud 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. +;;; +;;; Shroud 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 Shroud. If not, see <http://www.gnu.org/licenses/>. + +(define-module (shroud ui hide) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (shroud utils) + #:use-module (shroud secret) + #:use-module (shroud ui) + #:export (shroud-hide)) + +(define (show-help) + (format #t "Usage: shroud hide [OPTION] --id=ID --username=USERNAME --password=PASSWORD +Add a new secret to the database.~%") + (display " + -i, --id unique ID for secret") + (display " + -u, --username username") + (display " + -p, --password password") + (display " + -r, --replace replace existing username/password if it exists") + (display " + -h, --help display this help and exit") + (display " + --version display version information and exit") + (newline)) + +(define %options + (list (option '(#\i "id") #t #f + (lambda (opt name arg result) + (alist-cons 'id arg result))) + (option '(#\u "username") #t #f + (lambda (opt name arg result) + (alist-cons 'username arg result))) + (option '(#\p "password") #t #f + (lambda (opt name arg result) + (alist-cons 'password arg result))) + (option '(#\r "replace") #f #f + (lambda (opt name arg result) + (alist-cons 'replace? #t result))) + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '("--version") #f #f + (lambda args + (show-version-and-exit))))) + +(define %default-options '()) + +(define (shroud-hide config db . args) + (let* ((opts (simple-args-fold args %options %default-options)) + (id (assq-ref opts 'id)) + (username (assq-ref opts 'username)) + (password (assq-ref opts 'password)) + (replace? (assq-ref opts 'replace?))) + + (unless id + (leave "no secret id specified")) + (unless username + (leave "no username specified")) + (unless password + (leave "no password specified")) + + (let* ((db (secrets-by-id (force db))) + (existing (vhash-ref db id)) + (vcons (if existing vhash-replace vhash-cons)) + (secret (make-secret id username password))) + + (when (and (not replace?) existing) + (leave "~a: secret already defined" id)) + + (vhash-values (vcons id secret db))))) diff --git a/shroud/ui/remove.scm b/shroud/ui/remove.scm new file mode 100644 index 0000000..239618f --- /dev/null +++ b/shroud/ui/remove.scm @@ -0,0 +1,63 @@ +;;; Shroud +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; Shroud 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. +;;; +;;; Shroud 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 Shroud. If not, see <http://www.gnu.org/licenses/>. + +(define-module (shroud ui remove) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (shroud utils) + #:use-module (shroud secret) + #:use-module (shroud ui) + #:export (shroud-remove)) + +(define (show-help) + (format #t "Usage: shroud remove [OPTION] id +Remove a secret from the database.~%") + (display " + -h, --help display this help and exit") + (display " + --version display version information and exit") + (newline)) + +(define %options + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '("--version") #f #f + (lambda args + (show-version-and-exit))))) + +(define %default-options '()) + +(define (shroud-remove config db . args) + (let* ((opts (args-fold args %options + (lambda (opt name arg result) + (leave "~A: unrecognized option" name)) + (lambda (arg result) + (if (assq-ref result 'id) + (leave "~A: extraneuous argument" arg) + (alist-cons 'id arg result))) + %default-options)) + (id (assq-ref opts 'id)) + (db (secrets-by-id (force db)))) + + (unless (vhash-ref db id) + (leave "secret '~a' is undefined" id)) + + (vhash-values (vhash-delete id db)))) diff --git a/shroud/ui/show.scm b/shroud/ui/show.scm new file mode 100644 index 0000000..e56d8dd --- /dev/null +++ b/shroud/ui/show.scm @@ -0,0 +1,79 @@ +;;; Shroud +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; Shroud 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. +;;; +;;; Shroud 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 Shroud. If not, see <http://www.gnu.org/licenses/>. + +(define-module (shroud ui show) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (shroud utils) + #:use-module (shroud secret) + #:use-module (shroud ui) + #:export (shroud-show)) + +(define (show-help) + (format #t "Usage: shroud show [OPTION] id +Show secret named ID.~%") + (display " + -p, --password show only the password") + (display " + -h, --help display this help and exit") + (display " + --version display version information and exit") + (newline)) + +(define %options + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '("--version") #f #f + (lambda args + (show-version-and-exit))) + (option '(#\p "password") #f #f + (lambda (opt name arg result) + (alist-cons 'password #t result))))) + +(define %default-options '()) + +(define (shroud-show config db . args) + (let* ((opts (args-fold args %options + (lambda (opt name arg result) + (leave "~A: unrecognized option" name)) + (lambda (arg result) + (if (assq-ref result 'id) + (leave "~A: extraneuous argument" arg) + (alist-cons 'id arg result))) + %default-options)) + (id (assq-ref opts 'id)) + (password? (assq-ref opts 'password))) + + (unless id + (leave "no secret id specified")) + + (let* ((db (secrets-by-id (force db))) + (secret (vhash-ref db id))) + (unless secret + (leave "~a: secret undefined" id)) + + (if password? + (display (secret-password secret)) + (format #t "username: ~a~%password: ~a~%" + (secret-username secret) + (secret-password secret))))) + + ;; We don't alter the database. + db) |