···

       
30
       
30
       
 
       
let get_image ~dir ~proc image =

     

       
31
       
31
       
 
       
  let container_id =

     

       
32
       
32
       
 
       
    Eio.Process.parse_out proc Eio.Buf_read.take_all

     

       
33
       
33
       
-
       
      [ "docker"; "run"; "-d"; image ]

     

       
33
       
33
       
+
       
      [ "docker"; "create"; "--"; image ]

     

       
34
       
34
       
 
       
    |> String.trim

     

       
35
       
35
       
 
       
  in

     

       
36
       
36
       
 
       
  let tar = replace_slash image ^ ".tar.gz" in

     

···

       
298
       
298
       
 
       
    "127.0.0.1 localhost builder";

     

       
299
       
299
       
 
       
  let id = string_of_int !next_id in

     

       
300
       
300
       
 
       
  incr next_id;

     

       
301
       
301
       
-
       
  let cmd = [ "runc"; "--root"; "runc"; "run"; id ] in

     

       
301
       
301
       
+
       
  let cmd = [ "runc"; "run"; id ] in

     

       
302
       
302
       
 
       
  let stdout =

     

       
303
       
303
       
 
       
    to_other_sink_as_well ~other:env#stdout

     

       
304
       
304
       
 
       
      (log :> Eio.Flow.sink_ty Eio.Flow.sink)

     

       
305
       
305
       
 
       
  in

     

       
306
       
306
       
-
       
  Eio.Process.spawn ~sw ~stdout env#proc ~cwd:eio_tmp cmd

     

       
306
       
306
       
+
       
  Eio.Process.spawn ~sw ~stdout ~stderr:env#stdout env#proc ~cwd:eio_tmp cmd

     

       
307
       
307
       
 
       


     

       
308
       
308
       
 
       
(* 

     

       
309
       
309
       
 
       
                                 Apache License

     

···

       
324
       
324
       
 
       
      let start, res =

     

       
325
       
325
       
 
       
        Switch.run @@ fun sw ->

     

       
326
       
326
       
 
       
        let log =

     

       
327
       
327
       
-
       
          Eio.Path.open_out ~sw ~create:(`If_missing 0o644)

     

       
327
       
327
       
+
       
          Eio.Path.open_out ~sw ~create:(`Or_truncate 0o644)

     

       
328
       
328
       
 
       
            Eio.Path.(fs / rootfs / "log")

     

       
329
       
329
       
 
       
        in

     

       
330
       
330
       
 
       
        let res = spawn sw log in

     

···

       
55
       
55
       
 
       
  | Some _ -> ()

     

       
56
       
56
       
 
       
  | None -> with_dataset ~typ t (dataset :> string) @@ fun d -> Zfs.mount d

     

       
57
       
57
       
 
       


     

       
58
       
58
       
+
       
let mount_snapshot ?(typ = Zfs.Types.snapshot) t (dataset : Datasets.snapshot) =

     

       
59
       
59
       
+
       
  match Zfs.is_mounted t.zfs (dataset :> string) with

     

       
60
       
60
       
+
       
  | Some _ -> ()

     

       
61
       
61
       
+
       
  | None -> with_dataset ~typ t (dataset :> string) @@ fun d -> Zfs.mount d

     

       
62
       
62
       
+
       


     

       
58
       
63
       
 
       
let unmount_dataset t (dataset : Datasets.dataset) =

     

       
59
       
64
       
 
       
  match Zfs.is_mounted t.zfs (dataset :> string) with

     

       
60
       
65
       
 
       
  | None -> ()

     

       
61
       
66
       
 
       
  | Some _ ->

     

       
62
       
67
       
 
       
      with_dataset t (dataset :> string) @@ fun d ->

     

       
63
       
63
       
-
       
      let _todo () = Zfs.unmount d in

     

       
68
       
68
       
+
       
      let () = Zfs.unmount d in

     

       
64
       
69
       
 
       
      ()

     

       
65
       
70
       
 
       


     

       
66
       
71
       
 
       
let create_dataset t (dataset : Datasets.dataset) =

     
···

       
104
       
109
       
 
       
        loop ()

     

       
105
       
110
       
 
       
  in

     

       
106
       
111
       
 
       
  loop ()

     

       
107
       
107
       
-
       


     

       
108
       
108
       
-
       
let diff t (data : Datasets.snapshot) (snap : Datasets.snapshot) output =

     

       
109
       
109
       
-
       
  let data_fs =

     

       
110
       
110
       
-
       
    String.sub (data :> string) 0 (String.index (data :> string) '@')

     

       
111
       
111
       
-
       
  in

     

       
112
       
112
       
-
       
  let zh = Zfs.open_ t.zfs data_fs Zfs.Types.filesystem in

     

       
113
       
113
       
-
       
  let () =

     

       
114
       
114
       
-
       
    try

     

       
115
       
115
       
-
       
      Eio.Path.with_open_out ~create:(`If_missing 0o644) output

     

       
116
       
116
       
-
       
      @@ fun flow_fd ->

     

       
117
       
117
       
-
       
      let eio_fd = Eio_unix.Resource.fd_opt flow_fd in

     

       
118
       
118
       
-
       
      Eio_unix.Fd.use_exn_opt "zfs-diff" eio_fd @@ function

     

       
119
       
119
       
-
       
      | None -> Fmt.failwith "Output needs to have an FD"

     

       
120
       
120
       
-
       
      | Some fd ->

     

       
121
       
121
       
-
       
          Zfs.show_diff zh ~from_:(data :> string) ~to_:(snap :> string) fd

     

       
122
       
122
       
-
       
    with Unix.Unix_error (Unix.EBADF, _, _) -> ()

     

       
123
       
123
       
-
       
  in

     

       
124
       
124
       
-
       
  Zfs.close zh;

     

       
125
       
125
       
-
       
  let diff = Eio.Path.load output in

     

       
126
       
126
       
-
       
  Diff.of_zfs diff

     

       
127
       
112
       
 
       


     

       
128
       
113
       
 
       
let cid s =

     

       
129
       
114
       
 
       
  let hash =

     
···

       
173
       
158
       
 
       
    Fun.protect ~finally:(fun () -> unmount_dataset t ds) @@ fun () ->

     

       
174
       
159
       
 
       
    mount_dataset t ds;

     

       
175
       
160
       
 
       
    fn ("/" ^ (ds :> string))

     

       
161
       
161
       
+
       


     

       
162
       
162
       
+
       
  let diff t (data : Datasets.snapshot) (snap : Datasets.snapshot) output =

     

       
163
       
163
       
+
       
    let data_fs =

     

       
164
       
164
       
+
       
      String.sub (data :> string) 0 (String.index (data :> string) '@')

     

       
165
       
165
       
+
       
    in

     

       
166
       
166
       
+
       
    let snap_fs =

     

       
167
       
167
       
+
       
      String.sub (snap :> string) 0 (String.index (snap :> string) '@')

     

       
168
       
168
       
+
       
    in

     

       
169
       
169
       
+
       
    if Option.is_none (Zfs.is_mounted t.zfs data_fs) then

     

       
170
       
170
       
+
       
      with_dataset t data_fs Zfs.mount;

     

       
171
       
171
       
+
       
    if Option.is_none (Zfs.is_mounted t.zfs snap_fs) then

     

       
172
       
172
       
+
       
      with_dataset t snap_fs Zfs.mount;

     

       
173
       
173
       
+
       
    with_dataset ~typ:Zfs.Types.filesystem t data_fs @@ fun zh ->

     

       
174
       
174
       
+
       
    let () =

     

       
175
       
175
       
+
       
      try

     

       
176
       
176
       
+
       
        Eio.Path.with_open_out ~create:(`If_missing 0o644) output

     

       
177
       
177
       
+
       
        @@ fun flow_fd ->

     

       
178
       
178
       
+
       
        let eio_fd = Eio_unix.Resource.fd_opt flow_fd in

     

       
179
       
179
       
+
       
        Eio_unix.Fd.use_exn_opt "zfs-diff" eio_fd @@ function

     

       
180
       
180
       
+
       
        | None -> Fmt.failwith "Output needs to have an FD"

     

       
181
       
181
       
+
       
        | Some fd ->

     

       
182
       
182
       
+
       
            Zfs.show_diff zh ~from_:(data :> string) ~to_:(snap :> string) fd

     

       
183
       
183
       
+
       
      with Unix.Unix_error (Unix.EBADF, _, _) -> ()

     

       
184
       
184
       
+
       
    in

     

       
185
       
185
       
+
       
    let diff = Eio.Path.load output in

     

       
186
       
186
       
+
       
    Diff.of_zfs diff

     

       
176
       
187
       
 
       


     

       
177
       
188
       
 
       
  let with_clone t ~src new_cid output fn =

     

       
178
       
189
       
 
       
    let ds = Datasets.build t.pool (Cid.to_string src) in

     

···

       
42
       
42
       
 
       
      (Types.libzfs_handle_t @-> string @-> int @-> returning Types.zfs_handle_t)

     

       
43
       
43
       
 
       


     

       
44
       
44
       
 
       
  let mount =

     

       
45
       
45
       
-
       
    foreign "zfs_mount" (Types.zfs_handle_t @-> string @-> int @-> returning int)

     

       
45
       
45
       
+
       
    foreign "zfs_mount" (Types.zfs_handle_t @-> string_opt @-> int @-> returning int)

     

       
46
       
46
       
 
       


     

       
47
       
47
       
 
       
  let unmount =

     

       
48
       
48
       
 
       
    foreign "zfs_unmount"

     

       
49
       
49
       
-
       
      (Types.zfs_handle_t @-> string @-> int @-> returning int)

     

       
49
       
49
       
+
       
      (Types.zfs_handle_t @-> string_opt @-> int @-> returning int)

     

       
50
       
50
       
 
       


     

       
51
       
51
       
 
       
  let close = foreign "zfs_close" (Types.zfs_handle_t @-> returning void)

     

       
52
       
52
       
 
       
  let get_type = foreign "zfs_get_type" (Types.zfs_handle_t @-> returning int)

     

···

       
116
       
116
       
 
       
let null_string = Ctypes.(coerce (ptr void) (ptr char) null)

     

       
117
       
117
       
 
       


     

       
118
       
118
       
 
       
let mount ?mount_opts ?(mount_flags = 0) dataset =

     

       
119
       
119
       
-
       
  let opts =

     

       
120
       
120
       
-
       
    Option.value

     

       
121
       
121
       
-
       
      ~default:(Ctypes.string_from_ptr null_string ~length:0)

     

       
122
       
122
       
-
       
      mount_opts

     

       
123
       
123
       
-
       
  in

     

       
124
       
124
       
-
       
  let res = C.Functions.mount dataset opts mount_flags in

     

       
119
       
119
       
+
       
  let res = C.Functions.mount dataset mount_opts mount_flags in

     

       
125
       
120
       
 
       
  if res <> 0 then invalid_arg "mounting dataset"

     

       
126
       
121
       
 
       


     

       
127
       
122
       
 
       
let unmount ?mount_opts ?(mount_flags = 0) dataset =

     

       
128
       
128
       
-
       
  let opts =

     

       
129
       
129
       
-
       
    Option.value

     

       
130
       
130
       
-
       
      ~default:(Ctypes.string_from_ptr null_string ~length:0)

     

       
131
       
131
       
-
       
      mount_opts

     

       
132
       
132
       
-
       
  in

     

       
133
       
133
       
-
       
  let res = C.Functions.unmount dataset opts mount_flags in

     

       
123
       
123
       
+
       
  let res = C.Functions.unmount dataset mount_opts mount_flags in

     

       
134
       
124
       
 
       
  if res <> 0 then invalid_arg "unmounting dataset"

     

       
135
       
125
       
 
       


     

       
136
       
126
       
 
       
let show_diff ?to_ handle ~from_ (fd : Unix.file_descr) =