From 00d2b69b46e0604c14af3ca78dfa12bf715c7fc3 Mon Sep 17 00:00:00 2001 From: Adam Mohammed Date: Sat, 8 Apr 2023 20:41:50 -0400 Subject: [PATCH] init --- .gitignore | 9 +++ README.org | 12 ++++ k8splayground.asd | 21 ++++++ src/main.lisp | 116 ++++++++++++++++++++++++++++++++++ src/tutorial0/deployment.yaml | 41 ++++++++++++ tests/main.lisp | 12 ++++ 6 files changed, 211 insertions(+) create mode 100644 .gitignore create mode 100644 README.org create mode 100644 k8splayground.asd create mode 100644 src/main.lisp create mode 100644 src/tutorial0/deployment.yaml create mode 100644 tests/main.lisp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b9fa3c1 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +*.abcl +*.fasl +*.dx32fsl +*.dx64fsl +*.lx32fsl +*.lx64fsl +*.x86f +*~ +.#* diff --git a/README.org b/README.org new file mode 100644 index 0000000..1fd7514 --- /dev/null +++ b/README.org @@ -0,0 +1,12 @@ +* K8splayground + +Playing around with using CLOG to set up kind clusters for teaching +different techniques for canarying. + +** Author + ++ Adam Mohammed (adam@fixergrid.net) + +** Copyright + +Copyright (c) 2023 Adam Mohammed (adam@fixergrid.net) diff --git a/k8splayground.asd b/k8splayground.asd new file mode 100644 index 0000000..adbe826 --- /dev/null +++ b/k8splayground.asd @@ -0,0 +1,21 @@ +(defsystem "k8splayground" + :version "0.1.0" + :author "Adam Mohammed" + :license "" + :depends-on ("yason") + :components ((:module "src" + :components + ((:file "main")))) + :description "" + :in-order-to ((test-op (test-op "k8splayground/tests")))) + +(defsystem "k8splayground/tests" + :author "Adam Mohammed" + :license "" + :depends-on ("k8splayground" + "rove") + :components ((:module "tests" + :components + ((:file "main")))) + :description "Test system for k8splayground" + :perform (test-op (op c) (symbol-call :rove :run c))) diff --git a/src/main.lisp b/src/main.lisp new file mode 100644 index 0000000..7011468 --- /dev/null +++ b/src/main.lisp @@ -0,0 +1,116 @@ +(defpackage k8splayground + (:use :cl) + (:export :create-kube-cluster) + (:import-from #:yason + #:parse) + (:import-from #:uiop + #:run-program)) + + +(in-package :k8splayground) + +(defclass demo-cluster () + ((name :accessor cluster-name + :documentation "name of the k8s cluster.") + (deployments :accessor k8s-deployments + :initform '() + :documentation "currently active deployments") + (services :accessor k8s-services + :initform '() + :documentation "currently active services"))) + +(defun kind-executable () + "Determine the location of the `kind` executable" + "/home/adammo/go/bin/kind") + +(defun kubectl-executable () + "Location for kubectl" + "/usr/local/bin/kubectl") + +(defun initial-deployment-files () + "Files to deploy when the cluster first starts." + "/home/adammo/repos/k8splayground/src/tutorial0/deployment.yaml") + +(defun create-kube-cluster (name) + (let ((result (nth-value 2 (run-program (create-kube-cluster-command name) :output *STANDARD-OUTPUT*)))) + (= 0 result))) + +(defun delete-kube-cluster (cluster) + (let ((result (nth-value 2 (run-program (delete-kube-cluster-command cluster) :output *STANDARD-OUTPUT*)))) + (= 0 result))) + +(defun create-kube-cluster-command (name) + "Create the command to create the cluster." + (list (kind-executable) "create" "cluster" "--name" name)) + +(defun delete-kube-cluster-command (cluster) + "Lists the existing kube clusters." + (list (kind-executable) "delete" "cluster" "--name" (cluster-name cluster))) + + +(defun update-cluster (cluster) + "Fetches the latest state for the cluster." + (progn + (update-cluster-deployments cluster) + (update-cluster-services cluster) + cluster)) + + +(defun fetch-resources (resource) + (let* ((api-response (run-program (list "/usr/local/bin/kubectl" "get" resource "-o" "json") :output :string)) + (json-resp (parse api-response)) + (resources (gethash "items" json-resp))) + (loop for r in resources + collect (gethash "name" (gethash "metadata" r))))) + +(defun update-cluster-deployments (cluster) + (let ((active-deployments (fetch-resources "deployments"))) + (setf (k8s-deployments cluster) active-deployments))) + +(defun update-cluster-services (cluster) + (let ((active-services (fetch-resources "services"))) + (setf (k8s-services cluster) active-services))) + +(defun bring-up-environment (name) + "Starts a kind cluster and applies yaml and updates the cluster-state" + (let ((cluster (make-instance 'demo-cluster)) + (kcname (format nil "kind-~A" name)) + (output *STANDARD-OUTPUT*)) + (format output "Creating cluster ~A... This may take a few seconds.~%" name) + (setf (cluster-name cluster) name) + (create-kube-cluster name) + (format output "Switching Kube context.~%") + (run-program `(,(kubectl-executable) "config" "use-context" ,kcname) :output output) + (format output "Creating K8s resources.~%") + (run-program `(,(kubectl-executable) "apply" "-f" ,(initial-deployment-files)) :ouptut output) + (format output "Refreshing cluster state.~%") + (update-cluster cluster))) + +(defun update-drop-list (drop-list items) + (loop for i in items + do (clog:create-list-item (clog-drop-list:drop-root drop-list) :content i))) + +(defun update-cluster-ui (dep-drop svc-drop cluster) + (progn + (update-cluster cluster) + (update-drop-list dep-drop (k8s-deployments cluster)) + (update-drop-list svc-drop (k8s-services cluster)))) + +(defun on-new-window (body) + (let ((active-name (clog:create-child body (format nil "

Cluster Name: kind-~A

" (cluster-name *ACTIVE-CLUSTER*)))) + (dep-drop (clog-drop-list:create-drop-list body :content "Deployments")) + (svc-drop (clog-drop-list:create-drop-list body :content "Services")) + (refresh-btn (clog:create-button body :content "⟳ Refresh"))) + (declare (ignore active-name)) + (setf (clog:background-color body) "#3B4252") + (setf (clog:color body) "#ECEFF4") + (update-cluster-ui dep-drop svc-drop *ACTIVE-CLUSTER*) + (clog:set-on-click refresh-btn (lambda (obj) + (declare (ignore obj)) + (let ((new-dep-drop (clog-drop-list:create-drop-list body :auto-place nil :content "Deployments")) + (new-svc-drop (clog-drop-list:create-drop-list body :auto-place nil :content "Services"))) + (update-cluster-ui new-dep-drop new-svc-drop *ACTIVE-CLUSTER*) + (clog:replace-element dep-drop new-dep-drop) + (setf dep-drop new-dep-drop) + (clog:replace-element svc-drop new-svc-drop) + (setf svc-drop new-svc-drop)))))) diff --git a/src/tutorial0/deployment.yaml b/src/tutorial0/deployment.yaml new file mode 100644 index 0000000..e8b3af5 --- /dev/null +++ b/src/tutorial0/deployment.yaml @@ -0,0 +1,41 @@ +--- +apiVersion: apps/v1 +kind: Deployment +metadata: + labels: + app: demo-echo-server + name: demo-echo-server +spec: + replicas: 3 + selector: + matchLabels: + app: demo-echo-server + strategy: {} + template: + metadata: + labels: + app: demo-echo-server + spec: + containers: + - image: docker.io/hashicorp/http-echo + name: echo-server + env: + - name: POD_NAME + valueFrom: + fieldRef: + fieldPath: metadata.name + command: + - /http-echo + - -text=$(POD_NAME) +--- +apiVersion: v1 +kind: Service +metadata: + name: demo-echo-service +spec: + selector: + app: demo-echo-server + ports: + - name: web + port: 8080 + targetPort: 5678 diff --git a/tests/main.lisp b/tests/main.lisp new file mode 100644 index 0000000..39f6509 --- /dev/null +++ b/tests/main.lisp @@ -0,0 +1,12 @@ +(defpackage k8splayground/tests/main + (:use :cl + :k8splayground + :rove)) +(in-package :k8splayground/tests/main) + +;; NOTE: To run this test file, execute `(asdf:test-system :k8splayground)' in your Lisp. + +(deftest make-k8s-cluster + (testing "should create a k8s-cluster" + (let ((cluster (k8smake-k8s-cluster))) + (ok (= "test" (k8splayground:cluster-name cluster))))))