post.lisp

   1 ;;;;
   2 ;;;; Copyright (c) 2008 Zachary Beane, All Rights Reserved
   3 ;;;;
   4 ;;;; Redistribution and use in source and binary forms, with or without
   5 ;;;; modification, are permitted provided that the following conditions
   6 ;;;; are met:
   7 ;;;;
   8 ;;;;   * Redistributions of source code must retain the above copyright
   9 ;;;;     notice, this list of conditions and the following disclaimer.
  10 ;;;;
  11 ;;;;   * Redistributions in binary form must reproduce the above
  12 ;;;;     copyright notice, this list of conditions and the following
  13 ;;;;     disclaimer in the documentation and/or other materials
  14 ;;;;     provided with the distribution.
  15 ;;;;
  16 ;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
  17 ;;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  18 ;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  19 ;;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
  20 ;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  21 ;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  22 ;;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  23 ;;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  24 ;;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  25 ;;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  26 ;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27 ;;;;
  28 ;;;; post.lisp
  29
  30 (in-package #:zs3)
  31
  32 (defclass post-policy ()
  33   ((expires
  34     :initarg :expires
  35     :accessor expires)
  36    (conditions
  37     :initarg :conditions
  38     :accessor conditions)))
  39
  40 (defgeneric policy-serialize (object stream))
  41
  42 (defmethod policy-serialize ((condition cons) stream)
  43   (destructuring-bind (type field value &optional value2)
  44       condition
  45     (ecase type
  46       ((:eq :starts-with)
  47        (format stream "[~S, \"$~A\", ~S]"
  48                (string-downcase type)
  49                field
  50                value))
  51       (:range
  52        (format stream "[~S, ~D, ~D]" field value value2)))))
  53
  54 (defmethod policy-serialize ((policy post-policy) stream)
  55   (format stream "{\"expiration\": ~S, \"conditions\": ["
  56           (iso8601-date-string (expires policy)))
  57   (when (conditions policy)
  58     (destructuring-bind (first &rest rest)
  59         (conditions policy)
  60       (when first
  61         (policy-serialize first stream)
  62         (dolist (condition rest)
  63           (format stream ",")
  64           (policy-serialize condition stream)))))
  65   (format stream "]}"))
  66
  67 (defun policy-string64 (policy)
  68   (string64
  69    (with-output-to-string (stream)
  70      (policy-serialize policy stream))))
  71
  72 (defun policy-signature (key policy)
  73   (sign-string key (policy-string64 policy)))
  74
  75