luciano/pods
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Pod resolver. See borkdude/babashka#690

Browse source
This commit is contained in:
Michiel Borkent 2020-12-27 13:55:50 +01:00 committed by GitHub
parent 9d363c7d3c
commit 22f200ef30
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 223 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
deps.edn
View file

@ -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

2
src/babashka/pods.clj
View file

@ -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

26
src/babashka/pods/impl.clj
View file

@ -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?

187
src/babashka/pods/impl/resolver.clj Normal file
View file

@ -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)})))

6
src/babashka/pods/jvm.clj
View file

@ -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]

6
src/babashka/pods/sci.clj
View file

@ -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