Compatibility with Lwt 4.x

Author: vasilisp

Makefile.options

@@ -1,6 +1,6 @@
 BYTEDBG :=
 OPTDBG  :=
-THREAD  :=
+THREAD  := -thread
 
 ifeq "$(DEBUG)" "YES"
 BYTEDBG += -g
@@ -17,22 +17,15 @@ BYTEDBG := -p ${BYTEDBG}
 OPTDBG  += -p
 endif
 
-ifeq "$(PREEMPTIVE)" "YES"
-  THREAD += -thread
-endif
-
 ## ${SERVER_PACKAGE} is not only used to build the 'ocsigenserver' executable
 ## but also to generate src/baselib/ocsigen_config.ml and src/files/META
 
-ifeq "$(PREEMPTIVE)" "YES"
-LWT_PREEMPTIVE_PACKAGE:=lwt.preemptive
-endif
-
 BASE_PACKAGE := lwt ipaddr bytes
 
 SERVER_PACKAGE := lwt_ssl           \
-		  bytes			\
-	          ${LWT_PREEMPTIVE_PACKAGE} \
+		  bytes             \
+	          lwt.unix          \
+                  lwt_log           \
                   ipaddr            \
 	          netstring         \
 	          netstring-pcre    \

configure

@@ -81,7 +81,6 @@ set_defaults () {
     with_pgsql=1
     with_camlzip=1
     with_dbm=1
-    with_preempt=1
     prefix="/usr/local"
     bindir=""
     logdir=""
@@ -412,7 +411,7 @@ check_library lwt "See: http://ocsigen.org/lwt"
 check_library lwt.unix  "Missing support for 'unix' in lwt."
 check_library lwt_react   "See: http://ocsigen.org/lwt"
 check_library lwt_ssl   "See: http://ocsigen.org/lwt"
-check_library lwt.preemptive "Missing support for 'preemptive' in lwt."
+check_library lwt_log   "See: http://ocsigen.org/lwt"
 
 check_library netstring \
     "See ocamlnet: http://projects.camlcity.org/projects/ocamlnet.html"
@@ -462,22 +461,6 @@ if [ "$with_camlzip" -gt 0 ]; then
     fi
 fi
 
-# Check Lwt.preemptive
-if [ "$with_preempt" -gt 0 ]; then
-    if test_library lwt.preemptive; then
-	echo -n
-    elif [ "$with_preempt" -gt 1 ]; then
-	fail_library lwt.preemptive "Missing support for 'preemptive' in lwt."
-    else
-	with_preempt=0
-    fi
-fi
-
-if [ "$with_sqlite" -eq 1 ] && [ "$with_preempt" -eq -1 ]; then
-    echo "preemptive threads are needed by sqlite, enable it with -with-preempt"
-    exit 1
-fi
-
 # Check rlwrap or ledit
 if test_binary rlwrap; then
     rlwrap=rlwrap
@@ -532,11 +515,6 @@ if [ $with_camlzip -gt 0 ] ; then
 else
 	with_camlzip="NO"
 fi
-if [ $with_preempt -gt 0 ] ; then
-	with_preempt="YES"
-else
-	with_preempt="NO"
-fi
 
 ocamlinclude=`ocamlfind printconf stdlib`
 
@@ -588,9 +566,6 @@ OCSIPERSISTPGSQL:=$with_pgsql
 # Do you want ocsipersist with dbm? YES/NO
 OCSIPERSISTDBM:=$with_dbm
 
-# Do you want preemptive threads ? YES/NO
-PREEMPTIVE:=$with_preempt
-
 # Do you want debugging information (-g) ? YES/NO
 DEBUG:=$enable_debug
 

opam

@@ -48,9 +48,10 @@ depends: [
   "base-threads"
   "react"
   "ssl"
-  "lwt" {>= "3.0.0" & < "4.0.0"}
+  "lwt" {>= "3.0.0"}
   "lwt_ssl"
   "lwt_react"
+  "lwt_log"
   "ocamlnet" {>= "4.0.2"}
   "pcre"
   "cryptokit"

src/baselib/Makefile

@@ -3,6 +3,7 @@ include ../../Makefile.config
 PACKAGE  := \
 	bytes \
 	lwt.unix \
+	lwt_log \
 	netstring \
 	netstring-pcre \
 	cryptokit \

src/baselib/ocsigen_stream.ml

@@ -229,10 +229,10 @@ let of_file filename =
   let fd = Lwt_unix.of_unix_file_descr
       (Unix.openfile filename [Unix.O_RDONLY;Unix.O_NONBLOCK] 0o666)
   in
-  let ch = Lwt_chan.in_channel_of_descr fd in
+  let ch = Lwt_io.of_fd ~mode:Lwt_io.input fd in
   let buf = Bytes.create 1024 in
   let rec aux () =
-    Lwt_chan.input ch buf 0 1024 >>= fun n ->
+    Lwt_io.read_into ch buf 0 1024 >>= fun n ->
     if n = 0 then empty None else
       (* Streams should be immutable, thus we always make a copy
          of the buffer *)

src/extensions/Makefile

@@ -3,6 +3,7 @@ include ../../Makefile.config
 PACKAGE  :=		\
 	bytes		\
 	lwt.unix	\
+	lwt_log		\
 	ipaddr		\
 	lwt_ssl		\
 	lwt_react	\

src/extensions/cgimod.ml

@@ -307,7 +307,25 @@ let create_process_cgi filename ri post_out cgi_in err_in re doc_root hostname =
       cgi_in
       err_in
 
-
+(* Copied from deprecated [Lwt_chan]. *)
+let lwt_chan_input_line ic =
+  let rec loop buf =
+    Lwt_io.read_char_opt ic >>= function
+    | None | Some '\n' ->
+      Lwt.return (Buffer.contents buf)
+    | Some char ->
+      Buffer.add_char buf char;
+      loop buf
+  in
+  Lwt_io.read_char_opt ic >>= function
+  | Some '\n' ->
+    Lwt.return ""
+  | Some char ->
+    let buf = Buffer.create 128 in
+    Buffer.add_char buf char;
+    loop buf
+  | None ->
+    Lwt.fail End_of_file
 
 (** This function makes it possible to launch a cgi script *)
 
@@ -368,15 +386,15 @@ let recupere_cgi head re doc_root filename ri hostname =
     Lwt_timeout.start timeout;
 
     (* A thread giving POST data to the CGI script: *)
-    let post_in_ch = Lwt_chan.out_channel_of_descr post_in in
+    let post_in_ch = Lwt_io.of_fd ~mode:Lwt_io.output post_in in
     ignore
       (catch
          (fun () ->
             (match (Ocsigen_request_info.http_frame ri).Ocsigen_http_frame.frame_content with
              | None -> Lwt_unix.close post_in
              | Some content_post ->
                Ocsigen_http_com.write_stream post_in_ch content_post >>= fun () ->
-               Lwt_chan.flush post_in_ch >>= fun () ->
+               Lwt_io.flush post_in_ch >>= fun () ->
                Lwt_unix.close post_in
             ))
          (*XXX Check possible errors! *)
@@ -391,9 +409,9 @@ let recupere_cgi head re doc_root filename ri hostname =
 
     (* A thread listening the error output of the CGI script
        and writing them in warnings.log *)
-    let err_channel = Lwt_chan.in_channel_of_descr err_out in
+    let err_channel = Lwt_io.of_fd ~mode:Lwt_io.input err_out in
     let rec get_errors () =
-      Lwt_chan.input_line err_channel >>= fun err ->
+      lwt_chan_input_line err_channel >>= fun err ->
       Lwt_log.ign_warning ~section err;
       get_errors ()
     in ignore

src/extensions/ocsipersist-dbm/Makefile

@@ -1,9 +1,6 @@
 include ../../../Makefile.config
 
-PACKAGE  := ${LWT_PREEMPTIVE_PACKAGE} \
-	    lwt.unix     \
-	    tyxml.parser \
-	    dbm          \
+PACKAGE  := lwt.unix lwt_log tyxml.parser dbm
 
 LIBS     := -I ../../baselib -I ../../http -I ../../server \
 	    ${addprefix -package ,${PACKAGE}}

src/extensions/ocsipersist-dbm/ocsidbm.ml

@@ -198,8 +198,8 @@ let _ = Unix.setsid ()
 (** Communication functions: *)
 
 let send outch v =
-  Lwt_chan.output_value outch v >>=
-  (fun () -> Lwt_chan.flush outch)
+  Lwt_io.write_value outch v >>= fun () ->
+  Lwt_io.flush outch
 
 let execute outch =
   let handle_errors f = try f () with e -> send outch (Error e) in
@@ -241,9 +241,9 @@ let execute outch =
 let nb_clients = ref 0
 
 let rec listen_client inch outch =
-  Lwt_chan.input_value inch >>=
-  (fun v -> execute outch v) >>=
-  (fun () -> listen_client inch outch)
+  Lwt_io.read_value inch >>= fun v ->
+  execute outch v >>= fun () ->
+  listen_client inch outch
 
 let finish _ =
   nb_clients := !nb_clients - 1;
@@ -260,8 +260,8 @@ let rec loop socket =
      ignore (
        b := true;
        nb_clients := !nb_clients + 1;
-       let inch = Lwt_chan.in_channel_of_descr indescr in
-       let outch = Lwt_chan.out_channel_of_descr indescr in
+       let inch = Lwt_io.of_fd ~mode:Lwt_io.input indescr in
+       let outch = Lwt_io.of_fd ~mode:Lwt_io.output indescr in
        catch
          (fun () -> listen_client inch outch >>= finish)
          finish);
@@ -344,4 +344,3 @@ let _ = Lwt_main.run
       in ignore (f ())
 
 *)
-

src/extensions/ocsipersist-dbm/ocsipersist.ml

@@ -151,12 +151,12 @@ let init_fun config =
        Lwt_log.ign_warning ~section "Initializing ...");
   let indescr = get_indescr 2 in
   if delay_loading then (
-    inch  := (indescr >>= fun r -> return (Lwt_chan.in_channel_of_descr r));
-    outch := (indescr >>= fun r -> return (Lwt_chan.out_channel_of_descr r));
+    inch  := Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.input) indescr;
+    outch := Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.output) indescr;
   ) else (
     let r = Lwt_main.run indescr in
-    inch  := return (Lwt_chan.in_channel_of_descr r);
-    outch := return (Lwt_chan.out_channel_of_descr r);
+    inch  := Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.input r);
+    outch := Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.output r);
     Lwt_log.ign_warning ~section "...Initialization complete";
   )
 
@@ -171,9 +171,9 @@ let send =
        !inch >>= fun inch ->
        !outch >>= fun outch ->
        previous :=
-         (Lwt_chan.output_value outch v >>= fun () ->
-          Lwt_chan.flush outch >>= fun () ->
-          Lwt_chan.input_value inch);
+         (Lwt_io.write_value outch v >>= fun () ->
+          Lwt_io.flush outch >>= fun () ->
+          Lwt_io.read_value inch);
        !previous)
 
 let db_get (store, name) =