code.consxy.com Git - candle/blob - src/main/aws/aws.lisp

   1 (in-package #:candle-aws)
   2
   3 (defvar *aws-mutex* (sb-thread:make-mutex))
   4 (defvar *aws-waitq* (sb-thread:make-waitqueue))
   5 (defvar *aws-state* :initial)
   6 (defvar *aws-exec*)
   7 (defvar *aws-instance-id*)
   8 (defvar *aws-username*)
   9 (defvar *aws-keyfile*)
  10 (defvar *rsync-exec*)
  11 (defvar *ssh-exec*)
  12 (defvar *remote-work-dir*)
  13 (defvar *remote-candle-location*)
  14
  15 (defmethod candle:process-job-in-system ((job-system (eql :aws)) job)
  16  (sb-thread:with-mutex (*aws-mutex*)
  17   ; Don't start it up until we process the first job
  18   (when (eql :initial *aws-state*)
  19    (setf *aws-state* :down)
  20    (start-shutdown-thread))
  21   (when (eql :down *aws-state*) (start-aws-box))
  22   (let
  23    ((retn (multiple-value-list (run-job job))))
  24    (setf *aws-state* :up)
  25    (sb-thread:condition-broadcast *aws-waitq*)
  26    (values-list retn))))
  27
  28 (defun start-shutdown-thread ()
  29  (log:info "Starting AWS shutdown thread")
  30  (sb-thread:make-thread
  31   (lambda ()
  32    (loop
  33     (sb-thread:with-mutex (*aws-mutex*)
  34      (when (eql :down *aws-state*)
  35       (sb-thread:condition-wait *aws-waitq* *aws-mutex*))
  36      (when (eql :shutting-down-soon *aws-state*)
  37       (stop-aws-box)
  38       (setf *aws-state* :down))
  39      (when (eql :up *aws-state*)
  40       (setf *aws-state* :shutting-down-soon)))
  41     (sleep 30)))
  42   :name "AWS Shutdown Thread"))
  43
  44 (defmethod candle:shutdown-system ((job-system (eql :aws)))
  45  (log:info "Shutting down AWS box for exit")
  46  ; If there's a job going, we need to wait for it to finish
  47  (sb-thread:with-mutex (*aws-mutex*))
  48  (stop-aws-box))
  49
  50 (defun aws-command (cmd &rest args)
  51  (with-output-to-string (out)
  52  (sb-ext:run-program
  53   *aws-exec*
  54   (append
  55    (list "ec2" cmd)
  56    args)
  57   :output out
  58   :error *error-output*)))
  59
  60 (defun describe-property (property)
  61  (read-from-string
  62   (aws-command
  63    "describe-instances"
  64    "--instance-ids"
  65    *aws-instance-id*
  66    "--query"
  67    (format nil "Reservations[0].Instances[0].~A" property))))
  68
  69 (defun get-remote-state ()
  70  (intern (string-upcase (describe-property "State.Name")) :keyword))
  71
  72 (defun start-aws-box ()
  73  (aws-command "start-instances" "--instance-ids" *aws-instance-id*)
  74  (loop
  75   :repeat 8
  76   :until (eql :running (get-remote-state))
  77   :do (sleep 15))
  78  ; Make sure ssh and services are started up
  79  (sleep 15)
  80  (when (not (eql :running (get-remote-state)))
  81   (error "Waited two minutes and still not running...?")))
  82
  83 (defun stop-aws-box ()
  84  (aws-command "stop-instances" "--instance-ids" *aws-instance-id*)
  85  (loop
  86   :repeat 8
  87   :until (eql :stopped (get-remote-state))
  88   :do (sleep 15))
  89  (when (not (eql :stopped (get-remote-state)))
  90   (error "Waited two minutes and still not stopped...?")))
  91
  92 (defun run-job (job)
  93  (sb-ext:run-program
  94   *rsync-exec*
  95   (list
  96    "-az"
  97    "--delete"
  98    "-e"
  99    (format nil "ssh -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null -i ~A" *aws-keyfile*)
 100    (candle:project-dir (candle:job-project job))
 101    (format nil "~A@~A:~A" *aws-username* (describe-property "PublicIpAddress") *remote-work-dir*)))
 102  (let*
 103   ((out nil)
 104    (code nil))
 105    (setf out
 106     (with-output-to-string (out-str)
 107      (setf code
 108       (sb-ext:process-exit-code
 109        (sb-ext:run-program
 110         *ssh-exec*
 111         (list
 112          "-o"
 113          "StrictHostKeyChecking=no"
 114          "-o"
 115          "UserKnownHostsFile=/dev/null"
 116          "-i"
 117          *aws-keyfile*
 118          (describe-property "PublicIpAddress")
 119          (format nil "cd ~A ; ~A run" *remote-work-dir* *remote-candle-location*))
 120         :output out-str
 121         :error out-str
 122         :wait t)))))
 123    (values (zerop code) out)))