Permalink
Browse files

Missing files .. oops

  • Loading branch information...
1 parent a35370c commit 478d98da1300065b34ebd02a0a4f97ab580fc4fa @RobBlackwell committed Feb 2, 2012
Showing with 203 additions and 0 deletions.
  1. +30 −0 acs.lisp
  2. +52 −0 handlers.lisp
  3. +69 −0 manage.lisp
  4. +52 −0 tests.lisp
View
@@ -0,0 +1,30 @@
+;;;; acs.lisp
+;;;; Copyright (c) 2012, Rob Blackwell. All rights reserved.
+
+(in-package :cl-azure)
+
+;; Experimental support for the Access Control Service
+
+;; http://msdn.microsoft.com/en-us/library/windowsazure/ee706734.aspx
+
+(defparameter *plaintext-token-request-body-template*
+"
+wrap_scope=~a&
+wrap_name=~a&
+wrap_password=~a
+")
+
+;; Not yet working?
+
+(defun plaintext-token-request (wrap-scope wrap-name wrap-password &key (handler #'identity))
+ ""
+ (funcall handler
+ (web-request (list
+ :method :post
+ :uri (format nil "https://robblackwell.accesscontrol.windows.net/WRAPv0.9/")
+ :body (format nil *plaintext-token-request-body-template*
+ wrap-scope wrap-name (base64:string-to-base64-string wrap-password))
+ :headers (acons "Content-type" "application/x-www-form-urlencoded" nil)))))
+
+
+
View
@@ -0,0 +1,52 @@
+;;;; handlers.lisp
+;;;; Copyright (c) 2011 - 2012, Rob Blackwell. All rights reserved.
+
+(in-package #:cl-azure)
+
+;; Commonly used functions for processing HTTP responses.
+
+(defun windows-azure-error (response)
+ "Raises an error using the Message from the response body."
+ (error (extract-named-elements (response-body response) "Message")))
+
+(defun get-body-handler (response)
+ "Returns the response body if the HHTP status is ok, otherwise raises an error."
+ (if (eq (response-status response) +http-ok+)
+ (response-body response)
+ (windows-azure-error response)))
+
+(defun get-headers-handler (response)
+ "Returns the respone headers if the HTTP status is ok, otherwise raises an error."
+ (if (eq (response-status response) +http-ok+)
+ (response-headers response)
+ (windows-azure-error response)))
+
+(defun list-name-elements-handler (response)
+ "Returns a list of the elements named Name if the HTTP status is ok, otherwise raises an error."
+ (if (eq (response-status response) +HTTP-OK+)
+ (extract-named-elements (response-body response) "Name")
+ (windows-azure-error response)))
+
+(defun created-handler (response)
+ "Returns true if the HTTP response is ok, otheriwse raises an error."
+ (if (eq (response-status response) +http-created+)
+ t
+ (windows-azure-error response)))
+
+(defun accepted-handler (response)
+ "Returns true if the HTTP response is accepted, otheriwse raises an error."
+ (if (eq (response-status response) +http-accepted+)
+ t
+ (windows-azure-error response)))
+
+(defun no-content-handler (response)
+ "Returns true if the HTTP response is no-content, otheriwse raises an error."
+ (if (eq (response-status response) +http-no-content+)
+ t
+ (windows-azure-error response)))
+
+(defun ensure-created-handler (response)
+ "returns true if the HTTP response is created, otheriwse raises an error."
+ (if (member (response-status response) (list +http-created+ +http-conflict+))
+ t
+ (windows-azure-error response)))
View
@@ -0,0 +1,69 @@
+;;;; manage.lisp
+;;;; Copyright (c) 2012, Rob Blackwell. All rights reserved.
+
+(in-package #:cl-azure)
+
+;; Experimental
+;; The Windows Azure Service Management API is a REST API for managing your services and deployments.
+;; See http://msdn.microsoft.com/en-us/library/windowsazure/ee460799.aspx
+
+(defconstant +service-management-version+ "2011-02-25")
+
+(defparameter *subscription-id* "YOUR_SUBSCRIPTION_ID")
+
+(defparameter *management-certificate* (list
+ :certificate "~/YOUR_CERTIFICATE.pfx.pem"
+ :key "~/YOUR_CERTIFICATE.pfx.pem"
+ :pass-phrase "YOUR_PASSWORD"))
+
+(defun management-request (method resource &key (content nil)
+ (management-certificate *management-certificate*)
+ (handler #'identity))
+ "Makes an HTTP request to the Windows Azure Service Management API"
+ (let ((headers (list (cons "x-ms-version" +service-management-version+))))
+ (funcall handler
+ (web-request (list
+ :certificate management-certificate
+ :method method
+ :uri resource
+ :content content
+ :content-type "application/xml"
+ :headers headers)))))
+
+(defun list-service-name-elements-handler (response)
+ "Returns a list of the elements named ServiceName if the HTTP status is ok, otherwise raises an error."
+ (if (eq (response-status response) +HTTP-OK+)
+ (extract-named-elements (response-body response) "ServiceName")
+ (windows-azure-error response)))
+
+(defun list-storage-accounts (&key (subscription-id *subscription-id*)
+ (management-certificate *management-certificate*)
+ (handler #'list-service-name-elements-handler))
+ "Lists the storage accounts available for a subscription."
+ (management-request :get (format nil "https://management.core.windows.net/~a/services/storageservices" subscription-id)
+ :management-certificate management-certificate
+ :handler handler))
+
+(defun list-hosted-services ( &key (subscription-id *subscription-id*)
+ (management-certificate *management-certificate*)
+ (handler #'list-service-name-elements-handler))
+ "Lists the hosted services available for a subscription."
+ (management-request :get (format nil "https://management.core.windows.net/~a/services/hostedservices" subscription-id)
+ :management-certificate management-certificate
+ :handler handler))
+
+(defun list-thumbprint-elements-handler (response)
+ "Returns a list of the elements named ServiceName if the HTTP status is ok, otherwise raises an error."
+ (if (eq (response-status response) +HTTP-OK+)
+ (extract-named-elements (response-body response) "Thumbprint")
+ (windows-azure-error response)))
+
+(defun list-certificates (service-name &key (subscription-id *subscription-id*)
+ (management-certificate *management-certificate*)
+ (handler #'list-thumbprint-elements-handler))
+ "Lists all certificates associated with the specified hosted service."
+ (management-request :get (format nil "https://management.core.windows.net/~a/services/hostedservices/~a/certificates"
+ subscription-id service-name)
+ :management-certificate management-certificate
+ :handler handler))
+
View
@@ -0,0 +1,52 @@
+;;;; tests.lisp
+;;;; Copyright (c) 2012, Rob Blackwell. All rights reserved.
+
+(in-package #:cl-azure)
+
+;; Unit tests
+
+(rt:deftest test-hmac-string
+ (hmac-string "GuGbCQ41a9G1vtS1/dairlSMbXhHVzoA8+VPrbWxtj94o0aoAQdsgaaoYQASWqG9mj8xDvP1hSkvSVcLC34CfA==" "Hello World")
+ "+UTfogPQ1ELBA4l+A7LwT1lbZVbP34F/CQzXaXqwfWA=")
+
+(rt:deftest test-canonicalized-headers
+ (string=
+ (canonicalized-headers (list :headers (list (cons "x-ms-version" "2009-09-19") (cons "x-ms-date" "Sun, 12 Jun 2011 10:00:45 GMT"))))
+ (concatenate 'string "x-ms-date:Sun, 12 Jun 2011 10:00:45 GMT"
+ +linefeed+
+ "x-ms-version:2009-09-19"
+ +linefeed+))
+ t)
+
+(rt:deftest test-canonicalized-resource-1
+ (string=
+ (canonicalized-resource-1 (list :account (list :account-name "myaccount")
+ :uri "https://myaccount.blob.core.windows.net/mycontainer?restype=container&comp=metadata"))
+ (concatenate 'string "/myaccount/mycontainer"
+ +linefeed+ "comp:metadata"
+ +linefeed+ "restype:container"))
+ t)
+
+(rt:deftest test2-canonicalized-resource-1
+ (string=
+ (canonicalized-resource-1 (list :account (list :account-name "myaccount") :uri "https://myaccount.blob.core.windows.net/?comp=list"))
+ (concatenate 'string "/myaccount/"
+ +linefeed+ "comp:list"))
+ t)
+
+(rt:deftest test-query-tables
+ (> (length (query-tables)) 0)
+ t)
+
+(rt:deftest test-list-containers
+ (> (length (list-containers)) 0)
+ t)
+
+(rt:deftest test-list-queues
+ (> (length (list-queues)) 0)
+ t)
+
+(rt:deftest test-list-hosted-services
+ (> (length (list-hosted-services)) 0)
+ t)
+

0 comments on commit 478d98d

Please sign in to comment.