From 87b6ce0826e241445e4c2ce3a11c0bb821f8741c Mon Sep 17 00:00:00 2001 From: "R. Matthew Emerson" Date: Mon, 15 Jul 2024 20:46:14 -0700 Subject: [PATCH] When creating sockets, do all work at fd level first 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. --- library/sockets.lisp | 291 +++++++++++++++++++++---------------------- 1 file changed, 143 insertions(+), 148 deletions(-) diff --git a/library/sockets.lisp b/library/sockets.lisp index b74a1046..eeac1e0f 100644 --- a/library/sockets.lisp +++ b/library/sockets.lisp @@ -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) @@ -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)) @@ -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)))) @@ -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)))) @@ -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) @@ -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 @@ -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)))