sockets/conditions.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2006, 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :net.sockets)
  23
  24 (defgeneric error-code (err))
  25 (defmethod error-code ((err system-error))
  26   (et:system-error-code err))
  27
  28 (defgeneric error-identifier (err))
  29 (defmethod error-identifier ((err system-error))
  30   (et:system-error-identifier err))
  31
  32 (defgeneric error-message (err))
  33 (defmethod error-message ((err system-error))
  34   (et:message err))
  35
  36 (defun print-message-if-not-null (condition stream &optional (eof-place :before))
  37   (declare (type stream stream))
  38   (let ((msg (error-message condition)))
  39     (when msg
  40       (when (eql eof-place :before)
  41         (fresh-line stream))
  42       (format stream "~A" msg)
  43       (when (eql eof-place :after)
  44         (fresh-line stream)))))
  45
  46 ;;;;;;;;;;;;;;;;;;;;;;;
  47 ;;;  SOCKET ERRORS  ;;;
  48 ;;;;;;;;;;;;;;;;;;;;;;;
  49
  50 (defparameter *socket-error-map* nil)
  51
  52 (define-condition socket-error (unix-error) ())
  53
  54 (defmacro define-socket-error (name identifier &optional documentation)
  55   `(progn
  56      (export ',name)
  57      (push (cons ,identifier ',name) *socket-error-map*)
  58      (define-condition ,name (socket-error) ()
  59        (:default-initargs :code (unixerr-value ,identifier)
  60                           :identifier ,identifier)
  61        (:documentation ,(or documentation "")))))
  62
  63 (define-socket-error socket-address-in-use-error          :eaddrinuse)
  64 (define-socket-error socket-address-not-available-error   :eaddrnotavail)
  65 (define-socket-error socket-network-down-error            :enetdown)
  66 (define-socket-error socket-network-reset-error           :enetreset)
  67 (define-socket-error socket-network-unreachable-error     :enetunreach)
  68 (define-socket-error socket-no-network-error              :enonet)
  69 (define-socket-error socket-connection-aborted-error      :econnaborted)
  70 (define-socket-error socket-connection-reset-error        :econnreset)
  71 (define-socket-error socket-connection-refused-error      :econnrefused)
  72 (define-socket-error socket-endpoint-shutdown-error       :eshutdown)
  73 (define-socket-error socket-connection-timeout-error      :etimedout)
  74 (define-socket-error socket-no-buffer-space-error         :enobufs)
  75 (define-socket-error socket-host-down-error               :ehostdown)
  76 (define-socket-error socket-host-unreachable-error        :ehostunreach)
  77 (define-socket-error socket-already-connected-error       :eisconn)
  78 (define-socket-error socket-not-connected-error           :enotconn)
  79 (define-socket-error socket-option-not-supported-error    :enoprotoopt)
  80 (define-socket-error socket-operation-not-supported-error :eopnotsupp)
  81
  82 (defun socket-error (unix-error)
  83   (let* ((id (error-identifier unix-error))
  84          (condition (cdr (assoc id *socket-error-map*))))
  85     (if condition
  86         (error condition)
  87         (error unix-error))))
  88
  89 (defmacro with-socket-error-filter (&body body)
  90   `(handler-case
  91        (progn ,@body)
  92      (unix-error (err)
  93        (socket-error err))))