diff --git a/bin/main.ml b/bin/main.ml index 0e465e8..6aa19f9 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -10,8 +10,9 @@ let () = | "poke" -> poke () | "gut" -> gut () | "trade" -> trade () - (* | "look" -> look () *) + | "look" -> look () | "fresh" -> fresh () + | "hunt" -> hunt () | _ -> help () else help () | None -> diff --git a/flake.nix b/flake.nix index 964647b..33d7c3a 100644 --- a/flake.nix +++ b/flake.nix @@ -22,7 +22,10 @@ inherit (pkgs.ocamlPackages) dune_3 ocaml + yojson + ssl ; + inherit (pkgs.openssl) dev; }; dev = collectPkgs { inherit (pkgs.ocamlPackages) diff --git a/lib/commands/cook.ml b/lib/commands/cook.ml new file mode 100644 index 0000000..4c79b1c --- /dev/null +++ b/lib/commands/cook.ml @@ -0,0 +1,9 @@ +let run () = + print_string Common.header; + Common.meat_print "PREPARING DELICIOUS MEATS.."; + let build_target = + Unix.getenv "MEATS" ^ "#nixosConfigurations." ^ Unix.gethostname () + ^ ".config.system.build.toplevel" + in + Common.do_cmd @@ "nix build --no-link" ^ build_target |> ignore; + print_string Common.footer diff --git a/lib/commands/fresh.ml b/lib/commands/fresh.ml new file mode 100644 index 0000000..d4c4a52 --- /dev/null +++ b/lib/commands/fresh.ml @@ -0,0 +1,17 @@ +let run () = + print_string Common.header; + Common.meat_print "HUNTING FRESH MEATS.."; + let argv_len = Array.length Sys.argv in + let root = Sys.getenv "MEATS" in + if argv_len >= 3 then + let open Array in + let flakes = sub Sys.argv 2 (argv_len - 2) in + flakes + |> iter (fun f -> + if Common.all_low f = "meat" then Common.meat_print "PROCESSING REAL MEAT.." + else Common.meat_print ("PROCESSING FRESH MEAT " ^ Common.all_caps f ^ ".."); + Common.do_cmd ~args:false @@ "nix flake update " ^ f ^ " --flake " ^ root + |> ignore) + else Common.do_cmd @@ "nix flake update --flake " ^ root |> ignore; + print_string Common.footer; + print_newline () diff --git a/lib/commands/gut.ml b/lib/commands/gut.ml new file mode 100644 index 0000000..8a5594c --- /dev/null +++ b/lib/commands/gut.ml @@ -0,0 +1,5 @@ +let run () = + print_string Common.header; + Common.meat_print "CLEANING MEAT STORES.."; + Common.do_cmd "nh clean all" |> ignore; + print_string Common.footer diff --git a/lib/commands/help.ml b/lib/commands/help.ml new file mode 100644 index 0000000..f29a0e7 --- /dev/null +++ b/lib/commands/help.ml @@ -0,0 +1 @@ +let run () = print_string (Common.header ^ Common.help_text ^ Common.footer ^ "\n") diff --git a/lib/commands/hunt.ml b/lib/commands/hunt.ml new file mode 100644 index 0000000..655feee --- /dev/null +++ b/lib/commands/hunt.ml @@ -0,0 +1,61 @@ +let es_host = "nixos-search-7-1733963800.us-east-1.bonsaisearch.net" + +let es_query term = + Printf.sprintf + {|{"from":0,"size":20,"sort":[{"_score":"desc","package_attr_name":"desc","package_pversion":"desc"}],"collapse":{"field":"package_attr_name"},"query":{"bool":{"must":[{"term":{"type":"package"}},{"multi_match":{"type":"cross_fields","query":"%s","fields":["package_attr_name^9","package_pname^6","package_description^1.3","package_longDescription^1"]}}]}}}|} + term + +let truncate n s = if String.length s > n then String.sub s 0 n ^ ".." else s + +let run () = + print_string Common.header; + let argv_len = Array.length Sys.argv in + if argv_len < 3 then ( + Common.meat_print "WHAT MEAT ARE YOU HUNTING?"; + print_string Common.footer) + else + let query = + Array.sub Sys.argv 2 (argv_len - 2) + |> Array.to_list |> String.concat " " + in + Common.meat_print ("HUNTING FOR " ^ Common.all_caps query ^ ".."); + let body = es_query query in + let path = "/nixos-*-unstable-*/_search" in + (try + let resp = Http.https_post ~host:es_host ~path ~body in + let json = Json.parse_json resp in + let hits = + match Option.bind (Json.jfield "hits" json) (fun h -> Json.jfield "hits" h) with + | Some (`List items) -> items + | _ -> [] + in + if hits = [] then + Common.meat_print "NO MEATS FOUND!" + else + List.iter + (fun hit -> + let src = + match Json.jfield "_source" hit with Some s -> s | None -> `Null + in + let name = + match Option.bind (Json.jfield "package_attr_name" src) Json.jstring with + | Some s -> s + | None -> "?" + in + let version = + match Option.bind (Json.jfield "package_pversion" src) Json.jstring with + | Some s -> s + | None -> "" + in + let desc = + match Option.bind (Json.jfield "package_description" src) Json.jstring with + | Some s -> truncate 60 s + | None -> "" + in + let ver_str = if version <> "" then " (" ^ version ^ ")" else "" in + Printf.printf " \tnixpkgs#%s%s\n" name ver_str; + if desc <> "" then Printf.printf " \t %s\n" desc) + hits + with e -> + Common.meat_print ("HUNT FAILED: " ^ Printexc.to_string e)); + print_string Common.footer diff --git a/lib/commands/look.ml b/lib/commands/look.ml new file mode 100644 index 0000000..c1df668 --- /dev/null +++ b/lib/commands/look.ml @@ -0,0 +1,114 @@ +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 diff --git a/lib/commands/poke.ml b/lib/commands/poke.ml new file mode 100644 index 0000000..800e39d --- /dev/null +++ b/lib/commands/poke.ml @@ -0,0 +1,9 @@ +let run () = + print_string Common.header; + Common.meat_print "PREPARING SUSPICIOUS MEATS.."; + let build_target = + Unix.getenv "MEATS" ^ "#nixosConfigurations." ^ Unix.gethostname () + ^ ".config.system.build.toplevel" + in + Common.do_cmd @@ "nix build --no-link " ^ build_target ^ " --show-trace" |> ignore; + print_string Common.footer diff --git a/lib/commands/trade.ml b/lib/commands/trade.ml new file mode 100644 index 0000000..80e6dfa --- /dev/null +++ b/lib/commands/trade.ml @@ -0,0 +1,8 @@ +let run () = + print_string Common.header; + Common.meat_print "TRADING FOREIGN MEATS.."; + Common.do_remote () |> function + | Error _ -> print_string "FAILED TO TRADE MEATS." + | _ -> + (); + print_string Common.footer diff --git a/lib/commands/yum.ml b/lib/commands/yum.ml new file mode 100644 index 0000000..08514cc --- /dev/null +++ b/lib/commands/yum.ml @@ -0,0 +1,7 @@ +let run () = + print_string Common.header; + Common.meat_print "CONSUMING DELICIOUS MEATS.."; + ( Common.do_build () |> function + | Error _ -> print_string "FAILED TO CONSUME MEATS." + | _ -> () ); + print_string Common.footer diff --git a/lib/common.ml b/lib/common.ml new file mode 100644 index 0000000..c8a87b9 --- /dev/null +++ b/lib/common.ml @@ -0,0 +1,60 @@ +let header = "\n ----- MEAT ----------------------------------------\n" +let footer = "\n ---------------------------------------------------\n" + +let help_text = + {| + YUM - CONSUME DELICIOUS MEATS + COOK - ONLY PREPARE MEATS + POKE - TASTE SUSPICIOUS MEATS + GUT - CLEAN MEAT STORES + FRESH - HUNT FRESH MEATS + LOOK - LOOK FOR FRESHER MEATS + HUNT - HUNT FOR MEATS IN NIXPKGS + TRADE - SEND MEATS FAR AWAY + ..-A - ..ALL MEATS|} +open Sys + +let pass_args () = + let len = Array.length argv and sconcat acc el = acc ^ " " ^ el in + match len with + | 3 -> argv.(2) + | n when n > 3 -> + print_int (n - 1); + Array.fold_left sconcat " " (Array.sub argv 2 (n - 2)) + | _ -> "" + +let do_cmd ?(args = true) cmd = + match command (if args then cmd ^ " " ^ pass_args () else cmd) with + | 0 -> Ok () + | e -> Error e + +let meat_print text = print_endline ("\n \t" ^ text ^ "\n") + +let do_build () = + let ( >>= ) = Result.bind in + let ( >|= ) = Fun.flip Result.map in + let tmpdir = Filename.temp_dir "meat-build" "" in + let build_target = + Unix.getenv "MEATS" ^ "/entry.nix -A nixosConfigurations." + ^ Unix.gethostname () ^ ".config.system.build.toplevel" + in + do_cmd @@ "nix-build --log-format internal-json -v --out-link " ^ tmpdir + ^ "/build " ^ build_target ^ " |& nom --json" + >>= fun () -> + do_cmd @@ "dix /nix/var/nix/profiles/system " ^ tmpdir ^ "/build" + >>= fun () -> + do_cmd @@ "sudo nix-env --set -p /nix/var/nix/profiles/system " ^ tmpdir + ^ "/build && " ^ tmpdir ^ "/build/bin/switch-to-configuration switch" + >|= fun () -> Unix.unlink @@ tmpdir ^ "/build" + +let do_remote () = + meat_print "tbd"; + Ok () + +let all_flag () = + if Array.length argv >= 3 then + match Array.get argv 2 with "-a" | "--all" -> true | _ -> false + else false + +let all_caps s = s |> String.map (fun c -> Char.uppercase_ascii c) +let all_low s = s |> String.map (fun c -> Char.lowercase_ascii c) diff --git a/lib/dune b/lib/dune index 2b63e36..016c372 100644 --- a/lib/dune +++ b/lib/dune @@ -1,3 +1,4 @@ +(include_subdirs qualified) (library (name meat) - (libraries unix)) + (libraries unix ssl yojson)) diff --git a/lib/http.ml b/lib/http.ml new file mode 100644 index 0000000..f681505 --- /dev/null +++ b/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 diff --git a/lib/json.ml b/lib/json.ml new file mode 100644 index 0000000..5dd5297 --- /dev/null +++ b/lib/json.ml @@ -0,0 +1,8 @@ +let parse_json src = Yojson.Basic.from_string src + +let jfield key = function + | `Assoc pairs -> List.assoc_opt key pairs + | _ -> None + +let jstring = function `String s -> Some s | _ -> None +let jassoc = function `Assoc pairs -> Some pairs | _ -> None diff --git a/lib/meat.ml b/lib/meat.ml index 9a17705..2d481e1 100644 --- a/lib/meat.ml +++ b/lib/meat.ml @@ -1,213 +1,10 @@ -let header = "\n ----- MEAT ----------------------------------------\n" -let footer = "\n ---------------------------------------------------\n" - -let help = - {| - YUM - CONSUME DELICIOUS MEATS - COOK - ONLY PREPARE MEATS - POKE - TASTE SUSPICIOUS MEATS - GUT - CLEAN MEAT STORES - FRESH - HUNT FRESH MEATS - TRADE - SEND MEATS FAR AWAY - ..-A - ..ALL MEATS|} - -(* \tLOOK - LOOK FOR FRESHER MEATS *) -open Sys - -(* TODO rewrite all of this to use its own build and activation routines *) -(* pipe into nom for user output, then use dix at the end *) -let pass_args () = - let len = Array.length argv and sconcat acc el = acc ^ " " ^ el in - match len with - | 3 -> argv.(2) - | n when n > 3 -> - print_int (n - 1); - Array.fold_left sconcat " " (Array.sub argv 2 (n - 2)) - | _ -> "" - -let do_cmd ?(args = true) cmd = - match command (if args then cmd ^ " " ^ pass_args () else cmd) with - | 0 -> Ok () - | e -> Error e - -let meat_print text = print_endline ("\n \t" ^ text ^ "\n") - -let do_build () = - let ( >>= ) = Result.bind in - let ( >|= ) = Fun.flip Result.map in - let tmpdir = Filename.temp_dir "meat-build" "" in - let build_target = - Unix.getenv "MEATS" ^ "/entry.nix -A nixosConfigurations." - ^ Unix.gethostname () ^ ".config.system.build.toplevel" - in - do_cmd @@ "nix-build --log-format internal-json -v --out-link " ^ tmpdir - ^ "/build " ^ build_target ^ " |& nom --json" - >>= fun () -> do_cmd @@ "dix /nix/var/nix/profiles/system " ^ tmpdir ^ "/build" - >>= fun () -> - do_cmd @@ "sudo nix-env --set -p /nix/var/nix/profiles/system " ^ tmpdir - ^ "/build" - >>= fun () -> - do_cmd @@ "sudo " ^ tmpdir ^ "/build/bin/switch-to-configuration switch" - >|= fun () -> Unix.unlink @@ tmpdir ^ "/build" - -let do_remote () = - meat_print "tbd"; - Ok () - -let trade () = - print_string header; - meat_print "TRADING FOREIGN MEATS.."; - do_remote () |> function - | Error _ -> print_string "FAILED TO TRADE MEATS." - | _ -> - (); - print_string footer - -let yum () = - print_string header; - meat_print "CONSUMING DELICIOUS MEATS.."; - ( do_build () |> function - | Error _ -> print_string "FAILED TO CONSUME MEATS." - | _ -> () ); - print_string footer - -let cook () = - print_string header; - meat_print "PREPARING DELICIOUS MEATS.."; - let build_target = - Unix.getenv "MEATS" ^ "#nixosConfigurations." ^ Unix.gethostname () - ^ ".config.system.build.toplevel" - in - do_cmd @@ "nix build --no-link" ^ build_target |> ignore; - print_string footer - -let poke () = - print_string header; - meat_print "PREPARING SUSPICIOUS MEATS.."; - let build_target = - Unix.getenv "MEATS" ^ "#nixosConfigurations." ^ Unix.gethostname () - ^ ".config.system.build.toplevel" - in - do_cmd @@ "nix build --no-link " ^ build_target ^ " --show-trace" |> ignore; - print_string footer - -let gut () = - print_string header; - meat_print "CLEANING MEAT STORES.."; - do_cmd "nh clean all" |> ignore; - print_string footer - -(* TODO pending fuiska lib.. *) -(* let look () = *) -(* print_string header; *) -(* meat_print "INSPECTING MEAT.."; *) -(* meat_print "CONSUMING MEATS:"; *) -(* let meats = Unix.getenv "MEATS" in *) -(* do_cmd @@ "nix flake metadata" ^ meats |> ignore; *) -(* meat_print "PRODUCING MEATS:"; *) -(* do_cmd "nix flake show $MEATS"; *) -(* print_string footer; *) - -(* let all_flag () = Array.mem "-a" argv || Array.mem "--all" argv -let sub_flag () = Array.mem "-s" argv || Array.mem "--subflake" argv *) -let all_flag () = - if Array.length argv >= 3 then - match Array.get argv 2 with "-a" | "--all" -> true | _ -> false - else false - -let sub_flag () = - if Array.length argv >= 3 then - match Array.get argv 2 with "-s" | "--sub" -> true | _ -> false - else false - -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 = 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 all_caps s = s |> String.map (fun c -> Char.uppercase_ascii c) -let all_low s = s |> String.map (fun c -> Char.lowercase_ascii c) -let fmt_dir d = String.split_on_char '/' d |> List.rev |> List.hd |> all_caps - -let submeats s = - s - |> List.iter (fun d -> - meat_print ("PROCESSING SUBMEAT " ^ fmt_dir d ^ ".."); - do_cmd ~args:false @@ "nix flake update --flake " ^ d |> ignore) - -let fresh () = - print_string header; - meat_print "HUNTING FRESH MEATS.."; - let argv_len = Array.length argv in - let root = Sys.getenv "MEATS" in - let base_dir = root ^ "/flakes" in - (match (sub_flag (), all_flag ()) with - | false, false -> - (* no flags, plain flake inputs *) - if argv_len >= 3 then - let open Array in - let flakes = sub argv 2 (argv_len - 2) in - flakes - |> iter (fun f -> - if all_low f = "meat" then meat_print "PROCESSING REAL MEAT.." - else meat_print ("PROCESSING FRESH MEAT " ^ all_caps f ^ ".."); - do_cmd ~args:false @@ "nix flake update " ^ f ^ " --flake " - ^ root - |> ignore) - else do_cmd @@ "nix flake update --flake " ^ root |> ignore - | _, true -> - (* all flag, update all subflakes and main flake inputs *) - walk base_dir |> List.sort compdepth |> List.rev |> submeats; - print_string footer; - meat_print "PROCESSING FRESH MEATS.."; - do_cmd ~args:false @@ "nix flake update --flake " ^ root |> ignore - | true, _ when argv_len >= 4 -> - (* sub flag, update inputs as subflakes *) - let subflakes = - match argv_len with - | 4 -> [ argv.(3) ] - | _ -> Array.sub argv 4 (argv_len - 4) |> Array.to_list - in - let open List in - let sf_full = subflakes |> derelativise base_dir in - sf_full |> map walk |> flatten |> sort compdepth |> rev |> append sf_full - |> submeats; - print_string footer; - meat_print "PROCESSING FRESH MEATS.."; - subflakes - |> iter (fun f -> - do_cmd ~args:false @@ "nix flake update " ^ all_low f - ^ " --flake $MEATS" - |> ignore) - | _ -> print_string help); - print_string footer; - print_newline () - -let help () = print_string (header ^ help ^ footer ^ "\n") +let yum = Commands.Yum.run +let cook = Commands.Cook.run +let poke = Commands.Poke.run +let gut = Commands.Gut.run +let trade = Commands.Trade.run +let look = Commands.Look.run +let fresh = Commands.Fresh.run +let hunt = Commands.Hunt.run +let help = Commands.Help.run +let meat_print = Common.meat_print