Windows Update

src/conf.ml

@@ -34,14 +34,11 @@ module Distro = Dockerfile_opam.Distro
 let pool_name (distro:Distro.t) arch =
   let os_family = Distro.os_family_of_distro distro in
   let os_str = match os_family with
-  | `Windows | `Cygwin ->
-    let dedicated_pool = [`V1809] in
-    begin match Distro.resolve_alias distro with
-    | `Windows (_, release) | `Cygwin release when List.mem release dedicated_pool ->
-      "windows-" ^ Distro.win10_release_to_string release
-    | `Windows _ | `Cygwin _ -> "windows"
-    | _ -> assert false
-    end
+  | `Cygwin -> "windows"
+  | `Windows -> begin match distro with
+     | `Windows _ -> "windows-1809"
+     | `WindowsServer _ -> "windows"
+     | _ -> assert false end
   | `Linux -> "linux"
   in
   let arch_str = match arch with
@@ -57,11 +54,12 @@ let switches ~arch ~distro =
   (* opam-repository-mingw doesn't package the development version of
      the compiler. *)
   (* TODO: Does Windows include alpha, beta, and release candidate versions? *)
-  let with_unreleased = match distro with `Windows _ -> false | _ -> true in
+  let with_unreleased = match distro with `WindowsServer _ | `Windows _ -> false | _ -> true in
   let filter_windows main_switches =
     (* opam-repository-mingw doesn't package OCaml 5.0.
        TODO: remove when upstream opam gains OCaml packages on Windows. *)
     match distro with
+    | `WindowsServer _
     | `Windows _ ->
        List.filter (fun ov -> Ocaml_version.(compare ov Releases.v4_14) <= 0) main_switches
     | _ -> main_switches
@@ -83,10 +81,19 @@ let distros = Distro.(active_distros `X86_64 |> List.filter (fun d ->
   | `Linux | `Windows -> true
   | _ -> false))
 
+let windows_distros = Distro.(latest_distros |> List.filter (fun d ->
+  match os_family_of_distro d with
+  | `Windows -> true
+  | _ -> false)
+  |> List.map (fun d ->
+     let bdt = base_distro_tag d in
+     d, (fst bdt) ^ ":" ^ (snd bdt), pool_name d `X86_64))
+
 let arches_for ~distro =
   match distro with
   (* opam-repository-mingw doesn't package OCaml 5.0.
      TODO: remove when upstream opam gains OCaml packages on Windows. *)
+  | `WindowsServer _
   | `Windows _ -> Distro.distro_arches Ocaml_version.Releases.v4_14 distro
   | `Ubuntu (`V23_10) ->
     (* There does not yet exist risc-v ubuntu 23.10 docker images
@@ -95,8 +102,6 @@ let arches_for ~distro =
     |> List.filter (fun arch -> arch != `Riscv64)
   | _ -> Distro.distro_arches Ocaml_version.Releases.latest distro
 
-let win10_revision : Distro.win10_lcu = Dockerfile_opam.Distro.win10_current_lcu
-
 (* For testing, you can uncomment these lines to limit the number of combinations: *)
 
 (*

src/dump.ml

@@ -49,6 +49,9 @@ module Fake = struct
       | `Ready fn -> let x = fn log in t.state <- `Done x; x
       | `Done x -> x
 
+    let return ?label:_ x =
+      Primitive.const x
+
     let component fmt =
       fmt |> Fmt.kstr @@ fun msg ->
       msg |> String.split_on_char '\n' |> String.concat "/"
@@ -70,6 +73,12 @@ module Fake = struct
         Log.note log description;
         Log.with_indent (force (fn x)) log
 
+      let (and>) x y =
+        of_fn @@ fun log ->
+        let x = force x log in
+        let y = force y log in
+        (x, y)
+
       let (let+) x f =
         of_fn @@ fun log ->
         match x.state with
@@ -113,5 +122,15 @@ let run () =
       opam_2_1 = Current_git.Commit_id.v ~repo:"opam" ~gref:"2.1" ~hash:"2.1";
       opam_master = Current_git.Commit_id.v ~repo:"opam" ~gref:"master" ~hash:"master";
     } in
-  let log = Log.run @@ Fake.Current.force (Dump.v ~ocluster:() repos) in
+  (* The version numbers given below are correct as of April 2024.  They do not need to be updated and serve only as static
+   * placeholder values to test the version number substitution.  Alternatively, windows_version could be an empty set which
+   * would output the default tags. e.g. ltsc2022 / ltsc2019
+   * let windows_version = Pipeline.Windows_map.empty *)
+  let windows_version = List.fold_left (fun m (d, v) -> Pipeline.Windows_map.add d v m) Pipeline.Windows_map.empty
+    [ `Windows (`Msvc, `Ltsc2019), Fake.Current.return "10.0.17763.5696";
+      `Windows (`Mingw, `Ltsc2019), Fake.Current.return "10.0.17763.5696";
+      `WindowsServer (`Msvc, `Ltsc2022), Fake.Current.return "10.0.20348.2402";
+      `WindowsServer (`Mingw, `Ltsc2022), Fake.Current.return "10.0.20348.2402"; ]
+  in
+  let log = Log.run @@ Fake.Current.force (Dump.v ~ocluster:() ~repos ~windows_version) in
   List.iter print_endline log

src/pipeline.ml

@@ -2,8 +2,16 @@ module Distro = Dockerfile_opam.Distro
 module Windows = Dockerfile_opam.Windows
 
 module Switch_map = Map.Make(Ocaml_version)
+module Windows_map = Map.Make(Distro)
 
 let weekly = Current_cache.Schedule.v ~valid_for:(Duration.of_day Conf.days_between_rebuilds) ()
+let daily = Current_cache.Schedule.v ~valid_for:(Duration.of_day 1) ()
+
+let win_ver ocluster =
+  Conf.windows_distros
+  |> List.fold_left (fun m (distro, product, pool) ->
+    let w = Win_ver.get ~schedule:daily ocluster product pool in
+    Windows_map.add distro w m) Windows_map.empty
 
 let git_repositories () =
   Git_repositories.get ~schedule:weekly
@@ -111,6 +119,7 @@ let or_die = function
 
 let maybe_add_overlay distro hash =
   match distro with
+  | `WindowsServer (`Msvc, _)
   | `Windows (`Msvc, _) ->
     Dockerfile.run "opam repo add ocurrent-overlay git+https://github.com/ocurrent/opam-repository-mingw#%s --set-default" hash
   | _ -> Dockerfile.empty
@@ -130,30 +139,35 @@ module Make (OCurrent : S.OCURRENT) = struct
     let buildkit distro =
       Distro.os_family_of_distro distro <> `Windows
 
-    let install_opam ~arch ~ocluster ~distro ~repos ~push_target =
+    let install_opam ~arch ~ocluster ~distro ~repos ~push_target ~windows_version () =
       let arch_name = Ocaml_version.string_of_arch arch in
       let distro_tag, os_family = Distro.(tag_of_distro distro, os_family_of_distro distro) in
       Current.component "%s@,%s" distro_tag arch_name |>
-      let> {Git_repositories.opam_repository_master; opam_repository_mingw_sunset; opam_overlays; opam_2_0; opam_2_1; opam_master} = repos in
+      let> {Git_repositories.opam_repository_master; opam_repository_mingw_sunset; opam_overlays; opam_2_0; opam_2_1; opam_master} = repos
+      and> windows_version = windows_version in
       let dockerfile =
         let opam_hashes = {
           Dockerfile_opam.opam_2_0_hash = Current_git.Commit_id.hash opam_2_0;
           opam_2_1_hash = Current_git.Commit_id.hash opam_2_1;
           opam_master_hash = Current_git.Commit_id.hash opam_master;
         } in
         `Contents (
-          let opam = snd @@ Dockerfile_opam.gen_opam2_distro ~win10_revision:Conf.win10_revision ~arch ~clone_opam_repo:false ~opam_hashes distro in
+          let opam = snd @@ match windows_version with
+          | "" -> Dockerfile_opam.gen_opam2_distro ~arch ~clone_opam_repo:false ~opam_hashes distro
+          | override_tag -> Dockerfile_opam.gen_opam2_distro ~arch ~override_tag ~clone_opam_repo:false ~opam_hashes distro
+          in
           let open Dockerfile in
           string_of_t (
-            opam @@
             begin match os_family with
             | `Linux ->
+              opam @@
               copy ~link:true ~chown:"opam:opam" ~src:["."] ~dst:"/home/opam/opam-repository" () @@
               run "opam-sandbox-disable" @@
               run "opam init -k local -a /home/opam/opam-repository --bare" @@
               run "rm -rf .opam/repo/default/.git" @@
               copy ~link:true ~src:["Dockerfile"] ~dst:"/Dockerfile.opam" ()
             | `Windows ->
+              opam @@
               let opam_repo = Windows.Cygwin.default.root ^ {|\home\opam\opam-repository|} in
               let opam_root = {|C:\opam\.opam|} in
               copy ~src:["."] ~dst:opam_repo () @@
@@ -211,9 +225,9 @@ module Make (OCurrent : S.OCURRENT) = struct
         ~pool:(Conf.pool_name distro `X86_64)
 
     (* Build the base image for [distro], plus an image for each compiler version. *)
-    let pipeline ~ocluster ~repos ~distro arch =
+    let pipeline ~ocluster ~repos ?(windows_version = Windows_map.empty) ~distro arch =
       let update_index current distro switch =
-        let+ state = Current.state ~hidden:true current in
+        let+ state = Current.state ~hidden:false current in
         let s = match state with
         | Ok _ -> Index.Ok
         | Error (`Active _) -> Active
@@ -229,7 +243,8 @@ module Make (OCurrent : S.OCURRENT) = struct
           |> Cluster_api.Docker.Image_id.of_string
           |> or_die
         in
-        install_opam ~arch ~ocluster ~distro ~repos ~push_target
+        let windows_version = Windows_map.find_opt distro windows_version |> Option.value ~default:(Current.return "") in
+        install_opam ~arch ~ocluster ~distro ~repos ~windows_version ~push_target ()
       in
       let _ = update_index opam_image distro None in
       let compiler_images =
@@ -239,7 +254,10 @@ module Make (OCurrent : S.OCURRENT) = struct
           |> Cluster_api.Docker.Image_id.of_string
           |> or_die
         in
-        let windows_port = match distro with  `Windows (port, _) -> Some port | _ -> None in
+        let windows_port = match distro with
+        | `WindowsServer (port, _) -> Some port
+        | `Windows (port, _) -> Some port
+        | _ -> None in
         let repo_id = install_compiler ~distro ~arch ~ocluster ~switch ~push_target ?windows_port opam_image in
         let _ = update_index repo_id distro (Some switch) in
         (switch, repo_id)
@@ -271,11 +289,11 @@ module Make (OCurrent : S.OCURRENT) = struct
     let> v = t in
     Current.Primitive.const v
 
-  let pipeline ~ocluster repos distro gen_tags =
+  let pipeline ~ocluster ~repos ?windows_version distro gen_tags =
     let opam_images, ocaml_images, archive_image =
       let arch_results =
         let arches = Conf.arches_for ~distro in
-        List.map (Arch.pipeline ~ocluster ~repos ~distro) arches in
+        List.map (Arch.pipeline ~ocluster ~repos ~distro ?windows_version) arches in
       List.fold_left (fun (aa,ba,ca) (a,b,c) ->
           let ca = match ca,c with Some v, _ -> Some v | None, v -> v in
           a::aa, b::ba, ca) ([], [], None) arch_results
@@ -304,7 +322,7 @@ module Make (OCurrent : S.OCURRENT) = struct
     in
     multiarch_images, pipeline
 
-  let linux_pipeline ~ocluster repos distro =
+  let linux_pipeline ~ocluster ~repos distro =
     let distro_label = Distro.tag_of_distro distro in
     let repos = label distro_label repos in
     Current.collapse ~key:"distro" ~value:distro_label ~input:repos @@
@@ -328,10 +346,10 @@ module Make (OCurrent : S.OCURRENT) = struct
         (* Fmt.pr "Aliases: %s -> %a@." full_tag Fmt.(Dump.list string) (List.sort String.compare tags); *)
         Switch_map.empty, tags
       in
-      let (_multiarch_images, pipeline) = pipeline ~ocluster repos distro gen_tags in
+      let (_multiarch_images, pipeline) = pipeline ~ocluster ~repos distro gen_tags in
       pipeline
 
-  let windows_distro_pipeline ~ocluster repos distro_label distro_versions =
+  let windows_distro_pipeline ~ocluster ~repos ~windows_version distro_label distro_versions =
     let distro_pipeline multiarches distro =
       let gen_tags images full_tag switch distro_aliases =
         let tags =
@@ -347,7 +365,7 @@ module Make (OCurrent : S.OCURRENT) = struct
         (* Fmt.pr "Aliases: %s -> %a@." full_tag Fmt.(Dump.list string) (List.sort String.compare tags); *)
         Switch_map.add switch images Switch_map.empty, tags
       in
-      let (multiarch_images, pipeline) = pipeline ~ocluster repos distro gen_tags in
+      let (multiarch_images, pipeline) = pipeline ~ocluster ~repos ~windows_version distro gen_tags in
       let multiarch_images =
         let update images = function None -> Some images | Some images' -> Some (images @ images') in
         let fold switch images acc = Switch_map.update switch (update images) acc in
@@ -372,31 +390,33 @@ module Make (OCurrent : S.OCURRENT) = struct
     in
     Current.(collapse ~key:"distro" ~value:distro_label ~input:repos (all ((all_labelled pushes) :: pipelines)))
 
-  let windows_pipeline ~ocluster repos mingw msvc cygwin =
+  let windows_pipeline ~ocluster ~repos ~windows_version mingw msvc cygwin =
     List.filter_map (fun (distro_label, distros) ->
         match distros with
         | [] -> None
         | distro_versions ->
            let repos = label distro_label repos in
-           windows_distro_pipeline ~ocluster repos distro_label distro_versions |> Option.some)
+           windows_distro_pipeline ~ocluster ~repos ~windows_version distro_label distro_versions |> Option.some)
       [("windows-mingw", mingw); ("windows-msvc", msvc); ("cygwin", cygwin)]
 
   (* The main pipeline. Builds images for all supported distribution, compiler version and architecture combinations. *)
-  let v ~ocluster repos =
+  let v ~ocluster ~repos ~windows_version =
     let linux, mingw, msvc, cygwin = Conf.distros |> List.fold_left (fun (linux, mingw, msvc, cygwin) distro ->
       let os_family = Distro.os_family_of_distro distro in
       match os_family with
       | `Linux -> distro :: linux, mingw, msvc, cygwin
       | `Cygwin -> linux, mingw, msvc, distro :: cygwin
       | `Windows ->
          match distro with
+         | `WindowsServer (`Mingw, _)
          | `Windows (`Mingw, _) -> linux, distro :: mingw, msvc, cygwin
+         | `WindowsServer (`Msvc, _)
          | `Windows (`Msvc, _) -> linux, mingw, distro :: msvc, cygwin
          | _ -> assert false) ([], [], [], [])
     in
     let pipelines =
-      List.rev_map (linux_pipeline ~ocluster repos) linux
-      @ windows_pipeline ~ocluster repos mingw msvc cygwin in
+      List.rev_map (linux_pipeline ~ocluster ~repos) linux
+      @ windows_pipeline ~ocluster ~repos ~windows_version mingw msvc cygwin in
     Current.all pipelines
 end
 
@@ -424,4 +444,5 @@ let notify_status ?channel x =
 let v ?channel ~ocluster () =
   if Conf.auth = None then Fmt.pr "Password file %S not found; images will not be pushed to hub@." Conf.password_path;
   let repos = git_repositories () in
-  Real.v ~ocluster repos |> notify_status ?channel
+  let wv = win_ver ocluster in
+  Real.v ~ocluster ~repos ~windows_version:wv |> notify_status ?channel

src/pipeline.mli

@@ -1,7 +1,15 @@
+
+module Windows_map : sig
+  type key = Dockerfile_opam.Distro.t
+  type 'a t = 'a Map.Make(Dockerfile_opam.Distro).t
+  val empty : 'a t
+  val add : key -> 'a -> 'a t -> 'a t
+end
+
 module Make (OCurrent : S.OCURRENT) : sig
   open OCurrent
 
-  val v : ocluster:OCluster.t -> Git_repositories.t Current.t -> unit Current.t
+  val v : ocluster:OCluster.t -> repos:(Git_repositories.t Current.t) -> windows_version:(string Current.t Windows_map.t) -> unit Current.t
 end
 
 val v : ?channel:Current_slack.channel -> ocluster:Current_ocluster.t -> unit -> unit Current.t

src/s.ml

@@ -19,9 +19,11 @@ module type OCURRENT = sig
     val all : unit t list -> unit t
     val all_labelled : (string * unit t) list -> unit t
     val collapse : key:string -> value:string -> input:_ t -> 'a t -> 'a t
+    val return : ?label:string -> 'a -> 'a t
 
     module Syntax : sig
       val (let>) : 'a t -> ('a -> 'b Primitive.t) -> description -> 'b t
+      val (and>) : 'a t -> 'b t -> ('a * 'b) t
       val (let+) : 'a t -> ('a -> 'b) -> 'b t
     end
   end