Commits

Anonymous committed 6e8ad9c

IO_Lwt: basic support of Lwt_unix.file_descr; + establish_server_fd

Comments (0)

Files changed (1)

 
 value close_out = Lwt_io.close;
 
+(********************************************************)
+
+type fd = Lwt_unix.file_descr;
+
+value close_fd = Lwt_unix.close;
+
+value read_fd_into = Lwt_unix.read;
+
+value write_fd_from = Lwt_unix.write;
+
+value rec write_fd_loop fd str ofs left =
+  if left = 0
+  then
+    return ()
+  else
+    Lwt.bind
+      (Lwt_unix.write fd str ofs left)
+      (fun written -> write_fd_loop fd str (ofs + written) (left - written))
+;
+
+value write_fd fd str = write_fd_loop fd str 0 (String.length str)
+;
+
+
 
 (********************************************************)
 
   fmt
 ;
 
-value establish_server ?buffer_size ?(backlog=5) sockaddr f =
+value establish_server_fd ?(backlog=5) sockaddr f =
   let sock = Lwt_unix.socket
     (Unix.domain_of_sockaddr sockaddr) Unix.SOCK_STREAM 0 in
   let () =
             (try Lwt_unix.set_close_on_exec fd
              with [Invalid_argument _ -> ()]) in
           let () = if server_debug then dbg "after close_on_exec" else () in
-          let close = lazy begin
-            let () = if server_debug then dbg "close1" else () in
-            Lwt_unix.shutdown fd Unix.SHUTDOWN_ALL;
-            let () = if server_debug then dbg "close2" else () in
-            Lwt_unix.close fd >>= fun () ->
-            let () = if server_debug then dbg "close3" else () in
-            return ()
-          end in
-          let () =
-            let in_ch = Lwt_io.of_fd ?buffer_size ~mode:Lwt_io.input
-              ~close:(fun () -> Lazy.force close) fd in
-            let () = if server_debug then dbg "made in_ch" else () in
-            let out_ch = Lwt_io.of_fd ?buffer_size ~mode:Lwt_io.output
-               ~close:(fun () -> Lazy.force close) fd in
-            let () = if server_debug then dbg "made out_ch" else () in
-            f (in_ch, out_ch)
-          in
+          let () = f fd in
           let () = if server_debug then dbg "user function executed" else () in
           loop ()
       | `Shutdown ->
   )
 ;
 
+value establish_server ?buffer_size ?backlog sockaddr f =
+  let f fd =
+    let close = lazy begin
+      let () = if server_debug then dbg "close1" else () in
+      Lwt_unix.shutdown fd Unix.SHUTDOWN_ALL;
+      let () = if server_debug then dbg "close2" else () in
+      Lwt_unix.close fd >>= fun () ->
+      let () = if server_debug then dbg "close3" else () in
+      return ()
+    end in
+    let in_ch = Lwt_io.of_fd ?buffer_size ~mode:Lwt_io.input
+      ~close:(fun () -> Lazy.force close) fd in
+    let () = if server_debug then dbg "made in_ch" else () in
+    let out_ch = Lwt_io.of_fd ?buffer_size ~mode:Lwt_io.output
+      ~close:(fun () -> Lazy.force close) fd in
+    let () = if server_debug then dbg "made out_ch" else () in
+    f (in_ch, out_ch)
+  in
+    establish_server_fd ?backlog sockaddr f
+;
+
 (* end of copypaste *)
 
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.