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
  53 (defun %make-internet-stream-active-socket (args family ef)
  54   (destructuring-bind (&key keepalive nodelay (reuse-address t)
  55                             (local-host +default-host+) (local-port 0)
  56                             (remote-host +default-host+) (remote-port 0))
  57       args
  58     (let ((local-port  (ensure-numerical-service local-port))
  59           (remote-port (ensure-numerical-service remote-port)))
  60       (%with-close-on-error (socket (create-socket family :stream :active ef))
  61         (when keepalive (set-socket-option socket :keep-alive :value t))
  62         (when nodelay (set-socket-option socket :tcp-nodelay :value t))
  63         (when local-host
  64           (bind-address socket (convert-or-lookup-inet-address local-host)
  65                         :port local-port
  66                         :reuse-address reuse-address))
  67         (when (plusp remote-port)
  68           (connect socket (convert-or-lookup-inet-address remote-host)
  69                    :port remote-port))))))
  70
  71 (defun %make-internet-stream-passive-socket (args family ef)
  72   (destructuring-bind (&key interface (reuse-address t)
  73                             (local-host +default-host+) (local-port 0)
  74                             (backlog *default-backlog-size*))
  75       args
  76     (let ((local-port  (ensure-numerical-service local-port)))
  77       (%with-close-on-error (socket (create-socket family :stream :passive ef))
  78         (when local-host
  79           (when interface
  80             (set-socket-option socket :bind-to-device :value interface))
  81           (bind-address socket (convert-or-lookup-inet-address local-host)
  82                         :port local-port
  83                         :reuse-address reuse-address)
  84           (socket-listen socket :backlog backlog))))))
  85
  86 (defun %make-local-stream-active-socket (args family ef)
  87   (destructuring-bind (&key local-filename remote-filename)
  88       args
  89     (%with-close-on-error (socket (create-socket family :stream :active ef))
  90       (when local-filename
  91         (bind-address socket (ensure-address local-filename :local)))
  92       (when remote-filename
  93         (connect socket (ensure-address remote-filename :local))))))
  94
  95 (defun %make-local-stream-passive-socket (args family ef)
  96   (destructuring-bind (&key local-filename (reuse-address t)
  97                             (backlog *default-backlog-size*))
  98       args
  99     (%with-close-on-error (socket (create-socket family :stream :passive ef))
 100       (when local-filename
 101         (bind-address socket (ensure-address local-filename :local)
 102                       :reuse-address reuse-address)
 103         (socket-listen socket :backlog backlog)))))
 104
 105 (defun %make-internet-datagram-socket (args family ef)
 106   (destructuring-bind (&key broadcast interface (reuse-address t)
 107                             (local-host +default-host+) (local-port 0)
 108                             (remote-host +default-host+) (remote-port 0))
 109       args
 110     (let ((local-port  (ensure-numerical-service local-port))
 111           (remote-port (ensure-numerical-service remote-port)))
 112       (%with-close-on-error (socket (create-socket family :datagram :active ef))
 113         (when broadcast (set-socket-option socket :broadcast :value t))
 114         (when local-host
 115           (bind-address socket (convert-or-lookup-inet-address local-host)
 116                         :port local-port
 117                         :reuse-address reuse-address)
 118           (when interface
 119             (set-socket-option socket :bind-to-device :value interface)))
 120         (when (plusp remote-port)
 121           (connect socket (convert-or-lookup-inet-address remote-host)
 122                    :port remote-port))))))
 123
 124 (defun %make-local-datagram-socket (args family ef)
 125   (destructuring-bind (&key local-filename remote-filename) args
 126     (%with-close-on-error (socket (create-socket family :datagram :active ef))
 127       (when local-filename
 128         (bind-address socket (ensure-address local-filename :local)))
 129       (when remote-filename
 130         (connect socket (ensure-address remote-filename :local))))))
 131
 132 (defun make-socket (&rest args &key (family :internet) (type :stream)
 133                     (connect :active) (ipv6 *ipv6*)
 134                     (external-format :default) &allow-other-keys)
 135   "Creates a socket instance of the appropriate subclass of SOCKET."
 136   (check-type family (member :internet :local :ipv4 :ipv6) "one of :INTERNET, :LOCAL, :IPV4 or :IPV6")
 137   (check-type type (member :stream :datagram) "either :STREAM or :DATAGRAM")
 138   (check-type connect (member :active :passive) "either :ACTIVE or :PASSIVE")
 139   (dolist (key '(:family :type :connect :external-format :ipv6))
 140     (remf args key))
 141   (case family
 142     (:internet (setf family (if ipv6 :ipv6 :ipv4)))
 143     (:ipv4     (setf ipv6 nil)))
 144   (let ((*ipv6* ipv6))
 145     (multiple-value-case (family type connect)
 146       (((:ipv4 :ipv6) :stream :active)
 147        (%make-internet-stream-active-socket args family external-format))
 148       (((:ipv4 :ipv6) :stream :passive)
 149        (%make-internet-stream-passive-socket args family external-format))
 150       ((:local :stream :active)
 151        (%make-local-stream-active-socket args :local external-format))
 152       ((:local :stream :passive)
 153        (%make-local-stream-passive-socket args :local external-format))
 154       (((:ipv4 :ipv6) :datagram)
 155        (%make-internet-datagram-socket args family external-format))
 156       ((:local :datagram)
 157        (%make-local-datagram-socket args :local external-format)))))
 158
 159 (defmacro with-open-socket ((var &rest args) &body body)
 160   "VAR is bound to a socket created by passing ARGS to
 161 MAKE-SOCKET and BODY is executed as implicit PROGN.  The socket
 162 is automatically closed upon exit."
 163   `(with-open-stream (,var (make-socket ,@args)) ,@body))
 164
 165 (defmacro with-accept-connection ((var passive-socket &rest args) &body body)
 166   "VAR is bound to a socket created by passing PASSIVE-SOCKET and ARGS to
 167 ACCEPT-CONNECTION and BODY is executed as implicit PROGN.  The socket
 168 is automatically closed upon exit."
 169   `(with-open-stream (,var (accept-connection ,passive-socket ,@args)) ,@body))