sockets/make-socket.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 (defun make-socket (&key
  25                     (address-family :internet)
  26                     (type :stream)
  27                     (connect :active)
  28                     (protocol :default)
  29                     (ipv6 *ipv6*))
  30   (check-type address-family (member :internet :local))
  31   (check-type type (member :stream :datagram))
  32   (check-type connect (member :active :passive))
  33   (check-type ipv6 (member nil t :ipv6))
  34   (when (eql address-family :internet)
  35     (setf address-family (if ipv6 :ipv6 :ipv4)))
  36   (let ((socket-class
  37          (select-socket-type address-family type connect protocol)))
  38     (make-instance socket-class :family address-family)))
  39
  40 (defun open-client-socket (type address &optional port (ipv6 *ipv6*))
  41   (let* ((addr (ensure-address address))
  42          (family (etypecase addr
  43                    (inetaddr  :internet)
  44                    (localaddr :local)))
  45          (socket (make-socket :address-family family
  46                               :type type
  47                               :connect :active
  48                               :protocol :default
  49                               :ipv6 ipv6)))
  50     (connect socket addr :port port)))
  51
  52 (defun open-server-socket (address &key
  53                            port reuse-address
  54                            backlog (ipv6 *ipv6*))
  55   (let* ((addr (ensure-address address))
  56          (family (etypecase addr
  57                    (inetaddr  :internet)
  58                    (localaddr :local)))
  59          (socket (make-socket :address-family family
  60                               :connect :passive
  61                               :protocol :default
  62                               :ipv6 ipv6)))
  63     (bind-address socket addr :port port
  64                   :reuse-address reuse-address)
  65     (socket-listen socket :backlog backlog)))
  66
  67 (defmacro with-socket ((var &rest args) &body body)
  68   `(with-open-stream (,var (make-socket ,@args)) ,@body))
  69
  70 (defmacro with-client-socket ((var &key type address port (ipv6 nil ipv6p)) &body body)
  71   `(with-open-stream (,var  ,(if ipv6p `(open-client-socket ,type ,address ,port ,ipv6)
  72                                        `(open-client-socket ,type ,address ,port)))
  73      ,@body))
  74
  75 (defmacro with-server-socket ((var &key address port reuse-address
  76                                    backlog (ipv6 nil ipv6p)) &body body)
  77   `(with-open-stream (,var  ,(if ipv6p `(open-server-socket ,address :port ,port
  78                                                             :reuse-address ,reuse-address
  79                                                             :backlog ,backlog
  80                                                             :ipv6 ,ipv6)
  81                                        `(open-server-socket ,address :port ,port
  82                                                             :reuse-address ,reuse-address
  83                                                             :backlog ,backlog)))
  84      ,@body))