Docker admin

docker.clj

(ns hendekagon.docker
  "
    Docker admin
    adapted from
    https://github.com/lispyclouds/contajners/blob/main/doc/002-general-guidelines.md

  "
  (:require
    [clojure.string :as string]
    [clojure.java.io :as io]
    [clojure.pprint :as pprint]
    [cheshire.core :as json]
    [contajners.core :as c]
    [me.raynes.conch :refer [programs] :as sh])
  (:import [java.io File]))

(programs tar xattr)

(def docker-instructions
 '#{comment add arg cmd copy entrypoint env expose from healthcheck label maintainer onbuild run shell stopsignal user volume workdir})

(def clients
  (into {}
    (map
      (fn [category]
        [category (c/client
                    {:engine :docker
                     :category category
                     :version "v1.44"
                     :conn {:uri "unix:///var/run/docker.sock"}})])
       [:build :images :containers])))

(defn normalize-instructions [instructions]
  (->> instructions
    (partition-by first)
    (map
      (fn [is]
        (let [inst (string/upper-case (ffirst is)) args (map rest is)]
          (if (== 1 (count args)) (cons inst (first args)) (list inst args)))))))

(defn arg->str [arg]
  (cond
    (or (symbol? arg) (keyword? arg)) (name arg)
    (vector? arg) (json/generate-string (map (fn [x] (if (keyword? x) (name x) x)) arg))
    :else (str arg)))

(defn clj->dockerfile
  "Make a docker file from these instructions"
  [instructions]
  (map
    (fn [[instruction & args]]
      (str (if (= instruction "COMMENT") "#" instruction) " "
        (if (seq? (first args))
          (string/join
            (str (if ('#{"RUN"} instruction) " && \\\n" " \\\n") (string/join "" (repeat (inc (count instruction)) \space)))
            (map (fn [arg] (string/join (if ('#{"ENV"} instruction) "" " ") (map arg->str arg))) (first args)))
          (string/join " " (map arg->str args)))
        \newline))
    (normalize-instructions instructions)))

(defn instructions->dockerfile [lines]
  (->> lines
    (partition-by (fn [x] (or (docker-instructions (symbol (string/lower-case x))) (list? x))))
    (partition 2)
    (mapcat (fn [[[instruction] & args]] (map (partial cons instruction) args)))
    clj->dockerfile))

(defn write-dockerfile! [path strings]
  (with-open [out (io/writer (str path "Dockerfile"))]
    (doseq [line strings]
      (.write out line))))

(defn ->tar! [path filenames]
  (apply tar "-czvf" "docker.tar.gz" (concat (cons "Dockerfile" filenames) [{:dir path :out *out* :err *err*}])))

(defn build-cmd! [path image-name]
  (with-open
    [in (io/input-stream (str path "docker.tar.gz"))]
      (c/invoke (:build clients)
         {:op :ImageBuild
          :params {:t image-name}
          :data in
          :as :stream})))

(defn show-build-output!
  [input-stream]
  (let [stream-data (json/parsed-seq (io/reader input-stream))]
    (loop [data stream-data]
      (when-let [line (first data)]
      (if-let [s (get line "stream")]
        (do
          (print s)
          (flush))
        (pprint/pprint line))
      (recur (rest data))))))

(defn build! [{:keys [options path image-name]}]
  (let [docker-output-stream (build-cmd! path (string/lower-case image-name))]
    (when (options :verbose?)
      (show-build-output! docker-output-stream))))

(def files-and-dirs
  (comp
    (mapcat
     (fn [path]
       (tree-seq File/isDirectory ^{:param-tags []} File/listFiles (File. path))))
    (filter File/isFile)
    (filter File/exists)
    (map File/getAbsolutePath)))

(defn remove-files [remove-regexs]
  (remove (fn [n] (string/ends-with? n ".DS_Store"))))

(defn replace-paths [{:keys [from-path to-path]}]
  (map (fn [f] (string/replace f from-path to-path))))

(defn make-image!
  [{:keys [path filenames clj-instructions instructions instruction-strings options] :or {options #{:prune}} :as params}]
  (do
    (when (or clj-instructions instructions instruction-strings)
      (write-dockerfile! path
        (cond
          instructions (instructions->dockerfile instructions)
          clj-instructions (clj->dockerfile clj-instructions)
          :else instruction-strings)))
    (->tar! path (sequence (comp files-and-dirs (remove-files params)) filenames))
    (build! params)
    (when (options :prune)
      (c/invoke (:images clients)
        {:op :ImagePrune
         :params {:force true}}))))

(defn docker-run!
  ([image-name cmd]
    (docker-run! {:image-name image-name :cmd cmd}))
  ([{:keys [options images-client containers-client image-name container-name cmd]
     :or {options '#{:prune} container-name (str (string/replace image-name #"/|:" "-") "-" (System/currentTimeMillis))
          images-client (:images clients) containers-client (:containers clients)}}]
   (when (options :prune)
     (c/invoke images-client
       {:op :ImagePrune
        :params {:force true}}))
   (c/invoke containers-client
     {:op :ContainerCreate
      :params {:name container-name}
      :data {:Image image-name
             :Cmd cmd
             :Tty true
             }})
   (let [start (c/invoke containers-client
                 {:op :ContainerStart
                  :params {:id container-name}})
         log (c/invoke containers-client
               {:op :ContainerLogs
                :params {:id container-name :follow true :stdout true :stderr true}})]
     (c/invoke containers-client
       {:op :ContainerStop
        :params {:id container-name}})
     (c/invoke containers-client
       {:op :ContainerDelete
        :params {:id container-name}})
     {:start start :log log})))

(require '[clojure.tools.build.api :as b])

(make-image!
    {:options #{:verbose?} :path "./" :image-name "al2-test2"
     :filenames
      (keys (:classpath (b/create-basis)))
     :instructions
     '(from "public.ecr.aws/amazonlinux/amazonlinux:2.0.20240610.1-arm64v8")})