Add aws processor, refactor processing a little

diff --git a/bin/candle-server b/bin/candle-server
index 8c4d0cb9a9f1d0f04097aa74638b3d2ea905996f..7bd12a6d77bbd9a1f7c51cb2f404e8de41df7b5a 100755 (executable)
--- 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))
     (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)
    (setf candle:*candle-dir*
     (if (opera:option-present :dir options)
      (opera:option-argument :dir options)

diff --git a/candle.asd b/candle.asd
index f4675115431dd556394e3acd2546f96ab6d5e65b..e65a5027151815d7ca5c13a83f196082ccb8be20 100644 (file)
--- a/candle.asd
+++ b/candle.asd
@@ -7,10 +7,17 @@
  :pathname "src/main"
  :components ((:file "package")
               (:file "base")
  :pathname "src/main"
  :components ((:file "package")
               (:file "base")

-              (:file "server")
-              (:file "cli")

               (:file "git")
               (:file "git")

+              (:file "run")

               (:file "processor")
               (:file "processor")

-              (:file "local")
-              (:file "run"))
+              (:file "server")
+              (:file "cli"))

  :depends-on (:herbie-utility :opera))
  :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 (file)
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 (file)
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 (file)
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.lisp
deleted file mode 100644 (file)
index 83b9815..0000000
--- a/src/main/local.lisp
+++ /dev/null
@@ -1,20 +0,0 @@
-(in-package #:candle)
-
-(defmethod process-job-in-system ((job-system (eql :local)) job)
- (let
-  ((work-dir (format nil "~Awork/" *candle-dir*))
-   (result nil))
-  (sb-ext:run-program
-   "/bin/cp"
-   (list
-    "-ap"
-    (project-dir (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)))))
-    (sb-ext:delete-directory work-dir :recursive t)
-    (values result output))))

diff --git a/src/main/local/local.lisp b/src/main/local/local.lisp
new file mode 100644 (file)
index 0000000..bce245b
--- /dev/null
+++ b/src/main/local/local.lisp
@@ -0,0 +1,20 @@
+(in-package #:candle-local)
+
+(defmethod candle:process-job-in-system ((job-system (eql :local)) job)
+ (let
+  ((work-dir (format nil "~Awork/" candle:*candle-dir*))
+   (result nil))
+  (sb-ext:run-program
+   "/bin/cp"
+   (list
+    "-ap"
+    (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 (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 f43a3444444d664efe2468a5433bd22932b8cdfd..848b09f441ea824d2eced9cc66f70ae5ae6db963 100644 (file)
--- 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
 (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-cli (:use :cl) (:export :run))

+(defpackage #:candle-aws (:use :cl))
+(defpackage #:candle-local (:use :cl))