Merge pull request #22 from wsgac/master
[zs3.git] / redirects.lisp
blobd5098ba88060b8d04b3f0a54b1f91e95900c0b37
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
30 (in-package #:zs3)
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.")
38 (defun redirect-key (endpoint bucket &key
39 ((:credentials *credentials*) *credentials*))
40 (list endpoint bucket (access-key *credentials*)))
43 (defun redirection-data (endpoint bucket
44 &key ((:credentials *credentials*) *credentials*))
45 (gethash (redirect-key endpoint bucket) *permanent-redirects*))
47 (defun redirected-endpoint (endpoint bucket
48 &key ((:credentials *credentials*) *credentials*))
49 (or (first (redirection-data endpoint bucket)) endpoint))
51 (defun redirected-region (endpoint bucket &key
52 ((:credentials *credentials*) *credentials*))
53 (second (redirection-data endpoint bucket)))
55 (defun (setf redirection-data) (new-value endpoint bucket
56 &key ((:credentials *credentials*) *credentials*))
57 (check-type new-value list)
58 (let ((key (redirect-key endpoint bucket)))
59 (if (not new-value)
60 (progn (remhash key *permanent-redirects*) new-value)
61 (setf (gethash key *permanent-redirects*) new-value))))
63 (defun clear-redirects ()
64 (clrhash *permanent-redirects*))