Refactor printing of accounts using fmt egg - pee - Pee a password manager;Pee - because you have to...
(HTM) git clone git://vernunftzentrum.de/pee.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) LICENSE
---
(DIR) commit dfac95894f1ebd1d65322a31e5f0051ceb66109b
(DIR) parent cda319bcb34d3f10945787e0085d13ebb9099d45
(HTM) Author: Christian Kellermann <ckeen@pestilenz.org>
Date: Thu, 21 Apr 2016 12:00:31 +0200
Refactor printing of accounts using fmt egg
This gives us prettier output for the list and merge commands. The
relevant procedure now needs all entries in a list as input instead of
printing a formatted string line by line.
Diffstat:
compile.sh | 8 ++++++--
pee.scm | 45 ++++++++++++++++++-------------
2 files changed, 32 insertions(+), 21 deletions(-)
---
(DIR) diff --git a/compile.sh b/compile.sh
@@ -14,7 +14,11 @@ chicken-install -r matchable >/dev/null || echo Fetching matchable has failed.
chicken-install -r string-utils >/dev/null || echo Fetching string-utils has failed.
chicken-install -r stty >/dev/null || echo Fetching stty has failed.
chicken-install -r tweetnacl >/dev/null || echo Fetching tweetnacl has failed.
+chicken-install -r fmt > /dev/null || echo Fetching fmt has failed.
+cd fmt
+csc -unit fmt -emit-import-library fmt -uses ports,srfi-1,srfi-69,srfi-13,extras,data-structures -c fmt-chicken.scm -o fmt.o && mv fmt.o ..
+cd ..
cd matchable
csc -unit matchable -emit-import-library matchable -c matchable.scm -o matchable.o
mv matchable.o ..; cd ..
@@ -27,11 +31,11 @@ csc -unit tweetnacl -emit-import-library tweetnacl -c tweetnacl/tweetnacl.scm -c
csc -unit type-checks -uses type-errors -J -c ./check-errors/type-checks.scm -o type-checks.o
csc -unit type-errors -J -c ./check-errors/type-errors.scm -o type-errors.o
csc -uses matchable -uses foreigners -c stty/stty.scm -emit-import-library stty -unit stty -o stty.o
-csc -uses srfi-1,srfi-4,srfi-13,srfi-14,utils,stty,crypto-helper,tweetnacl,getopt-long,matchable -c pee.scm -o pee.o
+csc -uses srfi-1,srfi-4,srfi-13,srfi-14,utils,stty,crypto-helper,tweetnacl,getopt-long,fmt,matchable -c pee.scm -o pee.o
csc -static *o ./tweetnacl/tweetnacl.impl.o -o pee
strip ./pee
-rm -r matchable blob-utils check-errors foreigners getopt-long string-utils stty tweetnacl hash tag
+rm -r matchable blob-utils check-errors foreigners getopt-long string-utils stty tweetnacl hash tag fmt
rm *.o *.import.*
(DIR) diff --git a/pee.scm b/pee.scm
@@ -16,7 +16,7 @@
(module pee (main)
(import chicken scheme)
-(use (srfi 1 4 13 14) matchable posix tweetnacl utils crypto-helper getopt-long stty files data-structures irregex files ports extras)
+(use (srfi 1 4 13 14) matchable posix tweetnacl utils crypto-helper getopt-long stty files data-structures irregex files fmt ports extras)
(include "program-meta.scm")
@@ -194,11 +194,23 @@
db
equal?)))
-(define (print-entry entry #!key show-password)
- (match-let (((user pass comment last-modified) entry))
- (printf "User: ~a\tPass: ~a\tComment: ~a\tLast changed: ~a~%"
- user (if show-password pass "***") comment
- (time->string (seconds->local-time last-modified) "%Y-%m-%d %H:%M:%S"))))
+(define (print-entries entries #!key show-password (show-headers #t) (prefixes '()))
+ (let ((users (map first entries))
+ (passwords (if show-password
+ (map second entries)
+ (make-list (length entries) "***")))
+ (comments (map third entries))
+ (dates (map (lambda (e)
+ (time->string (seconds->local-time (fourth e)) "%Y-%m-%d %H:%M:%S"))
+ entries)))
+ (fmt #t
+ (tabular
+ (cat (if show-headers (cat "Label" nl) "") (fmt-join dsp prefixes nl)) " "
+ (cat (if show-headers (cat "Username" nl) "") (fmt-join dsp users nl)) " "
+ (cat (if show-headers (cat "Passwords" nl) "") (fmt-join dsp passwords nl)) " "
+ (cat (if show-headers (cat "Comments" nl) "") (fmt-join dsp comments nl)) " "
+ (cat (if show-headers (cat "Last modified" nl) "") (fmt-join dsp dates nl))))))
+
(define (check-access f)
(and (file-exists? f)
@@ -311,8 +323,7 @@
(define (do-delete db-name db p account)
(cond ((alist-ref account db equal?) =>
(lambda (e)
- (printf "Account: ~a" account)
- (print-entry e)
+ (print-entries (list e) prefixes: (list account) show-header: #f)
(cond ((ask-yes-or-no "Really delete account?")
(encrypt-file db-name (alist-delete account db equal?) p)
(print "Entry '" account "' deleted."))
@@ -332,11 +343,11 @@
(when (null? accounts)
(print "Error: No entry for " account " found.")
(exit 1))
- (for-each
- (lambda (account-name)
- (printf "Account: ~a\t" account-name)
- (print-entry (alist-ref account-name db equal?)))
- accounts)))
+ (print-entries (map
+ (lambda (account-name)
+ (alist-ref account-name db equal?))
+ accounts)
+ prefixes: accounts)))
(define (do-password db e)
(cond ((alist-ref e db equal?) =>
@@ -384,10 +395,7 @@
(let ((show-password? (ask-yes-or-no "Show passwords?")))
(print "Account " account)
(let dialog-loop ()
- (printf "MINE:\t")
- (print-entry mine show-password: show-password?)
- (printf "THEIRS:")
- (print-entry theirs show-password: show-password?)
+ (print-entries (list mine theirs) prefixes: '("MINE" "THEIRS") show-password: show-password? show-headers: #f)
(unless (or (equal? (second mine) (second theirs)) show-password?)
(print "Password MISMATCH"))
(let ((choice (ask-for-choice "Use which version?" "m" "t" "s" "?")))
@@ -418,8 +426,7 @@
(let ((new (merge-entries account ours theirs)))
(alist-update account new db equal?))))
(else
- (printf "NEW ~a " account)
- (print-entry theirs)
+ (print-entries (list theirs) prefixes: (list (sprintf "NEW ~a" account)) show-headers: #f)
(alist-cons account theirs db)))))
db
db-theirs)