Upgrade to Tls >= 0.9.0 and Cohttp-lwt-unix >= 1.0.0

Dockerfile

@@ -1,11 +1,12 @@
 FROM ocaml/opam-dev:alpine-3.5_ocaml-4.05.0
 RUN sudo apk add --no-cache tzdata aspcud gmp-dev perl libev-dev m4
 
+ENV OPAMERRLOGLEN=0 OPAMYES=1
+
 RUN git -C /home/opam/opam-repository fetch origin && \
     git -C /home/opam/opam-repository reset 68b69980 --hard && \
     opam update -u
 
-ENV OPAMERRLOGLEN=0 OPAMYES=1
 RUN opam install alcotest lwt conf-libev inotify
 
 COPY check-libev.ml /tmp/check-libev.ml

Dockerfile.ci

@@ -1,11 +1,12 @@
 FROM ocaml/opam-dev:alpine-3.5_ocaml-4.05.0
 RUN sudo apk add --no-cache tzdata aspcud gmp-dev perl libev-dev m4
 
+ENV OPAMERRLOGLEN=0 OPAMYES=1
+
 RUN git -C /home/opam/opam-repository fetch origin && \
-    git -C /home/opam/opam-repository reset 68b69980 --hard && \
+    git -C /home/opam/opam-repository reset 37514b6f --hard && \
     opam update -u
 
-ENV OPAMERRLOGLEN=0 OPAMYES=1
 RUN opam install alcotest lwt conf-libev inotify
 
 COPY check-libev.ml /tmp/check-libev.ml

Dockerfile.client

@@ -1,11 +1,12 @@
 FROM ocaml/opam-dev:alpine-3.5_ocaml-4.05.0
 RUN sudo apk add --no-cache tzdata aspcud gmp-dev perl libev-dev m4
 
+ENV OPAMERRLOGLEN=0 OPAMYES=1
+
 RUN git -C /home/opam/opam-repository fetch origin && \
     git -C /home/opam/opam-repository reset 68b69980 --hard && \
     opam update -u
 
-ENV OPAMERRLOGLEN=0 OPAMYES=1
 RUN opam install alcotest lwt conf-libev inotify
 
 COPY check-libev.ml /tmp/check-libev.ml

Dockerfile.github

@@ -1,11 +1,12 @@
 FROM ocaml/opam-dev:alpine-3.5_ocaml-4.05.0
 RUN sudo apk add --no-cache tzdata aspcud gmp-dev perl libev-dev m4
 
+ENV OPAMERRLOGLEN=0 OPAMYES=1
+
 RUN git -C /home/opam/opam-repository fetch origin && \
     git -C /home/opam/opam-repository reset 68b69980 --hard && \
     opam update -u
 
-ENV OPAMERRLOGLEN=0 OPAMYES=1
 RUN opam install alcotest lwt conf-libev inotify
 
 COPY check-libev.ml /tmp/check-libev.ml

check-libev.ml

@@ -1,4 +1,5 @@
 (* Make sure we have libev, or we'll crash from time-to-time with EINVAL in select *)
 #use "topfind";;
+#thread;;
 #require "lwt.unix";;
 Lwt_engine.set (new Lwt_engine.libev () :> Lwt_engine.t);;

ci/src/cI_secrets.ml

@@ -47,16 +47,10 @@ let ensure_crt ~private_key path =
   else (
     let dn = [`CN "DataKitCI"] in
     let csr = X509.CA.request dn private_key in
-    let valid_from = { Asn.Time.
-                       date = (2016, 07, 25);
-                       time = (12, 0, 0, 0.0);
-                       tz = None;
-                     } in
-    let valid_until = { Asn.Time.
-                        date = (3000, 01, 01);
-                        time = (15, 0, 0, 0.0);
-                        tz = None;
-                      } in
+    let valid_from = Ptime.of_date_time ((2016, 07, 25), ((12, 0, 0), 0)) in
+    let valid_from = opt_get (fun () -> assert false) valid_from in
+    let valid_until = Ptime.of_date_time ((3000, 01, 01), ((15, 0, 0), 0)) in
+    let valid_until = opt_get (fun () -> assert false) valid_until in
     let crt = X509.CA.sign csr ~valid_from ~valid_until private_key dn in
     let data = X509.Encoding.Pem.Certificate.to_pem_cstruct1 crt |> Cstruct.to_string in
     Lwt_io.with_file ~mode:Lwt_io.output path (fun ch -> Lwt_io.write ch data)

ci/src/cI_utils.ml

@@ -143,3 +143,7 @@ let cancel_when_off switch fn =
     (fun () -> Lwt.cancel th; Lwt.return ())
   >>= fun () ->
   th
+
+let opt_get f = function
+  | None -> f ()
+  | Some x -> x

ci/src/cI_utils.mli

@@ -48,3 +48,5 @@ val ls: string -> string list Lwt.t
 val with_switch: (Lwt_switch.t -> 'a Lwt.t) -> 'a Lwt.t
 
 val cancel_when_off: Lwt_switch.t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
+
+val opt_get : (unit -> 'a) -> 'a option -> 'a

ci/src/cI_web.ml

@@ -73,7 +73,7 @@ let check_metrics_token server provided =
     false
 
 class metrics t = object(self)
-  inherit [Cohttp_lwt_body.t] Wm.resource
+  inherit [Cohttp_lwt.Body.t] Wm.resource
 
   method content_types_provided rd =
     Wm.continue [

ci/src/cI_web.mli

@@ -5,5 +5,5 @@ val routes :
   ci:CI_engine.t ->
   server:CI_web_utils.server ->
   dashboards:CI_target.Set.t Repo.Map.t ->
-  (string * (unit -> Cohttp_lwt_body.t CI_web_utils.Wm.resource)) list
+  (string * (unit -> Cohttp_lwt.Body.t CI_web_utils.Wm.resource)) list
 (** [routes ~config ~logs ~ci ~auth ~dashboards] is the configuration for a web-server providing a UI to [ci]. *)

ci/src/cI_web_utils.ml

@@ -49,7 +49,7 @@ end
 
 module Wm = struct
   module Rd = Webmachine.Rd
-  include Webmachine.Make(Cohttp_lwt_unix_io)
+  include Webmachine.Make(Cohttp_lwt_unix.IO)
 end
 module Session = struct
   module Memory = Session.Lift.IO(Lwt)(Session.Memory)
@@ -362,14 +362,14 @@ let server ~auth ~web_config ~session_backend ~public_address =
 let web_config t = t.web_config
 
 class type resource = object
-  inherit [Cohttp_lwt_body.t] Wm.resource
-  method content_types_accepted : ((string * Cohttp_lwt_body.t Wm.acceptor) list, Cohttp_lwt_body.t) Wm.op
-  method content_types_provided : ((string * Cohttp_lwt_body.t Wm.provider) list, Cohttp_lwt_body.t) Wm.op
+  inherit [Cohttp_lwt.Body.t] Wm.resource
+  method content_types_accepted : ((string * Cohttp_lwt.Body.t Wm.acceptor) list, Cohttp_lwt.Body.t) Wm.op
+  method content_types_provided : ((string * Cohttp_lwt.Body.t Wm.provider) list, Cohttp_lwt.Body.t) Wm.op
 end
 
 class static ~valid ~mime_type dir =
   object(self)
-    inherit [Cohttp_lwt_body.t] Wm.resource
+    inherit [Cohttp_lwt.Body.t] Wm.resource
 
     method content_types_provided rd =
       match mime_type rd.Wm.Rd.uri with
@@ -400,7 +400,7 @@ class static ~valid ~mime_type dir =
 
 class static_crunch ~mime_type read =
   object(self)
-    inherit [Cohttp_lwt_body.t] Wm.resource
+    inherit [Cohttp_lwt.Body.t] Wm.resource
 
     method content_types_provided rd =
       match mime_type rd.Wm.Rd.uri with
@@ -438,8 +438,8 @@ end
 
 class virtual resource_with_session t =
   object(self)
-    inherit [Cohttp_lwt_body.t] Wm.resource
-    inherit [Cohttp_lwt_body.t] Session.manager ~cookie_key:(cookie_key t) t.session_backend
+    inherit [Cohttp_lwt.Body.t] Wm.resource
+    inherit [Cohttp_lwt.Body.t] Session.manager ~cookie_key:(cookie_key t) t.session_backend
 
     method private session rd =
       let generate_new_session () =
@@ -668,7 +668,7 @@ let serve ~mode ~routes =
 class virtual html_page t = object(self)
   inherit protected_page t
 
-  method virtual private render : (CI_web_templates.t -> CI_web_templates.page, Cohttp_lwt_body.t) Wm.op
+  method virtual private render : (CI_web_templates.t -> CI_web_templates.page, Cohttp_lwt.Body.t) Wm.op
 
   method content_types_provided rd =
     Wm.continue [
@@ -694,7 +694,7 @@ class virtual ['a] form_page t = object(self)
   method virtual private default : CI_form.State.t Lwt.t
   method virtual private render : csrf_token:string -> CI_form.State.t -> CI_web_templates.t -> CI_web_templates.page
   method virtual private validate : 'a CI_form.Validator.t
-  method virtual private process : 'a -> Cohttp_lwt_body.t Wm.acceptor
+  method virtual private process : 'a -> Cohttp_lwt.Body.t Wm.acceptor
 
   method! allowed_methods rd =
     Wm.continue [`GET; `POST] rd
@@ -722,7 +722,7 @@ class virtual ['a] form_page t = object(self)
       | None -> Wm.respond 403 ~body:(`String "Missing Content-Type header") rd
       | Some content_type ->
         let body = rd.Wm.Rd.req_body in
-        Multipart.parse_stream ~stream:(Cohttp_lwt_body.to_stream body) ~content_type >>= fun parts ->
+        Multipart.parse_stream ~stream:(Cohttp_lwt.Body.to_stream body) ~content_type >>= fun parts ->
         Multipart.get_parts parts >>= fun parts ->
         match CI_form.Validator.run self#validate parts with
         | Ok data -> self#process data rd

ci/src/cI_web_utils.mli

@@ -48,9 +48,9 @@ module Session_data : sig
 end
 
 class type resource = object
-  inherit [Cohttp_lwt_body.t] Wm.resource
-  method content_types_accepted : ((string * Cohttp_lwt_body.t Wm.acceptor) list, Cohttp_lwt_body.t) Wm.op
-  method content_types_provided : ((string * Cohttp_lwt_body.t Wm.provider) list, Cohttp_lwt_body.t) Wm.op
+  inherit [Cohttp_lwt.Body.t] Wm.resource
+  method content_types_accepted : ((string * Cohttp_lwt.Body.t Wm.acceptor) list, Cohttp_lwt.Body.t) Wm.op
+  method content_types_provided : ((string * Cohttp_lwt.Body.t Wm.provider) list, Cohttp_lwt.Body.t) Wm.op
 end
 
 class static : valid:Str.regexp -> mime_type:(Uri.t -> string option) -> string -> resource
@@ -62,8 +62,8 @@ class static_crunch : mime_type:(Uri.t -> string option) -> (string -> string op
     The MIME type returned will be [mime_type uri]. *)
 
 class virtual resource_with_session : server -> object
-    inherit [Cohttp_lwt_body.t] Wm.resource
-    method private session : Cohttp_lwt_body.t Webmachine.Rd.t -> Session_data.t Lwt.t
+    inherit [Cohttp_lwt.Body.t] Wm.resource
+    method private session : Cohttp_lwt.Body.t Webmachine.Rd.t -> Session_data.t Lwt.t
   end
 (** [resource_with_session] ensures there is a session for each request. *)
 
@@ -94,8 +94,8 @@ class virtual protected_page : server -> object
 
 class virtual post_page : server -> object
     inherit protected_page
-    method content_types_accepted : ((string * Cohttp_lwt_body.t Wm.acceptor) list, Cohttp_lwt_body.t) Wm.op
-    method content_types_provided : ((string * Cohttp_lwt_body.t Wm.provider) list, Cohttp_lwt_body.t) Wm.op
+    method content_types_accepted : ((string * Cohttp_lwt.Body.t Wm.acceptor) list, Cohttp_lwt.Body.t) Wm.op
+    method content_types_provided : ((string * Cohttp_lwt.Body.t Wm.provider) list, Cohttp_lwt.Body.t) Wm.op
   end
 (** [post_page] accepts form POST submissions.
     It overrides [forbidden] to check that the CSRF token is present and correct. *)
@@ -105,15 +105,15 @@ class logout_page : server -> resource
 
 val serve :
   mode:Conduit_lwt_unix.server ->
-  routes:(string * (unit -> Cohttp_lwt_body.t Wm.resource)) list ->
+  routes:(string * (unit -> Cohttp_lwt.Body.t Wm.resource)) list ->
   unit Lwt.t
 (** [serve ~mode ~routes] runs a web-server listening on [mode] that dispatches incoming requests using [routes]. *)
 
 class virtual html_page : server -> object
     inherit protected_page
-    method virtual private render : (CI_web_templates.t -> CI_web_templates.page, Cohttp_lwt_body.t) Wm.op
-    method content_types_accepted : ((string * Cohttp_lwt_body.t Wm.acceptor) list, Cohttp_lwt_body.t) Wm.op
-    method content_types_provided : ((string * Cohttp_lwt_body.t Wm.provider) list, Cohttp_lwt_body.t) Wm.op
+    method virtual private render : (CI_web_templates.t -> CI_web_templates.page, Cohttp_lwt.Body.t) Wm.op
+    method content_types_accepted : ((string * Cohttp_lwt.Body.t Wm.acceptor) list, Cohttp_lwt.Body.t) Wm.op
+    method content_types_provided : ((string * Cohttp_lwt.Body.t Wm.provider) list, Cohttp_lwt.Body.t) Wm.op
   end
 
 class virtual ['a] form_page : server -> object
@@ -133,11 +133,11 @@ class virtual ['a] form_page : server -> object
   (** [validate] is a validator that returns a validated result from a form submission
       (or produces suitable errors if the form is not valid). *)
 
-  method virtual private process : 'a -> Cohttp_lwt_body.t Wm.acceptor
+  method virtual private process : 'a -> Cohttp_lwt.Body.t Wm.acceptor
   (** [process data] should act on the valid form data [data], which has been produced by [validate]. *)
 
-  method content_types_accepted : ((string * Cohttp_lwt_body.t Wm.acceptor) list, Cohttp_lwt_body.t) Wm.op
-  method content_types_provided : ((string * Cohttp_lwt_body.t Wm.provider) list, Cohttp_lwt_body.t) Wm.op
+  method content_types_accepted : ((string * Cohttp_lwt.Body.t Wm.acceptor) list, Cohttp_lwt.Body.t) Wm.op
+  method content_types_provided : ((string * Cohttp_lwt.Body.t Wm.provider) list, Cohttp_lwt.Body.t) Wm.op
 end
 
 class github_auth_settings : server -> resource

ci/tests/test_ci.ml

@@ -568,7 +568,7 @@ let test_live_logs conn =
   let log = CI_live_log.create ~pending:"Building" ~branch ~title:"Test" logs in
   CI_live_log.printf log "TEST-\027[1;31mOUTPUT\027[m-1\n";
   let path = "/log/live/test%2flog" in
-  get path >|= Cohttp_lwt_body.to_stream >>= fun log_page ->
+  get path >|= Cohttp_lwt.Body.to_stream >>= fun log_page ->
   read_to log_page "TEST-<span class='fg-bright-red bold'>OUTPUT</span>-1" >>= fun () ->
   CI_live_log.printf log "TEST-OUTPUT-<&2>\n";
   read_to log_page "TEST-OUTPUT-&lt;&amp;2" >>= fun () ->
@@ -588,7 +588,7 @@ let test_live_logs conn =
   | Some (code, header, _body, _path) ->
     Alcotest.(check status_code) "Web response" `Temporary_redirect code;
     let path = Cohttp.Header.get header "location" |> Test_utils.or_fail "Missing location" in
-    get path >>= Cohttp_lwt_body.to_string >>= fun body ->
+    get path >>= Cohttp_lwt.Body.to_string >>= fun body ->
     if not (String.is_infix ~affix:"TEST-OUTPUT-&lt;&amp;" body) then
       Alcotest.fail ("Missing saved data in: " ^body);
     Lwt.return ()

datakit-ci.opam

@@ -23,7 +23,7 @@ depends: [
   "fmt"
   "logs"
   "tyxml" {>= "4.0.0"}
-  "tls"
+  "tls" {>= "0.9.0"}
   "conduit-lwt-unix" {>= "1.0.0"}
   "io-page"
   "pbkdf"
@@ -40,5 +40,6 @@ depends: [
   "datakit" {test & >= "0.12.0"}
   "irmin-unix" {test & >= "1.2.0"}
   "alcotest" {test}
+  "cohttp-lwt-unix" {>= "1.0.0"}
 ]
 available: [ocaml-version >= "4.03.0"]