| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960 |
- (in-package :cl-user)
- (defpackage #:assboard.pgp
- (:use :cl :assboard.utils)
- (:export #:list-fingerprints
- #:recv-key
- #:delete-key
- #:verify))
- (in-package #:assboard.pgp)
- (defvar *gpg-program* "/usr/bin/gpg" "gpg command")
- (defvar *gpg-homedir* (make-pathname :name ".gnupg"
- :defaults +project-path+)
- "gpg homedir (key storage)")
- (defvar *gpg-keyserver* "pgpkeys.mit.edu" "Keyserver to use")
- (defun extract-fingerprint (line)
- (let* ((last (1- (length line)))
- (first (1+ (position #\: line :from-end t :end last))))
- (subseq line first last)))
- (defun run-gpg (args &key input)
- (with-output-to-string (s)
- (sb-ext:run-program *gnupg-program*
- (append
- (list "--homedir" (namestring *gnupg-homedir*)
- "--status-fd" "1"
- "--logger-fd" "2"
- "--no-tty")
- args)
- :input input
- :output s
- :error nil)))
- (defun list-fingerprints ()
- (loop-lines (run-gpg '("--with-colons"
- "--with-fingerprint"
- "--list-keys"))
- if (starts-with "fpr:" line)
- collect (extract-fingerprint line)))
- (defun recv-key (fingerprint)
- (loop-lines (run-gpg (list "--keyserver" *gpg-keyserver*
- "--recv-keys" fingerprint))
- if (starts-with "[GNUPG:] IMPORT_OK" line)
- do (return t)))
- (defun delete-key (fingerprint)
- (not (loop-lines (run-gpg (list "--batch"
- "--delete-keys" fingerprint))
- if (starts-with "[GNUPG:] DELETE_PROBLEM" line)
- do (return t))))
- (defun verify (clearsigned)
- (with-input-from-string (input clearsigned)
- (loop-lines (run-gpg '("--verify") :input input)
- if (starts-with "[GNUPG:] VALIDSIG" line)
- do (return (values (subseq line (1+ (position #\Space line :from-end t)))
- (parse-integer line
- :start 70
- :end (position #\Space line :start 70)))))))
|
