Added git reference, other changes for package release.
[Net-Amazon-S3-Policy.git] / lib / Net / Amazon / S3 / Policy.pm
blob3cffc922f8d9230d60c018ad2243013d5bf726b7
1 package Net::Amazon::S3::Policy;
3 use version; our $VERSION = qv('0.1.0');
5 use warnings;
6 use strict;
7 use Carp;
8 use English qw( -no_match_vars );
9 use JSON;
11 use Exporter qw( import );
12 our @EXPORT_OK = qw( exact starts_with range );
13 our %EXPORT_TAGS = (
14 all => \@EXPORT_OK,
17 # Module implementation here
18 sub new {
19 my $class = shift;
20 my %args = ref($_[0]) ? %{$_[0]} : @_;
21 my $self = bless {}, $class;
23 if ($args{json}) {
24 $self->parse($args{json});
26 else {
27 $self->expiration($args{expiration}) if defined $args{expiration};
28 $self->conditions([]);
29 $self->add($_) for @{$args{conditions} || []};
32 return $self;
33 } ## end sub new
35 # Accessors
36 sub expiration {
37 my $self = shift;
38 my $previous = $self->{expiration};
39 if (@_) {
40 my $time = shift;
41 if ($time && $time =~ /\A \d+ \z/mxs) {
42 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
43 gmtime($time);
44 $time = sprintf "%04d-%02d-%02dT%02d:%02d:%02d.000Z", $year + 1900,
45 $mon + 1, $mday, $hour, $min, $sec;
47 $time ? ($self->{expiration} = $time) : delete $self->{expiration};
49 return $previous;
52 sub conditions {
53 my $self = shift;
54 my $previous = $self->{conditions};
56 if (@_) {
57 $self->{conditions} = (scalar(@_) == 1) ? shift : [ @_ ];
60 return $previous;
63 { # try to understand rules
64 my @DWIMs = (
65 sub {
66 return unless m{\A\s* (\S+?) \s* \* \s*\z}mxs;
67 return starts_with($1, '');
69 sub {
70 return unless m{\A\s* (\S+) \s+ eq \s+ (.*?) \s*\z}mxs;
71 return ($2 eq '*') ? starts_with($1, '') : exact($1, $2);
73 sub {
74 return
75 unless
76 m{\A\s* (\S+) \s+ (?: ^ | starts[_-]?with) \s+ (.*?) \s*\z}mxs;
77 return starts_with($1, $2);
79 sub {
80 return unless m{\A\s* (\d+) \s*<=\s* (\S+) \s*<=\s* (\d+) \s*\z}mxs;
81 my ($min, $value, $max) = ($1, $2, $3);
82 s{_}{}g for $min, $max;
83 return range($value, $min, $max);
87 sub _resolve_rule {
88 local $_ = shift;
89 for my $tester (@DWIMs) {
90 if (my $retval = $tester->()) {
91 return $retval;
94 croak "could not understand '$_', bailing out";
95 } ## end sub _resolve_rule
98 sub add {
99 my ($self, $condition) = @_;
100 push @{$self->conditions()}, ref($condition) ? $condition : _resolve_rule($condition);
101 } ## end sub add
103 sub remove {
104 my ($self, $condition) = @_;
105 $condition = _resolve_rule($condition) unless ref $condition;
106 my $conditions = $self->conditions();
107 my @filtered = grep {
108 my $keep;
109 if (@$condition != @$_) { # different lengths => different
110 $keep = 1;
112 else {
113 for my $i (0 .. $#$condition) {
114 last if $keep = $condition->[$i] ne $_->[$i];
117 $keep;
118 } @$conditions;
119 $self->conditions(\@filtered);
120 return;
121 } ## end sub remove
123 sub exact {
124 shift if ref $_[0];
125 my ($target, $value) = @_;
126 return ['eq', $target, $value];
129 sub starts_with {
130 shift if ref $_[0];
131 my ($target, $value) = @_;
132 return ['starts-with', $target, $value];
135 sub range {
136 shift if ref $_[0];
137 my ($target, $min, $max) = @_;
138 return [$target, $min, $max];
141 sub json {
142 my $self = shift;
143 my %params = %$self;
144 delete $params{expiration} unless defined $params{expiration};
145 return to_json(\%params);
148 sub base64 { return _encode_base64($_[0]->json()); }
151 no warnings;
152 *stringify = \&json;
153 *json_base64 = \&base64;
154 *stringify_base64 = \&base64;
157 sub parse {
158 my ($self, $json) = @_;
160 $json = _decode_base64($json)
161 unless substr($json, 0, 1) eq '{';
163 my %decoded = %{ from_json($json) };
164 $self->{conditions} = [ map {
165 if (ref($_) eq 'ARRAY') {$_}
166 else { [ 'eq', %$_ ] }
167 } @{$decoded{conditions}} ];
168 $self->{expiration} = $decoded{expiration};
170 return $self;
173 sub signature {
174 my ($self, $key) = @_;
175 require Digest::HMAC_SHA1;
176 return hmac_sha1($self->base64(), $key);
179 sub signature_base64 {
180 my ($self, $key) = @_;
181 return _encode_base64($self->signature($key));
184 sub _decode_base64 {
185 require MIME::Base64;
186 no warnings 'redefine';
187 *_decode_base64 = \&MIME::Base64::decode_base64;
188 goto \&MIME::Base64::decode_base64;
191 # Wrapper around base64 encoder, ensuring that there's no newline
192 # to make AWS S3 happy
193 sub _encode_base64 {
194 require MIME::Base64;
195 (my $retval = MIME::Base64::encode_base64($_[0])) =~ s/\n//gmxs;
196 return $retval;
200 1; # Magic true value required at end of module
201 __END__
203 =head1 NAME
205 Net::Amazon::S3::Policy - manage Amazon S3 policies for HTTP POST forms
207 =head1 VERSION
209 This document describes Net::Amazon::S3::Policy version 0.1.0. Most likely, this
210 version number here is outdate, and you should peek the source.
213 =head1 SYNOPSIS
215 use Net::Amazon::S3::Policy;
217 # Expire in one hour
218 my $policy = Net::Amazon::S3::Policy->new(expiration => time() + 3600);
220 # Do What I Mean handling of conditions
221 # Note: single quotes, $key is not a Perl variable in this example!
222 $policy->add('$key eq path/to/somewhere');
223 $policy->add('x-some-field starts-with some-prefix');
224 $policy->add(' 0 <= content-length-range <= 1_000_000 ');
225 $policy->add('whatever *'); # any value admitted for field 'whatever'
227 # NON-DWIM interface for conditions
228 use Net::Amazon::S3::Policy qw( :all ); # OR
229 use Net::Amazon::S3::Policy qw( exact starts_with range );
230 $policy->add(exact('field', 'whatever spaced value ');
231 $policy->add(starts_with('other-field', ' yadda ');
232 $policy->add(range('percentual', 0, 100));
234 # The output as JSON
235 print $policy->stringify(), "\n"; # OR
236 print $policy->json(), "\n";
238 # Where the stuff is really needed: HTML FORMs for HTTP POSTs
239 my $policy_for_form = $policy->base64();
240 my $signature_for_form = $policy->signature_base64($key);
242 # If you ever receive a policy...
243 my $received = Net::Amazon::S3::Policy->new(json => $json_text);
244 my $rec2 = Net::Amazon::S3::Policy->new();
245 $rec2->parse($json_base64); # either JSON or its Base64 encoding
248 =head1 DESCRIPTION
250 Net::Amazon::S3::Policy gives you an object-oriented interface to
251 manage policies for Amazon S3 HTTP POST uploads.
253 Amazon S3 relies upon either a REST interface (see L<Net::Amazon::S3>)
254 or a SOAP one; as an added service, it is possible to give access to
255 the upload of resources using HTTP POSTs that do not involve using
256 any of these two interfaces, but a single HTML FORM. The rules you
257 have to follow are explained in the Amazon S3 Developer Guide.
259 More or less, it boils down to the following:
261 =over
263 =item *
265 if the target bucket is not writeable by the anonymous group, you'll need
266 to set an access policy;
268 =item *
270 almost every field in the HTML FORM that will be used to build up the HTTP POST
271 message by the browser needs to be included into a I<policy>, and the policy
272 has to be sent along within the HTTP POST
274 =item *
276 together with the I<policy>, also the bucket owner's AWS ID (the public one) has to
277 be sent, together with a digital signature of the policy that has to be created
278 using the bucket owner's AWS secret key.
280 =back
282 So, you'll have to add three fields to the HTTP POST in order for it to comply
283 with Amazon's requirement when the bucket is not publicly writeable:
285 =over
287 =item C<AWSAccessKeyId>
289 given "as-is", i.e. as you copied from your account in Amazon Web Services;
291 =item C<policy>
293 given as a JSON document that is Base64 encoded;
295 =item C<signature>
297 calculated as a SHA1-HMAC of the Base64-encoded policy, using your secret
298 key as the signature key, and then encoded with Base64.
300 =back
302 This module lets you manage the build-up of a policy document, providing you
303 with tools to get the Base64 encoding of the resulting JSON policy document,
304 and to calculate the Base64 encoding of the signature. See L</Example> for
305 a complete example of how to do this.
307 In addition to I<policy synthesis>, the module is also capable of parsing
308 some policy (base64-encoded or not, but in JSON format). This shouldn't
309 be a need in general... possibly for debug reasons.
311 =head2 Example
313 For example, suppose that you have the following HTML FORM to allow selected
314 uploads to the C<somebucket> bucket (see the Amazon S3 Developer Guide for
315 details about writing the HTML FORM):
317 <form action="http://somebucket.s3.amazonaws.com/" method="post"
318 enctype="multipart/form-data">
319 <!-- inputs needed because bucket is not publicly writeable -->
320 <input type="hidden" name="AWSAccessKeyId" value="your-ID-here">
321 <input type="hidden" name="policy" value="base64-encoded-policy">
322 <input type="hidden" name="signature" value="base64-encoded-signature">
324 <!-- input needed by AWS-S3 logic: there MUST be a key -->
325 <input type="hidden" name="key" value="/restricted/${filename}">
327 <!-- inputs that you want to include in your form -->
328 <input type="hidden" name="Content-Type" value="image/jpeg">
329 <label for="colour">Colour</label>
330 <input type="text" id="colour" name="x-amz-meta-colour" value="green">
332 <!-- input needed to have something to upload. LAST IN FORM! -->
333 <input type="file" id="file" name="file">
334 </form>
336 You need to include the following elements in your policy:
338 =over
340 =item *
342 C<key>
344 =item *
346 C<Content-Type>
348 =item *
350 C<x-amz-meta-colour>
352 =back
354 Your policy can then be built like this:
356 my $policy = Net::Amazon::S3::Policy->new(
357 expiration => time() + 60 * 60, # one-hour policy
358 conditions => [
359 '$key starts-with /restricted/', # restrict to here
360 'Content-Type starts-with image/', # accept any image format
361 'x-amz-meta-colour *', # accept any colour
365 # Put this as the value for "policy",
366 # instead of "base64-encoded-policy"
367 my $policy_for_form = $policy->base64();
369 # Put this as the value for "signature",
370 # instead of "base64-encoded-signature"
371 my $signature_for_form = $policy->signature_base64();
373 =head1 INTERFACE
375 =head2 Module Interface
377 =over
379 =item B<< new (%args) >>
381 =item B<< new (\%args) >>
383 constructor to create a new Net::Amazon::S3::Policy object.
385 Arguments can be passed either as a single hash reference, or
386 as a hash. Choose whatever you like most.
388 Recognised keys are:
390 =over
392 =item expiration
394 the expiration date for this policy.
396 =item conditions
398 a list of conditions to initialise the object. This should
399 point to an array with the conditions, that will be passed through
400 the L</add> method.
402 =item json
404 a piece of JSON text to parse the configuration from. The presence
405 of this parameter overrides the other two.
407 =back
409 =item B<< expiration () >>
411 =item B<< expiration ($time) >>
413 get/set the expiration time for the condition. Set to a false value
414 to remove the expiration time from the policy.
416 You should either pass an ISO8601 datetime string, or an epoch value.
417 You'll always get an ISO8601 string back.
419 =item B<< conditions () >>
421 =item B<< conditions (@conditions) >>
423 =item B<< conditions (\@conditions) >>
425 get/set the conditions in the policy. You should never need to use this
426 method, because the L</add> and L</remove> are there for you to interact
427 with this member. If you want to use this, anyway, be sure to take
428 a look to the functions in L</Convenience Condition Functions>.
430 =item B<< add ($spec) >>
432 add a specification to the list of conditions.
434 A specification can be either an ARRAY reference, or a textual one:
436 =over
438 =item *
440 if you pass an ARRAY reference, it should be something like the one
441 returned by any of the functions in L</Convenience Condition Functions>;
443 =item *
445 othewise, it can be a string with a single condition, like the following
446 examples:
448 some-field eq some-value
449 some-other-field starts-with /path/to/somewhere/
450 10 <= numeric-value <= 1000
452 Note that the string specification is less "strict" in checking its
453 parameters; in particular, you should stick to the ARRAY reference if
454 your parameters have a space inside. You can use the following formats:
456 =over
458 =item C<< <name> eq <value> >>
460 set a name to have a given value, exactly;
462 =item C<< <name> starts-with <prefix> >>
464 =item C<< <name> starts_with <prefix> >>
466 =item C<< <name> ^ <prefix> >>
468 set the prefix that has to be matched against the value
469 for the field with the given name. If the prefix is left
470 empty, every possible value will be admitted;
472 =item C<< <name> * >>
474 admit any value for the given field, just like setting an empty
475 value for a C<starts-with> rule;
477 =item C<< <min> <= <name> <= <max> >>
479 set an allowable range for the given field.
481 =back
483 =back
485 =item B<< remove ($spec) >>
487 remove a condition in the list of conditions. The parameter is
488 regarded exactly as in L</add>; once it is found, the list of
489 conditions will be filtered to exclude that particular
490 condition, exactly.
492 =item B<< json () >>
494 =item B<< stringify () >>
496 get a textual version of the object, in JSON format. This is the
497 base format used to interact with Amazon S3.
499 =item B<< base64 () >>
501 =item B<< json_base64 () >>
503 =item B<< stringify_base64 () >>
505 get a textual version of the object, as a Base64 encoding of the
506 JSON representation (see L</json>). This is what should to be put
507 as C<policy> field in the POST form.
510 =item B<< parse ($json_text) >>
512 parse a JSON representation of a policy and fill in the object. This
513 is the opposite of L</json>.
516 =item B<< signature ($key) >>
518 get the signature for the Base 64 encoding of the JSON representation of
519 the policy. The signature is the SHA1-HMAC digital signature, with the
520 given key.
523 =item B<< signature_base64 ($key) >>
525 get the Base64 encoding of the signature, as given by L</signature>. This
526 is the value that should be put in the C<signature> field in the POST
527 form.
529 =back
531 =head2 Convenience Condition Functions
533 The following functions can be optionally imported from the
534 module, and can be used indifferently as class/instance
535 methods or as functions.
537 =over
539 =item B<< exact ($target, $value) >>
541 produce an I<exact value> condition. This condition is an array
542 reference with the following elements:
544 =over
546 =item *
548 the C<eq> string;
550 =item *
552 the I<name> of the field;
554 =item *
556 the I<value> that the field should match exactly.
558 =back
560 =item B<< starts_with ($target, $value) >>
562 produce a I<starts-with> condition. This condition is an array
563 reference with the following elements:
565 =over
567 =item *
569 the C<starts-with> string;
571 =item *
573 the I<name> of the field;
575 =item *
577 the I<prefix> that has to be matched by the field's value
579 =back
581 =item B<< range ($target, $min, $max) >>
583 produce a I<value range> condition. This condition is an array
584 reference with the following elements:
586 =over
588 =item *
590 the I<name> of the field;
592 =item *
594 the I<minimum> value allowed for the field's value;
596 =item *
598 the I<maximum> value allowed for the field's value;
600 =back
602 =back
604 =head1 DIAGNOSTICS
607 =over
609 =item C<< could not understand '%s', bailing out >>
611 The L</add> and L</remove> function try their best to understand
612 a condition when given in string form... but you should really
613 stick to the format given in the documentation!
615 =back
618 =head1 CONFIGURATION AND ENVIRONMENT
620 Net::Amazon::S3::Policy requires no configuration files or environment variables.
623 =head1 DEPENDENCIES
625 The C<version> pragma (which has been included in Perl 5.10) and the
626 L</JSON> module.
629 =head1 INCOMPATIBILITIES
631 None reported.
634 =head1 BUGS AND LIMITATIONS
636 No bugs have been reported.
638 Please report any bugs or feature requests through http://rt.cpan.org/
641 =head1 AUTHOR
643 Flavio Poletti C<< <flavio [at] polettix [dot] it> >>
646 =head1 LICENCE AND COPYRIGHT
648 Copyright (c) 2008, Flavio Poletti C<< <flavio [at] polettix [dot] it> >>. All rights reserved.
650 This module is free software; you can redistribute it and/or
651 modify it under the same terms as Perl 5.8.x itself. See L<perlartistic>
652 and L<perlgpl>.
654 Questo modulo è software libero: potete ridistribuirlo e/o
655 modificarlo negli stessi termini di Perl 5.8.x stesso. Vedete anche
656 L<perlartistic> e L<perlgpl>.
659 =head1 DISCLAIMER OF WARRANTY
661 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
662 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
663 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
664 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
665 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
666 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
667 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
668 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
669 NECESSARY SERVICING, REPAIR, OR CORRECTION.
671 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
672 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
673 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
674 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
675 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
676 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
677 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
678 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
679 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
680 SUCH DAMAGES.
682 =head1 NEGAZIONE DELLA GARANZIA
684 Poiché questo software viene dato con una licenza gratuita, non
685 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
686 dalle leggi applicabili. A meno di quanto possa essere specificato
687 altrove, il proprietario e detentore del copyright fornisce questo
688 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
689 o implicita, includendo fra l'altro (senza però limitarsi a questo)
690 eventuali garanzie implicite di commerciabilità e adeguatezza per
691 uno scopo particolare. L'intero rischio riguardo alla qualità ed
692 alle prestazioni di questo software rimane a voi. Se il software
693 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
694 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
696 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
697 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
698 di copyright, o qualunque altra parte che possa modificare, o redistribuire
699 questo software così come consentito dalla licenza di cui sopra, potrà
700 essere considerato responsabile nei vostri confronti per danni, ivi
701 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
702 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
703 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
704 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
705 sostenute da voi o da terze parti o un fallimento del software ad
706 operare con un qualsivoglia altro software. Tale negazione di garanzia
707 rimane in essere anche se i dententori del copyright, o qualsiasi altra
708 parte, è stata avvisata della possibilità di tali danneggiamenti.
710 Se decidete di utilizzare questo software, lo fate a vostro rischio
711 e pericolo. Se pensate che i termini di questa negazione di garanzia
712 non si confacciano alle vostre esigenze, o al vostro modo di
713 considerare un software, o ancora al modo in cui avete sempre trattato
714 software di terze parti, non usatelo. Se lo usate, accettate espressamente
715 questa negazione di garanzia e la piena responsabilità per qualsiasi
716 tipo di danno, di qualsiasi natura, possa derivarne.
718 =cut