1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; make-socket.lisp --- Socket creation.
5 ;;; Copyright (C) 2006-2007, Stelian Ionescu <sionescu@common-lisp.net>
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
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.
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
24 (in-package :net.sockets
)
27 (eq (not x1
) (not x2
)))
29 ;;; FIXME: protocol is sort of misinterpreted.
31 ;;; CREATE-SOCKET is a a bit of a confusing name as it is too similar
32 ;;; to MAKE-SOCKET. I thought about different names and considered
33 ;;; the option of moving this "factory" code could be moved into
34 ;;; MAKE-INSTANCE methods. However, AFAICT, MAKE-SOCKET can achieve
35 ;;; the exact same effect as CREATE-SOCKET when some of the parameters
36 ;;; are ommitted so I have opted to remove CREATE-SOCKET from the
37 ;;; export list. --luis
38 (defun create-socket (&key
(family :internet
) (type :stream
) (connect :active
)
39 (protocol :default
) (ipv6 *ipv6
*)
40 (external-format :default
))
41 ;; (check-type address-family (member :internet :local))
42 (check-type type
(member :stream
:datagram
))
43 (check-type connect
(member :active
:passive
))
44 (check-type ipv6
(member nil t
:ipv6
))
45 (when (or (null family
) (eq family
:internet
))
46 (setf family
(if ipv6
:ipv6
:ipv4
)))
47 (let ((class (select-socket-type family type connect protocol
)))
50 :external-format external-format
)))
52 (defmacro %close-on-error
((obj) &body body
)
53 (alexandria:with-unique-names
(flag)
55 (unwind-protect (multiple-value-prog1 (progn ,@body
) (setf ,flag nil
))
56 (when (and ,obj
,flag
) (close ,obj
:abort t
))))))
58 (declaim (inline %make-internet-stream-socket
))
59 (defun %make-internet-stream-socket
(args connect ef
)
61 (destructuring-bind (&key local-host local-port remote-host remote-port
62 backlog reuse-address keepalive nodelay family
)
66 (assert (xnor local-host local-port
))
67 (assert (xnor remote-host remote-port
))
68 (%close-on-error
(socket)
69 (setf socket
(create-socket :family family
:type
:stream
70 :connect
:active
:external-format ef
))
71 (when keepalive
(set-socket-option socket
:keep-alive
:value t
))
72 (when nodelay
(set-socket-option socket
:tcp-nodelay
:value t
))
74 (setf address
(convert-or-lookup-inet-address local-host
))
75 (bind-address socket address
:port local-port
76 :reuse-address reuse-address
))
78 (setf address
(convert-or-lookup-inet-address remote-host
))
79 (connect socket address
:port remote-port
))))
81 (assert (xnor local-host local-port
))
82 (%close-on-error
(socket)
83 (setf socket
(create-socket :family family
:type
:stream
84 :connect
:passive
:external-format ef
))
86 (setf address
(convert-or-lookup-inet-address local-host
))
87 (bind-address socket address
:port local-port
88 :reuse-address reuse-address
)
89 (socket-listen socket
:backlog backlog
))))))
92 (declaim (inline %make-local-stream-socket
))
93 (defun %make-local-stream-socket
(args connect ef
)
95 (destructuring-bind (&key local-filename remote-filename backlog family
)
99 (assert remote-filename
)
100 (%close-on-error
(socket)
101 (setf socket
(create-socket :family family
:type
:stream
102 :connect
:active
:external-format ef
))
104 (bind-address socket
(make-address local-filename
)))
105 (connect socket
(make-address remote-filename
))))
107 (assert local-filename
)
108 (%close-on-error
(socket)
109 (setf socket
(create-socket :family family
:type
:stream
111 :external-format ef
))
112 (bind-address socket
(make-address local-filename
))
113 (socket-listen socket
:backlog backlog
)))))
116 (declaim (inline %make-internet-datagram-socket
))
117 (defun %make-internet-datagram-socket
(args ef
)
118 (let (socket address
)
119 (destructuring-bind (&key local-host local-port remote-host remote-port
120 reuse-address broadcast family
)
122 (assert (xnor local-host local-port
))
123 (assert (xnor remote-host remote-port
))
124 (%close-on-error
(socket)
125 (setf socket
(create-socket :family family
:type
:datagram
126 :connect
:active
:external-format ef
))
127 (when broadcast
(set-socket-option socket
:broadcast
:value t
))
129 (setf address
(convert-or-lookup-inet-address local-host
))
130 (bind-address socket address
:port local-port
131 :reuse-address reuse-address
))
133 (setf address
(convert-or-lookup-inet-address remote-host
))
134 (connect socket address
:port remote-port
))))
137 (declaim (inline %make-local-datagram-socket
))
138 (defun %make-local-datagram-socket
(args ef
)
139 (let (socket address
)
140 (destructuring-bind (&key local-filename remote-filename family
) args
141 (%close-on-error
(socket)
142 (setf socket
(create-socket :family family
:type
:datagram
143 :connect
:active
:external-format ef
))
145 (bind-address socket
(make-address address
)))
146 (when remote-filename
147 (connect socket
(make-address address
)))))
150 ;;; Changed ADDRESS-FAMILY to FAMILY and accept :IPV4 and :IPV6 as
151 ;;; arguments so we can create an IPv4 socket with
152 ;;; (make-socket :family :ipv4)
154 ;;; (make-socket #|:family :internet|# :ipv6 nil)
155 ;;; This is not compatible with Allegro's MAKE-SOCKET behaviour.
156 ;;; Is the renaming and the acceptance of extra values a problem?
157 ;;; (We need to be careful with *IPV6* for starters.)
158 (defun make-socket (&rest args
&key
(family :internet
) (type :stream
)
159 (connect :active
) (ipv6 *ipv6
*) format eol
160 (external-format :default
) scope-id
&allow-other-keys
)
161 "Creates a socket instance of the appropriate subclass of SOCKET."
162 (declare (ignore format eol scope-id
))
163 (check-type family
(member :internet
:local
:ipv4
:ipv6
))
164 (check-type type
(member :stream
:datagram
))
165 (check-type connect
(member :active
:passive
))
167 (remf args
:external-format
)
170 (let ((*ipv6
* (if (eq family
:ipv4
) nil ipv6
))
171 (address-family (if (or (eq family
:ipv4
) (eq family
:ipv6
))
175 ((and (eq address-family
:internet
) (eq type
:stream
))
176 (%make-internet-stream-socket args connect external-format
))
177 ((and (eq address-family
:local
) (eq type
:stream
))
178 (%make-local-stream-socket args connect external-format
))
179 ((and (eq address-family
:internet
) (eq type
:datagram
))
180 (%make-internet-datagram-socket args external-format
))
181 ((and (eq address-family
:local
) (eq type
:datagram
))
182 (%make-local-datagram-socket args external-format
)))))
184 (defmacro with-socket
((var &rest args
) &body body
)
185 "VAR is bound to a socket created by passing ARGS to
186 MAKE-SOCKET and BODY is executed as implicit PROGN. The socket
187 is automatically closed upon exit."
188 `(with-open-stream (,var
(make-socket ,@args
)) ,@body
))