src/sockets/trivial-sockets.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- Main socket methods.
   4 ;;;
   5
   6 (in-package :common-lisp-user)
   7
   8 (defpackage :iolib.trivial-sockets
   9   (:use :iolib.base :iolib.sockets)
  10   (:shadow #:socket-error #:accept-connection)
  11   (:export #:open-stream #:socket-error #:socket-nested-error
  12            #:unsupported #:unsupported-feature
  13            #:open-server #:close-server #:accept-connection
  14            #:with-server))
  15
  16 (in-package :iolib.trivial-sockets)
  17
  18 ;;;;
  19 ;;;; ERRORS
  20 ;;;;
  21
  22 ;; you're using a part of the interface that the implementation doesn't do
  23 (define-condition unsupported (error)
  24   ((feature :initarg :feature :reader unsupported-feature))
  25   (:report (lambda (c s)
  26              (format s "~S does not support trivial-socket feature ~S."
  27                      (lisp-implementation-type) (unsupported-feature c)))))
  28
  29 ;; all-purpose error: host not found, host not responding,
  30 ;; no service on that port, etc
  31 (define-condition socket-error (error)
  32   ((nested-error :initarg :nested-error :reader socket-nested-error)))
  33 \f
  34 ;;;;
  35 ;;;; Main implementation
  36 ;;;;
  37
  38 (defun resolve-hostname (name)
  39   (let ((*ipv6* nil))
  40     (cond
  41       ((eql :any name) +ipv4-unspecified+)
  42       (t (nth-value 0 (ensure-hostname name))))))
  43
  44 (defun open-stream (peer-host peer-port &key
  45                     (local-host :any) (local-port 0)
  46                     (external-format :default)
  47                     (element-type 'character)
  48                     (protocol :tcp))
  49   (declare (ignore element-type))
  50   (unless (eql :tcp protocol)
  51     (error 'unsupported :feature `(:protocol ,protocol)))
  52   (let ((*ipv6* nil))
  53     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  54       (make-socket :address-family :internet
  55                    :connect :active
  56                    :type :stream
  57                    :remote-host (resolve-hostname peer-host)
  58                    :remote-port peer-port
  59                    :local-host (resolve-hostname local-host)
  60                    :local-port local-port
  61                    :external-format external-format))))
  62
  63 (defun open-server (&key (host :any) (port 0)
  64                     (reuse-address t)
  65                     (backlog 1)
  66                     (protocol :tcp))
  67   "Returns a SERVER object and the port that was bound, as multiple values."
  68   (unless (eql :tcp protocol)
  69     (error 'unsupported :feature `(:protocol ,protocol)))
  70   (let ((*ipv6* nil))
  71     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  72       (let* ((host (if (eql :any host) +ipv4-unspecified+ host))
  73              (socket (make-socket :address-family :internet
  74                                   :type :stream
  75                                   :connect :passive
  76                                   :local-host host
  77                                   :local-port port
  78                                   :reuse-address reuse-address
  79                                   :backlog backlog)))
  80         (values socket (local-port socket))))))
  81
  82 (defun close-server (server)
  83   (close server))
  84
  85 (defun accept-connection (socket &key
  86                           (external-format :default)
  87                           (element-type 'character))
  88   (declare (ignore element-type))       ; bivalent streams
  89   (let ((*ipv6* nil))
  90     (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
  91       (iolib.sockets:accept-connection socket :external-format external-format))))
  92 \f
  93 ;;;;
  94 ;;;; Utilities
  95 ;;;;
  96
  97 (defmacro with-server ((name arguments) &body forms)
  98   `(with-open-stream (,name (open-server ,@arguments))
  99      (locally ,@forms)))