From 22f200ef3006da90971e3bafa794985918b65fea Mon Sep 17 00:00:00 2001 From: Michiel Borkent Date: Sun, 27 Dec 2020 13:55:50 +0100 Subject: [PATCH] Pod resolver. See borkdude/babashka#690 --- deps.edn | 2 +- src/babashka/pods.clj | 2 + src/babashka/pods/impl.clj | 26 +++- src/babashka/pods/impl/resolver.clj | 187 ++++++++++++++++++++++++++++ src/babashka/pods/jvm.clj | 6 +- src/babashka/pods/sci.clj | 6 +- 6 files changed, 223 insertions(+), 6 deletions(-) create mode 100644 src/babashka/pods/impl/resolver.clj diff --git a/deps.edn b/deps.edn index aab6415..ec186b0 100644 --- a/deps.edn +++ b/deps.edn @@ -5,7 +5,7 @@ {:sci {:extra-deps {borkdude/sci {:git/url "https://github.com/borkdude/sci" - :sha "a7f8d05f08ab150621c2403dacdd57c47ea09ff4"}}} + :sha "5aa9031eb3692a2207106076088fcab7347c2299"}}} :test {:extra-deps {cognitect/test-runner diff --git a/src/babashka/pods.clj b/src/babashka/pods.clj index 964a6c9..82b35e8 100644 --- a/src/babashka/pods.clj +++ b/src/babashka/pods.clj @@ -3,6 +3,8 @@ (defn load-pod ([pod-spec] (load-pod pod-spec nil)) + ([pod-spec version opts] + (load-pod pod-spec (assoc opts :version version))) ([pod-spec opts] (jvm/load-pod pod-spec opts))) (defn unload-pod diff --git a/src/babashka/pods/impl.clj b/src/babashka/pods/impl.clj index 5fd777d..56c06f5 100644 --- a/src/babashka/pods/impl.clj +++ b/src/babashka/pods/impl.clj @@ -1,7 +1,8 @@ (ns babashka.pods.impl {:no-doc true} (:refer-clojure :exclude [read]) - (:require [bencode.core :as bencode] + (:require [babashka.pods.impl.resolver :as resolver] + [bencode.core :as bencode] [cheshire.core :as cheshire] [clojure.edn :as edn] [clojure.java.io :as io] @@ -267,10 +268,29 @@ (binding [*out* *err*] (println (str/join " " (map pr-str strs))))) +;; TODO: symbol -> look up pod in local cache, invoke if present, else +;; download via package. +;; What about versions? +;; bb can package definitions of popular pods in its resources +;; but what if the resources have an error - maybe best to fetch the definitions from github +;; (load-pod 'org.babashka/postgresql) +;; (load-pod 'org.babashka/postgresql_0.0.1) + (defn load-pod ([pod-spec] (load-pod pod-spec nil)) - ([pod-spec {:keys [:remove-ns :resolve :transport]}] - (let [pod-spec (if (string? pod-spec) [pod-spec] pod-spec) + ([pod-spec opts] + (let [{:keys [:version :force]} opts + resolved (when (qualified-symbol? pod-spec) + (resolver/resolve pod-spec version force)) + opts (if resolved + (if-let [extra-opts (:options resolved)] + (merge opts extra-opts) + opts) + opts) + {:keys [:remove-ns :resolve :transport]} opts + pod-spec (cond resolved [(:executable resolved)] + (string? pod-spec) [pod-spec] + :else pod-spec) pb (ProcessBuilder. ^java.util.List pod-spec) socket? (identical? :socket transport) _ (if socket? diff --git a/src/babashka/pods/impl/resolver.clj b/src/babashka/pods/impl/resolver.clj new file mode 100644 index 0000000..342344c --- /dev/null +++ b/src/babashka/pods/impl/resolver.clj @@ -0,0 +1,187 @@ +(ns babashka.pods.impl.resolver + {:no-doc true} + (:refer-clojure :exclude [resolve]) + (:require [clojure.edn :as edn] + [clojure.java.io :as io] + [clojure.java.shell :refer [sh]] + [clojure.string :as str]) + (:import [java.net URL HttpURLConnection] + [java.nio.file Files])) + +(set! *warn-on-reflection* true) + +(defn normalize-arch [arch] + (if (= "amd64" arch) + "x86_64" + arch)) + +(def os {:os/name (System/getProperty "os.name") + :os/arch (let [arch (System/getProperty "os.arch")] + (normalize-arch arch))}) + +(defn warn [& strs] + (binding [*out* *err*] + (apply println strs))) + +(defn match-artifacts [package] + (let [artifacts (:pod/artifacts package)] + (filter (fn [{os-name :os/name + os-arch :os/arch}] + (let [os-arch (normalize-arch os-arch)] + (and (re-matches (re-pattern os-name) (:os/name os)) + (re-matches (re-pattern os-arch) + (:os/arch os))))) + artifacts))) + +(defn unzip [{:keys [^java.io.File zip-file + ^java.io.File destination-dir + verbose]}] + (when verbose (warn "Unzipping" (.getPath zip-file) "to" (.getPath destination-dir))) + (let [output-path (.toPath destination-dir) + zip-file (io/file zip-file) + _ (.mkdirs (io/file destination-dir))] + (with-open + [fis (Files/newInputStream (.toPath zip-file) (into-array java.nio.file.OpenOption [])) + zis (java.util.zip.ZipInputStream. fis)] + (loop [] + (let [entry (.getNextEntry zis)] + (when entry + (let [entry-name (.getName entry) + new-path (.resolve output-path entry-name)] + (if (.isDirectory entry) + (Files/createDirectories new-path (into-array [])) + (Files/copy ^java.io.InputStream zis + new-path + ^"[Ljava.nio.file.CopyOption;" + (into-array + [java.nio.file.StandardCopyOption/REPLACE_EXISTING])))) + (recur))))))) + +(defn un-tgz [^java.io.File zip-file ^java.io.File destination-dir verbose?] + (when verbose? (warn "Unzipping" (.getPath zip-file) "to" (.getPath destination-dir))) + (let [tmp-file (java.io.File/createTempFile "glam" ".tar") + output-path (.toPath tmp-file)] + (with-open + [fis (Files/newInputStream (.toPath zip-file) (into-array java.nio.file.OpenOption [])) + zis (java.util.zip.GZIPInputStream. fis)] + (Files/copy ^java.io.InputStream zis + output-path + ^"[Ljava.nio.file.CopyOption;" + (into-array + [java.nio.file.StandardCopyOption/REPLACE_EXISTING]))) + (sh "tar" "xf" (.getPath tmp-file) "--directory" (.getPath destination-dir)) + (.delete tmp-file))) + +(defn make-executable [dest-dir executables verbose?] + (doseq [e executables] + (let [f (io/file dest-dir e)] + (when verbose? (warn "Making" (.getPath f) "executable.")) + (.setExecutable f true)))) + +(defn download [source ^java.io.File dest verbose?] + (when verbose? (warn "Downloading" source "to" (.getPath dest))) + (let [source (URL. source) + dest (io/file dest) + conn ^HttpURLConnection (.openConnection ^URL source)] + (.setInstanceFollowRedirects conn true) + (.connect conn) + (io/make-parents dest) + (with-open [is (.getInputStream conn)] + (io/copy is dest)))) + +(def pod-manifests-dir + ;; wrapped in delay for GraalVM native-image + (delay (io/file (or (System/getenv "XDG_DATA_HOME") + (System/getProperty "user.home")) + ".babashka" "pods" "repository"))) + +(defn github-url [qsym version] + (format + "https://raw.githubusercontent.com/babashka/pod-registry/master/manifests/%s/%s/manifest.edn" + qsym version)) + +(defn pod-manifest + [qsym version force?] + (let [f (io/file @pod-manifests-dir (str qsym) (str version) "manifest.edn")] + (if (and (not force?) + (.exists f)) + (edn/read-string (slurp f)) + (do (download (github-url qsym version) f false) + (edn/read-string (slurp f)))))) + +(defn cache-dir + ^java.io.File + [{pod-name :pod/name + pod-version :pod/version}] + (io/file (or + (System/getenv "XDG_CACHE_HOME") + (System/getProperty "user.home")) + ".babashka" + "pods" + "repository" + (str pod-name) + pod-version)) + +(defn data-dir + ^java.io.File + [{pod-name :pod/name + pod-version :pod/version}] + (io/file (or + (System/getenv "XDG_DATA_HOME") + (System/getProperty "user.home")) + ".babashka" + "pods" + "repository" + (str pod-name) + pod-version)) + +(defn sha256 [file] + (let [buf (byte-array 8192) + digest (java.security.MessageDigest/getInstance "SHA-256")] + (with-open [bis (io/input-stream (io/file file))] + (loop [] + (let [count (.read bis buf)] + (when (pos? count) + (.update digest buf 0 count) + (recur))))) + (-> (.encode (java.util.Base64/getEncoder) + (.digest digest)) + (String. "UTF-8")))) + +(defn resolve [qsym version force?] + (assert (string? version) "Version must be provided!") + (when-let [manifest (pod-manifest qsym version force?)] + (let [artifacts (match-artifacts manifest) + cdir (cache-dir manifest) + ddir (data-dir manifest) + execs (mapv (fn [artifact] + (let [url (:artifact/url artifact) + file-name (last (str/split url #"/")) + cache-file (io/file cdir file-name) + executable (io/file ddir (:artifact/executable artifact))] + (when (or force? (not (.exists executable))) + (warn (format "Downloading pod %s (%s)" qsym version)) + (download url cache-file false) + (when-let [expected-sha (:artifact/hash artifact)] + (let [sha (sha256 cache-file)] + (when-not (= (str/replace expected-sha #"^sha256:" "") + sha) + (throw (ex-info (str "Wrong SHA-256 for file" (str cache-file)) + {:sha sha + :expected-sha expected-sha}))))) + (let [filename (.getName cache-file)] + (cond (str/ends-with? filename ".zip") + (unzip {:zip-file cache-file + :destination-dir ddir + :verbose false}) + (or (str/ends-with? filename ".tgz") + (str/ends-with? filename ".tar.gz")) + (un-tgz cache-file ddir + false)) + (.delete cache-file)) + (make-executable ddir [(:artifact/executable artifact)] false) + (warn (format "Successfully installed pod %s (%s)" qsym version)) + (io/file ddir (:artifact/executable artifact))) + (io/file ddir (:artifact/executable artifact)))) artifacts)] + {:executable (.getAbsolutePath ^java.io.File (first execs)) + :options (:pod/options manifest)}))) diff --git a/src/babashka/pods/jvm.clj b/src/babashka/pods/jvm.clj index 289f71e..94aa545 100644 --- a/src/babashka/pods/jvm.clj +++ b/src/babashka/pods/jvm.clj @@ -33,8 +33,12 @@ (defn load-pod ([pod-spec] (load-pod pod-spec nil)) + ([pod-spec version opts] (load-pod pod-spec (assoc opts :version version))) ([pod-spec opts] - (let [pod (impl/load-pod + (let [opts (if (string? opts) + {:version opts} + opts) + pod (impl/load-pod pod-spec (merge {:remove-ns remove-ns :resolve (fn [sym] diff --git a/src/babashka/pods/sci.clj b/src/babashka/pods/sci.clj index 4a412de..2b3ae83 100644 --- a/src/babashka/pods/sci.clj +++ b/src/babashka/pods/sci.clj @@ -21,8 +21,12 @@ (defn load-pod ([ctx pod-spec] (load-pod ctx pod-spec nil)) + ([ctx pod-spec version opts] (load-pod ctx pod-spec (assoc opts :version version))) ([ctx pod-spec opts] - (let [env (:env ctx) + (let [opts (if (string? opts) + {:version opts} + opts) + env (:env ctx) pod (binding [*out* @sci/out *err* @sci/err] (impl/load-pod