git.fiddlerwoaroof.com
Raw Blame History
(defpackage :mfa-tool.credential-provider
  (:use :cl )
  (:export #:make-aws-session
           #:debug-provider
           #:setup-default-chain
           #:save-ubiquitous-credentials))
(in-package :mfa-tool.credential-provider)

(defstruct hash-ref name hash-table)
(defstruct leaf name value)

(defun normalize (key)
  (string-trim " " key))

(defmethod architecture.builder-protocol:make-node
    ((builder (eql :my-builder)) (kind (eql :section)) &key name bounds)
  (declare (ignore bounds))
  (let ((name (normalize (car name))))
    (make-hash-ref :name (normalize name)
                   :hash-table (alexandria:alist-hash-table `((,name . ,(make-hash-table :test 'equal)))
                                                            :test 'equal))))

(defmethod architecture.builder-protocol:relate
    ((builder  (eql :my-builder))
     (relation (eql :section-option))
     (left     hash-ref)
     (right    cons)
     &key)
  (alexandria:ensure-gethash (normalize (car right))
                             (gethash (hash-ref-name left)
                                      (hash-ref-hash-table left))
                             (normalize (cdr right)))
  left)

(defmethod architecture.builder-protocol:make-node
    ((builder (eql :my-builder)) (kind (eql :option)) &key name value bounds)
  (declare (ignore bounds))
  (cons (car name)
        value))

(defmethod architecture.builder-protocol:finish-node
    ((builder (eql :my-builder)) (kind (eql :section)) (node hash-ref))
  (hash-ref-hash-table node))

(defun merge-hash-tables (tables)
  (reduce (lambda (next acc)
            (loop for key being each hash-key in next using (hash-value value)
                  do (setf (gethash key acc) value))
            acc)
          tables
          :initial-value (make-hash-table :test 'equal)
          :from-end t))

(defun parse-ini (fn)
  (merge-hash-tables (parser.ini:parse (pathname fn)
                                       :my-builder)))

(defclass fwoar-provider (aws-sdk/credentials/base:provider)
  ((file :initarg :file :initform (error "must pass a file name"))
   (profile :initarg :profile
            :initform aws-sdk:*aws-profile*
            :accessor provider-profile)

   (retrievedp :initform nil)))

(defun read-credentials (provider)
  (with-slots (file) provider
    (when (probe-file file)
      (gethash (provider-profile provider)
               (parse-ini file)))))

(defmethod aws-sdk/credentials/base:retrieve ((provider fwoar-provider))
  (with-slots (retrievedp) provider
    (setf retrievedp nil)
    (let ((section (read-credentials provider)))
      (when section
        (setf retrievedp t)
        (aws-sdk:make-credentials
         :access-key-id (gethash "aws_access_key_id" section)
         :secret-access-key (gethash "aws_secret_access_key" section)
         :session-token (gethash "aws_session_token" section)
         :provider-name "fwoar-provider")))))

(defclass ubiquitous-provider (aws-sdk/credentials/base:provider)
  ((retrievedp :initform nil)))

(defmethod aws-sdk/credentials/base:retrieve ((provider ubiquitous-provider))
  (when (and (ubiquitous:value :aws :access-key-id)
             (ubiquitous:value :aws :secret-access-key))
    (aws-sdk:make-credentials
     :access-key-id (ubiquitous:value :aws :access-key-id)
     :secret-access-key (ubiquitous:value :aws :secret-access-key)
     :session-token (ubiquitous:value :aws :session-token)
     :provider-name "ubiquitous-provider")))

(defun save-ubiquitous-credentials (credentials)
  (prog1 credentials
    (setf (ubiquitous:value :aws :access-key-id)
          (aws-sdk/credentials/base:credentials-access-key-id credentials)

          (ubiquitous:value :aws :secret-access-key)
          (aws-sdk/credentials/base:credentials-secret-access-key credentials)

          (ubiquitous:value :aws :session-token)
          (aws-sdk/credentials/base:credentials-session-token credentials))
    (ubiquitous:offload)))

(defun make-aws-session ()
  (let ((aws-sdk/credentials::*chained-providers*
          (list (make-instance 'fwoar-provider :file (merge-pathnames ".aws/credentials"
                                                                      (user-homedir-pathname)))
                (make-instance 'ubiquitous-provider))))
    (aws:make-session :credentials (aws:default-aws-credentials))))

(defun debug-provider (s)
  (pprint (read-credentials (make-instance 'fwoar-provider
                                           :file (merge-pathnames ".aws/credentials"
                                                                  (user-homedir-pathname))))
          s))

(defun setup-default-chain ()
  (setf aws-sdk/credentials::*chained-providers*
        (list (make-instance 'fwoar-provider :file (merge-pathnames ".aws/credentials"
                                                                    (user-homedir-pathname)))
              (make-instance 'ubiquitous-provider))))