gazagnaire.org
Git object storage and pack files for Eio
1(* Copyright (c) 2024-2026 Thomas Gazagnaire <thomas@gazagnaire.org>
2
3 Permission to use, copy, modify, and distribute this software for any
4 purpose with or without fee is hereby granted, provided that the above
5 copyright notice and this permission notice appear in all copies.
6
7 THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8 WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9 MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10 ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12 ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13 OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
14
15(** Git smart HTTP protocol implementation for remote queries.
16
17 This implements the git smart HTTP protocol for lightweight remote
18 operations like ls-remote without cloning or fetching.
19
20 Reference: https://git-scm.com/docs/http-protocol *)
21
22type ref_entry = { ref_name : string; hash : Hash.t }
23
24(* Parse a pkt-line length (4 hex digits) *)
25let parse_pkt_len s offset =
26 if offset + 4 > String.length s then None
27 else
28 let hex = String.sub s offset 4 in
29 try Some (int_of_string ("0x" ^ hex)) with Failure _ -> None
30
31(* Parse pkt-line formatted data.
32 Format: 4 hex digits length + content, or "0000" for flush packet *)
33let parse_pkt_lines data =
34 let len = String.length data in
35 let rec parse acc offset =
36 if offset >= len then List.rev acc
37 else
38 match parse_pkt_len data offset with
39 | None -> List.rev acc
40 | Some 0 -> parse acc (offset + 4) (* flush packet *)
41 | Some pkt_len when pkt_len <= 4 -> List.rev acc
42 | Some pkt_len ->
43 let content_len = pkt_len - 4 in
44 if offset + 4 + content_len > len then List.rev acc
45 else
46 let content = String.sub data (offset + 4) content_len in
47 (* Strip trailing newline if present *)
48 let content =
49 if
50 String.length content > 0
51 && content.[String.length content - 1] = '\n'
52 then String.sub content 0 (String.length content - 1)
53 else content
54 in
55 parse (content :: acc) (offset + pkt_len)
56 in
57 parse [] 0
58
59(* Parse a ref line: "sha1 refname\0capabilities" or "sha1 refname" *)
60let parse_ref_line line =
61 (* Skip service announcement lines *)
62 if String.length line = 0 || line.[0] = '#' then None
63 else
64 (* Split on space to get hash and ref *)
65 match String.index_opt line ' ' with
66 | None -> None
67 | Some i ->
68 let hash_str = String.sub line 0 i in
69 let rest = String.sub line (i + 1) (String.length line - i - 1) in
70 (* Strip capabilities after NUL if present *)
71 let ref_name =
72 match String.index_opt rest '\x00' with
73 | Some j -> String.sub rest 0 j
74 | None -> rest
75 in
76 if String.length hash_str = 40 then
77 try Some { ref_name; hash = Hash.of_hex hash_str }
78 with Invalid_argument _ -> None
79 else None
80
81let git_headers =
82 Requests.Headers.empty
83 |> Requests.Headers.set_string "User-Agent" "ocaml-git/4.0"
84 |> Requests.Headers.set_string "Accept"
85 "application/x-git-upload-pack-advertisement"
86
87let normalize_url url =
88 let s = Uri.to_string url in
89 if String.length s > 0 && s.[String.length s - 1] = '/' then
90 String.sub s 0 (String.length s - 1)
91 else s
92
93(** Query remote refs using git smart HTTP protocol. Pass an existing [session]
94 to reuse TLS connection and avoid cert reload. *)
95let ls_remote ?session ~sw ~env url =
96 let url_str = normalize_url url in
97 let info_refs_url = url_str ^ "/info/refs?service=git-upload-pack" in
98 try
99 let session =
100 match session with Some s -> s | None -> Requests.v ~sw env
101 in
102 let resp = Requests.get session ~headers:git_headers info_refs_url in
103 if not (Requests.Response.ok resp) then None
104 else
105 let body = Requests.Response.text resp in
106 let lines = parse_pkt_lines body in
107 let refs = List.filter_map parse_ref_line lines in
108 Some refs
109 with Eio.Io _ | Failure _ -> None
110
111(** Get the HEAD ref for a specific branch. Pass an existing [session] to reuse
112 TLS connection. *)
113let head ?session ~sw ~env url ~branch =
114 match ls_remote ?session ~sw ~env url with
115 | None -> None
116 | Some refs ->
117 let ref_name = "refs/heads/" ^ branch in
118 List.find_map
119 (fun r -> if r.ref_name = ref_name then Some r.hash else None)
120 refs
121
122(** Check if a remote ref matches a local hash. Pass an existing [session] to
123 reuse TLS connection. *)
124let matches_local ?session ~sw ~env url ~branch ~local_hash =
125 match head ?session ~sw ~env url ~branch with
126 | None -> false
127 | Some remote_hash -> Hash.equal remote_hash local_hash