Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
irmin: add Sync module, worktree.ml, cmd_push
- Sync: TRANSPORT module type (fetch/push) + resolver type for
conflict resolution strategies (Fail, Ours, Theirs, Custom)
- Worktree: checkout, status, commit against the filesystem with
.irmin/index tracking (mtime+size fast path, hash on change)
- cmd_push: push local branch to remote Git repo (fast-forward only,
CAS on remote ref)
- Export Irmin.Sync in irmin.ml/mli
+312
+31
bin/cmd_push.ml
+31
bin/cmd_push.ml
···
1
+
(** Push command. *)
2
+
3
+
module S = Common.S
4
+
5
+
let run ~repo ~branch ~remote () =
6
+
let config = Config.load ~repo () in
7
+
Eio_main.run @@ fun env ->
8
+
let fs = Eio.Stdenv.cwd env in
9
+
Eio.Switch.run @@ fun sw ->
10
+
let heap = Common.open_store ~sw ~fs ~config in
11
+
let local_head =
12
+
match S.head heap ~branch with
13
+
| None ->
14
+
Common.error "branch %a not found" Common.styled_bold branch;
15
+
exit 1
16
+
| Some h -> h
17
+
in
18
+
let remote_path = Fpath.v remote in
19
+
let remote_heap = Irmin_git.open_ ~sw ~fs ~path:remote_path in
20
+
let remote_head = S.head remote_heap ~branch in
21
+
match remote_head with
22
+
| Some rh when Irmin.Hash.equal rh local_head ->
23
+
Common.success "already up to date"
24
+
| _ ->
25
+
(* Fast-forward: set remote branch to local head *)
26
+
let old = remote_head in
27
+
if S.update_branch remote_heap ~branch ~old ~new_:local_head then
28
+
Common.success "pushed %a to %s" Irmin.Hash.pp_short local_head remote
29
+
else (
30
+
Common.error "push rejected (remote branch changed, pull first)";
31
+
exit 1)
+1
lib/irmin.ml
+1
lib/irmin.ml
+1
lib/irmin.mli
+1
lib/irmin.mli
+13
lib/sync.ml
+13
lib/sync.ml
···
1
+
module type TRANSPORT = sig
2
+
type t
3
+
type hash
4
+
5
+
val fetch : t -> branch:string -> (hash, [ `Msg of string ]) result
6
+
val push : t -> branch:string -> hash -> (unit, [ `Msg of string ]) result
7
+
end
8
+
9
+
type resolver =
10
+
| Fail
11
+
| Ours
12
+
| Theirs
13
+
| Custom of (string list -> string option -> string option -> string)
+42
lib/sync.mli
+42
lib/sync.mli
···
1
+
(** Distributed sync: transport + merge composition.
2
+
3
+
Sync composes a backend-specific {!TRANSPORT} (block transfer) with Schema's
4
+
merge (conflict resolution). Three modes:
5
+
6
+
- {b Explicit}: user-triggered pull/push (like Git).
7
+
- {b Continuous}: automatic gossip between peers (eventually consistent).
8
+
- {b DTN}: delay-tolerant via space-dtn bundle envelopes.
9
+
10
+
The transport handles "get blocks from there to here." The merge handles
11
+
"reconcile concurrent modifications." They compose in [pull]:
12
+
[transport.fetch] + [Schema.merge] + [update_branch]. *)
13
+
14
+
(** {1 Transport}
15
+
16
+
Backend-specific block transfer. Each backend implements this: Git uses
17
+
fetch_local / git-fetch, ATProto uses CAR import/export, OCI uses registry
18
+
pull/push. *)
19
+
20
+
module type TRANSPORT = sig
21
+
type t
22
+
type hash
23
+
24
+
val fetch : t -> branch:string -> (hash, [ `Msg of string ]) result
25
+
(** [fetch t ~branch] ensures all blocks reachable from the remote's [branch]
26
+
tip are available locally. Returns the remote's HEAD hash. *)
27
+
28
+
val push : t -> branch:string -> hash -> (unit, [ `Msg of string ]) result
29
+
(** [push t ~branch hash] pushes [hash] and its reachable blocks to the
30
+
remote. Fast-forward only — fails if the remote has diverged. *)
31
+
end
32
+
33
+
(** {1 Resolver}
34
+
35
+
Conflict resolution strategy for pull/merge. *)
36
+
37
+
type resolver =
38
+
| Fail (** Abort on any conflict. *)
39
+
| Ours (** Keep our version for all conflicts. *)
40
+
| Theirs (** Keep their version for all conflicts. *)
41
+
| Custom of (string list -> string option -> string option -> string)
42
+
(** [Custom f] calls [f path ours theirs] for each conflict. *)
+224
lib/worktree.ml
+224
lib/worktree.ml
···
1
+
module Make (H : sig
2
+
type hash
3
+
4
+
val hash_equal : hash -> hash -> bool
5
+
val hash_string : string -> hash
6
+
val to_hex : hash -> string
7
+
val of_hex : string -> hash
8
+
end) =
9
+
struct
10
+
type change = Added of string | Modified of string | Deleted of string
11
+
12
+
let pp_change ppf = function
13
+
| Added p -> Fmt.pf ppf "A %s" p
14
+
| Modified p -> Fmt.pf ppf "M %s" p
15
+
| Deleted p -> Fmt.pf ppf "D %s" p
16
+
17
+
(* ===== Index ===== *)
18
+
19
+
type index_entry = { path : string; hash : H.hash; mtime : float; size : int }
20
+
type index = index_entry list
21
+
22
+
let irmin_dir dir = Fpath.(to_string (dir / ".irmin"))
23
+
let index_file fs dir = Eio.Path.(fs / irmin_dir dir / "index")
24
+
25
+
let read_index ~fs ~dir =
26
+
let p = index_file fs dir in
27
+
match Eio.Path.load p with
28
+
| content ->
29
+
String.split_on_char '\n' content
30
+
|> List.filter_map (fun line ->
31
+
match String.split_on_char '\t' line with
32
+
| [ path; hex; mtime_s; size_s ] -> (
33
+
match
34
+
(float_of_string_opt mtime_s, int_of_string_opt size_s)
35
+
with
36
+
| Some mtime, Some size ->
37
+
Some { path; hash = H.of_hex hex; mtime; size }
38
+
| _ -> None)
39
+
| _ -> None)
40
+
| exception Eio.Io _ -> []
41
+
42
+
let write_index ~fs ~dir entries =
43
+
let dp = Eio.Path.(fs / irmin_dir dir) in
44
+
(try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dp with Eio.Io _ -> ());
45
+
let p = index_file fs dir in
46
+
let buf = Buffer.create 4096 in
47
+
List.iter
48
+
(fun e ->
49
+
Buffer.add_string buf
50
+
(Fmt.str "%s\t%s\t%.6f\t%d\n" e.path (H.to_hex e.hash) e.mtime e.size))
51
+
entries;
52
+
Eio.Path.save ~create:(`Or_truncate 0o644) p (Buffer.contents buf)
53
+
54
+
(* ===== Filesystem scanning ===== *)
55
+
56
+
let rec walk_dir fs root acc rel_dir =
57
+
let abs_dir =
58
+
if rel_dir = "" then Eio.Path.(fs / Fpath.to_string root)
59
+
else Eio.Path.(fs / Fpath.to_string root / rel_dir)
60
+
in
61
+
match Eio.Path.read_dir abs_dir with
62
+
| names ->
63
+
List.fold_left
64
+
(fun acc name ->
65
+
let rel = if rel_dir = "" then name else rel_dir ^ "/" ^ name in
66
+
if name = ".irmin" || name = ".git" then acc
67
+
else
68
+
let full = Eio.Path.(abs_dir / name) in
69
+
match Eio.Path.kind ~follow:true full with
70
+
| `Directory -> walk_dir fs root acc rel
71
+
| `Regular_file ->
72
+
let stat = Eio.Path.stat ~follow:true full in
73
+
let content = Eio.Path.load full in
74
+
let hash = H.hash_string content in
75
+
{
76
+
path = rel;
77
+
hash;
78
+
mtime = stat.mtime;
79
+
size = Optint.Int63.to_int stat.size;
80
+
}
81
+
:: acc
82
+
| _ -> acc)
83
+
acc names
84
+
| exception Eio.Io _ -> acc
85
+
86
+
let scan_dir ~fs ~root =
87
+
List.sort (fun a b -> String.compare a.path b.path) (walk_dir fs root [] "")
88
+
89
+
(* ===== Status ===== *)
90
+
91
+
let status ~fs ~dir =
92
+
let idx = read_index ~fs ~dir in
93
+
let on_disk = scan_dir ~fs ~root:dir in
94
+
let idx_tbl = Hashtbl.create (List.length idx) in
95
+
List.iter (fun e -> Hashtbl.replace idx_tbl e.path e) idx;
96
+
let disk_tbl = Hashtbl.create (List.length on_disk) in
97
+
List.iter (fun e -> Hashtbl.replace disk_tbl e.path e) on_disk;
98
+
let changes = ref [] in
99
+
List.iter
100
+
(fun idx_e ->
101
+
match Hashtbl.find_opt disk_tbl idx_e.path with
102
+
| None -> changes := Deleted idx_e.path :: !changes
103
+
| Some disk_e ->
104
+
(* Fast path: if mtime and size match, skip re-hash *)
105
+
if disk_e.mtime <> idx_e.mtime || disk_e.size <> idx_e.size then
106
+
if not (H.hash_equal disk_e.hash idx_e.hash) then
107
+
changes := Modified idx_e.path :: !changes)
108
+
idx;
109
+
List.iter
110
+
(fun disk_e ->
111
+
if not (Hashtbl.mem idx_tbl disk_e.path) then
112
+
changes := Added disk_e.path :: !changes)
113
+
on_disk;
114
+
List.sort
115
+
(fun a b ->
116
+
let p = function Added s | Modified s | Deleted s -> s in
117
+
String.compare (p a) (p b))
118
+
!changes
119
+
120
+
(* ===== Checkout ===== *)
121
+
122
+
let checkout ~fs (heap : (H.hash, string) Heap.t) ~hash ~dir =
123
+
(* Walk the tree in the heap and write files to dir.
124
+
This is format-agnostic: it walks the cursor and writes leaf blocks
125
+
as files, using the path as the filename. *)
126
+
let module Sch = Schema.Make (struct
127
+
type nonrec hash = H.hash
128
+
type block = string
129
+
130
+
let hash_equal = H.hash_equal
131
+
let hash_block = H.hash_string
132
+
end) in
133
+
let schema = Sch.opaque in
134
+
let c = Sch.at heap schema hash in
135
+
let entries = ref [] in
136
+
let dir_s = Fpath.to_string dir in
137
+
let rec write_cursor : type a. string -> a Sch.cursor -> unit =
138
+
fun prefix c ->
139
+
let kids = Sch.list c in
140
+
if kids = [] then (
141
+
match Sch.get_block c with
142
+
| None -> ()
143
+
| Some content ->
144
+
let rel = prefix in
145
+
let parent = Filename.dirname rel in
146
+
(if parent <> "." && parent <> "" then
147
+
let pp = Eio.Path.(fs / dir_s / parent) in
148
+
try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 pp
149
+
with Eio.Io _ -> ());
150
+
let full = Eio.Path.(fs / dir_s / rel) in
151
+
Eio.Path.save ~create:(`Or_truncate 0o644) full content;
152
+
let stat = Eio.Path.stat ~follow:true full in
153
+
let h = H.hash_string content in
154
+
entries :=
155
+
{
156
+
path = rel;
157
+
hash = h;
158
+
mtime = stat.mtime;
159
+
size = String.length content;
160
+
}
161
+
:: !entries)
162
+
else
163
+
List.iter
164
+
(fun (name, _kind) ->
165
+
match Sch.step_any c name with
166
+
| None -> ()
167
+
| Some (Sch.Step (_schema, child)) ->
168
+
let child_prefix =
169
+
if prefix = "" then name else prefix ^ "/" ^ name
170
+
in
171
+
write_cursor child_prefix child)
172
+
kids
173
+
in
174
+
write_cursor "" c;
175
+
write_index ~fs ~dir
176
+
(List.sort (fun a b -> String.compare a.path b.path) !entries);
177
+
Ok ()
178
+
179
+
(* ===== Commit ===== *)
180
+
181
+
let commit ~fs (heap : (H.hash, string) Heap.t) ~branch ~dir ~message ~author
182
+
=
183
+
let changes = status ~fs ~dir in
184
+
if changes = [] then Error (`Msg "nothing to commit")
185
+
else
186
+
let new_entries = scan_dir ~fs ~root:dir in
187
+
(* Store all blobs *)
188
+
List.iter
189
+
(fun e ->
190
+
if not (Heap.mem heap e.hash) then
191
+
let full = Eio.Path.(fs / Fpath.to_string dir / e.path) in
192
+
let content = Eio.Path.load full in
193
+
Heap.put heap e.hash content)
194
+
new_entries;
195
+
(* Build tree: list of (path, hash) sorted *)
196
+
let tree_str =
197
+
String.concat "\n"
198
+
(List.map
199
+
(fun e -> Fmt.str "%s\t%s" e.path (H.to_hex e.hash))
200
+
new_entries)
201
+
in
202
+
let tree_hash = H.hash_string tree_str in
203
+
Heap.put heap tree_hash tree_str;
204
+
(* Commit object *)
205
+
let module Sch = Schema.Make (struct
206
+
type nonrec hash = H.hash
207
+
type block = string
208
+
209
+
let hash_equal = H.hash_equal
210
+
let hash_block = H.hash_string
211
+
end) in
212
+
let parent =
213
+
match Sch.head heap ~branch with Some h -> H.to_hex h | None -> ""
214
+
in
215
+
let commit_str =
216
+
Fmt.str "tree %s\nparent %s\nauthor %s\n\n%s" (H.to_hex tree_hash)
217
+
parent author message
218
+
in
219
+
let commit_hash = H.hash_string commit_str in
220
+
Heap.put heap commit_hash commit_str;
221
+
Sch.set_head heap ~branch commit_hash;
222
+
write_index ~fs ~dir new_entries;
223
+
Ok commit_hash
224
+
end