1;;;; libgpg-error.lisp
2
3;;; Copyright (C) 2006 g10 Code GmbH
4;;;
5;;; This file is part of libgpg-error.
6;;;
7;;; libgpg-error is free software; you can redistribute it and/or
8;;; modify it under the terms of the GNU Lesser General Public License
9;;; as published by the Free Software Foundation; either version 2.1 of
10;;; the License, or (at your option) any later version.
11;;;
12;;; libgpg-error is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15;;; Lesser General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU Lesser General Public
18;;; License along with libgpg-error; if not, write to the Free
19;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
20;;; 02111-1307, USA.
21
22;;; Set up the library.
23
24(in-package :gpg-error)
25
26(define-foreign-library libgpg-error
27  (:unix "libgpg-error.so")
28  (t (:default "libgpg-error")))
29
30(use-foreign-library libgpg-error)
31
32;;; System dependencies.
33
34(defctype size-t :unsigned-int "The system size_t type.")
35
36;;; Error sources.
37
38(defcenum gpg-err-source-t
39  "The GPG error source type."
40  (:gpg-err-source-unknown 0)
41  (:gpg-err-source-gcrypt 1)
42  (:gpg-err-source-gpg 2)
43  (:gpg-err-source-gpgsm 3)
44  (:gpg-err-source-gpgagent 4)
45  (:gpg-err-source-pinentry 5)
46  (:gpg-err-source-scd 6)
47  (:gpg-err-source-gpgme 7)
48  (:gpg-err-source-keybox 8)
49  (:gpg-err-source-ksba 9)
50  (:gpg-err-source-dirmngr 10)
51  (:gpg-err-source-gsti 11)
52  (:gpg-err-source-any 31)
53  (:gpg-err-source-user-1 32)
54  (:gpg-err-source-user-2 33)
55  (:gpg-err-source-user-3 34)
56  (:gpg-err-source-user-4 35))
57
58(defconstant +gpg-err-source-dim+ 256)
59
60;;; The error code type gpg-err-code-t.
61
62;;; libgpg-error-codes.lisp is loaded by ASDF.
63
64(defctype gpg-error-t :unsigned-int "The GPG error code type.")
65
66;;; Bit mask manipulation constants.
67
68(defconstant +gpg-err-code-mask+ (- +gpg-err-code-dim+ 1))
69
70(defconstant +gpg-err-source-mask+ (- +gpg-err-source-dim+ 1))
71(defconstant +gpg-err-source-shift+ 24)
72
73;;; Constructor and accessor functions.
74
75;;; If we had in-library versions of our static inlines, we wouldn't
76;;; need to replicate them here.  Oh well.
77
78(defun c-gpg-err-make (source code)
79  "Construct an error value from an error code and source.
80   Within a subsystem, use gpg-error instead."
81  (logior
82   (ash (logand source +gpg-err-source-mask+)
83	+gpg-err-source-shift+)
84   (logand code +gpg-err-code-mask+)))
85
86(defun c-gpg-err-code (err)
87  "retrieve the error code from an error value."
88  (logand err +gpg-err-code-mask+))
89
90(defun c-gpg-err-source (err)
91  "retrieve the error source from an error value."
92  (logand (ash err (- +gpg-err-source-shift+))
93	  +gpg-err-source-mask+))
94
95;;; String functions.
96
97(defcfun ("gpg_strerror" c-gpg-strerror) :string
98  (err gpg-error-t))
99
100(defcfun ("gpg_strsource" c-gpg-strsource) :string
101  (err gpg-error-t))
102
103;;; Mapping of system errors (errno).
104
105(defcfun ("gpg_err_code_from_errno" c-gpg-err-code-from-errno) gpg-err-code-t
106  (err :int))
107
108(defcfun ("gpg_err_code_to_errno" c-gpg-err-code-to-errno) :int
109  (code gpg-err-code-t))
110
111(defcfun ("gpg_err_code_from_syserror"
112           c-gpg-err-code-from-syserror) gpg-err-code-t)
113
114;;; Self-documenting convenience functions.
115
116;;; See below.
117
118;;;
119;;;
120;;; Lispy interface.
121;;;
122;;;
123
124;;; Low-level support functions.
125
126(defun gpg-err-code-as-value (code-key)
127  (foreign-enum-value 'gpg-err-code-t code-key))
128
129(defun gpg-err-code-as-key (code)
130  (foreign-enum-keyword 'gpg-err-code-t code))
131
132(defun gpg-err-source-as-value (source-key)
133  (foreign-enum-value 'gpg-err-source-t source-key))
134
135(defun gpg-err-source-as-key (source)
136  (foreign-enum-keyword 'gpg-err-source-t source))
137
138(defun gpg-err-canonicalize (err)
139  "Canonicalize the error value err."
140  (gpg-err-make (gpg-err-source err) (gpg-err-code err)))
141
142(defun gpg-err-as-value (err)
143  "Get the integer representation of the error value ERR."
144  (let ((error (gpg-err-canonicalize err)))
145    (c-gpg-err-make (gpg-err-source-as-value (gpg-err-source error))
146		    (gpg-err-code-as-value (gpg-err-code error)))))
147
148;;; Constructor and accessor functions.
149
150(defun gpg-err-make (source code)
151  "Construct an error value from an error code and source.
152   Within a subsystem, use gpg-error instead."
153  ;; As an exception to the rule, the function gpg-err-make will use
154  ;; the error source value as is when provided as integer, instead of
155  ;; parsing it as an error value.
156  (list (if (integerp source)
157	    (gpg-err-source-as-key source)
158	    (gpg-err-source source))
159	(gpg-err-code code)))
160
161(defvar *gpg-err-source-default* :gpg-err-source-unknown
162  "define this to specify a default source for gpg-error.")
163
164(defun gpg-error (code)
165  "Construct an error value from an error code, using the default source."
166  (gpg-err-make *gpg-err-source-default* code))
167
168(defun gpg-err-code (err)
169    "Retrieve an error code from the error value ERR."
170    (cond ((listp err) (second err))
171	  ((keywordp err) err) ; FIXME
172	  (t (gpg-err-code-as-key (c-gpg-err-code err)))))
173
174(defun gpg-err-source (err)
175    "Retrieve an error source from the error value ERR."
176    (cond ((listp err) (first err))
177	  ((keywordp err) err) ; FIXME
178	  (t (gpg-err-source-as-key (c-gpg-err-source err)))))
179
180;;; String functions.
181
182(defun gpg-strerror (err)
183  "Return a string containig a description of the error code."
184  (c-gpg-strerror (gpg-err-as-value err)))
185
186;;; FIXME: maybe we should use this as the actual implementation for
187;;; gpg-strerror.
188
189;; (defcfun ("gpg_strerror_r" c-gpg-strerror-r) :int
190;;   (err gpg-error-t)
191;;   (buf :string)
192;;   (buflen size-t))
193
194;; (defun gpg-strerror-r (err)
195;;   "Return a string containig a description of the error code."
196;;   (with-foreign-pointer-as-string (errmsg 256 errmsg-size)
197;;     (c-gpg-strerror-r (gpg-err-code-as-value (gpg-err-code err))
198;; 		      errmsg errmsg-size)))
199
200(defun gpg-strsource (err)
201  "Return a string containig a description of the error source."
202  (c-gpg-strsource (gpg-err-as-value err)))
203
204;;; Mapping of system errors (errno).
205
206(defun gpg-err-code-from-errno (err)
207  "Retrieve the error code for the system error.  If the system error
208   is not mapped, :gpg-err-unknown-errno is returned."
209  (gpg-err-code-as-key (c-gpg-err-code-from-errno err)))
210
211(defun gpg-err-code-to-errno (code)
212  "Retrieve the system error for the error code.  If this is not a
213   system error, 0 is returned."
214  (c-gpg-err-code-to-errno (gpg-err-code code)))
215
216(defun gpg-err-code-from-syserror ()
217  "Retrieve the error code directly from the system ERRNO.  If the system error
218   is not mapped, :gpg-err-unknown-errno is returned and
219   :gpg-err-missing-errno if ERRNO has the value 0."
220  (gpg-err-code-as-key (c-gpg-err-code-from-syserror)))
221
222
223;;; Self-documenting convenience functions.
224
225(defun gpg-err-make-from-errno (source err)
226  (gpg-err-make source (gpg-err-code-from-errno err)))
227
228(defun gpg-error-from-errno (err)
229  (gpg-error (gpg-err-code-from-errno err)))
230
231(defun gpg-error-from-syserror ()
232  (gpg-error (gpg-err-code-from-syserror)))
233
234