[Chicken-hackers] [PATCH 2/2] tcp: fix file descriptor leaks and don't clobber errno

[Florian Zumbiehl]

Fix file descriptor leaks in tcp that happen in case of exceptions before ports
or a listener get returned to the caller. Also, save and restore errno around
the cleanup close() calls so that the error messages report the original
failure even if close() modified errno.
---
 tcp.scm |   66 ++++++++++++++++++++++++++++++++++++--------------------------
 1 files changed, 38 insertions(+), 28 deletions(-)

diff --git a/tcp.scm b/tcp.scm
index 3e507e6..8878d0e 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -113,6 +113,11 @@ EOF
 (define ##net#shutdown (foreign-lambda int "shutdown" int int))
 (define ##net#connect (foreign-lambda int "connect" int scheme-pointer int))
 
+(define (##net#close-cleanup s)
+  (let ((errno-saved errno))
+    (##net#close s)
+    (set! errno errno-saved)))
+
 (define ##net#send
   (foreign-lambda* 
       int ((int s) (scheme-pointer msg) (int offset) (int len) (int flags))
@@ -254,28 +259,30 @@ EOF
   (##sys#check-exact port)
   (when (or (fx< port 0) (fx> port 65535))
     (##sys#signal-hook #:domain-error 'tcp-listen "invalid port number" port) )
-  (let ((s (##net#socket _af_inet style 0)))
-    (when (eq? _invalid_socket s)
-      (##sys#update-errno)
-      (##sys#error "cannot create socket") )
-    ;; PLT makes this an optional arg to tcp-listen. Should we as well?
-    (when (eq? -1 ((foreign-lambda* int ((int socket)) 
-                    "int yes = 1; 
-                      C_return(setsockopt(socket, SOL_SOCKET, SO_REUSEADDR, 
(const char *)&yes, sizeof(int)));") 
-                  s) )
-      (##sys#update-errno)
-      (##sys#signal-hook 
-       #:network-error 'tcp-listen
-       (##sys#string-append "error while setting up socket - " strerror) s) )
-    (let ((addr (make-string _sockaddr_in_size)))
-      (if host
-         (unless (##net#gethostaddr addr host port)
-           (##sys#signal-hook 
-            #:network-error 'tcp-listen 
-            "getting listener host IP failed - " host port) )
-         (##net#fresh-addr addr port) )
+  (let ((addr (make-string _sockaddr_in_size)))
+    (if host
+       (unless (##net#gethostaddr addr host port)
+         (##sys#signal-hook
+          #:network-error 'tcp-listen
+          "getting listener host IP failed - " host port) )
+       (##net#fresh-addr addr port) )
+    (let ((s (##net#socket _af_inet style 0)))
+      (when (eq? _invalid_socket s)
+        (##sys#update-errno)
+        (##sys#error "cannot create socket") )
+      ;; PLT makes this an optional arg to tcp-listen. Should we as well?
+      (when (eq? -1 ((foreign-lambda* int ((int socket))
+                      "int yes = 1;
+                        C_return(setsockopt(socket, SOL_SOCKET, SO_REUSEADDR, 
(const char *)&yes, sizeof(int)));")
+                    s) )
+        (##net#cleanup-close s)
+        (##sys#update-errno)
+        (##sys#signal-hook
+         #:network-error 'tcp-listen
+         (##sys#string-append "error while setting up socket - " strerror) s) )
       (let ((b (##net#bind s addr _sockaddr_in_size)))
        (when (eq? -1 b)
+         (##net#cleanup-close s)
          (##sys#update-errno)
          (##sys#signal-hook
           #:network-error 'tcp-listen
@@ -286,10 +293,11 @@ EOF
 
 (define (tcp-listen port . more)
   (let-optionals more ((w default-backlog) (host #f))
+    (##sys#check-exact w)
     (let-values (((s addr) (##net#bind-socket port _sock_stream host)))
-      (##sys#check-exact w)
       (let ((l (##net#listen s w)))
        (when (eq? -1 l)
+         (##net#cleanup-close s)
          (##sys#update-errno)
          (##sys#signal-hook 
           #:network-error 'tcp-listen
@@ -332,6 +340,7 @@ EOF
   (let ((tbs tcp-buffer-size))
     (lambda (fd)
       (unless (##net#make-nonblocking fd)
+       (##net#close-cleanup fd)
        (##sys#update-errno)
        (##sys#signal-hook 
         #:network-error (##sys#string-append "cannot create TCP ports - " 
strerror)) )
@@ -580,16 +589,18 @@ EOF
 
 (define (tcp-connect host . more)
   (let ((port (optional more #f))
-       (tmc (tcp-connect-timeout)))
+       (tmc (tcp-connect-timeout))
+       (addr (make-string _sockaddr_in_size)))
     (##sys#check-string host)
     (unless port
       (set!-values (host port) (##net#parse-host host "tcp"))
       (unless port (##sys#signal-hook #:network-error 'tcp-connect "no port 
specified" host)) )
     (##sys#check-exact port)
-    (let ((addr (make-string _sockaddr_in_size))
-         (s (##net#socket _af_inet _sock_stream 0)) )
+    (unless (##net#gethostaddr addr host port)
+      (##sys#signal-hook #:network-error 'tcp-connect "cannot find host 
address" host) )
+    (let ((s (##net#socket _af_inet _sock_stream 0)) )
       (define (fail)
-       (##net#close s)
+       (##net#close-cleanup s)
        (##sys#update-errno)
        (##sys#signal-hook 
         #:network-error 'tcp-connect (##sys#string-append "cannot connect to 
socket - " strerror) 
@@ -599,9 +610,8 @@ EOF
        (##sys#signal-hook 
         #:network-error 'tcp-connect
         (##sys#string-append "cannot create socket - " strerror) host port) )
-      (unless (##net#gethostaddr addr host port)
-       (##sys#signal-hook #:network-error 'tcp-connect "cannot find host 
address" host) )
       (unless (##net#make-nonblocking s)
+       (##net#close-cleanup s)
        (##sys#update-errno)
        (##sys#signal-hook #:network-error 'tcp-connect (##sys#string-append 
"fcntl() failed - " strerror)) )
       (let loop ()
@@ -629,7 +639,7 @@ EOF
                (else (fail) ) )))
       (let ((err (get-socket-error s)))
        (cond ((fx= err -1)
-              (##net#close s)
+              (##net#close-cleanup s)
               (##sys#signal-hook 
                #:network-error 'tcp-connect
                (##sys#string-append "getsockopt() failed - " strerror)))
-- 
1.7.2.5