| 1 | (in-package #:asdf-install) |
|---|
| 2 | |
|---|
| 3 | (define-condition download-error (error) |
|---|
| 4 | ((url :initarg :url :reader download-url) |
|---|
| 5 | (response :initarg :response :reader download-response)) |
|---|
| 6 | (:report (lambda (c s) |
|---|
| 7 | (format s "Server responded ~A for GET ~A" |
|---|
| 8 | (download-response c) (download-url c))))) |
|---|
| 9 | |
|---|
| 10 | (define-condition signature-error (error) |
|---|
| 11 | ((cause :initarg :cause :reader signature-error-cause)) |
|---|
| 12 | (:report (lambda (c s) |
|---|
| 13 | (format s "Cannot verify package signature: ~A" |
|---|
| 14 | (signature-error-cause c))))) |
|---|
| 15 | |
|---|
| 16 | (define-condition gpg-error (error) |
|---|
| 17 | ((message :initarg :message :reader gpg-error-message)) |
|---|
| 18 | (:report (lambda (c s) |
|---|
| 19 | (format s "GPG failed with error status:~%~S" |
|---|
| 20 | (gpg-error-message c))))) |
|---|
| 21 | |
|---|
| 22 | (define-condition gpg-shell-error (gpg-error) |
|---|
| 23 | () |
|---|
| 24 | (:report (lambda (c s) |
|---|
| 25 | (declare (ignore c)) |
|---|
| 26 | (format s "Call to GPG failed. Perhaps GPG is not installed or not ~ |
|---|
| 27 | in the path.")))) |
|---|
| 28 | |
|---|
| 29 | (define-condition no-signature (gpg-error) ()) |
|---|
| 30 | |
|---|
| 31 | (define-condition key-not-found (gpg-error) |
|---|
| 32 | ((key-id :initarg :key-id :reader key-id)) |
|---|
| 33 | (:report (lambda (c s) |
|---|
| 34 | (let* ((*print-circle* nil) |
|---|
| 35 | (key-id (key-id c)) |
|---|
| 36 | (key-id (if (and (consp key-id) |
|---|
| 37 | (> (length key-id) 1)) |
|---|
| 38 | (car key-id) key-id))) |
|---|
| 39 | (format s "~&No key found for key id 0x~A.~%" key-id) |
|---|
| 40 | (format s "~&Try some command like ~% gpg --recv-keys 0x~A" |
|---|
| 41 | (format nil "~a" key-id)))))) |
|---|
| 42 | |
|---|
| 43 | (define-condition key-not-trusted (gpg-error) |
|---|
| 44 | ((key-id :initarg :key-id :reader key-id) |
|---|
| 45 | (key-user-name :initarg :key-user-name :reader key-user-name)) |
|---|
| 46 | (:report (lambda (c s) |
|---|
| 47 | (format s "GPG warns that the key id 0x~A (~A) is not fully trusted" |
|---|
| 48 | (key-id c) (key-user-name c))))) |
|---|
| 49 | |
|---|
| 50 | (define-condition author-not-trusted (gpg-error) |
|---|
| 51 | ((key-id :initarg :key-id :reader key-id) |
|---|
| 52 | (key-user-name :initarg :key-user-name :reader key-user-name)) |
|---|
| 53 | (:report (lambda (c s) |
|---|
| 54 | (format s "~A (key id ~A) is not on your package supplier list" |
|---|
| 55 | (key-user-name c) (key-id c))))) |
|---|
| 56 | |
|---|
| 57 | (define-condition installation-abort (condition) |
|---|
| 58 | () |
|---|
| 59 | (:report (lambda (c s) |
|---|
| 60 | (declare (ignore c)) |
|---|
| 61 | (installer-msg s "Installation aborted.")))) |
|---|
| 62 | |
|---|
| 63 | (defun report-valid-preferred-locations (stream &optional attempted-location) |
|---|
| 64 | (when attempted-location |
|---|
| 65 | (installer-msg stream "~s is not a valid value for *preferred-location*" |
|---|
| 66 | attempted-location)) |
|---|
| 67 | (installer-msg stream "*preferred-location* may either be nil, a number between 1 and ~d \(the length of *locations*\) or the name of one of the *locations* \(~{~s~^, ~}\). If using a name, then it can be a symbol tested with #'eq or a string tested with #'string-equal." |
|---|
| 68 | (length *locations*) |
|---|
| 69 | (mapcar #'third *locations*))) |
|---|
| 70 | |
|---|
| 71 | (define-condition invalid-preferred-location-error (error) |
|---|
| 72 | ((preferred-location :initarg :preferred-location)) |
|---|
| 73 | (:report (lambda (c s) |
|---|
| 74 | (report-valid-preferred-locations |
|---|
| 75 | s (slot-value c 'preferred-location))))) |
|---|
| 76 | |
|---|
| 77 | (define-condition invalid-preferred-location-number-error |
|---|
| 78 | (invalid-preferred-location-error) ()) |
|---|
| 79 | |
|---|
| 80 | (define-condition invalid-preferred-location-name-error |
|---|
| 81 | (invalid-preferred-location-error) ()) |
|---|
| 82 | |
|---|