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  (sb-thread:make-thread
  30   (lambda ()
  31    (loop
  32     (sb-thread:with-mutex (*aws-mutex*)
  33      (when (eql :down *aws-state*)
  34       (sb-thread:condition-wait *aws-waitq* *aws-mutex*))
  35      (when (eql :shutting-down-soon *aws-state*)
  36       (stop-aws-box)
  37       (setf *aws-state* :down))
  38      (when (eql :up *aws-state*)
  39       (setf *aws-state* :shutting-down-soon)))
  40     (sleep 30)))
  41   :name "AWS Shutdown Thread"))
  42
  43 (defun aws-command (cmd &rest args)
  44  (with-output-to-string (out)
  45  (sb-ext:run-program
  46   *aws-exec*
  47   (append
  48    (list "ec2" cmd)
  49    args)
  50   :output out
  51   :error *error-output*)))
  52
  53 (defun describe-property (property)
  54  (read-from-string
  55   (aws-command
  56    "describe-instances"
  57    "--instance-ids"
  58    *aws-instance-id*
  59    "--query"
  60    (format nil "Reservations[0].Instances[0].~A" property))))
  61
  62 (defun get-remote-state ()
  63  (intern (string-upcase (describe-property "State.Name")) :keyword))
  64
  65 (defun start-aws-box ()
  66  (aws-command "start-instances" "--instance-ids" *aws-instance-id*)
  67  (loop
  68   :repeat 8
  69   :until (eql :running (get-remote-state))
  70   :do (sleep 15))
  71  ; Make sure ssh and services are started up
  72  (sleep 15)
  73  (when (not (eql :running (get-remote-state)))
  74   (error "Waited two minutes and still not running...?")))
  75
  76 (defun stop-aws-box ()
  77  (aws-command "stop-instances" "--instance-ids" *aws-instance-id*)
  78  (loop
  79   :repeat 8
  80   :until (eql :stopped (get-remote-state))
  81   :do (sleep 15))
  82  (when (not (eql :stopped (get-remote-state)))
  83   (error "Waited two minutes and still not stopped...?")))
  84
  85 (defun run-job (job)
  86  (sb-ext:run-program
  87   *rsync-exec*
  88   (list
  89    "-az"
  90    "--delete"
  91    "-e"
  92    (format nil "ssh -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null -i ~A" *aws-keyfile*)
  93    (candle:project-dir (candle:job-project job))
  94    (format nil "~A@~A:~A" *aws-username* (describe-property "PublicIpAddress") *remote-work-dir*)))
  95  (let*
  96   ((out nil)
  97    (code nil))
  98    (setf out
  99     (with-output-to-string (out-str)
 100      (setf code
 101       (sb-ext:process-exit-code
 102        (sb-ext:run-program
 103         *ssh-exec*
 104         (list
 105          "-o"
 106          "StrictHostKeyChecking=no"
 107          "-o"
 108          "UserKnownHostsFile=/dev/null"
 109          "-i"
 110          *aws-keyfile*
 111          (describe-property "PublicIpAddress")
 112          (format nil "cd ~A ; ~A run" *remote-work-dir* *remote-candle-location*))
 113         :output out-str
 114         :error out-str
 115         :wait t)))))
 116    (values (zerop code) out)))