Merge pull request #667 from ocsigen/mrmime

Remove dependency to ocamlnet

Author: vouillon

Makefile.options

@@ -55,8 +55,7 @@ SASS_TEMPORARY_PROJECT_NAME := os_temporary_project_name
 
 # OCamlfind packages for the server
 SERVER_PACKAGES    := calendar safepass \
-                      ocsigen-toolkit.server yojson re.str cohttp-lwt-unix \
-                      netstring
+                      ocsigen-toolkit.server yojson re.str cohttp-lwt-unix
 
 SERVER_PPX_PACKAGES := lwt_ppx js_of_ocaml-ppx_deriving_json ocsigen-ppx-rpc
 

opam

@@ -31,7 +31,6 @@ depends: [
   "resource-pooling" {>= "1.0" & < "2.0"}
   "cohttp-lwt-unix"
   "conf-npm" {>= "1"}
-  "ocamlnet"
   "re" {>= "1.7.2"}
 ]
 depexts: [

src/os_email.eliom

@@ -33,41 +33,28 @@ let email_pattern = email_pattern
 let email_regexp = Str.regexp_case_fold email_pattern
 let is_valid email = Str.string_match email_regexp email 0
 
-let default_send ?url ~from_addr ~to_addrs ~subject content =
-  (* TODO with fork ou mieux en utilisant l'event loop de ocamlnet *)
+let default_send ?url:_ ~from_addr ~to_addrs ~subject:_ content =
   let echo = printf "%s\n" in
   let flush () = printf "%!" in
+  let print_tuple (a, b) = printf " (%s,%s)\n" a b in
   let content =
-    match url with Some url -> content @ [url] | None -> content
+    if List.length content = 0
+    then ""
+    else
+      List.fold_left
+        (fun s1 s2 -> s1 ^ "\n" ^ s2)
+        (List.hd content) (List.tl content)
   in
-  try
-    let content =
-      if List.length content = 0
-      then ""
-      else
-        List.fold_left
-          (fun s1 s2 -> s1 ^ "\n" ^ s2)
-          (List.hd content) (List.tl content)
-    in
-    let print_tuple (a, b) = printf " (%s,%s)\n" a b in
-    echo "Sending e-mail:";
-    echo "[from_addr]: ";
-    print_tuple from_addr;
-    echo "[to_addrs]: [";
-    List.iter print_tuple to_addrs;
-    echo "]";
-    printf "[content]:\n%s\n" content;
-    let%lwt () =
-      Lwt_preemptive.detach
-        (Netsendmail.sendmail ~mailer:!mailer)
-        (Netsendmail.compose ~from_addr ~to_addrs ~subject content)
-    in
-    echo "[SUCCESS]: e-mail has been sent!";
-    Lwt.return_unit
-  with Netchannels.Command_failure (Unix.WEXITED 127) ->
-    echo "[FAIL]: e-mail has not been sent!";
-    flush ();
-    Lwt.fail (Invalid_mailer (!mailer ^ " not found"))
+  echo "Sending e-mail:";
+  echo "[from_addr]: ";
+  print_tuple from_addr;
+  echo "[to_addrs]: [";
+  List.iter print_tuple to_addrs;
+  echo "]";
+  printf "[content]:\n%s\n" content;
+  echo "Please set your own sendmail function using Os_email.set_send";
+  flush ();
+  Lwt.return ()
 
 let send_ref = ref default_send
 

template.distillery/demo_pgocaml_db.ml

@@ -10,4 +10,4 @@ open Os_db
 
 let get () =
   full_transaction_block (fun dbh ->
-      [%pgsql dbh "SELECT lastname FROM ocsigen_start.users"])
+    [%pgsql dbh "SELECT lastname FROM ocsigen_start.users"])

template.distillery/mobile!eliom_loader.ml

@@ -15,7 +15,7 @@
 module XmlHttpRequest = Js_of_ocaml_lwt.XmlHttpRequest
 
 (* Debug mode. Set to true if you want to use the debug mode. Used by "log".
- *)
+*)
 let debug = false
 
 (* If debug mode is activated, a paragraph is created and a message is printed
@@ -73,17 +73,17 @@ let rec add_retry_button wake msg =
        (Js_of_ocaml.Js.string "Retry"));
   btn##.onclick :=
     Js_of_ocaml.Dom_html.handler (fun _ ->
-        Js_of_ocaml.Dom.removeChild container p;
-        container##.className := Js_of_ocaml.Js.string "app blink";
-        if !update_failed
-        then (
-          update_failed := false;
-          ignore Js_of_ocaml.Js.Unsafe.global##.chcp##fetchUpdate);
-        if !data_upload_failed
-        then (
-          data_upload_failed := false;
-          Lwt.async (fun () -> get_data wake));
-        Js_of_ocaml.Js._false);
+      Js_of_ocaml.Dom.removeChild container p;
+      container##.className := Js_of_ocaml.Js.string "app blink";
+      if !update_failed
+      then (
+        update_failed := false;
+        ignore Js_of_ocaml.Js.Unsafe.global##.chcp##fetchUpdate);
+      if !data_upload_failed
+      then (
+        data_upload_failed := false;
+        Lwt.async (fun () -> get_data wake));
+      Js_of_ocaml.Js._false);
   btn##.id := Js_of_ocaml.Js.string "retry-button";
   Js_of_ocaml.Dom.appendChild p btn;
   Js_of_ocaml.Dom.appendChild container p
@@ -119,9 +119,9 @@ let _ =
   @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
        (Js_of_ocaml.Dom_html.Event.make "resume")
        (Js_of_ocaml.Dom.handler (fun _ ->
-            log "Resume";
-            ignore Js_of_ocaml.Js.Unsafe.global##.chcp##fetchUpdate;
-            Js_of_ocaml.Js._true))
+          log "Resume";
+          ignore Js_of_ocaml.Js.Unsafe.global##.chcp##fetchUpdate;
+          Js_of_ocaml.Js._true))
        Js_of_ocaml.Js._false;
   (* Create two threads for success callbacks and error callbacks. *)
   let wait_success, wake_success = Lwt.wait () in
@@ -132,26 +132,26 @@ let _ =
    *)
   let callback ev =
     Js_of_ocaml.Dom.handler (fun _ ->
-        log ev;
-        update_failed := false;
-        Lwt.wakeup wake_success ();
-        Js_of_ocaml.Js._true)
+      log ev;
+      update_failed := false;
+      Lwt.wakeup wake_success ();
+      Js_of_ocaml.Js._true)
   in
   (* Callback when errors.
    * Calls by the event chcp_nothingToUpdate.
    *)
   let error_callback name =
     Js_of_ocaml.Dom.handler (fun ev ->
-        log
-          (name ^ ": "
-          ^ Js_of_ocaml.Js.to_string ev##.detail##.error##.description);
-        update_failed := true;
-        if not !data_upload_failed
-        then
-          add_retry_button wake_error
-            (Js_of_ocaml.Js.to_string ev##.detail##.error##.description
-            ^ ". Please try again later.");
-        Js_of_ocaml.Js.bool true)
+      log
+        (name ^ ": "
+        ^ Js_of_ocaml.Js.to_string ev##.detail##.error##.description);
+      update_failed := true;
+      if not !data_upload_failed
+      then
+        add_retry_button wake_error
+          (Js_of_ocaml.Js.to_string ev##.detail##.error##.description
+          ^ ". Please try again later.");
+      Js_of_ocaml.Js.bool true)
   in
   (* Callback to print a message *)
   let status_callback name =
@@ -160,20 +160,20 @@ let _ =
   (* Binding to chcp_nothingToUpdate. Calls [callback ev]. *)
   List.iter
     (fun ev ->
-      ignore
-      @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
-           (Js_of_ocaml.Dom_html.Event.make ev)
-           (callback ev) Js_of_ocaml.Js._false)
+       ignore
+       @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
+            (Js_of_ocaml.Dom_html.Event.make ev)
+            (callback ev) Js_of_ocaml.Js._false)
     ["chcp_nothingToUpdate"];
   (* Binding to chcp_updateLoadFailed, chcp_updateInstallFailed and
    * chcp_assetsInstallationError. It calls [error_callback ev].
    *)
   List.iter
     (fun ev ->
-      ignore
-      @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
-           (Js_of_ocaml.Dom_html.Event.make ev)
-           (error_callback ev) Js_of_ocaml.Js._false)
+       ignore
+       @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
+            (Js_of_ocaml.Dom_html.Event.make ev)
+            (error_callback ev) Js_of_ocaml.Js._false)
     [ "chcp_updateLoadFailed"
     ; "chcp_updateInstallFailed"
     ; "chcp_assetsInstallationError" ];
@@ -182,10 +182,10 @@ let _ =
    *)
   List.iter
     (fun ev ->
-      ignore
-      @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
-           (Js_of_ocaml.Dom_html.Event.make ev)
-           (status_callback ev) Js_of_ocaml.Js._false)
+       ignore
+       @@ Js_of_ocaml.Dom.addEventListener Js_of_ocaml.Dom_html.document
+            (Js_of_ocaml.Dom_html.Event.make ev)
+            (status_callback ev) Js_of_ocaml.Js._false)
     [ "chcp_updateIsReadyToInstall"
     ; "chcp_beforeInstall"
     ; "chcp_nothingToInstall"

template.distillery/tools!check_modules.ml

@@ -10,17 +10,19 @@ let modules_from_bytecode_executable nm =
     ()
   done;
   let lst = ref [] in
-  while
-    let l = input_line ch in
-    if l <> "" && l.[0] = '\t'
-    then (
-      let i = String.rindex l '\t' in
-      lst := String.sub l (i + 1) (String.length l - i - 1) :: !lst;
-      true)
-    else false
-  do
-    ()
-  done;
+  (try
+     while
+       let l = input_line ch in
+       if l <> "" && l.[0] = '\t'
+       then (
+         let i = String.rindex l '\t' in
+         lst := String.sub l (i + 1) (String.length l - i - 1) :: !lst;
+         true)
+       else false
+     do
+       ()
+     done
+   with End_of_file -> ());
   !lst
 
 let modules_from_bytecode_library nm =
@@ -75,17 +77,17 @@ let _ =
   let missing_server_modules =
     List.filter_map
       (fun (m, sect) ->
-        let c = List.mem m client_modules in
-        let s = List.mem m server_modules in
-        match c, s, sect with true, false, true -> Some m | _ -> None)
+         let c = List.mem m client_modules in
+         let s = List.mem m server_modules in
+         match c, s, sect with true, false, true -> Some m | _ -> None)
       eliom_modules
   in
   let missing_client_modules =
     List.filter_map
       (fun (m, sect) ->
-        let c = List.mem m client_modules in
-        let s = List.mem m server_modules in
-        match c, s, sect with false, true, true -> Some m | _ -> None)
+         let c = List.mem m client_modules in
+         let s = List.mem m server_modules in
+         match c, s, sect with false, true, true -> Some m | _ -> None)
       eliom_modules
   in
   let missing_modules =

template.distillery/tools!gen_dune.ml

@@ -1,7 +1,8 @@
 let with_suffixes nm l f =
   List.iter
     (fun suffix ->
-      if Filename.check_suffix nm suffix then f (Filename.chop_suffix nm suffix))
+       if Filename.check_suffix nm suffix
+       then f (Filename.chop_suffix nm suffix))
     l
 
 let handle_file_client nm =
@@ -11,9 +12,9 @@ let handle_file_client nm =
   then ()
   else
     with_suffixes nm [".eliom"; ".tsv"] (fun nm ->
-        Printf.printf
-          "(rule (target %s.ml) (deps ../%s.eliom)\n\  (action\n\    (with-stdout-to %%{target}\n\      (chdir .. (run tools/eliom_ppx_client.exe --as-pp -server-cmo %%{cmo:../%s} --impl %s.eliom)))))\n"
-          nm nm nm nm);
+      Printf.printf
+        "(rule (target %s.ml) (deps ../%s.eliom)\n\  (action\n\    (with-stdout-to %%{target}\n\      (chdir .. (run tools/eliom_ppx_client.exe --as-pp -server-cmo %%{cmo:../%s} --impl %s.eliom)))))\n"
+        nm nm nm nm);
   if Filename.check_suffix nm ".eliomi"
   then
     let nm = Filename.chop_suffix nm ".eliomi" in