Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
(ns deployer
(:require [ :as deps]
[ :as reader]
[ :as io]
[clojure.string :as string])
(:import ( MessageDigest)
(com.jcraft.jsch JSch)
( URI)))
(def hex-alphabet (vec "0123456789ABCDEF"))
(defn hex [bytes]
(let [chars (char-array (* 2 (count bytes)))]
(dotimes [i (count bytes)]
(let [v (bit-and (nth bytes i) 0xFF)]
(aset chars (* 2 i) (nth hex-alphabet (unsigned-bit-shift-right v 4)))
(aset chars (inc (* 2 i)) (nth hex-alphabet (bit-and v 0x0F)))))
(String. chars)))
(defn hash-dir [dir]
(let [md (MessageDigest/getInstance "SHA-256")
c (count (.getAbsolutePath dir))
buf (byte-array 1024)]
(doseq [f (file-seq dir)
:when (not (.isDirectory f))
:let [n (subs (.getAbsolutePath f) c)]]
(.update md (.getBytes n))
(with-open [in (io/input-stream f)]
(loop []
(let [i (.read in buf)]
(when-not (neg? i)
(.update md buf 0 i)
(hex (.digest md))))
(defprotocol Target
(exists? [_ path-segments])
(mkdirs [_ path-segments])
(write [_ data path-segments])
(-resolve [_ path-segments]))
(extend-protocol Target
(exists? [this path-segments]
(.exists (apply io/file this path-segments)))
(mkdirs [this path-segments]
(.mkdirs (apply io/file this path-segments)))
(write [this data path-segments]
(io/copy data (io/output-stream (apply io/file this path-segments))))
(-resolve [this path-segments]
(.getAbsolutePath (apply io/file this path-segments))))
(defn f [target n]
(let [deps-map (reader/read-deps
(:config-files (reader/clojure-env)))
paths (reduce
(fn [accum [v p]]
(if (.exists (io/file p))
(if-not (.isDirectory (io/file p))
(when-not (exists? target ["files"])
(mkdirs target ["files"]))
(let [f (io/file p)
n (.getName f)]
(when-not (exists? target ["files" n])
(write target f ["files" n]))
(conj accum (-resolve target ["files" n]))))
(when-not (exists? target ["paths"])
(mkdirs target ["paths"]))
(let [f (io/file p)
n (hash-dir f)
c (inc (count (.getAbsolutePath f)))]
(when-not (exists? target ["paths" n])
(mkdirs target ["paths" n])
(doseq [file (file-seq f)
:when (not (.isDirectory file))
:let [s (subs (.getAbsolutePath file) c)]]
(mkdirs target (list* "paths" n (butlast (.split s "/"))))
(write target file (list* "paths" n (.split s "/")))))
(conj accum (-resolve target ["paths" n])))))
(for [p (:paths deps-map)] [nil p])
(for [[_ v] (deps/resolve-deps
p (:paths v)]
[v p])))]
(write target (.getBytes (string/join ":" paths)) [n])))
(defn sftp-target [uri]
(let [f (subs (.getPath uri) 1)
host (.getHost uri)
[user pass] (.split (.getUserInfo uri) ":")
jsch (JSch.)
session (.getSession jsch user host 22)
_ (doto jsch
(.setKnownHosts "/home/kevin/.ssh/known_hosts")
(.addIdentity "/home/kevin/.ssh/id_rsa"))
_ (.setConfig session
(doto (java.util.Properties.)
(.put "StrictHostKeyChecking" "no")))
_ (.connect session)
channel (.openChannel session "sftp")
_ (.connect channel)
pwd (.pwd channel)]
(exists? [_ path-segments]
(.stat channel (string/join "/" (cons f path-segments)))
(catch Throwable _))))
(mkdirs [this path-segments]
(fn [accum elem]
(when-not (boolean
(.stat channel (string/join "/" (conj accum elem)))
(catch Throwable _)))
(.mkdir channel (string/join "/" (conj accum elem))))
(conj accum elem))
(cons f path-segments)))
(write [_ data path-segments]
(with-open [in (io/input-stream data)]
(.put channel in (string/join "/" (cons f path-segments)))))
(-resolve [_ path-segments]
(string/join "/" (concat [pwd f] path-segments)))
(close [_]
(.disconnect session)))))
(defn -main [uri & args]
(with-open [s (sftp-target (URI. uri))]
(f s "cp"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.