redirects.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 ;;;; redirects.lisp
  29
  30 (in-package #:zs3)
  31
  32 (defvar *permanent-redirects*
  33   (make-hash-table :test 'equalp)
  34   "Some bucket operations make permanent redirects to different
  35 endpoints. This table stores access-key/bucket redirects for use when
  36 creating requests.")
  37
  38 (defun redirect-key (endpoint bucket &key
  39                      ((:credentials *credentials*) *credentials*))
  40   (list endpoint bucket (access-key *credentials*)))
  41
  42
  43 (defun redirected-endpoint (endpoint bucket &key
  44                             ((:credentials *credentials*) *credentials*))
  45   (gethash (redirect-key endpoint bucket) *permanent-redirects* endpoint))
  46
  47 (defun (setf redirected-endpoint) (new-value endpoint bucket &key
  48                                    ((:credentials *credentials*) *credentials*))
  49   (let ((key (redirect-key endpoint bucket)))
  50     (if (not new-value)
  51         (progn (remhash key *permanent-redirects*) new-value)
  52         (setf (gethash key *permanent-redirects*) new-value))))
  53
  54 (defun clear-redirects ()
  55   (clrhash *permanent-redirects*))
  56