1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
3 ;; Copyright (C) 2006, 2007 Stelian Ionescu
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
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.
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
22 (in-package :net.sockets
)
24 (defun create-socket (&key
25 (address-family :internet
)
30 (external-format :default
))
31 (check-type address-family
(member :internet
:local
))
32 (check-type type
(member :stream
:datagram
))
33 (check-type connect
(member :active
:passive
))
34 (check-type ipv6
(member nil t
:ipv6
))
35 (when (eq address-family
:internet
)
36 (setf address-family
(if ipv6
:ipv6
:ipv4
)))
38 (select-socket-type address-family type connect protocol
)))
39 (make-instance socket-class
:family address-family
40 :external-format external-format
)))
42 (defmacro %close-on-error
((obj) &body body
)
43 (with-gensyms ($flag$
)
45 (unwind-protect (multiple-value-prog1 (progn ,@body
) (setf ,$flag$ nil
))
46 (when (and ,obj
,$flag$
) (close ,obj
:abort t
))))))
48 (declaim (inline %make-internet-stream-socket
))
49 (defun %make-internet-stream-socket
(args connect ipv6 ef
)
51 (destructuring-bind (&key local-host local-port remote-host remote-port
52 backlog reuse-address keepalive nodelay
&allow-other-keys
) args
55 (assert (xnor local-host local-port
))
56 (assert (xnor remote-host remote-port
))
57 (%close-on-error
(socket)
58 (setf socket
(create-socket :address-family
:internet
:type
:stream
59 :connect
:active
:ipv6 ipv6
61 (when keepalive
(set-socket-option socket
:keep-alive
:value t
))
62 (when nodelay
(set-socket-option socket
:tcp-nodelay
:value t
))
64 (setf address
(convert-or-lookup-inet-address local-host ipv6
))
65 (bind-address socket address
:port local-port
66 :reuse-address reuse-address
))
68 (setf address
(convert-or-lookup-inet-address remote-host ipv6
))
69 (connect socket address
:port remote-port
))))
71 (assert (xnor local-host local-port
))
72 (%close-on-error
(socket)
73 (setf socket
(create-socket :address-family
:internet
:type
:stream
74 :connect
:passive
:ipv6 ipv6
))
76 (setf address
(convert-or-lookup-inet-address local-host ipv6
))
77 (bind-address socket address
:port local-port
78 :reuse-address reuse-address
)
79 (socket-listen socket
:backlog backlog
))))))
82 (declaim (inline %make-local-stream-socket
))
83 (defun %make-local-stream-socket
(args connect ef
)
85 (destructuring-bind (&key local-filename remote-filename backlog
&allow-other-keys
) args
88 (assert remote-filename
)
89 (%close-on-error
(socket)
90 (setf socket
(create-socket :address-family
:local
:type
:stream
91 :connect
:active
:external-format ef
))
92 (when local-filename
(bind-address socket
(make-address local-filename
)))
93 (connect socket
(make-address remote-filename
))))
95 (assert local-filename
)
96 (%close-on-error
(socket)
97 (setf socket
(create-socket :address-family
:local
:type
:stream
99 (bind-address socket
(make-address local-filename
))
100 (socket-listen socket
:backlog backlog
)))))
103 (declaim (inline %make-internet-datagram-socket
))
104 (defun %make-internet-datagram-socket
(args ipv6 ef
)
105 (let (socket address
)
106 (destructuring-bind (&key local-host local-port remote-host remote-port
107 reuse-address broadcast
&allow-other-keys
) args
108 (assert (xnor local-host local-port
))
109 (assert (xnor remote-host remote-port
))
110 (%close-on-error
(socket)
111 (setf socket
(create-socket :address-family
:internet
:type
:datagram
112 :connect
:active
:ipv6 ipv6
113 :external-format ef
))
114 (when broadcast
(set-socket-option socket
:broadcast
:value t
))
116 (setf address
(convert-or-lookup-inet-address local-host ipv6
))
117 (bind-address socket address
:port local-port
118 :reuse-address reuse-address
))
120 (setf address
(convert-or-lookup-inet-address remote-host ipv6
))
121 (connect socket address
:port remote-port
))))
124 (declaim (inline %make-local-datagram-socket
))
125 (defun %make-local-datagram-socket
(args ef
)
126 (let (socket address
)
127 (destructuring-bind (&key local-filename remote-filename
&allow-other-keys
) args
128 (%close-on-error
(socket)
129 (setf socket
(create-socket :address-family
:local
:type
:datagram
130 :connect
:active
:external-format ef
))
132 (bind-address socket
(make-address address
)))
133 (when remote-filename
134 (connect socket
(make-address address
)))))
137 (defun make-socket (&rest args
&key address-family type connect
(ipv6 *ipv6
*)
138 format eol
(external-format :default
) scope-id
&allow-other-keys
)
139 (declare (ignore format eol scope-id
))
140 (check-type address-family
(member :internet
:local
))
141 (check-type type
(member :stream
:datagram
))
142 (check-type connect
(member :active
:passive
))
143 (check-type ipv6
(member nil t
:ipv6
))
145 ((and (eq address-family
:internet
) (eq type
:stream
))
146 (%make-internet-stream-socket args connect ipv6 external-format
))
147 ((and (eq address-family
:local
) (eq type
:stream
))
148 (%make-local-stream-socket args connect external-format
))
149 ((and (eq address-family
:internet
) (eq type
:datagram
))
150 (%make-internet-datagram-socket args ipv6 external-format
))
151 ((and (eq address-family
:local
) (eq type
:datagram
))
152 (%make-local-datagram-socket args external-format
))))
154 (defmacro with-socket
((var &rest args
) &body body
)
155 `(with-open-stream (,var
(make-socket ,@args
)) ,@body
))