lang/cl/gpg-error.lisp

   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