From e598b04caea500642e4cedaf577798ee4bf16f05 Mon Sep 17 00:00:00 2001 From: atagen Date: Sat, 23 Nov 2024 16:49:05 +1100 Subject: [PATCH] ocaml --- .envrc | 1 + .gitea/workflows/nix.yaml | 11 ++ .gitignore | 5 + README.md | 1 + bin/.ocamlformat | 0 bin/dune | 4 + bin/main.ml | 21 ++++ dune-project | 26 +++++ flake.lock | 110 ++++++++++++++++++ flake.nix | 99 ++++++++++++++++ lib/.ocamlformat | 0 lib/commands/cook.ml | 9 ++ lib/commands/fresh.ml | 17 +++ lib/commands/gut.ml | 5 + lib/commands/help.ml | 1 + lib/commands/hunt.ml | 61 ++++++++++ lib/commands/look.ml | 114 +++++++++++++++++++ lib/commands/poke.ml | 9 ++ lib/commands/ritual.ml | 39 +++++++ lib/commands/trade.ml | 8 ++ lib/commands/yum.ml | 7 ++ lib/common.ml | 61 ++++++++++ lib/dune | 4 + lib/http.ml | 232 ++++++++++++++++++++++++++++++++++++++ lib/json.ml | 8 ++ lib/meat.ml | 11 ++ meat.opam | 31 +++++ nix/default.nix | 17 +++ nix/module.nix | 32 ++++++ test/dune | 2 + test/test_meat.ml | 0 31 files changed, 946 insertions(+) create mode 100644 .envrc create mode 100644 .gitea/workflows/nix.yaml create mode 100644 .gitignore create mode 100644 README.md create mode 100644 bin/.ocamlformat create mode 100644 bin/dune create mode 100644 bin/main.ml create mode 100644 dune-project create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 lib/.ocamlformat create mode 100644 lib/commands/cook.ml create mode 100644 lib/commands/fresh.ml create mode 100644 lib/commands/gut.ml create mode 100644 lib/commands/help.ml create mode 100644 lib/commands/hunt.ml create mode 100644 lib/commands/look.ml create mode 100644 lib/commands/poke.ml create mode 100644 lib/commands/ritual.ml create mode 100644 lib/commands/trade.ml create mode 100644 lib/commands/yum.ml create mode 100644 lib/common.ml create mode 100644 lib/dune create mode 100644 lib/http.ml create mode 100644 lib/json.ml create mode 100644 lib/meat.ml create mode 100644 meat.opam create mode 100644 nix/default.nix create mode 100644 nix/module.nix create mode 100644 test/dune create mode 100644 test/test_meat.ml diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..3550a30 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use flake diff --git a/.gitea/workflows/nix.yaml b/.gitea/workflows/nix.yaml new file mode 100644 index 0000000..d5443ef --- /dev/null +++ b/.gitea/workflows/nix.yaml @@ -0,0 +1,11 @@ +name: Nix Build +on: [push] + +jobs: + all-in-one: + runs-on: [native] + name: nix build + steps: + - uses: actions/checkout@v4 + - run: nix build --no-link . + diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9a62042 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +_build +.direnv/ +result +justfile +todo diff --git a/README.md b/README.md new file mode 100644 index 0000000..a13e7e8 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +this is chopped dont look at it diff --git a/bin/.ocamlformat b/bin/.ocamlformat new file mode 100644 index 0000000..e69de29 diff --git a/bin/dune b/bin/dune new file mode 100644 index 0000000..b1f555a --- /dev/null +++ b/bin/dune @@ -0,0 +1,4 @@ +(executable + (public_name meat) + (name main) + (libraries meat)) diff --git a/bin/main.ml b/bin/main.ml new file mode 100644 index 0000000..11c0cca --- /dev/null +++ b/bin/main.ml @@ -0,0 +1,21 @@ +open Meat + +let () = + match Sys.getenv_opt "MEATS" with + | Some _ -> + if Array.length Sys.argv >= 2 then + match String.lowercase_ascii (Array.get Sys.argv 1) with + | "yum" -> yum () + | "cook" -> cook () + | "poke" -> poke () + | "gut" -> gut () + | "trade" -> trade () + | "look" -> look () + | "fresh" -> fresh () + | "hunt" -> hunt () + | "ritual" -> ritual () + | _ -> help () + else help () + | None -> + meat_print "NO PATH TO RUNESTONE FOUND!"; + help () diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..256991c --- /dev/null +++ b/dune-project @@ -0,0 +1,26 @@ +(lang dune 3.16) + +(name meat) + +(generate_opam_files true) + +(source + (github username/reponame)) + +(authors "Author Name ") + +(maintainers "Maintainer Name ") + +(license LICENSE) + +(documentation https://url/to/documentation) + +(package + (name meat) + (synopsis "A short synopsis") + (description "A longer description") + (depends ocaml dune) + (tags + ("add topics" "to describe" your project))) + +; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..843a72b --- /dev/null +++ b/flake.lock @@ -0,0 +1,110 @@ +{ + "nodes": { + "ndg": { + "inputs": { + "nixpkgs": "nixpkgs_2" + }, + "locked": { + "lastModified": 1773478949, + "narHash": "sha256-8rMpSs2OWGaDlDFO5FS6Pf9WutHBXxM2omPr6hfKydI=", + "owner": "feel-co", + "repo": "ndg", + "rev": "c3bc1541668e6f6632a7005c7e4963c0a5dedc7b", + "type": "github" + }, + "original": { + "owner": "feel-co", + "repo": "ndg", + "type": "github" + } + }, + "nix-systems": { + "locked": { + "lastModified": 1689347949, + "narHash": "sha256-12tWmuL2zgBgZkdoB6qXZsgJEH9LR3oUgpaQq2RbI80=", + "owner": "nix-systems", + "repo": "default-linux", + "rev": "31732fcf5e8fea42e59c2488ad31a0e651500f68", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default-linux", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1774078191, + "narHash": "sha256-nyxxxW1/2ouu9dU0I02ul5pHrmUrE1JVFhfFlmYe3Lw=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "09061f748ee21f68a089cd5d91ec1859cd93d0be", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1773282481, + "narHash": "sha256-oFe06TmOy8UUT1f7xMHqDpSYq2Fy1mkIsXZUvdnyfeY=", + "rev": "fe416aaedd397cacb33a610b33d60ff2b431b127", + "type": "tarball", + "url": "https://releases.nixos.org/nixos/unstable/nixos-26.05pre962285.fe416aaedd39/nixexprs.tar.xz?lastModified=1773282481&rev=fe416aaedd397cacb33a610b33d60ff2b431b127" + }, + "original": { + "type": "tarball", + "url": "https://channels.nixos.org/nixos-unstable/nixexprs.tar.xz" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1774078191, + "narHash": "sha256-nyxxxW1/2ouu9dU0I02ul5pHrmUrE1JVFhfFlmYe3Lw=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "09061f748ee21f68a089cd5d91ec1859cd93d0be", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "nix-systems": "nix-systems", + "nixpkgs": "nixpkgs", + "unf": "unf" + } + }, + "unf": { + "inputs": { + "ndg": "ndg", + "nixpkgs": "nixpkgs_3" + }, + "locked": { + "lastModified": 1760178630, + "narHash": "sha256-oxRMTQtzIO1yFRhY++Ss8+ea1cTH40bD/+FAE+m5NFk=", + "ref": "refs/heads/main", + "rev": "8a6aa536039f1b207888b1369c5cabf0b131e07b", + "revCount": 5, + "type": "git", + "url": "https://git.atagen.co/atagen/unf" + }, + "original": { + "type": "git", + "url": "https://git.atagen.co/atagen/unf" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..33d7c3a --- /dev/null +++ b/flake.nix @@ -0,0 +1,99 @@ +{ + inputs = { + nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable"; + nix-systems.url = "github:nix-systems/default-linux"; + unf.url = "git+https://git.atagen.co/atagen/unf"; + }; + + outputs = + inputs: + with inputs; + let + version = builtins.toString self.lastModified; + collectPkgs = builtins.attrValues; + forEachSystem = + function: + nixpkgs.lib.genAttrs (import nix-systems) ( + system: function nixpkgs.legacyPackages.${system} system + ); + deps = forEachSystem ( + pkgs: _: { + build = collectPkgs { + inherit (pkgs.ocamlPackages) + dune_3 + ocaml + yojson + ssl + ; + inherit (pkgs.openssl) dev; + }; + dev = collectPkgs { + inherit (pkgs.ocamlPackages) + utop + ocaml-lsp + ocamlformat + ocamlformat-rpc-lib + ; + }; + } + ); + in + { + devShells = forEachSystem ( + pkgs: sys: { + default = pkgs.mkShell { + packages = pkgs.lib.mapAttrsToList (_: v: v) deps.${sys}; + shellHook = + let + justFile = '' + default: + @just --list + + @build: + nix build .#debug --offline + + @release: + nix build --offline + + @test: + printf "\\n\\n\\t************ running nix+dune tests ************\\n\\n\\n" + nix flake check --offline + ''; + in + '' + printf '${justFile}' > justfile + ''; + }; + } + ); + + packages = forEachSystem ( + pkgs: sys: { + default = pkgs.callPackage ./nix/default.nix { + buildInputs = deps.${sys}.build; + inherit version; + }; + docs = pkgs.callPackage unf.lib.pak-chooie { + inherit self; + projectName = "meat"; + newPath = "https://git.atagen.co/atagen/meat/src"; + modules = [ + self.nixosModules.meat + ]; + }; + } + ); + + nixosModules.meat = + { + pkgs, + lib, + ... + }: + { + imports = [ ./nix/module.nix ]; + programs.meat.package = self.packages.${pkgs.stdenv.hostPlatform.system}.default; + }; + + }; +} diff --git a/lib/.ocamlformat b/lib/.ocamlformat new file mode 100644 index 0000000..e69de29 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/ritual.ml b/lib/commands/ritual.ml new file mode 100644 index 0000000..739995f --- /dev/null +++ b/lib/commands/ritual.ml @@ -0,0 +1,39 @@ +let run () = + print_string Common.header; + Common.meat_print "PREPARING RITUAL GROUND.."; + let ( >>= ) = Result.bind in + let ( >|= ) = Fun.flip Result.map in + let tmpdir = Filename.temp_dir "meat-chew" "" in + let meats = Unix.getenv "MEATS" in + let hostname = Unix.gethostname () in + let nix_conf_target = + meats ^ "/entry.nix -A nixosConfigurations." ^ hostname + ^ {|'.config.environment.etc."nix/nix.conf"'|} + in + let build_target = + meats ^ "/entry.nix -A nixosConfigurations." ^ hostname + ^ ".config.system.build.toplevel" + in + ( Common.do_cmd ~args:false + @@ "nix-build --log-format internal-json -v --out-link " ^ tmpdir + ^ "/nix.conf " ^ nix_conf_target ^ " |& nom --json" + >>= fun () -> + Common.meat_print "CONSUMING MEATS.."; + Common.do_cmd ~args:false + @@ "NIX_USER_CONF_FILES=" ^ tmpdir + ^ "/nix.conf nix-build --log-format internal-json -v --out-link " ^ tmpdir + ^ "/build " ^ build_target ^ " |& nom --json" + >>= fun () -> + Common.do_cmd ~args:false @@ "dix /nix/var/nix/profiles/system " ^ tmpdir + ^ "/build" + >>= fun () -> + Common.do_cmd ~args:false + @@ "sudo sh -c 'nix-env --set -p /nix/var/nix/profiles/system " ^ tmpdir + ^ "/build && " ^ tmpdir ^ "/build/bin/switch-to-configuration switch'" + >|= fun () -> + Unix.unlink @@ tmpdir ^ "/nix-conf"; + Unix.unlink @@ tmpdir ^ "/build" ) + |> ( function + | Error _ -> print_string "FAILED TO CONSUME MEATS." + | _ -> () ); + 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..ca7ead8 --- /dev/null +++ b/lib/common.ml @@ -0,0 +1,61 @@ +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 + RITUAL - PERFORM RITUAL THEN CONSUME + 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 sh -c '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 new file mode 100644 index 0000000..016c372 --- /dev/null +++ b/lib/dune @@ -0,0 +1,4 @@ +(include_subdirs qualified) +(library + (name meat) + (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 new file mode 100644 index 0000000..29a35d1 --- /dev/null +++ b/lib/meat.ml @@ -0,0 +1,11 @@ +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 ritual = Commands.Ritual.run +let help = Commands.Help.run +let meat_print = Common.meat_print diff --git a/meat.opam b/meat.opam new file mode 100644 index 0000000..f89d30f --- /dev/null +++ b/meat.opam @@ -0,0 +1,31 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "A short synopsis" +description: "A longer description" +maintainer: ["Maintainer Name "] +authors: ["Author Name "] +license: "LICENSE" +tags: ["add topics" "to describe" "your" "project"] +homepage: "https://github.com/username/reponame" +doc: "https://url/to/documentation" +bug-reports: "https://github.com/username/reponame/issues" +depends: [ + "ocaml" + "dune" {>= "3.16"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/username/reponame.git" diff --git a/nix/default.nix b/nix/default.nix new file mode 100644 index 0000000..a6004a4 --- /dev/null +++ b/nix/default.nix @@ -0,0 +1,17 @@ +{ + ocamlPackages, + buildInputs, + git, + version, + ... +}: +ocamlPackages.buildDunePackage { + pname = "meat"; + version = "0.1-delicious-${version}"; + + minimalOCamlVersion = "5.2"; + + src = ./..; + nativeBuildInputs = [ git ]; + buildInputs = buildInputs; +} diff --git a/nix/module.nix b/nix/module.nix new file mode 100644 index 0000000..a45e9ef --- /dev/null +++ b/nix/module.nix @@ -0,0 +1,32 @@ +{ + pkgs, + lib, + config, + ... +}: +let + inherit (lib) mkEnableOption mkOption types; + cfg = config.programs.meat; +in +{ + options.programs.meat = { + enable = mkEnableOption "meat"; + flake = mkOption { + type = with types; either path str; + description = "path to your system flake"; + }; + package = mkOption { + type = types.package; + description = "your ideal meat"; + }; + }; + config = lib.mkIf cfg.enable { + environment.sessionVariables.MEATS = cfg.flake; + environment.systemPackages = [ + cfg.package + pkgs.nh # for now.. + pkgs.nix-output-monitor + pkgs.dix + ]; + }; +} diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..249a645 --- /dev/null +++ b/test/dune @@ -0,0 +1,2 @@ +(test + (name test_meat)) diff --git a/test/test_meat.ml b/test/test_meat.ml new file mode 100644 index 0000000..e69de29