Commit bb65f89f authored by Luís Oliveira's avatar Luís Oliveira
Browse files

Add syscall info to posix errors.

parent b3de7235
Loading
Loading
Loading
Loading
+8 −6
Original line number Diff line number Diff line
@@ -50,8 +50,10 @@
(defmethod print-object ((posix-error posix-error) stream)
 (print-unreadable-object (posix-error stream :type t :identity nil)
   (let ((code (system-error-code posix-error))
          (identifier (system-error-identifier posix-error)))
      (format stream "~s ~s ~s"
         (identifier (system-error-identifier posix-error))
         (syscall (posix-error-syscall posix-error)))
     (format stream "~s ~s ~s ~s"
             (or syscall "[No syscall name]")
             (or code "[No code]") identifier
             (or (strerror code) "[Can't get error string.]")))))

+26 −14
Original line number Diff line number Diff line
@@ -36,7 +36,8 @@
;;; in basic-unix.lisp because it needs %STRERROR-R defined later in
;;; wrappers.lisp.
(define-condition posix-error (system-error)
  ((object :initform nil :initarg :object :reader posix-error-object))
  ((object :initform nil :initarg :object :reader posix-error-object)
   (syscall :initform nil :initarg :syscall :reader posix-error-syscall))
  (:documentation
   "POSIX-ERRORs are signalled whenever ERRNO is set by a POSIX call."))

@@ -65,7 +66,7 @@
;;; Instantiates a subclass of POSIX-ERROR matching ERR or a plain
;;; POSIX-ERROR if no matching subclass is found.  ERR can be either a
;;; keyword or an integer both denoting an ERRNO value.
(defun make-posix-error (err object)
(defun make-posix-error (err object syscall)
  (let (error-keyword error-code)
    (etypecase err
      (keyword (setf error-keyword err)
@@ -74,24 +75,27 @@
                                       :unknown))
               (setf error-code err)))
    (if-let (condition-class (get-posix-error-condition error-keyword))
            (make-condition condition-class :object object)
            (make-condition condition-class
                            :object object
                            :syscall syscall)
            (make-condition 'posix-error
                            :object object
                            :code error-code
                            :identifier error-keyword))))
                            :identifier error-keyword
                            :syscall syscall))))

;;; This might be a silly question but, who resets ERRNO?  Should we?
;;; I ask because we have some function bindings with DEFSYSCALL that
;;; have no documented ERRNO behaviour and we're checking ERRNO when
;;; they fail anyway.  --luis

(defun posix-error (&optional (errno (get-errno)) object)
  (error (make-posix-error errno object)))
(defun posix-error (&optional (errno (get-errno)) object syscall)
  (error (make-posix-error errno object syscall)))

;;; Default ERROR-GENERATOR for ERRNO-WRAPPER.
(defun syscall-signal-posix-error (return-value object)
(defun syscall-signal-posix-error (return-value object syscall)
  (declare (ignore return-value))
  (posix-error (get-errno) object))
  (posix-error (get-errno) object syscall))

;;; Error predicate that always returns NIL.  Not actually used
;;; because the ERRNO-WRAPPER optimizes this call away.
@@ -112,7 +116,8 @@
   (return-filter :initarg :return-filter :reader return-filter)
   (error-generator :initarg :error-generator :reader error-generator)
   (base-type :initarg :base-type :reader base-type)
   (object :initarg :object :reader errno-object)))
   (object :initarg :object :reader errno-object)
   (function-name :initarg :function-name :reader function-name)))

;;; FIXME: undocumented in cffi-grovel.
(defun make-from-pointer-function-name (type-name)
@@ -120,7 +125,8 @@

(define-parse-method errno-wrapper
    (base-type &key object error-predicate (return-filter 'identity)
               (error-generator 'syscall-signal-posix-error))
               (error-generator 'syscall-signal-posix-error)
               function-name)
  ;; pick a default error-predicate
  (unless error-predicate
    (case base-type
@@ -148,7 +154,8 @@
                 :base-type base-type
                 :error-predicate error-predicate
                 :return-filter return-filter
                 :error-generator error-generator))
                 :error-generator error-generator
                 :function-name function-name))

;;; This type translator sets up the appropriate calls to
;;; RETURN-FILTER, ERROR-PREDICATE and ERROR-GENERATOR around the
@@ -164,7 +171,8 @@
            (if (eq (error-predicate type) 'never-fails)
                return-exp
                `(if (,(error-predicate type) r)
                     (,(error-generator type) r ,(errno-object type))
                     (,(error-generator type) r ,(errno-object type)
                       ',(function-name type))
                     ,return-exp))))))

(defmacro defsyscall (name-and-opts return-type &body args)
@@ -174,11 +182,15 @@ the C function name."
  (multiple-value-bind (lisp-name c-name options)
      (cffi::parse-name-and-options name-and-opts)
    #+windows (setf c-name (concatenate 'string "_" c-name))
    `(defcfun (,c-name ,lisp-name ,@options) (errno-wrapper ,return-type)
    `(defcfun (,c-name ,lisp-name ,@options)
         (errno-wrapper ,return-type :function-name ,lisp-name)
       ,@args)))

;;; This workaround for windows sucks. --luis
(defmacro defcsyscall (name-and-opts return-type &body args)
  "Like DEFSYSCALL but doesn't prepend #\_ to the C function name on
windows (or any other platform)."
  `(defcfun ,name-and-opts (errno-wrapper ,return-type) ,@args))
  (let ((lisp-name (cffi::parse-name-and-options name-and-opts)))
    `(defcfun ,name-and-opts
         (errno-wrapper ,return-type :function-name ,lisp-name)
       ,@args)))
+1 −0
Original line number Diff line number Diff line
@@ -37,6 +37,7 @@
   ;; Conditions
   #:posix-error
   #:posix-error-object
   #:posix-error-syscall

   #:eperm #:enoent #:esrch #:eintr #:eio #:enxio #:e2big #:enoexec #:ebadf
   #:echild #:eagain #:enomem #:eacces #:efault #:enotblk #:ebusy #:eexist
+6 −0
Original line number Diff line number Diff line
@@ -626,3 +626,9 @@
          (nix:close fd)
          (nix:unlink non-link-pathname))))
  failed)

(define-posix-test posix-error-syscall
    (handler-case (nix:mkdir "/" 0)
      (nix:posix-error (c)
        (nix:posix-error-syscall c)))
  nix:mkdir)
 No newline at end of file