commit 64530452a22143ec11050ccbe5423d190bc43611 · anil.recoil.org/shelter

.gitignore

README.md

···

       18
       18
        
       ```

     

       19
       19
        
       $ sudo zpool destroy shelter && sudo zpool create shelter /var/shelter.img && sudo rm -rf ~/.cache/shelter

     

       20
       20
        
       ```

     

       21
       21
       +
       

     

       22
       22
       +
       ## Shl files

     

       23
       23
       +
       

     

       24
       24
       +
       You can run both the main shelter program and the passthrough mode via a series of actions in a `.shl` file.

+27 -8

src/bin/main.ml

···

       6
       6
        
       end

     

       7
       7
        
       

     

       8
       8
        
       module Pass = Shelter.Make (History) (Shelter_passthrough)

     

       9
       9
       -
       module Shelter = Shelter.Make (Shelter_main.History) (Shelter_main)

     

       9
       9
       +
       module Main = Shelter.Make (Shelter_main.History) (Shelter_main)

     

       10
       10
        
       

     

       11
       11
        
       let home = Unix.getenv "HOME"

     

       12
       12
        
       

     
···

       17
       17
        
       

     

       18
       18
        
       (* Command Line *)

     

       19
       19
        
       open Cmdliner

     

       20
       20
       +
       

     

       21
       21
       +
       let cmd_file =

     

       22
       22
       +
         let doc = "Path to a file containing a series of commands." in

     

       23
       23
       +
         Arg.(

     

       24
       24
       +
           value

     

       25
       25
       +
           & opt (some file) None

     

       26
       26
       +
           & info [ "f"; "file" ] ~docv:"COMMAND_FILE" ~doc)

     

       20
       27
        
       

     

       21
       28
        
       let main =

     

       22
       22
       -
         let run config =

     

       29
       29
       +
         let run config cmd_file =

     

       23
       30
        
           Eio_posix.run @@ fun env ->

     

       31
       31
       +
           let cmd_file = Option.map (Eio.Path.( / ) env#fs) cmd_file in

     

       24
       32
        
           let dir = state_dir env#fs "shelter" in

     

       25
       25
       -
           Shelter.main config env#fs env#clock env#process_mgr dir

     

       33
       33
       +
           Main.main config env#fs env#clock env#process_mgr dir cmd_file

     

       26
       34
        
         in

     

       27
       27
       -
         let t = Term.(const run $ Shelter_main.config_term) in

     

       35
       35
       +
         let t = Term.(const run $ Shelter_main.config_term $ cmd_file) in

     

       28
       36
        
         let man =

     

       29
       37
        
           [

     

       30
       38
        
             `P

     
···

       37
       45
        
         (Cmd.v info t, t, info)

     

       38
       46
        
       

     

       39
       47
        
       let passthrough =

     

       40
       40
       -
         let run config =

     

       48
       48
       +
         let run config cmd_file =

     

       41
       49
        
           Eio_posix.run @@ fun env ->

     

       50
       50
       +
           let cmd_file = Option.map (Eio.Path.( / ) env#fs) cmd_file in

     

       42
       51
        
           let dir = state_dir env#fs "passthrough" in

     

       43
       43
       -
           Pass.main config env#fs env#clock env#process_mgr dir

     

       52
       52
       +
           Pass.main config env#fs env#clock env#process_mgr dir cmd_file

     

       44
       53
        
         in

     

       45
       45
       -
         let t = Term.(const run $ Shelter_passthrough.config_term) in

     

       54
       54
       +
         let t = Term.(const run $ Shelter_passthrough.config_term $ cmd_file) in

     

       46
       55
        
         let info = Cmd.info "passthrough" in

     

       47
       56
        
         Cmd.v info t

     

       48
       57
        
       

     

       58
       58
       +
       let extract_commands =

     

       59
       59
       +
         let run cmd_file =

     

       60
       60
       +
           Eio_posix.run @@ fun env ->

     

       61
       61
       +
           let cmd_file = Eio.Path.( / ) env#fs (Option.get cmd_file) in

     

       62
       62
       +
           Shelter.Script.to_commands cmd_file |> List.iter (Fmt.pr "%s\n")

     

       63
       63
       +
         in

     

       64
       64
       +
         let t = Term.(const run $ cmd_file) in

     

       65
       65
       +
         let info = Cmd.info "extract" in

     

       66
       66
       +
         Cmd.v info t

     

       67
       67
       +
       

     

       49
       68
        
       let cmds =

     

       50
       69
        
         let cmd, term, info = main in

     

       51
       51
       -
         let cmds = [ cmd; passthrough ] in

     

       70
       70
       +
         let cmds = [ cmd; passthrough; extract_commands ] in

     

       52
       71
        
         Cmd.group ~default:term info cmds

     

       53
       72
        
       

     

       54
       73
        
       let () =

+1 -1

src/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name shelter)

     

       3
       3
        
        (public_name shelter)

     

       4
       4
       -
        (libraries cmdliner irmin-fs.unix eio.unix eio linenoise void repr))

     

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

+57

src/lib/script.ml

···

       1
       1
       +
       module Cst = Morbig.CST

     

       2
       2
       +
       

     

       3
       3
       +
       let redirect_to_string = function

     

       4
       4
       +
         | Cst.IoRedirect_IoFile { value = io_file; _ } -> (

     

       5
       5
       +
             match io_file with

     

       6
       6
       +
             | Cst.IoFile_Great_FileName

     

       7
       7
       +
                 { value = Cst.Filename_Word { value = Cst.Word (w, _); _ }; _ } ->

     

       8
       8
       +
                 Fmt.str "> %s" w

     

       9
       9
       +
             | Cst.IoFile_DGreat_FileName

     

       10
       10
       +
                 { value = Cst.Filename_Word { value = Cst.Word (w, _); _ }; _ } ->

     

       11
       11
       +
                 Fmt.str ">> %s" w

     

       12
       12
       +
             | _ -> failwith "Redirect Unsupported")

     

       13
       13
       +
         | _ -> failwith "IO Redirect Unsupported"

     

       14
       14
       +
       

     

       15
       15
       +
       let cmd_suffix_to_list s =

     

       16
       16
       +
         let rec loop = function

     

       17
       17
       +
           | Cst.CmdSuffix_Word { value = Cst.Word (s, _); _ } -> [ s ]

     

       18
       18
       +
           | Cst.CmdSuffix_CmdSuffix_Word (suff, { value = Cst.Word (s, _); _ }) ->

     

       19
       19
       +
               s :: loop suff.value

     

       20
       20
       +
           | Cst.CmdSuffix_CmdSuffix_IoRedirect (suff, { value = redirect; _ }) ->

     

       21
       21
       +
               let sf = loop suff.value in

     

       22
       22
       +
               redirect_to_string redirect :: sf

     

       23
       23
       +
           | _ -> failwith "Unsupported!"

     

       24
       24
       +
         in

     

       25
       25
       +
         loop s |> List.rev |> String.concat " "

     

       26
       26
       +
       

     

       27
       27
       +
       let of_cmd (c : Cst.command) =

     

       28
       28
       +
         match c with

     

       29
       29
       +
         | Cst.Command_SimpleCommand simple -> (

     

       30
       30
       +
             match simple.value with

     

       31
       31
       +
             | Cst.SimpleCommand_CmdName

     

       32
       32
       +
                 { value = Cst.CmdName_Word { value = Cst.Word (w, _); _ }; _ } ->

     

       33
       33
       +
                 w

     

       34
       34
       +
             | Cst.SimpleCommand_CmdName_CmdSuffix

     

       35
       35
       +
                 ( { value = Cst.CmdName_Word { value = Cst.Word (w, _); _ }; _ },

     

       36
       36
       +
                   { value = suff; _ } ) ->

     

       37
       37
       +
                 let s = cmd_suffix_to_list suff in

     

       38
       38
       +
                 w ^ " " ^ s

     

       39
       39
       +
             | _ -> failwith "Unsupported")

     

       40
       40
       +
         | _ -> failwith "Unsupported"

     

       41
       41
       +
       

     

       42
       42
       +
       let cmds_to_strings =

     

       43
       43
       +
         let v =

     

       44
       44
       +
           object

     

       45
       45
       +
             inherit [_] Morbig.CSTVisitors.reduce

     

       46
       46
       +
             method zero = []

     

       47
       47
       +
             method plus = List.append

     

       48
       48
       +
             method! visit_command acc c = of_cmd c :: acc

     

       49
       49
       +
           end

     

       50
       50
       +
         in

     

       51
       51
       +
         v#visit_program []

     

       52
       52
       +
       

     

       53
       53
       +
       let to_commands file =

     

       54
       54
       +
         let contents = Eio.Path.load file in

     

       55
       55
       +
         let name = Eio.Path.native_exn file |> Filename.basename in

     

       56
       56
       +
         let ast = Morbig.parse_string name contents in

     

       57
       57
       +
         cmds_to_strings ast

+32 -2

src/lib/shelter.ml

···

       1
       1
        
       module History = History

     

       2
       2
        
       module Engine = Engine

     

       3
       3
       +
       module Script = Script

     

       3
       4
        
       

     

       4
       5
        
       module Make (H : History.S) (Engine : Engine.S with type entry = H.t) = struct

     

       5
       6
        
         module Store = Irmin_fs_unix.KV.Make (H)

     
···

       24
       25
        
           in

     

       25
       26
        
           loop store initial_ctx (`Exited 0)

     

       26
       27
        
       

     

       27
       27
       -
         let main config fs clock proc directory =

     

       28
       28
       +
         let command_file_to_actions cf =

     

       29
       29
       +
           Eio.Path.load cf |> String.split_on_char '\n'

     

       30
       30
       +
           |> List.map Engine.action_of_command

     

       31
       31
       +
       

     

       32
       32
       +
         let main config fs clock proc directory command_file =

     

       28
       33
        
           Irmin_fs.run directory @@ fun () ->

     

       29
       34
        
           let conf = Irmin_fs.config (Eio.Path.native_exn directory) in

     

       30
       35
        
           let repo = Store.Repo.v conf in

     

       31
       36
        
           let store = Store.main repo in

     

       32
       32
       -
           run config fs clock proc store

     

       37
       37
       +
           match command_file with

     

       38
       38
       +
           | Some file -> (

     

       39
       39
       +
               let actions = command_file_to_actions file in

     

       40
       40
       +
               let store = History.Store ((module Store), store) in

     

       41
       41
       +
               let initial_ctx = Engine.init fs proc store in

     

       42
       42
       +
               let folder (store, ctx, exit_code) action =

     

       43
       43
       +
                 if exit_code <> `Exited 0 then (store, ctx, exit_code)

     

       44
       44
       +
                 else

     

       45
       45
       +
                   match Engine.run config fs clock proc (store, ctx) action with

     

       46
       46
       +
                   | Error (Eio.Process.Child_error exit_code) ->

     

       47
       47
       +
                       Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code;

     

       48
       48
       +
                       (store, ctx, exit_code)

     

       49
       49
       +
                   | Error (Eio.Process.Executable_not_found m) ->

     

       50
       50
       +
                       Fmt.epr "cshell: excutable not found %s\n%!" m;

     

       51
       51
       +
                       (store, ctx, `Exited 127)

     

       52
       52
       +
                   | Ok (store, ctx) -> (store, ctx, `Exited 0)

     

       53
       53
       +
               in

     

       54
       54
       +
               let _store, _ctx, exit_code =

     

       55
       55
       +
                 List.fold_left folder (store, initial_ctx, `Exited 0) actions

     

       56
       56
       +
               in

     

       57
       57
       +
               match exit_code with

     

       58
       58
       +
               | `Exited 0 -> ()

     

       59
       59
       +
               | `Exited n | `Signaled n ->

     

       60
       60
       +
                   Fmt.epr "%a\n%!" Eio.Process.pp_status exit_code;

     

       61
       61
       +
                   exit n)

     

       62
       62
       +
           | None -> run config fs clock proc store

     

       33
       63
        
       end