Commits

Anonymous committed 93ed40b

Beginnings of an EC2 service. Can only list regions, zones, and instances atm

  • Participants
  • Parent commits 68b5264

Comments (0)

Files changed (4)

    )
   )
 
+(defclass ec2-request ()
+  (
+   (region
+    :initform nil
+    :initarg :region
+    :accessor region-for
+    )
+   )
+  )
+
 (defgeneric make-request (a-service a-request-type)
   (:documentation
     "Create a new request for the service
   (:method ((some-request s3-request))
     'ironclad:sha1
     )
+  (:method ((some-request ec2-request))
+    'ironclad:sha256
+    )
   )
 
 (defgeneric add-parameter (some-request parameter-name parameter-value)
   (add-parameter some-request "Timestamp" (aws-timestamp))
   )
 
+(defmethod initialize-instance ((some-request ec2-request) &key )
+  (call-next-method)
+  (add-parameter some-request "Action" (default-action some-request))
+  (add-parameter some-request "AWSAccessKeyId" (access-key-id *credentials*))
+  (add-parameter some-request "SignatureMethod" "HmacSHA256")
+  (add-parameter some-request "SignatureVersion" "2")
+  (add-parameter some-request "Version" (version-of (service-of some-request)))
+  (add-parameter some-request "Timestamp" (aws-timestamp))
+  )
+
 (defmethod initialize-instance ((some-request s3-request) &key )
   (call-next-method)
   (add-header some-request "Date" (aws-date))
       )  
   )
 
+(defmethod endpoint-of ((some-request ec2-request))
+  (if (region-for some-request)
+      (region-for some-request)
+      (call-next-method)
+      )  
+  )
+
 (defgeneric http-host-header (some-request)
   (:method ((some-request request))
     (endpoint-of some-request)
                                )
                              )
                            )
-                          )
+	      )
             )
-     (detokenize joined-pairs "&")
-     )
+      (detokenize joined-pairs "&")
+      )
     )
   (:method ((some-request sqs-request))
     ( let* ( 
                                )
                              )
                            )
-                          )
+	      )
             )
-     (detokenize joined-pairs "&")
-     )
+      (detokenize joined-pairs "&")
+      )
+    )
+  (:method ((some-request ec2-request))
+    ( let* ( 
+            (sorted-parameters (sorted-parameters some-request))
+            (joined-pairs (map-name-value-pairs 
+                           sorted-parameters
+                           (lambda (n v) 
+                             (with-output-to-string (os)
+                               (format os "~a=~a" n (url-encode v))
+                               )
+                             )
+                           )
+	      )
+            )
+      (detokenize joined-pairs "&")
+      )
     )
   )
 
 
 (defgeneric request-string-to-sign (some-request)
   (:documentation
-    "String representation of request prepared for signing
+   "String representation of request prepared for signing
     "
-    )
+   )
   (:method ((some-request db-request))
     (format-string "~a~%~a~%~a~%~a"
                    (http-verb some-request)
                    (canonical-query-string some-request)
                    )
     )
-    (:method ((some-request s3-request))
+  (:method ((some-request s3-request))
     (if (has-amz-headers-p some-request)
         (format-string "~a~%~a~%~a~%~a~%~a~%~a"
                        (http-verb some-request)
                        )
         )
     )
+  (:method ((some-request ec2-request))
+    (format-string "~a~%~a~%~a~%~a"
+                   (http-verb some-request)
+                   (http-host-header some-request)
+                   (uri-of some-request)
+                   (canonical-query-string some-request)
+                   )
+    )
   )
 
 (defgeneric request-signature (some-request)
           (sorted-parameters some-request)
           )
     )
+  (:method ((some-request ec2-request))
+    (cons (cons "Signature" (request-signature some-request))
+          (sorted-parameters some-request)
+          )
+    )
   )
 
 (defgeneric additional-headers-of (some-request)
 
 (defgeneric extract-result (some-service some-request some-response)
   (:documentation
-    "
+   "
     ")
   (:method (
             (some-service service) 
           )
       (if some-format
           (find-responses (response-body some-response) 
-                    some-format
-                    )
+			  some-format
+			  )
           (response-values some-response)
           )
       )
           )
       (if some-format
           (find-responses (response-body some-response) 
-                    some-format
-                    )
+			  some-format
+			  )
           (response-values some-response)
           )
       )
             )
     (bytes-to-string (response-body some-response))
     )
+  (:method (
+            (some-service service) 
+            (some-request ec2-request) 
+            some-response
+            ) 
+    (let ( 
+          (some-format (result-format some-request))
+          )
+      (if some-format
+          (find-responses (response-body some-response) 
+			  some-format
+			  )
+          (response-values some-response)
+          )
+      )
+    )
   )
 
 (defgeneric error-format (some-request)
+(in-package :hh-aws)
+
+(export
+ (list
+
+  'ec2-list-regions
+  'ec2-list-availability-zones
+  'ec2-list-instances
+
+  )
+ )
+
+(defservice ec2
+  :endpoint ( 
+	     ;; TODO hmm, ec2 has multiple, region-specific endpoints
+	     ;; ec2.us-east-1.amazonaws.com
+	     ;; ec2.us-west-1.amazonaws.com
+	     ;; ec2.eu-west-1.amazonaws.com
+	     ;; ec2.ap-southeast-1.amazonaws.com
+             (string "ec2.amazonaws.com")
+             )
+  :version ( 
+            (string "2010-06-15") 
+            )
+  )
+
+ (defrequest ec2-list-regions
+  :documentation "List all regions"
+  :bases (ec2-request)
+  :service ec2
+  :action ( 
+           (string "DescribeRegions")
+           )
+  )
+
+(defxmlparser ec2-instances-parser builder
+  :enter (
+          (call-next-method)
+          )
+  :text (
+         (if (path-p '("reservationSet" "item" "instancesSet" "item" "instanceId"))
+             (progn
+               (putend text-string (current-of handler) )
+               )
+             )
+         (call-next-method)
+         )
+  ;; :exit (
+  ;;        (if (path-p '("Contents"))
+  ;;            (progn
+  ;;              (putend (current-of handler) (results-of handler) )
+  ;;              (setf (current-of handler) nil)
+  ;;              )
+  ;;            )
+  ;;        (call-next-method)
+  ;;        )
+  :finish (
+           (results-of handler)
+           )
+  )
+
+(defrequest ec2-list-availability-zones
+  :documentation "List all availability zones"
+  :bases (ec2-request)
+  :service ec2
+  :action ( 
+           (string "DescribeAvailabilityZones")
+           )
+  :result-format (
+                  `(
+                    "zoneName"
+		    "zoneState"
+		    "regionName"
+		    "messageSet"
+                    )
+                  )
+
+  )
+
+(defrequest ec2-list-instances
+  :documentation "List all regions"
+  :bases (ec2-request)
+  :service ec2
+  :action ( 
+           (string "DescribeInstances")
+           )
+  :args (
+	 region-name
+	 )
+  :call (
+         (setf (region-for some-request) region-name)
+         (call-next-method)
+         )
+  :result-format (
+                  `(
+                    "instanceId"
+		    "imageId"
+		    ;; "instanceState"
+		    "privateDnsName"
+		    "dnsName"
+		    ;; "reason"
+		    "keyName"
+		    "amiLaunchIndex"
+		    ;; "productCodes"
+		    "instanceType"
+		    "launchTime"
+		    ;; "placement"
+		    "kernelId"
+		    ;; "monitoring"
+		    "privateIpAddress"
+		    "ipAddress"
+		    "architecture"
+		    "rootDeviceType"
+		    ;; "blockDeviceMapping"
+		    "virtualizationType"
+                    )
+                  )
+  :result (
+	   (call-next-method)
+	   )
+    )
+
+;; <amiLaunchIndex>0</amiLaunchIndex>
+;; <productCodes/>
+;; <instanceType>m1.small</instanceType>
+;; <launchTime>2010-07-13T13:25:38.000Z</launchTime>
+;; <placement>
+;;     <availabilityZone>us-east-1a</availabilityZone>
+;;     <groupName/>
+;; </placement>
+;; <kernelId>aki-754aa41c</kernelId>
+;; <monitoring>
+;;     <state>disabled</state>
+;; </monitoring>
+;; <privateIpAddress>10.241.22.16</privateIpAddress>
+;; <ipAddress>75.101.150.79</ipAddress>
+;; <architecture>i386</architecture>
+;; <rootDeviceType>instance-store</rootDeviceType>
+;; <blockDeviceMapping/>
+;; <virtualizationType>paravirtual</virtualizationType>
+
                (:file "simpledb" :depends-on ("common"))
                (:file "s3" :depends-on ("common"))
                (:file "sqs" :depends-on ("common"))
+               (:file "ec2" :depends-on ("common"))
 	       
                )
   :depends-on (
          (setf (bucket-object-for some-request) object-name)
          
 	 (call-next-method)
-         ;; (handler-bind 
-         ;;  (
-         ;;   (aws-error #'(lambda (e)
-         ;;                  (cout "Response is ~a~%"
-         ;;                        (bytes-to-string 
-         ;;                         (response-body (error-response e))
-         ;;                         )
-         ;;                        )
-         ;;                  ) 
-         ;;              )
-         ;;   )
-         ;;  (call-next-method)
-         ;;  )
          )
   :result (
            (response-body some-response)
          (setf (bucket-object-for some-request) object-name)
          
           (call-next-method)
-         ;; (handler-bind 
-         ;;  (
-         ;;   (aws-error #'(lambda (e)
-         ;;                  (cout "Response is ~a~%"
-         ;;                        (bytes-to-string 
-         ;;                         (response-body (error-response e))
-         ;;                         )
-         ;;                        )
-         ;;                  ) 
-         ;;              )
-         ;;   )
-         ;;  (call-next-method)
-         ;;  )
          )
   :result (
            t