diff options
Diffstat (limited to 'libotr/libgpg-error-1.42/lang/cl/gpg-error.lisp')
| -rw-r--r-- | libotr/libgpg-error-1.42/lang/cl/gpg-error.lisp | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/libotr/libgpg-error-1.42/lang/cl/gpg-error.lisp b/libotr/libgpg-error-1.42/lang/cl/gpg-error.lisp new file mode 100644 index 0000000..cad2532 --- /dev/null +++ b/libotr/libgpg-error-1.42/lang/cl/gpg-error.lisp @@ -0,0 +1,233 @@ +;;;; libgpg-error.lisp + +;;; Copyright (C) 2006 g10 Code GmbH +;;; +;;; This file is part of libgpg-error. +;;; +;;; libgpg-error is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public License +;;; as published by the Free Software Foundation; either version 2.1 of +;;; the License, or (at your option) any later version. +;;; +;;; libgpg-error is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with libgpg-error; if not, write to the Free +;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;;; 02111-1307, USA. + +;;; Set up the library. + +(in-package :gpg-error) + +(define-foreign-library libgpg-error + (:unix "libgpg-error.so") + (t (:default "libgpg-error"))) + +(use-foreign-library libgpg-error) + +;;; System dependencies. + +(defctype size-t :unsigned-int "The system size_t type.") + +;;; Error sources. + +(defcenum gpg-err-source-t + "The GPG error source type." + (:gpg-err-source-unknown 0) + (:gpg-err-source-gcrypt 1) + (:gpg-err-source-gpg 2) + (:gpg-err-source-gpgsm 3) + (:gpg-err-source-gpgagent 4) + (:gpg-err-source-pinentry 5) + (:gpg-err-source-scd 6) + (:gpg-err-source-gpgme 7) + (:gpg-err-source-keybox 8) + (:gpg-err-source-ksba 9) + (:gpg-err-source-dirmngr 10) + (:gpg-err-source-gsti 11) + (:gpg-err-source-any 31) + (:gpg-err-source-user-1 32) + (:gpg-err-source-user-2 33) + (:gpg-err-source-user-3 34) + (:gpg-err-source-user-4 35)) + +(defconstant +gpg-err-source-dim+ 256) + +;;; The error code type gpg-err-code-t. + +;;; libgpg-error-codes.lisp is loaded by ASDF. + +(defctype gpg-error-t :unsigned-int "The GPG error code type.") + +;;; Bit mask manipulation constants. + +(defconstant +gpg-err-code-mask+ (- +gpg-err-code-dim+ 1)) + +(defconstant +gpg-err-source-mask+ (- +gpg-err-source-dim+ 1)) +(defconstant +gpg-err-source-shift+ 24) + +;;; Constructor and accessor functions. + +;;; If we had in-library versions of our static inlines, we wouldn't +;;; need to replicate them here. Oh well. + +(defun c-gpg-err-make (source code) + "Construct an error value from an error code and source. + Within a subsystem, use gpg-error instead." + (logior + (ash (logand source +gpg-err-source-mask+) + +gpg-err-source-shift+) + (logand code +gpg-err-code-mask+))) + +(defun c-gpg-err-code (err) + "retrieve the error code from an error value." + (logand err +gpg-err-code-mask+)) + +(defun c-gpg-err-source (err) + "retrieve the error source from an error value." + (logand (ash err (- +gpg-err-source-shift+)) + +gpg-err-source-mask+)) + +;;; String functions. + +(defcfun ("gpg_strerror" c-gpg-strerror) :string + (err gpg-error-t)) + +(defcfun ("gpg_strsource" c-gpg-strsource) :string + (err gpg-error-t)) + +;;; Mapping of system errors (errno). + +(defcfun ("gpg_err_code_from_errno" c-gpg-err-code-from-errno) gpg-err-code-t + (err :int)) + +(defcfun ("gpg_err_code_to_errno" c-gpg-err-code-to-errno) :int + (code gpg-err-code-t)) + +(defcfun ("gpg_err_code_from_syserror" + c-gpg-err-code-from-syserror) gpg-err-code-t) + +;;; Self-documenting convenience functions. + +;;; See below. + +;;; +;;; +;;; Lispy interface. +;;; +;;; + +;;; Low-level support functions. + +(defun gpg-err-code-as-value (code-key) + (foreign-enum-value 'gpg-err-code-t code-key)) + +(defun gpg-err-code-as-key (code) + (foreign-enum-keyword 'gpg-err-code-t code)) + +(defun gpg-err-source-as-value (source-key) + (foreign-enum-value 'gpg-err-source-t source-key)) + +(defun gpg-err-source-as-key (source) + (foreign-enum-keyword 'gpg-err-source-t source)) + +(defun gpg-err-canonicalize (err) + "Canonicalize the error value err." + (gpg-err-make (gpg-err-source err) (gpg-err-code err))) + +(defun gpg-err-as-value (err) + "Get the integer representation of the error value ERR." + (let ((error (gpg-err-canonicalize err))) + (c-gpg-err-make (gpg-err-source-as-value (gpg-err-source error)) + (gpg-err-code-as-value (gpg-err-code error))))) + +;;; Constructor and accessor functions. + +(defun gpg-err-make (source code) + "Construct an error value from an error code and source. + Within a subsystem, use gpg-error instead." + ;; As an exception to the rule, the function gpg-err-make will use + ;; the error source value as is when provided as integer, instead of + ;; parsing it as an error value. + (list (if (integerp source) + (gpg-err-source-as-key source) + (gpg-err-source source)) + (gpg-err-code code))) + +(defvar *gpg-err-source-default* :gpg-err-source-unknown + "define this to specify a default source for gpg-error.") + +(defun gpg-error (code) + "Construct an error value from an error code, using the default source." + (gpg-err-make *gpg-err-source-default* code)) + +(defun gpg-err-code (err) + "Retrieve an error code from the error value ERR." + (cond ((listp err) (second err)) + ((keywordp err) err) ; FIXME + (t (gpg-err-code-as-key (c-gpg-err-code err))))) + +(defun gpg-err-source (err) + "Retrieve an error source from the error value ERR." + (cond ((listp err) (first err)) + ((keywordp err) err) ; FIXME + (t (gpg-err-source-as-key (c-gpg-err-source err))))) + +;;; String functions. + +(defun gpg-strerror (err) + "Return a string containig a description of the error code." + (c-gpg-strerror (gpg-err-as-value err))) + +;;; FIXME: maybe we should use this as the actual implementation for +;;; gpg-strerror. + +;; (defcfun ("gpg_strerror_r" c-gpg-strerror-r) :int +;; (err gpg-error-t) +;; (buf :string) +;; (buflen size-t)) + +;; (defun gpg-strerror-r (err) +;; "Return a string containig a description of the error code." +;; (with-foreign-pointer-as-string (errmsg 256 errmsg-size) +;; (c-gpg-strerror-r (gpg-err-code-as-value (gpg-err-code err)) +;; errmsg errmsg-size))) + +(defun gpg-strsource (err) + "Return a string containig a description of the error source." + (c-gpg-strsource (gpg-err-as-value err))) + +;;; Mapping of system errors (errno). + +(defun gpg-err-code-from-errno (err) + "Retrieve the error code for the system error. If the system error + is not mapped, :gpg-err-unknown-errno is returned." + (gpg-err-code-as-key (c-gpg-err-code-from-errno err))) + +(defun gpg-err-code-to-errno (code) + "Retrieve the system error for the error code. If this is not a + system error, 0 is returned." + (c-gpg-err-code-to-errno (gpg-err-code code))) + +(defun gpg-err-code-from-syserror () + "Retrieve the error code directly from the system ERRNO. If the system error + is not mapped, :gpg-err-unknown-errno is returned and + :gpg-err-missing-errno if ERRNO has the value 0." + (gpg-err-code-as-key (c-gpg-err-code-from-syserror))) + + +;;; Self-documenting convenience functions. + +(defun gpg-err-make-from-errno (source err) + (gpg-err-make source (gpg-err-code-from-errno err))) + +(defun gpg-error-from-errno (err) + (gpg-error (gpg-err-code-from-errno err))) + +(defun gpg-error-from-syserror () + (gpg-error (gpg-err-code-from-syserror))) + |