comparing cd45e2f76a1fb07a52d7e1a04ba538f7e94e60a4 and fix-build on anil.recoil.org/shelter

+5 -3

dune-project

···

       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

     

       28
       28
       -
          irmin-fs

     

       28
       28
       +
          irmin-git

     

       29
       29
       +
          morbig

     

       30
       30
       +
          ppx_blob

     

       29
       31
        
          cmdliner

     

       30
       32
        
         )

     

       31
       33
        
        (tags

+8 -4

shelter.opam

···

       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"

     

       19
       19
       -
         "irmin-fs"

     

       19
       19
       +
         "irmin-git"

     

       20
       20
       +
         "morbig"

     

       21
       21
       +
         "ppx_blob"

     

       20
       22
        
         "cmdliner"

     

       21
       23
        
         "odoc" {with-doc}

     

       22
       24
        
       ]

     
···

       39
       41
        
         [ "zfs.dev"      "git+https://github.com/patricoferris/ocaml-zfs" ]

     

       40
       42
        
         [ "void.dev"     "git+https://github.com/quantifyearth/void" ]

     

       41
       43
        
         [ "irmin.dev"    "git+https://github.com/mirage/irmin#eio" ]

     

       42
       42
       -
         [ "irmin-fs.dev" "git+https://github.com/mirage/irmin#eio" ]

     

       44
       44
       +
         [ "ppx_irmin.dev"    "git+https://github.com/mirage/irmin#eio" ]

     

       45
       45
       +
         [ "irmin-git.dev" "git+https://github.com/mirage/irmin#eio" ]

     

       46
       46
       +
         [ "irmin-watcher.dev" "git+https://github.com/patricoferris/irmin-watcher#675125d9e95cd09ef0c18ab1d9d6d69a26856b9f" ]

     

       43
       47
        
       ]

+3 -1

shelter.opam.template

···

       2
       2
        
         [ "zfs.dev"      "git+https://github.com/patricoferris/ocaml-zfs" ]

     

       3
       3
        
         [ "void.dev"     "git+https://github.com/quantifyearth/void" ]

     

       4
       4
        
         [ "irmin.dev"    "git+https://github.com/mirage/irmin#eio" ]

     

       5
       5
       -
         [ "irmin-fs.dev" "git+https://github.com/mirage/irmin#eio" ]

     

       5
       5
       +
         [ "ppx_irmin.dev"    "git+https://github.com/mirage/irmin#eio" ]

     

       6
       6
       +
         [ "irmin-git.dev" "git+https://github.com/mirage/irmin#eio" ]

     

       7
       7
       +
         [ "irmin-watcher.dev" "git+https://github.com/patricoferris/irmin-watcher#675125d9e95cd09ef0c18ab1d9d6d69a26856b9f" ]

     

       6
       8
        
       ]

+1 -10

src/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name shelter)

     

       3
       3
        
        (public_name shelter)

     

       4
       4
       -
        (libraries

     

       5
       5
       -
         cmdliner

     

       6
       6
       -
         irmin-fs.unix

     

       7
       7
       -
         irmin-git.unix

     

       8
       8
       -
         eio.unix

     

       9
       9
       -
         eio

     

       10
       10
       -
         linenoise

     

       11
       11
       -
         void

     

       12
       12
       -
         repr

     

       13
       13
       -
         morbig))

     

       4
       4
       +
        (libraries cmdliner irmin-git.unix eio.unix eio linenoise void repr morbig))

+1 -1

src/lib/shelter/runc.ml

···

       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

+16 -12

src/lib/shelter/shelter_main.ml

···

       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

+16 -15

src/lib/shelter/store.ml

···

       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

+1 -2

src/lib/shelter.ml

···

       36
       36
        
           |> List.map Engine.action_of_command

     

       37
       37
        
       

     

       38
       38
        
         let main config ~stdout fs clock proc directory command_file =

     

       39
       39
       -
           Irmin_fs.run directory @@ fun () ->

     

       40
       40
       -
           let conf = Irmin_fs.config (Eio.Path.native_exn directory) in

     

       39
       39
       +
           let conf = Irmin_git.config (Eio.Path.native_exn directory) in

     

       41
       40
        
           let repo = Store.Repo.v conf in

     

       42
       41
        
           let store = Store.main repo in

     

       43
       42
        
           match command_file with

+3

vendor/void/src/void_action.c

···

       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>

-1

vendor/zfs/src/zfs.ml

···

       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

Compare changes