jon.recoil.org
A fork of mtelver's day10 project
Restructure
+91
-5
README.md
+91
-5
README.md
···
11
```
12
13
14
-
Windows
15
16
```
17
-
winget install git.git --scope machine
18
-
winget install ocaml.opam --scope machine
19
```
20
21
```
22
dune build
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
24
```
25
26
```
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
28
```
29
30
Next commit
31
···
11
```
12
13
14
+
# Windows
15
+
16
+
Remove Windows Defender
17
18
```
19
+
dism /online /disable-feature /featurename:Windows-Defender /remove /norestart
20
```
21
+
22
+
Install OpenSSH and configure (Windows Server 2022 only)
23
24
```
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
+
start /wait msiexec /q /norestart /i openssh-win64.msi
27
+
copy id_ed25519.pub c:\programdata\ssh\administrators_authorized_keys
28
+
netsh advfirewall firewall set rule name="OpenSSH SSH Server Preview (sshd)" new profile=any enable=yes
29
+
```
30
+
31
+
On Windows Server 2025, SSHD is already installed, but not enabled.
32
+
33
+
```
34
+
sc config sshd start=auto
35
+
net start sshd
36
+
copy id_ed25519.pub c:\programdata\ssh\administrators_authorized_keys
37
+
netsh advfirewall firewall set rule name="OpenSSH SSH Server (sshd)" new profile=any enable=yes
38
+
```
39
+
40
+
Install Git and ensure you restart your shell before continuing.
41
+
42
+
```
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
+
start /wait c:\windows\temp\git.exe /VERYSILENT /NORESTART /NOCANCEL /SP- /CLOSEAPPLICATIONS /RESTARTAPPLICATIONS /TASKS="addtopath"
45
+
```
46
+
47
+
Install Containerd. On the last line selection `ltsc2025` if using Windows Server 2025.
48
+
49
+
```
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
+
Set-ExecutionPolicy Bypass
52
+
.\install-containerd-runtime.ps1 -ContainerDVersion 2.1.3 -WinCNIVersion 0.3.1 -ExternalNetAdapter Ethernet -ContainerBaseImage mcr.microsoft.com/windows/servercore:ltsc2022
53
+
```
54
+
55
+
Create `C:\Program Files\containerd\cni\conf\0-containerd-nat.conf` containing
56
+
57
+
```
58
+
{
59
+
"cniVersion": "0.3.0",
60
+
"name": "nat",
61
+
"type": "nat",
62
+
"master": "Ethernet",
63
+
"ipam": {
64
+
"subnet": "172.20.0.0/16",
65
+
"routes": [
66
+
{
67
+
"gateway": "172.20.0.1"
68
+
}
69
+
]
70
+
},
71
+
"capabilities": {
72
+
"portMappings": true,
73
+
"dns": true
74
+
}
75
+
}
76
+
```
77
+
78
+
Install opam
79
+
80
+
```
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
+
opam init -y
83
+
```
84
+
85
+
Download and build mtelvers/hcn-namespace
86
+
87
+
```
88
+
git clone https://github.com/mtelvers/hcn-namespace
89
+
cd hcn-namespace
90
+
opam install . --deps-only
91
+
for /f "tokens=*" %i in ('opam env') do @%i
92
dune build
93
+
copy _build\install\default\bin\hcn-namespace.exe %LocalAppData%\opam\.cygwin\root\usr\local\bin
94
```
95
96
+
Build this project
97
+
98
```
99
+
git clone https://github.com/mtelvers/ohc -b tool
100
+
cd ohc
101
+
opam install . --deps-only
102
+
dune build
103
```
104
+
105
+
Run
106
+
107
+
```
108
+
git clone http://github.com/ocaml/opam-repository c:\opam-repository
109
+
mkdir c:\cache
110
+
make -j 6 SYSTEM=windows-x86_64 OUTPUT_DIR=./output CACHE_DIR=c:\\cache OPAM_REPO=c:\\opam-repository all
111
+
```
112
+
113
+
114
+
115
116
Next commit
117
+7
bin/config.ml
+7
bin/config.ml
+43
-65
bin/dir_context.ml
+43
-65
bin/dir_context.ml
···
8
9
let with_dir path fn =
10
let ch = Unix.opendir path in
11
-
Fun.protect ~finally:(fun () -> Unix.closedir ch)
12
-
(fun () -> fn ch)
13
14
let list_dir path =
15
let rec aux acc ch =
···
23
env : string -> OpamVariable.variable_contents option;
24
packages_dir : string;
25
pins : (OpamPackage.Version.t * OpamFile.OPAM.t) OpamPackage.Name.Map.t;
26
-
constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *)
27
test : OpamPackage.Name.Set.t;
28
prefer_oldest : bool;
29
}
···
33
match OpamPackage.Name.Map.find_opt name t.pins with
34
| Some (_, opam) -> opam
35
| None ->
36
-
let opam_path = t.packages_dir / OpamPackage.Name.to_string name / OpamPackage.to_string pkg / "opam" in
37
-
OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw opam_path))
38
39
-
let user_restrictions t name =
40
-
OpamPackage.Name.Map.find_opt name t.constraints
41
-
42
let dev = OpamPackage.Version.of_string "dev"
43
44
-
let std_env
45
-
?(ocaml_native=true)
46
-
?sys_ocaml_version
47
-
?opam_version
48
-
~arch ~os ~os_distribution ~os_family ~os_version
49
-
() =
50
-
function
51
| "arch" -> Some (OpamTypes.S arch)
52
| "os" -> Some (OpamTypes.S os)
53
| "os-distribution" -> Some (OpamTypes.S os_distribution)
54
| "os-version" -> Some (OpamTypes.S os_version)
55
| "os-family" -> Some (OpamTypes.S os_family)
56
-
| "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
57
| "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v)
58
| "ocaml:native" -> Some (OpamTypes.B ocaml_native)
59
-
| "enable-ocaml-beta-repository" -> None (* Fake variable? *)
60
| v ->
61
-
OpamConsole.warning "Unknown variable %S" v;
62
-
None
63
64
let env t pkg v =
65
if List.mem v OpamPackageVar.predefined_depends_variables then None
66
-
else match OpamVariable.Full.to_string v with
67
| "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg)))
68
| x -> t.env x
69
70
let filter_deps t pkg f =
71
let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in
72
let test = OpamPackage.Name.Set.mem (OpamPackage.name pkg) t.test in
73
-
f
74
-
|> OpamFilter.partial_filter_formula (env t pkg)
75
-
|> OpamFilter.filter_deps ~build:true ~post:true ~test ~doc:false ~dev ~dev_setup:false ~default:false
76
77
-
let version_compare t v1 v2 =
78
-
if t.prefer_oldest then
79
-
OpamPackage.Version.compare v1 v2
80
-
else
81
-
OpamPackage.Version.compare v2 v1
82
83
let candidates t name =
84
match OpamPackage.Name.Map.find_opt name t.pins with
85
-
| Some (version, opam) -> [version, Ok opam]
86
-
| None ->
87
-
let versions_dir = t.packages_dir / OpamPackage.Name.to_string name in
88
-
match list_dir versions_dir with
89
-
| versions ->
90
-
let user_constraints = user_restrictions t name in
91
-
versions
92
-
|> List.filter_map (fun dir ->
93
-
match OpamPackage.of_string_opt dir with
94
-
| Some pkg when Sys.file_exists (versions_dir / dir / "opam") -> Some (OpamPackage.version pkg)
95
-
| _ -> None
96
-
)
97
-
|> List.sort (version_compare t)
98
-
|> List.map (fun v ->
99
-
match user_constraints with
100
-
| Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) ->
101
-
v, Error (UserConstraint (name, Some test))
102
-
| _ ->
103
-
let pkg = OpamPackage.create name v in
104
-
let opam = load t pkg in
105
-
let available = OpamFile.OPAM.available opam in
106
-
match OpamFilter.eval ~default:(B false) (env t pkg) available with
107
-
| B true -> v, Ok opam
108
-
| B false -> v, Error Unavailable
109
-
| _ ->
110
-
OpamConsole.error "Available expression not a boolean: %s" (OpamFilter.to_string available);
111
-
v, Error Unavailable
112
-
)
113
-
| exception Unix.Unix_error (Unix.ENOENT, _, _) ->
114
-
OpamConsole.log "opam-0install" "Package %S not found!" (OpamPackage.Name.to_string name);
115
-
[]
116
117
let pp_rejection f = function
118
| UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x)
119
| Unavailable -> Fmt.string f "Availability condition not satisfied"
120
121
-
let create
122
-
?(prefer_oldest=false)
123
-
?(test=OpamPackage.Name.Set.empty)
124
-
?(pins=OpamPackage.Name.Map.empty)
125
-
~constraints ~env packages_dir =
126
{ env; packages_dir; pins; constraints; test; prefer_oldest }
127
-
···
8
9
let with_dir path fn =
10
let ch = Unix.opendir path in
11
+
Fun.protect ~finally:(fun () -> Unix.closedir ch) (fun () -> fn ch)
12
13
let list_dir path =
14
let rec aux acc ch =
···
22
env : string -> OpamVariable.variable_contents option;
23
packages_dir : string;
24
pins : (OpamPackage.Version.t * OpamFile.OPAM.t) OpamPackage.Name.Map.t;
25
+
constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *)
26
test : OpamPackage.Name.Set.t;
27
prefer_oldest : bool;
28
}
···
32
match OpamPackage.Name.Map.find_opt name t.pins with
33
| Some (_, opam) -> opam
34
| None ->
35
+
let opam_path = t.packages_dir / OpamPackage.Name.to_string name / OpamPackage.to_string pkg / "opam" in
36
+
OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw opam_path))
37
38
+
let user_restrictions t name = OpamPackage.Name.Map.find_opt name t.constraints
39
let dev = OpamPackage.Version.of_string "dev"
40
41
+
let std_env ?(ocaml_native = true) ?sys_ocaml_version ?opam_version ~arch ~os ~os_distribution ~os_family ~os_version () = function
42
| "arch" -> Some (OpamTypes.S arch)
43
| "os" -> Some (OpamTypes.S os)
44
| "os-distribution" -> Some (OpamTypes.S os_distribution)
45
| "os-version" -> Some (OpamTypes.S os_version)
46
| "os-family" -> Some (OpamTypes.S os_family)
47
+
| "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
48
| "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v)
49
| "ocaml:native" -> Some (OpamTypes.B ocaml_native)
50
+
| "enable-ocaml-beta-repository" -> None (* Fake variable? *)
51
| v ->
52
+
OpamConsole.warning "Unknown variable %S" v;
53
+
None
54
55
let env t pkg v =
56
if List.mem v OpamPackageVar.predefined_depends_variables then None
57
+
else
58
+
match OpamVariable.Full.to_string v with
59
| "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg)))
60
| x -> t.env x
61
62
let filter_deps t pkg f =
63
let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in
64
let test = OpamPackage.Name.Set.mem (OpamPackage.name pkg) t.test in
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
66
67
+
let version_compare t v1 v2 = if t.prefer_oldest then OpamPackage.Version.compare v1 v2 else OpamPackage.Version.compare v2 v1
68
69
let candidates t name =
70
match OpamPackage.Name.Map.find_opt name t.pins with
71
+
| Some (version, opam) -> [ (version, Ok opam) ]
72
+
| None -> (
73
+
let versions_dir = t.packages_dir / OpamPackage.Name.to_string name in
74
+
match list_dir versions_dir with
75
+
| versions ->
76
+
let user_constraints = user_restrictions t name in
77
+
versions
78
+
|> List.filter_map (fun dir ->
79
+
match OpamPackage.of_string_opt dir with
80
+
| Some pkg when Sys.file_exists (versions_dir / dir / "opam") -> Some (OpamPackage.version pkg)
81
+
| _ -> None)
82
+
|> List.sort (version_compare t)
83
+
|> List.map (fun v ->
84
+
match user_constraints with
85
+
| Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> (v, Error (UserConstraint (name, Some test)))
86
+
| _ -> (
87
+
let pkg = OpamPackage.create name v in
88
+
let opam = load t pkg in
89
+
let available = OpamFile.OPAM.available opam in
90
+
match OpamFilter.eval ~default:(B false) (env t pkg) available with
91
+
| B true -> (v, Ok opam)
92
+
| B false -> (v, Error Unavailable)
93
+
| _ ->
94
+
OpamConsole.error "Available expression not a boolean: %s" (OpamFilter.to_string available);
95
+
(v, Error Unavailable)))
96
+
| exception Unix.Unix_error (Unix.ENOENT, _, _) ->
97
+
OpamConsole.log "opam-0install" "Package %S not found!" (OpamPackage.Name.to_string name);
98
+
[])
99
100
let pp_rejection f = function
101
| UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x)
102
| Unavailable -> Fmt.string f "Availability condition not satisfied"
103
104
+
let create ?(prefer_oldest = false) ?(test = OpamPackage.Name.Set.empty) ?(pins = OpamPackage.Name.Map.empty) ~constraints ~env packages_dir =
105
{ env; packages_dir; pins; constraints; test; prefer_oldest }
-165
bin/json_config.ml
-165
bin/json_config.ml
···
1
-
type mount = {
2
-
ty : string;
3
-
src : string;
4
-
dst : string;
5
-
options : string list;
6
-
}
7
-
8
-
let mount ~ty ~options ~src dst =
9
-
`Assoc [ ("destination", `String dst); ("type", `String ty); ("source", `String src); ("options", `List (List.map (fun x -> `String x) options)) ]
10
-
11
-
let user_mounts = List.map @@ fun { ty; src; dst; options } -> mount ~ty ~options ~src dst
12
-
let strings xs = `List (List.map (fun x -> `String x) xs)
13
-
14
-
(* This is a subset of the capabilities that Docker uses by default.
15
-
These control what root can do in the container.
16
-
If the init process is non-root, permitted, effective and ambient sets are cleared.
17
-
See capabilities(7) for full details. *)
18
-
let default_linux_caps =
19
-
[
20
-
(* Make arbitrary changes to file UIDs and GIDs *)
21
-
"CAP_CHOWN";
22
-
(* Bypass file read, write, and execute permission checks. *)
23
-
"CAP_DAC_OVERRIDE";
24
-
(* Set SUID/SGID bits. *)
25
-
"CAP_FSETID";
26
-
(* Bypass permission checks. *)
27
-
"CAP_FOWNER";
28
-
(* Create special files using mknod. *)
29
-
"CAP_MKNOD";
30
-
(* Make arbitrary manipulations of process GIDs. *)
31
-
"CAP_SETGID";
32
-
(* Make arbitrary manipulations of process UIDs. *)
33
-
"CAP_SETUID";
34
-
(* Set arbitrary capabilities on a file. *)
35
-
"CAP_SETFCAP";
36
-
(* Add any capability from bounding set to inheritable set. *)
37
-
"CAP_SETPCAP";
38
-
(* Use chroot. *)
39
-
"CAP_SYS_CHROOT";
40
-
(* Bypass permission checks for sending signals. *)
41
-
"CAP_KILL";
42
-
(* Write records to kernel auditing log. *)
43
-
"CAP_AUDIT_WRITE";
44
-
]
45
-
46
-
let make ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t =
47
-
`Assoc
48
-
[
49
-
("ociVersion", `String "1.0.1-dev");
50
-
( "process",
51
-
`Assoc
52
-
[
53
-
("terminal", `Bool false);
54
-
("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]);
55
-
("args", strings argv);
56
-
("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env));
57
-
("cwd", `String cwd);
58
-
( "capabilities",
59
-
`Assoc
60
-
[
61
-
(* Limits capabilities gained on execve. *)
62
-
("bounding", strings default_linux_caps);
63
-
(* Checked by kernel to decide access *)
64
-
("effective", strings default_linux_caps);
65
-
(* Preserved across an execve (if root, or cap in ambient set) *)
66
-
("inheritable", strings default_linux_caps);
67
-
(* Limiting superset for the effective capabilities *)
68
-
("permitted", strings default_linux_caps);
69
-
] );
70
-
("rlimits", `List [ `Assoc [ ("type", `String "RLIMIT_NOFILE"); ("hard", `Int 1024); ("soft", `Int 1024) ] ]);
71
-
("noNewPrivileges", `Bool false);
72
-
] );
73
-
("root", `Assoc [ ("path", `String root); ("readonly", `Bool false) ]);
74
-
("hostname", `String hostname);
75
-
( "mounts",
76
-
`List
77
-
(user_mounts mounts
78
-
@ [
79
-
mount "/proc" ~options:[ (* TODO: copy to others? *) "nosuid"; "noexec"; "nodev" ] ~ty:"proc" ~src:"proc";
80
-
mount "/tmp" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "noatime"; "nodev"; "noexec"; "mode=1777" ];
81
-
mount "/dev" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "strictatime"; "mode=755"; "size=65536k" ];
82
-
mount "/dev/pts" ~ty:"devpts" ~src:"devpts" ~options:[ "nosuid"; "noexec"; "newinstance"; "ptmxmode=0666"; "mode=0620"; "gid=5" (* tty *) ];
83
-
mount "/sys" (* This is how Docker does it. runc's default is a bit different. *) ~ty:"sysfs" ~src:"sysfs"
84
-
~options:[ "nosuid"; "noexec"; "nodev"; "ro" ];
85
-
mount "/sys/fs/cgroup" ~ty:"cgroup" ~src:"cgroup" ~options:[ "ro"; "nosuid"; "noexec"; "nodev" ];
86
-
mount "/dev/shm" ~ty:"tmpfs" ~src:"shm" ~options:[ "nosuid"; "noexec"; "nodev"; "mode=1777"; "size=65536k" ];
87
-
mount "/dev/mqueue" ~ty:"mqueue" ~src:"mqueue" ~options:[ "nosuid"; "noexec"; "nodev" ];
88
-
]
89
-
@ if network then [ mount "/etc/resolv.conf" ~ty:"bind" ~src:"/etc/resolv.conf" ~options:[ "ro"; "rbind"; "rprivate" ] ] else []) );
90
-
( "linux",
91
-
`Assoc
92
-
[
93
-
( "namespaces",
94
-
`List
95
-
(List.map
96
-
(fun namespace -> `Assoc [ ("type", `String namespace) ])
97
-
((if network then [] else [ "network" ]) @ [ "pid"; "ipc"; "uts"; "mount" ])) );
98
-
( "maskedPaths",
99
-
strings
100
-
[
101
-
"/proc/acpi";
102
-
"/proc/asound";
103
-
"/proc/kcore";
104
-
"/proc/keys";
105
-
"/proc/latency_stats";
106
-
"/proc/timer_list";
107
-
"/proc/timer_stats";
108
-
"/proc/sched_debug";
109
-
"/sys/firmware";
110
-
"/proc/scsi";
111
-
] );
112
-
("readonlyPaths", strings [ "/proc/bus"; "/proc/fs"; "/proc/irq"; "/proc/sys"; "/proc/sysrq-trigger" ]);
113
-
( "seccomp",
114
-
`Assoc
115
-
([
116
-
("defaultAction", `String "SCMP_ACT_ALLOW");
117
-
( "syscalls",
118
-
`List
119
-
[
120
-
`Assoc
121
-
[
122
-
(* Sync calls are pointless for the builder, because if the computer crashes then we'll
123
-
just throw the build dir away and start again. And btrfs sync is really slow.
124
-
Based on https://bblank.thinkmo.de/using-seccomp-to-filter-sync-operations.html
125
-
Note: requires runc >= v1.0.0-rc92. *)
126
-
("names", strings [ "fsync"; "fdatasync"; "msync"; "sync"; "syncfs"; "sync_file_range" ]);
127
-
("action", `String "SCMP_ACT_ERRNO");
128
-
("errnoRet", `Int 0);
129
-
(* Return error "success" *)
130
-
];
131
-
] );
132
-
]
133
-
@ [ ("architectures", strings [ "SCMP_ARCH_X86_64"; "SCMP_ARCH_X86"; "SCMP_ARCH_X32" ]) ]) );
134
-
] );
135
-
]
136
-
137
-
138
-
let make_ctr ~layers ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t =
139
-
`Assoc
140
-
[
141
-
("ociVersion", `String "1.1.0");
142
-
( "process",
143
-
`Assoc
144
-
[
145
-
("terminal", `Bool false);
146
-
("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]);
147
-
("args", strings argv);
148
-
("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env));
149
-
("cwd", `String cwd);
150
-
] );
151
-
("root", `Assoc [ ("path", `String ""); ("readonly", `Bool false) ]);
152
-
("hostname", `String hostname);
153
-
( "mounts", `List (user_mounts mounts));
154
-
( "windows",
155
-
`Assoc
156
-
[
157
-
( "layerFolders", strings layers);
158
-
("ignoreFlushesDuringBoot", `Bool true);
159
-
("network", `Assoc [
160
-
("allowUnqualifiedDNSQuery", `Bool true);
161
-
("networkNamespace", `String network);
162
-
]);
163
-
] );
164
-
]
165
-
···
-31
bin/json_config.mli
-31
bin/json_config.mli
···
1
-
type mount = {
2
-
ty : string;
3
-
src : string;
4
-
dst : string;
5
-
options : string list;
6
-
}
7
-
8
-
val make :
9
-
root:string ->
10
-
cwd:string ->
11
-
argv:string list ->
12
-
hostname:string ->
13
-
uid:int ->
14
-
gid:int ->
15
-
env:(string * string) list ->
16
-
mounts:mount list ->
17
-
network:bool ->
18
-
Yojson.Safe.t
19
-
20
-
val make_ctr :
21
-
layers:string list ->
22
-
cwd:string ->
23
-
argv:string list ->
24
-
hostname:string ->
25
-
uid:int ->
26
-
gid:int ->
27
-
env:(string * string) list ->
28
-
mounts:mount list ->
29
-
network:string ->
30
-
Yojson.Safe.t
31
-
···
+8
-13
bin/json_layers.ml
+8
-13
bin/json_layers.ml
···
1
-
2
-
type parent_layer_paths = {
3
-
parentLayerPaths: string list; [@key "parentLayerPaths"]
4
-
} [@@deriving yojson]
5
6
type layer = {
7
type_ : string;
···
15
raw_source : string; [@key "Source"]
16
raw_target : string; [@key "Target"]
17
raw_options : string list; [@key "Options"]
18
-
} [@@deriving yojson]
19
20
let parse_option_string str =
21
if String.starts_with ~prefix:"parentLayerPaths=" str then
22
try
23
let json_part = String.sub str 17 (String.length str - 17) in
24
let full_json = "{\"parentLayerPaths\":" ^ json_part ^ "}" in
25
-
Yojson.Safe.from_string full_json
26
-
|> parent_layer_paths_of_yojson
27
-
|> Result.to_option
28
with
29
| _ -> None
30
-
else
31
-
None
32
33
-
let layer_of_raw (raw_layer:raw_layer) =
34
{
35
type_ = raw_layer.raw_type_;
36
source = raw_layer.raw_source;
···
50
let read_layers path =
51
let mounts = Os.read_from_file path in
52
match parse_layers mounts with
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)
54
| Error _ -> []
55
-
···
1
+
type parent_layer_paths = { parentLayerPaths : string list [@key "parentLayerPaths"] } [@@deriving yojson]
2
3
type layer = {
4
type_ : string;
···
12
raw_source : string; [@key "Source"]
13
raw_target : string; [@key "Target"]
14
raw_options : string list; [@key "Options"]
15
+
}
16
+
[@@deriving yojson]
17
18
let parse_option_string str =
19
if String.starts_with ~prefix:"parentLayerPaths=" str then
20
try
21
let json_part = String.sub str 17 (String.length str - 17) in
22
let full_json = "{\"parentLayerPaths\":" ^ json_part ^ "}" in
23
+
Yojson.Safe.from_string full_json |> parent_layer_paths_of_yojson |> Result.to_option
24
with
25
| _ -> None
26
+
else None
27
28
+
let layer_of_raw (raw_layer : raw_layer) =
29
{
30
type_ = raw_layer.raw_type_;
31
source = raw_layer.raw_source;
···
45
let read_layers path =
46
let mounts = Os.read_from_file path in
47
match parse_layers mounts with
48
+
| Ok layers ->
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
50
| Error _ -> []
+243
bin/linux.ml
+243
bin/linux.ml
···
···
1
+
type t = { config : Config.t }
2
+
3
+
let hostname = "builder"
4
+
5
+
let env =
6
+
[
7
+
("PATH", "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin");
8
+
("HOME", "/home/opam");
9
+
("OPAMYES", "1");
10
+
("OPAMCONFIRMLEVEL", "unsafe-yes");
11
+
("OPAMERRLOGLEN", "0");
12
+
("OPAMPRECISETRACKING", "1");
13
+
]
14
+
15
+
let std_env = Util.std_env ~arch:"x86_64" ~os:"linux" ~os_distribution:"debian" ~os_family:"debian" ~os_version:"12" ()
16
+
17
+
(* This is a subset of the capabilities that Docker uses by default.
18
+
These control what root can do in the container.
19
+
If the init process is non-root, permitted, effective and ambient sets are cleared.
20
+
See capabilities(7) for full details. *)
21
+
let default_linux_caps =
22
+
[
23
+
(* Make arbitrary changes to file UIDs and GIDs *)
24
+
"CAP_CHOWN";
25
+
(* Bypass file read, write, and execute permission checks. *)
26
+
"CAP_DAC_OVERRIDE";
27
+
(* Set SUID/SGID bits. *)
28
+
"CAP_FSETID";
29
+
(* Bypass permission checks. *)
30
+
"CAP_FOWNER";
31
+
(* Create special files using mknod. *)
32
+
"CAP_MKNOD";
33
+
(* Make arbitrary manipulations of process GIDs. *)
34
+
"CAP_SETGID";
35
+
(* Make arbitrary manipulations of process UIDs. *)
36
+
"CAP_SETUID";
37
+
(* Set arbitrary capabilities on a file. *)
38
+
"CAP_SETFCAP";
39
+
(* Add any capability from bounding set to inheritable set. *)
40
+
"CAP_SETPCAP";
41
+
(* Use chroot. *)
42
+
"CAP_SYS_CHROOT";
43
+
(* Bypass permission checks for sending signals. *)
44
+
"CAP_KILL";
45
+
(* Write records to kernel auditing log. *)
46
+
"CAP_AUDIT_WRITE";
47
+
]
48
+
49
+
let strings xs = `List (List.map (fun x -> `String x) xs)
50
+
51
+
let make ~root ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t =
52
+
`Assoc
53
+
[
54
+
("ociVersion", `String "1.0.1-dev");
55
+
( "process",
56
+
`Assoc
57
+
[
58
+
("terminal", `Bool false);
59
+
("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]);
60
+
("args", strings argv);
61
+
("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env));
62
+
("cwd", `String cwd);
63
+
( "capabilities",
64
+
`Assoc
65
+
[
66
+
(* Limits capabilities gained on execve. *)
67
+
("bounding", strings default_linux_caps);
68
+
(* Checked by kernel to decide access *)
69
+
("effective", strings default_linux_caps);
70
+
(* Preserved across an execve (if root, or cap in ambient set) *)
71
+
("inheritable", strings default_linux_caps);
72
+
(* Limiting superset for the effective capabilities *)
73
+
("permitted", strings default_linux_caps);
74
+
] );
75
+
("rlimits", `List [ `Assoc [ ("type", `String "RLIMIT_NOFILE"); ("hard", `Int 1024); ("soft", `Int 1024) ] ]);
76
+
("noNewPrivileges", `Bool false);
77
+
] );
78
+
("root", `Assoc [ ("path", `String root); ("readonly", `Bool false) ]);
79
+
("hostname", `String hostname);
80
+
( "mounts",
81
+
`List
82
+
(Mount.user_mounts mounts
83
+
@ [
84
+
Mount.make "/proc" ~options:[ (* TODO: copy to others? *) "nosuid"; "noexec"; "nodev" ] ~ty:"proc" ~src:"proc";
85
+
Mount.make "/tmp" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "noatime"; "nodev"; "noexec"; "mode=1777" ];
86
+
Mount.make "/dev" ~ty:"tmpfs" ~src:"tmpfs" ~options:[ "nosuid"; "strictatime"; "mode=755"; "size=65536k" ];
87
+
Mount.make "/dev/pts" ~ty:"devpts" ~src:"devpts" ~options:[ "nosuid"; "noexec"; "newinstance"; "ptmxmode=0666"; "mode=0620"; "gid=5" (* tty *) ];
88
+
Mount.make "/sys" (* This is how Docker does it. runc's default is a bit different. *) ~ty:"sysfs" ~src:"sysfs"
89
+
~options:[ "nosuid"; "noexec"; "nodev"; "ro" ];
90
+
Mount.make "/sys/fs/cgroup" ~ty:"cgroup" ~src:"cgroup" ~options:[ "ro"; "nosuid"; "noexec"; "nodev" ];
91
+
Mount.make "/dev/shm" ~ty:"tmpfs" ~src:"shm" ~options:[ "nosuid"; "noexec"; "nodev"; "mode=1777"; "size=65536k" ];
92
+
Mount.make "/dev/mqueue" ~ty:"mqueue" ~src:"mqueue" ~options:[ "nosuid"; "noexec"; "nodev" ];
93
+
]
94
+
@ if network then [ Mount.make "/etc/resolv.conf" ~ty:"bind" ~src:"/etc/resolv.conf" ~options:[ "ro"; "rbind"; "rprivate" ] ] else []) );
95
+
( "linux",
96
+
`Assoc
97
+
[
98
+
( "namespaces",
99
+
`List
100
+
(List.map
101
+
(fun namespace -> `Assoc [ ("type", `String namespace) ])
102
+
((if network then [] else [ "network" ]) @ [ "pid"; "ipc"; "uts"; "mount" ])) );
103
+
( "maskedPaths",
104
+
strings
105
+
[
106
+
"/proc/acpi";
107
+
"/proc/asound";
108
+
"/proc/kcore";
109
+
"/proc/keys";
110
+
"/proc/latency_stats";
111
+
"/proc/timer_list";
112
+
"/proc/timer_stats";
113
+
"/proc/sched_debug";
114
+
"/sys/firmware";
115
+
"/proc/scsi";
116
+
] );
117
+
("readonlyPaths", strings [ "/proc/bus"; "/proc/fs"; "/proc/irq"; "/proc/sys"; "/proc/sysrq-trigger" ]);
118
+
( "seccomp",
119
+
`Assoc
120
+
([
121
+
("defaultAction", `String "SCMP_ACT_ALLOW");
122
+
( "syscalls",
123
+
`List
124
+
[
125
+
`Assoc
126
+
[
127
+
(* Sync calls are pointless for the builder, because if the computer crashes then we'll
128
+
just throw the build dir away and start again. And btrfs sync is really slow.
129
+
Based on https://bblank.thinkmo.de/using-seccomp-to-filter-sync-operations.html
130
+
Note: requires runc >= v1.0.0-rc92. *)
131
+
("names", strings [ "fsync"; "fdatasync"; "msync"; "sync"; "syncfs"; "sync_file_range" ]);
132
+
("action", `String "SCMP_ACT_ERRNO");
133
+
("errnoRet", `Int 0);
134
+
(* Return error "success" *)
135
+
];
136
+
] );
137
+
]
138
+
@ [ ("architectures", strings [ "SCMP_ARCH_X86_64"; "SCMP_ARCH_X86"; "SCMP_ARCH_X32" ]) ]) );
139
+
] );
140
+
]
141
+
142
+
let init ~(config : Config.t) = { config }
143
+
let deinit ~t:_ = ()
144
+
let config ~t = t.config
145
+
146
+
let run ~t:_ ~temp_dir opam_repository build_log =
147
+
let rootfs = Os.path [ temp_dir; "fs" ] in
148
+
let () = Os.mkdir rootfs in
149
+
let _ = Os.sudo [ "/usr/bin/env"; "bash"; "-c"; "docker export $(docker run -d debian:12) | sudo tar -C " ^ rootfs ^ " -x" ] in
150
+
let opam = Os.path [ rootfs; "/usr/local/bin/opam" ] in
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
+
let _ = Os.sudo [ "sudo"; "chmod"; "+x"; opam ] in
153
+
let _ = Os.sudo [ "cp"; "/home/mtelvers/opam_build/_build/default/bin/main.exe"; Os.path [ rootfs; "/usr/local/bin/opam-build" ] ] in
154
+
let etc_hosts = Os.path [ temp_dir; "hosts" ] in
155
+
let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in
156
+
let argv =
157
+
[
158
+
"/usr/bin/env";
159
+
"bash";
160
+
"-c";
161
+
String.concat " && "
162
+
[
163
+
"apt update";
164
+
"apt upgrade -y";
165
+
"apt install build-essential unzip bubblewrap git sudo curl rsync -y";
166
+
"adduser --disabled-password --gecos '@opam' --no-create-home --home /home/opam opam";
167
+
"chown -R $(id -u opam):$(id -g opam) /home/opam";
168
+
{|echo "opam ALL=(ALL:ALL) NOPASSWD:ALL" > /etc/sudoers.d/opam|};
169
+
"su - opam -c 'opam init -k local -a /home/opam/opam-repository --bare -y'";
170
+
"su - opam -c 'opam switch create default --empty'";
171
+
];
172
+
]
173
+
in
174
+
let mounts =
175
+
[
176
+
{ Mount.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] };
177
+
{ ty = "bind"; src = opam_repository; dst = "/home/opam/opam-repository"; options = [ "rbind"; "rprivate" ] };
178
+
]
179
+
in
180
+
let config = make ~root:rootfs ~cwd:"/home/opam" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:true in
181
+
let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in
182
+
let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in
183
+
let _ = Os.rm (Os.path [ rootfs; "home"; "opam"; ".opam"; "repo"; "state-33BF9E46.cache" ]) in
184
+
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
185
+
()
186
+
187
+
let build ~t ~temp_dir build_log pkg dependencies deps =
188
+
let config = t.config in
189
+
let lowerdir = Os.path [ config.dir; "root"; "fs" ] in
190
+
let upperdir = Os.path [ temp_dir; "fs" ] in
191
+
let () = Os.mkdir upperdir in
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
+
let argv = [ "/usr/bin/env"; "bash"; "-c"; String.concat " && " (pin @ [ "opam-build -v " ^ OpamPackage.to_string pkg ]) ] in
194
+
let workdir = Os.path [ temp_dir; "work" ] in
195
+
let () = Os.mkdir workdir in
196
+
let () =
197
+
OpamPackage.Set.iter
198
+
(fun dep ->
199
+
let hash = Util.hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in
200
+
assert (
201
+
0
202
+
= Os.sudo
203
+
[
204
+
"cp";
205
+
(* "--no-clobber"; *)
206
+
"--update=none";
207
+
"--archive";
208
+
"--no-dereference";
209
+
"--recursive";
210
+
"--link";
211
+
"--no-target-directory";
212
+
Os.path [ config.dir; hash; "fs" ];
213
+
upperdir;
214
+
]))
215
+
deps
216
+
in
217
+
let () =
218
+
let default_switch = Os.path [ temp_dir; "fs"; "home"; "opam"; ".opam"; "default" ] in
219
+
if Sys.file_exists default_switch then Opamh.dump_state default_switch
220
+
in
221
+
let etc_hosts = Os.path [ temp_dir; "hosts" ] in
222
+
let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in
223
+
let mounts =
224
+
[
225
+
{ Mount.ty = "overlay"; src = "overlay"; dst = "/"; options = [ "lowerdir=" ^ lowerdir; "upperdir=" ^ upperdir; "workdir=" ^ workdir ] };
226
+
{ ty = "bind"; src = config.opam_repository; dst = "/home/opam/.opam/repo/default"; options = [ "rbind"; "rprivate" ] };
227
+
{ ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] };
228
+
]
229
+
in
230
+
let mounts =
231
+
match config.directory with
232
+
| None -> mounts
233
+
| Some src -> mounts @ [ { ty = "bind"; src; dst = "/home/opam/src"; options = [ "rw"; "rbind"; "rprivate" ] } ]
234
+
in
235
+
let () = Os.mkdir (Os.path [ temp_dir; "dummy" ]) in
236
+
let config = make ~root:"dummy" ~cwd:"/home/opam" ~argv ~hostname ~uid:1000 ~gid:1000 ~env ~mounts ~network:true in
237
+
let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in
238
+
let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in
239
+
let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "tmp" ] ] in
240
+
let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/sources" ] ] in
241
+
let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/build" ] ] in
242
+
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
243
+
()
+61
-292
bin/main.ml
+61
-292
bin/main.ml
···
4
module Role = Solver.Input.Role
5
module Role_map = Output.RoleMap
6
7
-
type config = {
8
-
dir : string;
9
-
opam_repository : string;
10
-
package : string;
11
-
directory : string option;
12
-
md : string option;
13
-
network : string option;
14
-
}
15
16
-
let hostname = "builder"
17
18
-
let create_network () = match Sys.win32 with
19
-
| true -> Os.run "hcn-namespace create" |> String.trim
20
-
| false -> ""
21
-
22
-
let delete_network = function
23
-
| Some n -> Os.exec ["hcn-namespace"; "delete"; n]
24
-
| None -> 0
25
-
26
-
let env =
27
-
[
28
-
("PATH", "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin");
29
-
("HOME", "/home/opam");
30
-
("OPAMYES", "1");
31
-
("OPAMCONFIRMLEVEL", "unsafe-yes");
32
-
("OPAMERRLOGLEN", "0");
33
-
("OPAMPRECISETRACKING", "1");
34
-
]
35
-
36
-
let win_env =
37
-
[
38
-
("OPAMYES", "1");
39
-
("OPAMCONFIRMLEVEL", "unsafe-yes");
40
-
("OPAMERRLOGLEN", "0");
41
-
("OPAMPRECISETRACKING", "1");
42
-
]
43
-
44
-
let init config =
45
let root = Os.path [ config.dir; "root" ] in
46
if not (Sys.file_exists root) then
47
Os.create_directory_exclusively root @@ fun target_dir ->
48
let temp_dir = Filename.temp_dir ~temp_dir:config.dir ~perms:0o755 "temp-" "" in
49
-
let rootfs = Os.path [ temp_dir; "fs" ] in
50
-
let () = Os.mkdir rootfs in
51
let opam_repository = Os.path [ temp_dir; "opam-repository" ] in
52
let () = Os.mkdir opam_repository in
53
let () = Os.write_to_file (Os.path [ opam_repository; "repo" ]) {|opam-version: "2.0"|} in
54
let build_log = Os.path [ temp_dir; "build.log" ] in
55
-
match Sys.win32 with
56
-
| false ->
57
-
let _ = Os.sudo [ "/usr/bin/env"; "bash"; "-c"; "docker export $(docker run -d debian:12) | sudo tar -C " ^ rootfs ^ " -x" ] in
58
-
let opam = Os.path [ rootfs; "/usr/local/bin/opam" ] in
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
-
let _ = Os.sudo [ "sudo"; "chmod"; "+x"; opam ] in
61
-
let _ = Os.sudo [ "cp"; "/home/mtelvers/opam_build/_build/default/bin/main.exe"; Os.path [ rootfs; "/usr/local/bin/opam-build" ] ] in
62
-
let etc_hosts = Os.path [ temp_dir; "hosts" ] in
63
-
let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in
64
-
let argv =
65
-
[
66
-
"/usr/bin/env";
67
-
"bash";
68
-
"-c";
69
-
String.concat " && "
70
-
[
71
-
"apt update";
72
-
"apt upgrade -y";
73
-
"apt install build-essential unzip bubblewrap git sudo curl rsync -y";
74
-
"adduser --disabled-password --gecos '@opam' --no-create-home --home /home/opam opam";
75
-
"chown -R $(id -u opam):$(id -g opam) /home/opam";
76
-
{|echo "opam ALL=(ALL:ALL) NOPASSWD:ALL" > /etc/sudoers.d/opam|};
77
-
"su - opam -c 'opam init -k local -a /home/opam/opam-repository --bare -y'";
78
-
"su - opam -c 'opam switch create default --empty'";
79
-
];
80
-
]
81
-
in
82
-
let mounts =
83
-
[
84
-
{ Json_config.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] };
85
-
{ ty = "bind"; src = opam_repository; dst = "/home/opam/opam-repository"; options = [ "rbind"; "rprivate" ] };
86
-
]
87
-
in
88
-
let config = Json_config.make ~root:rootfs ~cwd:"/home/opam" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:true in
89
-
let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in
90
-
let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in
91
-
let _ = Os.rm (Os.path [ rootfs; "home"; "opam"; ".opam"; "repo"; "state-33BF9E46.cache" ] ) in
92
-
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
93
-
Unix.rename temp_dir target_dir
94
-
| true ->
95
-
let argv =
96
-
[
97
-
"cmd";
98
-
"/c";
99
-
String.concat " && "
100
-
[
101
-
"set";
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
-
"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
-
(* "net user opam /nopassword /add"; *)
105
-
"opam.exe init -k local -a c:\\opam-repository --bare -y";
106
-
"opam.exe switch create default --empty";
107
-
];
108
-
]
109
-
in
110
-
let mounts =
111
-
[
112
-
{ Json_config.ty = "bind"; src = rootfs; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] };
113
-
(*{ Json_config.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; *)
114
-
{ ty = "bind"; src = opam_repository; dst = "c:\\opam-repository"; options = [ "rbind"; "rprivate" ] };
115
-
]
116
-
in
117
-
let mounts_json = Os.path [ temp_dir; "mounts.json" ] in
118
-
let _ = Os.retry_exec ~stdout:mounts_json [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] in
119
-
let layers = Json_layers.read_layers mounts_json in
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
-
let config_json = Os.path [ temp_dir; "config.json" ] in
122
-
let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in
123
-
let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in
124
-
let _ = Os.rm (Os.path [ rootfs; "lock" ] ) in
125
-
let _ = Os.rm (Os.path [ rootfs; "conf.lock" ] ) in
126
-
let _ = Os.rm (Os.path [ rootfs; "default"; ".opam-switch"; "lock" ] ) in
127
-
let _ = Os.rm (Os.path [ rootfs; "repo"; "state-33BF9E46.cache" ] ) in
128
-
let _ = Os.rm (Os.path [ rootfs; "repo"; "conf.lock" ] ) in
129
-
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
130
-
let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in
131
Unix.rename temp_dir target_dir
132
133
let () = OpamFormatConfig.init ()
···
136
let _ = OpamStateConfig.load_defaults root *)
137
let () = OpamCoreConfig.init ?debug_level:(Some 10) ?debug_sections:(Some (OpamStd.String.Map.singleton "foo" (Some 10))) ()
138
139
-
let std_env
140
-
?(ocaml_native=true)
141
-
?opam_version
142
-
~arch ~os ~os_distribution ~os_family ~os_version
143
-
() =
144
-
function
145
-
| "arch" -> Some (OpamTypes.S arch)
146
-
| "os" -> Some (OpamTypes.S os)
147
-
| "os-distribution" -> Some (OpamTypes.S os_distribution)
148
-
| "os-version" -> Some (OpamTypes.S os_version)
149
-
| "os-family" -> Some (OpamTypes.S os_family)
150
-
| "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
151
-
(* There is no system compliler *)
152
-
| "sys-ocaml-arch"
153
-
| "sys-ocaml-cc"
154
-
| "sys-ocaml-libc"
155
-
| "sys-ocaml-system"
156
-
| "sys-ocaml-version" -> Some (OpamTypes.S "")
157
-
| "ocaml:native" -> Some (OpamTypes.B ocaml_native)
158
-
| "ocaml:version" -> Some (OpamTypes.S "5.3.0")
159
-
| "enable-ocaml-beta-repository" -> None (* Fake variable? *)
160
-
| v ->
161
-
OpamConsole.warning "Unknown variable %S" v;
162
-
None
163
-
164
-
let std_env = match Sys.win32 with
165
-
| false -> std_env ~arch:"x86_64" ~os:"linux" ~os_distribution:"debian" ~os_family:"debian" ~os_version:"12" ()
166
-
| true -> std_env ~arch:"x86_64" ~os:"win32" ~os_distribution:"cygwin" ~os_family:"windows" ~os_version:"10.0.20348" ()
167
-
168
let opam_env pkg v =
169
(* if List.mem v OpamPackageVar.predefined_depends_variables then (Some (OpamTypes.B true))
170
else *)
···
178
Some (OpamTypes.B false)
179
| "build" -> Some (OpamTypes.B true)
180
| "post" -> None
181
-
| x -> std_env x
182
183
-
let solve config ocaml_version pkg =
184
let constraints =
185
OpamPackage.Name.Map.of_list
186
[ (OpamPackage.name ocaml_version, (`Eq, OpamPackage.version ocaml_version)); (OpamPackage.name pkg, (`Eq, OpamPackage.version pkg)) ]
···
193
|> OpamPackage.Name.Map.add (OpamPackage.Name.of_string config.package)
194
(OpamPackage.Version.of_string "dev", OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw (Os.path [ directory; config.package ^ ".opam" ]))))
195
in
196
-
let context = Dir_context.create ~env:std_env ~constraints ~pins (Os.path [ config.opam_repository; "packages" ]) in
197
let r = Solver.solve context [ OpamPackage.name pkg ] in
198
match r with
199
| Ok out ->
···
269
installable @ topological_sort pkgs
270
271
let pkg_deps solution =
272
-
List.fold_left (fun map pkg ->
273
-
let deps_direct = OpamPackage.Map.find pkg solution in
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
-
OpamPackage.Map.add pkg deps_plus_children map) OpamPackage.Map.empty
276
-
277
-
let hash_of_set s = s |> OpamPackage.Set.to_list |> List.map OpamPackage.to_string |> String.concat " " |> Digest.string |> Digest.to_hex
278
279
type build_result =
280
| No_solution
···
288
| Failure _ -> "failure"
289
| Success _ -> "success"
290
291
-
let build_layer config solution dependencies pkg =
292
let () = Printf.printf "Layer %s: %!" (OpamPackage.to_string pkg) in
293
let deps = OpamPackage.Map.find pkg solution in
294
-
let hash = hash_of_set (OpamPackage.Set.add pkg (OpamPackage.Map.find pkg dependencies)) in
295
let layer_dir = Os.path [ config.dir; hash ] in
296
let () = Printf.printf "layer_dir %s\n%!" layer_dir in
297
let write_layer target_dir =
···
299
let () = Printf.printf "temp_dir %s\n%!" temp_dir in
300
let () = Os.write_to_file (Os.path [ temp_dir; "package" ]) (OpamPackage.to_string pkg) in
301
let () = Os.write_to_file (Os.path [ temp_dir; "packages" ]) (OpamPackage.Set.to_string deps) in
302
-
let lowerdir = Os.path [ config.dir; "root"; "fs" ] in
303
-
let upperdir = Os.path [ temp_dir; "fs" ] in
304
let build_log = Os.path [ temp_dir; "build.log" ] in
305
-
let () = Os.mkdir upperdir in
306
-
(
307
-
match Sys.win32 with
308
-
| false ->
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
-
let argv = [ "/usr/bin/env"; "bash"; "-c"; String.concat " && " (pin @ [ "opam-build -v " ^ OpamPackage.to_string pkg ]) ] in
311
-
let workdir = Os.path [ temp_dir; "work" ] in
312
-
let () = Os.mkdir workdir in
313
-
let () =
314
-
OpamPackage.Set.iter
315
-
(fun dep ->
316
-
let hash = hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in
317
-
assert (
318
-
0
319
-
= Os.sudo
320
-
[
321
-
"cp";
322
-
(* "--no-clobber"; *)
323
-
"--update=none";
324
-
"--archive";
325
-
"--no-dereference";
326
-
"--recursive";
327
-
"--link";
328
-
"--no-target-directory";
329
-
Os.path [ config.dir; hash; "fs" ];
330
-
upperdir;
331
-
]))
332
-
deps
333
-
in
334
-
let () =
335
-
let default_switch = Os.path [ temp_dir; "fs"; "home"; "opam"; ".opam"; "default" ] in
336
-
if Sys.file_exists default_switch then Opamh.dump_state default_switch
337
-
in
338
-
let etc_hosts = Os.path [ temp_dir; "hosts" ] in
339
-
let () = Os.write_to_file etc_hosts ("127.0.0.1 localhost " ^ hostname) in
340
-
let mounts =
341
-
[
342
-
{ Json_config.ty = "overlay"; src = "overlay"; dst = "/"; options = [ "lowerdir=" ^ lowerdir; "upperdir=" ^ upperdir; "workdir=" ^ workdir ] };
343
-
{ ty = "bind"; src = config.opam_repository; dst = "/home/opam/.opam/repo/default"; options = [ "rbind"; "rprivate" ] };
344
-
{ ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] };
345
-
]
346
-
in
347
-
let mounts =
348
-
match config.directory with
349
-
| None -> mounts
350
-
| Some src -> mounts @ [{ ty = "bind"; src; dst = "/home/opam/src"; options = [ "rw"; "rbind"; "rprivate" ] }]
351
-
in
352
-
let () = Os.mkdir (Os.path [ temp_dir; "dummy" ]) in
353
-
let config = Json_config.make ~root:"dummy" ~cwd:"/home/opam" ~argv ~hostname ~uid:1000 ~gid:1000 ~env ~mounts ~network:true in
354
-
let () = Os.write_to_file (Os.path [ temp_dir; "config.json" ]) (Yojson.Safe.pretty_to_string config) in
355
-
let result = Os.sudo ~stdout:build_log ~stderr:build_log [ "runc"; "run"; "-b"; temp_dir; Filename.basename temp_dir ] in
356
-
let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "tmp" ] ] in
357
-
let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/sources" ] ] in
358
-
let _ = Os.sudo [ "rm"; "-rf"; Os.path [ upperdir; "home/opam/.opam/default/.opam-switch/build" ] ] in
359
-
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
360
-
Unix.rename temp_dir target_dir
361
-
| true ->
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
-
let argv = [ "cmd"; "/c"; String.concat " && " (pin @ [ "set && c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam\\opam-build.exe -v " ^ OpamPackage.to_string pkg ]) ] in
364
-
let _ = Os.hardlink_tree ~source:(Os.path [ config.dir; "root"; "fs" ]) ~target:upperdir in
365
-
let () =
366
-
OpamPackage.Set.iter
367
-
(fun dep ->
368
-
let hash = hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in
369
-
Os.hardlink_tree ~source:(Os.path [ config.dir; hash; "fs"]) ~target:upperdir)
370
-
deps
371
-
in
372
-
373
-
let () =
374
-
let default_switch = Os.path [ temp_dir; "fs"; "default" ] in
375
-
if Sys.file_exists default_switch then Opamh.dump_state default_switch
376
-
in
377
-
let mounts =
378
-
[
379
-
{ Json_config.ty = "bind"; src = upperdir; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] };
380
-
{ ty = "bind"; src = config.opam_repository; dst = "c:\\users\\ContainerAdministrator\\AppData\\Local\\opam\\repo\\default"; options = [ "rbind"; "rprivate" ] };
381
-
]
382
-
in
383
-
let mounts_json = Os.path [ temp_dir; "mounts.json" ] in
384
-
let _ = Os.retry_exec ~stdout:mounts_json [ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ] in
385
-
let layers = Json_layers.read_layers mounts_json in
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
-
let config_json = Os.path [ temp_dir; "config.json" ] in
388
-
let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in
389
-
let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in
390
-
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
391
-
let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in
392
-
let _ = Os.rm (Os.path [ upperdir; "repo"; "state-33BF9E46.cache" ] ) in
393
-
let _ = Os.rm ~recursive:true (Os.path [ upperdir; "default"; ".opam-switch"; "sources" ] ) in
394
-
let _ = Os.rm ~recursive:true (Os.path [ upperdir; "default"; ".opam-switch"; "build" ] ) in
395
-
let _ = Os.rm (Os.path [ upperdir; "default"; ".opam-switch"; "lock" ] ) in
396
Unix.rename temp_dir target_dir
397
-
)
398
in
399
let () = if not (Sys.file_exists layer_dir) then Os.create_directory_exclusively layer_dir write_layer in
400
let () = Os.write_to_file (Os.path [ layer_dir; "last_used" ]) (Unix.time () |> string_of_float) in
···
406
407
let reduce dependencies =
408
OpamPackage.Map.map (fun u ->
409
-
OpamPackage.Set.filter (fun v ->
410
-
let others = OpamPackage.Set.remove v u in
411
-
OpamPackage.Set.fold (fun o acc ->
412
-
acc || OpamPackage.Set.mem v (OpamPackage.Map.find o dependencies)
413
-
) others false |> not
414
-
) u
415
-
)
416
417
let build config ocaml_version package =
418
let solution = solve config ocaml_version package in
419
-
(* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".dot") solution in *)
420
-
if OpamPackage.Map.is_empty solution then
421
-
[ No_solution ]
422
else
423
let ordered_installation = topological_sort solution in
424
let dependencies = pkg_deps solution ordered_installation in
425
let solution = reduce dependencies solution in
426
-
(* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".reduced.dot") solution in *)
427
-
List.fold_left
428
-
(fun lst pkg ->
429
-
match lst with
430
-
| [] -> [ build_layer config solution dependencies pkg ]
431
-
| Success _ :: _ -> build_layer config solution dependencies pkg :: lst
432
-
| _ -> Dependency_failed :: lst)
433
-
[] ordered_installation
434
435
let ocaml_version = OpamPackage.create (OpamPackage.Name.of_string "ocaml") (OpamPackage.Version.of_string "5.3.0")
436
···
458
459
open Cmdliner
460
461
-
let output config results =
462
match config.md with
463
| Some filename ->
464
-
let oc = open_out filename in
465
-
let cmd = Printf.sprintf "git -C %s rev-parse HEAD" config.opam_repository in
466
-
let opam_repo_sha = Os.run cmd |> String.trim in
467
-
let () = Printf.fprintf oc "---\nstatus: %s\ncommit: %s\npackage: %s\n---\n\n"
468
-
(build_result_to_string (List.hd results))
469
-
opam_repo_sha config.package in
470
-
let () = List.rev results |> List.iter (function
471
-
| Success log
472
-
| Failure log -> output_string oc log
473
-
| _ -> ()) in
474
-
close_out oc
475
-
| None ->
476
-
print_string (build_result_to_string (List.hd results))
477
478
-
let run_ci config =
479
-
init config;
480
let package = OpamPackage.of_string (config.package ^ ".dev") in
481
-
let config = { config with network = Some (create_network ()) } in
482
let results = build config ocaml_version package in
483
-
let _ = delete_network config.network in
484
output config results
485
486
-
let run_health_check config =
487
-
init config;
488
let package = OpamPackage.of_string config.package in
489
-
let config = { config with network = Some (create_network ()) } in
490
let results = build config ocaml_version package in
491
-
let _ = delete_network config.network in
492
output config results
493
494
let cache_dir_term =
···
501
502
let md_term =
503
let doc = "Output results in markdown format" in
504
-
Arg.(value & opt (some string) None & info ["md"] ~docv:"FILE" ~doc)
505
506
let find_opam_files dir =
507
try
···
516
in
517
let ci_term =
518
Term.(
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 })
520
$ cache_dir_term $ opam_repository_term $ directory_arg $ md_term)
521
in
522
let ci_info = Cmd.info "ci" ~doc:"Run CI tests on a directory" in
···
529
in
530
let health_check_term =
531
Term.(
532
-
const (fun dir opam_repository package md -> run_health_check { dir; opam_repository; package; directory = None; md; network = None })
533
$ cache_dir_term $ opam_repository_term $ package_arg $ md_term)
534
in
535
let health_check_info = Cmd.info "health-check" ~doc:"Run health check on a package" in
···
560
561
let () =
562
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
563
-
let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd ; list_cmd ] in
564
exit (Cmd.eval cmd)
···
4
module Role = Solver.Input.Role
5
module Role_map = Output.RoleMap
6
7
+
let container = if Sys.win32 then (module Windows : S.CONTAINER) else (module Linux : S.CONTAINER)
8
9
+
module Container = (val container)
10
11
+
let init t =
12
+
let config = Container.config ~t in
13
let root = Os.path [ config.dir; "root" ] in
14
if not (Sys.file_exists root) then
15
Os.create_directory_exclusively root @@ fun target_dir ->
16
let temp_dir = Filename.temp_dir ~temp_dir:config.dir ~perms:0o755 "temp-" "" in
17
let opam_repository = Os.path [ temp_dir; "opam-repository" ] in
18
let () = Os.mkdir opam_repository in
19
let () = Os.write_to_file (Os.path [ opam_repository; "repo" ]) {|opam-version: "2.0"|} in
20
let build_log = Os.path [ temp_dir; "build.log" ] in
21
+
let _ = Container.run ~t ~temp_dir opam_repository build_log in
22
Unix.rename temp_dir target_dir
23
24
let () = OpamFormatConfig.init ()
···
27
let _ = OpamStateConfig.load_defaults root *)
28
let () = OpamCoreConfig.init ?debug_level:(Some 10) ?debug_sections:(Some (OpamStd.String.Map.singleton "foo" (Some 10))) ()
29
30
let opam_env pkg v =
31
(* if List.mem v OpamPackageVar.predefined_depends_variables then (Some (OpamTypes.B true))
32
else *)
···
40
Some (OpamTypes.B false)
41
| "build" -> Some (OpamTypes.B true)
42
| "post" -> None
43
+
| x -> Container.std_env x
44
45
+
let solve (config : Config.t) ocaml_version pkg =
46
let constraints =
47
OpamPackage.Name.Map.of_list
48
[ (OpamPackage.name ocaml_version, (`Eq, OpamPackage.version ocaml_version)); (OpamPackage.name pkg, (`Eq, OpamPackage.version pkg)) ]
···
55
|> OpamPackage.Name.Map.add (OpamPackage.Name.of_string config.package)
56
(OpamPackage.Version.of_string "dev", OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw (Os.path [ directory; config.package ^ ".opam" ]))))
57
in
58
+
let context = Dir_context.create ~env:Container.std_env ~constraints ~pins (Os.path [ config.opam_repository; "packages" ]) in
59
let r = Solver.solve context [ OpamPackage.name pkg ] in
60
match r with
61
| Ok out ->
···
131
installable @ topological_sort pkgs
132
133
let pkg_deps solution =
134
+
List.fold_left
135
+
(fun map pkg ->
136
+
let deps_direct = OpamPackage.Map.find pkg solution in
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
+
OpamPackage.Map.add pkg deps_plus_children map)
139
+
OpamPackage.Map.empty
140
141
type build_result =
142
| No_solution
···
150
| Failure _ -> "failure"
151
| Success _ -> "success"
152
153
+
let build_layer t solution dependencies pkg =
154
+
let config = Container.config ~t in
155
let () = Printf.printf "Layer %s: %!" (OpamPackage.to_string pkg) in
156
let deps = OpamPackage.Map.find pkg solution in
157
+
let hash = Util.hash_of_set (OpamPackage.Set.add pkg (OpamPackage.Map.find pkg dependencies)) in
158
let layer_dir = Os.path [ config.dir; hash ] in
159
let () = Printf.printf "layer_dir %s\n%!" layer_dir in
160
let write_layer target_dir =
···
162
let () = Printf.printf "temp_dir %s\n%!" temp_dir in
163
let () = Os.write_to_file (Os.path [ temp_dir; "package" ]) (OpamPackage.to_string pkg) in
164
let () = Os.write_to_file (Os.path [ temp_dir; "packages" ]) (OpamPackage.Set.to_string deps) in
165
let build_log = Os.path [ temp_dir; "build.log" ] in
166
+
let () = Container.build ~t ~temp_dir build_log pkg dependencies deps in
167
Unix.rename temp_dir target_dir
168
in
169
let () = if not (Sys.file_exists layer_dir) then Os.create_directory_exclusively layer_dir write_layer in
170
let () = Os.write_to_file (Os.path [ layer_dir; "last_used" ]) (Unix.time () |> string_of_float) in
···
176
177
let reduce dependencies =
178
OpamPackage.Map.map (fun u ->
179
+
OpamPackage.Set.filter
180
+
(fun v ->
181
+
let others = OpamPackage.Set.remove v u in
182
+
OpamPackage.Set.fold (fun o acc -> acc || OpamPackage.Set.mem v (OpamPackage.Map.find o dependencies)) others false |> not)
183
+
u)
184
185
let build config ocaml_version package =
186
let solution = solve config ocaml_version package in
187
+
(* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".dot") solution in *)
188
+
if OpamPackage.Map.is_empty solution then [ No_solution ]
189
else
190
+
let t = Container.init ~config in
191
+
init t;
192
let ordered_installation = topological_sort solution in
193
let dependencies = pkg_deps solution ordered_installation in
194
let solution = reduce dependencies solution in
195
+
(* let _ = Dot_solution.save ((OpamPackage.to_string package) ^ ".reduced.dot") solution in *)
196
+
let results =
197
+
List.fold_left
198
+
(fun lst pkg ->
199
+
match lst with
200
+
| [] -> [ build_layer t solution dependencies pkg ]
201
+
| Success _ :: _ -> build_layer t solution dependencies pkg :: lst
202
+
| _ -> Dependency_failed :: lst)
203
+
[] ordered_installation
204
+
in
205
+
Container.deinit ~t;
206
+
results
207
208
let ocaml_version = OpamPackage.create (OpamPackage.Name.of_string "ocaml") (OpamPackage.Version.of_string "5.3.0")
209
···
231
232
open Cmdliner
233
234
+
let output (config : Config.t) results =
235
match config.md with
236
| Some filename ->
237
+
let oc = open_out_bin filename in
238
+
let cmd = Printf.sprintf "git -C %s rev-parse HEAD" config.opam_repository in
239
+
let opam_repo_sha = Os.run cmd |> String.trim in
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
+
let () =
242
+
List.rev results
243
+
|> List.iter (function
244
+
| Success log
245
+
| Failure log ->
246
+
output_string oc log
247
+
| _ -> ())
248
+
in
249
+
close_out oc
250
+
| None -> print_string (build_result_to_string (List.hd results))
251
252
+
let run_ci (config : Config.t) =
253
let package = OpamPackage.of_string (config.package ^ ".dev") in
254
let results = build config ocaml_version package in
255
output config results
256
257
+
let run_health_check (config : Config.t) =
258
let package = OpamPackage.of_string config.package in
259
let results = build config ocaml_version package in
260
output config results
261
262
let cache_dir_term =
···
269
270
let md_term =
271
let doc = "Output results in markdown format" in
272
+
Arg.(value & opt (some string) None & info [ "md" ] ~docv:"FILE" ~doc)
273
274
let find_opam_files dir =
275
try
···
284
in
285
let ci_term =
286
Term.(
287
+
const (fun dir opam_repository directory md ->
288
+
run_ci { dir; opam_repository; package = List.hd (find_opam_files directory); directory = Some directory; md })
289
$ cache_dir_term $ opam_repository_term $ directory_arg $ md_term)
290
in
291
let ci_info = Cmd.info "ci" ~doc:"Run CI tests on a directory" in
···
298
in
299
let health_check_term =
300
Term.(
301
+
const (fun dir opam_repository package md -> run_health_check { dir; opam_repository; package; directory = None; md })
302
$ cache_dir_term $ opam_repository_term $ package_arg $ md_term)
303
in
304
let health_check_info = Cmd.info "health-check" ~doc:"Run health check on a package" in
···
329
330
let () =
331
let default_term = Term.(ret (const (`Help (`Pager, None)))) in
332
+
let cmd = Cmd.group ~default:default_term main_info [ ci_cmd; health_check_cmd; list_cmd ] in
333
exit (Cmd.eval cmd)
+11
bin/mount.ml
+11
bin/mount.ml
···
···
1
+
type t = {
2
+
ty : string;
3
+
src : string;
4
+
dst : string;
5
+
options : string list;
6
+
}
7
+
8
+
let make ~ty ~options ~src dst =
9
+
`Assoc [ ("destination", `String dst); ("type", `String ty); ("source", `String src); ("options", `List (List.map (fun x -> `String x) options)) ]
10
+
11
+
let user_mounts = List.map @@ fun { ty; src; dst; options } -> make ~ty ~options ~src dst
+71
-75
bin/os.ml
+71
-75
bin/os.ml
···
17
| 0, _ -> 0
18
| r, 0 -> r
19
| _, n ->
20
-
OpamConsole.note "retry %i: %s" (tries - n + 1) (String.concat " " cmd);
21
-
Unix.sleepf (Random.float 2.0); loop (n - 1)
22
in
23
-
loop tries
24
25
let run cmd =
26
let inp = Unix.open_process_in cmd in
···
31
let nproc () = run "nproc" |> String.trim |> int_of_string
32
let mkdir dir = if not (Sys.file_exists dir) then Sys.mkdir dir 0o755
33
34
-
let rec rm ?(recursive=false) path =
35
try
36
let stat = Unix.lstat path in
37
match stat.st_kind with
38
-
| S_REG | S_LNK | S_CHR | S_BLK | S_FIFO | S_SOCK ->
39
-
(try
40
-
Unix.unlink path
41
-
with
42
-
Unix.Unix_error (Unix.EACCES, _, _) ->
43
-
Unix.chmod path (stat.st_perm lor 0o222);
44
-
Unix.unlink path)
45
| S_DIR ->
46
-
if recursive then
47
-
Sys.readdir path
48
-
|> Array.iter (fun f ->
49
-
rm ~recursive (Filename.concat path f));
50
-
Unix.rmdir path
51
with
52
-
| Unix.Unix_error (Unix.ENOENT, _, _) -> ()
53
54
module IntSet = Set.Make (Int)
55
···
93
exception Copy_error of string
94
95
let cp ?(buffer_size = 65536) ?(preserve_permissions = true) ?(preserve_times = true) src dst =
96
-
let safe_close fd = try Unix.close fd with _ -> () in
97
let src_stats =
98
-
try Unix.stat src
99
-
with Unix.Unix_error (err, _, _) ->
100
-
raise (Copy_error (Printf.sprintf "Cannot stat source file '%s': %s" src (Unix.error_message err)))
101
in
102
-
if src_stats.st_kind <> S_REG then
103
-
raise (Copy_error (Printf.sprintf "Source '%s' is not a regular file" src));
104
let src_fd =
105
-
try Unix.openfile src [O_RDONLY] 0
106
-
with Unix.Unix_error (err, _, _) ->
107
-
raise (Copy_error (Printf.sprintf "Cannot open source file '%s': %s" src (Unix.error_message err)))
108
in
109
let dst_fd =
110
-
try Unix.openfile dst [O_WRONLY; O_CREAT; O_TRUNC] src_stats.st_perm
111
-
with Unix.Unix_error (err, _, _) ->
112
-
safe_close src_fd;
113
-
raise (Copy_error (Printf.sprintf "Cannot open destination file '%s': %s" dst (Unix.error_message err)))
114
in
115
let buffer = Bytes.create buffer_size in
116
let rec copy_loop () =
117
try
118
-
match (Unix.read src_fd buffer 0 buffer_size) with
119
| 0 -> ()
120
| bytes_read ->
121
-
let rec write_all pos remaining =
122
-
if remaining > 0 then
123
-
let bytes_written = Unix.write dst_fd buffer pos remaining in
124
-
write_all (pos + bytes_written) (remaining - bytes_written)
125
-
in
126
-
write_all 0 bytes_read;
127
-
copy_loop ()
128
-
with Unix.Unix_error (err, _, _) ->
129
-
safe_close src_fd;
130
-
safe_close dst_fd;
131
-
raise (Copy_error (Printf.sprintf "Error during copy: %s" (Unix.error_message err)))
132
in
133
copy_loop ();
134
safe_close src_fd;
135
safe_close dst_fd;
136
-
if preserve_permissions then begin
137
-
try Unix.chmod dst src_stats.st_perm
138
-
with Unix.Unix_error (err, _, _) ->
139
-
Printf.eprintf "Warning: Could not preserve permissions: %s\n" (Unix.error_message err)
140
-
end;
141
-
if preserve_times then begin
142
-
try Unix.utimes dst src_stats.st_atime src_stats.st_mtime
143
-
with Unix.Unix_error (err, _, _) ->
144
-
Printf.eprintf "Warning: Could not preserve timestamps: %s\n" (Unix.error_message err)
145
-
end
146
147
let hardlink_tree ~source ~target =
148
let rec process_directory current_source current_target =
149
let entries = Sys.readdir current_source in
150
-
Array.iter (fun entry ->
151
-
let source = Filename.concat current_source entry in
152
-
let target = Filename.concat current_target entry in
153
-
try
154
-
let stat = Unix.lstat source in
155
-
match stat.st_kind with
156
-
| Unix.S_LNK ->
157
-
if not (Sys.file_exists target) then
158
-
Unix.symlink (Unix.readlink source) target
159
-
| Unix.S_REG ->
160
-
if not (Sys.file_exists target) then
161
-
Unix.link source target
162
-
| Unix.S_DIR ->
163
-
mkdir target;
164
-
process_directory source target
165
-
| S_CHR | S_BLK | S_FIFO | S_SOCK ->
166
-
()
167
-
with
168
-
| Unix.Unix_error (Unix.EMLINK, _, _) ->
169
-
cp source target
170
-
| Unix.Unix_error (err, _, _) ->
171
-
Printf.eprintf "Warning: %s -> %s = %s\n" source target (Unix.error_message err);
172
-
) entries
173
in
174
process_directory source target
···
17
| 0, _ -> 0
18
| r, 0 -> r
19
| _, n ->
20
+
OpamConsole.note "retry %i: %s" (tries - n + 1) (String.concat " " cmd);
21
+
Unix.sleepf (Random.float 2.0);
22
+
loop (n - 1)
23
in
24
+
loop tries
25
26
let run cmd =
27
let inp = Unix.open_process_in cmd in
···
32
let nproc () = run "nproc" |> String.trim |> int_of_string
33
let mkdir dir = if not (Sys.file_exists dir) then Sys.mkdir dir 0o755
34
35
+
let rec rm ?(recursive = false) path =
36
try
37
let stat = Unix.lstat path in
38
match stat.st_kind with
39
+
| S_REG
40
+
| S_LNK
41
+
| S_CHR
42
+
| S_BLK
43
+
| S_FIFO
44
+
| S_SOCK -> (
45
+
try Unix.unlink path with
46
+
| Unix.Unix_error (Unix.EACCES, _, _) ->
47
+
Unix.chmod path (stat.st_perm lor 0o222);
48
+
Unix.unlink path)
49
| S_DIR ->
50
+
if recursive then Sys.readdir path |> Array.iter (fun f -> rm ~recursive (Filename.concat path f));
51
+
Unix.rmdir path
52
with
53
+
| Unix.Unix_error (Unix.ENOENT, _, _) -> ()
54
55
module IntSet = Set.Make (Int)
56
···
94
exception Copy_error of string
95
96
let cp ?(buffer_size = 65536) ?(preserve_permissions = true) ?(preserve_times = true) src dst =
97
+
let safe_close fd =
98
+
try Unix.close fd with
99
+
| _ -> ()
100
+
in
101
let src_stats =
102
+
try Unix.stat src with
103
+
| Unix.Unix_error (err, _, _) -> raise (Copy_error (Printf.sprintf "Cannot stat source file '%s': %s" src (Unix.error_message err)))
104
in
105
+
if src_stats.st_kind <> S_REG then raise (Copy_error (Printf.sprintf "Source '%s' is not a regular file" src));
106
let src_fd =
107
+
try Unix.openfile src [ O_RDONLY ] 0 with
108
+
| Unix.Unix_error (err, _, _) -> raise (Copy_error (Printf.sprintf "Cannot open source file '%s': %s" src (Unix.error_message err)))
109
in
110
let dst_fd =
111
+
try Unix.openfile dst [ O_WRONLY; O_CREAT; O_TRUNC ] src_stats.st_perm with
112
+
| Unix.Unix_error (err, _, _) ->
113
+
safe_close src_fd;
114
+
raise (Copy_error (Printf.sprintf "Cannot open destination file '%s': %s" dst (Unix.error_message err)))
115
in
116
let buffer = Bytes.create buffer_size in
117
let rec copy_loop () =
118
try
119
+
match Unix.read src_fd buffer 0 buffer_size with
120
| 0 -> ()
121
| bytes_read ->
122
+
let rec write_all pos remaining =
123
+
if remaining > 0 then
124
+
let bytes_written = Unix.write dst_fd buffer pos remaining in
125
+
write_all (pos + bytes_written) (remaining - bytes_written)
126
+
in
127
+
write_all 0 bytes_read;
128
+
copy_loop ()
129
+
with
130
+
| Unix.Unix_error (err, _, _) ->
131
+
safe_close src_fd;
132
+
safe_close dst_fd;
133
+
raise (Copy_error (Printf.sprintf "Error during copy: %s" (Unix.error_message err)))
134
in
135
copy_loop ();
136
safe_close src_fd;
137
safe_close dst_fd;
138
+
(if preserve_permissions then
139
+
try Unix.chmod dst src_stats.st_perm with
140
+
| Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: Could not preserve permissions: %s\n" (Unix.error_message err));
141
+
if preserve_times then
142
+
try Unix.utimes dst src_stats.st_atime src_stats.st_mtime with
143
+
| Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: Could not preserve timestamps: %s\n" (Unix.error_message err)
144
145
let hardlink_tree ~source ~target =
146
let rec process_directory current_source current_target =
147
let entries = Sys.readdir current_source in
148
+
Array.iter
149
+
(fun entry ->
150
+
let source = Filename.concat current_source entry in
151
+
let target = Filename.concat current_target entry in
152
+
try
153
+
let stat = Unix.lstat source in
154
+
match stat.st_kind with
155
+
| S_LNK -> if not (Sys.file_exists target) then Unix.symlink (Unix.readlink source) target
156
+
| S_REG -> if not (Sys.file_exists target) then Unix.link source target
157
+
| S_DIR ->
158
+
mkdir target;
159
+
process_directory source target
160
+
| S_CHR
161
+
| S_BLK
162
+
| S_FIFO
163
+
| S_SOCK ->
164
+
()
165
+
with
166
+
| Unix.Unix_error (Unix.EMLINK, _, _) -> cp source target
167
+
| Unix.Unix_error (err, _, _) -> Printf.eprintf "Warning: %s -> %s = %s\n" source target (Unix.error_message err))
168
+
entries
169
in
170
process_directory source target
+10
bin/s.ml
+10
bin/s.ml
···
···
1
+
module type CONTAINER = sig
2
+
type t
3
+
4
+
val init : config:Config.t -> t
5
+
val deinit : t:t -> unit
6
+
val config : t:t -> Config.t
7
+
val run : t:t -> temp_dir:string -> string -> string -> unit
8
+
val build : t:t -> temp_dir:string -> string -> OpamPackage.t -> OpamPackage.Set.t OpamPackage.Map.t -> OpamPackage.Set.t -> unit
9
+
val std_env : string -> OpamTypes.variable_contents option
10
+
end
+22
bin/util.ml
+22
bin/util.ml
···
···
1
+
let hash_of_set s = s |> OpamPackage.Set.to_list |> List.map OpamPackage.to_string |> String.concat " " |> Digest.string |> Digest.to_hex
2
+
3
+
let std_env ?(ocaml_native = true) ?opam_version ~arch ~os ~os_distribution ~os_family ~os_version () = function
4
+
| "arch" -> Some (OpamTypes.S arch)
5
+
| "os" -> Some (OpamTypes.S os)
6
+
| "os-distribution" -> Some (OpamTypes.S os_distribution)
7
+
| "os-version" -> Some (OpamTypes.S os_version)
8
+
| "os-family" -> Some (OpamTypes.S os_family)
9
+
| "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
10
+
(* There is no system compliler *)
11
+
| "sys-ocaml-arch"
12
+
| "sys-ocaml-cc"
13
+
| "sys-ocaml-libc"
14
+
| "sys-ocaml-system"
15
+
| "sys-ocaml-version" ->
16
+
Some (OpamTypes.S "")
17
+
| "ocaml:native" -> Some (OpamTypes.B ocaml_native)
18
+
| "ocaml:version" -> Some (OpamTypes.S "5.3.0")
19
+
| "enable-ocaml-beta-repository" -> None (* Fake variable? *)
20
+
| v ->
21
+
OpamConsole.warning "Unknown variable %S" v;
22
+
None
+136
bin/windows.ml
+136
bin/windows.ml
···
···
1
+
type t = {
2
+
config : Config.t;
3
+
network : string;
4
+
}
5
+
6
+
let hostname = "builder"
7
+
let env = [ ("OPAMYES", "1"); ("OPAMCONFIRMLEVEL", "unsafe-yes"); ("OPAMERRLOGLEN", "0"); ("OPAMPRECISETRACKING", "1") ]
8
+
let std_env = Util.std_env ~arch:"x86_64" ~os:"win32" ~os_distribution:"cygwin" ~os_family:"windows" ~os_version:"10.0.20348" ()
9
+
let strings xs = `List (List.map (fun x -> `String x) xs)
10
+
11
+
let make_config_json ~layers ~cwd ~argv ~hostname ~uid ~gid ~env ~mounts ~network : Yojson.Safe.t =
12
+
`Assoc
13
+
[
14
+
("ociVersion", `String "1.1.0");
15
+
( "process",
16
+
`Assoc
17
+
[
18
+
("terminal", `Bool false);
19
+
("user", `Assoc [ ("uid", `Int uid); ("gid", `Int gid) ]);
20
+
("args", strings argv);
21
+
("env", strings (List.map (fun (k, v) -> Printf.sprintf "%s=%s" k v) env));
22
+
("cwd", `String cwd);
23
+
] );
24
+
("root", `Assoc [ ("path", `String ""); ("readonly", `Bool false) ]);
25
+
("hostname", `String hostname);
26
+
("mounts", `List (Mount.user_mounts mounts));
27
+
( "windows",
28
+
`Assoc
29
+
[
30
+
("layerFolders", strings layers);
31
+
("ignoreFlushesDuringBoot", `Bool true);
32
+
("network", `Assoc [ ("allowUnqualifiedDNSQuery", `Bool true); ("networkNamespace", `String network) ]);
33
+
] );
34
+
]
35
+
36
+
let init ~(config : Config.t) = { config; network = Os.run "hcn-namespace create" |> String.trim }
37
+
let deinit ~t = ignore (Os.exec [ "hcn-namespace"; "delete"; t.network ])
38
+
let config ~t = t.config
39
+
40
+
let run ~t ~temp_dir opam_repository build_log =
41
+
let rootfs = Os.path [ temp_dir; "fs" ] in
42
+
let () = Os.mkdir rootfs in
43
+
let argv =
44
+
[
45
+
"cmd";
46
+
"/c";
47
+
String.concat " && "
48
+
[
49
+
"set";
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
+
"curl.exe -L -o c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam\\opam-build.exe \
52
+
https://github.com/mtelvers/opam-build/releases/download/1.0.0/opam-build-1.0.0-x86_64-windows.exe";
53
+
(* "net user opam /nopassword /add"; *)
54
+
"opam.exe init -k local -a c:\\opam-repository --bare -y";
55
+
"opam.exe switch create default --empty";
56
+
];
57
+
]
58
+
in
59
+
let mounts =
60
+
[
61
+
{ Mount.ty = "bind"; src = rootfs; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] };
62
+
(*{ Mount.ty = "bind"; src = etc_hosts; dst = "/etc/hosts"; options = [ "ro"; "rbind"; "rprivate" ] }; *)
63
+
{ ty = "bind"; src = opam_repository; dst = "c:\\opam-repository"; options = [ "rbind"; "rprivate" ] };
64
+
]
65
+
in
66
+
let mounts_json = Os.path [ temp_dir; "mounts.json" ] in
67
+
let _ =
68
+
Os.retry_exec ~stdout:mounts_json
69
+
[ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ]
70
+
in
71
+
let layers = Json_layers.read_layers mounts_json in
72
+
let config = make_config_json ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:t.network in
73
+
let config_json = Os.path [ temp_dir; "config.json" ] in
74
+
let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in
75
+
let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in
76
+
let _ = Os.rm (Os.path [ rootfs; "lock" ]) in
77
+
let _ = Os.rm (Os.path [ rootfs; "conf.lock" ]) in
78
+
let _ = Os.rm (Os.path [ rootfs; "default"; ".opam-switch"; "lock" ]) in
79
+
let _ = Os.rm (Os.path [ rootfs; "repo"; "state-33BF9E46.cache" ]) in
80
+
let _ = Os.rm (Os.path [ rootfs; "repo"; "conf.lock" ]) in
81
+
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
82
+
let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in
83
+
()
84
+
85
+
let build ~t ~temp_dir build_log pkg dependencies deps =
86
+
let config = t.config in
87
+
let target = Os.path [ temp_dir; "fs" ] in
88
+
let () = Os.mkdir target in
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
+
let argv =
91
+
[
92
+
"cmd";
93
+
"/c";
94
+
String.concat " && " (pin @ [ "set && c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam\\opam-build.exe -v " ^ OpamPackage.to_string pkg ]);
95
+
]
96
+
in
97
+
let _ = Os.hardlink_tree ~source:(Os.path [ config.dir; "root"; "fs" ]) ~target in
98
+
let () =
99
+
OpamPackage.Set.iter
100
+
(fun dep ->
101
+
let hash = Util.hash_of_set (OpamPackage.Set.add dep (OpamPackage.Map.find dep dependencies)) in
102
+
Os.hardlink_tree ~source:(Os.path [ config.dir; hash; "fs" ]) ~target)
103
+
deps
104
+
in
105
+
let () =
106
+
let default_switch = Os.path [ temp_dir; "fs"; "default" ] in
107
+
if Sys.file_exists default_switch then Opamh.dump_state default_switch
108
+
in
109
+
let mounts =
110
+
[
111
+
{ Mount.ty = "bind"; src = target; dst = "c:\\Users\\ContainerAdministrator\\AppData\\Local\\opam"; options = [ "rw"; "rbind"; "rprivate" ] };
112
+
{
113
+
ty = "bind";
114
+
src = config.opam_repository;
115
+
dst = "c:\\users\\ContainerAdministrator\\AppData\\Local\\opam\\repo\\default";
116
+
options = [ "rbind"; "rprivate" ];
117
+
};
118
+
]
119
+
in
120
+
let mounts_json = Os.path [ temp_dir; "mounts.json" ] in
121
+
let _ =
122
+
Os.retry_exec ~stdout:mounts_json
123
+
[ "ctr"; "snapshot"; "prepare"; "--mounts"; Filename.basename temp_dir; "sha256:6f75278129ccaff6084617218cb8a28e8acc1748beeaae2946dfa92c5ca425ee" ]
124
+
in
125
+
let layers = Json_layers.read_layers mounts_json in
126
+
let config = make_config_json ~layers ~cwd:"c:\\" ~argv ~hostname ~uid:0 ~gid:0 ~env ~mounts ~network:t.network in
127
+
let config_json = Os.path [ temp_dir; "config.json" ] in
128
+
let () = Os.write_to_file config_json (Yojson.Safe.pretty_to_string config) in
129
+
let result = Os.exec ~stdout:build_log ~stderr:build_log [ "ctr"; "run"; "--cni"; "--rm"; "--config"; config_json; Filename.basename temp_dir ] in
130
+
let () = Os.write_to_file (Os.path [ temp_dir; "status" ]) (string_of_int result) in
131
+
let _ = Os.exec [ "ctr"; "snapshot"; "rm"; Filename.basename temp_dir ] in
132
+
let _ = Os.rm (Os.path [ target; "repo"; "state-33BF9E46.cache" ]) in
133
+
let _ = Os.rm ~recursive:true (Os.path [ target; "default"; ".opam-switch"; "sources" ]) in
134
+
let _ = Os.rm ~recursive:true (Os.path [ target; "default"; ".opam-switch"; "build" ]) in
135
+
let _ = Os.rm (Os.path [ target; "default"; ".opam-switch"; "lock" ]) in
136
+
()