Merge pull request xapi-project#60 from krizex/CA-289145

CA-289145: close socket if error occurs when using lwt connect
AsherBond · May 23, 2018 · bc1820a · bc1820a
2 parents 9db42f1 + efd6c10
commit bc1820a
Showing 1 changed file with 12 additions and 2 deletions.
diff --git a/src/impl.ml b/src/impl.ml
@@ -706,7 +706,12 @@ let write_stream common s destination source_protocol destination_protocol preze
       return (c, [ Nbd; NoProtocol; Chunked; Human; Tar ])
     | Sockaddr sockaddr ->
       let sock = socket sockaddr in
-      Lwt_unix.connect sock sockaddr >>= fun () ->
+      Lwt.catch (fun () ->
+          Lwt_unix.connect sock sockaddr
+        ) (fun e ->
+          Lwt_unix.close sock >>= fun () -> Lwt.fail e
+        )
+      >>= fun () ->
       Channels.of_raw_fd sock >>= fun c ->
       return (c, [ Nbd; NoProtocol; Chunked; Human; Tar ])
     | Https uri'
@@ -717,7 +722,12 @@ let write_stream common s destination source_protocol destination_protocol preze
       Lwt_unix.gethostbyname host >>= fun host_entry ->
       let sockaddr = Lwt_unix.ADDR_INET(host_entry.Lwt_unix.h_addr_list.(0), port) in
       let sock = socket sockaddr in
-      Lwt_unix.connect sock sockaddr >>= fun () ->
+      Lwt.catch (fun () ->
+          Lwt_unix.connect sock sockaddr
+        ) (fun e ->
+          Lwt_unix.close sock >>= fun () -> Lwt.fail e
+        )
+      >>= fun () ->
 
       let open Cohttp in
       ( if use_ssl then Channels.of_ssl_fd sock ssl_legacy good_ciphersuites legacy_ciphersuites else Channels.of_raw_fd sock ) >>= fun c ->