+91 -5

README.md

··· 11 11 ``` 12 12 13 13 14 14 - Windows 14 14 + # Windows 15 15 + 16 16 + Remove Windows Defender 15 17 16 18 ``` 17 17 - winget install git.git --scope machine 18 18 - winget install ocaml.opam --scope machine 19 19 + dism /online /disable-feature /featurename:Windows-Defender /remove /norestart 19 20 ``` 21 21 + 22 22 + Install OpenSSH and configure (Windows Server 2022 only) 20 23 21 24 ``` 25 25 + curl.exe -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 26 26 + start /wait msiexec /q /norestart /i openssh-win64.msi 27 27 + copy id_ed25519.pub c:\programdata\ssh\administrators_authorized_keys 28 28 + netsh advfirewall firewall set rule name="OpenSSH SSH Server Preview (sshd)" new profile=any enable=yes 29 29 + ``` 30 30 + 31 31 + On Windows Server 2025, SSHD is already installed, but not enabled. 32 32 + 33 33 + ``` 34 34 + sc config sshd start=auto 35 35 + net start sshd 36 36 + copy id_ed25519.pub c:\programdata\ssh\administrators_authorized_keys 37 37 + netsh advfirewall firewall set rule name="OpenSSH SSH Server (sshd)" new profile=any enable=yes 38 38 + ``` 39 39 + 40 40 + Install Git and ensure you restart your shell before continuing. 41 41 + 42 42 + ``` 43 43 + curl.exe -L https://github.com/git-for-windows/git/releases/download/v2.50.0.windows.1/Git-2.50.0-64-bit.exe -o c:\windows\temp\git.exe 44 44 + start /wait c:\windows\temp\git.exe /VERYSILENT /NORESTART /NOCANCEL /SP- /CLOSEAPPLICATIONS /RESTARTAPPLICATIONS /TASKS="addtopath" 45 45 + ``` 46 46 + 47 47 + Install Containerd. On the last line selection `ltsc2025` if using Windows Server 2025. 48 48 + 49 49 + ``` 50 50 + curl.exe https://raw.githubusercontent.com/microsoft/Windows-Containers/refs/heads/Main/helpful_tools/Install-ContainerdRuntime/install-containerd-runtime.ps1 -o install-containerd-runtime.ps1 51 51 + Set-ExecutionPolicy Bypass 52 52 + .\install-containerd-runtime.ps1 -ContainerDVersion 2.1.3 -WinCNIVersion 0.3.1 -ExternalNetAdapter Ethernet -ContainerBaseImage mcr.microsoft.com/windows/servercore:ltsc2022 53 53 + ``` 54 54 + 55 55 + Create `C:\Program Files\containerd\cni\conf\0-containerd-nat.conf` containing 56 56 + 57 57 + ``` 58 58 + { 59 59 + "cniVersion": "0.3.0", 60 60 + "name": "nat", 61 61 + "type": "nat", 62 62 + "master": "Ethernet", 63 63 + "ipam": { 64 64 + "subnet": "172.20.0.0/16", 65 65 + "routes": [ 66 66 + { 67 67 + "gateway": "172.20.0.1" 68 68 + } 69 69 + ] 70 70 + }, 71 71 + "capabilities": { 72 72 + "portMappings": true, 73 73 + "dns": true 74 74 + } 75 75 + } 76 76 + ``` 77 77 + 78 78 + Install opam 79 79 + 80 80 + ``` 81 81 + curl.exe -L https://github.com/ocaml/opam/releases/download/2.3.0/opam-2.3.0-x86_64-windows.exe -o c:\windows\opam.exe 82 82 + opam init -y 83 83 + ``` 84 84 + 85 85 + Download and build mtelvers/hcn-namespace 86 86 + 87 87 + ``` 88 88 + git clone https://github.com/mtelvers/hcn-namespace 89 89 + cd hcn-namespace 90 90 + opam install . --deps-only 91 91 + for /f "tokens=*" %i in ('opam env') do @%i 22 92 dune build 23 23 - _build\install\default\bin\day10.exe health-check --cache-dir c:\Users\Administrator\cache --opam-repository c:\Users\Administrator\opam-repository 0install.2.18 93 93 + copy _build\install\default\bin\hcn-namespace.exe %LocalAppData%\opam\.cygwin\root\usr\local\bin 24 94 ``` 25 95 96 96 + Build this project 97 97 + 26 98 ``` 27 27 - make -j 2 SYSTEM=windows-x86_64 OUTPUT_DIR=./output CACHE_DIR=c:\\Users\\Administrator\\cache OPAM_REPO=c:\\Users\\Administrator\\opam-repository all 99 99 + git clone https://github.com/mtelvers/ohc -b tool 100 100 + cd ohc 101 101 + opam install . --deps-only 102 102 + dune build 28 103 ``` 104 104 + 105 105 + Run 106 106 + 107 107 + ``` 108 108 + git clone http://github.com/ocaml/opam-repository c:\opam-repository 109 109 + mkdir c:\cache 110 110 + make -j 6 SYSTEM=windows-x86_64 OUTPUT_DIR=./output CACHE_DIR=c:\\cache OPAM_REPO=c:\\opam-repository all 111 111 + ``` 112 112 + 113 113 + 114 114 + 29 115 30 116 Next commit 31 117

+7

bin/config.ml

··· 1 1 + type t = { 2 2 + dir : string; 3 3 + opam_repository : string; 4 4 + package : string; 5 5 + directory : string option; 6 6 + md : string option; 7 7 + }

+43 -65

bin/dir_context.ml

··· 8 8 9 9 let with_dir path fn = 10 10 let ch = Unix.opendir path in 11 11 - Fun.protect ~finally:(fun () -> Unix.closedir ch) 12 12 - (fun () -> fn ch) 11 11 + Fun.protect ~finally:(fun () -> Unix.closedir ch) (fun () -> fn ch) 13 12 14 13 let list_dir path = 15 14 let rec aux acc ch = ··· 23 22 env : string -> OpamVariable.variable_contents option; 24 23 packages_dir : string; 25 24 pins : (OpamPackage.Version.t * OpamFile.OPAM.t) OpamPackage.Name.Map.t; 26 26 - constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *) 25 25 + constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *) 27 26 test : OpamPackage.Name.Set.t; 28 27 prefer_oldest : bool; 29 28 } ··· 33 32 match OpamPackage.Name.Map.find_opt name t.pins with 34 33 | Some (_, opam) -> opam 35 34 | None -> 36 36 - let opam_path = t.packages_dir / OpamPackage.Name.to_string name / OpamPackage.to_string pkg / "opam" in 37 37 - OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw opam_path)) 35 35 + let opam_path = t.packages_dir / OpamPackage.Name.to_string name / OpamPackage.to_string pkg / "opam" in 36 36 + OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw opam_path)) 38 37 39 39 - let user_restrictions t name = 40 40 - OpamPackage.Name.Map.find_opt name t.constraints 41 41 - 38 38 + let user_restrictions t name = OpamPackage.Name.Map.find_opt name t.constraints 42 39 let dev = OpamPackage.Version.of_string "dev" 43 40 44 44 - let std_env 45 45 - ?(ocaml_native=true) 46 46 - ?sys_ocaml_version 47 47 - ?opam_version 48 48 - ~arch ~os ~os_distribution ~os_family ~os_version 49 49 - () = 50 50 - function 41 41 + let std_env ?(ocaml_native = true) ?sys_ocaml_version ?opam_version ~arch ~os ~os_distribution ~os_family ~os_version () = function 51 42 | "arch" -> Some (OpamTypes.S arch) 52 43 | "os" -> Some (OpamTypes.S os) 53 44 | "os-distribution" -> Some (OpamTypes.S os_distribution) 54 45 | "os-version" -> Some (OpamTypes.S os_version) 55 46 | "os-family" -> Some (OpamTypes.S os_family) 56 56 - | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 47 47 + | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 57 48 | "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v) 58 49 | "ocaml:native" -> Some (OpamTypes.B ocaml_native) 59 59 - | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 50 50 + | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 60 51 | v -> 61 61 - OpamConsole.warning "Unknown variable %S" v; 62 62 - None 52 52 + OpamConsole.warning "Unknown variable %S" v; 53 53 + None 63 54 64 55 let env t pkg v = 65 56 if List.mem v OpamPackageVar.predefined_depends_variables then None 66 66 - else match OpamVariable.Full.to_string v with 57 57 + else 58 58 + match OpamVariable.Full.to_string v with 67 59 | "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg))) 68 60 | x -> t.env x 69 61 70 62 let filter_deps t pkg f = 71 63 let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in 72 64 let test = OpamPackage.Name.Set.mem (OpamPackage.name pkg) t.test in 73 73 - f 74 74 - |> OpamFilter.partial_filter_formula (env t pkg) 75 75 - |> OpamFilter.filter_deps ~build:true ~post:true ~test ~doc:false ~dev ~dev_setup:false ~default:false 65 65 + f |> OpamFilter.partial_filter_formula (env t pkg) |> OpamFilter.filter_deps ~build:true ~post:true ~test ~doc:false ~dev ~dev_setup:false ~default:false 76 66 77 77 - let version_compare t v1 v2 = 78 78 - if t.prefer_oldest then 79 79 - OpamPackage.Version.compare v1 v2 80 80 - else 81 81 - OpamPackage.Version.compare v2 v1 67 67 + let version_compare t v1 v2 = if t.prefer_oldest then OpamPackage.Version.compare v1 v2 else OpamPackage.Version.compare v2 v1 82 68 83 69 let candidates t name = 84 70 match OpamPackage.Name.Map.find_opt name t.pins with 85 85 - | Some (version, opam) -> [version, Ok opam] 86 86 - | None -> 87 87 - let versions_dir = t.packages_dir / OpamPackage.Name.to_string name in 88 88 - match list_dir versions_dir with 89 89 - | versions -> 90 90 - let user_constraints = user_restrictions t name in 91 91 - versions 92 92 - |> List.filter_map (fun dir -> 93 93 - match OpamPackage.of_string_opt dir with 94 94 - | Some pkg when Sys.file_exists (versions_dir / dir / "opam") -> Some (OpamPackage.version pkg) 95 95 - | _ -> None 96 96 - ) 97 97 - |> List.sort (version_compare t) 98 98 - |> List.map (fun v -> 99 99 - match user_constraints with 100 100 - | Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> 101 101 - v, Error (UserConstraint (name, Some test)) 102 102 - | _ -> 103 103 - let pkg = OpamPackage.create name v in 104 104 - let opam = load t pkg in 105 105 - let available = OpamFile.OPAM.available opam in 106 106 - match OpamFilter.eval ~default:(B false) (env t pkg) available with 107 107 - | B true -> v, Ok opam 108 108 - | B false -> v, Error Unavailable 109 109 - | _ -> 110 110 - OpamConsole.error "Available expression not a boolean: %s" (OpamFilter.to_string available); 111 111 - v, Error Unavailable 112 112 - ) 113 113 - | exception Unix.Unix_error (Unix.ENOENT, _, _) -> 114 114 - OpamConsole.log "opam-0install" "Package %S not found!" (OpamPackage.Name.to_string name); 115 115 - [] 71 71 + | Some (version, opam) -> [ (version, Ok opam) ] 72 72 + | None -> ( 73 73 + let versions_dir = t.packages_dir / OpamPackage.Name.to_string name in 74 74 + match list_dir versions_dir with 75 75 + | versions -> 76 76 + let user_constraints = user_restrictions t name in 77 77 + versions 78 78 + |> List.filter_map (fun dir -> 79 79 + match OpamPackage.of_string_opt dir with 80 80 + | Some pkg when Sys.file_exists (versions_dir / dir / "opam") -> Some (OpamPackage.version pkg) 81 81 + | _ -> None) 82 82 + |> List.sort (version_compare t) 83 83 + |> List.map (fun v -> 84 84 + match user_constraints with 85 85 + | Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> (v, Error (UserConstraint (name, Some test))) 86 86 + | _ -> ( 87 87 + let pkg = OpamPackage.create name v in 88 88 + let opam = load t pkg in 89 89 + let available = OpamFile.OPAM.available opam in 90 90 + match OpamFilter.eval ~default:(B false) (env t pkg) available with 91 91 + | B true -> (v, Ok opam) 92 92 + | B false -> (v, Error Unavailable) 93 93 + | _ -> 94 94 + OpamConsole.error "Available expression not a boolean: %s" (OpamFilter.to_string available); 95 95 + (v, Error Unavailable))) 96 96 + | exception Unix.Unix_error (Unix.ENOENT, _, _) -> 97 97 + OpamConsole.log "opam-0install" "Package %S not found!" (OpamPackage.Name.to_string name); 98 98 + []) 116 99 117 100 let pp_rejection f = function 118 101 | UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x) 119 102 | Unavailable -> Fmt.string f "Availability condition not satisfied" 120 103 121 121 - let create 122 122 - ?(prefer_oldest=false) 123 123 - ?(test=OpamPackage.Name.Set.empty) 124 124 - ?(pins=OpamPackage.Name.Map.empty) 125 125 - ~constraints ~env packages_dir = 104 104 + let create ?(prefer_oldest = false) ?(test = OpamPackage.Name.Set.empty) ?(pins = OpamPackage.Name.Map.empty) ~constraints ~env packages_dir = 126 105 { env; packages_dir; pins; constraints; test; prefer_oldest } 127 127 -

-165

bin/json_config.ml

··· 1 1 - type mount = { 2 2 - ty : string; 3 3 - src : string; 4 4 - dst : string; 5 5 - options : string list; 6 6 - } 7 7 - 8 8 - let mount ~ty ~options ~src dst = 9 9 - `Assoc [ ("destination", `String dst); ("type", `String ty); ("source", `String src); ("options", `List (List.map (fun x -> `String x) options)) ] 10 10 - 11 11 - let user_mounts = List.map @@ fun { ty; src; dst; options } -> mount ~ty ~options ~src dst 12 12 - let strings xs = `List (List.map (fun x -> `String x) xs) 13 13 - 14 14 - (* This is a subset of the capabilities that Docker uses by default. 15 15 - These control what root can do in the container. 16 16 - If the init process is non-root, permitted, effective and ambient sets are cleared. 17 17 - See capabilities(7) for full details. *) 18 18 - let default_linux_caps = 19 19 - [ 20 20 - (* Make arbitrary changes to file UIDs and GIDs *) 21 21 - "CAP_CHOWN"; 22 22 - (* Bypass file read, write, and execute permission checks. *) 23 23 - "CAP_DAC_OVERRIDE"; 24 24 - (* Set SUID/SGID bits. *) 25 25 - "CAP_FSETID"; 26 26 - (* Bypass permission checks. *) 27 27 - "CAP_FOWNER"; 28 28 - (* Create special files using mknod. *) 29 29 - "CAP_MKNOD"; 30 30 - (* Make arbitrary manipulations of process GIDs. *) 31 31 - "CAP_SETGID"; 32 32 - (* Make arbitrary manipulations of process UIDs. *) 33 33 - "CAP_SETUID"; 34 34 - (* Set arbitrary capabilities on a file. *) 35 35 - "CAP_SETFCAP"; 36 36 - (* Add any capability from bounding set to inheritable set. *) 37 37 - "CAP_SETPCAP"; 38 38 - (* Use chroot. *) 39 39 - "CAP_SYS_CHROOT"; 40 40 - (* Bypass permission checks for sending signals. *) 41 41 - "CAP_KILL"; 42 42 - (* Write records to kernel auditing log. *) 43 43 - "CAP_AUDIT_WRITE"; 44 44 - ] 45 45 - 46 46 - let make ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t = 47 47 - `Assoc 48 48 - [ 49 49 - ("ociVersion", `String "1.0.1-dev"); 50 50 - ( "process", 51 51 - `Assoc 52 52 - [ 53 53 - ("terminal", `Bool false); 54 54 - ("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]); 55 55 - ("args", strings argv); 56 56 - ("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env)); 57 57 - ("cwd", `String cwd); 58 58 - ( "capabilities", 59 59 - `Assoc 60 60 - [ 61 61 - (* Limits capabilities gained on execve. *) 62 62 - ("bounding", strings default_linux_caps); 63 63 - (* Checked by kernel to decide access *) 64 64 - ("effective", strings default_linux_caps); 65 65 - (* Preserved across an execve (if root, or cap in ambient set) *) 66 66 - ("inheritable", strings default_linux_caps); 67 67 - (* Limiting superset for the effective capabilities *) 68 68 - ("permitted", strings default_linux_caps); 69 69 - ] ); 70 70 - ("rlimits", `List [ `Assoc [ ("type", `String "RLIMIT_NOFILE"); ("hard", `Int 1024); ("soft", `Int 1024) ] ]); 71 71 - ("noNewPrivileges", `Bool false); 72 72 - ] ); 73 73 - ("root", `Assoc [ ("path", `String root); ("readonly", `Bool false) ]); 74 74 - ("hostname", `String hostname); 75 75 - ( "mounts", 76 76 - `List 77 77 - (user_mounts mounts 78 78 - @ [ 79 79 - mount "/proc" ~options:[ (* TODO: copy to others? *) "nosuid"; "noexec"; "nodev" ] ~ty:"proc" ~src:"proc"; 80 80 - mount "/tmp" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "noatime"; "nodev"; "noexec"; "mode=1777" ]; 81 81 - mount "/dev" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "strictatime"; "mode=755"; "size=65536k" ]; 82 82 - mount "/dev/pts" ~ty:"devpts" ~src:"devpts" ~options:[ "nosuid"; "noexec"; "newinstance"; "ptmxmode=0666"; "mode=0620"; "gid=5" (* tty *) ]; 83 83 - mount "/sys" (* This is how Docker does it. runc's default is a bit different. *) ~ty:"sysfs" ~src:"sysfs" 84 84 - ~options:[ "nosuid"; "noexec"; "nodev"; "ro" ]; 85 85 - mount "/sys/fs/cgroup" ~ty:"cgroup" ~src:"cgroup" ~options:[ "ro"; "nosuid"; "noexec"; "nodev" ]; 86 86 - mount "/dev/shm" ~ty:"tmpfs" ~src:"shm" ~options:[ "nosuid"; "noexec"; "nodev"; "mode=1777"; "size=65536k" ]; 87 87 - mount "/dev/mqueue" ~ty:"mqueue" ~src:"mqueue" ~options:[ "nosuid"; "noexec"; "nodev" ]; 88 88 - ] 89 89 - @ if network then [ mount "/etc/resolv.conf" ~ty:"bind" ~src:"/etc/resolv.conf" ~options:[ "ro"; "rbind"; "rprivate" ] ] else []) ); 90 90 - ( "linux", 91 91 - `Assoc 92 92 - [ 93 93 - ( "namespaces", 94 94 - `List 95 95 - (List.map 96 96 - (fun namespace -> `Assoc [ ("type", `String namespace) ]) 97 97 - ((if network then [] else [ "network" ]) @ [ "pid"; "ipc"; "uts"; "mount" ])) ); 98 98 - ( "maskedPaths", 99 99 - strings 100 100 - [ 101 101 - "/proc/acpi"; 102 102 - "/proc/asound"; 103 103 - "/proc/kcore"; 104 104 - "/proc/keys"; 105 105 - "/proc/latency_stats"; 106 106 - "/proc/timer_list"; 107 107 - "/proc/timer_stats"; 108 108 - "/proc/sched_debug"; 109 109 - "/sys/firmware"; 110 110 - "/proc/scsi"; 111 111 - ] ); 112 112 - ("readonlyPaths", strings [ "/proc/bus"; "/proc/fs"; "/proc/irq"; "/proc/sys"; "/proc/sysrq-trigger" ]); 113 113 - ( "seccomp", 114 114 - `Assoc 115 115 - ([ 116 116 - ("defaultAction", `String "SCMP_ACT_ALLOW"); 117 117 - ( "syscalls", 118 118 - `List 119 119 - [ 120 120 - `Assoc 121 121 - [ 122 122 - (* Sync calls are pointless for the builder, because if the computer crashes then we'll 123 123 - just throw the build dir away and start again. And btrfs sync is really slow. 124 124 - Based on https://bblank.thinkmo.de/using-seccomp-to-filter-sync-operations.html 125 125 - Note: requires runc >= v1.0.0-rc92. *) 126 126 - ("names", strings [ "fsync"; "fdatasync"; "msync"; "sync"; "syncfs"; "sync_file_range" ]); 127 127 - ("action", `String "SCMP_ACT_ERRNO"); 128 128 - ("errnoRet", `Int 0); 129 129 - (* Return error "success" *) 130 130 - ]; 131 131 - ] ); 132 132 - ] 133 133 - @ [ ("architectures", strings [ "SCMP_ARCH_X86_64"; "SCMP_ARCH_X86"; "SCMP_ARCH_X32" ]) ]) ); 134 134 - ] ); 135 135 - ] 136 136 - 137 137 - 138 138 - let make_ctr ~layers ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t = 139 139 - `Assoc 140 140 - [ 141 141 - ("ociVersion", `String "1.1.0"); 142 142 - ( "process", 143 143 - `Assoc 144 144 - [ 145 145 - ("terminal", `Bool false); 146 146 - ("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]); 147 147 - ("args", strings argv); 148 148 - ("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env)); 149 149 - ("cwd", `String cwd); 150 150 - ] ); 151 151 - ("root", `Assoc [ ("path", `String ""); ("readonly", `Bool false) ]); 152 152 - ("hostname", `String hostname); 153 153 - ( "mounts", `List (user_mounts mounts)); 154 154 - ( "windows", 155 155 - `Assoc 156 156 - [ 157 157 - ( "layerFolders", strings layers); 158 158 - ("ignoreFlushesDuringBoot", `Bool true); 159 159 - ("network", `Assoc [ 160 160 - ("allowUnqualifiedDNSQuery", `Bool true); 161 161 - ("networkNamespace", `String network); 162 162 - ]); 163 163 - ] ); 164 164 - ] 165 165 -

-31

bin/json_config.mli

··· 1 1 - type mount = { 2 2 - ty : string; 3 3 - src : string; 4 4 - dst : string; 5 5 - options : string list; 6 6 - } 7 7 - 8 8 - val make : 9 9 - root:string -> 10 10 - cwd:string -> 11 11 - argv:string list -> 12 12 - hostname:string -> 13 13 - uid:int -> 14 14 - gid:int -> 15 15 - env:(string * string) list -> 16 16 - mounts:mount list -> 17 17 - network:bool -> 18 18 - Yojson.Safe.t 19 19 - 20 20 - val make_ctr : 21 21 - layers:string list -> 22 22 - cwd:string -> 23 23 - argv:string list -> 24 24 - hostname:string -> 25 25 - uid:int -> 26 26 - gid:int -> 27 27 - env:(string * string) list -> 28 28 - mounts:mount list -> 29 29 - network:string -> 30 30 - Yojson.Safe.t 31 31 -

+8 -13

bin/json_layers.ml

··· 1 1 - 2 2 - type parent_layer_paths = { 3 3 - parentLayerPaths: string list; [@key "parentLayerPaths"] 4 4 - } [@@deriving yojson] 1 1 + type parent_layer_paths = { parentLayerPaths : string list [@key "parentLayerPaths"] } [@@deriving yojson] 5 2 6 3 type layer = { 7 4 type_ : string; ··· 15 12 raw_source : string; [@key "Source"] 16 13 raw_target : string; [@key "Target"] 17 14 raw_options : string list; [@key "Options"] 18 18 - } [@@deriving yojson] 15 15 + } 16 16 + [@@deriving yojson] 19 17 20 18 let parse_option_string str = 21 19 if String.starts_with ~prefix:"parentLayerPaths=" str then 22 20 try 23 21 let json_part = String.sub str 17 (String.length str - 17) in 24 22 let full_json = "{\"parentLayerPaths\":" ^ json_part ^ "}" in 25 25 - Yojson.Safe.from_string full_json 26 26 - |> parent_layer_paths_of_yojson 27 27 - |> Result.to_option 23 23 + Yojson.Safe.from_string full_json |> parent_layer_paths_of_yojson |> Result.to_option 28 24 with 29 25 | _ -> None 30 30 - else 31 31 - None 26 26 + else None 32 27 33 33 - let layer_of_raw (raw_layer:raw_layer) = 28 28 + let layer_of_raw (raw_layer : raw_layer) = 34 29 { 35 30 type_ = raw_layer.raw_type_; 36 31 source = raw_layer.raw_source; ··· 50 45 let read_layers path = 51 46 let mounts = Os.read_from_file path in 52 47 match parse_layers mounts with 53 53 - | Ok layers -> (layers |> List.map (fun l -> List.map (fun x -> x.parentLayerPaths) l.options) |> List.flatten |> List.flatten) @ (List.map (fun l -> l.source) layers) 48 48 + | Ok layers -> 49 49 + (layers |> List.map (fun l -> List.map (fun x -> x.parentLayerPaths) l.options) |> List.flatten |> List.flatten) @ List.map (fun l -> l.source) layers 54 50 | Error _ -> [] 55 55 -

+243

bin/linux.ml

··· 1 1 + type t = { config : Config.t } 2 2 + 3 3 + let hostname = "builder" 4 4 + 5 5 + let env = 6 6 + [ 7 7 + ("PATH", "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"); 8 8 + ("HOME", "/home/opam"); 9 9 + ("OPAMYES", "1"); 10 10 + ("OPAMCONFIRMLEVEL", "unsafe-yes"); 11 11 + ("OPAMERRLOGLEN", "0"); 12 12 + ("OPAMPRECISETRACKING", "1"); 13 13 + ] 14 14 + 15 15 + let std_env = Util.std_env ~arch:"x86_64" ~os:"linux" ~os_distribution:"debian" ~os_family:"debian" ~os_version:"12" () 16 16 + 17 17 + (* This is a subset of the capabilities that Docker uses by default. 18 18 + These control what root can do in the container. 19 19 + If the init process is non-root, permitted, effective and ambient sets are cleared. 20 20 + See capabilities(7) for full details. *) 21 21 + let default_linux_caps = 22 22 + [ 23 23 + (* Make arbitrary changes to file UIDs and GIDs *) 24 24 + "CAP_CHOWN"; 25 25 + (* Bypass file read, write, and execute permission checks. *) 26 26 + "CAP_DAC_OVERRIDE"; 27 27 + (* Set SUID/SGID bits. *) 28 28 + "CAP_FSETID"; 29 29 + (* Bypass permission checks. *) 30 30 + "CAP_FOWNER"; 31 31 + (* Create special files using mknod. *) 32 32 + "CAP_MKNOD"; 33 33 + (* Make arbitrary manipulations of process GIDs. *) 34 34 + "CAP_SETGID"; 35 35 + (* Make arbitrary manipulations of process UIDs. *) 36 36 + "CAP_SETUID"; 37 37 + (* Set arbitrary capabilities on a file. *) 38 38 + "CAP_SETFCAP"; 39 39 + (* Add any capability from bounding set to inheritable set. *) 40 40 + "CAP_SETPCAP"; 41 41 + (* Use chroot. *) 42 42 + "CAP_SYS_CHROOT"; 43 43 + (* Bypass permission checks for sending signals. *) 44 44 + "CAP_KILL"; 45 45 + (* Write records to kernel auditing log. *) 46 46 + "CAP_AUDIT_WRITE"; 47 47 + ] 48 48 + 49 49 + let strings xs = `List (List.map (fun x -> `String x) xs) 50 50 + 51 51 + let make ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t = 52 52 + `Assoc 53 53 + [ 54 54 + ("ociVersion", `String "1.0.1-dev"); 55 55 + ( "process", 56 56 + `Assoc 57 57 + [ 58 58 + ("terminal", `Bool false); 59 59 + ("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]); 60 60 + ("args", strings argv); 61 61 + ("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env)); 62 62 + ("cwd", `String cwd); 63 63 + ( "capabilities", 64 64 + `Assoc 65 65 + [ 66 66 + (* Limits capabilities gained on execve. *) 67 67 + ("bounding", strings default_linux_caps); 68 68 + (* Checked by kernel to decide access *) 69 69 + ("effective", strings default_linux_caps); 70 70 + (* Preserved across an execve (if root, or cap in ambient set) *) 71 71 + ("inheritable", strings default_linux_caps); 72 72 + (* Limiting superset for the effective capabilities *) 73 73 + ("permitted", strings default_linux_caps); 74 74 + ] ); 75 75 + ("rlimits", `List [ `Assoc [ ("type", `String "RLIMIT_NOFILE"); ("hard", `Int 1024); ("soft", `Int 1024) ] ]); 76 76 + ("noNewPrivileges", `Bool false); 77 77 + ] ); 78 78 + ("root", `Assoc [ ("path", `String root); ("readonly", `Bool false) ]); 79 79 + ("hostname", `String hostname); 80 80 + ( "mounts", 81 81 + `List 82 82 + (Mount.user_mounts mounts 83 83 + @ [ 84 84 + Mount.make "/proc" ~options:[ (* TODO: copy to others? *) "nosuid"; "noexec"; "nodev" ] ~ty:"proc" ~src:"proc"; 85 85 + Mount.make "/tmp" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "noatime"; "nodev"; "noexec"; "mode=1777" ]; 86 86 + Mount.make "/dev" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "strictatime"; "mode=755"; "size=65536k" ]; 87 87 + Mount.make "/dev/pts" ~ty:"devpts" ~src:"devpts" ~options:[ "nosuid"; "noexec"; "newinstance"; "ptmxmode=0666"; "mode=0620"; "gid=5" (* tty *) ]; 88 88 + Mount.make "/sys" (* This is how Docker does it. runc's default is a bit different. *) ~ty:"sysfs" ~src:"sysfs" 89 89 + ~options:[ "nosuid"; "noexec"; "nodev"; "ro" ]; 90 90 + Mount.make "/sys/fs/cgroup" ~ty:"cgroup" ~src:"cgroup" ~options:[ "ro"; "nosuid"; "noexec"; "nodev" ]; 91 91 + Mount.make "/dev/shm" ~ty:"tmpfs" ~src:"shm" ~options:[ "nosuid"; "noexec"; "nodev"; "mode=1777"; "size=65536k" ]; 92 92 + Mount.make "/dev/mqueue" ~ty:"mqueue" ~src:"mqueue" ~options:[ "nosuid"; "noexec"; "nodev" ]; 93 93 + ] 94 94 + @ if network then [ Mount.make "/etc/resolv.conf" ~ty:"bind" ~src:"/etc/resolv.conf" ~options:[ "ro"; "rbind"; "rprivate" ] ] else []) ); 95 95 + ( "linux", 96 96 + `Assoc 97 97 + [ 98 98 + ( "namespaces", 99 99 + `List 100 100 + (List.map 101 101 + (fun namespace -> `Assoc [ ("type", `String namespace) ]) 102 102 + ((if network then [] else [ "network" ]) @ [ "pid"; "ipc"; "uts"; "mount" ])) ); 103 103 + ( "maskedPaths", 104 104 + strings 105 105 + [ 106 106 + "/proc/acpi"; 107 107 + "/proc/asound"; 108 108 + "/proc/kcore"; 109 109 + "/proc/keys"; 110 110 + "/proc/latency_stats"; 111 111 + "/proc/timer_list"; 112 112 + "/proc/timer_stats"; 113 113 + "/proc/sched_debug"; 114 114 + "/sys/firmware"; 115 115 + "/proc/scsi"; 116 116 + ] ); 117 117 + ("readonlyPaths", strings [ "/proc/bus"; "/proc/fs"; "/proc/irq"; "/proc/sys"; "/proc/sysrq-trigger" ]); 118 118 + ( "seccomp", 119 119 + `Assoc 120 120 + ([ 121 121 + ("defaultAction", `String "SCMP_ACT_ALLOW"); 122 122 + ( "syscalls", 123 123 + `List 124 124 + [ 125 125 + `Assoc 126 126 + [ 127 127 + (* Sync calls are pointless for the builder, because if the computer crashes then we'll 128 128 + just throw the build dir away and start again. And btrfs sync is really slow. 129 129 + Based on https://bblank.thinkmo.de/using-seccomp-to-filter-sync-operations.html 130 130 + Note: requires runc >= v1.0.0-rc92. *) 131 131 + ("names", strings [ "fsync"; "fdatasync"; "msync"; "sync"; "syncfs"; "sync_file_range" ]); 132 132 + ("action", `String "SCMP_ACT_ERRNO"); 133 133 + ("errnoRet", `Int 0); 134 134 + (* Return error "success" *) 135 135 + ]; 136 136 + ] ); 137 137 + ] 138 138 + @ [ ("architectures", strings [ "SCMP_ARCH_X86_64"; "SCMP_ARCH_X86"; "SCMP_ARCH_X32" ]) ]) ); 139 139 + ] ); 140 140 + ] 141 141 + 142 142 + let init ~(config : Config.t) = { config } 143 143 + let deinit ~t:_ = () 144 144 + let config ~t = t.config 145 145 + 146 146 + let run ~t:_ ~temp_dir opam_repository build_log = 147 147 + let rootfs = Os.path [ temp_dir; "fs" ] in 148 148 + let () = Os.mkdir rootfs in 149 149 + let _ = Os.sudo [ "/usr/bin/env"; "bash"; "-c"; "docker export $(docker run -d debian:12) | sudo tar -C " ^ rootfs ^ " -x" ] in 150 150 + let opam = Os.path [ rootfs; "/usr/local/bin/opam" ] in 151 151 + let _ = Os.sudo [ "curl"; "-L"; "https://github.com/ocaml/opam/releases/download/2.3.0/opam-2.3.0-x86_64-linux"; "-o"; opam ] in 152 152 + let _ = Os.sudo [ "sudo"; "chmod"; "+x"; opam ] in 153 153 + let _ = Os.sudo [ "cp"; "/home/mtelvers/opam_build/_build/default/bin/main.exe"; Os.path [ rootfs; "/usr/local/bin/opam-build" ] ] in 154 154 + let etc_hosts = Os.path [ temp_dir; "hosts" ] in 155 155 + let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in 156 156 + let argv = 157 157 + [ 158 158 + "/usr/bin/env"; 159 159 + "bash"; 160 160 + "-c"; 161 161 + String.concat " && " 162 162 + [ 163 163 + "apt update"; 164 164 + "apt upgrade -y"; 165 165 + "apt install build-essential unzip bubblewrap git sudo curl rsync -y"; 166 166 + "adduser --disabled-password --gecos '@opam' --no-create-home --home /home/opam opam"; 167 167 + "chown -R $(id -u opam):$(id -g opam) /home/opam"; 168 168 + {|echo "opam ALL=(ALL:ALL) NOPASSWD:ALL" > /etc/sudoers.d/opam|}; 169 169 + "su - opam -c 'opam init -k local -a /home/opam/opam-repository --bare -y'"; 170 170 + "su - opam -c 'opam switch create default --empty'"; 171 171 + ]; 172 172 + ] 173 173 + in 174 174 + let mounts = 175 175 + [ 176 176 + { Mount.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; 177 177 + { ty = "bind"; src = opam_repository; dst = "/home/opam/opam-repository"; options = [ "rbind"; "rprivate" ] }; 178 178 + ] 179 179 + in 180 180 + let config = make ~root:rootfs ~cwd:"/home/opam" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:true in 181 181 + let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in 182 182 + let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in 183 183 + let _ = Os.rm (Os.path [ rootfs; "home"; "opam"; ".opam"; "repo"; "state-33BF9E46.cache" ]) in 184 184 + let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 185 185 + () 186 186 + 187 187 + let build ~t ~temp_dir build_log pkg dependencies deps = 188 188 + let config = t.config in 189 189 + let lowerdir = Os.path [ config.dir; "root"; "fs" ] in 190 190 + let upperdir = Os.path [ temp_dir; "fs" ] in 191 191 + let () = Os.mkdir upperdir in 192 192 + let pin = if OpamPackage.name_to_string pkg = config.package then [ "opam pin -yn " ^ OpamPackage.to_string pkg ^ " $HOME/src/"; "cd src" ] else [] in 193 193 + let argv = [ "/usr/bin/env"; "bash"; "-c"; String.concat " && " (pin @ [ "opam-build -v " ^ OpamPackage.to_string pkg ]) ] in 194 194 + let workdir = Os.path [ temp_dir; "work" ] in 195 195 + let () = Os.mkdir workdir in 196 196 + let () = 197 197 + OpamPackage.Set.iter 198 198 + (fun dep -> 199 199 + let hash = Util.hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in 200 200 + assert ( 201 201 + 0 202 202 + = Os.sudo 203 203 + [ 204 204 + "cp"; 205 205 + (* "--no-clobber"; *) 206 206 + "--update=none"; 207 207 + "--archive"; 208 208 + "--no-dereference"; 209 209 + "--recursive"; 210 210 + "--link"; 211 211 + "--no-target-directory"; 212 212 + Os.path [ config.dir; hash; "fs" ]; 213 213 + upperdir; 214 214 + ])) 215 215 + deps 216 216 + in 217 217 + let () = 218 218 + let default_switch = Os.path [ temp_dir; "fs"; "home"; "opam"; ".opam"; "default" ] in 219 219 + if Sys.file_exists default_switch then Opamh.dump_state default_switch 220 220 + in 221 221 + let etc_hosts = Os.path [ temp_dir; "hosts" ] in 222 222 + let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in 223 223 + let mounts = 224 224 + [ 225 225 + { Mount.ty = "overlay"; src = "overlay"; dst = "/"; options = [ "lowerdir=" ^ lowerdir; "upperdir=" ^ upperdir; "workdir=" ^ workdir ] }; 226 226 + { ty = "bind"; src = config.opam_repository; dst = "/home/opam/.opam/repo/default"; options = [ "rbind"; "rprivate" ] }; 227 227 + { ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; 228 228 + ] 229 229 + in 230 230 + let mounts = 231 231 + match config.directory with 232 232 + | None -> mounts 233 233 + | Some src -> mounts @ [ { ty = "bind"; src; dst = "/home/opam/src"; options = [ "rw"; "rbind"; "rprivate" ] } ] 234 234 + in 235 235 + let () = Os.mkdir (Os.path [ temp_dir; "dummy" ]) in 236 236 + let config = make ~root:"dummy" ~cwd:"/home/opam" ~argv ~hostname ~uid:1000 ~gid:1000 ~env ~mounts ~network:true in 237 237 + let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in 238 238 + let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in 239 239 + let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "tmp" ] ] in 240 240 + let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/sources" ] ] in 241 241 + let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/build" ] ] in 242 242 + let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 243 243 + ()

+61 -292

bin/main.ml

··· 4 4 module Role = Solver.Input.Role 5 5 module Role_map = Output.RoleMap 6 6 7 7 - type config = { 8 8 - dir : string; 9 9 - opam_repository : string; 10 10 - package : string; 11 11 - directory : string option; 12 12 - md : string option; 13 13 - network : string option; 14 14 - } 7 7 + let container = if Sys.win32 then (module Windows : S.CONTAINER) else (module Linux : S.CONTAINER) 15 8 16 16 - let hostname = "builder" 9 9 + module Container = (val container) 17 10 18 18 - let create_network () = match Sys.win32 with 19 19 - | true -> Os.run "hcn-namespace create" |> String.trim 20 20 - | false -> "" 21 21 - 22 22 - let delete_network = function 23 23 - | Some n -> Os.exec ["hcn-namespace"; "delete"; n] 24 24 - | None -> 0 25 25 - 26 26 - let env = 27 27 - [ 28 28 - ("PATH", "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"); 29 29 - ("HOME", "/home/opam"); 30 30 - ("OPAMYES", "1"); 31 31 - ("OPAMCONFIRMLEVEL", "unsafe-yes"); 32 32 - ("OPAMERRLOGLEN", "0"); 33 33 - ("OPAMPRECISETRACKING", "1"); 34 34 - ] 35 35 - 36 36 - let win_env = 37 37 - [ 38 38 - ("OPAMYES", "1"); 39 39 - ("OPAMCONFIRMLEVEL", "unsafe-yes"); 40 40 - ("OPAMERRLOGLEN", "0"); 41 41 - ("OPAMPRECISETRACKING", "1"); 42 42 - ] 43 43 - 44 44 - let init config = 11 11 + let init t = 12 12 + let config = Container.config ~t in 45 13 let root = Os.path [ config.dir; "root" ] in 46 14 if not (Sys.file_exists root) then 47 15 Os.create_directory_exclusively root @@ fun target_dir -> 48 16 let temp_dir = Filename.temp_dir ~temp_dir:config.dir ~perms:0o755 "temp-" "" in 49 49 - let rootfs = Os.path [ temp_dir; "fs" ] in 50 50 - let () = Os.mkdir rootfs in 51 17 let opam_repository = Os.path [ temp_dir; "opam-repository" ] in 52 18 let () = Os.mkdir opam_repository in 53 19 let () = Os.write_to_file (Os.path [ opam_repository; "repo" ]) {|opam-version: "2.0"|} in 54 20 let build_log = Os.path [ temp_dir; "build.log" ] in 55 55 - match Sys.win32 with 56 56 - | false -> 57 57 - let _ = Os.sudo [ "/usr/bin/env"; "bash"; "-c"; "docker export $(docker run -d debian:12) | sudo tar -C " ^ rootfs ^ " -x" ] in 58 58 - let opam = Os.path [ rootfs; "/usr/local/bin/opam" ] in 59 59 - let _ = Os.sudo [ "curl"; "-L"; "https://github.com/ocaml/opam/releases/download/2.3.0/opam-2.3.0-x86_64-linux"; "-o"; opam ] in 60 60 - let _ = Os.sudo [ "sudo"; "chmod"; "+x"; opam ] in 61 61 - let _ = Os.sudo [ "cp"; "/home/mtelvers/opam_build/_build/default/bin/main.exe"; Os.path [ rootfs; "/usr/local/bin/opam-build" ] ] in 62 62 - let etc_hosts = Os.path [ temp_dir; "hosts" ] in 63 63 - let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in 64 64 - let argv = 65 65 - [ 66 66 - "/usr/bin/env"; 67 67 - "bash"; 68 68 - "-c"; 69 69 - String.concat " && " 70 70 - [ 71 71 - "apt update"; 72 72 - "apt upgrade -y"; 73 73 - "apt install build-essential unzip bubblewrap git sudo curl rsync -y"; 74 74 - "adduser --disabled-password --gecos '@opam' --no-create-home --home /home/opam opam"; 75 75 - "chown -R $(id -u opam):$(id -g opam) /home/opam"; 76 76 - {|echo "opam ALL=(ALL:ALL) NOPASSWD:ALL" > /etc/sudoers.d/opam|}; 77 77 - "su - opam -c 'opam init -k local -a /home/opam/opam-repository --bare -y'"; 78 78 - "su - opam -c 'opam switch create default --empty'"; 79 79 - ]; 80 80 - ] 81 81 - in 82 82 - let mounts = 83 83 - [ 84 84 - { Json_config.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; 85 85 - { ty = "bind"; src = opam_repository; dst = "/home/opam/opam-repository"; options = [ "rbind"; "rprivate" ] }; 86 86 - ] 87 87 - in 88 88 - let config = Json_config.make ~root:rootfs ~cwd:"/home/opam" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:true in 89 89 - let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in 90 90 - let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in 91 91 - let _ = Os.rm (Os.path [ rootfs; "home"; "opam"; ".opam"; "repo"; "state-33BF9E46.cache" ] ) in 92 92 - let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 93 93 - Unix.rename temp_dir target_dir 94 94 - | true -> 95 95 - let argv = 96 96 - [ 97 97 - "cmd"; 98 98 - "/c"; 99 99 - String.concat " && " 100 100 - [ 101 101 - "set"; 102 102 - "curl.exe -L -o c:\\Windows\\opam.exe https://github.com/ocaml/opam/releases/download/2.3.0/opam-2.3.0-x86_64-windows.exe"; 103 103 - "curl.exe -L -o c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam\\opam-build.exe https://github.com/mtelvers/opam-build/releases/download/1.0.0/opam-build-1.0.0-x86_64-windows.exe"; 104 104 - (* "net user opam /nopassword /add"; *) 105 105 - "opam.exe init -k local -a c:\\opam-repository --bare -y"; 106 106 - "opam.exe switch create default --empty"; 107 107 - ]; 108 108 - ] 109 109 - in 110 110 - let mounts = 111 111 - [ 112 112 - { Json_config.ty = "bind"; src = rootfs; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] }; 113 113 - (*{ Json_config.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; *) 114 114 - { ty = "bind"; src = opam_repository; dst = "c:\\opam-repository"; options = [ "rbind"; "rprivate" ] }; 115 115 - ] 116 116 - in 117 117 - let mounts_json = Os.path [ temp_dir; "mounts.json" ] in 118 118 - let _ = Os.retry_exec ~stdout:mounts_json [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] in 119 119 - let layers = Json_layers.read_layers mounts_json in 120 120 - let config = Json_config.make_ctr ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env:win_env ~mounts ~network:(Option.value ~default:"" config.network) in 121 121 - let config_json = Os.path [ temp_dir; "config.json" ] in 122 122 - let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in 123 123 - let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in 124 124 - let _ = Os.rm (Os.path [ rootfs; "lock" ] ) in 125 125 - let _ = Os.rm (Os.path [ rootfs; "conf.lock" ] ) in 126 126 - let _ = Os.rm (Os.path [ rootfs; "default"; ".opam-switch"; "lock" ] ) in 127 127 - let _ = Os.rm (Os.path [ rootfs; "repo"; "state-33BF9E46.cache" ] ) in 128 128 - let _ = Os.rm (Os.path [ rootfs; "repo"; "conf.lock" ] ) in 129 129 - let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 130 130 - let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in 21 21 + let _ = Container.run ~t ~temp_dir opam_repository build_log in 131 22 Unix.rename temp_dir target_dir 132 23 133 24 let () = OpamFormatConfig.init () ··· 136 27 let _ = OpamStateConfig.load_defaults root *) 137 28 let () = OpamCoreConfig.init ?debug_level:(Some 10) ?debug_sections:(Some (OpamStd.String.Map.singleton "foo" (Some 10))) () 138 29 139 139 - let std_env 140 140 - ?(ocaml_native=true) 141 141 - ?opam_version 142 142 - ~arch ~os ~os_distribution ~os_family ~os_version 143 143 - () = 144 144 - function 145 145 - | "arch" -> Some (OpamTypes.S arch) 146 146 - | "os" -> Some (OpamTypes.S os) 147 147 - | "os-distribution" -> Some (OpamTypes.S os_distribution) 148 148 - | "os-version" -> Some (OpamTypes.S os_version) 149 149 - | "os-family" -> Some (OpamTypes.S os_family) 150 150 - | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 151 151 - (* There is no system compliler *) 152 152 - | "sys-ocaml-arch" 153 153 - | "sys-ocaml-cc" 154 154 - | "sys-ocaml-libc" 155 155 - | "sys-ocaml-system" 156 156 - | "sys-ocaml-version" -> Some (OpamTypes.S "") 157 157 - | "ocaml:native" -> Some (OpamTypes.B ocaml_native) 158 158 - | "ocaml:version" -> Some (OpamTypes.S "5.3.0") 159 159 - | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 160 160 - | v -> 161 161 - OpamConsole.warning "Unknown variable %S" v; 162 162 - None 163 163 - 164 164 - let std_env = match Sys.win32 with 165 165 - | false -> std_env ~arch:"x86_64" ~os:"linux" ~os_distribution:"debian" ~os_family:"debian" ~os_version:"12" () 166 166 - | true -> std_env ~arch:"x86_64" ~os:"win32" ~os_distribution:"cygwin" ~os_family:"windows" ~os_version:"10.0.20348" () 167 167 - 168 30 let opam_env pkg v = 169 31 (* if List.mem v OpamPackageVar.predefined_depends_variables then (Some (OpamTypes.B true)) 170 32 else *) ··· 178 40 Some (OpamTypes.B false) 179 41 | "build" -> Some (OpamTypes.B true) 180 42 | "post" -> None 181 181 - | x -> std_env x 43 43 + | x -> Container.std_env x 182 44 183 183 - let solve config ocaml_version pkg = 45 45 + let solve (config : Config.t) ocaml_version pkg = 184 46 let constraints = 185 47 OpamPackage.Name.Map.of_list 186 48 [ (OpamPackage.name ocaml_version, (`Eq, OpamPackage.version ocaml_version)); (OpamPackage.name pkg, (`Eq, OpamPackage.version pkg)) ] ··· 193 55 |> OpamPackage.Name.Map.add (OpamPackage.Name.of_string config.package) 194 56 (OpamPackage.Version.of_string "dev", OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw (Os.path [ directory; config.package ^ ".opam" ])))) 195 57 in 196 196 - let context = Dir_context.create ~env:std_env ~constraints ~pins (Os.path [ config.opam_repository; "packages" ]) in 58 58 + let context = Dir_context.create ~env:Container.std_env ~constraints ~pins (Os.path [ config.opam_repository; "packages" ]) in 197 59 let r = Solver.solve context [ OpamPackage.name pkg ] in 198 60 match r with 199 61 | Ok out -> ··· 269 131 installable @ topological_sort pkgs 270 132 271 133 let pkg_deps solution = 272 272 - List.fold_left (fun map pkg -> 273 273 - let deps_direct = OpamPackage.Map.find pkg solution in 274 274 - let deps_plus_children = OpamPackage.Set.fold (fun pkg acc -> OpamPackage.Set.union acc (OpamPackage.Map.find pkg map)) deps_direct deps_direct in 275 275 - OpamPackage.Map.add pkg deps_plus_children map) OpamPackage.Map.empty 276 276 - 277 277 - let hash_of_set s = s |> OpamPackage.Set.to_list |> List.map OpamPackage.to_string |> String.concat " " |> Digest.string |> Digest.to_hex 134 134 + List.fold_left 135 135 + (fun map pkg -> 136 136 + let deps_direct = OpamPackage.Map.find pkg solution in 137 137 + let deps_plus_children = OpamPackage.Set.fold (fun pkg acc -> OpamPackage.Set.union acc (OpamPackage.Map.find pkg map)) deps_direct deps_direct in 138 138 + OpamPackage.Map.add pkg deps_plus_children map) 139 139 + OpamPackage.Map.empty 278 140 279 141 type build_result = 280 142 | No_solution ··· 288 150 | Failure _ -> "failure" 289 151 | Success _ -> "success" 290 152 291 291 - let build_layer config solution dependencies pkg = 153 153 + let build_layer t solution dependencies pkg = 154 154 + let config = Container.config ~t in 292 155 let () = Printf.printf "Layer %s: %!" (OpamPackage.to_string pkg) in 293 156 let deps = OpamPackage.Map.find pkg solution in 294 294 - let hash = hash_of_set (OpamPackage.Set.add pkg (OpamPackage.Map.find pkg dependencies)) in 157 157 + let hash = Util.hash_of_set (OpamPackage.Set.add pkg (OpamPackage.Map.find pkg dependencies)) in 295 158 let layer_dir = Os.path [ config.dir; hash ] in 296 159 let () = Printf.printf "layer_dir %s\n%!" layer_dir in 297 160 let write_layer target_dir = ··· 299 162 let () = Printf.printf "temp_dir %s\n%!" temp_dir in 300 163 let () = Os.write_to_file (Os.path [ temp_dir; "package" ]) (OpamPackage.to_string pkg) in 301 164 let () = Os.write_to_file (Os.path [ temp_dir; "packages" ]) (OpamPackage.Set.to_string deps) in 302 302 - let lowerdir = Os.path [ config.dir; "root"; "fs" ] in 303 303 - let upperdir = Os.path [ temp_dir; "fs" ] in 304 165 let build_log = Os.path [ temp_dir; "build.log" ] in 305 305 - let () = Os.mkdir upperdir in 306 306 - ( 307 307 - match Sys.win32 with 308 308 - | false -> 309 309 - let pin = if OpamPackage.name_to_string pkg = config.package then [ "opam pin -yn " ^ OpamPackage.to_string pkg ^ " $HOME/src/"; "cd src" ] else [] in 310 310 - let argv = [ "/usr/bin/env"; "bash"; "-c"; String.concat " && " (pin @ [ "opam-build -v " ^ OpamPackage.to_string pkg ]) ] in 311 311 - let workdir = Os.path [ temp_dir; "work" ] in 312 312 - let () = Os.mkdir workdir in 313 313 - let () = 314 314 - OpamPackage.Set.iter 315 315 - (fun dep -> 316 316 - let hash = hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in 317 317 - assert ( 318 318 - 0 319 319 - = Os.sudo 320 320 - [ 321 321 - "cp"; 322 322 - (* "--no-clobber"; *) 323 323 - "--update=none"; 324 324 - "--archive"; 325 325 - "--no-dereference"; 326 326 - "--recursive"; 327 327 - "--link"; 328 328 - "--no-target-directory"; 329 329 - Os.path [ config.dir; hash; "fs" ]; 330 330 - upperdir; 331 331 - ])) 332 332 - deps 333 333 - in 334 334 - let () = 335 335 - let default_switch = Os.path [ temp_dir; "fs"; "home"; "opam"; ".opam"; "default" ] in 336 336 - if Sys.file_exists default_switch then Opamh.dump_state default_switch 337 337 - in 338 338 - let etc_hosts = Os.path [ temp_dir; "hosts" ] in 339 339 - let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in 340 340 - let mounts = 341 341 - [ 342 342 - { Json_config.ty = "overlay"; src = "overlay"; dst = "/"; options = [ "lowerdir=" ^ lowerdir; "upperdir=" ^ upperdir; "workdir=" ^ workdir ] }; 343 343 - { ty = "bind"; src = config.opam_repository; dst = "/home/opam/.opam/repo/default"; options = [ "rbind"; "rprivate" ] }; 344 344 - { ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; 345 345 - ] 346 346 - in 347 347 - let mounts = 348 348 - match config.directory with 349 349 - | None -> mounts 350 350 - | Some src -> mounts @ [{ ty = "bind"; src; dst = "/home/opam/src"; options = [ "rw"; "rbind"; "rprivate" ] }] 351 351 - in 352 352 - let () = Os.mkdir (Os.path [ temp_dir; "dummy" ]) in 353 353 - let config = Json_config.make ~root:"dummy" ~cwd:"/home/opam" ~argv ~hostname ~uid:1000 ~gid:1000 ~env ~mounts ~network:true in 354 354 - let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in 355 355 - let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in 356 356 - let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "tmp" ] ] in 357 357 - let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/sources" ] ] in 358 358 - let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/build" ] ] in 359 359 - let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 360 360 - Unix.rename temp_dir target_dir 361 361 - | true -> 362 362 - let pin = if OpamPackage.name_to_string pkg = config.package then [ "opam pin -yn " ^ OpamPackage.to_string pkg ^ " $HOME/src/"; "cd src" ] else [] in 363 363 - let argv = [ "cmd"; "/c"; String.concat " && " (pin @ [ "set && c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam\\opam-build.exe -v " ^ OpamPackage.to_string pkg ]) ] in 364 364 - let _ = Os.hardlink_tree ~source:(Os.path [ config.dir; "root"; "fs" ]) ~target:upperdir in 365 365 - let () = 366 366 - OpamPackage.Set.iter 367 367 - (fun dep -> 368 368 - let hash = hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in 369 369 - Os.hardlink_tree ~source:(Os.path [ config.dir; hash; "fs"]) ~target:upperdir) 370 370 - deps 371 371 - in 372 372 - 373 373 - let () = 374 374 - let default_switch = Os.path [ temp_dir; "fs"; "default" ] in 375 375 - if Sys.file_exists default_switch then Opamh.dump_state default_switch 376 376 - in 377 377 - let mounts = 378 378 - [ 379 379 - { Json_config.ty = "bind"; src = upperdir; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] }; 380 380 - { ty = "bind"; src = config.opam_repository; dst = "c:\\users\\ContainerAdministrator\\AppData\\Local\\opam\\repo\\default"; options = [ "rbind"; "rprivate" ] }; 381 381 - ] 382 382 - in 383 383 - let mounts_json = Os.path [ temp_dir; "mounts.json" ] in 384 384 - let _ = Os.retry_exec ~stdout:mounts_json [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] in 385 385 - let layers = Json_layers.read_layers mounts_json in 386 386 - let config = Json_config.make_ctr ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env:win_env ~mounts ~network:(Option.value ~default:"" config.network) in 387 387 - let config_json = Os.path [ temp_dir; "config.json" ] in 388 388 - let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in 389 389 - let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in 390 390 - let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 391 391 - let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in 392 392 - let _ = Os.rm (Os.path [ upperdir; "repo"; "state-33BF9E46.cache" ] ) in 393 393 - let _ = Os.rm ~recursive:true (Os.path [ upperdir; "default"; ".opam-switch"; "sources" ] ) in 394 394 - let _ = Os.rm ~recursive:true (Os.path [ upperdir; "default"; ".opam-switch"; "build" ] ) in 395 395 - let _ = Os.rm (Os.path [ upperdir; "default"; ".opam-switch"; "lock" ] ) in 166 166 + let () = Container.build ~t ~temp_dir build_log pkg dependencies deps in 396 167 Unix.rename temp_dir target_dir 397 397 - ) 398 168 in 399 169 let () = if not (Sys.file_exists layer_dir) then Os.create_directory_exclusively layer_dir write_layer in 400 170 let () = Os.write_to_file (Os.path [ layer_dir; "last_used" ]) (Unix.time () |> string_of_float) in ··· 406 176 407 177 let reduce dependencies = 408 178 OpamPackage.Map.map (fun u -> 409 409 - OpamPackage.Set.filter (fun v -> 410 410 - let others = OpamPackage.Set.remove v u in 411 411 - OpamPackage.Set.fold (fun o acc -> 412 412 - acc || OpamPackage.Set.mem v (OpamPackage.Map.find o dependencies) 413 413 - ) others false |> not 414 414 - ) u 415 415 - ) 179 179 + OpamPackage.Set.filter 180 180 + (fun v -> 181 181 + let others = OpamPackage.Set.remove v u in 182 182 + OpamPackage.Set.fold (fun o acc -> acc || OpamPackage.Set.mem v (OpamPackage.Map.find o dependencies)) others false |> not) 183 183 + u) 416 184 417 185 let build config ocaml_version package = 418 186 let solution = solve config ocaml_version package in 419 419 - (* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".dot") solution in *) 420 420 - if OpamPackage.Map.is_empty solution then 421 421 - [ No_solution ] 187 187 + (* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".dot") solution in *) 188 188 + if OpamPackage.Map.is_empty solution then [ No_solution ] 422 189 else 190 190 + let t = Container.init ~config in 191 191 + init t; 423 192 let ordered_installation = topological_sort solution in 424 193 let dependencies = pkg_deps solution ordered_installation in 425 194 let solution = reduce dependencies solution in 426 426 - (* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".reduced.dot") solution in *) 427 427 - List.fold_left 428 428 - (fun lst pkg -> 429 429 - match lst with 430 430 - | [] -> [ build_layer config solution dependencies pkg ] 431 431 - | Success _ :: _ -> build_layer config solution dependencies pkg :: lst 432 432 - | _ -> Dependency_failed :: lst) 433 433 - [] ordered_installation 195 195 + (* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".reduced.dot") solution in *) 196 196 + let results = 197 197 + List.fold_left 198 198 + (fun lst pkg -> 199 199 + match lst with 200 200 + | [] -> [ build_layer t solution dependencies pkg ] 201 201 + | Success _ :: _ -> build_layer t solution dependencies pkg :: lst 202 202 + | _ -> Dependency_failed :: lst) 203 203 + [] ordered_installation 204 204 + in 205 205 + Container.deinit ~t; 206 206 + results 434 207 435 208 let ocaml_version = OpamPackage.create (OpamPackage.Name.of_string "ocaml") (OpamPackage.Version.of_string "5.3.0") 436 209 ··· 458 231 459 232 open Cmdliner 460 233 461 461 - let output config results = 234 234 + let output (config : Config.t) results = 462 235 match config.md with 463 236 | Some filename -> 464 464 - let oc = open_out filename in 465 465 - let cmd = Printf.sprintf "git -C %s rev-parse HEAD" config.opam_repository in 466 466 - let opam_repo_sha = Os.run cmd |> String.trim in 467 467 - let () = Printf.fprintf oc "---\nstatus: %s\ncommit: %s\npackage: %s\n---\n\n" 468 468 - (build_result_to_string (List.hd results)) 469 469 - opam_repo_sha config.package in 470 470 - let () = List.rev results |> List.iter (function 471 471 - | Success log 472 472 - | Failure log -> output_string oc log 473 473 - | _ -> ()) in 474 474 - close_out oc 475 475 - | None -> 476 476 - print_string (build_result_to_string (List.hd results)) 237 237 + let oc = open_out_bin filename in 238 238 + let cmd = Printf.sprintf "git -C %s rev-parse HEAD" config.opam_repository in 239 239 + let opam_repo_sha = Os.run cmd |> String.trim in 240 240 + let () = Printf.fprintf oc "---\nstatus: %s\ncommit: %s\npackage: %s\n---\n\n" (build_result_to_string (List.hd results)) opam_repo_sha config.package in 241 241 + let () = 242 242 + List.rev results 243 243 + |> List.iter (function 244 244 + | Success log 245 245 + | Failure log -> 246 246 + output_string oc log 247 247 + | _ -> ()) 248 248 + in 249 249 + close_out oc 250 250 + | None -> print_string (build_result_to_string (List.hd results)) 477 251 478 478 - let run_ci config = 479 479 - init config; 252 252 + let run_ci (config : Config.t) = 480 253 let package = OpamPackage.of_string (config.package ^ ".dev") in 481 481 - let config = { config with network = Some (create_network ()) } in 482 254 let results = build config ocaml_version package in 483 483 - let _ = delete_network config.network in 484 255 output config results 485 256 486 486 - let run_health_check config = 487 487 - init config; 257 257 + let run_health_check (config : Config.t) = 488 258 let package = OpamPackage.of_string config.package in 489 489 - let config = { config with network = Some (create_network ()) } in 490 259 let results = build config ocaml_version package in 491 491 - let _ = delete_network config.network in 492 260 output config results 493 261 494 262 let cache_dir_term = ··· 501 269 502 270 let md_term = 503 271 let doc = "Output results in markdown format" in 504 504 - Arg.(value & opt (some string) None & info ["md"] ~docv:"FILE" ~doc) 272 272 + Arg.(value & opt (some string) None & info [ "md" ] ~docv:"FILE" ~doc) 505 273 506 274 let find_opam_files dir = 507 275 try ··· 516 284 in 517 285 let ci_term = 518 286 Term.( 519 519 - const (fun dir opam_repository directory md -> run_ci { dir; opam_repository; package = List.hd (find_opam_files directory); directory = Some directory; md; network = None }) 287 287 + const (fun dir opam_repository directory md -> 288 288 + run_ci { dir; opam_repository; package = List.hd (find_opam_files directory); directory = Some directory; md }) 520 289 $ cache_dir_term $ opam_repository_term $ directory_arg $ md_term) 521 290 in 522 291 let ci_info = Cmd.info "ci" ~doc:"Run CI tests on a directory" in ··· 529 298 in 530 299 let health_check_term = 531 300 Term.( 532 532 - const (fun dir opam_repository package md -> run_health_check { dir; opam_repository; package; directory = None; md; network = None }) 301 301 + const (fun dir opam_repository package md -> run_health_check { dir; opam_repository; package; directory = None; md }) 533 302 $ cache_dir_term $ opam_repository_term $ package_arg $ md_term) 534 303 in 535 304 let health_check_info = Cmd.info "health-check" ~doc:"Run health check on a package" in ··· 560 329 561 330 let () = 562 331 let default_term = Term.(ret (const (`Help (`Pager, None)))) in 563 563 - let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd ; list_cmd ] in 332 332 + let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd; list_cmd ] in 564 333 exit (Cmd.eval cmd)

+11

bin/mount.ml

··· 1 1 + type t = { 2 2 + ty : string; 3 3 + src : string; 4 4 + dst : string; 5 5 + options : string list; 6 6 + } 7 7 + 8 8 + let make ~ty ~options ~src dst = 9 9 + `Assoc [ ("destination", `String dst); ("type", `String ty); ("source", `String src); ("options", `List (List.map (fun x -> `String x) options)) ] 10 10 + 11 11 + let user_mounts = List.map @@ fun { ty; src; dst; options } -> make ~ty ~options ~src dst

+71 -75

bin/os.ml

··· 17 17 | 0, _ -> 0 18 18 | r, 0 -> r 19 19 | _, n -> 20 20 - OpamConsole.note "retry %i: %s" (tries - n + 1) (String.concat " " cmd); 21 21 - Unix.sleepf (Random.float 2.0); loop (n - 1) 20 20 + OpamConsole.note "retry %i: %s" (tries - n + 1) (String.concat " " cmd); 21 21 + Unix.sleepf (Random.float 2.0); 22 22 + loop (n - 1) 22 23 in 23 23 - loop tries 24 24 + loop tries 24 25 25 26 let run cmd = 26 27 let inp = Unix.open_process_in cmd in ··· 31 32 let nproc () = run "nproc" |> String.trim |> int_of_string 32 33 let mkdir dir = if not (Sys.file_exists dir) then Sys.mkdir dir 0o755 33 34 34 34 - let rec rm ?(recursive=false) path = 35 35 + let rec rm ?(recursive = false) path = 35 36 try 36 37 let stat = Unix.lstat path in 37 38 match stat.st_kind with 38 38 - | S_REG | S_LNK | S_CHR | S_BLK | S_FIFO | S_SOCK -> 39 39 - (try 40 40 - Unix.unlink path 41 41 - with 42 42 - Unix.Unix_error (Unix.EACCES, _, _) -> 43 43 - Unix.chmod path (stat.st_perm lor 0o222); 44 44 - Unix.unlink path) 39 39 + | S_REG 40 40 + | S_LNK 41 41 + | S_CHR 42 42 + | S_BLK 43 43 + | S_FIFO 44 44 + | S_SOCK -> ( 45 45 + try Unix.unlink path with 46 46 + | Unix.Unix_error (Unix.EACCES, _, _) -> 47 47 + Unix.chmod path (stat.st_perm lor 0o222); 48 48 + Unix.unlink path) 45 49 | S_DIR -> 46 46 - if recursive then 47 47 - Sys.readdir path 48 48 - |> Array.iter (fun f -> 49 49 - rm ~recursive (Filename.concat path f)); 50 50 - Unix.rmdir path 50 50 + if recursive then Sys.readdir path |> Array.iter (fun f -> rm ~recursive (Filename.concat path f)); 51 51 + Unix.rmdir path 51 52 with 52 52 - | Unix.Unix_error (Unix.ENOENT, _, _) -> () 53 53 + | Unix.Unix_error (Unix.ENOENT, _, _) -> () 53 54 54 55 module IntSet = Set.Make (Int) 55 56 ··· 93 94 exception Copy_error of string 94 95 95 96 let cp ?(buffer_size = 65536) ?(preserve_permissions = true) ?(preserve_times = true) src dst = 96 96 - let safe_close fd = try Unix.close fd with _ -> () in 97 97 + let safe_close fd = 98 98 + try Unix.close fd with 99 99 + | _ -> () 100 100 + in 97 101 let src_stats = 98 98 - try Unix.stat src 99 99 - with Unix.Unix_error (err, _, _) -> 100 100 - raise (Copy_error (Printf.sprintf "Cannot stat source file '%s': %s" src (Unix.error_message err))) 102 102 + try Unix.stat src with 103 103 + | Unix.Unix_error (err, _, _) -> raise (Copy_error (Printf.sprintf "Cannot stat source file '%s': %s" src (Unix.error_message err))) 101 104 in 102 102 - if src_stats.st_kind <> S_REG then 103 103 - raise (Copy_error (Printf.sprintf "Source '%s' is not a regular file" src)); 105 105 + if src_stats.st_kind <> S_REG then raise (Copy_error (Printf.sprintf "Source '%s' is not a regular file" src)); 104 106 let src_fd = 105 105 - try Unix.openfile src [O_RDONLY] 0 106 106 - with Unix.Unix_error (err, _, _) -> 107 107 - raise (Copy_error (Printf.sprintf "Cannot open source file '%s': %s" src (Unix.error_message err))) 107 107 + try Unix.openfile src [ O_RDONLY ] 0 with 108 108 + | Unix.Unix_error (err, _, _) -> raise (Copy_error (Printf.sprintf "Cannot open source file '%s': %s" src (Unix.error_message err))) 108 109 in 109 110 let dst_fd = 110 110 - try Unix.openfile dst [O_WRONLY; O_CREAT; O_TRUNC] src_stats.st_perm 111 111 - with Unix.Unix_error (err, _, _) -> 112 112 - safe_close src_fd; 113 113 - raise (Copy_error (Printf.sprintf "Cannot open destination file '%s': %s" dst (Unix.error_message err))) 111 111 + try Unix.openfile dst [ O_WRONLY; O_CREAT; O_TRUNC ] src_stats.st_perm with 112 112 + | Unix.Unix_error (err, _, _) -> 113 113 + safe_close src_fd; 114 114 + raise (Copy_error (Printf.sprintf "Cannot open destination file '%s': %s" dst (Unix.error_message err))) 114 115 in 115 116 let buffer = Bytes.create buffer_size in 116 117 let rec copy_loop () = 117 118 try 118 118 - match (Unix.read src_fd buffer 0 buffer_size) with 119 119 + match Unix.read src_fd buffer 0 buffer_size with 119 120 | 0 -> () 120 121 | bytes_read -> 121 121 - let rec write_all pos remaining = 122 122 - if remaining > 0 then 123 123 - let bytes_written = Unix.write dst_fd buffer pos remaining in 124 124 - write_all (pos + bytes_written) (remaining - bytes_written) 125 125 - in 126 126 - write_all 0 bytes_read; 127 127 - copy_loop () 128 128 - with Unix.Unix_error (err, _, _) -> 129 129 - safe_close src_fd; 130 130 - safe_close dst_fd; 131 131 - raise (Copy_error (Printf.sprintf "Error during copy: %s" (Unix.error_message err))) 122 122 + let rec write_all pos remaining = 123 123 + if remaining > 0 then 124 124 + let bytes_written = Unix.write dst_fd buffer pos remaining in 125 125 + write_all (pos + bytes_written) (remaining - bytes_written) 126 126 + in 127 127 + write_all 0 bytes_read; 128 128 + copy_loop () 129 129 + with 130 130 + | Unix.Unix_error (err, _, _) -> 131 131 + safe_close src_fd; 132 132 + safe_close dst_fd; 133 133 + raise (Copy_error (Printf.sprintf "Error during copy: %s" (Unix.error_message err))) 132 134 in 133 135 copy_loop (); 134 136 safe_close src_fd; 135 137 safe_close dst_fd; 136 136 - if preserve_permissions then begin 137 137 - try Unix.chmod dst src_stats.st_perm 138 138 - with Unix.Unix_error (err, _, _) -> 139 139 - Printf.eprintf "Warning: Could not preserve permissions: %s\n" (Unix.error_message err) 140 140 - end; 141 141 - if preserve_times then begin 142 142 - try Unix.utimes dst src_stats.st_atime src_stats.st_mtime 143 143 - with Unix.Unix_error (err, _, _) -> 144 144 - Printf.eprintf "Warning: Could not preserve timestamps: %s\n" (Unix.error_message err) 145 145 - end 138 138 + (if preserve_permissions then 139 139 + try Unix.chmod dst src_stats.st_perm with 140 140 + | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: Could not preserve permissions: %s\n" (Unix.error_message err)); 141 141 + if preserve_times then 142 142 + try Unix.utimes dst src_stats.st_atime src_stats.st_mtime with 143 143 + | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: Could not preserve timestamps: %s\n" (Unix.error_message err) 146 144 147 145 let hardlink_tree ~source ~target = 148 146 let rec process_directory current_source current_target = 149 147 let entries = Sys.readdir current_source in 150 150 - Array.iter (fun entry -> 151 151 - let source = Filename.concat current_source entry in 152 152 - let target = Filename.concat current_target entry in 153 153 - try 154 154 - let stat = Unix.lstat source in 155 155 - match stat.st_kind with 156 156 - | Unix.S_LNK -> 157 157 - if not (Sys.file_exists target) then 158 158 - Unix.symlink (Unix.readlink source) target 159 159 - | Unix.S_REG -> 160 160 - if not (Sys.file_exists target) then 161 161 - Unix.link source target 162 162 - | Unix.S_DIR -> 163 163 - mkdir target; 164 164 - process_directory source target 165 165 - | S_CHR | S_BLK | S_FIFO | S_SOCK -> 166 166 - () 167 167 - with 168 168 - | Unix.Unix_error (Unix.EMLINK, _, _) -> 169 169 - cp source target 170 170 - | Unix.Unix_error (err, _, _) -> 171 171 - Printf.eprintf "Warning: %s -> %s = %s\n" source target (Unix.error_message err); 172 172 - ) entries 148 148 + Array.iter 149 149 + (fun entry -> 150 150 + let source = Filename.concat current_source entry in 151 151 + let target = Filename.concat current_target entry in 152 152 + try 153 153 + let stat = Unix.lstat source in 154 154 + match stat.st_kind with 155 155 + | S_LNK -> if not (Sys.file_exists target) then Unix.symlink (Unix.readlink source) target 156 156 + | S_REG -> if not (Sys.file_exists target) then Unix.link source target 157 157 + | S_DIR -> 158 158 + mkdir target; 159 159 + process_directory source target 160 160 + | S_CHR 161 161 + | S_BLK 162 162 + | S_FIFO 163 163 + | S_SOCK -> 164 164 + () 165 165 + with 166 166 + | Unix.Unix_error (Unix.EMLINK, _, _) -> cp source target 167 167 + | Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: %s -> %s = %s\n" source target (Unix.error_message err)) 168 168 + entries 173 169 in 174 170 process_directory source target

+10

bin/s.ml

··· 1 1 + module type CONTAINER = sig 2 2 + type t 3 3 + 4 4 + val init : config:Config.t -> t 5 5 + val deinit : t:t -> unit 6 6 + val config : t:t -> Config.t 7 7 + val run : t:t -> temp_dir:string -> string -> string -> unit 8 8 + val build : t:t -> temp_dir:string -> string -> OpamPackage.t -> OpamPackage.Set.t OpamPackage.Map.t -> OpamPackage.Set.t -> unit 9 9 + val std_env : string -> OpamTypes.variable_contents option 10 10 + end

+22

bin/util.ml

··· 1 1 + let hash_of_set s = s |> OpamPackage.Set.to_list |> List.map OpamPackage.to_string |> String.concat " " |> Digest.string |> Digest.to_hex 2 2 + 3 3 + let std_env ?(ocaml_native = true) ?opam_version ~arch ~os ~os_distribution ~os_family ~os_version () = function 4 4 + | "arch" -> Some (OpamTypes.S arch) 5 5 + | "os" -> Some (OpamTypes.S os) 6 6 + | "os-distribution" -> Some (OpamTypes.S os_distribution) 7 7 + | "os-version" -> Some (OpamTypes.S os_version) 8 8 + | "os-family" -> Some (OpamTypes.S os_family) 9 9 + | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 10 10 + (* There is no system compliler *) 11 11 + | "sys-ocaml-arch" 12 12 + | "sys-ocaml-cc" 13 13 + | "sys-ocaml-libc" 14 14 + | "sys-ocaml-system" 15 15 + | "sys-ocaml-version" -> 16 16 + Some (OpamTypes.S "") 17 17 + | "ocaml:native" -> Some (OpamTypes.B ocaml_native) 18 18 + | "ocaml:version" -> Some (OpamTypes.S "5.3.0") 19 19 + | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 20 20 + | v -> 21 21 + OpamConsole.warning "Unknown variable %S" v; 22 22 + None

+136

bin/windows.ml

··· 1 1 + type t = { 2 2 + config : Config.t; 3 3 + network : string; 4 4 + } 5 5 + 6 6 + let hostname = "builder" 7 7 + let env = [ ("OPAMYES", "1"); ("OPAMCONFIRMLEVEL", "unsafe-yes"); ("OPAMERRLOGLEN", "0"); ("OPAMPRECISETRACKING", "1") ] 8 8 + let std_env = Util.std_env ~arch:"x86_64" ~os:"win32" ~os_distribution:"cygwin" ~os_family:"windows" ~os_version:"10.0.20348" () 9 9 + let strings xs = `List (List.map (fun x -> `String x) xs) 10 10 + 11 11 + let make_config_json ~layers ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t = 12 12 + `Assoc 13 13 + [ 14 14 + ("ociVersion", `String "1.1.0"); 15 15 + ( "process", 16 16 + `Assoc 17 17 + [ 18 18 + ("terminal", `Bool false); 19 19 + ("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]); 20 20 + ("args", strings argv); 21 21 + ("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env)); 22 22 + ("cwd", `String cwd); 23 23 + ] ); 24 24 + ("root", `Assoc [ ("path", `String ""); ("readonly", `Bool false) ]); 25 25 + ("hostname", `String hostname); 26 26 + ("mounts", `List (Mount.user_mounts mounts)); 27 27 + ( "windows", 28 28 + `Assoc 29 29 + [ 30 30 + ("layerFolders", strings layers); 31 31 + ("ignoreFlushesDuringBoot", `Bool true); 32 32 + ("network", `Assoc [ ("allowUnqualifiedDNSQuery", `Bool true); ("networkNamespace", `String network) ]); 33 33 + ] ); 34 34 + ] 35 35 + 36 36 + let init ~(config : Config.t) = { config; network = Os.run "hcn-namespace create" |> String.trim } 37 37 + let deinit ~t = ignore (Os.exec [ "hcn-namespace"; "delete"; t.network ]) 38 38 + let config ~t = t.config 39 39 + 40 40 + let run ~t ~temp_dir opam_repository build_log = 41 41 + let rootfs = Os.path [ temp_dir; "fs" ] in 42 42 + let () = Os.mkdir rootfs in 43 43 + let argv = 44 44 + [ 45 45 + "cmd"; 46 46 + "/c"; 47 47 + String.concat " && " 48 48 + [ 49 49 + "set"; 50 50 + "curl.exe -L -o c:\\Windows\\opam.exe https://github.com/ocaml/opam/releases/download/2.3.0/opam-2.3.0-x86_64-windows.exe"; 51 51 + "curl.exe -L -o c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam\\opam-build.exe \ 52 52 + https://github.com/mtelvers/opam-build/releases/download/1.0.0/opam-build-1.0.0-x86_64-windows.exe"; 53 53 + (* "net user opam /nopassword /add"; *) 54 54 + "opam.exe init -k local -a c:\\opam-repository --bare -y"; 55 55 + "opam.exe switch create default --empty"; 56 56 + ]; 57 57 + ] 58 58 + in 59 59 + let mounts = 60 60 + [ 61 61 + { Mount.ty = "bind"; src = rootfs; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] }; 62 62 + (*{ Mount.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; *) 63 63 + { ty = "bind"; src = opam_repository; dst = "c:\\opam-repository"; options = [ "rbind"; "rprivate" ] }; 64 64 + ] 65 65 + in 66 66 + let mounts_json = Os.path [ temp_dir; "mounts.json" ] in 67 67 + let _ = 68 68 + Os.retry_exec ~stdout:mounts_json 69 69 + [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] 70 70 + in 71 71 + let layers = Json_layers.read_layers mounts_json in 72 72 + let config = make_config_json ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:t.network in 73 73 + let config_json = Os.path [ temp_dir; "config.json" ] in 74 74 + let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in 75 75 + let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in 76 76 + let _ = Os.rm (Os.path [ rootfs; "lock" ]) in 77 77 + let _ = Os.rm (Os.path [ rootfs; "conf.lock" ]) in 78 78 + let _ = Os.rm (Os.path [ rootfs; "default"; ".opam-switch"; "lock" ]) in 79 79 + let _ = Os.rm (Os.path [ rootfs; "repo"; "state-33BF9E46.cache" ]) in 80 80 + let _ = Os.rm (Os.path [ rootfs; "repo"; "conf.lock" ]) in 81 81 + let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 82 82 + let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in 83 83 + () 84 84 + 85 85 + let build ~t ~temp_dir build_log pkg dependencies deps = 86 86 + let config = t.config in 87 87 + let target = Os.path [ temp_dir; "fs" ] in 88 88 + let () = Os.mkdir target in 89 89 + let pin = if OpamPackage.name_to_string pkg = config.package then [ "opam pin -yn " ^ OpamPackage.to_string pkg ^ " $HOME/src/"; "cd src" ] else [] in 90 90 + let argv = 91 91 + [ 92 92 + "cmd"; 93 93 + "/c"; 94 94 + String.concat " && " (pin @ [ "set && c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam\\opam-build.exe -v " ^ OpamPackage.to_string pkg ]); 95 95 + ] 96 96 + in 97 97 + let _ = Os.hardlink_tree ~source:(Os.path [ config.dir; "root"; "fs" ]) ~target in 98 98 + let () = 99 99 + OpamPackage.Set.iter 100 100 + (fun dep -> 101 101 + let hash = Util.hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in 102 102 + Os.hardlink_tree ~source:(Os.path [ config.dir; hash; "fs" ]) ~target) 103 103 + deps 104 104 + in 105 105 + let () = 106 106 + let default_switch = Os.path [ temp_dir; "fs"; "default" ] in 107 107 + if Sys.file_exists default_switch then Opamh.dump_state default_switch 108 108 + in 109 109 + let mounts = 110 110 + [ 111 111 + { Mount.ty = "bind"; src = target; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] }; 112 112 + { 113 113 + ty = "bind"; 114 114 + src = config.opam_repository; 115 115 + dst = "c:\\users\\ContainerAdministrator\\AppData\\Local\\opam\\repo\\default"; 116 116 + options = [ "rbind"; "rprivate" ]; 117 117 + }; 118 118 + ] 119 119 + in 120 120 + let mounts_json = Os.path [ temp_dir; "mounts.json" ] in 121 121 + let _ = 122 122 + Os.retry_exec ~stdout:mounts_json 123 123 + [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] 124 124 + in 125 125 + let layers = Json_layers.read_layers mounts_json in 126 126 + let config = make_config_json ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:t.network in 127 127 + let config_json = Os.path [ temp_dir; "config.json" ] in 128 128 + let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in 129 129 + let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in 130 130 + let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in 131 131 + let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in 132 132 + let _ = Os.rm (Os.path [ target; "repo"; "state-33BF9E46.cache" ]) in 133 133 + let _ = Os.rm ~recursive:true (Os.path [ target; "default"; ".opam-switch"; "sources" ]) in 134 134 + let _ = Os.rm ~recursive:true (Os.path [ target; "default"; ".opam-switch"; "build" ]) in 135 135 + let _ = Os.rm (Os.path [ target; "default"; ".opam-switch"; "lock" ]) in 136 136 + ()