1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
3 ;;; --- Socket conditions.
6 (in-package :iolib.sockets
)
8 (defgeneric error-code
(err)
9 (:method
((err isys
:syscall-error
))
12 (defgeneric error-identifier
(err)
13 (:method
((err isys
:syscall-error
))
14 (isys:identifier-of err
)))
16 (defgeneric error-message
(err)
17 (:method
((err isys
:syscall-error
))
18 (isys:message-of err
)))
22 (define-condition socket-error
(isys:syscall-error
) ())
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
)))))
33 (defparameter *socket-error-map
* (make-hash-table :test
'eql
))
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
)))
40 (setf (gethash ,errno
*socket-error-map
*) ',name
)
41 (define-condition ,name
(,(isys:get-syscall-error-condition errno
)
43 (:default-initargs
:code
,(foreign-enum-value 'socket-error-values
45 :identifier
,identifier
)
46 (:documentation
,(or documentation
(isys:strerror identifier
))))))))
48 (defun lookup-socket-error (errno)
49 (gethash errno
*socket-error-map
*))
51 (define-condition unknown-socket-error
(socket-error) ()
52 (:documentation
"Error signalled upon finding an unknown socket error."))
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
)
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
)))
80 ;;; Used in the ERRNO-WRAPPER foreign type.
81 (declaim (inline signal-socket-error
))
82 (defun signal-socket-error (errno &optional syscall fd fd2
)
85 (error 'isys
:eintr
:syscall syscall
:handle fd
:handle2 fd2
))
86 ((= errno isys
:ewouldblock
)
87 (error 'isys
:ewouldblock
:syscall syscall
:handle fd
:handle2 fd2
))
89 (or (%signal-socket-error errno syscall fd fd2
)
90 (error (isys:make-syscall-error errno syscall fd fd2
))))))