Browse code
bug: add new credentials provider to hopefully fix weird auth issues
Edward Langley authored on 10/10/2019 07:20:12Showing 2 changed files
| 33 | 34 |
new file mode 100644 |
| ... | ... |
@@ -0,0 +1,87 @@ |
| 1 |
+(defpackage :fwoar.credential-provider |
|
| 2 |
+ (:use :cl ) |
|
| 3 |
+ (:export |
|
| 4 |
+ #:make-aws-session)) |
|
| 5 |
+(in-package :fwoar.credential-provider) |
|
| 6 |
+ |
|
| 7 |
+(defstruct hash-ref name hash-table) |
|
| 8 |
+(defstruct leaf name value) |
|
| 9 |
+ |
|
| 10 |
+(defun normalize (key) |
|
| 11 |
+ (string-trim " " key)) |
|
| 12 |
+ |
|
| 13 |
+(defmethod architecture.builder-protocol:make-node |
|
| 14 |
+ ((builder (eql :my-builder)) (kind (eql :section)) &key name bounds) |
|
| 15 |
+ (declare (ignore bounds)) |
|
| 16 |
+ (let ((name (normalize (car name)))) |
|
| 17 |
+ (make-hash-ref :name (normalize name) |
|
| 18 |
+ :hash-table (alexandria:alist-hash-table `((,name . ,(make-hash-table :test 'equal))) |
|
| 19 |
+ :test 'equal)))) |
|
| 20 |
+ |
|
| 21 |
+(defmethod architecture.builder-protocol:relate |
|
| 22 |
+ ((builder (eql :my-builder)) |
|
| 23 |
+ (relation (eql :section-option)) |
|
| 24 |
+ (left hash-ref) |
|
| 25 |
+ (right cons) |
|
| 26 |
+ &key) |
|
| 27 |
+ (alexandria:ensure-gethash (normalize (car right)) |
|
| 28 |
+ (gethash (hash-ref-name left) |
|
| 29 |
+ (hash-ref-hash-table left)) |
|
| 30 |
+ (normalize (cdr right))) |
|
| 31 |
+ left) |
|
| 32 |
+ |
|
| 33 |
+(defmethod architecture.builder-protocol:make-node |
|
| 34 |
+ ((builder (eql :my-builder)) (kind (eql :option)) &key name value bounds) |
|
| 35 |
+ (declare (ignore bounds)) |
|
| 36 |
+ (cons (car name) |
|
| 37 |
+ value)) |
|
| 38 |
+ |
|
| 39 |
+(defmethod architecture.builder-protocol:finish-node |
|
| 40 |
+ ((builder (eql :my-builder)) (kind (eql :section)) (node hash-ref)) |
|
| 41 |
+ (hash-ref-hash-table node)) |
|
| 42 |
+ |
|
| 43 |
+(defun merge-hash-tables (tables) |
|
| 44 |
+ (reduce (lambda (next acc) |
|
| 45 |
+ (loop for key being each hash-key in next using (hash-value value) |
|
| 46 |
+ do (setf (gethash key acc) value)) |
|
| 47 |
+ acc) |
|
| 48 |
+ tables |
|
| 49 |
+ :initial-value (make-hash-table :test 'equal) |
|
| 50 |
+ :from-end t)) |
|
| 51 |
+ |
|
| 52 |
+(defun parse-ini (fn) |
|
| 53 |
+ (merge-hash-tables (parser.ini:parse (pathname fn) |
|
| 54 |
+ :my-builder))) |
|
| 55 |
+ |
|
| 56 |
+(defclass fwoar-provider (aws-sdk/credentials/base:provider) |
|
| 57 |
+ ((file :initarg :file |
|
| 58 |
+ :initform #P"~/.aws/credentials") |
|
| 59 |
+ (profile :initarg :profile |
|
| 60 |
+ :initform aws-sdk:*aws-profile* |
|
| 61 |
+ :accessor provider-profile) |
|
| 62 |
+ |
|
| 63 |
+ (retrievedp :initform nil))) |
|
| 64 |
+ |
|
| 65 |
+(defun read-credentials (provider) |
|
| 66 |
+ (with-slots (file) provider |
|
| 67 |
+ (when (probe-file file) |
|
| 68 |
+ (gethash (provider-profile provider) |
|
| 69 |
+ (parse-ini file))))) |
|
| 70 |
+ |
|
| 71 |
+(defmethod aws-sdk/credentials/base:retrieve ((provider fwoar-provider)) |
|
| 72 |
+ (with-slots (retrievedp file) provider |
|
| 73 |
+ (setf retrievedp nil) |
|
| 74 |
+ (let ((section (read-credentials provider))) |
|
| 75 |
+ (when section |
|
| 76 |
+ (setf retrievedp t) |
|
| 77 |
+ (aws-sdk:make-credentials |
|
| 78 |
+ :access-key-id (gethash "aws_access_key_id" section) |
|
| 79 |
+ :secret-access-key (gethash "aws_secret_access_key" section) |
|
| 80 |
+ :session-token (gethash "aws_session_token" section) |
|
| 81 |
+ :provider-name "fwoar-provider"))))) |
|
| 82 |
+ |
|
| 83 |
+(defun make-aws-session () |
|
| 84 |
+ (let ((aws-sdk/credentials::*chained-providers* |
|
| 85 |
+ (list* (make-instance 'fwoar-provider) |
|
| 86 |
+ aws-sdk/credentials::*chained-providers*))) |
|
| 87 |
+ (aws:make-session :credentials (aws:default-aws-credentials)))) |