sockets/conditions.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; conditions.lisp --- Conditions.
   4 ;;;
   5 ;;; Copyright (C) 2006-2007, Stelian Ionescu  <sionescu@common-lisp.net>
   6 ;;;
   7 ;;; This code is free software; you can redistribute it and/or
   8 ;;; modify it under the terms of the version 2.1 of
   9 ;;; the GNU Lesser General Public License as published by
  10 ;;; the Free Software Foundation, as clarified by the
  11 ;;; preamble found here:
  12 ;;;     http://opensource.franz.com/preamble.html
  13 ;;;
  14 ;;; This program is distributed in the hope that it will be useful,
  15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU Lesser General
  20 ;;; Public License along with this library; if not, write to the
  21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  22 ;;; Boston, MA 02110-1301, USA
  23
  24 (in-package :net.sockets)
  25
  26 (defgeneric error-code (err))
  27
  28 (defmethod error-code ((err system-error))
  29   (osicat-sys:system-error-code err))
  30
  31 (defgeneric error-identifier (err))
  32
  33 (defmethod error-identifier ((err system-error))
  34   (osicat-sys:system-error-identifier err))
  35
  36 (defgeneric error-message (err))
  37
  38 (defmethod error-message ((err system-error))
  39   (osicat-sys:system-error-message err))
  40
  41 (defun print-message-if-not-null (condition stream
  42                                   &optional (eof-place :before))
  43   (declare (type stream stream))
  44   (let ((msg (error-message condition)))
  45     (when msg
  46       (when (eql eof-place :before)
  47         (fresh-line stream))
  48       (format stream "~A" msg)
  49       (when (eql eof-place :after)
  50         (fresh-line stream)))))
  51
  52 ;;;; Socket Errors
  53
  54 (defvar *socket-error-map* nil)
  55
  56 (define-condition socket-error (nix:posix-error) ())
  57
  58 (defmethod print-object ((socket-error socket-error) stream)
  59   (print-unreadable-object (socket-error stream :type t :identity nil)
  60     (let ((code (osicat-sys:system-error-code socket-error)))
  61       (format stream "~S ~S ~S"
  62               (or code "[No code]")
  63               (osicat-sys:system-error-identifier socket-error)
  64               (or (nix:strerror code)
  65                   "[Can't get error string.]")))))
  66
  67 (defmacro define-socket-error (name identifier &optional documentation)
  68   `(progn
  69      (push (cons ,identifier ',name) *socket-error-map*)
  70      (define-condition ,name (socket-error) ()
  71        (:default-initargs :code ,(foreign-enum-value 'socket-error-values
  72                                                      identifier)
  73          :identifier ,identifier)
  74        (:documentation ,(or documentation "")))))
  75
  76 (define-condition unknown-socket-error (socket-error)
  77   ()
  78   (:documentation "Error signalled upon finding an unknown error."))
  79
  80 (defun lookup-socket-error (keyword)
  81   (or (cdr (assoc keyword *socket-error-map*))
  82       (make-instance 'unknown-socket-error :identifier keyword
  83                      :code (foreign-enum-value 'socket-error-values keyword))))
  84
  85 (define-socket-error socket-invalid-argument              :einval)
  86 (define-socket-error socket-address-in-use-error          :eaddrinuse)
  87 (define-socket-error socket-address-not-available-error   :eaddrnotavail)
  88 (define-socket-error socket-network-down-error            :enetdown)
  89 (define-socket-error socket-network-reset-error           :enetreset)
  90 (define-socket-error socket-network-unreachable-error     :enetunreach)
  91 (define-socket-error socket-no-network-error              :enonet)
  92 (define-socket-error socket-connection-aborted-error      :econnaborted)
  93 (define-socket-error socket-connection-reset-error        :econnreset)
  94 (define-socket-error socket-connection-refused-error      :econnrefused)
  95 (define-socket-error socket-endpoint-shutdown-error       :eshutdown)
  96 (define-socket-error socket-connection-timeout-error      :etimedout)
  97 (define-socket-error socket-no-buffer-space-error         :enobufs)
  98 (define-socket-error socket-host-down-error               :ehostdown)
  99 (define-socket-error socket-host-unreachable-error        :ehostunreach)
 100 (define-socket-error socket-already-connected-error       :eisconn)
 101 (define-socket-error socket-not-connected-error           :enotconn)
 102 (define-socket-error socket-option-not-supported-error    :enoprotoopt)
 103 (define-socket-error socket-operation-not-supported-error :eopnotsupp)
 104
 105 ;;; For regular POSIX functions that return extra errors when handling
 106 ;;; sockets.  Eg.: CLOSE and OPEN.  But maybe we should simply define
 107 ;;; our own bindings for those functions at some point in order to
 108 ;;; ditch the CL-POSIX dependency? (especially if we at some point use
 109 ;;; HANDLEs instead of FDs on windows)
 110 (defmacro with-socket-error-filter (&body body)
 111   `(handler-case
 112        (progn ,@body)
 113      (nix:posix-error (err)
 114        (let* ((id (error-identifier err))
 115               (condition (cdr (assoc id *socket-error-map*))))
 116          (if condition
 117              (error condition)
 118              (error err))))))
 119
 120 ;;; Used in the ERRNO-WRAPPER foreign type.
 121 (defun signal-socket-error (return-value)
 122   (declare (ignore return-value))
 123   (let ((errno (nix:get-errno)))
 124     (let ((kw (foreign-enum-keyword 'socket-error-values errno :errorp nil)))
 125       (if kw
 126           (error (lookup-socket-error kw))
 127           ;; this branch is probably mostly unused now. Should
 128           ;; probably sinal an UNKOWN-SOCKET-ERROR here instead.
 129           (nix:posix-error errno)))))
 130
 131 (define-condition resolver-error ()
 132   ((data :initarg :data :reader resolver-error-data))
 133   (:documentation
 134    "Signaled when an error occurs while trying to resolve an address."))
 135
 136 (defmacro define-resolver-error (name format-string &optional documentation)
 137   `(define-condition ,name (resolver-error) ()
 138      (:report (lambda (condition stream)
 139                 (format stream ,format-string (resolver-error-data condition))))
 140      (:documentation ,documentation)))
 141
 142 (define-resolver-error resolver-again-error
 143   "Temporary failure occurred while resolving: ~S"
 144   "Condition signaled when a temporary failure occurred.")
 145
 146 (define-resolver-error resolver-fail-error
 147   "Non recoverable error occurred while resolving: ~S"
 148   "Condition signaled when a non-recoverable error occurred.")
 149
 150 (define-resolver-error resolver-no-name-error
 151   "Host or service not found: ~S"
 152   "Condition signaled when a host or service was not found.")
 153
 154 (define-resolver-error resolver-unknown-error
 155   "Unknown error while resolving: ~S"
 156   "Condition signaled when an unknown error is signaled while resolving
 157 an address.")