;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- (declaim (optimize (speed 0) (safety 3) (debug 3))) (in-package :snow) (defclass aws () ((profile :initarg :profile :initform nil :accessor profile) (region :initarg :region :initform (region *webapp*) :accessor region)) (:documentation "")) (defclass aws-tag () ((key :initarg :key :initform nil :accessor key) (value :initarg :value :initform nil :accessor value)) (:documentation "")) (defclass aws-instance () ((id :initarg :id :initform nil :accessor id) (ip :initarg :ip :initform nil :accessor ip) (launch-time :initarg :launch-time :initform nil :accessor launch-time)) (:documentation "")) (defclass aws-asg (aws) ((name :initarg :name :initform nil :accessor name) (arn :initarg :arn :initform nil :accessor arn) (count-min :initarg :count-min :initform nil :accessor count-min) (count-max :initarg :count-max :initform nil :accessor count-max) (count-desired :initarg :count-desired :initform nil :accessor count-desired) (age :initarg :age :initform nil :accessor age) (instance-ids :initarg :instance-ids :initform nil :accessor instance-ids) (instances :initarg :instances :initform nil :accessor instances) (howmany :initarg :howmany :initform nil :accessor howmany)) (:documentation "")) (defclass aws-certificate (aws) ((arn :initarg :arn :initform nil :accessor arn) (domain-name :initarg :domain-name :initform nil :accessor domain-name) (status :initarg :status :initform nil :accessor status) (renewal-eligibility :initarg :renewal-eligibility :initform nil :accessor renewal-eligibility) (not-before :initarg :not-before :initform nil :accessor not-before) (not-after :initarg :not-after :initform nil :accessor not-after) (tags :initarg :tags :initform nil :accessor tags) (cert :initarg :cert :initform nil :accessor cert) (chain :initarg :chain :initform nil :accessor chain) (key :initarg :key :initform nil :accessor key) (passphrase :initarg :passphrase :initform nil :accessor passphrase)) (:documentation "")) (defclass aws-targetgroup (aws) ((name :initarg :name :initform nil :accessor name) (arn :initarg :arn :initform nil :accessor arn) (protocol :initarg :protocol :initform nil :accessor protocol) (port :initarg :port :initform nil :accessor port) (healthy-p :initarg :healthy-p :initform nil :accessor healthy-p) (stdout :initarg :stdout :initform nil :accessor stdout) (filter :initarg :filter :initform nil :accessor filter) (targets :initarg :targets :initform nil :accessor targets)) (:documentation "")) (defclass aws-target () ((instance-id :initarg :instance-id :initform nil :accessor instance-id) (port :initarg :port :initform nil :accessor port) (state :initarg :state :initform nil :accessor state) (healthy-p :initarg :healthy-p :initform nil :accessor healthy-p)) (:documentation "")) (defclass aws-ssm-parameter (aws) ((name :initarg :name :initform nil :accessor name) (value :initarg :value :initform nil :accessor value)) (:documentation "")) (defmethod sanitize-json ((aws-asg aws-asg)) (make-instance 'aws-asg :profile nil :region nil :name (name aws-asg) :count-min (count-min aws-asg) :count-max (count-max aws-asg) :count-desired (count-desired aws-asg) :age (age aws-asg) :instances (instances aws-asg) :howmany nil)) (defmethod run-aws-cli ((aws aws) command) "Runs an awscli command and returns the results as CL-JSON object." (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t))) (with-output-to-string (stream output) (uffi:run-shell-command (format nil "~a --profile ~a --region ~a" command (profile aws) (region aws)) :output stream)) (if (org-ckons-core::null-or-empty-p output) output (cl-json:decode-json-from-string output)))) (defmethod get-asgs ((aws aws) filter) (let* ((command "aws autoscaling describe-auto-scaling-groups") (asgs (loop for asg in (cdar (run-aws-cli aws command)) when (org-ckons-core::match-it filter (cdr (assoc :*auto-scaling-group-name asg))) collect (make-instance 'aws-asg :profile (profile aws) :region (region aws) :name (cdr (assoc :*auto-scaling-group-name asg)) :arn (cdr (assoc :*auto-scaling-group-+arn+ asg)) :count-min (cdr (assoc :*min-size asg)) :count-max (cdr (assoc :*max-size asg)) :count-desired (cdr (assoc :*desired-capacity asg)) :instance-ids (org-ckons-core::flatten (loop for instance in (cdr (assoc :*instances asg)) collect (cdr (assoc :*instance-id instance))))))) (instances (get-instances aws (org-ckons-core::flatten (loop for asg in asgs collect (instance-ids asg)))))) (loop for instance in instances do (loop for asg in asgs when (intersection `(,(id instance)) (instance-ids asg) :test 'string=) do (push instance (instances asg)))) (loop for asg in asgs do (handler-case (progn (setf (instances asg) (sort (instances asg) (lambda (x y) (string< (launch-time x) (launch-time y))))) (setf (age asg) (/ (- (get-universal-time) (local-time:timestamp-to-universal (local-time:parse-timestring (launch-time (first (instances asg)))))) 86400.0))) (error (e) (declare (ignore e)) (setf (age asg) -1)))) (sort asgs (lambda (x y) (> (age x) (age y)))))) (defmethod get-instances ((aws aws) instance-ids) (let ((command (format nil "aws ec2 describe-instances --instance-ids ~a" (org-ckons-core::reduce-to-char-separated-string instance-ids " ")))) (loop for instance in (loop for reservation in (cdr (assoc :*reservations (run-aws-cli aws command))) collect (car (cdr (assoc :*instances reservation)))) collect (make-instance 'aws-instance :id (cdr (assoc :*instance-id instance)) :ip (first (loop for interface in (cdr (assoc :*network-interfaces instance)) collect (cdr (assoc :*private-ip-address interface)))) :launch-time (cdr (assoc :*launch-time instance)))))) (defmethod get-targetgroups ((aws-targetgroup aws-targetgroup)) (let ((command "aws elbv2 describe-target-groups")) (sort (loop for targetgroup in (cdar (run-aws-cli aws-targetgroup command)) when (org-ckons-core::match-it (if (string= (filter aws-targetgroup) "all") "" (filter aws-targetgroup)) (cdr (assoc :*target-group-name targetgroup))) collect (let ((targetgroup (make-instance 'aws-targetgroup :profile (profile aws-targetgroup) :region (region aws-targetgroup) :name (cdr (assoc :*target-group-name targetgroup)) :arn (cdr (assoc :*target-group-arn targetgroup)) :protocol (cdr (assoc :*protocol targetgroup)) :port (cdr (assoc :*port targetgroup))))) (setf (targets targetgroup) (get-targets targetgroup)) (setf (healthy-p targetgroup) (get-targetgroup-health targetgroup)) targetgroup)) (lambda (x y) (string< (name x) (name y)))))) (defmethod get-targets ((aws-targetgroup aws-targetgroup)) (let ((command (format nil "aws elbv2 describe-target-health --target-group-arn ~a" (arn aws-targetgroup)))) (loop for target in (cdar (run-aws-cli aws-targetgroup command)) collect (make-instance 'aws-target :instance-id (cdr (assoc :*id (cdr (assoc :*target target)))) :port (cdr (assoc :*port (cdr (assoc :*target target)))) :state (cdr (assoc :*state (cdr (assoc :*target-health target)))) :healthy-p (string= (cdr (assoc :*state (cdr (assoc :*target-health target)))) "healthy"))))) (defmethod get-targetgroup-health ((aws-targetgroup aws-targetgroup)) (let ((states (loop for target in (targets aws-targetgroup) collect (healthy-p target)))) (= (length states) (length (remove-if 'null states))))) (defmethod get-aws-unhealthy-targetgroups ((aws-targetgroup aws-targetgroup)) (enqueue *queue-aws* aws-targetgroup)) (defmethod bg-perform ((aws-targetgroup aws-targetgroup)) (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)) (targetgroups (get-targetgroups aws-targetgroup))) (with-output-to-string (stream output) (loop for targetgroup in targetgroups when (not (healthy-p targetgroup)) do (format stream "~a~t~a~t~a~%" (name targetgroup) (arn targetgroup) (port targetgroup)) (loop for target in (targets targetgroup) when (not (healthy-p target)) do (format stream "~t~a~t~a~%" (instance-id target) (state target))) (format stream "~%"))) (with-open-file (stream (stdout aws-targetgroup) :direction :output :if-exists :append :if-does-not-exist :create) (format stream output)))) (defmethod get-certificates ((aws aws) &optional filter) (sort (loop for cert in (cdr (assoc :*certificate-summary-list (run-aws-cli aws "aws acm list-certificates"))) when (or (and (null filter) (string= (cdr (assoc :*status cert)) "ISSUED")) (string= filter (cdr (assoc :*domain-name cert)))) collect (make-instance 'aws-certificate :profile (profile aws) :region (region aws) :arn (cdr (assoc :*certificate-arn cert)) :domain-name (cdr (assoc :*domain-name cert)) :status (cdr (assoc :*status cert)) :renewal-eligibility (cdr (assoc :*renewal-eligibility cert)) :not-before (cdr (assoc :*not-before cert)) :not-after (cdr (assoc :*not-after cert)))) (lambda (x y) (string< (domain-name x) (domain-name y))))) (defmethod get-certificate-tags ((aws-certificate aws-certificate)) (setf (tags aws-certificate) (sort (loop for tag in (cdr (assoc :*tags (run-aws-cli aws-certificate (format nil "aws acm list-tags-for-certificate --certificate-arn ~a" (arn aws-certificate))))) collect (make-instance 'aws-tag :key (cdr (assoc :*key tag)) :value (cdr (assoc :*value tag)))) (lambda (x y) (string< (key x) (key y)))))) (defun tag-exists-p (cert key value) (find-if (lambda (x) (and (string= (key x) key) (string= (value x) value))) (tags cert))) (defun get-certificates-to-renew (certs environment) (loop for cert in certs do (get-certificate-tags cert)) (loop for cert in certs when (and (or (tag-exists-p cert "Purpose" "KafkaAuth") (tag-exists-p cert "Purpose" "OloAuthSigningKey")) (tag-exists-p cert "Environment" environment)) collect cert)) (defmethod bg-perform ((aws-asg aws-asg)) (labels ((do-scale (count-desired) (let ((command (format nil "aws autoscaling set-desired-capacity --auto-scaling-group-name ~a --desired-capacity ~a" (name aws-asg) count-desired))) (run-aws-cli aws-asg command))) (instances-ready-p () (let ((updated-asg (car (get-asgs aws-asg (name aws-asg)))) (in-service-p t)) (loop for id in (instances updated-asg) do (let* ((command (format nil "aws autoscaling describe-auto-scaling-instances --instance-id ~a" id)) (instance (cadar (run-aws-cli updated-asg command)))) (when (not (string= (cdr (assoc :*lifecycle-state instance)) "InService")) (setf in-service-p nil)))) in-service-p))) (let ((count (cond ((string= (howmany aws-asg) "all") (count-desired aws-asg)) ((string= (howmany aws-asg) "one") 1) (t 0)))) (loop for index from 1 to count do (progn (do-scale (+ (count-desired aws-asg) 1)) (sleep 15) (do-scale (count-desired aws-asg)) (sleep 15) (loop while (not (instances-ready-p)) do (sleep 30))))))) (defmethod recycle-asg ((aws-asg aws-asg)) (enqueue *queue-aws* aws-asg)) (defmethod bg-perform ((aws-certificate aws-certificate)) ) (defmethod renew-certificates ((aws-certificate aws-certificate) environment filter) (loop for cert in (get-certificates-to-renew (get-certificates aws-certificate filter) environment) do (let* ((passphrase (cl-base64:string-to-base64-string (org-ckons-session::generate-sessionid))) (exported-cert (run-aws-cli aws-certificate (format nil "aws acm export-certificate --certificate-arn ~a --passphrase ~a --output json" (arn cert) passphrase)))) (setf (cert cert) (cdr (assoc :*certificate exported-cert))) (setf (chain cert) (cdr (assoc :*certificate-chain exported-cert))) (setf (key cert) (cdr (assoc :*private-key exported-cert))) (setf (passphrase cert) passphrase)))) ;;do (enqueue *queue-aws* cert))) (defun get-aws-ssm-parameter (profile key) (let* ((aws-ssm-parameter (make-instance 'aws-ssm-parameter :profile profile :region "us-east-1")) (command (format nil "aws ssm get-parameter --with-decryption --name \"~a\"" key)) (results (run-aws-cli aws-ssm-parameter command))) (setf (name aws-ssm-parameter) (cdr (assoc :*name (cdar results)))) (setf (value aws-ssm-parameter) (cdr (assoc :*value (cdar results)))) aws-ssm-parameter))