commit c761c9163a34caae51aa619134d1d6f47c8dc306 · anil.recoil.org/shelter

+28 -4

src/lib/shelter/shelter_main.ml

···

       16
       16
        
           build : Store.Build.t;

     

       17
       17
        
           args : string list;

     

       18
       18
        
           time : int64;

     

       19
       19
       +
           env : string list;

     

       20
       20
       +
           cwd : string;

     

       19
       21
        
           diff : Diff.t;

     

       20
       22
        
         }

     

       21
       23
        
         [@@deriving repr]

     
···

       172
       174
        
           (list s);

     

       173
       175
        
         store

     

       174
       176
        
       

     

       175
       175
       -
       let run (_config : config) _fs clock _proc

     

       177
       177
       +
       let run (_config : config) fs clock _proc

     

       176
       178
        
           (((H.Store ((module S), store) : entry H.t) as s), ctx) = function

     

       177
       179
        
         | Set_mode mode ->

     

       178
       180
        
             with_latest ~default:(fun _ -> Ok (s, ctx)) s @@ fun (_, entry) ->

     
···

       240
       242
        
                       args = command;

     

       241
       243
        
                       time = 0L;

     

       242
       244
        
                       diff = [];

     

       245
       245
       +
                       (* TODO: extract with fetch *)

     

       246
       246
       +
                       env = [];

     

       247
       247
       +
                       cwd = "/";

     

       243
       248
        
                     })

     

       244
       249
        
                 s

     

       245
       250
        
               @@ fun (_, e) -> e

     
···

       261
       266
        
                 let void =

     

       262
       267
        
                   Void.empty

     

       263
       268
        
                   |> Void.rootfs ~mode:entry.mode rootfs

     

       264
       264
       -
                   |> Void.exec [ "/bin/ash"; "-c"; String.concat " " command ]

     

       269
       269
       +
                   |> Void.cwd entry.cwd

     

       270
       270
       +
                   |> Void.exec ~env:entry.env

     

       271
       271
       +
                        [

     

       272
       272
       +
                          "/bin/ash";

     

       273
       273
       +
                          "-c";

     

       274
       274
       +
                          String.concat " " command ^ " && env > /shelter-env";

     

       275
       275
       +
                        ]

     

       265
       276
        
                 in

     

       266
       277
        
                 Switch.run @@ fun sw ->

     

       267
       278
        
                 let start = Mtime_clock.now () in

     
···

       270
       281
        
                   Void.exit_status proc |> Eio.Promise.await |> Void.to_eio_status

     

       271
       282
        
                 in

     

       272
       283
        
                 let stop = Mtime_clock.now () in

     

       284
       284
       +
                 (* Extract env *)

     

       285
       285
       +
                 let env_path = Eio.Path.(fs / rootfs / "shelter-env") in

     

       286
       286
       +
                 let env = Eio.Path.(load env_path) |> String.split_on_char '\n' in

     

       287
       287
       +
                 Eio.Path.unlink env_path;

     

       288
       288
       +
                 let cwd =

     

       289
       289
       +
                   List.find_map

     

       290
       290
       +
                     (fun v ->

     

       291
       291
       +
                       match Astring.String.cut ~sep:"=" v with

     

       292
       292
       +
                       | Some ("PWD", dir) -> Some dir

     

       293
       293
       +
                       | _ -> None)

     

       294
       294
       +
                     env

     

       295
       295
       +
                   |> Option.value ~default:hash_entry.cwd

     

       296
       296
       +
                 in

     

       273
       297
        
                 let span = Mtime.span start stop in

     

       274
       298
        
                 let time = Mtime.Span.to_uint64_ns span in

     

       275
       299
        
                 (* Add command to history regardless of exit status *)

     
···

       278
       302
        
                 in

     

       279
       303
        
                 if res = `Exited 0 then

     

       280
       304
        
                   if entry.mode = RW then

     

       281
       281
       -
                     Ok { hash_entry with build = Build new_cid; time }

     

       282
       282
       -
                   else Ok hash_entry

     

       305
       305
       +
                     Ok { hash_entry with build = Build new_cid; time; env; cwd }

     

       306
       306
       +
                   else Ok { hash_entry with cwd; env }

     

       283
       307
        
                 else Error (Eio.Process.Child_error res)

     

       284
       308
        
               in

     

       285
       309
        
               match new_entry with

src/lib/shelter/shelter_main.mli

···

       6
       6
        
           build : Store.Build.t;

     

       7
       7
        
           args : string list;

     

       8
       8
        
           time : int64;

     

       9
       9
       +
           env : string list;

     

       10
       10
       +
           cwd : string;

     

       9
       11
        
           diff : Diff.t;

     

       10
       12
        
         }

     

       11
       13
        
         [@@deriving repr]

+7 -4

vendor/void/src/void.ml

···

       9
       9
        
       

     

       10
       10
        
       type void = {

     

       11
       11
        
         args : string list;

     

       12
       12
       +
         env : string list;

     

       13
       13
       +
         cwd : string;

     

       12
       14
        
         rootfs : (string * mode) option;

     

       13
       15
        
         mounts : mount list;

     

       14
       16
        
       }

     
···

       98
       100
        
       

     

       99
       101
        
       type path = string

     

       100
       102
        
       

     

       101
       101
       -
       let empty = { args = []; rootfs = None; mounts = [] }

     

       103
       103
       +
       let empty = { args = []; env = []; rootfs = None; mounts = []; cwd = "/" }

     

       102
       104
        
       

     

       103
       105
        
       let actions v : Fork_action.t list =

     

       104
       106
        
         let root, tmpfs, root_mode =

     
···

       108
       110
        
         in

     

       109
       111
        
         let args = match v.args with [] -> failwith "No exec" | args -> args in

     

       110
       112
        
         let e =

     

       111
       111
       -
           Process.Fork_action.execve (List.hd args) ~env:[||]

     

       113
       113
       +
           Process.Fork_action.execve (List.hd args) ~env:(Array.of_list v.env) 

     

       112
       114
        
             ~argv:(Array.of_list args)

     

       113
       115
        
         in

     

       114
       116
        
         (* Process mount point points *)

     
···

       126
       128
        
         let mounts = pivot_root root root_flags tmpfs mounts in

     

       127
       129
        
         let uid, gid = Unix.(getuid (), getgid ()) in

     

       128
       130
        
         let user_namespace = map_uid_gid ~uid ~gid in

     

       129
       129
       -
         [ user_namespace; mounts; e ]

     

       131
       131
       +
         [ user_namespace; mounts; Process.Fork_action.chdir v.cwd; e ]

     

       130
       132
        
       

     

       131
       133
        
       let rootfs ~mode path v = { v with rootfs = Some (path, mode) }

     

       132
       132
       -
       let exec args v = { v with args }

     

       134
       134
       +
       let cwd cwd v = { v with cwd }

     

       135
       135
       +
       let exec ?(env=[]) args v = { v with args; env }

     

       133
       136
        
       

     

       134
       137
        
       let mount ~mode ~src ~tgt v =

     

       135
       138
        
         let mode = if mode = R then Mount.Flags.ms_rdonly else Mount.Flags.empty in

+5 -1

vendor/void/src/void.mli

···

       47
       47
        
       

     

       48
       48
        
       val mount : mode:mode -> src:path -> tgt:path -> void -> void

     

       49
       49
        
       

     

       50
       50
       -
       val exec : string list -> void -> void

     

       50
       50
       +
       

     

       51
       51
       +
       val cwd : string -> void -> void

     

       52
       52
       +
       (** Set the current working directory *)

     

       53
       53
       +
       

     

       54
       54
       +
       val exec : ?env:string list -> string list -> void -> void

     

       51
       55
        
       (** Make a void configuration ready to be spawned *)

     

       52
       56
        
       

     

       53
       57
        
       val spawn : sw:Eio.Switch.t -> void -> t