src/sockets/conditions.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Socket conditions.
   4 ;;;
   5
   6 (in-package :iolib.sockets)
   7
   8 (defgeneric error-code (err)
   9   (:method ((err isys:syscall-error))
  10     (isys:code-of err)))
  11
  12 (defgeneric error-identifier (err)
  13   (:method ((err isys:syscall-error))
  14     (isys:identifier-of err)))
  15
  16 (defgeneric error-message (err)
  17   (:method ((err isys:syscall-error))
  18     (isys:message-of err)))
  19
  20 ;;;; Socket Errors
  21
  22 (define-condition socket-error (isys:syscall-error) ())
  23
  24 (defmethod print-object ((socket-error socket-error) stream)
  25   (print-unreadable-object (socket-error stream :type t :identity nil)
  26     (let ((code (iolib.syscalls:code-of socket-error)))
  27       (format stream "~S ~S ~S~@[, FD: ~S~]"
  28               (or code "[Unknown code]")
  29               (error-identifier socket-error)
  30               (if code (isys:strerror code) "[Can't get error string.]")
  31               (isys:handle-of socket-error)))))
  32
  33 (defparameter *socket-error-map* (make-hash-table :test 'eql))
  34
  35 (defmacro define-socket-error (name identifier &optional documentation)
  36   ;; FIXME: find a better way to conditionally define syscall errors
  37   (when (find identifier (cffi:foreign-enum-keyword-list 'isys:errno-values))
  38     (let ((errno (cffi:foreign-enum-value 'isys:errno-values identifier)))
  39       `(progn
  40          (setf (gethash ,errno *socket-error-map*) ',name)
  41          (define-condition ,name (,(isys:get-syscall-error-condition errno)
  42                                    socket-error) ()
  43            (:default-initargs :code ,(foreign-enum-value 'socket-error-values
  44                                                          identifier)
  45              :identifier ,identifier)
  46            (:documentation ,(or documentation (isys:strerror identifier))))))))
  47
  48 (defun lookup-socket-error (errno)
  49   (gethash errno *socket-error-map*))
  50
  51 (define-condition unknown-socket-error (socket-error) ()
  52   (:documentation "Error signalled upon finding an unknown socket error."))
  53
  54 (define-socket-error socket-address-in-use-error          :eaddrinuse)
  55 (define-socket-error socket-address-family-not-supported-error :eafnosupport)
  56 (define-socket-error socket-address-not-available-error   :eaddrnotavail)
  57 (define-socket-error socket-network-down-error            :enetdown)
  58 (define-socket-error socket-network-reset-error           :enetreset)
  59 (define-socket-error socket-network-unreachable-error     :enetunreach)
  60 (define-socket-error socket-no-network-error              :enonet)
  61 (define-socket-error socket-connection-aborted-error      :econnaborted)
  62 (define-socket-error socket-connection-reset-error        :econnreset)
  63 (define-socket-error socket-connection-refused-error      :econnrefused)
  64 (define-socket-error socket-connection-timeout-error      :etimedout)
  65 (define-socket-error socket-connection-in-progress-error  :einprogress)
  66 (define-socket-error socket-endpoint-shutdown-error       :eshutdown)
  67 (define-socket-error socket-no-buffer-space-error         :enobufs)
  68 (define-socket-error socket-host-down-error               :ehostdown)
  69 (define-socket-error socket-host-unreachable-error        :ehostunreach)
  70 (define-socket-error socket-already-connected-error       :eisconn)
  71 (define-socket-error socket-not-connected-error           :enotconn)
  72 (define-socket-error socket-option-not-supported-error    :enoprotoopt)
  73 (define-socket-error socket-operation-not-supported-error :eopnotsupp)
  74
  75 (declaim (inline %signal-socket-error))
  76 (defun %signal-socket-error (errno syscall fd fd2)
  77   (when-let (err (lookup-socket-error errno))
  78     (error err :syscall syscall :handle fd :handle2 fd2)))
  79
  80 ;;; Used in the ERRNO-WRAPPER foreign type.
  81 (declaim (inline signal-socket-error))
  82 (defun signal-socket-error (errno &optional syscall fd fd2)
  83   (cond
  84     ((= errno isys:eintr)
  85      (error 'isys:eintr :syscall syscall :handle fd :handle2 fd2))
  86     ((= errno isys:ewouldblock)
  87      (error 'isys:ewouldblock :syscall syscall :handle fd :handle2 fd2))
  88     (t
  89      (or (%signal-socket-error errno syscall fd fd2)
  90          (error (isys:make-syscall-error errno syscall fd fd2))))))