diff --git a/doc/index.mld b/doc/index.mld index 9ddb2cbb..be41496e 100644 --- a/doc/index.mld +++ b/doc/index.mld @@ -8,3 +8,4 @@ The entry point of this library is the module: - {{!page-macOS}macOS implementation documentation}. - {{!page-freebsd}FreeBSD implementation documentation}. - {{!page-windows}Windows implementation documentation}. +- {{!page-qemu}QEMU implementation documentation}. diff --git a/doc/qemu.md b/doc/qemu.md new file mode 100644 index 00000000..ba10541c --- /dev/null +++ b/doc/qemu.md @@ -0,0 +1,116 @@ +# OBuilder's QEMU Sandbox + +This backend should work with any OS which can be booted in QEMU and +which can provide an SSH interface. + +# Base Images + +These need to be provided as boot disks. There is a `Makefile` in the +`qemu` directory which builds two base images: + +- ubuntu-noble-x86_64-ocaml-4.14.img +- windows-server-2022-x86_64-ocaml-4.14.img + +The base images build automatically using Cloud Init on Ubuntu and +`autounattend.xml` on Windows. + +# Operation + + +A spec which reference the required base image in using the `from` +directive, then run the whatever commands are required. An trivial +example is given below. + +``` +( + (from windows-server-2022-x86_64-ocaml-4.14) + (run + (cache (opam-archives (target /Users/opam/AppData/Local/opam/download-cache))) + (shell "opam install tar") + ) +) +``` + +A typical invocation via `obuilder build` would be as below. Note that +in this example, the base images would be in `/data/base-image/*.img`. + +``` +./_build/install/default/bin/obuilder build --store=qemu:/data -v -f test.spec --qemu-memory 16 --qemu-cpus 8 . +``` + +The `from` directive causes `qemu-img` to create a snapshot of the base +image and stage it in the `result-tmp` folder. When this completes +successfully, `result-tmp` is moved to `result`: + +``` +(from windows-server-2022-x86_64-ocaml-4.14) +obuilder: [INFO] Base image not present; importing "windows-server-2022-x86_64-ocaml-4.14"… +obuilder: [INFO] Exec "mkdir" "-m" "755" "--" "/var/lib/docker/test/result-tmp/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101/rootfs" +obuilder: [INFO] Exec "qemu-img" "create" "-f" "qcow2" "-b" "/var/lib/docker/test/base-image/windows-server-2022-x86_64-ocaml-4.14.img" "-F" "qcow2" "/var/lib/docker/test/result-tmp/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101/rootfs/image.qcow2" +Formatting '/var/lib/docker/test/result-tmp/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101/rootfs/image.qcow2', fmt=qcow2 cluster_size=65536 extended_l2=off compression_type=zlib size=42949672960 backing_file=/var/lib/docker/test/base-image/windows-server-2022-x86_64-ocaml-4.14.img backing_fmt=qcow2 lazy_refcounts=off refcount_bits=16 +obuilder: [INFO] Exec "mv" "/var/lib/docker/test/result-tmp/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101" "/var/lib/docker/test/result/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101" +---> saved as “dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101” +``` + +Moving on to the next stage in the build which is the `run` directive. +First, `qemu-img` creates a snapshot of the current `resuilt` layer into +`result-tmp`. Then `qemu-system-x86_64` is started with this snapshot as +the base image. `ssh` is used to poll the machine until it is available. +Next, `scp` runs to copy the cache `opam-archives` over to the target +directory `/Users/opam/AppData/Local/opam/download-cache`. Finally, +the actual commands are sent over `ssh` to install `tar`. The step +completes with an `scp` of the cache back to the host followed by an +ACPI shutdown command sent to the qemu console. + +``` +/: (run (cache (opam-archives (target /Users/opam/AppData/Local/opam/download-cache))) + (shell "opam install tar")) +obuilder: [INFO] Exec "qemu-img" "create" "-f" "qcow2" "-b" "/var/lib/docker/test/result/dce4336e183de81da7537728ed710f2906e9f75431694d9de80b95a9d9ff1101/rootfs/image.qcow2" "-F" "qcow2" "/var/lib/docker/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3/rootfs/image.qcow2" "40G" +obuilder: [INFO] Exec "cp" "-pRduT" "--reflink=auto" "/var/lib/docker/test/cache/c-opam-archives" "/var/lib/docker/test/cache-tmp/0-c-opam-archives" +obuilder: [INFO] Fork exec "qemu-system-x86_64" "-m" "16G" "-smp" "8" "-machine" "accel=kvm,type=q35" "-cpu" "host" "-nic" "user,hostfwd=tcp::34649-:22" "-display" "none" "-monitor" "stdio" "-drive" "file=/var/lib/docker/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3/rootfs/image.qcow2,format=qcow2" +obuilder: [INFO] Exec "ssh" "opam@localhost" "-p" "34649" "-o" "BatchMode=yes" "-o" "NoHostAuthenticationForLocalhost=yes" "exit" +obuilder: [INFO] Exec "scp" "-P" "34649" "-o" "NoHostAuthenticationForLocalhost=yes" "-prq" "/var/lib/docker/test/cache-tmp/0-c-opam-archives/md5" "/var/lib/docker/test/cache-tmp/0-c-opam-archives/sha512" "/var/lib/docker/test/cache-tmp/0-c-opam-archives/sha256" "opam@localhost:/Users/opam/AppData/Local/opam/download-cache" +obuilder: [INFO] Fork exec "ssh" "opam@localhost" "-p" "34649" "-o" "NoHostAuthenticationForLocalhost=yes" "cd" "/" "&&" "opam install tar" +The following actions will be performed: +=== install 8 packages + - install checkseum 0.5.2 [required by decompress] + - install cmdliner 1.3.0 [required by decompress] + - install csexp 1.5.2 [required by dune-configurator] + - install decompress 1.5.3 [required by tar] + - install dune 3.16.0 [required by tar] + - install dune-configurator 3.16.0 [required by checkseum] + - install optint 0.3.0 [required by decompress] + - install tar 3.1.2 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +-> retrieved checkseum.0.5.2 (cached) +-> retrieved cmdliner.1.3.0 (cached) +-> retrieved csexp.1.5.2 (cached) +-> retrieved decompress.1.5.3 (cached) +-> retrieved optint.0.3.0 (cached) +-> retrieved tar.3.1.2 (cached) +-> retrieved dune.3.16.0, dune-configurator.3.16.0 (cached) +-> installed cmdliner.1.3.0 +-> installed dune.3.16.0 +-> installed csexp.1.5.2 +-> installed optint.0.3.0 +-> installed dune-configurator.3.16.0 +-> installed checkseum.0.5.2 +-> installed decompress.1.5.3 +-> installed tar.3.1.2 +Done. +# Run eval $(opam env) to update the current shell environment +obuilder: [INFO] Exec "scp" "-P" "34649" "-o" "NoHostAuthenticationForLocalhost=yes" "-prq" "opam@localhost:/Users/opam/AppData/Local/opam/download-cache/*" "/var/lib/docker/test/cache-tmp/0-c-opam-archives" +obuilder: [INFO] Sending QEMU an ACPI shutdown event +obuilder: [INFO] Exec "cp" "-pRduT" "--reflink=auto" "/var/lib/docker/test/cache-tmp/0-c-opam-archives" "/var/lib/docker/test/cache/c-opam-archives" +obuilder: [INFO] Exec "rm" "-r" "/var/lib/docker/test/cache-tmp/0-c-opam-archives" +obuilder: [INFO] Exec "mv" "/var/lib/docker/test/result-tmp/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3" "/var/lib/docker/test/result/8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3" +---> saved as "8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3" +Got: "8a897f21e54db877fc971c757ef7ffc2e1293e191dc60c3a18f24f0d3f0926f3" +``` + +# Note + +While this initial version only runs on x86_64 targetting x86_64 +processors it would be entirely possibly to extend this to other +architectures. diff --git a/lib/archive_extract.ml b/lib/archive_extract.ml index 96e4384f..aa835f8f 100644 --- a/lib/archive_extract.ml +++ b/lib/archive_extract.ml @@ -14,8 +14,7 @@ let invoke_fetcher base destdir = fetcher >>= fun () -> extracter -let fetch ~log ~rootfs base = - let _ = log in +let fetch ~log:_ ~root:_ ~rootfs base = Lwt.catch (fun () -> invoke_fetcher base rootfs >>= fun () -> diff --git a/lib/build.ml b/lib/build.ml index c15547df..efb00956 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -161,7 +161,7 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st () in Os.with_pipe_to_child @@ fun ~r:from_us ~w:to_untar -> - let proc = Sandbox.run ~cancelled ~stdin:from_us ~log t.sandbox config result_tmp in + let proc = Sandbox.tar_in ~cancelled ~stdin:from_us ~log t.sandbox config result_tmp in let send = (* If the sending thread finishes (or fails), close the writing socket immediately so that the tar process finishes too. *) @@ -233,11 +233,12 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st let get_base t ~log base = log `Heading (Fmt.str "(from %a)" Sexplib.Sexp.pp_hum (Atom base)); let id = Sha256.to_hex (Sha256.string base) in + let root = Store.root t.store in Store.build t.store ~id ~log (fun ~cancelled:_ ~log tmp -> Log.info (fun f -> f "Base image not present; importing %S…" base); let rootfs = tmp / "rootfs" in Os.sudo ["mkdir"; "-m"; "755"; "--"; rootfs] >>= fun () -> - Fetch.fetch ~log ~rootfs base >>= fun env -> + Fetch.fetch ~log ~root ~rootfs base >>= fun env -> Os.write_file ~path:(tmp / "env") (Sexplib.Sexp.to_string_hum Saved_context.(sexp_of_t {env})) >>= fun () -> Lwt_result.return () @@ -278,6 +279,9 @@ module Make (Raw_store : S.STORE) (Sandbox : S.SANDBOX) (Fetch : S.FETCHER) = st let df t = Store.df t.store + let root t = + Store.root t.store + let cache_stats t = Store.cache_stats t.store @@ -537,6 +541,9 @@ module Make_Docker (Raw_store : S.STORE) = struct let df t = Store.df t.store + let root t = + Store.root t.store + let cache_stats t = Store.cache_stats t.store diff --git a/lib/db_store.ml b/lib/db_store.ml index 75f3dae9..a2be43b5 100644 --- a/lib/db_store.ml +++ b/lib/db_store.ml @@ -132,6 +132,7 @@ module Make (Raw : S.STORE) = struct let result t id = Raw.result t.raw id let count t = Dao.count t.dao let df t = Raw.df t.raw + let root t = Raw.root t.raw let cache_stats t = t.cache_hit, t.cache_miss let cache ~user t = Raw.cache ~user t.raw diff --git a/lib/db_store.mli b/lib/db_store.mli index 95b29a93..74937a02 100644 --- a/lib/db_store.mli +++ b/lib/db_store.mli @@ -24,6 +24,8 @@ module Make (Raw : S.STORE) : sig val df : t -> float Lwt.t + val root : t -> string + val cache_stats : t -> int * int val cache : diff --git a/lib/docker.ml b/lib/docker.ml index b37ba8b0..601569d2 100644 --- a/lib/docker.ml +++ b/lib/docker.ml @@ -367,7 +367,7 @@ module Extract = struct | Some _ as pair -> pair ) - let fetch ~log ~rootfs base = + let fetch ~log ~root:_ ~rootfs base = let* () = with_container ~log base (fun cid -> Os.with_pipe_between_children @@ fun ~r ~w -> let exporter = Cmd.export ~stdout:(`FD_move_safely w) (`Docker_container cid) in diff --git a/lib/docker_sandbox.ml b/lib/docker_sandbox.ml index 9d66f853..22677cda 100644 --- a/lib/docker_sandbox.ml +++ b/lib/docker_sandbox.ml @@ -155,6 +155,9 @@ let run ~cancelled ?stdin ~log t config (id:S.id) = if Lwt.is_sleeping cancelled then (r :> (unit, [`Msg of string | `Cancelled]) result) else Error `Cancelled +let tar_in ~cancelled ?stdin ~log t config result_tmp = + run ~cancelled ?stdin ~log t config result_tmp + (* Duplicate of Build.hostname. *) let hostname = "builder" diff --git a/lib/obuilder.ml b/lib/obuilder.ml index f036dd21..a50104ed 100644 --- a/lib/obuilder.ml +++ b/lib/obuilder.ml @@ -1,13 +1,13 @@ let log_src = Log.src -(** {2 Types} *) +(** {4 Types} *) module S = S module Spec = Obuilder_spec module Context = Build.Context module Docker = Docker -(** {2 Stores} *) +(** {7 Stores} *) module Btrfs_store = Btrfs_store module Zfs_store = Zfs_store @@ -15,19 +15,22 @@ module Rsync_store = Rsync_store module Xfs_store = Xfs_store module Store_spec = Store_spec module Docker_store = Docker_store +module Qemu_store = Qemu_store -(** {2 Fetchers} *) +(** {4 Fetchers} *) module Zfs_clone = Zfs_clone +module Qemu_snapshot = Qemu_snapshot module Docker_extract = Docker.Extract module Archive_extract = Archive_extract -(** {2 Sandboxes} *) +(** {3 Sandboxes} *) module Config = Config module Native_sandbox = Sandbox module Docker_sandbox = Docker_sandbox +module Qemu_sandbox = Qemu_sandbox -(** {2 Builders} *) +(** {3 Builders} *) module type BUILDER = S.BUILDER with type context := Build.Context.t module Builder = Build.Make diff --git a/lib/os.ml b/lib/os.ml index 46ecd8af..fdb0c583 100644 --- a/lib/os.ml +++ b/lib/os.ml @@ -66,13 +66,13 @@ let default_exec ?timeout ?cwd ?stdin ?stdout ?stderr ~pp argv = (* Similar to default_exec except using open_process_none in order to get the pid of the forked process. On macOS this allows for cleaner job cancellations *) -let open_process ?cwd ?stdin ?stdout ?stderr ?pp:_ argv = +let open_process ?cwd ?env ?stdin ?stdout ?stderr ?pp:_ argv = Logs.info (fun f -> f "Fork exec %a" pp_cmd ("", argv)); let proc = let stdin = Option.map redirection stdin in let stdout = Option.map redirection stdout in let stderr = Option.map redirection stderr in - let process = Lwt_process.open_process_none ?cwd ?stdin ?stdout ?stderr ("", (Array.of_list argv)) in + let process = Lwt_process.open_process_none ?cwd ?env ?stdin ?stdout ?stderr ("", (Array.of_list argv)) in (process#pid, process#status) in Option.iter close_redirection stdin; @@ -213,6 +213,12 @@ let check_dir x = | _ -> Fmt.failwith "Exists, but is not a directory: %S" x | exception Unix.Unix_error(Unix.ENOENT, _, _) -> `Missing +let check_file x = + match Unix.lstat x with + | Unix.{ st_kind = S_REG; _ } -> `Present + | _ -> Fmt.failwith "Exists, but is not a regular file: %S" x + | exception Unix.Unix_error(Unix.ENOENT, _, _) -> `Missing + let ensure_dir ?(mode=0o777) path = match check_dir path with | `Present -> () @@ -232,6 +238,24 @@ let rm ~directory = Log.warn (fun f -> f "Failed to remove %s because %s" directory m); Lwt.return_unit +let mv ~src dst = + let pp _ ppf = Fmt.pf ppf "[ MV ]" in + sudo_result ~pp:(pp "MV") ["mv"; src; dst ] >>= fun t -> + match t with + | Ok () -> Lwt.return_unit + | Error (`Msg m) -> + Log.warn (fun f -> f "Failed to move %s to %s because %s" src dst m); + Lwt.return_unit + +let cp ~src dst = + let pp _ ppf = Fmt.pf ppf "[ CP ]" in + sudo_result ~pp:(pp "CP") ["cp"; "-pRduT"; "--reflink=auto"; src; dst ] >>= fun t -> + match t with + | Ok () -> Lwt.return_unit + | Error (`Msg m) -> + Log.warn (fun f -> f "Failed to copy from %s to %s because %s" src dst m); + Lwt.return_unit + let normalise_path root_dir = if Sys.win32 then let vol, _ = Fpath.(v root_dir |> split_volume) in diff --git a/lib/qemu_sandbox.ml b/lib/qemu_sandbox.ml new file mode 100644 index 00000000..d36211b8 --- /dev/null +++ b/lib/qemu_sandbox.ml @@ -0,0 +1,167 @@ +open Lwt.Infix +open Sexplib.Conv + +let ( / ) = Filename.concat + +let copy_to_log ~src ~dst = + let buf = Bytes.create 4096 in + let rec aux () = + Lwt_unix.read src buf 0 (Bytes.length buf) >>= function + | 0 -> Lwt.return_unit + | n -> Build_log.write dst (Bytes.sub_string buf 0 n) >>= aux + in + aux () + +type t = { + qemu_cpus : int; + qemu_memory : int; + qemu_network : string; (* Default network, overridden by network stanza *) +} + +type config = { + cpus : int; + memory : int; + network : string; +} [@@deriving sexp] + +let get_free_port () = + let fd = Unix.socket PF_INET SOCK_STREAM 0 in + let () = Unix.bind fd (ADDR_INET(Unix.inet_addr_loopback, 0)) in + let sa = Unix.getsockname fd in + let () = Unix.close fd in + match sa with + | ADDR_INET (_, n) -> string_of_int n + | ADDR_UNIX _ -> assert false;; + +let run ~cancelled ?stdin ~log t config result_tmp = + let pp f = Os.pp_cmd f ("", config.Config.argv) in + + Os.with_pipe_to_child @@ fun ~r:qemu_r ~w:qemu_w -> + let qemu_stdin = `FD_move_safely qemu_r in + let qemu_monitor = Lwt_io.(of_fd ~mode:output) qemu_w in + let port = get_free_port () in + let cmd = [ "qemu-system-x86_64"; + "-m"; (string_of_int t.qemu_memory) ^ "G"; + "-smp"; string_of_int t.qemu_cpus; + "-machine"; "accel=kvm,type=q35"; + "-cpu"; "host"; + "-nic"; "user,hostfwd=tcp::" ^ port ^ "-:22"; + "-display"; "none"; + "-monitor"; "stdio"; + "-drive"; "file=" ^ result_tmp / "rootfs" / "image.qcow2" ^ ",format=qcow2" ] in + let _, proc = Os.open_process ~stdin:qemu_stdin ~stdout:`Dev_null ~pp cmd in + + let rec loop = function + | 0 -> Lwt_result.fail (`Msg "No connection") + | n -> + Os.exec_result ~pp ["ssh"; "opam@localhost"; "-p"; port; "-o"; "BatchMode=yes"; "-o"; "NoHostAuthenticationForLocalhost=yes"; "exit"] >>= function + | Ok _ -> Lwt_result.ok (Lwt.return ()) + | _ -> Lwt_unix.sleep 2. >>= fun _ -> loop (n - 1) in + Lwt_unix.sleep 2. >>= fun _ -> + loop 30 >>= fun _ -> + + Lwt_list.iter_s (fun { Config.Mount.src; dst; _ } -> + let folders = Sys.readdir src |> Array.to_list |> List.map (fun f -> src / f) in + if List.length folders > 0 then + Os.exec (["scp"; "-P"; port; "-o"; "NoHostAuthenticationForLocalhost=yes"; "-prq"] @ folders @ ["opam@localhost:" ^ dst ]) + else Lwt.return ()) config.Config.mounts >>= fun () -> + + Os.with_pipe_from_child @@ fun ~r:out_r ~w:out_w -> + let stdin = Option.map (fun x -> `FD_move_safely x) stdin in + let stdout = `FD_move_safely out_w in + let stderr = stdout in + let copy_log = copy_to_log ~src:out_r ~dst:log in + let env = List.map (fun (k, v) -> k ^ "=" ^ v) config.Config.env |> Array.of_list in + let sendenv = if Array.length env > 0 then List.map (fun (k, _) -> ["-o"; "SendEnv=" ^ k]) config.Config.env |> List.flatten else [] in + let cmd = match config.Config.argv with + | "cmd" :: "/S" :: "/C" :: tl + | "/usr/bin/env" :: "bash" :: "-c" :: tl -> tl + | "/bin/sh" :: "-c" :: tl -> tl + | x -> x in + let _, proc2 = Os.open_process ~env ?stdin ~stdout ~stderr ~pp (["ssh"; "opam@localhost"; "-p"; port; "-o"; "NoHostAuthenticationForLocalhost=yes"] @ sendenv @ ["cd"; config.Config.cwd; "&&"] @ cmd) in + Lwt.on_termination cancelled (fun () -> + let aux () = + if Lwt.is_sleeping proc then + Lwt_io.write qemu_monitor "quit\n" + else Lwt.return_unit (* Process has already finished *) + in + Lwt.async aux + ); + Os.process_result ~pp proc2 >>= fun res -> + copy_log >>= fun () -> + + Lwt_list.iter_s (fun { Config.Mount.src; dst; _ } -> + Os.exec ["scp"; "-P"; port; "-o"; "NoHostAuthenticationForLocalhost=yes"; "-prq"; "opam@localhost:" ^ dst ^ "/*"; src ]) config.Config.mounts >>= fun () -> + + Log.info (fun f -> f "Sending QEMU an ACPI shutdown event"); + Lwt_io.write qemu_monitor "system_powerdown\n" >>= fun () -> + let rec loop = function + | 0 -> + Log.warn (fun f -> f "Powering off QEMU"); + Lwt_io.write qemu_monitor "quit\n" + | n -> + if Lwt.is_sleeping proc then + Lwt_unix.sleep 1. >>= fun () -> + loop (n - 1) + else Lwt.return () in + loop 30 >>= fun _ -> + + Os.process_result ~pp proc >>= fun _ -> + + if Lwt.is_sleeping cancelled then Lwt.return (res :> (unit, [`Msg of string | `Cancelled]) result) + else Lwt_result.fail `Cancelled + +let tar_in ~cancelled ?stdin ~log:_ _ config result_tmp = + let proc = + let cmd = ["guestfish"; + "add-drive"; result_tmp / "rootfs" / "image.qcow2"; ":"; + "run"; ":"; + "mount"; "/dev/sda2"; "/"; ":"; + "tar-in"; "-"; config.Config.cwd; ] in + let stdin = Option.map (fun x -> `FD_move_safely x) stdin in + let pp f = Os.pp_cmd f ("", config.Config.argv) in + Os.sudo_result ?stdin ~pp cmd in + proc >>= fun r -> + if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result) + else Lwt_result.fail `Cancelled + +let create (c : config) = + let t = { qemu_cpus = c.cpus; qemu_memory = c.memory; qemu_network = c.network } in + Lwt.return t + +let finished () = + Lwt.return () + +open Cmdliner + +let docs = "QEMU BACKEND" + +let cpus = + Arg.value @@ + Arg.opt Arg.int 2 @@ + Arg.info ~docs + ~doc:"Number of CPUs to be used by each QEMU machine." + ~docv:"CPUS" + ["qemu-cpus"] + +let memory = + Arg.value @@ + Arg.opt Arg.int 2 @@ + Arg.info ~docs + ~doc:"The amount of memory allocated to the VM in gigabytes." + ~docv:"MEMORY" + ["qemu-memory"] + +let network = + Arg.value @@ + Arg.opt Arg.string (if Sys.unix then "host" else "nat") @@ + Arg.info ~docs + ~doc:"Docker network used for the Docker backend setup." + ~docv:"NETWORK" + ["qemu-network"] + +let cmdliner : config Term.t = + let make cpus memory network = + { cpus; memory; network; } + in + Term.(const make $ cpus $ memory $ network) diff --git a/lib/qemu_sandbox.mli b/lib/qemu_sandbox.mli new file mode 100644 index 00000000..e940b1d7 --- /dev/null +++ b/lib/qemu_sandbox.mli @@ -0,0 +1,15 @@ +(** Sandbox builds using Docker. *) + +include S.SANDBOX + +type config [@@deriving sexp] +(** The type of sandbox configurations *) + +val cmdliner : config Cmdliner.Term.t +(** [cmdliner] is used for command-line interfaces to generate the + necessary flags and parameters to setup a specific sandbox's + configuration. *) + +val create : config -> t Lwt.t +(** [create config] is a Docker sandboxing system that is configured + using [config]. *) diff --git a/lib/qemu_snapshot.ml b/lib/qemu_snapshot.ml new file mode 100644 index 00000000..84cfd002 --- /dev/null +++ b/lib/qemu_snapshot.ml @@ -0,0 +1,12 @@ +open Lwt.Infix + +let ( / ) = Filename.concat + +let fetch ~log:_ ~root ~rootfs base = + let base_image = match base with + | "busybox" -> root / "base-image" / "ubuntu-noble-x86_64-ocaml-4.14.img" + | x -> root / "base-image" / (x ^ ".img") in + Os.sudo [ "qemu-img"; "create"; "-f"; "qcow2"; "-b"; base_image; "-F"; "qcow2"; rootfs / "image.qcow2" ] >>= fun () -> + Lwt.return [] + + diff --git a/lib/qemu_snapshot.mli b/lib/qemu_snapshot.mli new file mode 100644 index 00000000..db96a77e --- /dev/null +++ b/lib/qemu_snapshot.mli @@ -0,0 +1 @@ +include S.FETCHER diff --git a/lib/qemu_store.ml b/lib/qemu_store.ml new file mode 100644 index 00000000..b111ba95 --- /dev/null +++ b/lib/qemu_store.ml @@ -0,0 +1,163 @@ +open Lwt.Infix + +let strf = Printf.sprintf + +let running_as_root = Unix.getuid () = 0 + +(* Represents a persistent cache. + You must hold a cache's lock when removing or updating its entry in + "cache". *) +type cache = { + lock : Lwt_mutex.t; + mutable children : int; +} + +type t = { + root : string; (* The top-level directory (containing `result`, etc). *) + caches : (string, cache) Hashtbl.t; + mutable next : int; (* Used to generate unique temporary IDs. *) +} + +let ( / ) = Filename.concat + +module Qemu_img = struct + let qemu_img ?(sudo=false) args = + let args = "qemu-img" :: args in + let args = if sudo && not running_as_root then "sudo" :: args else args in + Os.exec ~stdout:`Dev_null args + + let snapshot _ ~src dst = + Os.ensure_dir dst; + Os.ensure_dir (dst / "rootfs"); + qemu_img (["create"; "-f"; "qcow2"; "-b"; src / "rootfs" / "image.qcow2"; "-F"; "qcow2"; dst / "rootfs" / "image.qcow2"; "40G"]) +end + +let delete_snapshot_if_exists path = + match Os.check_dir path with + | `Missing -> Lwt.return_unit + | `Present -> Os.rm ~directory:path + +module Path = struct + (* A qemu store contains several subdirectories: + + - result: completed builds, named by ID + - result-tmp: in-progress builds + - state: for sqlite DB, etc + - cache: the latest version of each cache, by cache ID + - cache-tmp: in-progress updates to caches + + result-tmp and cache-tmp are wiped at start-up. *) + + let result t id = t.root / "result" / id + let result_tmp t id = t.root / "result-tmp" / id + let state t = t.root / "state" + let cache t name = t.root / "cache" / Escape.cache name + let cache_tmp t i name = t.root / "cache-tmp" / strf "%d-%s" i (Escape.cache name) +end + +let delete t id = + delete_snapshot_if_exists (Path.result t id) + +let purge path = + Sys.readdir path |> Array.to_list |> Lwt_list.iter_s (fun item -> + let item = path / item in + Log.warn (fun f -> f "Removing left-over temporary item %S" item); + Os.rm ~directory:item + ) + +let root t = t.root + +module Stats = Map.Make (String) + +let df t = Lwt.return (Os.free_space_percent t.root) + +let create ~root = + Os.ensure_dir (root / "result"); + Os.ensure_dir (root / "result-tmp"); + Os.ensure_dir (root / "state"); + Os.ensure_dir (root / "cache"); + Os.ensure_dir (root / "cache-tmp"); + purge (root / "result-tmp") >>= fun () -> + purge (root / "cache-tmp") >>= fun () -> + Lwt.return { root; caches = Hashtbl.create 10; next = 0 } + +let build t ?base ~id fn = + let result = Path.result t id in + let result_tmp = Path.result_tmp t id in + assert (not (Sys.file_exists result)); (* Builder should have checked first *) + begin match base with + | None -> Lwt.return (Os.ensure_dir result_tmp) + | Some base -> Qemu_img.snapshot `RW ~src:(Path.result t base) result_tmp + end + >>= fun () -> + Lwt.try_bind + (fun () -> fn result_tmp) + (fun r -> + begin match r with + | Ok () -> Os.mv ~src:result_tmp result + | Error _ -> Os.rm ~directory:result_tmp + end >>= fun () -> + Lwt.return r + ) + (fun ex -> + Log.warn (fun f -> f "Uncaught exception from %S build function: %a" id Fmt.exn ex); + Os.rm ~directory:result_tmp >>= fun () -> + Lwt.reraise ex + ) + +let result t id = + let dir = Path.result t id in + match Os.check_dir dir with + | `Present -> Lwt.return_some dir + | `Missing -> Lwt.return_none + +let log_file t id = + result t id >|= function + | Some dir -> dir / "log" + | None -> (Path.result_tmp t id) / "log" + +let get_cache t name = + match Hashtbl.find_opt t.caches name with + | Some c -> c + | None -> + let c = { lock = Lwt_mutex.create (); children = 0 } in + Hashtbl.add t.caches name c; + c + +let cache ~user:_ t name : (string * (unit -> unit Lwt.t)) Lwt.t = + let cache = get_cache t name in + Lwt_mutex.with_lock cache.lock @@ fun () -> + let tmp = Path.cache_tmp t t.next name in + t.next <- t.next + 1; + let master = Path.cache t name in + (* Create cache if it doesn't already exist. *) + let () = match Os.check_dir master with + | `Missing -> Os.ensure_dir master + | `Present -> () in + cache.children <- cache.children + 1; + let () = Os.ensure_dir tmp in + Os.cp ~src:master tmp >>= fun () -> + let release () = + Lwt_mutex.with_lock cache.lock @@ fun () -> + cache.children <- cache.children - 1; + Os.cp ~src:tmp master >>= fun () -> + Os.rm ~directory:tmp + in + Lwt.return (tmp, release) + +let delete_cache t name = + let cache = get_cache t name in + Lwt_mutex.with_lock cache.lock @@ fun () -> + if cache.children > 0 + then Lwt_result.fail `Busy + else + let snapshot = Path.cache t name in + if Sys.file_exists snapshot then ( + Os.rm ~directory:snapshot >>= fun () -> + Lwt_result.return () + ) else Lwt_result.return () + +let state_dir = Path.state + +let complete_deletes _ = + Lwt.return_unit diff --git a/lib/qemu_store.mli b/lib/qemu_store.mli new file mode 100644 index 00000000..dd7cfe55 --- /dev/null +++ b/lib/qemu_store.mli @@ -0,0 +1,7 @@ +(** Store build results using qemu-img. *) + +include S.STORE + +val create : root:string -> t Lwt.t +(** [create ~path] creates a new overlayfs store where everything will + be stored under [path]. *) diff --git a/lib/s.ml b/lib/s.ml index 5aad754e..4eca293e 100644 --- a/lib/s.ml +++ b/lib/s.ml @@ -89,6 +89,21 @@ module type SANDBOX = sig @param log Used for child's stdout and stderr. *) + val tar_in : + cancelled:unit Lwt.t -> + ?stdin:Os.unix_fd -> + log:Build_log.t -> + t -> + Config.t -> + string -> + (unit, [`Cancelled | `Msg of string]) Lwt_result.t + (** [run ~cancelled t config dir] runs the operation [config] in a sandbox with root + filesystem [dir]. + @param cancelled Resolving this kills the process (and returns [`Cancelled]). + @param stdin Passed to child as its standard input. + @param log Used for child's stdout and stderr. + *) + val finished : unit -> unit Lwt.t end @@ -122,6 +137,9 @@ module type BUILDER = sig val count : t -> int64 (** [count t] return number of items in the store. *) + val root : t -> string + (** [root t] returns the root of the store. *) + val df : t -> float Lwt.t (** [df t] returns the percentage of free space in the store. *) @@ -135,10 +153,10 @@ module type BUILDER = sig end module type FETCHER = sig - val fetch : log:Build_log.t -> rootfs:string -> string -> Config.env Lwt.t - (** [fetch ~log ~rootfs base] initialises the [rootfs] directory by - fetching and extracting the [base] image. - Returns the image's environment. + val fetch : log:Build_log.t -> root:string -> rootfs:string -> string -> Config.env Lwt.t + (** [fetch ~log ~root ~rootfs base] initialises the [rootfs] + directory by fetching and extracting the [base] image. [root] + is the root of the store. Returns the image's environment. @param log Used for outputting the progress of the fetch @param rootfs The directory in which to extract the base image *) end diff --git a/lib/sandbox.runc.ml b/lib/sandbox.runc.ml index 26045fc9..1870e5d5 100644 --- a/lib/sandbox.runc.ml +++ b/lib/sandbox.runc.ml @@ -318,6 +318,9 @@ let run ~cancelled ?stdin:stdin ~log t config results_dir = if Lwt.is_sleeping cancelled then Lwt.return (r :> (unit, [`Msg of string | `Cancelled]) result) else Lwt_result.fail `Cancelled +let tar_in ~cancelled ?stdin ~log t config result_tmp = + run ~cancelled ?stdin ~log t config result_tmp + let clean_runc dir = Sys.readdir dir |> Array.to_list diff --git a/lib/store_spec.ml b/lib/store_spec.ml index ce8e1758..173142cf 100644 --- a/lib/store_spec.ml +++ b/lib/store_spec.ml @@ -9,6 +9,7 @@ type t = [ | `Xfs of string (* Path *) | `Overlayfs of string (* Path *) | `Docker of string (* Path *) + | `Qemu of string (* Path *) ] let is_absolute path = not (Filename.is_relative path) @@ -21,7 +22,8 @@ let of_string s = | Some ("xfs", path) when is_absolute path -> Ok (`Xfs path) | Some ("overlayfs", path) when is_absolute path -> Ok (`Overlayfs path) | Some ("docker", path) -> Ok (`Docker path) - | _ -> Error (`Msg "Store must start with zfs:, btrfs:/, rsync:/, xfs:/ or overlayfs:") + | Some ("qemu", path) -> Ok (`Qemu path) + | _ -> Error (`Msg "Store must start with zfs:, btrfs:/, rsync:/, xfs:/, qemu:/ or overlayfs:") let pp f = function | `Zfs path -> Fmt.pf f "zfs:%s" path @@ -30,6 +32,7 @@ let pp f = function | `Xfs path -> Fmt.pf f "xfs:%s" path | `Overlayfs path -> Fmt.pf f "overlayfs:%s" path | `Docker path -> Fmt.pf f "docker:%s" path + | `Qemu path -> Fmt.pf f "qemu:%s" path type store = Store : (module S.STORE with type t = 'a) * 'a -> store @@ -52,6 +55,9 @@ let to_store = function | `Docker path -> `Docker, Docker_store.create path >|= fun store -> Store ((module Docker_store), store) + | `Qemu root -> + `Qemu, Qemu_store.create ~root >|= fun store -> + Store ((module Qemu_store), store) open Cmdliner @@ -60,7 +66,7 @@ let store_t = Arg.conv (of_string, pp) let store ?docs names = Arg.opt Arg.(some store_t) None @@ Arg.info - ~doc:"$(docv) must be one of $(b,btrfs:/path), $(b,rsync:/path), $(b,xfs:/path), $(b,overlayfs:/path), $(b,zfs:pool) or $(b,docker:path) for the OBuilder cache." + ~doc:"$(docv) must be one of $(b,btrfs:/path), $(b,rsync:/path), $(b,xfs:/path), $(b,overlayfs:/path), $(b,zfs:pool), $(b,qmu:/path) or $(b,docker:path) for the OBuilder cache." ~docv:"STORE" ?docs names @@ -95,7 +101,8 @@ let of_t store rsync_mode = | Some (`Xfs path), None -> (`Xfs path) | Some (`Overlayfs path), None -> (`Overlayfs path) | Some (`Docker path), None -> (`Docker path) - | _, _ -> failwith "Store type required must be one of btrfs:/path, rsync:/path, xfs:/path, zfs:pool or docker:path for the OBuilder cache." + | Some (`Qemu path), None -> (`Qemu path) + | _, _ -> failwith "Store type required must be one of btrfs:/path, rsync:/path, xfs:/path, zfs:pool, qemu:/path or docker:path for the OBuilder cache." (** Parse cli arguments for t *) let v = diff --git a/lib/zfs_clone.ml b/lib/zfs_clone.ml index e7f930ec..3a281166 100644 --- a/lib/zfs_clone.ml +++ b/lib/zfs_clone.ml @@ -10,7 +10,7 @@ let ( / ) = Filename.concat rootfs = "/Volumes/obuilder/result/522fb2a0e81ba278bc1ae7314bd754201505e6493f4f2f40a166c416624a4005/rootfs" with base = "busybox", or base = "macos-homebrew-ocaml-4.14" -> clone home and brew subvolumes *) -let fetch ~log:_ ~rootfs base = +let fetch ~log:_ ~root:_ ~rootfs base = let path = let remove_on_match s lst = if List.hd lst = s then List.tl lst else lst in String.split_on_char '/' rootfs diff --git a/main.ml b/main.ml index 76e0c735..c6c26a00 100644 --- a/main.ml +++ b/main.ml @@ -4,9 +4,11 @@ let ( / ) = Filename.concat module Native_sandbox = Obuilder.Native_sandbox module Docker_sandbox = Obuilder.Docker_sandbox +module Qemu_sandbox = Obuilder.Qemu_sandbox module Docker_store = Obuilder.Docker_store module Docker_extract = Obuilder.Docker_extract module Archive_extract = Obuilder.Archive_extract +module Qemu_snapshot = Obuilder.Qemu_snapshot module Store_spec = Obuilder.Store_spec type builder = Builder : (module Obuilder.BUILDER with type t = 'a) * 'a -> builder @@ -31,20 +33,28 @@ let create_docker_builder store_spec conf = let builder = Builder.v ~store ~sandbox in Builder ((module Builder), builder) +let create_qemu_builder store_spec conf = + store_spec >>= fun (Store_spec.Store ((module Store), store)) -> + let module Builder = Obuilder.Builder (Store) (Qemu_sandbox) (Qemu_snapshot) in + Qemu_sandbox.create conf >|= fun sandbox -> + let builder = Builder.v ~store ~sandbox in + Builder ((module Builder), builder) + let read_whole_file path = let ic = open_in_bin path in Fun.protect ~finally:(fun () -> close_in ic) @@ fun () -> let len = in_channel_length ic in really_input_string ic len -let select_backend (sandbox, store_spec) native_conf docker_conf = +let select_backend (sandbox, store_spec) native_conf docker_conf qemu_conf = match sandbox with | `Native -> create_builder store_spec native_conf | `Docker -> create_docker_builder store_spec docker_conf + | `Qemu -> create_qemu_builder store_spec qemu_conf -let build () store spec native_conf docker_conf src_dir secrets = +let build () store spec native_conf docker_conf qemu_conf src_dir secrets = Lwt_main.run begin - select_backend store native_conf docker_conf + select_backend store native_conf docker_conf qemu_conf >>= fun (Builder ((module Builder), builder)) -> Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ fun () -> let spec = @@ -67,9 +77,9 @@ let build () store spec native_conf docker_conf src_dir secrets = exit 1 end -let healthcheck () store native_conf docker_conf = +let healthcheck () store native_conf docker_conf qemu_conf = Lwt_main.run begin - select_backend store native_conf docker_conf + select_backend store native_conf docker_conf qemu_conf >>= fun (Builder ((module Builder), builder)) -> Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ fun () -> Builder.healthcheck builder >|= function @@ -80,17 +90,17 @@ let healthcheck () store native_conf docker_conf = Fmt.pr "Healthcheck passed@." end -let delete () store native_conf docker_conf id = +let delete () store native_conf docker_conf qemu_conf id = Lwt_main.run begin - select_backend store native_conf docker_conf + select_backend store native_conf docker_conf qemu_conf >>= fun (Builder ((module Builder), builder)) -> Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ fun () -> Builder.delete builder id ~log:(fun id -> Fmt.pr "Removing %s@." id) end -let clean () store native_conf docker_conf = +let clean () store native_conf docker_conf qemu_conf = Lwt_main.run begin - select_backend store native_conf docker_conf + select_backend store native_conf docker_conf qemu_conf >>= fun (Builder ((module Builder), builder)) -> Fun.flip Lwt.finalize (fun () -> Builder.finish builder) @@ begin fun () -> let now = Unix.(gmtime (gettimeofday ())) in @@ -157,21 +167,21 @@ let build = let info = Cmd.info "build" ~doc in Cmd.v info Term.(const build $ setup_log $ store $ spec_file $ Native_sandbox.cmdliner - $ Docker_sandbox.cmdliner $ src_dir $ secrets) + $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ src_dir $ secrets) let delete = let doc = "Recursively delete a cached build result." in let info = Cmd.info "delete" ~doc in Cmd.v info Term.(const delete $ setup_log $ store $ Native_sandbox.cmdliner - $ Docker_sandbox.cmdliner $ id) + $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner $ id) let clean = let doc = "Clean all cached build results." in let info = Cmd.info "clean" ~doc in Cmd.v info Term.(const clean $ setup_log $ store $ Native_sandbox.cmdliner - $ Docker_sandbox.cmdliner) + $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner) let buildkit = Arg.value @@ @@ -200,7 +210,7 @@ let healthcheck = let info = Cmd.info "healthcheck" ~doc in Cmd.v info Term.(const healthcheck $ setup_log $ store $ Native_sandbox.cmdliner - $ Docker_sandbox.cmdliner) + $ Docker_sandbox.cmdliner $ Qemu_sandbox.cmdliner) let cmds = [build; delete; clean; dockerfile; healthcheck] diff --git a/qemu/Makefile b/qemu/Makefile new file mode 100644 index 00000000..60462c90 --- /dev/null +++ b/qemu/Makefile @@ -0,0 +1,43 @@ + +all: windows-server-2022-x86_64-ocaml-4.14.img ubuntu-noble-x86_64-ocaml-4.14.img + +clean: + rm -f unattend.iso seed.iso ubuntu-noble-x86_64-ocaml-4.14.img windows-server-2022-x86_64-ocaml-4.14.img + +# Windows + +windows-server-2022-x86_64-ocaml-4.14.img: unattend.iso + qemu-img create -f qcow2 windows-server-2022-x86_64-ocaml-4.14.img 40G + qemu-system-x86_64 -m 16G -smp 8 -machine accel=kvm,type=q35 -drive file=windows-server-2022-x86_64-ocaml-4.14.img -drive file=SW_DVD9_Win_Server_STD_CORE_2022_2108.6_64Bit_English_DC_STD_MLF_X23-03231.ISO,media=cdrom -drive file=unattend.iso,media=cdrom -cpu host -display none -vnc :0 -nic user,hostfwd=tcp::60022-:22 + # -drive file=virtio-win.iso,media=cdrom + +unattend.iso: autounattend.xml id_ed25519.pub openssh-win64.msi opam-2.2.exe opam-dev.exe setup-x86_64.exe + mkisofs -o unattend.iso -r -J autounattend.xml id_ed25519.pub openssh-win64.msi opam-2.2.exe opam-dev.exe setup-x86_64.exe + +opam-2.2.exe: + curl -L https://github.com/ocaml/opam/releases/download/2.2.1/opam-2.2.1-x86_64-windows.exe -o opam-2.2.exe + +opam-dev.exe: + curl -L https://github.com/ocaml/opam/releases/download/2.3.0-beta1/opam-2.3.0-beta1-x86_64-windows.exe -o opam-dev.exe + +openssh-win64.msi: + curl -L https://github.com/PowerShell/Win32-OpenSSH/releases/download/v9.2.2.0p1-Beta/OpenSSH-Win64-v9.2.2.0.msi -o openssh-win64.msi + +setup-x86_64.exe: + curl -L https://www.cygwin.com/setup-x86_64.exe -o setup-x86_64.exe + +virtio-win.iso: + curl -L https://fedorapeople.org/groups/virt/virtio-win/direct-downloads/archive-virtio/virtio-win-0.1.262-2/virtio-win.iso -o virtio-win.iso + +# Ubuntu + +seed.iso: user-data.yaml + cloud-localds seed.iso user-data.yaml + +ubuntu-noble-x86_64-ocaml-4.14.img: noble-server-cloudimg-amd64.img seed.iso + qemu-img create -f qcow2 -b noble-server-cloudimg-amd64.img -F qcow2 ubuntu-noble-x86_64-ocaml-4.14.img 20G + qemu-system-x86_64 -m 16G -smp 8 -machine accel=kvm,type=q35 -drive file=ubuntu-noble-x86_64-ocaml-4.14.img -drive file=seed.iso,format=raw -cpu host -display none -vnc :0 -nic user,hostfwd=tcp::60022-:22 + +noble-server-cloudimg-amd64.img: + curl -L https://cloud-images.ubuntu.com/noble/current/noble-server-cloudimg-amd64.img -o noble-server-cloudimg-amd64.img + diff --git a/qemu/autounattend.xml b/qemu/autounattend.xml new file mode 100644 index 00000000..3affbcfe --- /dev/null +++ b/qemu/autounattend.xml @@ -0,0 +1,309 @@ + + + + + + + + en-US + + en-US + en-US + en-US + en-US + en-US + + + + + + + 1 + BypassTPMCheck + cmd /c reg add "HKLM\SYSTEM\Setup\LabConfig" /v "BypassTPMCheck" /t REG_DWORD /d 1 + + + 2 + BypassSecureBootCheck + cmd /c reg add "HKLM\SYSTEM\Setup\LabConfig" /v "BypassSecureBootCheck" /t REG_DWORD /d 1 + + + 3 + BypassRAMCheck + cmd /c reg add "HKLM\SYSTEM\Setup\LabConfig" /v "BypassRAMCheck" /t REG_DWORD /d 1 + + + + + + + + Primary + 1 + 350 + + + 2 + Primary + true + + + + + true + NTFS + 1 + 1 + + + NTFS + C + 2 + 2 + + + 0 + true + + + + + + + + + /IMAGE/NAME + Windows Server 2022 SERVERSTANDARDCORE + + + + + 0 + 2 + + + OnError + + + + + + + OnError + + true + + + + + + + + + + + Audit + + + + + + + + + 1 + cmd /C wmic useraccount where "name='Administrator'" set PasswordExpires=FALSE + PasswordExpires=FALSE + + + + 2 + powershell.exe -NoProfile -ExecutionPolicy Bypass -Command "Set-NetConnectionProfile -NetworkCategory Private -InputObject (Get-NetConnectionProfile)" + NetworkLocation + + + + 3 + winrm quickconfig -q + Configure WinRM + + + + 4 + winrm set winrm/config/service @{AllowUnencrypted="true"} + Configure WinRM + + + + 5 + winrm set winrm/config/service/auth @{Basic="true"} + Configure WinRM + + + + 6 + netsh advfirewall firewall set rule group="remote administration" new enable=yes + Configure WinRM + + + + 7 + net stop winrm + Configure WinRM + + + + 8 + net start winrm + Configure WinRM + + + + 9 + cmd /c "copy e:\setup-x86_64.exe c:\windows\setup-x86_64.exe" + Copy cygwin executable + + + + 10 + c:\windows\setup-x86_64.exe -q -O -s https://cygwin.mirror.uk.sargasso.net -P mingw64-x86_64-gcc-core,rsync,git,make,patch,unzip,pkgconf,pkg-config + Install cygwin + + + + 11 + setx /m PATH "c:\cygwin64\bin;c:\cygwin64\usr\x86_64-w64-mingw32\sys-root\mingw\bin;%PATH%" + Set PATH environment variable + + + + 12 + setx /m OPAMCONFIRMLEVEL unsafe-yes + Set PATH environment variable + + + + 13 + setx /m OPAMYES 1 + Set PATH environment variable + + + + 14 + reg add HKLM\SOFTWARE\OpenSSH /v DefaultShell /d c:\cygwin64\bin\bash.exe + Configure WinRM + + + + 15 + cmd /c "msiexec /q /norestart /i e:\openssh-win64.msi" + Install OpenSSH + + + + 16 + cmd /c "copy e:\id_ed25519.pub c:\programdata\ssh\administrators_authorized_keys" + Install public key + + + + 17 + cmd /c "echo AcceptENV * >> c:\programdata\ssh\sshd_config" + Install public key + + + + 18 + netsh advfirewall firewall set rule group="OpenSSH SSH Server Preview (sshd)" new profile=any enable=yes + Configure OpenSSH + + + + 19 + cmd /c "copy e:\opam-2.2.exe c:\cygwin64\bin\opam.exe" + Copy opam executable + + + + 20 + cmd /c "copy e:\opam-2.2.exe c:\cygwin64\bin\opam-2.2.exe" + Copy opam executable + + + + 21 + cmd /c "copy e:\opam-dev.exe c:\cygwin64\bin\opam-dev.exe" + Copy opam executable + + + + 22 + c:\cygwin64\bin\bash.exe --login -c "cd /cygdrive/c/Users/opam && git clone https://github.com/ocaml/opam-repository" + Add opam-repository + + + + 23 + opam init -y -k local -a c:\users\opam\opam-repository --bare --cygwin-location=c:\cygwin64 + Opam init + + + + 24 + opam switch create 4.14 --packages=ocaml-base-compiler.4.14.2 + Opam switch + + + + 25 + opam pin add -k version ocaml-base-compiler 4.14.2 + Opam switch + + + + + + + + + + + + + + + + opam + true</PlainText> + </AdministratorPassword> + + <LocalAccounts> + <LocalAccount wcm:action="add"> + <Password> + <Value>opam</Value> + <PlainText>true</PlainText> + </Password> + <Group>administrators</Group> + <DisplayName>opam</DisplayName> + <Name>opam</Name> + <Description>Opam User</Description> + </LocalAccount> + </LocalAccounts> + + </UserAccounts> + + <AutoLogon> + <Enabled>true</Enabled> + <LogonCount>3</LogonCount> + <Username>opam</Username> + <Password> + <Value>opam</Value> + <PlainText>true</PlainText> + </Password> + </AutoLogon> + + </component> + + </settings> + +</unattend> diff --git a/qemu/id_ed25519.pub b/qemu/id_ed25519.pub new file mode 100644 index 00000000..70310ce0 --- /dev/null +++ b/qemu/id_ed25519.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIA09mqKPpMJ4tyOpl4l+KTTl1DqjFT2mRD29HW8VwnmB root@alpha diff --git a/qemu/user-data.yaml b/qemu/user-data.yaml new file mode 100644 index 00000000..99530235 --- /dev/null +++ b/qemu/user-data.yaml @@ -0,0 +1,22 @@ +#cloud-config +users: + - name: opam + groups: [sudo] + sudo: ALL=(ALL) NOPASSWD:ALL + shell: /bin/bash + passwd: opam + ssh_authorized_keys: + - ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIA09mqKPpMJ4tyOpl4l+KTTl1DqjFT2mRD29HW8VwnmB root@alpha +runcmd: + - echo "AcceptEnv=*" > /etc/ssh/sshd_config.d/acceptenv.conf + - curl -L https://github.com/ocaml/opam/releases/download/2.2.1/opam-2.2.1-x86_64-linux -o /usr/bin/opam + - chmod +x /usr/bin/opam + - apt install build-essential unzip bubblewrap -y + - su - opam -c "git clone https://github.com/ocaml/opam-repository" + - su - opam -c "opam init -k local -a /home/opam/opam-repository --bare" + - su - opam -c "rm -rf .opam/repo/default/.git" + - su - opam -c "echo export OPAMYES=1 OPAMCONFIRMLEVEL=unsafe-yes OPAMERRLOGLEN=0 OPAMPRECISETRACKING=1 >> .profile" + - su - opam -c "opam switch create 4.14 --packages=ocaml-base-compiler.4.14.2" + - su - opam -c "opam pin add -k version ocaml-base-compiler 4.14.2" + - su - opam -c "opam install -y opam-depext" + - poweroff diff --git a/test/mock_sandbox.ml b/test/mock_sandbox.ml index 57dbf5ee..3a325708 100644 --- a/test/mock_sandbox.ml +++ b/test/mock_sandbox.ml @@ -21,6 +21,9 @@ let run ~cancelled ?stdin ~log t (config:Obuilder.Config.t) dir = | ex -> Lwt_result.fail (`Msg (Printexc.to_string ex)) ) +let tar_in ~cancelled ?stdin ~log t config result_tmp = + run ~cancelled ?stdin ~log t config result_tmp + let create () = { expect = Queue.create () } let finished () = Lwt.return ()