1 package Net
::Amazon
::S3
::Policy
;
3 use version
; our $VERSION = qv
('0.1.1');
8 use English
qw( -no_match_vars );
11 use Exporter
qw( import );
12 our @EXPORT_OK = qw( exact starts_with range );
13 our %EXPORT_TAGS = (all
=> \
@EXPORT_OK,);
15 # Module implementation here
18 my %args = ref($_[0]) ?
%{$_[0]} : @_;
19 my $self = bless {}, $class;
22 $self->parse($args{json
});
25 $self->expiration($args{expiration
}) if defined $args{expiration
};
26 $self->conditions([]);
27 $self->add($_) for @
{$args{conditions
} || []};
36 my $previous = $self->{expiration
};
39 if ($time && $time =~ /\A \d+ \z/mxs) {
40 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
42 $time = sprintf "%04d-%02d-%02dT%02d:%02d:%02d.000Z",
44 $mon + 1, $mday, $hour, $min, $sec;
45 } ## end if ($time && $time =~ ...
46 $time ?
($self->{expiration
} = $time) : delete $self->{expiration
};
49 } ## end sub expiration
53 my $previous = $self->{conditions
};
56 $self->{conditions
} = (scalar(@_) == 1) ?
shift : [@_];
60 } ## end sub conditions
62 { # try to understand rules
65 substr($_[0], 0, 1) eq '$' ?
$_[0] : '$' . $_[0];
69 return unless m{\A\s* (\S+?) \s* \* \s*\z}mxs;
70 return starts_with
(_prepend_dollar
($1), '');
73 return unless m{\A\s* (\S+) \s+ eq \s+ (.*?) \s*\z}mxs;
75 ? starts_with
(_prepend_dollar
($1), '')
76 : exact
(_prepend_dollar
($1), $2);
81 m{\A\s* (\S+) \s+ (?: ^ | starts[_-]?with) \s+ (.*?) \s*\z}mxs;
82 return starts_with
(_prepend_dollar
($1), $2);
86 unless m{\A\s* (\d+) \s*<=\s* (\S+) \s*<=\s* (\d+) \s*\z}mxs;
87 my ($min, $value, $max) = ($1, $2, $3);
88 s{_}{}g for $min, $max;
90 # no "_prepend_dollar" for range conditions
91 return range
($value, $min, $max);
97 for my $tester (@DWIMs) {
98 if (my $retval = $tester->()) {
102 croak
"could not understand '$_', bailing out";
103 } ## end sub _resolve_rule
107 my ($self, $condition) = @_;
108 push @
{$self->conditions()},
109 ref($condition) ?
$condition : _resolve_rule
($condition);
113 my ($self, $condition) = @_;
114 $condition = _resolve_rule
($condition) unless ref $condition;
115 my $conditions = $self->conditions();
116 my @filtered = grep {
118 if (@
$condition != @
$_) { # different lengths => different
122 for my $i (0 .. $#$condition) {
123 last if $keep = $condition->[$i] ne $_->[$i];
128 $self->conditions(\
@filtered);
134 my ($target, $value) = @_;
135 return ['eq', $target, $value];
140 my ($target, $value) = @_;
141 return ['starts-with', $target, $value];
146 my ($target, $min, $max) = @_;
147 return [$target, $min, $max];
153 delete $params{expiration
} unless defined $params{expiration
};
154 return to_json
(\
%params);
157 sub base64
{ return _encode_base64
($_[0]->json()); }
162 *json_base64
= \
&base64
;
163 *stringify_base64
= \
&base64
;
167 my ($self, $json) = @_;
169 $json = _decode_base64
($json)
170 unless substr($json, 0, 1) eq '{';
172 my %decoded = %{from_json
($json)};
173 $self->{conditions
} = [
175 if (ref($_) eq 'ARRAY') { $_; }
177 my ($name, $value) = %$_;
178 ['eq', '$' . $name, $value];
180 } @
{$decoded{conditions
}}
182 $self->{expiration
} = $decoded{expiration
};
188 my ($self, $key) = @_;
189 require Digest
::HMAC_SHA1
;
190 return Digest
::HMAC_SHA1
::hmac_sha1
($self->base64(), $key);
193 sub signature_base64
{
194 my ($self, $key) = @_;
195 return _encode_base64
($self->signature($key));
199 require MIME
::Base64
;
200 no warnings
'redefine';
201 *_decode_base64
= \
&MIME
::Base64
::decode_base64
;
202 goto \
&MIME
::Base64
::decode_base64
;
203 } ## end sub _decode_base64
205 # Wrapper around base64 encoder, ensuring that there's no newline
206 # to make AWS S3 happy
208 require MIME
::Base64
;
209 (my $retval = MIME
::Base64
::encode_base64
($_[0])) =~ s/\n//gmxs;
213 1; # Magic true value required at end of module
218 Net::Amazon::S3::Policy - manage Amazon S3 policies for HTTP POST forms
222 This document describes Net::Amazon::S3::Policy version 0.1.0. Most likely, this
223 version number here is outdate, and you should peek the source.
228 use Net::Amazon::S3::Policy;
231 my $policy = Net::Amazon::S3::Policy->new(expiration => time() + 3600);
233 # Do What I Mean handling of conditions
234 # Note: single quotes, $key is not a Perl variable in this example!
235 $policy->add('$key eq path/to/somewhere');
236 # In DWIM mode, '$' are pre-pended automatically where necessary
237 $policy->add('key eq path/to/somewhere');
238 $policy->add('x-some-field starts-with some-prefix');
239 $policy->add(' 0 <= content-length-range <= 1_000_000 ');
240 $policy->add('whatever *'); # any value admitted for field 'whatever'
242 # NON-DWIM interface for conditions
243 use Net::Amazon::S3::Policy qw( :all ); # OR
244 use Net::Amazon::S3::Policy qw( exact starts_with range );
245 $policy->add(exact('$field', 'whatever spaced value ');
246 $policy->add(starts_with('$other-field', ' yadda ');
247 $policy->add(range('percentual', 0, 100));
250 print $policy->stringify(), "\n"; # OR
251 print $policy->json(), "\n";
253 # Where the stuff is really needed: HTML FORMs for HTTP POSTs
254 my $policy_for_form = $policy->base64();
255 my $signature_for_form = $policy->signature_base64($key);
257 # If you ever receive a policy...
258 my $received = Net::Amazon::S3::Policy->new(json => $json_text);
259 my $rec2 = Net::Amazon::S3::Policy->new();
260 $rec2->parse($json_base64); # either JSON or its Base64 encoding
265 Net::Amazon::S3::Policy gives you an object-oriented interface to
266 manage policies for Amazon S3 HTTP POST uploads.
268 Amazon S3 relies upon either a REST interface (see L<Net::Amazon::S3>)
269 or a SOAP one; as an added service, it is possible to give access to
270 the upload of resources using HTTP POSTs that do not involve using
271 any of these two interfaces, but a single HTML FORM. The rules you
272 have to follow are explained in the Amazon S3 Developer Guide.
274 More or less, it boils down to the following:
280 if the target bucket is not writeable by the anonymous group, you'll need
281 to set an access policy;
285 almost every field in the HTML FORM that will be used to build up the HTTP POST
286 message by the browser needs to be included into a I<policy>, and the policy
287 has to be sent along within the HTTP POST
291 together with the I<policy>, also the bucket owner's AWS ID (the public one) has to
292 be sent, together with a digital signature of the policy that has to be created
293 using the bucket owner's AWS secret key.
297 So, you'll have to add three fields to the HTTP POST in order for it to comply
298 with Amazon's requirement when the bucket is not publicly writeable:
302 =item C<AWSAccessKeyId>
304 given "as-is", i.e. as you copied from your account in Amazon Web Services;
308 given as a JSON document that is Base64 encoded;
312 calculated as a SHA1-HMAC of the Base64-encoded policy, using your secret
313 key as the signature key, and then encoded with Base64.
317 This module lets you manage the build-up of a policy document, providing you
318 with tools to get the Base64 encoding of the resulting JSON policy document,
319 and to calculate the Base64 encoding of the signature. See L</Example> for
320 a complete example of how to do this.
322 In addition to I<policy synthesis>, the module is also capable of parsing
323 some policy (base64-encoded or not, but in JSON format). This shouldn't
324 be a need in general... possibly for debug reasons.
328 For example, suppose that you have the following HTML FORM to allow selected
329 uploads to the C<somebucket> bucket (see the Amazon S3 Developer Guide for
330 details about writing the HTML FORM):
332 <form action="http://somebucket.s3.amazonaws.com/" method="post"
333 enctype="multipart/form-data">
334 <!-- inputs needed because bucket is not publicly writeable -->
335 <input type="hidden" name="AWSAccessKeyId" value="your-ID-here">
336 <input type="hidden" name="policy" value="base64-encoded-policy">
337 <input type="hidden" name="signature" value="base64-encoded-signature">
339 <!-- input needed by AWS-S3 logic: there MUST be a key -->
340 <input type="hidden" name="key" value="/restricted/${filename}">
342 <!-- inputs that you want to include in your form -->
343 <input type="hidden" name="Content-Type" value="image/jpeg">
344 <label for="colour">Colour</label>
345 <input type="text" id="colour" name="x-amz-meta-colour" value="green">
347 <!-- input needed to have something to upload. LAST IN FORM! -->
348 <input type="file" id="file" name="file">
351 You need to include the following elements in your policy:
369 Your policy can then be built like this:
371 my $policy = Net::Amazon::S3::Policy->new(
372 expiration => time() + 60 * 60, # one-hour policy
374 '$key starts-with /restricted/', # restrict to here
375 '$Content-Type starts-with image/', # accept any image format
376 '$x-amz-meta-colour *', # accept any colour
377 'bucket: somebucket',
381 # Put this as the value for "policy",
382 # instead of "base64-encoded-policy"
383 my $policy_for_form = $policy->base64();
385 # Put this as the value for "signature",
386 # instead of "base64-encoded-signature"
387 my $signature_for_form = $policy->signature_base64($key);
391 =head2 Module Interface
395 =item B<< new (%args) >>
397 =item B<< new (\%args) >>
399 constructor to create a new Net::Amazon::S3::Policy object.
401 Arguments can be passed either as a single hash reference, or
402 as a hash. Choose whatever you like most.
410 the expiration date for this policy.
414 a list of conditions to initialise the object. This should
415 point to an array with the conditions, that will be passed through
420 a piece of JSON text to parse the configuration from. The presence
421 of this parameter overrides the other two.
425 =item B<< expiration () >>
427 =item B<< expiration ($time) >>
429 get/set the expiration time for the condition. Set to a false value
430 to remove the expiration time from the policy.
432 You should either pass an ISO8601 datetime string, or an epoch value.
433 You'll always get an ISO8601 string back.
435 =item B<< conditions () >>
437 =item B<< conditions (@conditions) >>
439 =item B<< conditions (\@conditions) >>
441 get/set the conditions in the policy. You should never need to use this
442 method, because the L</add> and L</remove> are there for you to interact
443 with this member. If you want to use this, anyway, be sure to take
444 a look to the functions in L</Convenience Condition Functions>.
446 =item B<< add ($spec) >>
448 add a specification to the list of conditions.
450 A specification can be either an ARRAY reference, or a textual one:
456 if you pass an ARRAY reference, it should be something like the one
457 returned by any of the functions in L</Convenience Condition Functions>;
461 othewise, it can be a string with a single condition, like the following
464 some-field eq some-value
465 $some-other-field starts-with /path/to/somewhere/
466 10 <= numeric-value <= 1000
468 Note that the string specification is less "strict" in checking its
469 parameters; in particular, you should stick to the ARRAY reference if
470 your parameters have a space inside. You can use the following formats:
474 =item C<< <name> eq <value> >>
476 set a name to have a given value, exactly;
478 =item C<< <name> starts-with <prefix> >>
480 =item C<< <name> starts_with <prefix> >>
482 =item C<< <name> ^ <prefix> >>
484 set the prefix that has to be matched against the value
485 for the field with the given name. If the prefix is left
486 empty, every possible value will be admitted;
488 =item C<< <name> * >>
490 admit any value for the given field, just like setting an empty
491 value for a C<starts-with> rule;
493 =item C<< <min> <= <name> <= <max> >>
495 set an allowable range for the given field.
499 Policies for exact or starts-with matching usually refer to the form's
500 field, thus requiring to refer them as "variables" with a prepended
501 dollar sign, just like Perl scalars (more or less). Thus, if you forget
502 to put it, it will be automatically added for you. Hence, the following
503 conditions are equivalent:
508 because both yield the following condition in JSON:
510 ["eq","$field","blah"]
514 =item B<< remove ($spec) >>
516 remove a condition in the list of conditions. The parameter is
517 regarded exactly as in L</add>; once it is found, the list of
518 conditions will be filtered to exclude that particular
523 =item B<< stringify () >>
525 get a textual version of the object, in JSON format. This is the
526 base format used to interact with Amazon S3.
528 =item B<< base64 () >>
530 =item B<< json_base64 () >>
532 =item B<< stringify_base64 () >>
534 get a textual version of the object, as a Base64 encoding of the
535 JSON representation (see L</json>). This is what should to be put
536 as C<policy> field in the POST form.
539 =item B<< parse ($json_text) >>
541 parse a JSON representation of a policy and fill in the object. This
542 is the opposite of L</json>.
545 =item B<< signature ($key) >>
547 get the signature for the Base 64 encoding of the JSON representation of
548 the policy. The signature is the SHA1-HMAC digital signature, with the
552 =item B<< signature_base64 ($key) >>
554 get the Base64 encoding of the signature, as given by L</signature>. This
555 is the value that should be put in the C<signature> field in the POST
560 =head2 Convenience Condition Functions
562 The following functions can be optionally imported from the
563 module, and can be used indifferently as class/instance
564 methods or as functions.
568 =item B<< exact ($target, $value) >>
570 produce an I<exact value> condition. This condition is an array
571 reference with the following elements:
581 the I<name> of the field;
585 the I<value> that the field should match exactly.
589 =item B<< starts_with ($target, $value) >>
591 produce a I<starts-with> condition. This condition is an array
592 reference with the following elements:
598 the C<starts-with> string;
602 the I<name> of the field;
606 the I<prefix> that has to be matched by the field's value
610 =item B<< range ($target, $min, $max) >>
612 produce a I<value range> condition. This condition is an array
613 reference with the following elements:
619 the I<name> of the field;
623 the I<minimum> value allowed for the field's value;
627 the I<maximum> value allowed for the field's value;
638 =item C<< could not understand '%s', bailing out >>
640 The L</add> and L</remove> function try their best to understand
641 a condition when given in string form... but you should really
642 stick to the format given in the documentation!
647 =head1 CONFIGURATION AND ENVIRONMENT
649 Net::Amazon::S3::Policy requires no configuration files or environment variables.
654 The C<version> pragma (which has been included in Perl 5.10) and the
658 =head1 INCOMPATIBILITIES
663 =head1 BUGS AND LIMITATIONS
665 No bugs have been reported.
667 Please report any bugs or feature requests through http://rt.cpan.org/
672 Flavio Poletti C<< <flavio [at] polettix [dot] it> >>
675 =head1 LICENCE AND COPYRIGHT
677 Copyright (c) 2008, Flavio Poletti C<< <flavio [at] polettix [dot] it> >>. All rights reserved.
679 This module is free software; you can redistribute it and/or
680 modify it under the same terms as Perl 5.8.x itself. See L<perlartistic>
683 Questo modulo è software libero: potete ridistribuirlo e/o
684 modificarlo negli stessi termini di Perl 5.8.x stesso. Vedete anche
685 L<perlartistic> e L<perlgpl>.
688 =head1 DISCLAIMER OF WARRANTY
690 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
691 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
692 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
693 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
694 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
695 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
696 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
697 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
698 NECESSARY SERVICING, REPAIR, OR CORRECTION.
700 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
701 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
702 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
703 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
704 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
705 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
706 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
707 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
708 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
711 =head1 NEGAZIONE DELLA GARANZIA
713 Poiché questo software viene dato con una licenza gratuita, non
714 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
715 dalle leggi applicabili. A meno di quanto possa essere specificato
716 altrove, il proprietario e detentore del copyright fornisce questo
717 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
718 o implicita, includendo fra l'altro (senza però limitarsi a questo)
719 eventuali garanzie implicite di commerciabilità e adeguatezza per
720 uno scopo particolare. L'intero rischio riguardo alla qualità ed
721 alle prestazioni di questo software rimane a voi. Se il software
722 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
723 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
725 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
726 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
727 di copyright, o qualunque altra parte che possa modificare, o redistribuire
728 questo software così come consentito dalla licenza di cui sopra, potrà
729 essere considerato responsabile nei vostri confronti per danni, ivi
730 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
731 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
732 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
733 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
734 sostenute da voi o da terze parti o un fallimento del software ad
735 operare con un qualsivoglia altro software. Tale negazione di garanzia
736 rimane in essere anche se i dententori del copyright, o qualsiasi altra
737 parte, è stata avvisata della possibilità di tali danneggiamenti.
739 Se decidete di utilizzare questo software, lo fate a vostro rischio
740 e pericolo. Se pensate che i termini di questa negazione di garanzia
741 non si confacciano alle vostre esigenze, o al vostro modo di
742 considerare un software, o ancora al modo in cui avete sempre trattato
743 software di terze parti, non usatelo. Se lo usate, accettate espressamente
744 questa negazione di garanzia e la piena responsabilità per qualsiasi
745 tipo di danno, di qualsiasi natura, possa derivarne.