···

       
19
       
19
       
 
       
 (synopsis "Shelter from the Storm")

     

       
20
       
20
       
 
       
 (description "A shell session shim to help you explore!")

     

       
21
       
21
       
 
       
 (depends

     

       
22
       
22
       
-
       
   ocaml

     

       
22
       
22
       
+
       
   (ocaml (< "5.3.0~~")) ; for the irmin pin only

     

       
23
       
23
       
+
       
   (ctypes (< "0.23.0")) ; for a const ptr mismatch with zfs from https://github.com/yallop/ocaml-ctypes/pull/782

     

       
23
       
24
       
 
       
   eio_posix

     

       
24
       
24
       
-
       
   void

     

       
25
       
25
       
 
       
   zfs

     

       
26
       
26
       
 
       
   cid

     

       
27
       
27
       
 
       
   ppx_repr

     

···

       
10
       
10
       
 
       
bug-reports: "https://github.com/username/reponame/issues"

     

       
11
       
11
       
 
       
depends: [

     

       
12
       
12
       
 
       
  "dune" {>= "3.17"}

     

       
13
       
13
       
-
       
  "ocaml"

     

       
13
       
13
       
+
       
  "ocaml" {< "5.3.0~~"}

     

       
14
       
14
       
+
       
  "ctypes" {< "0.23.0"}

     

       
14
       
15
       
 
       
  "eio_posix"

     

       
15
       
15
       
-
       
  "void"

     

       
16
       
16
       
 
       
  "zfs"

     

       
17
       
17
       
 
       
  "cid"

     

       
18
       
18
       
 
       
  "ppx_repr"

     

···

       
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 ~stdout ~sw env#proc ~cwd:eio_tmp cmd

     

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

     

       
307
       
307
       
 
       


     

       
308
       
308
       
 
       
(* 

     

       
309
       
309
       
 
       
                                 Apache License

     

···

       
252
       
252
       
 
       
  in

     

       
253
       
253
       
 
       
  let with_rootfs fn =

     

       
254
       
254
       
 
       
    if entry.pre.mode = R then (Store.Run.with_build ctx.store build fn, [])

     

       
255
       
255
       
-
       
    else Store.Run.with_clone ctx.store ~src:build new_cid fn

     

       
255
       
255
       
+
       
    else

     

       
256
       
256
       
+
       
      let diff_path =

     

       
257
       
257
       
+
       
        Eio.Path.(fs / Filename.temp_dir "shelter-diff-" "" / "diff")

     

       
258
       
258
       
+
       
      in

     

       
259
       
259
       
+
       
      Store.Run.with_clone ctx.store ~src:build new_cid diff_path fn

     

       
256
       
260
       
 
       
  in

     

       
257
       
261
       
 
       
  with_rootfs @@ function

     

       
258
       
262
       
 
       
  | `Exists path ->

     
···

       
300
       
304
       
 
       
                    "-c";

     

       
301
       
305
       
 
       
                    String.concat " " command ^ " && env > /tmp/shelter-env";

     

       
302
       
306
       
 
       
                  ];

     

       
303
       
303
       
-
       
                hostname = "";

     

       
307
       
307
       
+
       
                hostname = "builder";

     

       
304
       
308
       
 
       
                network = [ "host" ];

     

       
305
       
309
       
 
       
                user = (uid, gid);

     

       
306
       
310
       
 
       
                env = entry.pre.env;

     
···

       
317
       
321
       
 
       
          in

     

       
318
       
322
       
 
       
          `Runc (Runc.spawn ~sw log env config rootfs)

     

       
319
       
323
       
 
       
      in

     

       
320
       
320
       
-
       
      Switch.run @@ fun sw ->

     

       
321
       
321
       
-
       
      let log =

     

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

     

       
323
       
323
       
-
       
          Eio.Path.(fs / rootfs / "log")

     

       
324
       
324
       
-
       
      in

     

       
325
       
325
       
-
       
      let res = spawn sw log in

     

       
326
       
326
       
-
       
      let start = Mtime_clock.now () in

     

       
327
       
327
       
-
       
      let res =

     

       
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)

     

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

     

       
329
       
329
       
+
       
        in

     

       
330
       
330
       
+
       
        let res = spawn sw log in

     

       
331
       
331
       
+
       
        let start = Mtime_clock.now () in

     

       
328
       
332
       
 
       
        match res with

     

       
329
       
329
       
-
       
        | `Runc r -> Eio.Process.await r

     

       
330
       
330
       
-
       
        | `Void v -> Void.to_eio_status (Eio.Promise.await v)

     

       
333
       
333
       
+
       
        | `Runc r -> (start, Eio.Process.await r)

     

       
334
       
334
       
+
       
        | `Void v -> (start, Void.to_eio_status (Eio.Promise.await v))

     

       
331
       
335
       
 
       
      in

     

       
332
       
336
       
 
       
      let stop = Mtime_clock.now () in

     

       
333
       
337
       
 
       
      let span = Mtime.span start stop in

     

···

       
94
       
94
       
 
       
  Zfs.clone src (tgt :> string)

     

       
95
       
95
       
 
       


     

       
96
       
96
       
 
       
let read_all fd =

     

       
97
       
97
       
-
       
  let buf = Buffer.create 128 in

     

       
98
       
98
       
-
       
  let bytes = Bytes.create 4096 in

     

       
97
       
97
       
+
       
  let buf = Buffer.create 10_000 in

     

       
98
       
98
       
+
       
  let bytes = Bytes.create 10_000 in

     

       
99
       
99
       
 
       
  let rec loop () =

     

       
100
       
100
       
 
       
    match Unix.read fd bytes 0 4096 with

     

       
101
       
101
       
 
       
    | 0 | (exception End_of_file) -> Buffer.contents buf

     
···

       
105
       
105
       
 
       
  in

     

       
106
       
106
       
 
       
  loop ()

     

       
107
       
107
       
 
       


     

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

     

       
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 diff =

     

       
114
       
114
       
-
       
    let r, w = Unix.pipe ~cloexec:false () in

     

       
113
       
113
       
+
       
  let () =

     

       
115
       
114
       
 
       
    try

     

       
116
       
116
       
-
       
      Zfs.show_diff zh ~from_:(data :> string) ~to_:(snap :> string) w;

     

       
117
       
117
       
-
       
      let f = read_all r in

     

       
118
       
118
       
-
       
      Unix.close r;

     

       
119
       
119
       
-
       
      f

     

       
120
       
120
       
-
       
    with e ->

     

       
121
       
121
       
-
       
      Unix.close r;

     

       
122
       
122
       
-
       
      raise e

     

       
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

     

       
125
       
126
       
 
       
  Diff.of_zfs diff

     

       
126
       
127
       
 
       


     

       
127
       
128
       
 
       
let cid s =

     
···

       
173
       
174
       
 
       
    mount_dataset t ds;

     

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

     

       
175
       
176
       
 
       


     

       
176
       
176
       
-
       
  let with_clone t ~src new_cid fn =

     

       
177
       
177
       
+
       
  let with_clone t ~src new_cid output fn =

     

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

     

       
178
       
179
       
 
       
    let tgt = Datasets.build t.pool (Cid.to_string new_cid) in

     

       
179
       
180
       
 
       
    let src_snap = Datasets.snapshot ds in

     

       
180
       
181
       
 
       
    let tgt_snap = Datasets.snapshot tgt in

     

       
181
       
182
       
 
       
    if Zfs.exists t.zfs (tgt :> string) Zfs.Types.dataset then

     

       
182
       
182
       
-
       
      (fn (`Exists ("/" ^ (tgt :> string))), diff t src_snap tgt_snap)

     

       
183
       
183
       
+
       
      (fn (`Exists ("/" ^ (tgt :> string))), diff t src_snap tgt_snap output)

     

       
183
       
184
       
 
       
    else (

     

       
184
       
185
       
 
       
      clone t src_snap tgt;

     

       
185
       
186
       
 
       
      let v = with_build t new_cid fn in

     

       
186
       
187
       
 
       
      snapshot t tgt_snap;

     

       
187
       
187
       
-
       
      let d = diff t src_snap tgt_snap in

     

       
188
       
188
       
+
       
      let d = diff t src_snap tgt_snap output in

     

       
188
       
189
       
 
       
      (v, d))

     

       
189
       
190
       
 
       
end

     

···

       
20
       
20
       
 
       
#include <string.h>

     

       
21
       
21
       
 
       


     

       
22
       
22
       
 
       


     

       
23
       
23
       
+
       
#define CAML_INTERNALS

     

       
23
       
24
       
 
       
#include <caml/mlvalues.h>

     

       
24
       
25
       
 
       
#include <caml/unixsupport.h>

     

       
25
       
26
       
 
       
#include <caml/memory.h>

     

       
26
       
27
       
 
       
#include <caml/custom.h>

     

       
28
       
28
       
+
       
#include <caml/signals.h>

     

       
27
       
29
       
 
       
#include <caml/fail.h>

     

       
30
       
30
       
+
       
#undef CAML_INTERNALS

     

       
28
       
31
       
 
       


     

       
29
       
32
       
 
       
// From Eio

     

       
30
       
33
       
 
       
#include <include/fork_action.h>

     

···

       
137
       
137
       
 
       
  (* TODO: Other Diff Flags https://github.com/openzfs/zfs/blob/5b0c27cd14bbc07d50304c97735cc105d0258673/include/libzfs.h#L917? *)

     

       
138
       
138
       
 
       
  let res = C.Functions.diff handle (Obj.magic fd : int) from_ to_ 1 in

     

       
139
       
139
       
 
       
  if res = 0 then () else begin

     

       
140
       
140
       
-
       
    Format.printf "Diff got %i\n%!" res;

     

       
141
       
140
       
 
       
    invalid_arg "show_diff"

     

       
142
       
141
       
 
       
  end