From 3fdc12a393fbbd099417398018d2fada7e751358 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Wed, 15 Dec 2021 13:11:13 -0600 Subject: [PATCH] Add aws processor, refactor processing a little --- bin/candle-server | 3 + candle.asd | 15 +++-- src/main/aws/.gitignore | 1 + src/main/aws/aws.lisp | 116 ++++++++++++++++++++++++++++++++ src/main/aws/config.lisp.tmpl | 10 +++ src/main/{ => local}/local.lisp | 10 +-- src/main/package.lisp | 6 +- 7 files changed, 150 insertions(+), 11 deletions(-) create mode 100644 src/main/aws/.gitignore create mode 100644 src/main/aws/aws.lisp create mode 100644 src/main/aws/config.lisp.tmpl rename src/main/{ => local}/local.lisp (58%) diff --git a/bin/candle-server b/bin/candle-server index 8c4d0cb..7bd12a6 100755 --- a/bin/candle-server +++ b/bin/candle-server @@ -46,6 +46,9 @@ (if (opera:option-present :system options) (intern (string-upcase (opera:option-argument :system options)) :keyword) :local)) + (case candle:*job-system* + (:aws (asdf:load-system :candle-aws)) + (:local (asdf:load-system :candle-local))) (setf candle:*candle-dir* (if (opera:option-present :dir options) (opera:option-argument :dir options) diff --git a/candle.asd b/candle.asd index f467511..e65a502 100644 --- a/candle.asd +++ b/candle.asd @@ -7,10 +7,17 @@ :pathname "src/main" :components ((:file "package") (:file "base") - (:file "server") - (:file "cli") (:file "git") + (:file "run") (:file "processor") - (:file "local") - (:file "run")) + (:file "server") + (:file "cli")) :depends-on (:herbie-utility :opera)) + +(asdf:defsystem candle-aws + :pathname "src/main/aws" + :components ((:file "aws") (:file "config"))) + +(asdf:defsystem candle-local + :pathname "src/main/local" + :components ((:file "local"))) diff --git a/src/main/aws/.gitignore b/src/main/aws/.gitignore new file mode 100644 index 0000000..262158a --- /dev/null +++ b/src/main/aws/.gitignore @@ -0,0 +1 @@ +config.lisp diff --git a/src/main/aws/aws.lisp b/src/main/aws/aws.lisp new file mode 100644 index 0000000..1d3745b --- /dev/null +++ b/src/main/aws/aws.lisp @@ -0,0 +1,116 @@ +(in-package #:candle-aws) + +(defvar *aws-mutex* (sb-thread:make-mutex)) +(defvar *aws-waitq* (sb-thread:make-waitqueue)) +(defvar *aws-state* :initial) +(defvar *aws-exec*) +(defvar *aws-instance-id*) +(defvar *aws-username*) +(defvar *aws-keyfile*) +(defvar *rsync-exec*) +(defvar *ssh-exec*) +(defvar *remote-work-dir*) +(defvar *remote-candle-location*) + +(defmethod candle:process-job-in-system ((job-system (eql :aws)) job) + (sb-thread:with-mutex (*aws-mutex*) + ; Don't start it up until we process the first job + (when (eql :initial *aws-state*) + (setf *aws-state* :down) + (start-shutdown-thread)) + (when (eql :down *aws-state*) (start-aws-box)) + (let + ((retn (multiple-value-list (run-job job)))) + (setf *aws-state* :up) + (sb-thread:condition-broadcast *aws-waitq*) + (values-list retn)))) + +(defun start-shutdown-thread () + (sb-thread:make-thread + (lambda () + (loop + (sb-thread:with-mutex (*aws-mutex*) + (when (eql :down *aws-state*) + (sb-thread:condition-wait *aws-waitq* *aws-mutex*)) + (when (eql :shutting-down-soon *aws-state*) + (stop-aws-box) + (setf *aws-state* :down)) + (when (eql :up *aws-state*) + (setf *aws-state* :shutting-down-soon))) + (sleep 30))) + :name "AWS Shutdown Thread")) + +(defun aws-command (cmd &rest args) + (with-output-to-string (out) + (sb-ext:run-program + *aws-exec* + (append + (list "ec2" cmd) + args) + :output out + :error *error-output*))) + +(defun describe-property (property) + (read-from-string + (aws-command + "describe-instances" + "--instance-ids" + *aws-instance-id* + "--query" + (format nil "Reservations[0].Instances[0].~A" property)))) + +(defun get-remote-state () + (intern (string-upcase (describe-property "State.Name")) :keyword)) + +(defun start-aws-box () + (aws-command "start-instances" "--instance-ids" *aws-instance-id*) + (loop + :repeat 8 + :until (eql :running (get-remote-state)) + :do (sleep 15)) + ; Make sure ssh and services are started up + (sleep 15) + (when (not (eql :running (get-remote-state))) + (error "Waited two minutes and still not running...?"))) + +(defun stop-aws-box () + (aws-command "stop-instances" "--instance-ids" *aws-instance-id*) + (loop + :repeat 8 + :until (eql :stopped (get-remote-state)) + :do (sleep 15)) + (when (not (eql :stopped (get-remote-state))) + (error "Waited two minutes and still not stopped...?"))) + +(defun run-job (job) + (sb-ext:run-program + *rsync-exec* + (list + "-az" + "--delete" + "-e" + (format nil "ssh -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null -i ~A" *aws-keyfile*) + (candle:project-dir (candle:job-project job)) + (format nil "~A@~A:~A" *aws-username* (describe-property "PublicIpAddress") *remote-work-dir*))) + (let* + ((out nil) + (code nil)) + (setf out + (with-output-to-string (out-str) + (setf code + (sb-ext:process-exit-code + (sb-ext:run-program + *ssh-exec* + (list + "-o" + "StrictHostKeyChecking=no" + "-o" + "UserKnownHostsFile=/dev/null" + "-i" + *aws-keyfile* + (describe-property "PublicIpAddress") + (format nil "cd ~A ; ~A run" *remote-work-dir* *remote-candle-location*)) + :output out-str + :error out-str + :wait t))))) + (values (zerop code) out))) diff --git a/src/main/aws/config.lisp.tmpl b/src/main/aws/config.lisp.tmpl new file mode 100644 index 0000000..829caca --- /dev/null +++ b/src/main/aws/config.lisp.tmpl @@ -0,0 +1,10 @@ +(in-package #:candle-aws) + +(setf *aws-exec* "/path/to/aws") +(setf *aws-instance-id* "instance-id") +(setf *aws-username* "user") +(setf *aws-keyfile* "/path/to/ssh/key") +(setf *rsync* "/usr/bin/rsync") +(setf *ssh-exec* "/usr/bin/ssh") +(setf *remote-work-dir* "/path/to/remote/work/dir") +(setf *remote-candle-location* "/path/to/remote/candle/exec") diff --git a/src/main/local.lisp b/src/main/local/local.lisp similarity index 58% rename from src/main/local.lisp rename to src/main/local/local.lisp index 83b9815..bce245b 100644 --- a/src/main/local.lisp +++ b/src/main/local/local.lisp @@ -1,20 +1,20 @@ -(in-package #:candle) +(in-package #:candle-local) -(defmethod process-job-in-system ((job-system (eql :local)) job) +(defmethod candle:process-job-in-system ((job-system (eql :local)) job) (let - ((work-dir (format nil "~Awork/" *candle-dir*)) + ((work-dir (format nil "~Awork/" candle:*candle-dir*)) (result nil)) (sb-ext:run-program "/bin/cp" (list "-ap" - (project-dir (job-project job)) + (candle:project-dir (candle:job-project job)) work-dir)) (let* ((*default-pathname-defaults* (pathname work-dir)) (*error-output* (make-broadcast-stream)) (output (with-output-to-string (*standard-output*) - (setf result (run))))) + (setf result (candle:run))))) (sb-ext:delete-directory work-dir :recursive t) (values result output)))) diff --git a/src/main/package.lisp b/src/main/package.lisp index f43a344..848b09f 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -1,7 +1,9 @@ (defpackage #:candle (:use :cl) (:export #:server #:add-project #:delete-project #:refresh-project #:list-projects - #:project-branch-information #:run #:*candle-dir* #:*job-system* - #:project-job-information #:get-job-log)) + #:project-branch-information #:run #:*candle-dir* #:*job-system* #:*candle-dir* + #:project-job-information #:get-job-log #:job-project #:project-dir #:process-job-in-system)) (defpackage #:candle-cli (:use :cl) (:export :run)) +(defpackage #:candle-aws (:use :cl)) +(defpackage #:candle-local (:use :cl)) -- 2.25.1