refactor, hunt

lib/http.ml

@@ -0,0 +1,232 @@
+let read_file path =
+  let ic = open_in path in
+  let n = in_channel_length ic in
+  let s = really_input_string ic n in
+  close_in ic;
+  s
+
+let contains_sub haystack needle =
+  let hl = String.length haystack and nl = String.length needle in
+  if nl > hl then false
+  else
+    let rec check i =
+      if i + nl > hl then false
+      else if String.sub haystack i nl = needle then true
+      else check (i + 1)
+    in
+    check 0
+
+let decode_chunked body =
+  let len = String.length body in
+  let buf = Buffer.create (len / 2) in
+  let i = ref 0 in
+  (try
+     while !i < len do
+       let line_end =
+         let rec find j =
+           if j >= len then raise Exit else if body.[j] = '\r' then j
+           else find (j + 1)
+         in
+         find !i
+       in
+       let size_str = String.sub body !i (line_end - !i) in
+       let size_str =
+         match String.index_opt size_str ';' with
+         | Some idx -> String.sub size_str 0 idx
+         | None -> size_str
+       in
+       let size = int_of_string ("0x" ^ String.trim size_str) in
+       if size = 0 then raise Exit;
+       i := line_end + 2;
+       if !i + size <= len then
+         Buffer.add_string buf (String.sub body !i size);
+       i := !i + size + 2
+     done
+   with Exit -> ());
+  Buffer.contents buf
+
+let b64_encode src =
+  let tbl = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" in
+  let len = String.length src in
+  let buf = Buffer.create (len * 4 / 3 + 4) in
+  let i = ref 0 in
+  while !i + 2 < len do
+    let a = Char.code src.[!i] and b = Char.code src.[!i+1] and c = Char.code src.[!i+2] in
+    Buffer.add_char buf tbl.[(a lsr 2) land 0x3f];
+    Buffer.add_char buf tbl.[((a lsl 4) lor (b lsr 4)) land 0x3f];
+    Buffer.add_char buf tbl.[((b lsl 2) lor (c lsr 6)) land 0x3f];
+    Buffer.add_char buf tbl.[c land 0x3f];
+    i := !i + 3
+  done;
+  (match len - !i with
+  | 2 ->
+      let a = Char.code src.[!i] and b = Char.code src.[!i+1] in
+      Buffer.add_char buf tbl.[(a lsr 2) land 0x3f];
+      Buffer.add_char buf tbl.[((a lsl 4) lor (b lsr 4)) land 0x3f];
+      Buffer.add_char buf tbl.[(b lsl 2) land 0x3f];
+      Buffer.add_char buf '='
+  | 1 ->
+      let a = Char.code src.[!i] in
+      Buffer.add_char buf tbl.[(a lsr 2) land 0x3f];
+      Buffer.add_char buf tbl.[(a lsl 4) land 0x3f];
+      Buffer.add_string buf "=="
+  | _ -> ());
+  Buffer.contents buf
+
+let ssl_inited = ref false
+
+let https_request ~meth ~host ~path ?(headers=[]) ?(body="") () =
+  if not !ssl_inited then (
+    Ssl.init ();
+    ssl_inited := true);
+  let he = Unix.gethostbyname host in
+  let addr = he.h_addr_list.(0) in
+  let sockaddr = Unix.ADDR_INET (addr, 443) in
+  let ctx = Ssl.create_context Ssl.TLSv1_2 Ssl.Client_context in
+  let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
+  Unix.connect sock sockaddr;
+  let ssl = Ssl.embed_socket sock ctx in
+  Ssl.set_client_SNI_hostname ssl host;
+  Ssl.connect ssl;
+  let extra_headers =
+    List.fold_left (fun acc (k, v) -> acc ^ k ^ ": " ^ v ^ "\r\n") "" headers
+  in
+  let content_len = if body <> "" then
+    Printf.sprintf "Content-Length: %d\r\n" (String.length body)
+  else "" in
+  let req =
+    Printf.sprintf "%s %s HTTP/1.1\r\nHost: %s\r\nUser-Agent: meat/1.0\r\nConnection: close\r\n%s%s\r\n%s"
+      meth path host extra_headers content_len body
+  in
+  ignore (Ssl.write ssl (Bytes.of_string req) 0 (String.length req));
+  let buf = Buffer.create 8192 in
+  let chunk = Bytes.create 4096 in
+  (try
+     while true do
+       let n = Ssl.read ssl chunk 0 4096 in
+       if n = 0 then raise Exit;
+       Buffer.add_subbytes buf chunk 0 n
+     done
+   with _ -> ());
+  (try Ssl.shutdown_connection ssl with _ -> ());
+  Unix.close sock;
+  let response = Buffer.contents buf in
+  let rlen = String.length response in
+  let header_end =
+    let rec find pos =
+      if pos + 3 >= rlen then rlen
+      else if
+        response.[pos] = '\r'
+        && response.[pos + 1] = '\n'
+        && response.[pos + 2] = '\r'
+        && response.[pos + 3] = '\n'
+      then pos
+      else find (pos + 1)
+    in
+    find 0
+  in
+  let resp_headers = String.sub response 0 header_end in
+  let body_start = min (header_end + 4) rlen in
+  let resp_body = String.sub response body_start (rlen - body_start) in
+  if
+    contains_sub
+      (String.lowercase_ascii resp_headers)
+      "transfer-encoding: chunked"
+  then decode_chunked resp_body
+  else resp_body
+
+let https_get ~host ~path =
+  https_request ~meth:"GET" ~host ~path
+    ~headers:[("User-Agent", "git/2.0")] ()
+
+let https_post ~host ~path ~body =
+  https_request ~meth:"POST" ~host ~path
+    ~headers:[
+      ("Content-Type", "application/json");
+      ("Accept", "application/json");
+      ("Authorization", "Basic " ^ b64_encode "aWVSALXpZv:X8gPHnzL52wFEekuxsfQ9cSh");
+    ] ~body ()
+
+let parse_pktline body =
+  let len = String.length body in
+  let i = ref 0 in
+  let refs = ref [] in
+  let hex_val c =
+    match c with
+    | '0' .. '9' -> Char.code c - Char.code '0'
+    | 'a' .. 'f' -> Char.code c - Char.code 'a' + 10
+    | 'A' .. 'F' -> Char.code c - Char.code 'A' + 10
+    | _ -> 0
+  in
+  let read_pkt_len () =
+    if !i + 4 > len then 0
+    else
+      let a = hex_val body.[!i]
+      and b = hex_val body.[!i + 1]
+      and c = hex_val body.[!i + 2]
+      and d = hex_val body.[!i + 3] in
+      i := !i + 4;
+      (a * 4096) + (b * 256) + (c * 16) + d
+  in
+  let plen = read_pkt_len () in
+  if plen > 4 then i := !i + (plen - 4);
+  ignore (read_pkt_len ());
+  let continue = ref true in
+  while !continue do
+    let plen = read_pkt_len () in
+    if plen = 0 then continue := false
+    else
+      let payload_len = plen - 4 in
+      if !i + payload_len <= len && payload_len >= 41 then (
+        let payload = String.sub body !i payload_len in
+        i := !i + payload_len;
+        let sha = String.sub payload 0 40 in
+        let rest = String.sub payload 41 (String.length payload - 41) in
+        let refname =
+          let s =
+            match String.index_opt rest '\000' with
+            | Some idx -> String.sub rest 0 idx
+            | None -> rest
+          in
+          match String.index_opt s '\n' with
+          | Some idx -> String.sub s 0 idx
+          | None -> s
+        in
+        refs := (refname, sha) :: !refs)
+      else i := !i + max 0 payload_len
+  done;
+  List.rev !refs
+
+let derelativise base = List.map (fun a -> base ^ "/" ^ a)
+
+let filter_dirs fullpath dirs =
+  dirs |> derelativise fullpath
+  |> List.filter (fun d -> (Unix.stat d).st_kind = Unix.S_DIR)
+
+let readdir d = try Sys.readdir d with Sys_error _ -> [||]
+
+let walk entry =
+  let open List in
+  let rec loop dir : string list =
+    let contents = readdir dir |> Array.to_list in
+    let is_flake = mem "flake.nix" contents in
+    if dir = entry then
+      let subdirs = contents |> filter_dirs dir in
+      flatten (map loop subdirs)
+    else if is_flake then
+      let subdirs = contents |> filter_dirs dir in
+      let children = flatten (map loop subdirs) in
+      [ dir ] @ children
+    else []
+  in
+  loop entry
+
+let countdepth s =
+  s |> String.fold_left (fun acc el -> acc + if el = '/' then 1 else 0) 0
+
+let compdepth a b =
+  let ad = countdepth a and bd = countdepth b in
+  let dif = ad - bd in
+  match dif with 0 -> 0 | _ -> dif / abs dif
+
+let fmt_dir d = String.split_on_char '/' d |> List.rev |> List.hd |> Common.all_caps