Skip to content

Commit

Permalink
When creating sockets, do all work at fd level first
Browse files Browse the repository at this point in the history 
When errors happen during the socket creation process, we want
to be able to clean up by closing the socket fd, and not have to
worry about leaking an incompletely configured fd into some
Lisp object.
  • Loading branch information
@xrme
xrme committed Jul 16, 2024
1 parent 678d152 commit 87b6ce0
Showing 1 changed file with 143 additions and 148 deletions.
291 changes: 143 additions & 148 deletions library/sockets.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -441,6 +441,14 @@ operating system resources associated with the socket."))
#||(fd-close fd)||#
(socket-error nil "connect" err nil :connect-address socket-address))))

(defun %socket-bind (fd socket-address)
(let ((err (c_bind fd
(sockaddr socket-address)
(sockaddr-length socket-address))))
(declare (fixnum err))
(unless (eql err 0)
(socket-error nil "bind" err nil))))

(defmethod socket-type ((stream udp-socket)) :datagram)
(defmethod socket-connect ((stream udp-socket)) (socket-connected stream))
(defmethod socket-format ((stream udp-socket)) :binary)
Expand Down Expand Up @@ -510,58 +518,36 @@ the socket is not connected."))
#-windows-target
(not (logtest #$O_NONBLOCK (fd-get-flags fd))))

(defun set-socket-options (socket
&key
keepalive
reuse-address
nodelay
broadcast
linger
(address-family :internet)
local-port
local-host
local-address
local-filename
type
connect
out-of-band-inline
&allow-other-keys)
(defun %set-socket-options (fd &key keepalive reuse-address broadcast
out-of-band-inline
address-family
type
linger nodelay
&allow-other-keys)
;; see man socket(7) tcp(7) ip(7)
(let ((fd (socket-device socket)))
(when keepalive
(int-setsockopt fd #$SOL_SOCKET #$SO_KEEPALIVE 1))
(when reuse-address
(int-setsockopt fd #$SOL_SOCKET #$SO_REUSEADDR 1))
(when broadcast
(int-setsockopt fd #$SOL_SOCKET #$SO_BROADCAST 1))
(when out-of-band-inline
(int-setsockopt fd #$SOL_SOCKET #$SO_OOBINLINE 1))
(when (member address-family '(:internet :internet6))
(when (eq type :stream)
(rlet ((plinger :linger))
(setf (pref plinger :linger.l_onoff) (if linger 1 0)
(pref plinger :linger.l_linger) (or linger 0))
(socket-call socket "setsockopt"
(c_setsockopt fd #$SOL_SOCKET #$SO_LINGER
plinger (record-length :linger)))))
(when nodelay
(int-setsockopt fd
#+linux-target #$SOL_TCP
#-linux-target #$IPPROTO_TCP
#$TCP_NODELAY 1))
(when (or local-port local-host local-address)
(socket-bind-local socket (or local-address
(resolve-address :host local-host
:port local-port
:connect connect
:address-family address-family
:socket-type type)))))
(when (and (eq address-family :file)
(eq connect :passive))
(unless local-filename
(error "need :local-filename argument to create passive file socket"))
#+windows-target (error "can't create file socket on Windows")
#-windows-target (socket-bind-local socket (make-instance 'unix-socket-address :path local-filename)))))
(when keepalive
(int-setsockopt fd #$SOL_SOCKET #$SO_KEEPALIVE 1))
(when reuse-address
(int-setsockopt fd #$SOL_SOCKET #$SO_REUSEADDR 1))
(when broadcast
(int-setsockopt fd #$SOL_SOCKET #$SO_BROADCAST 1))
(when out-of-band-inline
(int-setsockopt fd #$SOL_SOCKET #$SO_OOBINLINE 1))

(when (memq address-family '(:internet :internet6))
(when (eq type :stream)
(rlet ((plinger :linger))
(setf (pref plinger :linger.l_onoff) (if linger 1 0)
(pref plinger :linger.l_linger) (or linger 0))
(let ((err (c_setsockopt fd #$SOL_SOCKET #$SO_LINGER
plinger (record-length :linger))))
(unless (eql err 0)
(socket-error nil "setsockopt" fd nil)))))
(when nodelay
(int-setsockopt fd
#+linux-target #$SOL_TCP
#-linux-target #$IPPROTO_TCP
#$TCP_NODELAY 1))))

;; I hope the inline declaration makes the &rest/apply's go away...
(declaim (inline make-ip-socket))
Expand Down Expand Up @@ -613,34 +599,48 @@ the socket is not connected."))
(fd -1)
(connect :active)
(address-family :internet)
remote-host remote-port
remote-host remote-port remote-address
local-host local-port local-address
&allow-other-keys)
(unwind-protect
(let (socket)
(when (< fd 0)
(setq fd (socket-call nil "socket"
(c_socket (ecase address-family
(:internet #$PF_INET)
(:internet6 #$PF_INET6))
#$SOCK_DGRAM #$IPPROTO_UDP))))
(setq socket (make-instance 'udp-socket
:device fd
:keys keys))
(apply #'set-socket-options socket keys)
(when (and (eql connect :active)
remote-host remote-port)
(%socket-connect fd
(apply #'resolve-address
:connect connect
:address-family address-family
:host remote-host
:port remote-port
:allow-other-keys t
keys)
nil)
(setf (socket-connected socket) t))
(setq fd -1)
socket)
(let (socket connectedp)
(when (< fd 0)
(setq fd (socket-call nil "socket"
(c_socket (ecase address-family
(:internet #$PF_INET)
(:internet6 #$PF_INET6))
#$SOCK_DGRAM #$IPPROTO_UDP))))

(apply #'%set-socket-options fd keys)
(when (memq address-family '(:internet :internet6))
(when (or local-address local-port local-host)
(let ((local (or local-address
(apply #'resolve-address
:host local-host
:port local-port
:connect connect
:address-family address-family
:socket-type :datagram))))
(%socket-bind fd local)))
(when (and (eq connect :active)
remote-host remote-port)
(let ((remote (or remote-address
(apply #'resolve-address
:connect connect
:address-family address-family
:host remote-host
:port remote-port
:allow-other-keys t
keys))))
(%socket-connect fd remote nil)
(setq connectedp t))))
;; Now that the fd is all set up, make the socket object.
(setq socket (make-instance 'udp-socket
:device fd
:keys keys))
(setf (socket-connected socket) connectedp)
(setq fd -1)
socket)
(unless (< fd 0)
(fd-close fd))))

Expand All @@ -649,57 +649,56 @@ the socket is not connected."))
(connect :active)
(fd -1)
(address-family :internet)
type
local-host local-port local-address
remote-host remote-port remote-address
backlog connect-timeout deadline
&allow-other-keys)
(unwind-protect
(progn
(let (socket)
(when (< fd 0)
(setq fd (socket-call nil "socket"
(c_socket (ecase address-family
(:internet #$PF_INET)
(:internet6 #$PF_INET6))
#$SOCK_STREAM #$IPPROTO_TCP))))
(let ((socket (apply (ecase connect
(:active #'make-tcp-stream-socket)
(:passive #'make-tcp-listener-socket))
fd
keys)))
(apply #'set-socket-options socket keys)
(if (eql connect :passive)
(socket-call nil "listen" (c_listen fd (or backlog 5)))
(let ((timeout-in-milliseconds
(cond
(deadline
(max (round (- deadline (get-internal-real-time))
(/ internal-time-units-per-second 1000))
0))
(connect-timeout
(check-io-timeout connect-timeout)
(round (* connect-timeout 1000)))))
(socket-address (or remote-address
(apply #'resolve-address
:connect connect
:address-family address-family
:host remote-host
:port remote-port
:allow-other-keys t
keys))))
(handler-bind
((socket-creation-error
(lambda (c)
(declare (ignore c))
;; When connect fails, the fd is no longer usable,
;; and must be closed. Because we've already made
;; a stream using this fd, close the fd by closing
;; the stream.
(close socket)
;; Don't try to close fd again in the unwind-protect
;; cleanup form.
(setq fd -1))))
(%socket-connect fd socket-address timeout-in-milliseconds))))
(setq fd -1)
socket))
(apply #'%set-socket-options fd keys)
(when (or local-port local-host local-address)
(let ((local (or local-address
(resolve-address :host local-host
:port local-port
:connect connect
:address-family address-family
:socket-type type))))
(%socket-bind fd local)))
(if (eq connect :passive)
(socket-call nil "listen" (c_listen fd (or backlog 5)))
(let ((timeout-msecs
(cond
(deadline
(max (round (- deadline (get-internal-real-time))
(/ internal-time-units-per-second 1000))
0))
(connect-timeout
(check-io-timeout connect-timeout)
(round (* connect-timeout 1000)))))
(remote (or remote-address
(apply #'resolve-address
:connect connect
:address-family address-family
:host remote-host
:port remote-port
:allow-other-keys t
keys))))
(%socket-connect fd remote timeout-msecs)))
;; Now that the fd is all set up, make the socket object.
(setq socket (apply (ecase connect
(:active #'make-tcp-stream-socket)
(:passive #'make-tcp-listener-socket))
fd
keys))
(setq fd -1)
socket)
(unless (< fd 0)
(fd-close fd))))

Expand All @@ -718,19 +717,35 @@ the socket is not connected."))
(connect :active)
backlog
(fd -1)
local-filename
remote-filename
&allow-other-keys)
(unwind-protect
(let (socket)
(when (< fd 0)
(setq fd (socket-call nil "socket" (c_socket #$PF_LOCAL #$SOCK_STREAM 0))))
(setq socket
(apply (ecase connect
(:active #'make-file-stream-socket)
(:passive #'make-file-listener-socket))
fd keys))
(apply #'set-socket-options socket keys)
(when (eql connect :passive)
(socket-call nil "listen" (c_listen fd (or backlog 5))))
(setq fd (socket-call nil "socket" (c_socket #$PF_LOCAL
#$SOCK_STREAM 0))))
(apply #'%set-socket-options fd keys)
(if (eq connect :passive)
(progn
(unless local-filename
(error "need :local-filename argument to create server file ~
stream socket"))
(let ((local (make-instance 'unix-socket-address
:path local-filename)))
(%socket-bind fd local)
(socket-call nil "listen" (c_listen fd (or backlog 5)))))
(progn
(unless remote-filename
(error "need :remote-filename argument to create client file ~
stream socket"))
(let ((remote (make-instance 'unix-socket-address
:path remote-filename)))
(%socket-connect fd remote))))
(setq socket (apply (ecase connect
(:active #'make-file-stream-socket)
(:passive #'make-file-listener-socket))
fd keys))
(setq fd -1)
socket)
(unless (< fd 0)
Expand All @@ -740,28 +755,13 @@ the socket is not connected."))
(declare (ignore keys))
(error "Datagram file sockets aren't implemented."))

#-windows-target
(defun file-socket-connect (fd remote-filename)
(%socket-connect fd (make-instance 'unix-socket-address :path remote-filename)))

#+windows-target
(defun file-socket-connect (fd remote-filename)
(declare (ignore fd))
(error "Can't create file socket to ~s on Windows" remote-filename))

(defun make-tcp-stream-socket (fd &rest keys &key &allow-other-keys)
(apply #'make-tcp-stream fd keys))

#-windows-target
(defun make-file-stream-socket (fd &rest keys
&key remote-filename
&allow-other-keys)
(unless remote-filename
(error "need :remote-filename argument when creating file stream socket"))
(file-socket-connect fd remote-filename)
(defun make-file-stream-socket (fd &rest keys &key &allow-other-keys)
(apply #'make-file-socket-stream fd keys))


(defun make-tcp-stream (fd
&key (format :bivalent)
external-format
Expand Down Expand Up @@ -1690,11 +1690,6 @@ the resulting sockaddr."
#-darwin-target
(%get-cstring (pref sockaddr :sockaddr_un.sun_path))))))

(defmethod socket-bind-local (socket socket-address)
(socket-call socket "bind" (c_bind (socket-device socket)
(sockaddr socket-address)
(sockaddr-length socket-address))))

(defun get-socket-address-from-call (socket function call-name)
(let ((socket-address (make-instance 'socket-address)))
(rlet ((namelen :signed (sockaddr-length socket-address)))
Expand Down

0 comments on commit 87b6ce0

Please sign in to comment.