vblt.org
forked from
gazagnaire.org/irmin
Persistent store with Git semantics: lazy reads, delayed writes, content-addressing
1(** Git interoperability using ocaml-git.
2
3 Provides bidirectional support for reading and writing Git repositories. *)
4
5(* Convert between irmin Hash.sha1 and Git.Hash.t *)
6let git_hash_of_sha1 (h : Hash.sha1) : Git.Hash.t =
7 Git.Hash.of_raw_string (Hash.to_bytes h)
8
9let sha1_of_git_hash (h : Git.Hash.t) : Hash.sha1 =
10 Hash.sha1_of_bytes (Git.Hash.to_raw_string h)
11
12(* Detect object type from content.
13 Commits start with "tree ", trees have binary format with mode prefixes. *)
14let detect_object_type data =
15 if String.length data >= 5 && String.sub data 0 5 = "tree " then `Commit
16 else if String.length data >= 2 && data.[0] >= '1' && data.[0] <= '7' then
17 (* Tree entries start with mode like "100644 " or "40000 " *)
18 `Tree
19 else `Blob
20
21(* Create Git backend from a Git.Repository.t *)
22let git_backend (repo : Git.Repository.t) : Hash.sha1 Backend.t =
23 {
24 read =
25 (fun hash ->
26 let git_hash = git_hash_of_sha1 hash in
27 match Git.Repository.read repo git_hash with
28 | Ok value -> Some (Git.Value.to_string_without_header value)
29 | Error _ -> None);
30 write =
31 (fun _expected_hash data ->
32 (* Detect object type and write with correct Git wrapper *)
33 let value =
34 match detect_object_type data with
35 | `Blob -> Git.Value.blob (Git.Blob.of_string data)
36 | `Tree -> Git.Value.tree (Git.Tree.of_string_exn data)
37 | `Commit -> Git.Value.commit (Git.Commit.of_string_exn data)
38 in
39 let _git_hash = Git.Repository.write repo value in
40 ());
41 exists =
42 (fun hash ->
43 let git_hash = git_hash_of_sha1 hash in
44 Git.Repository.exists repo git_hash);
45 get_ref =
46 (fun name ->
47 Option.map sha1_of_git_hash (Git.Repository.read_ref repo name));
48 set_ref =
49 (fun name hash ->
50 Git.Repository.write_ref repo name (git_hash_of_sha1 hash));
51 test_and_set_ref =
52 (fun name ~test ~set ->
53 let current = Git.Repository.read_ref repo name in
54 let matches =
55 match (test, current) with
56 | None, None -> true
57 | Some t, Some c -> Git.Hash.equal (git_hash_of_sha1 t) c
58 | _ -> false
59 in
60 if matches then (
61 (match set with
62 | None -> Git.Repository.delete_ref repo name
63 | Some h -> Git.Repository.write_ref repo name (git_hash_of_sha1 h));
64 true)
65 else false);
66 list_refs = (fun () -> Git.Repository.list_refs repo);
67 write_batch =
68 (fun objects ->
69 List.iter
70 (fun (_expected_hash, data) ->
71 let value =
72 match detect_object_type data with
73 | `Blob -> Git.Value.blob (Git.Blob.of_string data)
74 | `Tree -> Git.Value.tree (Git.Tree.of_string_exn data)
75 | `Commit -> Git.Value.commit (Git.Commit.of_string_exn data)
76 in
77 let _git_hash = Git.Repository.write repo value in
78 ())
79 objects);
80 flush = (fun () -> ());
81 close = (fun () -> ());
82 }
83
84(* Public API *)
85
86let import_git ~sw:_ ~fs ~git_dir =
87 let repo = Git.Repository.open_bare ~fs git_dir in
88 let backend = git_backend repo in
89 Store.Git.create ~backend
90
91let open_git ~sw:_ ~fs ~path =
92 let repo = Git.Repository.open_repo ~fs path in
93 let backend = git_backend repo in
94 Store.Git.create ~backend
95
96let init_git ~sw:_ ~fs ~path =
97 let repo = Git.Repository.init ~fs path in
98 let backend = git_backend repo in
99 Store.Git.create ~backend
100
101let read_object ~sw:_ ~fs ~git_dir hash :
102 (string * string, [> `Msg of string ]) result =
103 let repo = Git.Repository.open_bare ~fs git_dir in
104 let git_hash = git_hash_of_sha1 hash in
105 match Git.Repository.read repo git_hash with
106 | Ok value ->
107 let kind =
108 match Git.Value.kind value with
109 | `Blob -> "blob"
110 | `Tree -> "tree"
111 | `Commit -> "commit"
112 | `Tag -> "tag"
113 in
114 Ok (kind, Git.Value.to_string_without_header value)
115 | Error (`Msg m) -> Error (`Msg m)
116
117let write_object ~sw:_ ~fs ~git_dir ~typ data =
118 let repo = Git.Repository.open_bare ~fs git_dir in
119 let value =
120 match typ with
121 | "blob" -> Git.Value.blob (Git.Blob.of_string data)
122 | "tree" -> Git.Value.tree (Git.Tree.of_string_exn data)
123 | "commit" -> Git.Value.commit (Git.Commit.of_string_exn data)
124 | "tag" -> Git.Value.tag (Git.Tag.of_string_exn data)
125 | _ -> invalid_arg ("unknown object type: " ^ typ)
126 in
127 let git_hash = Git.Repository.write repo value in
128 sha1_of_git_hash git_hash
129
130let read_ref ~sw:_ ~fs ~git_dir name =
131 let repo = Git.Repository.open_bare ~fs git_dir in
132 Option.map sha1_of_git_hash (Git.Repository.read_ref repo name)
133
134let write_ref ~sw:_ ~fs ~git_dir name hash =
135 let repo = Git.Repository.open_bare ~fs git_dir in
136 Git.Repository.write_ref repo name (git_hash_of_sha1 hash)
137
138let list_refs ~sw:_ ~fs ~git_dir =
139 let repo = Git.Repository.open_bare ~fs git_dir in
140 Git.Repository.list_refs repo