Add sockaddr information to callback

dinosaure · dinosaure · commit de3261b5b118 · 2014-05-06T11:26:06.000+02:00
diff --git a/lib/lwt_unix_conduit.mli b/lib/lwt_unix_conduit.mli
@@ -31,7 +31,7 @@ val connect :
 val serve :
   mode:server_mode ->
   sockaddr:Lwt_unix.sockaddr ->
-  ?timeout:int -> (ic -> oc -> unit io) -> unit io
+  ?timeout:int -> (Lwt_unix.sockaddr -> ic -> oc -> unit io) -> unit io
 
 val close_in : 'a Lwt_io.channel -> unit
 val close_out : 'a Lwt_io.channel -> unit
diff --git a/lib/lwt_unix_net.ml b/lib/lwt_unix_net.ml
@@ -54,12 +54,12 @@ module Tcp_server = struct
       Lwt_unix.listen sock 15;
       sock) ()
 
-  let process_accept ?timeout callback (client,_) =
+  let process_accept ?timeout callback (client, sockaddr) =
     Lwt_unix.setsockopt client Lwt_unix.TCP_NODELAY true;
     let ic = Lwt_io.of_fd ~mode:Lwt_io.input client in
     let oc = Lwt_io.of_fd ~mode:Lwt_io.output client in
  
-    let c = callback ic oc in
+    let c = callback sockaddr ic oc in
     let events = match timeout with
       |None -> [c]
       |Some t -> [c; (Lwt_unix.sleep (float_of_int t)) ] in
diff --git a/lib/lwt_unix_net.mli b/lib/lwt_unix_net.mli
@@ -33,7 +33,7 @@ module Tcp_server : sig
   val init :
     sockaddr:Lwt_unix.sockaddr ->
     ?timeout:int ->
-    (input channel -> output channel -> unit Lwt.t) ->
+    (Lwt_unix.sockaddr -> input channel -> output channel -> unit Lwt.t) ->
     unit Lwt.t
 
   val close : input channel * output channel -> unit Lwt.t
diff --git a/lib/lwt_unix_net_ssl.ml b/lib/lwt_unix_net_ssl.ml
@@ -44,9 +44,9 @@ module Server = struct
   let t = Ssl.create_context Ssl.TLSv1 Ssl.Server_context
 
   let accept fd =
-    lwt (afd,_) = Lwt_unix.accept fd in
+    lwt (afd,sockaddr) = Lwt_unix.accept fd in
     lwt sock = Lwt_ssl.ssl_accept afd t in
-    return (chans_of_fd sock)
+    return (sockaddr,chans_of_fd sock)
 
   let listen ?(nconn=20) ?password ~certfile ~keyfile sa =
     let fd = Lwt_unix.socket (Unix.domain_of_sockaddr sa) Unix.SOCK_STREAM 0 in
@@ -59,8 +59,8 @@ module Server = struct
     Ssl.use_certificate t certfile keyfile;
     fd
 
-  let process_accept ~timeout callback (ic,oc) =
-    let c = callback ic oc in
+  let process_accept ~timeout callback (sockaddr,(ic,oc)) =
+    let c = callback sockaddr ic oc in
     let events = match timeout with
       | None -> [c]
       | Some t -> [c; (Lwt_unix.sleep (float_of_int t)) ] in
diff --git a/lib/lwt_unix_net_ssl.mli b/lib/lwt_unix_net_ssl.mli
@@ -25,7 +25,7 @@ end
 module Server : sig
   val accept :
     Lwt_unix.file_descr ->
-    (Lwt_io.input_channel * Lwt_io.output_channel) Lwt.t
+    (Lwt_unix.sockaddr * (Lwt_io.input_channel * Lwt_io.output_channel)) Lwt.t
 
   val listen :
     ?nconn:int ->
@@ -40,7 +40,7 @@ module Server : sig
     keyfile:string ->
     ?timeout:int ->
     Lwt_unix.sockaddr ->
-    (Lwt_io.input_channel -> Lwt_io.output_channel -> unit Lwt.t) ->
+    (Lwt_unix.sockaddr -> Lwt_io.input_channel -> Lwt_io.output_channel -> unit Lwt.t) ->
     unit Lwt.t
 end
 
