PageRenderTime 26ms CodeModel.GetById 14ms app.highlight 9ms RepoModel.GetById 1ms app.codeStats 0ms

/lib/libgpg-error/libgpg-error-1.8/lang/cl/gpg-error.lisp

https://bitbucket.org/thelearninglabs/uclinux-distro-tll-public
Lisp | 233 lines | 117 code | 60 blank | 56 comment | 4 complexity | 885cd7c8ab23ebd13d71609e680f5cd1 MD5 | raw file
  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