Add merging of databases. - 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 579387ed5a16560041d32558bd7b3959ce4402ad
 (DIR) parent 9ef725dc3d118b83b56b97690fc966f2df79add1
 (HTM) Author: Christian Kellermann <ckeen@pestilenz.org>
       Date:   Wed, 20 Apr 2016 15:22:42 +0200
       
       Add merging of databases.
       
       This will merge a given db into the currentl used db. Accounts that
       exist in both dbs will prompt the user to take either one. Accounts that
       are new will be added to the db.
       
       Note: Deletions will not be detected.
       
       Diffstat:
         pee.scm                             |      53 ++++++++++++++++++++++++++++++
       
       1 file changed, 53 insertions(+), 0 deletions(-)
       ---
 (DIR) diff --git a/pee.scm b/pee.scm
       @@ -252,6 +252,12 @@
             (single-char #\f)
             (value (required FILE)
                    (predicate ,check-access)))
       +    (merge
       +     "Merge their DB file into our DB file"
       +     (required #f)
       +     (single-char #\m)
       +     (value (required THEIRS)
       +            (predicate ,check-access)))
            (export
             "Prints the database as an association list (s-expression) on stdout"
             (required #f)
       @@ -365,6 +371,52 @@
                    (else (encrypt-file db-name db passphrase1)
                          (print "Password store " db-name " reencrypted.")))))
        
       +(define (do-merge db-name db passphrase theirs)
       +  (define (merge-entries account mine theirs)
       +    (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?)
       +        (unless (or (equal? (second mine) (second theirs)) show-password?)
       +          (print "Password MISMATCH"))
       +        (let ((choice (ask-for-choice "Use which version?" "m" "t" "s" "?")))
       +          (case choice
       +            ((#\m) (print "Taking my version") mine)
       +            ((#\t) (print "Taking their version") theirs)
       +            ((#\s) (print "Skipping " account " keeping ours.") mine)
       +            ((#\?) (printf "m\ttake my version.~%t\ttake their version~%s\tskip the decision, same as \"m\"~%?\tthis help~%")
       +             (dialog-loop))
       +            (else (dialog-loop)))))))
       +  (print "Enter passphrase for db file " theirs)
       +  (let* ((passphrase-theirs (get-hashed-passphrase))
       +         (db-theirs (or (with-input-from-string
       +                         (or (decrypt-file theirs passphrase-theirs) "#f") read)
       +                        (begin (fprintf (current-error-port) "Error while decrypting ~a, wrong key?~%" theirs) (exit 1)))))
       +    (cond ((equal? db db-theirs)
       +           (print "Databases are the same."))
       +          (else
       +           (encrypt-file
       +            db-name
       +            (fold
       +             (lambda (entry db)
       +               (let ((account (car entry))
       +                     (theirs (cdr entry)))
       +                 (cond ((equal? theirs (alist-ref account db equal?)) db)
       +                       ((alist-ref account db equal?) =>
       +                        (lambda (ours)
       +                          (let ((new (merge-entries account ours theirs)))
       +                            (alist-update account new db equal?))))
       +                       (else
       +                        (printf "NEW ~a " account)
       +                        (print-entry theirs)
       +                        (alist-cons account theirs db)))))
       +             db
       +             db-theirs)
       +            passphrase)))))
       +
        (define (main args)
          (when (null? args)
                (banner) (print (usage options)) (exit 1))
       @@ -408,6 +460,7 @@
                 ((alist-ref 'delete opts) => (lambda (e) (do-delete db-name db passphrase e)))
                 ((alist-ref 'update opts) => (lambda (e) (do-update db-name db passphrase e)))
                 ((alist-ref 'password opts) => (lambda (e) (do-password db e)))
       +         ((alist-ref 'merge opts) => (lambda (theirs) (do-merge db-name db passphrase theirs)))
                 (else (banner) (print "Error: Don't know what to do") (print (usage options)) (exit 1))))))
            (exit 0)))
        )