114 lines
3.9 KiB
OCaml
114 lines
3.9 KiB
OCaml
let run () =
|
|
print_string Common.header;
|
|
Common.meat_print "LOOKING FOR FRESHER MEATS..";
|
|
let lockfile = Http.read_file (Unix.getenv "MEATS" ^ "/flake.lock") in
|
|
let json = Json.parse_json lockfile in
|
|
let nodes =
|
|
match Json.jfield "nodes" json with Some n -> n | None -> failwith "no nodes"
|
|
in
|
|
let root_node =
|
|
match Json.jfield "root" nodes with Some n -> n | None -> failwith "no root"
|
|
in
|
|
let root_inputs =
|
|
match Json.jfield "inputs" root_node with
|
|
| Some n -> n
|
|
| None -> failwith "no root inputs"
|
|
in
|
|
let input_pairs =
|
|
match Json.jassoc root_inputs with
|
|
| Some p -> p
|
|
| None -> failwith "root inputs not object"
|
|
in
|
|
let any_stale = ref false in
|
|
List.iter
|
|
(fun (name, node_ref) ->
|
|
let node_name =
|
|
match Json.jstring node_ref with Some s -> s | None -> name
|
|
in
|
|
let node =
|
|
match Json.jfield node_name nodes with
|
|
| Some n -> n
|
|
| None -> failwith ("no node: " ^ node_name)
|
|
in
|
|
let locked =
|
|
match Json.jfield "locked" node with
|
|
| Some n -> n
|
|
| None -> failwith "no locked"
|
|
in
|
|
let original =
|
|
match Json.jfield "original" node with
|
|
| Some n -> n
|
|
| None -> failwith "no original"
|
|
in
|
|
let locked_rev =
|
|
match Option.bind (Json.jfield "rev" locked) Json.jstring with
|
|
| Some s -> s
|
|
| None -> failwith "no rev"
|
|
in
|
|
let locked_type =
|
|
match Option.bind (Json.jfield "type" locked) Json.jstring with
|
|
| Some s -> s
|
|
| None -> failwith "no type"
|
|
in
|
|
let original_ref = Option.bind (Json.jfield "ref" original) Json.jstring in
|
|
let host, path =
|
|
match locked_type with
|
|
| "github" ->
|
|
let owner =
|
|
match Option.bind (Json.jfield "owner" locked) Json.jstring with
|
|
| Some s -> s
|
|
| None -> failwith "no owner"
|
|
in
|
|
let repo =
|
|
match Option.bind (Json.jfield "repo" locked) Json.jstring with
|
|
| Some s -> s
|
|
| None -> failwith "no repo"
|
|
in
|
|
( "github.com",
|
|
"/" ^ owner ^ "/" ^ repo
|
|
^ ".git/info/refs?service=git-upload-pack" )
|
|
| "git" ->
|
|
let url =
|
|
match Option.bind (Json.jfield "url" original) Json.jstring with
|
|
| Some s -> s
|
|
| None -> failwith "no url"
|
|
in
|
|
let prefix = "https://" in
|
|
let plen = String.length prefix in
|
|
if String.length url > plen && String.sub url 0 plen = prefix then
|
|
let after =
|
|
String.sub url plen (String.length url - plen)
|
|
in
|
|
let slash =
|
|
match String.index_opt after '/' with
|
|
| Some i -> i
|
|
| None -> failwith "no path in url"
|
|
in
|
|
let h = String.sub after 0 slash in
|
|
let p =
|
|
String.sub after slash (String.length after - slash)
|
|
in
|
|
(h, p ^ "/info/refs?service=git-upload-pack")
|
|
else failwith ("unsupported url: " ^ url)
|
|
| t -> failwith ("unsupported type: " ^ t)
|
|
in
|
|
try
|
|
let body = Http.https_get ~host ~path in
|
|
let refs = Http.parse_pktline body in
|
|
let target_ref =
|
|
match original_ref with
|
|
| Some r -> "refs/heads/" ^ r
|
|
| None -> "HEAD"
|
|
in
|
|
let latest_rev =
|
|
match List.assoc_opt target_ref refs with
|
|
| Some rev -> rev
|
|
| None -> failwith ("ref not found: " ^ target_ref)
|
|
in
|
|
if latest_rev <> locked_rev then (
|
|
any_stale := true;
|
|
Common.meat_print (Common.all_caps name ^ " HAS FRESHER MEAT!"))
|
|
with _ -> Common.meat_print ("COULD NOT REACH " ^ Common.all_caps name ^ ".."))
|
|
input_pairs;
|
|
if not !any_stale then Common.meat_print "ALL MEATS ARE FRESH!";
|
|
print_string Common.footer
|