patrick.sirref.org
this repo has no description
Handle error and recovery
+20
-1
src/lib/shelter/shelter_main.mli
+20
-1
src/lib/shelter/shelter_main.mli
···
1
1
module Store = Store
2
2
3
3
module History : sig
4
+
type mode = Void.mode
4
5
type post = { diff : Diff.t; time : int64 } [@@deriving repr]
5
6
6
7
type pre = {
···
19
20
include Irmin.Contents.S with type t := t
20
21
end
21
22
22
-
include Shelter.Engine.S with type entry = History.t
23
+
type action =
24
+
(* Change modes *)
25
+
| Set_mode of History.mode
26
+
(* Fork a new branch from an existing one,
27
+
or switch to a branch if it exists *)
28
+
| Set_session of string
29
+
(* Run a command *)
30
+
| Exec of string list
31
+
(* Undo the last command *)
32
+
| Undo
33
+
(* Replay the current branch onto another *)
34
+
| Replay of string
35
+
(* Display info *)
36
+
| Info of [ `Current | `History ]
37
+
(* Error state *)
38
+
| Unknown of string list
39
+
[@@deriving repr]
40
+
41
+
include Shelter.Engine.S with type entry = History.t and type action := action
+23
-11
src/lib/shelter/store.ml
+23
-11
src/lib/shelter/store.ml
···
94
94
let exists = Zfs.exists t.zfs (snap :> string) Zfs.Types.snapshot in
95
95
if not exists then Zfs.snapshot t.zfs (snap :> string) true
96
96
97
+
let destroy t (d : Datasets.dataset) =
98
+
with_dataset t (d :> string) @@ fun ds -> Zfs.destroy ds false
99
+
97
100
let clone t (snap : Datasets.snapshot) (tgt : Datasets.dataset) =
98
101
with_dataset ~typ:Zfs.Types.snapshot t (snap :> string) @@ fun src ->
99
102
Zfs.clone src (tgt :> string)
···
137
140
let cid = cid image in
138
141
let cids = cid |> Cid.to_string in
139
142
let dataset = Datasets.build t.pool cids in
140
-
let dir = Eio.Path.(t.fs / ("/" ^ (Datasets.build t.pool cids :> string))) in
141
-
create_and_mount t dataset;
142
-
let _dir : string = Fetch.get_image ~dir ~proc:t.proc image in
143
-
snapshot t (Datasets.snapshot dataset);
144
143
let username = Fetch.get_user t.proc image in
145
-
( cid,
146
-
Fetch.get_env t.proc image,
147
-
get_uid_gid ~username Eio.Path.(dir / "rootfs") )
144
+
let dir = Eio.Path.(t.fs / ("/" ^ (Datasets.build t.pool cids :> string))) in
145
+
if Zfs.exists t.zfs (dataset :> string) Zfs.Types.dataset then
146
+
( cid,
147
+
Fetch.get_env t.proc image,
148
+
get_uid_gid ~username Eio.Path.(dir / "rootfs") )
149
+
else (
150
+
create_and_mount t dataset;
151
+
let _dir : string = Fetch.get_image ~dir ~proc:t.proc image in
152
+
snapshot t (Datasets.snapshot dataset);
153
+
( cid,
154
+
Fetch.get_env t.proc image,
155
+
get_uid_gid ~username Eio.Path.(dir / "rootfs") ))
148
156
149
157
module Run = struct
150
158
let with_build t cid fn =
···
193
201
(fn (`Exists ("/" ^ (tgt :> string))), diff t src_snap tgt_snap output)
194
202
else (
195
203
clone t src_snap tgt;
196
-
let v = with_build t new_cid fn in
197
-
snapshot t tgt_snap;
198
-
let d = diff t src_snap tgt_snap output in
199
-
(v, d))
204
+
match with_build t new_cid fn with
205
+
| Error _ as v ->
206
+
destroy t tgt;
207
+
(v, [])
208
+
| Ok _ as v ->
209
+
snapshot t tgt_snap;
210
+
let d = diff t src_snap tgt_snap output in
211
+
(v, d))
200
212
end
+1
vendor/zfs/src/function_description.ml
+1
vendor/zfs/src/function_description.ml
···
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
+
let destroy = foreign "zfs_destroy" (Types.zfs_handle_t @-> bool @-> returning int)
52
53
let get_type = foreign "zfs_get_type" (Types.zfs_handle_t @-> returning int)
53
54
54
55
module Nvlist = struct
+4
vendor/zfs/src/zfs.ml
+4
vendor/zfs/src/zfs.ml
···
94
94
let i = C.Functions.create handle path type_ (Nvlist.v props) in
95
95
if i != 0 then failwith "Failed to create" else ()
96
96
97
+
let destroy handle recurse =
98
+
let i = C.Functions.destroy handle recurse in
99
+
if i != 0 then invalid_arg "destroy" else ()
100
+
97
101
let open_ handle path (type_ : Types.t) = C.Functions.open_ handle path type_
98
102
let close : t -> unit = C.Functions.close
99
103
let get_type : t -> Types.t = C.Functions.get_type