 |
Refactor printing of accounts using fmt egg - pee - Pee a password manager;Pee … |
 |
git clone git://vernunftzentrum.de/pee.git |
 |
Log |
|
Files |
|
Refs |
|
LICENSE |
|
--- |
|
commit dfac95894f1ebd1d65322a31e5f0051ceb66109b |
|
parent cda319bcb34d3f10945787e0085d13ebb9099d45 |
|
Author: Christian Kellermann <[email protected]> |
|
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(-) |
|
--- |
|
diff --git a/compile.sh b/compile.sh |
|
@@ -14,7 +14,11 @@ chicken-install -r matchable >/dev/null || echo Fetching mat… |
|
chicken-install -r string-utils >/dev/null || echo Fetching string-utils has f… |
|
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,extr… |
|
+cd .. |
|
cd matchable |
|
csc -unit matchable -emit-import-library matchable -c matchable.scm -o matchab… |
|
mv matchable.o ..; cd .. |
|
@@ -27,11 +31,11 @@ csc -unit tweetnacl -emit-import-library tweetnacl -c tweet… |
|
csc -unit type-checks -uses type-errors -J -c ./check-errors/type-checks.scm -… |
|
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 stt… |
|
-csc -uses srfi-1,srfi-4,srfi-13,srfi-14,utils,stty,crypto-helper,tweetnacl,get… |
|
+csc -uses srfi-1,srfi-4,srfi-13,srfi-14,utils,stty,crypto-helper,tweetnacl,get… |
|
csc -static *o ./tweetnacl/tweetnacl.impl.o -o pee |
|
|
|
strip ./pee |
|
|
|
-rm -r matchable blob-utils check-errors foreigners getopt-long string-utils st… |
|
+rm -r matchable blob-utils check-errors foreigners getopt-long string-utils st… |
|
rm *.o *.import.* |
|
|
|
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-lon… |
|
+(use (srfi 1 4 13 14) matchable posix tweetnacl utils crypto-helper getopt-lon… |
|
|
|
(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-… |
|
+(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… |
|
+ 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 passwor… |
|
+ (cat (if show-headers (cat "Comments" nl) "") (fmt-join dsp comments… |
|
+ (cat (if show-headers (cat "Last modified" nl) "") (fmt-join dsp dat… |
|
+ |
|
|
|
(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-pa… |
|
(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 … |
|
(alist-cons account theirs db))))) |
|
db |
|
db-theirs) |
