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 (declaim (inline %make-internet-stream-socket
))
43 (defun %make-internet-stream-socket
(args connect ipv6 ef
)
45 (destructuring-bind (&key local-host local-port remote-host remote-port
46 backlog reuse-address keepalive nodelay
&allow-other-keys
) args
49 (assert (xnor local-host local-port
))
50 (assert (xnor remote-host remote-port
))
51 (setf socket
(create-socket :address-family
:internet
:type
:stream
52 :connect
:active
:ipv6 ipv6
54 (when keepalive
(set-socket-option socket
:keep-alive
:value t
))
55 (when nodelay
(set-socket-option socket
:tcp-nodelay
:value t
))
57 (setf address
(convert-or-lookup-inet-address local-host ipv6
))
58 (bind-address socket address
:port local-port
59 :reuse-address reuse-address
))
61 (setf address
(convert-or-lookup-inet-address remote-host ipv6
))
62 (connect socket address
:port remote-port
)))
64 (assert (xnor local-host local-port
))
65 (setf socket
(create-socket :address-family
:internet
:type
:stream
66 :connect
:passive
:ipv6 ipv6
))
68 (setf address
(convert-or-lookup-inet-address local-host ipv6
))
69 (bind-address socket address
:port local-port
70 :reuse-address reuse-address
)
71 (socket-listen socket
:backlog backlog
)))))
74 (declaim (inline %make-local-stream-socket
))
75 (defun %make-local-stream-socket
(args connect ef
)
77 (destructuring-bind (&key local-filename remote-filename backlog
&allow-other-keys
) args
80 (assert remote-filename
)
81 (setf socket
(create-socket :address-family
:local
:type
:stream
82 :connect
:active
:external-format ef
))
83 (connect socket
(make-address remote-filename
)))
85 (assert local-filename
)
86 (setf socket
(create-socket :address-family
:local
:type
:stream
88 (bind-address socket
(make-address local-filename
))
89 (socket-listen socket
:backlog backlog
))))
92 (declaim (inline %make-internet-datagram-socket
))
93 (defun %make-internet-datagram-socket
(args ipv6 ef
)
95 (destructuring-bind (&key local-host local-port remote-host remote-port
96 reuse-address broadcast
&allow-other-keys
) args
97 (assert (xnor local-host local-port
))
98 (assert (xnor remote-host remote-port
))
99 (setf socket
(create-socket :address-family
:internet
:type
:datagram
100 :connect
:active
:ipv6 ipv6
101 :external-format ef
))
102 (when broadcast
(set-socket-option socket
:broadcast
:value t
))
104 (setf address
(convert-or-lookup-inet-address local-host ipv6
))
105 (bind-address socket address
:port local-port
106 :reuse-address reuse-address
))
108 (setf address
(convert-or-lookup-inet-address remote-host ipv6
))
109 (connect socket address
:port remote-port
)))
112 (declaim (inline %make-local-datagram-socket
))
113 (defun %make-local-datagram-socket
(args ef
)
114 (let (socket address
)
115 (destructuring-bind (&key local-filename remote-filename
&allow-other-keys
) args
116 (setf socket
(create-socket :address-family
:local
:type
:datagram
117 :connect
:active
:external-format ef
))
119 (bind-address socket
(make-address address
)))
120 (when remote-filename
121 (connect socket
(make-address address
))))
124 (defun make-socket (&rest args
&key address-family type connect
(ipv6 *ipv6
*)
125 format eol
(external-format :default
) scope-id
&allow-other-keys
)
126 (declare (ignore format eol scope-id
))
128 ((and (eq address-family
:internet
) (eq type
:stream
))
129 (%make-internet-stream-socket args connect ipv6 external-format
))
130 ((and (eq address-family
:local
) (eq type
:stream
))
131 (%make-local-stream-socket args connect external-format
))
132 ((and (eq address-family
:internet
) (eq type
:datagram
))
133 (%make-internet-datagram-socket args ipv6 external-format
))
134 ((and (eq address-family
:local
) (eq type
:datagram
))
135 (%make-local-datagram-socket args external-format
))))
137 (defmacro with-socket
((var &rest args
) &body body
)
138 `(with-open-stream (,var
(make-socket ,@args
)) ,@body
))