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
21let git_value_of_data data =
22 match detect_object_type data with
23 | `Blob -> Git.Value.blob (Git.Blob.of_string data)
24 | `Tree -> Git.Value.tree (Git.Tree.of_string_exn data)
25 | `Commit -> Git.Value.commit (Git.Commit.of_string_exn data)
26
27let test_and_set_ref repo name ~test ~set =
28 let current = Git.Repository.read_ref repo name in
29 let matches =
30 match (test, current) with
31 | None, None -> true
32 | Some t, Some c -> Git.Hash.equal (git_hash_of_sha1 t) c
33 | _ -> false
34 in
35 if matches then (
36 (match set with
37 | None -> Git.Repository.delete_ref repo name
38 | Some h -> Git.Repository.write_ref repo name (git_hash_of_sha1 h));
39 true)
40 else false
41
42(* Create Git backend from a Git.Repository.t *)
43let git_backend (repo : Git.Repository.t) : Hash.sha1 Backend.t =
44 {
45 read =
46 (fun hash ->
47 let git_hash = git_hash_of_sha1 hash in
48 match Git.Repository.read repo git_hash with
49 | Ok value -> Some (Git.Value.to_string_without_header value)
50 | Error _ -> None);
51 write =
52 (fun _expected_hash data ->
53 ignore (Git.Repository.write repo (git_value_of_data data)));
54 exists =
55 (fun hash ->
56 let git_hash = git_hash_of_sha1 hash in
57 Git.Repository.exists repo git_hash);
58 get_ref =
59 (fun name ->
60 Option.map sha1_of_git_hash (Git.Repository.read_ref repo name));
61 set_ref =
62 (fun name hash ->
63 Git.Repository.write_ref repo name (git_hash_of_sha1 hash));
64 test_and_set_ref = test_and_set_ref repo;
65 list_refs = (fun () -> Git.Repository.list_refs repo);
66 write_batch =
67 (fun objects ->
68 List.iter
69 (fun (_expected_hash, data) ->
70 ignore (Git.Repository.write repo (git_value_of_data data)))
71 objects);
72 flush = (fun () -> ());
73 close = (fun () -> ());
74 }
75
76(* Public API *)
77
78let import_git ~sw:_ ~fs ~git_dir =
79 let repo = Git.Repository.open_bare ~fs git_dir in
80 let backend = git_backend repo in
81 Store.Git.create ~backend
82
83let open_git ~sw:_ ~fs ~path =
84 let repo = Git.Repository.open_repo ~fs path in
85 let backend = git_backend repo in
86 Store.Git.create ~backend
87
88let init_git ~sw:_ ~fs ~path =
89 let repo = Git.Repository.init ~fs path in
90 let backend = git_backend repo in
91 Store.Git.create ~backend
92
93let read_object ~sw:_ ~fs ~git_dir hash :
94 (string * string, [> `Msg of string ]) result =
95 let repo = Git.Repository.open_bare ~fs git_dir in
96 let git_hash = git_hash_of_sha1 hash in
97 match Git.Repository.read repo git_hash with
98 | Ok value ->
99 let kind =
100 match Git.Value.kind value with
101 | `Blob -> "blob"
102 | `Tree -> "tree"
103 | `Commit -> "commit"
104 | `Tag -> "tag"
105 in
106 Ok (kind, Git.Value.to_string_without_header value)
107 | Error (`Msg m) -> Error (`Msg m)
108
109let write_object ~sw:_ ~fs ~git_dir ~typ data =
110 let repo = Git.Repository.open_bare ~fs git_dir in
111 let value =
112 match typ with
113 | "blob" -> Git.Value.blob (Git.Blob.of_string data)
114 | "tree" -> Git.Value.tree (Git.Tree.of_string_exn data)
115 | "commit" -> Git.Value.commit (Git.Commit.of_string_exn data)
116 | "tag" -> Git.Value.tag (Git.Tag.of_string_exn data)
117 | _ -> invalid_arg ("unknown object type: " ^ typ)
118 in
119 let git_hash = Git.Repository.write repo value in
120 sha1_of_git_hash git_hash
121
122let read_ref ~sw:_ ~fs ~git_dir name =
123 let repo = Git.Repository.open_bare ~fs git_dir in
124 Option.map sha1_of_git_hash (Git.Repository.read_ref repo name)
125
126let write_ref ~sw:_ ~fs ~git_dir name hash =
127 let repo = Git.Repository.open_bare ~fs git_dir in
128 Git.Repository.write_ref repo name (git_hash_of_sha1 hash)
129
130let list_refs ~sw:_ ~fs ~git_dir =
131 let repo = Git.Repository.open_bare ~fs git_dir in
132 Git.Repository.list_refs repo