+ (restart-case
+ (verify-gpg-signature/url url file-name)
+ (skip-gpg-check ()
+ :report "Don't check GPG signature for this package"
+ nil)))))
+
+(defun read-until-eof (stream)
+ (with-output-to-string (o)
+ (copy-stream stream o)))
+
+(defun verify-gpg-signature/string (string file-name)
+ (let* ((proc
+ (sb-ext:run-program
+ "gpg"
+ (list
+ "--status-fd" "1" "--verify" "-"
+ (namestring file-name))
+ :output :stream :error :stream :search t
+ :input (make-string-input-stream string) :wait t))
+ (err (read-until-eof (process-error proc)))
+ tags)
+ (loop for l = (read-line (process-output proc) nil nil)
+ while l
+ when (> (mismatch l "[GNUPG:]") 6)
+ do (destructuring-bind (_ tag &rest data) (asdf::split l)
+ (declare (ignore _))
+ (pushnew (cons (intern tag :keyword)
+ data) tags)))
+ ;; test for obvious key/sig problems
+ (let ((errsig (assoc :errsig tags)))
+ (and errsig (error 'key-not-found :key-id (second errsig) :gpg-err err)))
+ (let ((badsig (assoc :badsig tags)))
+ (and badsig (error 'key-not-found :key-id (second badsig) :gpg-err err)))
+ (let* ((good (assoc :goodsig tags))
+ (id (second good))
+ (name (format nil "~{~A~^ ~}" (nthcdr 2 good))))
+ ;; good signature, but perhaps not trusted
+ (unless (or (assoc :trust_ultimate tags)
+ (assoc :trust_fully tags))
+ (cerror "Install the package anyway"
+ 'key-not-trusted
+ :key-user-name name
+ :key-id id :gpg-err err))
+ (loop
+ (when
+ (restart-case
+ (or (assoc id *trusted-uids* :test #'equal)
+ (error 'author-not-trusted
+ :key-user-name name
+ :key-id id :gpg-err nil))
+ (add-key ()
+ :report "Add to package supplier list"
+ (pushnew (list id name) *trusted-uids*)))
+ (return))))))