devc

#!/usr/bin/env bb
(ns devc
  (:require [clojure.string :as str]
            [babashka.cli :as cli]
            [babashka.process :as p]
            [cheshire.core :as json]))


;; Set to true, when *not* in repl
(def real? (= *file* (System/getProperty "babashka.file")))


(defn exit [exit-code]
  (if real?
    (System/exit exit-code)
    (println (str "(System/exit " exit-code ")"))))


(def user   (System/getenv "USER"))
(def labels (str "app=devcontainer,user=" user))


(def default-opts {:context         (or (System/getenv "DEVC_CONTEXT")         (-> (p/shell {:out :string} "kubectl config view --minify -o jsonpath='{.contexts[0].name}'") :out))
                   :namespace       (or (System/getenv "DEVC_NAMESPACE")       (-> (p/shell {:out :string} "kubectl config view --minify -o jsonpath='{.contexts[0].context.namespace}'") :out))
                   :image           (or (System/getenv "DEVC_IMAGE")           "jarppe/clj-devcontainer:latest")
                   :pod             (or (System/getenv "DEVC_POD_NAME")        user)
                   :requests-memory (or (System/getenv "DEVC_REQUESTS_MEMORY") "1Gi")
                   :requests-cpu    (or (System/getenv "DEVC_REQUESTS_CPU")    "500m")
                   :limits-memory   (or (System/getenv "DEVC_LIMITS_MEMORY")   "4Gi")
                   :limits-cpu      (or (System/getenv "DEVC_LIMITS_CPU")      "4000m")
                   :volumes         (System/getenv "DEVC_VOLUMES")})


(def cli-spec
  {:spec     {:help            {:desc  "Show usage"
                                :alias :h}
              :context         {:desc    "Kube context (default from kubectl config)"
                                :alias   :ctx
                                :default (:context default-opts)}
              :namespace       {:desc    "Kube namespace (default from kubectl config)"
                                :alias   :ns
                                :default (:namespace default-opts)}
              :pod             {:desc    "Devcontainer pod name ($DEVC_POD_NAME or current user name)"
                                :alias   :pod
                                :default (:pod default-opts)}
              :image           {:desc    "Devcontainer image ($DEVC_IMAGE or \"jarppe/clj-devcontainer:latest\")"
                                :alias   :i
                                :default (:image default-opts)}
              :volumes         {:desc    "Comma separated list of volumes to mount on devcontainer, i.e. pvc:some-pvc-name:/mnt/data"
                                :alias   :v
                                :default (:volumes default-opts)}
              :requests-memory {:desc    "Pod memory request"
                                :default (:requests-memory default-opts)}
              :requests-cpu    {:desc    "Pod CPU request"
                                :default (:requests-cpu default-opts)}
              :limits-memory   {:desc    "Pod memory limit"
                                :default (:limits-memory default-opts)}
              :limits-cpu      {:desc    "Pod CPU limit"
                                :default (:limits-cpu default-opts)}}
   :error-fn (fn [_]
               (println "error: invalid command")
               (println "try: devc --help")
               (exit 1))})


(defn help [{spec :spec}]
  (println "usage: devc <command> <pod-name> <args>")
  (println "command:")
  (println "  up      Start devcontainer")
  (println "  down    Stop devcontainer")
  (println "  ps      List devcontainers")
  (println "  sh      Open shell in devcontainer pod")
  (println "pod-name:")
  (println "  Name of the devcontainer pod, defaults to" (pr-str user))
  (println "args:")
  (println (cli/format-opts spec)))


(defn kubectl [command args]
  (-> (apply p/process
             {:in  :inherit
              :out :inherit
              :err :inherit}
             "kubectl" command
             (mapcat (fn [arg]
                       (cond
                         (sequential? arg) arg
                         (some? arg) [arg]
                         :else []))
                     args))
      (deref)
      :exit
      (exit)))


(defn volume-info [{:keys [volumes]}]
  (when volumes
    (map (fn [v]
           (zipmap [:type :name :mount :opts]
                   (str/split v #":")))
         (str/split volumes #","))))


(defn up [{:keys [opts]}]
  (let [volumes   (volume-info opts)
        overrides {:apiVersion "v1"
                   :spec       {:containers [{:name         (:pod opts)
                                              :image        (:image opts)
                                              :command      ["sleep" "infinity"]
                                              :resources    {:requests {:cpu    (:requests-cpu opts)
                                                                        :memory (:requests-memory opts)}
                                                             :limits   {:cpu    (:limits-cpu opts)
                                                                        :memory (:limits-memory opts)}}
                                              :env          [{:name  "CONTEXT"
                                                              :value (:context opts)}
                                                             {:name  "NAMESPACE"
                                                              :value (:namespace opts)}
                                                             {:name  "POD_NAME"
                                                              :value (:pod opts)}]
                                              :volumeMounts (map (fn [volume]
                                                                   {:name      (:name volume)
                                                                    :mountPath (:mount volume)
                                                                    :readOnly  (case (:opts volume)
                                                                                 ("ro" nil) true
                                                                                 "rw" false
                                                                                 (do (println "unknown volume option:" (pr-str (:opts volume)))
                                                                                     (exit 1)))})
                                                                 volumes)}]
                                :volumes    (map (fn [volume]
                                                   (case (:type volume)
                                                     "pvc" {:name                  (:name volume)
                                                            :persistentVolumeClaim {:claimName (:name volume)}}
                                                     (do (println "unknown volume type:" (pr-str (:type volume)))
                                                         (exit 1))))
                                                 volumes)}}]
    (kubectl "run" [(:pod opts)
                    (str "--context="   (:context opts))
                    (str "--namespace=" (:namespace opts))
                    (str "--labels="    labels)
                    (str "--image="     (:image opts))
                    (str "--overrides=" (json/generate-string overrides))
                    "--restart=Never"])))


(defn down [{:keys [opts args]}]
  (kubectl "delete" ["pod"
                     (or (first args)
                         (str "--selector=" labels))
                     (str "--context="   (:context opts))
                     (str "--namespace=" (:namespace opts))]))


(defn ps [{:keys [opts args]}]
  (kubectl "get" ["pod"
                  (or (first args)
                      (str "--selector=" labels))
                  (str "--context="   (:context opts))
                  (str "--namespace=" (:namespace opts))]))


(defn sh [{:keys [opts args]}]
  (kubectl "exec" [(:pod opts)
                   (str "--context="   (:context opts))
                   (str "--namespace=" (:namespace opts))
                   (str "--container=" (:pod opts))
                   "--stdin"
                   (when-not args "--tty")
                   "--"
                   (or args ["zsh" "-l"])]))


(def table
  [{:cmds ["up"]
    :fn   (fn [m] (assoc m :fn up))}
   {:cmds ["down"]
    :fn   (fn [m] (assoc m :fn down))}
   {:cmds ["ps"]
    :fn   (fn [m] (assoc m :fn ps))}
   {:cmds ["sh"]
    :fn   (fn [m] (assoc m :fn sh))}
   {:cmds []
    :fn   (fn [m] (assoc m :fn help))}])


(defn main [args]
  (let [opts (-> (cli/dispatch table args cli-spec)
                 (assoc :spec cli-spec)
                 (update :opts (partial merge-with (fn [a _] a)) default-opts))]
    (when (#{:h :help} opts)
      (help opts)
      (exit 0))
    (let [command (:fn opts)]
      (command opts))))


(when real?
  (main *command-line-args*))


(comment
  (up {})
  (ps {:opts {:all true}})
  (ps {})
  (down {})
  ;
  )