From e396a1a30167a931b3bc4ccad4e51b85d8da87e9 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 22 Apr 2025 17:56:09 +0200 Subject: [PATCH 1/2] Add type annotation to ignored values This helps find ignored Lwt threads, which are a challenge to translate into direct-style concurrency. --- src/baselib/ocsigen_cache.ml | 8 ++++---- src/baselib/ocsigen_lib.ml | 8 +++++--- src/baselib/ocsigen_stream.ml | 4 +++- src/baselib/tests/test_wrapping.ml | 2 +- src/extensions/accesscontrol.ml | 2 +- src/extensions/authbasic.ml | 2 +- src/extensions/deflatemod.ml | 4 ++-- src/extensions/extendconfiguration.ml | 2 +- src/extensions/staticmod.ml | 4 +++- src/server/ocsigen_cohttp.ml | 2 +- src/server/ocsigen_extensions.ml | 12 ++++++------ src/server/ocsigen_local_files.ml | 4 +++- src/server/ocsigen_multipart.ml | 6 ++++-- src/server/ocsigen_server.ml | 23 +++++++++++------------ 14 files changed, 46 insertions(+), 37 deletions(-) diff --git a/src/baselib/ocsigen_cache.ml b/src/baselib/ocsigen_cache.ml index 801edd13d..4cc22a248 100644 --- a/src/baselib/ocsigen_cache.ml +++ b/src/baselib/ocsigen_cache.ml @@ -291,7 +291,7 @@ end = struct | Some n when node == n -> () | _ -> remove' node l; - ignore (add_node node l)) + ignore (add_node node l : _ node option)) (* assertion: = None *) (* we must not change the physical address => use add_node *) @@ -440,7 +440,7 @@ functor let remove cache k = try - let _v, node = H.find cache.table k in + let (_v : A.value), node = H.find cache.table k in assert ( match Dlist.list_of node with | None -> false @@ -451,7 +451,7 @@ functor (* Add in a cache, under the hypothesis that the value is not already in the cache *) let add_no_remove cache k v = - ignore (Dlist.add k cache.pointers); + ignore (Dlist.add k cache.pointers : A.key option); match Dlist.newest cache.pointers with | None -> assert false | Some n -> H.add cache.table k (v, n) @@ -465,7 +465,7 @@ functor cache.finder k >>= fun r -> (try (* it may have been added during cache.finder *) - ignore (find_in_cache cache k) + ignore (find_in_cache cache k : A.value) with Not_found -> add_no_remove cache k r); Lwt.return r diff --git a/src/baselib/ocsigen_lib.ml b/src/baselib/ocsigen_lib.ml index fd597cc82..9aa370ad6 100644 --- a/src/baselib/ocsigen_lib.ml +++ b/src/baselib/ocsigen_lib.ml @@ -130,11 +130,11 @@ module Netstring_pcre = struct let matched_group result n _ = if n < 0 || n >= Re.Group.nb_groups result then raise Not_found; - ignore (Pcre.get_substring_ofs result n); + ignore (Pcre.get_substring_ofs result n : int * int); Pcre.get_substring result n let matched_string result _ = - ignore (Pcre.get_substring_ofs result 0); + ignore (Pcre.get_substring_ofs result 0 : int * int); Pcre.get_substring result 0 let global_replace pat templ s = Re.replace pat ~f:(tr_templ templ) s @@ -427,7 +427,9 @@ module Url = struct https, host, port, uri_string, path, query, get_params let prefix_and_path_of_t url = - let https, host, port, _, path, _, _ = parse url in + let https, host, port, (_ : uri), path, (_ : uri option), (_ : _ Lazy.t) = + parse url + in let https_str = match https with | None -> "" diff --git a/src/baselib/ocsigen_stream.ml b/src/baselib/ocsigen_stream.ml index cc676d0fa..fedae912e 100644 --- a/src/baselib/ocsigen_stream.ml +++ b/src/baselib/ocsigen_stream.ml @@ -189,7 +189,9 @@ let substream delim s = then enlarge_stream stre >>= aux else try - let p, _ = Ocsigen_lib.Netstring_pcre.search_forward rdelim s 0 in + let p, (_ : Re.Group.t) = + Ocsigen_lib.Netstring_pcre.search_forward rdelim s 0 + in cont (String.sub s 0 p) (fun () -> empty (Some diff --git a/src/baselib/tests/test_wrapping.ml b/src/baselib/tests/test_wrapping.ml index 35baf99b9..83bcb6cde 100644 --- a/src/baselib/tests/test_wrapping.ml +++ b/src/baselib/tests/test_wrapping.ml @@ -1,5 +1,5 @@ (* ocamlfind ocamlopt -linkpkg -package react -g -I ../ ../wrapping.cmxa test_wrapping.ml -o test_wrapping *) -let _ = Printexc.record_backtrace true +let () = Printexc.record_backtrace true (*** simple wrap test ***) diff --git a/src/extensions/accesscontrol.ml b/src/extensions/accesscontrol.ml index c59307198..3e92a4167 100644 --- a/src/extensions/accesscontrol.ml +++ b/src/extensions/accesscontrol.ml @@ -280,7 +280,7 @@ let parse_config parse_fun = function | Element ("then", [], ithen) :: q -> parse_fun ithen, q | _ -> Ocsigen_extensions.badconfig "Bad branch in " in - let ielse, _sub = + let ielse, (_sub : _ list) = match sub with | Element ("else", [], ielse) :: ([] as q) -> parse_fun ielse, q | [] -> parse_fun [], [] diff --git a/src/extensions/authbasic.ml b/src/extensions/authbasic.ml index 46788bca6..bd56525ef 100644 --- a/src/extensions/authbasic.ml +++ b/src/extensions/authbasic.ml @@ -42,7 +42,7 @@ let register_basic_authentication_method, get_basic_authentication_method = fun config -> !fun_auth config ) (* Basic authentication with a predefined login/password (example) *) -let _ = +let () = let open Xml in register_basic_authentication_method @@ function | Element ("plain", [("login", login); ("password", password)], _) -> diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml index 11abca8cc..cb5666d4a 100644 --- a/src/extensions/deflatemod.ml +++ b/src/extensions/deflatemod.ml @@ -86,7 +86,7 @@ let rec output oz f buf pos len = else if len = 0 then next_cont oz f else - let _, used_in, used_out = + let (_ : bool), used_in, used_out = try Zlib.deflate oz.stream (Bytes.unsafe_of_string buf) @@ -133,7 +133,7 @@ and next_cont oz stream = else (* no more input, deflates only what were left because output buffer * was full *) - let finished, _, used_out = + let finished, (_ : int), used_out = Zlib.deflate oz.stream oz.buf 0 0 oz.buf oz.pos oz.avail Zlib.Z_FINISH in diff --git a/src/extensions/extendconfiguration.ml b/src/extensions/extendconfiguration.ml index b21cbf08b..8948d7e20 100644 --- a/src/extensions/extendconfiguration.ml +++ b/src/extensions/extendconfiguration.ml @@ -59,7 +59,7 @@ let check_regexp_list = try Hashtbl.find hashtbl r with Not_found -> ( try - ignore (Ocsigen_lib.Netstring_pcre.regexp r); + ignore (Ocsigen_lib.Netstring_pcre.regexp r : Re.re); Hashtbl.add hashtbl r () with _ -> raise (Bad_regexp r)) diff --git a/src/extensions/staticmod.ml b/src/extensions/staticmod.ml index 744d8deaf..cd464bdf6 100644 --- a/src/extensions/staticmod.ml +++ b/src/extensions/staticmod.ml @@ -59,7 +59,9 @@ let correct_user_local_file = let regexp = Ocsigen_lib.Netstring_pcre.regexp "(/\\.\\./)|(/\\.\\.$)" in fun path -> try - ignore (Ocsigen_lib.Netstring_pcre.search_forward regexp path 0); + ignore + (Ocsigen_lib.Netstring_pcre.search_forward regexp path 0 + : int * Pcre.substrings); false with Not_found -> true diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml index a0afe7a7d..06b746c03 100644 --- a/src/server/ocsigen_cohttp.ml +++ b/src/server/ocsigen_cohttp.ml @@ -204,7 +204,7 @@ let shutdown timeout = | Some f -> fun () -> Lwt_unix.sleep f | None -> fun () -> Lwt.return () in - ignore (Lwt.pick [process (); stop] >>= fun () -> exit 0) + ignore (Lwt.pick [process (); stop] >>= fun () -> exit 0 : unit Lwt.t) let service ?ssl ~address ~port ~connector () = let tls_own_key = diff --git a/src/server/ocsigen_extensions.ml b/src/server/ocsigen_extensions.ml index 54604b88f..3bab79497 100644 --- a/src/server/ocsigen_extensions.ml +++ b/src/server/ocsigen_extensions.ml @@ -636,12 +636,12 @@ module Configuration = struct raise (Error_in_user_config_file ("No PCDATA allowed in tag " ^ in_tag)) let check_attribute_occurrence ~in_tag attributes = function - | name, {attribute_obligatory = true; _} -> ( - try ignore (List.assoc name attributes) - with Not_found -> - raise - (Error_in_user_config_file - ("Obligatory attribute " ^ name ^ " not in tag " ^ in_tag))) + | name, {attribute_obligatory = true; _} -> + if not (List.mem_assoc name attributes) + then + raise + (Error_in_user_config_file + ("Obligatory attribute " ^ name ^ " not in tag " ^ in_tag)) | _ -> () let check_element_occurrence ~in_tag elements = function diff --git a/src/server/ocsigen_local_files.ml b/src/server/ocsigen_local_files.ml index 5b5c0235e..7e7d2aa60 100644 --- a/src/server/ocsigen_local_files.ml +++ b/src/server/ocsigen_local_files.ml @@ -100,7 +100,9 @@ let check_dotdot = In URLs, .. have already been removed by the server, but the filename may come from somewhere else than URLs ... *) try - ignore (Ocsigen_lib.Netstring_pcre.search_forward regexp filename 0); + ignore + (Ocsigen_lib.Netstring_pcre.search_forward regexp filename 0 + : int * Re.Group.t); false with Not_found -> true diff --git a/src/server/ocsigen_multipart.ml b/src/server/ocsigen_multipart.ml index e530c29e3..8b577b3ce 100644 --- a/src/server/ocsigen_multipart.ml +++ b/src/server/ocsigen_multipart.ml @@ -86,7 +86,9 @@ let read_header ?downcase ?unfold ?strip s = in find_end_of_header s >>= fun (s, end_pos) -> let b = Ocsigen_stream.current_buffer s in - let h, _ = scan_header ?downcase ?unfold ?strip b ~start_pos:0 ~end_pos in + let h, (_ : int) = + scan_header ?downcase ?unfold ?strip b ~start_pos:0 ~end_pos + in Ocsigen_stream.skip s (Int64.of_int end_pos) >>= fun s -> Lwt.return (s, h) let lf_re = S.regexp "[\n]" @@ -239,7 +241,7 @@ let counter = !c let field field content_disp = - let _, res = + let (_ : int), res = S.search_forward (S.regexp (field ^ "=.([^\"]*).;?")) content_disp 0 in S.matched_group res 1 content_disp diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml index b174b734d..3cf6b08db 100644 --- a/src/server/ocsigen_server.ml +++ b/src/server/ocsigen_server.ml @@ -24,14 +24,14 @@ let () = Random.self_init () (* Without the following line, it stops with "Broken Pipe" without raising an exception ... *) -let _ = Sys.set_signal Sys.sigpipe Sys.Signal_ignore +let () = Sys.set_signal Sys.sigpipe Sys.Signal_ignore (* Exit gracefully on SIGINT so that profiling will work *) -let _ = Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> exit 0)) +let () = Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> exit 0)) let section = Lwt_log.Section.make "ocsigen:main" (* Initialize exception handler for Lwt timeouts: *) -let _ = +let () = Lwt_timeout.set_exn_handler (fun e -> Lwt_log.ign_error ~section ~exn:e "Uncaught Exception after lwt timeout") @@ -97,7 +97,7 @@ let reload ?file () = with e -> Lwt_log.ign_error ~section (fst (errmsg e))); Lwt_log.ign_warning ~section "Config file reloaded" -let _ = +let () = let f _s = function | ["reopen_logs"] -> Ocsigen_messages.open_files () >>= fun () -> @@ -248,13 +248,13 @@ let main config = let commandpipe = Ocsigen_config.get_command_pipe () in let with_commandpipe = try - ignore (Unix.stat commandpipe); + ignore (Unix.stat commandpipe : Unix.stats); true with Unix.Unix_error _ -> ( try let umask = Unix.umask 0 in Unix.mkfifo commandpipe 0o660; - ignore (Unix.umask umask); + ignore (Unix.umask umask : int); Lwt_log.ign_warning ~section "Command pipe created"; true with e -> @@ -270,9 +270,8 @@ let main config = raise (Ocsigen_config.Config_file_error "maxthreads should be greater than minthreads"); - ignore - (Lwt_preemptive.init minthreads maxthreads (fun s -> - Lwt_log.ign_error ~section s)); + Lwt_preemptive.init minthreads maxthreads (fun s -> + Lwt_log.ign_error ~section s); (Lwt.async_exception_hook := fun e -> (* replace the default "exit 2" behaviour *) @@ -291,7 +290,7 @@ let main config = Unix.close devnull; Unix.close Unix.stdin); (* detach from the terminal *) - if Ocsigen_config.get_daemon () then ignore (Unix.setsid ()); + if Ocsigen_config.get_daemon () then ignore (Unix.setsid () : int); Ocsigen_extensions.end_initialisation (); (if with_commandpipe then @@ -325,7 +324,7 @@ let main config = Lwt.fail e) >>= f in - ignore (f ())); + ignore (f () : 'a Lwt.t)); Lwt_main.run @@ Lwt.join (List.map @@ -369,7 +368,7 @@ let main config = let f = Unix.openfile p [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o640 in - ignore (Unix.write_substring f spid 0 len); + ignore (Unix.write_substring f spid 0 len : int); Unix.close f in (* set_passwd_if_needed sslinfo; *) From 8774eba42f1e36965345da2ea2800cedc823868f Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 23 Apr 2025 15:22:03 +0200 Subject: [PATCH 2/2] Compatibility with re.1.8.0 and older The type annotations constrained 're' version which in turn constrained ocaml's version. --- src/baselib/ocsigen_stream.ml | 2 +- src/extensions/staticmod.ml | 2 +- src/server/ocsigen_local_files.ml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/baselib/ocsigen_stream.ml b/src/baselib/ocsigen_stream.ml index fedae912e..8e7faa970 100644 --- a/src/baselib/ocsigen_stream.ml +++ b/src/baselib/ocsigen_stream.ml @@ -189,7 +189,7 @@ let substream delim s = then enlarge_stream stre >>= aux else try - let p, (_ : Re.Group.t) = + let p, (_ : 'groups) = Ocsigen_lib.Netstring_pcre.search_forward rdelim s 0 in cont (String.sub s 0 p) (fun () -> diff --git a/src/extensions/staticmod.ml b/src/extensions/staticmod.ml index cd464bdf6..c90864fb4 100644 --- a/src/extensions/staticmod.ml +++ b/src/extensions/staticmod.ml @@ -61,7 +61,7 @@ let correct_user_local_file = try ignore (Ocsigen_lib.Netstring_pcre.search_forward regexp path 0 - : int * Pcre.substrings); + : int * 'groups); false with Not_found -> true diff --git a/src/server/ocsigen_local_files.ml b/src/server/ocsigen_local_files.ml index 7e7d2aa60..681295240 100644 --- a/src/server/ocsigen_local_files.ml +++ b/src/server/ocsigen_local_files.ml @@ -102,7 +102,7 @@ let check_dotdot = try ignore (Ocsigen_lib.Netstring_pcre.search_forward regexp filename 0 - : int * Re.Group.t); + : int * 'groups); false with Not_found -> true