sockets/make-socket.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; make-socket.lisp --- Socket creation.
   4 ;;;
   5 ;;; Copyright (C) 2006-2008, 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 (defun create-socket (family type connect external-format)
  27   (make-instance (select-socket-class family type connect :default)
  28                  :family family
  29                  :external-format external-format))
  30
  31 (defmacro %with-close-on-error ((var value) &body body)
  32   "Bind VAR to VALUE, execute BODY as implicit PROGN and return VAR.
  33 On error call CLOSE with :ABORT T on VAR."
  34   (with-gensyms (errorp)
  35     `(let ((,var ,value) (,errorp t))
  36        (unwind-protect
  37             (multiple-value-prog1 (locally ,@body ,var) (setf ,errorp nil))
  38          (when (and ,var ,errorp) (close ,var :abort t))))))
  39
  40 (defun convert-or-lookup-inet-address (address &optional (ipv6 *ipv6*))
  41   "If ADDRESS is an inet-address designator, it is converted, if
  42 necessary, to an INET-ADDRESS object and returned.  Otherwise it
  43 is assumed to be a host name which is then looked up in order to
  44 return its primary address as the first return value and the
  45 remaining address list as the second return value."
  46   (or (ignore-parse-errors (ensure-address address :internet))
  47       (let ((addresses (lookup-host address :ipv6 ipv6)))
  48         (values (car addresses) (cdr addresses)))))
  49
  50 (define-symbol-macro +default-host+
  51     (if *ipv6* +ipv6-unspecified+ +ipv4-unspecified+))
  52 \f
  53 ;;; Internet Stream Active Socket creation
  54
  55 (defun %%make-internet-stream-active-socket (family ef keepalive nodelay reuse-address
  56                                              local-host local-port remote-host remote-port)
  57   (let ((local-port  (ensure-numerical-service local-port))
  58         (remote-port (ensure-numerical-service remote-port)))
  59     (%with-close-on-error (socket (create-socket family :stream :active ef))
  60       (when keepalive (set-socket-option socket :keep-alive :value t))
  61       (when nodelay (set-socket-option socket :tcp-nodelay :value t))
  62       (when local-host
  63         (bind-address socket (convert-or-lookup-inet-address local-host)
  64                       :port local-port
  65                       :reuse-address reuse-address))
  66       (when (plusp remote-port)
  67         (connect socket (convert-or-lookup-inet-address remote-host)
  68                  :port remote-port)))))
  69
  70 (defun %make-internet-stream-active-socket (args family ef)
  71   (destructuring-bind (&key keepalive nodelay (reuse-address t)
  72                             (local-host +default-host+) (local-port 0)
  73                             (remote-host +default-host+) (remote-port 0))
  74       args
  75     (%%make-internet-stream-active-socket family ef keepalive nodelay reuse-address
  76                                           local-host local-port remote-host remote-port)))
  77
  78 (define-compiler-macro %make-internet-stream-active-socket (&whole form args family ef)
  79   (if (symbolp args)
  80       form
  81       (handler-case
  82           (destructuring-bind (&key keepalive nodelay (reuse-address t)
  83                                     (local-host +default-host+) (local-port 0)
  84                                     (remote-host +default-host+) (remote-port 0))
  85               (cdr args)
  86             `(%%make-internet-stream-active-socket ,family ,ef ,keepalive ,nodelay ,reuse-address
  87                                                    ,local-host ,local-port ,remote-host ,remote-port))
  88         (error (err) `(error ,err)))))
  89 \f
  90 ;;; Internet Stream Passive Socket creation
  91
  92 (defun %%make-internet-stream-passive-socket (family ef interface reuse-address
  93                                               local-host local-port backlog)
  94   (let ((local-port  (ensure-numerical-service local-port)))
  95     (%with-close-on-error (socket (create-socket family :stream :passive ef))
  96       (when local-host
  97         (when interface
  98           (set-socket-option socket :bind-to-device :value interface))
  99         (bind-address socket (convert-or-lookup-inet-address local-host)
 100                       :port local-port
 101                       :reuse-address reuse-address)
 102         (socket-listen socket :backlog backlog)))))
 103
 104 (defun %make-internet-stream-passive-socket (args family ef)
 105   (destructuring-bind (&key interface (reuse-address t)
 106                             (local-host +default-host+) (local-port 0)
 107                             (backlog *default-backlog-size*))
 108       args
 109     (%%make-internet-stream-passive-socket family ef interface reuse-address
 110                                            local-host local-port backlog)))
 111
 112 (define-compiler-macro %make-internet-stream-passive-socket (&whole form args family ef)
 113   (if (symbolp args)
 114       form
 115       (handler-case
 116           (destructuring-bind (&key interface (reuse-address t)
 117                                     (local-host +default-host+) (local-port 0)
 118                                     (backlog *default-backlog-size*))
 119               (cdr args)
 120             `(%%make-internet-stream-passive-socket ,family ,ef ,interface ,reuse-address
 121                                                     ,local-host ,local-port ,backlog))
 122         (error (err) `(error ,err)))))
 123 \f
 124 ;;; Local Stream Active Socket creation
 125
 126 (defun %%make-local-stream-active-socket (family ef local-filename remote-filename)
 127   (%with-close-on-error (socket (create-socket family :stream :active ef))
 128     (when local-filename
 129       (bind-address socket (ensure-address local-filename :local)))
 130     (when remote-filename
 131       (connect socket (ensure-address remote-filename :local)))))
 132
 133 (defun %make-local-stream-active-socket (args family ef)
 134   (destructuring-bind (&key local-filename remote-filename)
 135       args
 136     (%%make-local-stream-active-socket family ef local-filename remote-filename)))
 137
 138 (define-compiler-macro %make-local-stream-active-socket (&whole form args family ef)
 139   (if (symbolp args)
 140       form
 141       (handler-case
 142           (destructuring-bind (&key local-filename remote-filename)
 143               (cdr args)
 144             `(%%make-local-stream-active-socket ,family ,ef ,local-filename ,remote-filename))
 145         (error (err) `(error ,err)))))
 146 \f
 147 ;;; Local Stream Passive Socket creation
 148
 149 (defun %%make-local-stream-passive-socket (family ef local-filename reuse-address backlog)
 150   (%with-close-on-error (socket (create-socket family :stream :passive ef))
 151     (when local-filename
 152       (bind-address socket (ensure-address local-filename :local)
 153                     :reuse-address reuse-address)
 154       (socket-listen socket :backlog backlog))))
 155
 156 (defun %make-local-stream-passive-socket (args family ef)
 157   (destructuring-bind (&key local-filename (reuse-address t)
 158                             (backlog *default-backlog-size*))
 159       args
 160     (%%make-local-stream-passive-socket family ef local-filename reuse-address backlog)))
 161
 162 (define-compiler-macro %make-local-stream-passive-socket (&whole form args family ef)
 163   (if (symbolp args)
 164       form
 165       (handler-case
 166           (destructuring-bind (&key local-filename (reuse-address t)
 167                                     (backlog *default-backlog-size*))
 168               (cdr args)
 169             `(%%make-local-stream-passive-socket ,family ,ef ,local-filename ,reuse-address ,backlog))
 170         (error (err) `(error ,err)))))
 171 \f
 172 ;;; Internet Datagram Socket creation
 173
 174 (defun %%make-internet-datagram-socket (family ef broadcast interface reuse-address
 175                                         local-host local-port remote-host remote-port)
 176   (let ((local-port  (ensure-numerical-service local-port))
 177         (remote-port (ensure-numerical-service remote-port)))
 178     (%with-close-on-error (socket (create-socket family :datagram :active ef))
 179       (when broadcast (set-socket-option socket :broadcast :value t))
 180       (when local-host
 181         (bind-address socket (convert-or-lookup-inet-address local-host)
 182                       :port local-port
 183                       :reuse-address reuse-address)
 184         (when interface
 185           (set-socket-option socket :bind-to-device :value interface)))
 186       (when (plusp remote-port)
 187         (connect socket (convert-or-lookup-inet-address remote-host)
 188                  :port remote-port)))))
 189
 190 (defun %make-internet-datagram-socket (args family ef)
 191   (destructuring-bind (&key broadcast interface (reuse-address t)
 192                             (local-host +default-host+) (local-port 0)
 193                             (remote-host +default-host+) (remote-port 0))
 194       args
 195     (%%make-internet-datagram-socket family ef broadcast interface reuse-address
 196                                      local-host local-port remote-host remote-port)))
 197
 198 (define-compiler-macro %make-internet-datagram-socket (&whole form args family ef)
 199   (if (symbolp args)
 200       form
 201       (handler-case
 202           (destructuring-bind (&key broadcast interface (reuse-address t)
 203                                     (local-host +default-host+) (local-port 0)
 204                                     (remote-host +default-host+) (remote-port 0))
 205               (cdr args)
 206             `(%%make-internet-datagram-socket ,family ,ef ,broadcast ,interface ,reuse-address
 207                                               ,local-host ,local-port ,remote-host ,remote-port))
 208         (error (err) `(error ,err)))))
 209 \f
 210 ;;; Local Datagram Socket creation
 211
 212 (defun %%make-local-datagram-socket (family ef local-filename remote-filename)
 213   (%with-close-on-error (socket (create-socket family :datagram :active ef))
 214     (when local-filename
 215       (bind-address socket (ensure-address local-filename :local)))
 216     (when remote-filename
 217       (connect socket (ensure-address remote-filename :local)))))
 218
 219 (defun %make-local-datagram-socket (args family ef)
 220   (destructuring-bind (&key local-filename remote-filename)
 221       args
 222     (%%make-local-datagram-socket family ef local-filename remote-filename)))
 223
 224 (define-compiler-macro %make-local-datagram-socket (&whole form args family ef)
 225   (if (symbolp args)
 226       form
 227       (handler-case
 228           (destructuring-bind (&key local-filename remote-filename)
 229               (cdr args)
 230             `(%%make-local-datagram-socket ,family ,ef ,local-filename ,remote-filename))
 231         (error (err) `(error ,err)))))
 232 \f
 233 ;;; MAKE-SOCKET
 234
 235 (defun make-socket (&rest args &key (family :internet) (type :stream)
 236                     (connect :active) (ipv6 *ipv6*)
 237                     (external-format :default) &allow-other-keys)
 238   "Creates a socket instance of the appropriate subclass of SOCKET."
 239   (check-type family (member :internet :local :ipv4 :ipv6) "one of :INTERNET, :LOCAL, :IPV4 or :IPV6")
 240   (check-type type (member :stream :datagram) "either :STREAM or :DATAGRAM")
 241   (check-type connect (member :active :passive) "either :ACTIVE or :PASSIVE")
 242   (let ((args (remove-properties args '(:family :type :connect :external-format :ipv6))))
 243     (case family
 244       (:internet (setf family (if ipv6 :ipv6 :ipv4)))
 245       (:ipv4     (setf ipv6 nil)))
 246     (let ((*ipv6* ipv6))
 247       (multiple-value-case (family type connect)
 248         (((:ipv4 :ipv6) :stream :active)
 249          (%make-internet-stream-active-socket args family external-format))
 250         (((:ipv4 :ipv6) :stream :passive)
 251          (%make-internet-stream-passive-socket args family external-format))
 252         ((:local :stream :active)
 253          (%make-local-stream-active-socket args :local external-format))
 254         ((:local :stream :passive)
 255          (%make-local-stream-passive-socket args :local external-format))
 256         (((:ipv4 :ipv6) :datagram)
 257          (%make-internet-datagram-socket args family external-format))
 258         ((:local :datagram)
 259          (%make-local-datagram-socket args :local external-format))))))
 260
 261 (define-compiler-macro make-socket (&whole form &rest args &key (family :internet) (type :stream)
 262                                     (connect :active) (ipv6 '*ipv6*)
 263                                     (external-format :default) &allow-other-keys)
 264   (cond
 265     ((and (constantp family) (constantp type) (constantp connect))
 266      (check-type family (member :internet :local :ipv4 :ipv6) "one of :INTERNET, :LOCAL, :IPV4 or :IPV6")
 267      (check-type type (member :stream :datagram) "either :STREAM or :DATAGRAM")
 268      (check-type connect (member :active :passive) "either :ACTIVE or :PASSIVE")
 269      (let ((lower-function
 270             (multiple-value-case (family type connect)
 271               (((:ipv4 :ipv6 :internet) :stream :active) '%make-internet-stream-active-socket)
 272               (((:ipv4 :ipv6 :internet) :stream :passive) '%make-internet-stream-passive-socket)
 273               ((:local :stream :active) '%make-local-stream-active-socket)
 274               ((:local :stream :passive) '%make-local-stream-passive-socket)
 275               (((:ipv4 :ipv6 :internet) :datagram) '%make-internet-datagram-socket)
 276               ((:local :datagram) '%make-local-datagram-socket)))
 277            (newargs (remove-properties args '(:family :type :connect :external-format :ipv6))))
 278        (case family
 279          (:internet (setf family '+default-inet-family+))
 280          (:ipv4     (setf ipv6 nil)))
 281        `(let ((*ipv6* ,ipv6))
 282           (,lower-function (list ,@newargs) ,family ,external-format))))
 283     (t form)))
 284
 285 (defmacro with-open-socket ((var &rest args) &body body)
 286   "VAR is bound to a socket created by passing ARGS to
 287 MAKE-SOCKET and BODY is executed as implicit PROGN.  The socket
 288 is automatically closed upon exit."
 289   `(with-open-stream (,var (make-socket ,@args)) ,@body))
 290
 291 (defmacro with-accept-connection ((var passive-socket &rest args) &body body)
 292   "VAR is bound to a socket created by passing PASSIVE-SOCKET and ARGS to
 293 ACCEPT-CONNECTION and BODY is executed as implicit PROGN.  The socket
 294 is automatically closed upon exit."
 295   `(with-open-stream (,var (accept-connection ,passive-socket ,@args)) ,@body))