Net-Amazon-S3-0.89000755000765000024 013620607144 12754 5ustar00leostaff000000000000README100644000765000024 70413620607144 13676 0ustar00leostaff000000000000Net-Amazon-S3-0.89This archive contains the distribution Net-Amazon-S3, version 0.89: Use the Amazon S3 - Simple Storage Service This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v6.012. CHANGES100644000765000024 2400613620607144 14052 0ustar00leostaff000000000000Net-Amazon-S3-0.89Revision history for Perl module Net::Amazon::S3: 0.89 Tue 11 Feb 2020 20:26:26 - fix signature v4 test (Ali Zia) 0.88 Sat 1 Feb 2020 21:29:52 - Allow passing headers from client to InitiateMultipartUpload request (Ali Zia) - sign uri with iam role (kuriyama) - Canned ACLs updated (ratsbane) 0.87 Mon 9 Dec 2019 19:53:42 GMT - Time::Piece fix from Eden Crane - eu-north-1 region (happy-barney) - drop hardcoded V2 in ListAllMyBuckets (happy-barney) - Fix setting of S3 XML document namespace (michal-josef-spacek) 0.86 Fri 12 Apr 2019 13:38:10 BST - Retry bucket HEAD few times see #51 (thanks Branislav Zahradník) - Support server side encryption also in Net::Amazon::S3::Bucket (thanks Branislav Zahradník) - Use session token if specified in Signature V4 as well #43 (thanks Branislav Zahradník) - Add website_redirect_location (thanks Gavin Carr) - Make keep_alive cache size configurable (thanks Michael Schout) - Pod::Weaver fixes (thanks Florian Schlichting) 0.85 Tue 28 Aug 2018 20:14:38 BST - Support standard_ia and onezone_ia storage classes (thanks Michele Beltrame) - run 'use_ok' on all modules (thanks Yanick Champoux) - spellings (thanks Gregor Herrmann) - LOTS of cleanup and refactoring (thanks Branislav Zahradník) 0.84 Mon 16 Jul 2018 17:49:10 BST - Put back credential cache code lost in Signature 4 patch (Branislav Zahradník) 0.83 Tue 10 Jul 2018 22:30:23 BST - All patches by Branislav Zahradník - Use Signature 4 by default only for amazonaws host (issue #29) - Relaxing constraint on owner id, accepting any string (issue #18) - Enable secure by default (issue #23) - Sanity object uris to avoid invalid signature (issue #28) 0.82 Sat 7 Jul 2018 14:28:06 BST - Use HEAD request to determine bucket region (patch by Branislav Zahradník) 0.81 Thu 28 Jun 2018 20:27:44 GMT (TRIAL RELEASE) - Restore CHANGES files format - Change path to new github repo - Add optional delimiter parameter to Net::Amazon::S3::Client::Bucket->list (patch by Christian Lackas) - Add expected and received ETag value if upload is detected as being incorrect. - Add support for all location constraints when creating buckets - making DateTime coercion optional for last_modified (something that might happen million of times without ever been used, in a rather expensive operation) (patch by Christian Lackas) - avoiding MD5 calculation of large files (chunked uploads) that are then never used (patch by Christian Lackas) - add ability to set use_virtual_host to use virtual host method of making requests which eliminate having to set the region endpoint of a bucket. (patch by Christian Lackas) - Add V4 support (patch by Branislav Zahradník) 0.80 Sun Apr 12 12:33:19 GMT 2015 - Fixed a bug in ETag validation (patch by Ali Anari) - Add support to set x-amz-metadata-directive when calling Net::Amazon::S3::copy_key - Add get_callback to Net::Amazon::S3::Client:Object - Add support for using IAM credentials when running on EC2, rather than hard coding access key and secret key. - Add support for aws_session_token in addition to access and secret key. - Remove code that determined if bucket can be used as a DNS Hostname as it was flawed. - Fix a bug where if a bucket contained a key 0 it would not be possible to be retrieved. - Add support for Net::Amazon::S3::Client::Bucket::delete_multi_object to handle more than 1,000 requests in one call. - Various test fixes from pnu. - Fix Moose enum problems (patch by tomhukins) - Allow content 'value' property to be ScalarRef for Net::Amazon::S3::HTTPRequest (patch by Struan Bartlett) - Add support for storage class when creating buckets along with user metadata (patch by Aaron Crane) - Add support for cache control header on Net::Amazon::S3::Client::Object (patch by toritori0318) - Support server side encryption (patch by Haruka Iwao) - Add support for multipart upload aborting (patch by Gabriel Andrade) 0.59 Sat Mar 17 09:36:38 GMT 2013 - Added support for security token authentication (patch by Miquel Ruiz) 0.58 Wed Nov 28 16:22:42 GMT 2012 - Added support for multi-part upload and multiple objects deletion (patch by Robert B. Clarke) 0.57 Sun Sep 16 22:38:38 BST 2012 - Added support for Content-disposition (initial patch by Michele Beltrame) - Added sync_up option to s3cl (patch by Leo Lapworth) - Dist::Zilla tidying 0.56 Sun Dec 18 22:22:32 GMT 2011 - Spelling error (RT #69817, patch from Fabrizio Regalli) - Added use_ok tests (RT #72856, suggested by Gregor Herrmann) - Added missing use URI::Escape (RT #72857, patch from Gregor Herrmann) - Bumped dependency on MooseX::StrictConstructor to 0.16 (RT #73229, suggested by Andrew Main) - Enforce dependency versions (RT #73193, suggested by Andrew Main) 0.55 Sat Dec 10 00:55:29 GMT 2011 - Replaced dependency on MooseX::Types::DateTimeX with MooseX::Types::DateTime::MoreCoercions (RT #72472). 0.54 Sat Mar 21 21:23:32 BST 2011 - Fix for a naked qw() warning (patch by David Wheeler) - Fixed path issues (patch by Pavel Karoukin) *WARNING* THIS MIGHT BREAK EXISTING APPS *WARNING* - Author and development information changes 0.53 Tue Mar 30 15:24:19 BST 2010 - fix authenticated urls to work with EU buckets (patch by Edmund von der Burg) - tiny POD fix (patch by Frank Wiegand) - add an exists method to Net::Amazon::S3::Client (suggested by David Golden) - fix max_keys when listing buckets (spotted by Andrew Bryan) - add content_encoding to Net::Amazon::S3::Object (suggested by Egor Korablev) - update s3cl: You need to use the module before you use it, added the mkbucket command, now you can run the help without your AWS secret key, add docs about the env variables you need to run s3cl (patches by Jesse Vincent) 0.52 Thu Jul 2 09:17:11 BST 2009 - increase version prerequisites for some modules so that they are known to work 0.51 Tue May 19 08:31:59 BST 2009 - use MooseX::Types::DateTimeX so that we work with latest Moose (noticed by Ted Zlatanov) 0.50 Wed Jan 21 10:42:00 GMT 2009 - add support for an expires header when putting an object to Net::Amazon::S3::Client::Object - make all the classes immutable - add query_string_authentication_uri() to Net::Amazon::S3::Client::Object, suggested by Meng Wong 0.49 Tue Jan 13 09:04:42 GMT 2009 - add support for listing a bucket with a prefix to Net::Amazon::S3::Client::Bucket 0.48 Thu Dec 4 09:24:23 GMT 2008 - be slightly less strict about bucket names: they can contain uppercase letters, Amazon just doesn't recommend it (noticed by Simon Elliott, fixes Brackup) 0.47 Tue Dec 2 08:03:39 GMT 2008 - fix listing with a prefix (spotted by Nobuo Danjou) 0.46 Mon Nov 24 08:53:18 GMT 2008 - refactor request creation into Net::Amazon::S3::Request and many subclasses - move to Moose - add Net::Amazon::S3::Client and subclasses 0.45 Wed Aug 20 17:06:49 BST 2008 - make add_key, head_key etc. return all the headers, not just the X-Amazon ones (patch by Andrew Hanenkamp) - require IO::File 1.14 (noticed by tsw) - remove DateTime::Format::Strptime prerequisite as it was not being used (noticed by Yen-Ming Lee) - do not try and parse non-XML errors (patch by lostlogic) - make it possible to store and delete the key "0" (patch by Joey Hess) - make it possible to store empty files (patch by BDOLAN) - add Copy support (patch by BDOLAN) - add s3cl for command-line access (patch by Leo Lapworth) 0.44 Thu Mar 27 08:35:59 GMT 2008 - fix bug with storing files consisting of "0" (thanks to Martin Atkins) 0.43 Sat Mar 1 10:55:54 GMT 2008 - add binmode() to support Windows (thanks to Gabriel Weinberg) 0.42 Thu Feb 28 06:39:59 GMT 2008 - add exponential backoff upon temporary errors with the new retry option 0.41 Fri Nov 30 10:42:26 GMT 2007 - fix the expensive tests (patch by BDOLAN) - added support for EU buckets (patch by BDOLAN) 0.40 Tue Oct 30 11:40:42 GMT 2007 - fix for content length with empty keys by Mark A. Hershberger - get_key and get_key_filename now return content_length - rewrote synopsis - added support for common prefix (thanks to Andy Grundman) 0.39 Sun Aug 19 14:47:01 BST 2007 - add add_key_filename and get_key_filename which send files directly from disk - good for large files (Jim Blomo) - support UTF8 keys (Jim Blomo) - switch back from Build.PL to Makefile.PL 0.38 Sun Mar 4 16:43:28 GMT 2007 - use http_proxy and https_proxy environment variables for proxy settings (Ask Bjoern Hansen) - don't add the Authorization header if one is already specified when making a request - good for allowing caching to resources that are public. (Ask Bjoern Hansen) 0.37 Fri Oct 13 19:14:57 BST 2006 - added support for ACLs (thanks to Gordon McCreight) 0.36 Sun Sep 10 16:30:39 BST 2006 - remove extra warning 0.35 Sun Sep 10 16:25:44 BST 2006 - added list_bucket_all to stop having to worrying about 'marker' 0.34 Sun Sep 10 07:27:06 BST 2006 - added next marker and more docs from Jesse Vincent 0.33 Sat Aug 26 16:26:37 BST 2006 - documentation and test cleanup from Jesse Vincent - use HTTP keep alive (patch by Scott Gifford) - remove ununused code in _make_request (patch by Scott Gifford) 0.32 Tue Apr 25 19:51:06 BST 2006 - fix bug with listing buckets with parameters (thanks to karjala) 0.31 Tue Apr 4 21:15:02 BST 2006 - many patches from Brad Fitzpatrick to make change the API, make return values sane, add err/errstr, make Bucket object - added a timeout option as suggested by Brad Dixon - it's the Brad release! 0.30 Mon Mar 20 20:20:29 GMT 2006 - initial release LICENSE100644000765000024 4422113620607144 14065 0ustar00leostaff000000000000Net-Amazon-S3-0.89This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644000765000024 127213620607144 14503 0ustar00leostaff000000000000Net-Amazon-S3-0.89name = Net-Amazon-S3 author = Leo Lapworth license = Perl_5 copyright_holder = Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover version = 0.89 [@Filter] -bundle = @Basic option = for_basic [MetaJSON] [MetaResources] bugtracker.web = https://github.com/rustyconover/net-amazon-s3/issues repository.url = https://github.com/rustyconover/net-amazon-s3 repository.web = https://github.com/rustyconover/net-amazon-s3 repository.type = git [Prereqs] LWP = 6.03 [Prereqs / RuntimeRecommends] VM::EC2::Security::CredentialCache = 0 [AutoPrereqs] [CPANFile] [Git::Contributors] [PodWeaver] [ReadmeMarkdownFromPod] [PkgVersion] bin000755000765000024 013620607144 13445 5ustar00leostaff000000000000Net-Amazon-S3-0.89s3cl100755000765000024 3042513620607144 14423 0ustar00leostaff000000000000Net-Amazon-S3-0.89/bin#!/usr/bin/env perl use strict; use warnings; use Getopt::Long; use Pod::Usage; use Path::Class; use File::Find::Rule; use Digest::MD5 qw(md5_hex); use Net::Amazon::S3; use MIME::Types qw(by_suffix); use Term::ProgressBar::Simple; # PODNAME: s3cl # ABSTRACT: Command line for Amazon s3 cloud storage my $s3; my %args; my %commands = ( mkbucket => \&mk_bucket, buckets => \&buckets, ls => \&ls, rm => \&rm, cp => \&cp, sync => \&sync, sync_up => \&sync_up, help => \&helper, ); main(); sub main { terminal(); get_options(); init_s3(); my $command = shift @ARGV || "help"; $commands{$command} or helper("Unknown command: $command"); $commands{$command}->(); } sub init_s3 { # TODO: read key_id and secret from config file? # use AppConfig; # TODO: probably nicer to put all of this in Net::Amazon::S3::CommandLine # and have simple call to that from here. my $aws_access_key_id = $ENV{'AWS_ACCESS_KEY_ID'}; my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'}; $s3 = Net::Amazon::S3->new( { aws_access_key_id => $aws_access_key_id, aws_secret_access_key => $aws_secret_access_key, retry => 1, } ); } sub sync { my $dest = $args{dest_or_source} || ''; helper("No destination supplied") if $dest eq ''; helper("Can not write to: $args{dest_or_source}") unless -w $dest; my $bucket = _get_bucket(); my $list = ls('data'); foreach my $key ( @{ $list->{keys} } ) { my $source = file( $key->{key} ); my $destination = file( $dest, $source ); $destination->dir->mkpath(); warn "$source -> $destination"; my $response = $bucket->get_key_filename( $source->stringify, 'GET', $destination->stringify ) or die $s3->err . ": " . $s3->errstr; } } sub sync_up { my $source = $args{dest_or_source} || ''; my $prefix = $args{prefix_or_key} || ''; my $acl_short = $args{acl_short}; helper("No source supplied") if $source eq ''; helper("Can not read directory: $args{dest_or_source}") unless -d $source; # Work out our local files my @files = File::Find::Rule->file()->in( ($source) ); my $progress = Term::ProgressBar::Simple->new( scalar(@files) ); my $bucket = _get_bucket(); # Get a list of all the remote files my $remote_file_list = $bucket->list_all( { prefix => $prefix } ) or die $s3->err . ": " . $s3->errstr; # Now hash, so we can look up a specific key to find the etag my %remote_files; foreach my $key_meta ( @{ $remote_file_list->{keys} } ) { my $key = $key_meta->{key}; $remote_files{$key} = $key_meta; } my $dir = dir($source); my $dir_string = $dir->stringify; my $mimetypes = MIME::Types->new; foreach my $f (@files) { my $file = file($f); my ( $mediatype, $encoding ) = by_suffix $file->basename(); # Assume plain text unless we can work i unless ($mediatype) { if ( -T $file ) { $mediatype = 'text/plain'; } else { $progress++; $progress->message("$f - NOT uploading"); warn "Not uploading: $file"; warn "Unknown mime type, submit patch to MIME::Types"; next; } } my $content = $file->slurp(); my $md5 = md5_hex($content); my $key = $file->stringify; $key =~ s/$dir_string//; # remove our local path for the dir $key =~ s{^/}{}; # remove the trailing slash $key = "$prefix$key"; # Add the prefix if there is one if ( my $remote = $remote_files{$key} ) { if ( $remote->{etag} eq $md5 ) { $progress->message("$key - $mediatype - not changed"); next; } } $bucket->add_key_filename( $key, $f, { content_type => $mediatype, }, ) or die $s3->err . ": " . $s3->errstr; if ($acl_short) { $bucket->set_acl( { key => $key, acl_short => $acl_short, } ) || die $s3->err . ": " . $s3->errstr; } $progress->message("$key - $mediatype - uploaded"); $progress++; } } sub cp { my $dest = $args{dest_or_source} || ''; helper("No destination supplied") if $dest eq ''; my $key = $args{prefix_or_key} || helper("No key supplied"); if ( -d $dest ) { # If we have a directory we need to add the file name $dest = file( $dest, file($key)->basename ); } my $bucket = _get_bucket(); unless ( $bucket->get_key_filename( "$key", 'GET', "$dest" ) ) { die $s3->err . ": " . $s3->errstr if $s3->err; die "Could not copy $key from bucket $args{bucket}"; } } sub ls { my $mode = shift || 'print'; my $bucket = _get_bucket(); my $ls_conf; $ls_conf->{prefix} = $args{prefix_or_key} if $args{prefix_or_key}; # list files in the bucket my $response = $bucket->list_all($ls_conf) or die $s3->err . ": " . $s3->errstr; return $response if $mode eq 'data'; foreach my $key ( @{ $response->{keys} } ) { my $key_last_modified = $key->{last_modified}; # 2008-07-14T22:31:10.000Z $key_last_modified =~ s/:\d{2}\.\d{3}Z$//; my $key_name = $key->{key}; my $key_size = $key->{size}; print "$key_size $key_last_modified $key_name\n"; } } sub rm { my $bucket = _get_bucket(); helper("Must have a :") unless $args{prefix_or_key}; my $res = "NO"; if ( $args{force} ) { $res = 'y'; } else { print "\nOnce deleted there is no way to retrieve this key again." . "\nAre you sure you want to delete $args{bucket}:$args{prefix_or_key}? y/N\n"; ( $res = ) =~ s/\n//; } if ( $res eq 'y' ) { # delete key in this bucket my $response = $bucket->delete_key( $args{prefix_or_key} ) or die $s3->err . ": " . $s3->errstr; } } sub mk_bucket { my $bucketname = $args{bucket}; my $bucket = $s3->add_bucket( { bucket => $bucketname, location_constraint => 'EU' } ) or die $s3->err . ": " . $s3->errstr; } sub buckets { my $response = $s3->buckets; my $num = scalar @{ $response->{buckets} || [] }; print "You have $num bucket"; print "s" if $num != 1; print ":\n"; foreach my $bucket ( @{ $response->{buckets} } ) { print '- ' . $bucket->bucket . "\n"; } } sub terminal { my $encoding = eval { require Term::Encoding; Term::Encoding::get_encoding(); } || "utf-8"; binmode STDOUT, ":encoding($encoding)"; } # TODO: Replace with AppConfig this is ick! sub get_options { my $help = 0; my $man = 0; my $force = 0; my $loc = "us-east-1"; my $bucket = ""; GetOptions( \%args, "bucket=s", "jurisdiction=s", "acl_short=s", "f|force" => \$force, "h|help|?" => \$help, "man" => \$man, ) or pod2usage(2); $args{force} = $force; foreach my $arg (@ARGV) { if ( $arg =~ /:/ ) { my ( $b, $rest ) = split( ":", $arg ); $args{bucket} = $b; $args{prefix_or_key} = $rest; } } # For cp / sync etc $args{dest_or_source} = $ARGV[2] if $ARGV[2]; pod2usage(1) if $help || @ARGV == 0; pod2usage( -verbose => 2 ) if $man; } sub _get_bucket { helper("No bucket supplied") unless $args{bucket}; my $bucket = $s3->bucket( $args{bucket} ); die $s3->err . ": " . $s3->errstr if $s3->err; helper("Could not get bucket $args{bucket}") unless $bucket; return $bucket; } sub helper { my $msg = shift; if ($msg) { pod2usage( -message => $msg, -exitval => 2 ); } exit; } =pod =encoding UTF-8 =head1 NAME s3cl - Command line for Amazon s3 cloud storage =head1 VERSION version 0.89 =head1 SYNOPSIS s3cl command [options] s3cl buckets s3cl mkbucket --bucket some_bucket_name --jurisdiction [EU|US] s3cl ls :[prefix] s3cl cp : /path/[filename] s3cl sync :[prefix] /path/ s3cl sync_up [--acl_short=public-read] :[prefix] /path/ s3cl rm : Options: -help brief help message -man full documentation We take NO responsibility for the costs incured through using this script. To run this script, you need to set a pair of environment variables: AWS_ACCESS_KEY_ID AWS_ACCESS_KEY_SECRET =head1 DESCRIPTION This program gives a command line interface to Amazons s3 storage service. It does not limit the number of requests (which may cost you more money than if you did it a different way!) and each request costs Money (although some costs from EC2 may be $0.0, check latest from Amazon costs page) - we take NO responsibility for your bill. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __DATA__ =head1 COMMANDS =over 4 =item B s3cl buckets List all buckets for this account. =item B s3cl mkbucket --bucket sombucketname [--jurisdiction [EU|US]] Create a new bucket, optionally specifying what jurisdiction it should be created in. =item B s3cl ls :[prefix] List contents of a bucket, the optional B can be partial, in which case all keys matching this as the start of the key name will be returned. If no B is supplied all keys of the bucket will be returned. =item B s3cl cp : target_file s3cl cp : target_directory Copy a single key from the bucket to the target file, or into the target_directory. =item B s3cl sync :[prefix] target_dir Downloads all files matching the prefix into a directory structure replicating that of the prefix and all 'sub-directories'. It will download ALL files - even if already on your local disk: http://www.amazon.com/gp/browse.html?node=16427261 # Data transfer "in" and "out" refers to transfer into and out # of Amazon S3. Data transferred between Amazon EC2 and # Amazon S3, is free of charge (i.e., $0.00 per GB), except # data transferred between Amazon EC2 and Amazon S3-Europe, # which will be charged at regular rates. =item B s3cl sync_up [--acl_short=public-read] :[prefix] /path/ Upload all the files below /path/ to S3, with an optional prefix at the start of the key name. The existing S3 files and meta data are fetched from S3 and the md5 (etag) is compaired to what is on the local disk, files are not upload if the content has not changed. Use --acl_short to set access control, options from L this is only applied when the file is uploaded. Each files content-type is worked out using L, if this does not match 'text/plain' is used for ASCII text files, otherwise a warning is issued and the file is NOT uploaded. Currently this does NOT remove old files from S3, and if there is any change to a file then the entire file will be reuploaded. =item B s3cl rm : Remove a key(file) from the bucket, removing a non-existent file is not classed as an error. Once removed the key (file) can not be restored - so use with care! =back =head1 ABOUT This module contains code modified from Amazon that contains the following notice (which is also applicicable to this code): # This software code is made available "AS IS" without # warranties of any kind. You may copy, display, modify and # redistribute the software code either by itself or as incorporated # into your code; provided that you do not remove any proprietary # notices. Your use of this software code is at your own risk and # you waive any claim against Amazon Digital Services, Inc. or its # affiliates with respect to your use of this software code. # (c) 2006 Amazon Digital Services, Inc. or its affiliates. =head1 AUTHOR Leo Lapworth - Part of the HinuHinu project =cut META.yml100644000765000024 741613620607144 14316 0ustar00leostaff000000000000Net-Amazon-S3-0.89--- abstract: 'Use the Amazon S3 - Simple Storage Service' author: - 'Leo Lapworth ' build_requires: File::Temp: '0' FindBin: '0' LWP::Simple: '0' Moose::Meta::Class: '0' Test::Exception: '0' Test::LoadAllModules: '0' Test::MockTime: '0' Test::Warnings: '0' lib: '0' vars: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Amazon-S3 recommends: VM::EC2::Security::CredentialCache: '0' requires: Carp: '0' Data::Stream::Bulk::Callback: '0' DateTime::Format::HTTP: '0' Digest::HMAC_SHA1: '0' Digest::MD5: '0' Digest::MD5::File: '0' Digest::SHA: '0' Exporter::Tiny: '0' File::Find::Rule: '0' File::stat: '0' Getopt::Long: '0' HTTP::Date: '0' HTTP::Response: '0' HTTP::Status: '0' Hash::Util: '0' IO::File: '1.14' LWP: '6.03' LWP::UserAgent::Determined: '0' MIME::Base64: '0' MIME::Types: '0' Moose: '0.85' Moose::Object: '0' Moose::Role: '0' Moose::Util: '0' Moose::Util::TypeConstraints: '0' MooseX::Role::Parameterized: '0' MooseX::StrictConstructor: '0.16' MooseX::Types::DateTime::MoreCoercions: '0.07' Path::Class: '0' Pod::Usage: '0' Ref::Util: '0' Regexp::Common: '0' Scalar::Util: '0' Sub::Override: '0' Term::Encoding: '0' Term::ProgressBar::Simple: '0' Test::Deep: '0' Test::More: '0' Time::Piece: '0' URI: '0' URI::Escape: '0' URI::QueryParam: '0' XML::LibXML: '0' XML::LibXML::XPathContext: '0' namespace::clean: '0' parent: '0' sort: '0' strict: '0' warnings: '0' resources: bugtracker: https://github.com/rustyconover/net-amazon-s3/issues repository: https://github.com/rustyconover/net-amazon-s3 version: '0.89' x_contributors: - 'Aaron Crane ' - 'Ali Anari ' - 'Ali Zia ' - 'Ali ' - 'Branislav Zahradnik ' - 'Branislav Zahradník ' - 'Christian Lackas ' - 'Douglas Sims ' - 'Dylan William Hardison ' - 'Eden Crane <>' - 'Florian Schlichting ' - 'Gabriel Andrade ' - 'Gabriel Andrade ' - 'Gavin Carr ' - 'Haruka Iwao ' - 'Jun Kuriyama ' - 'Leo Lapworth ' - 'Leon Brocard ' - 'Michael Schout ' - 'Michal Josef Špaček ' - 'Michele Beltrame ' - 'Michele Beltrame ' - 'Miquel Ruiz ' - 'Panu Ervamaa ' - 'Pavel A. Karoukin ' - 'Pedro Figueiredo ' - 'Pedro Figueiredo ' - 'Pedro Figueiredo ' - 'perlpong ' - 'Renato Santos ' - 'robert clarke ' - 'Robert Ward ' - 'Rusty Conover ' - 'Rusty Conover ' - 'Rusty Conover ' - 'Rusty Conover ' - 'Slobodan Mišković ' - 'Steven Berler ' - 'Struan Bartlett ' - 'Stuart Skelton ' - 'Tom Hukins ' - 'toritori0318 ' - 'Yanick Champoux ' x_generated_by_perl: v5.28.2 x_serialization_backend: 'YAML::Tiny version 1.73' MANIFEST100644000765000024 1103613620607144 14207 0ustar00leostaff000000000000Net-Amazon-S3-0.89# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. CHANGES LICENSE MANIFEST META.json META.yml Makefile.PL README README.md README.mkdn bin/s3cl cpanfile dist.ini examples/backup_cpan.pl lib/Net/Amazon/S3.pm lib/Net/Amazon/S3/Bucket.pm lib/Net/Amazon/S3/Client.pm lib/Net/Amazon/S3/Client/Bucket.pm lib/Net/Amazon/S3/Client/Object.pm lib/Net/Amazon/S3/Features.pod lib/Net/Amazon/S3/HTTPRequest.pm lib/Net/Amazon/S3/Request.pm lib/Net/Amazon/S3/Request/AbortMultipartUpload.pm lib/Net/Amazon/S3/Request/Bucket.pm lib/Net/Amazon/S3/Request/CompleteMultipartUpload.pm lib/Net/Amazon/S3/Request/CreateBucket.pm lib/Net/Amazon/S3/Request/DeleteBucket.pm lib/Net/Amazon/S3/Request/DeleteMultiObject.pm lib/Net/Amazon/S3/Request/DeleteObject.pm lib/Net/Amazon/S3/Request/GetBucketAccessControl.pm lib/Net/Amazon/S3/Request/GetBucketLocationConstraint.pm lib/Net/Amazon/S3/Request/GetObject.pm lib/Net/Amazon/S3/Request/GetObjectAccessControl.pm lib/Net/Amazon/S3/Request/InitiateMultipartUpload.pm lib/Net/Amazon/S3/Request/ListAllMyBuckets.pm lib/Net/Amazon/S3/Request/ListBucket.pm lib/Net/Amazon/S3/Request/ListParts.pm lib/Net/Amazon/S3/Request/Object.pm lib/Net/Amazon/S3/Request/PutObject.pm lib/Net/Amazon/S3/Request/PutPart.pm lib/Net/Amazon/S3/Request/Role/HTTP/Header.pm lib/Net/Amazon/S3/Request/Role/HTTP/Header/Acl_short.pm lib/Net/Amazon/S3/Request/Role/HTTP/Header/Content_length.pm lib/Net/Amazon/S3/Request/Role/HTTP/Header/Content_md5.pm lib/Net/Amazon/S3/Request/Role/HTTP/Header/Content_type.pm lib/Net/Amazon/S3/Request/Role/HTTP/Header/Copy_source.pm lib/Net/Amazon/S3/Request/Role/HTTP/Header/Encryption.pm lib/Net/Amazon/S3/Request/Role/HTTP/Method.pm lib/Net/Amazon/S3/Request/Role/HTTP/Method/DELETE.pm lib/Net/Amazon/S3/Request/Role/HTTP/Method/GET.pm lib/Net/Amazon/S3/Request/Role/HTTP/Method/POST.pm lib/Net/Amazon/S3/Request/Role/HTTP/Method/PUT.pm lib/Net/Amazon/S3/Request/Role/Query/Action.pm lib/Net/Amazon/S3/Request/Role/Query/Action/Acl.pm lib/Net/Amazon/S3/Request/Role/Query/Action/Delete.pm lib/Net/Amazon/S3/Request/Role/Query/Action/Location.pm lib/Net/Amazon/S3/Request/Role/Query/Action/Uploads.pm lib/Net/Amazon/S3/Request/Role/Query/Param.pm lib/Net/Amazon/S3/Request/Role/Query/Param/Delimiter.pm lib/Net/Amazon/S3/Request/Role/Query/Param/Marker.pm lib/Net/Amazon/S3/Request/Role/Query/Param/Max_keys.pm lib/Net/Amazon/S3/Request/Role/Query/Param/Part_number.pm lib/Net/Amazon/S3/Request/Role/Query/Param/Prefix.pm lib/Net/Amazon/S3/Request/Role/Query/Param/Upload_id.pm lib/Net/Amazon/S3/Request/Service.pm lib/Net/Amazon/S3/Request/SetBucketAccessControl.pm lib/Net/Amazon/S3/Request/SetObjectAccessControl.pm lib/Net/Amazon/S3/Role/Bucket.pm lib/Net/Amazon/S3/Signature.pm lib/Net/Amazon/S3/Signature/V2.pm lib/Net/Amazon/S3/Signature/V4.pm lib/Net/Amazon/S3/Signature/V4Implementation.pm lib/Shared/Examples/Net/Amazon/S3.pm lib/Shared/Examples/Net/Amazon/S3/ACL.pm lib/Shared/Examples/Net/Amazon/S3/API.pm lib/Shared/Examples/Net/Amazon/S3/Client.pm lib/Shared/Examples/Net/Amazon/S3/Error.pm lib/Shared/Examples/Net/Amazon/S3/Operation/Bucket/Create.pm lib/Shared/Examples/Net/Amazon/S3/Operation/Bucket/Objects/Delete.pm lib/Shared/Examples/Net/Amazon/S3/Operation/Bucket/Objects/List.pm lib/Shared/Examples/Net/Amazon/S3/Operation/Service/Buckets/List.pm lib/Shared/Examples/Net/Amazon/S3/Request.pm perlcritic.rc t/00use.t t/01api.t t/02client.t t/03token.t t/api-bucket-acl-get.t t/api-bucket-acl-set.t t/api-bucket-create.t t/api-bucket-delete.t t/api-bucket-objects-delete.t t/api-bucket-objects-list.t t/api-object-acl-get.t t/api-object-acl-set.t t/api-object-create.t t/api-object-delete.t t/api-object-fetch.t t/api-object-head.t t/api-service-buckets-list.t t/client-bucket-acl-get.t t/client-bucket-create.t t/client-bucket-delete.t t/client-bucket-objects-delete.t t/client-bucket-objects-list.t t/client-object-create.t t/client-object-delete.t t/client-object-fetch.t t/client-service-buckets-list.t t/query-string-authentication-uri.t t/request-abort-multipart-upload.t t/request-complete-multipart-upload.t t/request-create-bucket.t t/request-delete-bucket.t t/request-delete-multi-object.t t/request-delete-object.t t/request-get-bucket-access-control.t t/request-get-bucket-location-constraint.t t/request-get-object-access-control.t t/request-get-object.t t/request-initiate-multipart-upload.t t/request-list-all-buckets.t t/request-list-bucket.t t/request-list-parts.t t/request-put-object.t t/request-put-part.t t/request-set-bucket-access-control.t t/request-set-object-access-control.t t/request.t t/signature-v4-with-security-token.t cpanfile100644000765000024 424513620607144 14546 0ustar00leostaff000000000000Net-Amazon-S3-0.89requires "Carp" => "0"; requires "Data::Stream::Bulk::Callback" => "0"; requires "DateTime::Format::HTTP" => "0"; requires "Digest::HMAC_SHA1" => "0"; requires "Digest::MD5" => "0"; requires "Digest::MD5::File" => "0"; requires "Digest::SHA" => "0"; requires "Exporter::Tiny" => "0"; requires "File::Find::Rule" => "0"; requires "File::stat" => "0"; requires "Getopt::Long" => "0"; requires "HTTP::Date" => "0"; requires "HTTP::Response" => "0"; requires "HTTP::Status" => "0"; requires "Hash::Util" => "0"; requires "IO::File" => "1.14"; requires "LWP" => "6.03"; requires "LWP::UserAgent::Determined" => "0"; requires "MIME::Base64" => "0"; requires "MIME::Types" => "0"; requires "Moose" => "0.85"; requires "Moose::Object" => "0"; requires "Moose::Role" => "0"; requires "Moose::Util" => "0"; requires "Moose::Util::TypeConstraints" => "0"; requires "MooseX::Role::Parameterized" => "0"; requires "MooseX::StrictConstructor" => "0.16"; requires "MooseX::Types::DateTime::MoreCoercions" => "0.07"; requires "Path::Class" => "0"; requires "Pod::Usage" => "0"; requires "Ref::Util" => "0"; requires "Regexp::Common" => "0"; requires "Scalar::Util" => "0"; requires "Sub::Override" => "0"; requires "Term::Encoding" => "0"; requires "Term::ProgressBar::Simple" => "0"; requires "Test::Deep" => "0"; requires "Test::More" => "0"; requires "Time::Piece" => "0"; requires "URI" => "0"; requires "URI::Escape" => "0"; requires "URI::QueryParam" => "0"; requires "XML::LibXML" => "0"; requires "XML::LibXML::XPathContext" => "0"; requires "namespace::clean" => "0"; requires "parent" => "0"; requires "sort" => "0"; requires "strict" => "0"; requires "warnings" => "0"; recommends "VM::EC2::Security::CredentialCache" => "0"; on 'test' => sub { requires "File::Temp" => "0"; requires "FindBin" => "0"; requires "LWP::Simple" => "0"; requires "Moose::Meta::Class" => "0"; requires "Test::Exception" => "0"; requires "Test::LoadAllModules" => "0"; requires "Test::MockTime" => "0"; requires "Test::Warnings" => "0"; requires "lib" => "0"; requires "vars" => "0"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'configure' => sub { suggests "JSON::PP" => "2.27300"; }; README.md100644000765000024 436013620607144 14317 0ustar00leostaff000000000000Net-Amazon-S3-0.89# DESCRIPTION This module provides a Perlish interface to Amazon S3. From the developer blurb: "Amazon S3 is storage for the Internet. It is designed to make web-scale computing easier for developers. Amazon S3 provides a simple web services interface that can be used to store and retrieve any amount of data, at any time, from anywhere on the web. It gives any developer access to the same highly scalable, reliable, fast, inexpensive data storage infrastructure that Amazon uses to run its own global network of web sites. The service aims to maximize benefits of scale and to pass those benefits on to developers". To find out more about S3, please visit: http://s3.amazonaws.com/ To use this module you will need to sign up to Amazon Web Services and provide an "Access Key ID" and " Secret Access Key". If you use this module, you will incurr costs as specified by Amazon. Please check the costs. If you use this module with your Access Key ID and Secret Access Key you must be responsible for these costs. I highly recommend reading all about S3, but in a nutshell data is stored in values. Values are referenced by keys, and keys are stored in buckets. Bucket names are global. Note: This is the legacy interface, please check out Net::Amazon::S3::Client instead. Development of this code happens here: https://github.com/rustyconover/net-amazon-s3 # LICENSE This module contains code modified from Amazon that contains the following notice: > This software code is made available "AS IS" without warranties of any > kind. You may copy, display, modify and redistribute the software > code either by itself or as incorporated into your code; provided that > you do not remove any proprietary notices. Your use of this software > code is at your own risk and you waive any claim against Amazon > Digital Services, Inc. or its affiliates with respect to your use of > this software code. (c) 2006 Amazon Digital Services, Inc. or its > affiliates. # AUTHOR * Leon Brocard and unknown Amazon Digital Services programmers. * Brad Fitzpatrick - return values, Bucket object. * Pedro Figueiredo - since 0.54. * Rusty Conover - since 0.80. * Leo Lapworth - since 0.81t000755000765000024 013620607144 13140 5ustar00leostaff000000000000Net-Amazon-S3-0.8900use.t100644000765000024 34113620607144 14377 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t#!perl use strict; use Test::More; use Test::Warnings; use Test::LoadAllModules; plan tests => 1+1; subtest 'use_ok' => sub { all_uses_ok( search_path => 'Net::Amazon::S3', except => [qw/ /], ) }; 01api.t100644000765000024 3423213620607144 14423 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t#!perl use warnings; use strict; use lib 'lib'; use Digest::MD5::File qw(file_md5_hex); use Test::More; use Test::Deep; use FindBin; my $DEFAULT_TEST_LOCATIONS = 'us-east-1,eu-west-1'; plan skip_all => 'Testing this module for real costs money. Enable it by setting true value to env variable AMAZON_S3_EXPENSIVE_TESTS' unless $ENV{'AMAZON_S3_EXPENSIVE_TESTS'}; plan skip_all => 'Required env variable AWS_ACCESS_KEY_ID not set.' unless $ENV{'AWS_ACCESS_KEY_ID'}; plan skip_all => 'Required env variable AWS_ACCESS_KEY_SECRET not set.' unless $ENV{'AWS_ACCESS_KEY_SECRET'}; diag "AMAZON_S3_TEST_LOCATIONS not set, using default $DEFAULT_TEST_LOCATIONS" unless $ENV{'AMAZON_S3_TEST_LOCATIONS'}; my @locations = split /,/, ($ENV{'AMAZON_S3_TEST_LOCATIONS'} || $DEFAULT_TEST_LOCATIONS); plan tests => 37 * @locations + 1; use_ok('Net::Amazon::S3'); use vars qw/$OWNER_ID $OWNER_DISPLAYNAME/; my $aws_access_key_id = $ENV{'AWS_ACCESS_KEY_ID'}; my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'}; my $s3 = Net::Amazon::S3->new( { aws_access_key_id => $aws_access_key_id, aws_secret_access_key => $aws_secret_access_key, retry => 1, } ); # list all buckets that i own my $response = $s3->buckets; $OWNER_ID = $response->{owner_id}; $OWNER_DISPLAYNAME = $response->{owner_displayname}; for my $location ( @locations ) { my $TEST_SUITE_LENGTH = 36; # without last delete ok my $bucket_obj; SKIP: { # create a bucket # make sure it's a valid hostname for EU testing my $bucketname = 'net-amazon-s3-test-' . lc($aws_access_key_id) . '-' . time; # for testing # my $bucket = $s3->bucket($bucketname); $bucket->delete_bucket; exit; $bucket_obj = $s3->add_bucket( { bucket => $bucketname, acl_short => 'public-read', location_constraint => $location } ) or skip $s3->err . ": " . $s3->errstr, $TEST_SUITE_LENGTH; isa_ok $bucket_obj, "Net::Amazon::S3::Bucket"; my $expected_location = $location; $expected_location = 'us-east-1' unless defined $expected_location; $expected_location = 'eu-west-1' if $expected_location eq 'EU'; is( $bucket_obj->get_location_constraint, $expected_location, "bucket created in expected region" ); like_acl_allusers_read($bucket_obj); ok( $bucket_obj->set_acl( { acl_short => 'private' } ), 'make bucket private using query parameters' ); unlike_acl_allusers_read($bucket_obj); # another way to get a bucket object (does no network I/O, # assumes it already exists). Read Net::Amazon::S3::Bucket. $bucket_obj = $s3->bucket($bucketname); isa_ok $bucket_obj, "Net::Amazon::S3::Bucket"; # fetch contents of the bucket # note prefix, marker, max_keys options can be passed in $response = $bucket_obj->list or skip $s3->err . ": " . $s3->errstr, $TEST_SUITE_LENGTH - 6; cmp_deeply $response, superhashof({ bucket => $bucketname, prefix => '', marker => '', max_keys => 1_000, is_truncated => 0, keys => [], }, "list empty bucket"); is( undef, $bucket_obj->get_key("non-existing-key"), "get non existing key" ); my $keyname = 'testing.txt'; { # Create a publicly readable key, then turn it private with a short acl. # This key will persist past the end of the block. my $value = 'T'; $bucket_obj->add_key( $keyname, $value, { content_type => 'text/plain', 'x-amz-meta-colour' => 'orange', acl_short => 'public-read', } ); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname", 200, "can access the publicly readable key" ); like_acl_allusers_read( $bucket_obj, $keyname ); ok( $bucket_obj->set_acl( { key => $keyname, acl_short => 'private' } ), "change key policy of private using acl_short"); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname", 403, "cannot access the private key" ); unlike_acl_allusers_read( $bucket_obj, $keyname ); ok( $bucket_obj->set_acl( { key => $keyname, acl_xml => acl_xml_from_acl_short('public-read') } ), "change key policy to public using acl_xml" ); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname", 200, "can access the publicly readable key after acl_xml set" ); like_acl_allusers_read( $bucket_obj, $keyname ); ok( $bucket_obj->set_acl( { key => $keyname, acl_xml => acl_xml_from_acl_short('private') } ), "change key policy to private using acl_xml" ); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname", 403, "cannot access the private key after acl_xml set" ); unlike_acl_allusers_read( $bucket_obj, $keyname ); } { # Create a private key, then make it publicly readable with a short # acl. Delete it at the end so we're back to having a single key in # the bucket. my $keyname2 = 'testing2.txt'; my $value = 'T2'; $bucket_obj->add_key( $keyname2, $value, { content_type => 'text/plain', 'x-amz-meta-colour' => 'blue', acl_short => 'private', } ); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname2", 403, "cannot access the private key" ); unlike_acl_allusers_read( $bucket_obj, $keyname2 ); ok( $bucket_obj->set_acl( { key => $keyname2, acl_short => 'public-read' } ), "change private key to public" ); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname2", 200, "can access the publicly readable key" ); like_acl_allusers_read( $bucket_obj, $keyname2 ); $bucket_obj->delete_key($keyname2); } { # Copy a key, keeping metadata my $keyname2 = 'testing2.txt'; $bucket_obj->copy_key( $keyname2, "/$bucketname/$keyname" ); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname2", 403, "cannot access the private key" ); # Overwrite, making publically readable $bucket_obj->copy_key( $keyname2, "/$bucketname/$keyname", { acl_short => 'public-read' } ); sleep 1; is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname2", 200, "can access the publicly readable key" ); # Now copy it over itself, making it private $bucket_obj->edit_metadata( $keyname2, { short_acl => 'private' } ); is_request_response_code( "http://$bucketname.s3.amazonaws.com/$keyname2", 403, "cannot access the private key" ); # Get rid of it, bringing us back to only one key $bucket_obj->delete_key($keyname2); # Expect a nonexistent key copy to fail ok( !$bucket_obj->copy_key( "newkey", "/$bucketname/$keyname2" ), "Copying a nonexistent key fails" ); } # list keys in the bucket $response = $bucket_obj->list or skip $s3->err . ": " . $s3->errstr, $TEST_SUITE_LENGTH - 28; cmp_deeply $response, superhashof({ bucket => $bucketname, prefix => '', marker => '', max_keys => 1_000, is_truncated => 0, keys => [ superhashof({ key => $keyname, # the etag is the MD5 of the value etag => 'b9ece18c950afbfa6b0fdbfa4ff731d3', size => 1, owner_id => $OWNER_ID, owner_displayname => $OWNER_DISPLAYNAME, })], }), "list bucket with 1 key"; # You can't delete a bucket with things in it ok( !$bucket_obj->delete_bucket(), "cannot delete non-empty bucket" ); $bucket_obj->delete_key($keyname); # now play with the file methods my $README_FILE = "$FindBin::Bin/../README.md"; my $README_DEST = "$FindBin::Bin/README.md"; my $readme_md5 = file_md5_hex($README_FILE); my $readme_size = -s $README_FILE; $keyname .= "2"; $bucket_obj->add_key_filename( $keyname, $README_FILE, { content_type => 'text/plain', 'x-amz-meta-colour' => 'orangy', } ); $response = $bucket_obj->get_key($keyname); cmp_deeply $response, superhashof({ content_type => 'text/plain', value => re( qr/Amazon Digital Services/ ), etag => $readme_md5, 'x-amz-meta-colour' => 'orangy', content_length => $readme_size, }), "fetch key-from-file into memory"; unlink($README_DEST); $response = $bucket_obj->get_key_filename( $keyname, undef, $README_DEST ); cmp_deeply $response, superhashof({ content_type => 'text/plain', value => '', etag => $readme_md5, 'x-amz-meta-colour' => 'orangy', content_length => $readme_size, }), "fetch key-from-file into file"; is( file_md5_hex($README_DEST), $readme_md5, "downloaded key-from-file checksum match" ); $bucket_obj->delete_key($keyname); # try empty files $keyname .= "3"; $bucket_obj->add_key( $keyname, '' ); $response = $bucket_obj->get_key($keyname); cmp_deeply $response, superhashof({ value => '', etag => 'd41d8cd98f00b204e9800998ecf8427e', content_type => 'binary/octet-stream', content_length => 0, }), "fetch empty key into memory"; $bucket_obj->delete_key($keyname); # how about using add_key_filename? my $EMPTY_FILE = "$FindBin::Bin/empty"; $keyname .= '4'; open FILE, ">", $EMPTY_FILE or skip "Can't open $EMPTY_FILE for write: $!", $TEST_SUITE_LENGTH - 34; close FILE; $bucket_obj->add_key_filename( $keyname, $EMPTY_FILE ); $response = $bucket_obj->get_key($keyname); cmp_deeply $response, superhashof({ value => '', etag => 'd41d8cd98f00b204e9800998ecf8427e', content_type => 'binary/octet-stream', content_length => 0, }), "fetch empty-key-from-file into memory"; $bucket_obj->delete_key($keyname); unlink $EMPTY_FILE; # fetch contents of the bucket # note prefix, marker, max_keys options can be passed in $response = $bucket_obj->list or skip $s3->err . ": " . $s3->errstr, $TEST_SUITE_LENGTH - 35; cmp_deeply $response, superhashof({ bucket => $bucketname, prefix => '', marker => '', max_keys => 1_000, is_truncated => 0, keys => [], }), "list bucket with all keys deleted"; } ok( $bucket_obj->delete_bucket() ); } # see more docs in Net::Amazon::S3::Bucket # local test methods sub is_request_response_code { my ( $url, $code, $message ) = @_; my $request = HTTP::Request->new( 'GET', $url ); #warn $request->as_string(); my $response = $s3->ua->request($request); is( $response->code, $code, $message ); } sub like_acl_allusers_read { my ( $bucketobj, $keyname ) = @_; my $message = acl_allusers_read_message( 'like', @_ ); like( $bucketobj->get_acl($keyname), qr(AllUsers.+READ), $message ); } sub unlike_acl_allusers_read { my ( $bucketobj, $keyname ) = @_; my $message = acl_allusers_read_message( 'unlike', @_ ); unlike( $bucketobj->get_acl($keyname), qr(AllUsers.+READ), $message ); } sub acl_allusers_read_message { my ( $like_or_unlike, $bucketobj, $keyname ) = @_; my $message = $like_or_unlike . "_acl_allusers_read: " . $bucketobj->bucket; $message .= " - $keyname" if $keyname; return $message; } sub acl_xml_from_acl_short { my $acl_short = shift || 'private'; my $public_read = ''; if ( $acl_short eq 'public-read' ) { $public_read = qq~ http://acs.amazonaws.com/groups/global/AllUsers READ ~; } return qq~ $OWNER_ID $OWNER_DISPLAYNAME $OWNER_ID $OWNER_DISPLAYNAME FULL_CONTROL $public_read ~; } META.json100644000765000024 1252213620607144 14500 0ustar00leostaff000000000000Net-Amazon-S3-0.89{ "abstract" : "Use the Amazon S3 - Simple Storage Service", "author" : [ "Leo Lapworth " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Net-Amazon-S3", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" }, "suggests" : { "JSON::PP" : "2.27300" } }, "runtime" : { "recommends" : { "VM::EC2::Security::CredentialCache" : "0" }, "requires" : { "Carp" : "0", "Data::Stream::Bulk::Callback" : "0", "DateTime::Format::HTTP" : "0", "Digest::HMAC_SHA1" : "0", "Digest::MD5" : "0", "Digest::MD5::File" : "0", "Digest::SHA" : "0", "Exporter::Tiny" : "0", "File::Find::Rule" : "0", "File::stat" : "0", "Getopt::Long" : "0", "HTTP::Date" : "0", "HTTP::Response" : "0", "HTTP::Status" : "0", "Hash::Util" : "0", "IO::File" : "1.14", "LWP" : "6.03", "LWP::UserAgent::Determined" : "0", "MIME::Base64" : "0", "MIME::Types" : "0", "Moose" : "0.85", "Moose::Object" : "0", "Moose::Role" : "0", "Moose::Util" : "0", "Moose::Util::TypeConstraints" : "0", "MooseX::Role::Parameterized" : "0", "MooseX::StrictConstructor" : "0.16", "MooseX::Types::DateTime::MoreCoercions" : "0.07", "Path::Class" : "0", "Pod::Usage" : "0", "Ref::Util" : "0", "Regexp::Common" : "0", "Scalar::Util" : "0", "Sub::Override" : "0", "Term::Encoding" : "0", "Term::ProgressBar::Simple" : "0", "Test::Deep" : "0", "Test::More" : "0", "Time::Piece" : "0", "URI" : "0", "URI::Escape" : "0", "URI::QueryParam" : "0", "XML::LibXML" : "0", "XML::LibXML::XPathContext" : "0", "namespace::clean" : "0", "parent" : "0", "sort" : "0", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "File::Temp" : "0", "FindBin" : "0", "LWP::Simple" : "0", "Moose::Meta::Class" : "0", "Test::Exception" : "0", "Test::LoadAllModules" : "0", "Test::MockTime" : "0", "Test::Warnings" : "0", "lib" : "0", "vars" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/rustyconover/net-amazon-s3/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/rustyconover/net-amazon-s3", "web" : "https://github.com/rustyconover/net-amazon-s3" } }, "version" : "0.89", "x_contributors" : [ "Aaron Crane ", "Ali Anari ", "Ali Zia ", "Ali ", "Branislav Zahradnik ", "Branislav Zahradn\u00edk ", "Christian Lackas ", "Douglas Sims ", "Dylan William Hardison ", "Eden Crane <>", "Florian Schlichting ", "Gabriel Andrade ", "Gabriel Andrade ", "Gavin Carr ", "Haruka Iwao ", "Jun Kuriyama ", "Leo Lapworth ", "Leon Brocard ", "Michael Schout ", "Michal Josef \u0160pa\u010dek ", "Michele Beltrame ", "Michele Beltrame ", "Miquel Ruiz ", "Panu Ervamaa ", "Pavel A. Karoukin ", "Pedro Figueiredo ", "Pedro Figueiredo ", "Pedro Figueiredo ", "perlpong ", "Renato Santos ", "robert clarke ", "Robert Ward ", "Rusty Conover ", "Rusty Conover ", "Rusty Conover ", "Rusty Conover ", "Slobodan Mis\u030ckovic\u0301 ", "Steven Berler ", "Struan Bartlett ", "Stuart Skelton ", "Tom Hukins ", "toritori0318 ", "Yanick Champoux " ], "x_generated_by_perl" : "v5.28.2", "x_serialization_backend" : "Cpanel::JSON::XS version 4.11" } request.t100644000765000024 356613620607144 15167 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 15; use Test::Warnings; use Moose::Meta::Class; use Net::Amazon::S3; use Shared::Examples::Net::Amazon::S3::Request ( qw[ expect_request_class ], qw[ expect_request_instance ], ); my $request_class; sub request_class { ($request_class) = @_; expect_request_class $request_class; } sub request_path { my ($title, %params) = @_; my $request = expect_request_instance request_class => $request_class, (with_bucket => $params{with_bucket}) x exists $params{with_bucket}, (with_key => $params{with_key}) x exists $params{with_key}, ; my $request_path = $request->_build_signed_request ( method => 'GET', path => $request->_request_path, )->path; is $request_path, $params{expect}, $title, ; } request_class 'Net::Amazon::S3::Request::Service'; request_path 'service request should return empty path', expect => '', ; request_class 'Net::Amazon::S3::Request::Bucket'; request_path 'bucket request', with_bucket => 'some-bucket', expect => 'some-bucket/', ; request_class 'Net::Amazon::S3::Request::Object'; request_path 'object request with empty key', with_bucket => 'some-bucket', with_key => '', expect => 'some-bucket/', ; request_path 'object request should recognize leading slash', with_bucket => 'some-bucket', with_key => '/some/key', expect => 'some-bucket/some/key', ; request_path 'object request should sanitize key with slash sequences', with_bucket => 'some-bucket', with_key => '//some///key', expect =>'some-bucket/some/key', ; request_path 'object request should uri-escape key', with_bucket => 'some-bucket', with_key => 'some/ %/key', expect => 'some-bucket/some/%20%25/key', ; 03token.t100644000765000024 163113620607144 14751 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t#!perl use warnings; use strict; use lib 'lib'; use Test::More; use Test::Exception; unless ( $ENV{'AWS_ACCESS_KEY_ID'} and $ENV{'AWS_ACCESS_KEY_SECRET'} and $ENV{'AWS_ACCESS_TOKEN'} ) { plan skip_all => 'Need these vars in ENV: AWS_ACCESS_KEY_ID, ' . 'AWS_ACCESS_KEY_SECRET, AWS_ACCESS_TOKEN'; } else { plan tests => 1 + 1; } use_ok('Net::Amazon::S3'); my $aws_access_key_id = $ENV{'AWS_ACCESS_KEY_ID'}; my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'}; my $aws_session_token = $ENV{'AWS_ACCESS_TOKEN'}; my $s3 = Net::Amazon::S3->new( { aws_access_key_id => $aws_access_key_id, aws_secret_access_key => $aws_secret_access_key, aws_session_token => $aws_session_token, retry => 1, } ); # list all buckets that i own my $response = $s3->buckets; ok($response, "Authentication with token succeded"); Makefile.PL100644000765000024 762413620607144 15020 0ustar00leostaff000000000000Net-Amazon-S3-0.89# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Use the Amazon S3 - Simple Storage Service", "AUTHOR" => "Leo Lapworth ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Net-Amazon-S3", "EXE_FILES" => [ "bin/s3cl" ], "LICENSE" => "perl", "NAME" => "Net::Amazon::S3", "PREREQ_PM" => { "Carp" => 0, "Data::Stream::Bulk::Callback" => 0, "DateTime::Format::HTTP" => 0, "Digest::HMAC_SHA1" => 0, "Digest::MD5" => 0, "Digest::MD5::File" => 0, "Digest::SHA" => 0, "Exporter::Tiny" => 0, "File::Find::Rule" => 0, "File::stat" => 0, "Getopt::Long" => 0, "HTTP::Date" => 0, "HTTP::Response" => 0, "HTTP::Status" => 0, "Hash::Util" => 0, "IO::File" => "1.14", "LWP" => "6.03", "LWP::UserAgent::Determined" => 0, "MIME::Base64" => 0, "MIME::Types" => 0, "Moose" => "0.85", "Moose::Object" => 0, "Moose::Role" => 0, "Moose::Util" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Role::Parameterized" => 0, "MooseX::StrictConstructor" => "0.16", "MooseX::Types::DateTime::MoreCoercions" => "0.07", "Path::Class" => 0, "Pod::Usage" => 0, "Ref::Util" => 0, "Regexp::Common" => 0, "Scalar::Util" => 0, "Sub::Override" => 0, "Term::Encoding" => 0, "Term::ProgressBar::Simple" => 0, "Test::Deep" => 0, "Test::More" => 0, "Time::Piece" => 0, "URI" => 0, "URI::Escape" => 0, "URI::QueryParam" => 0, "XML::LibXML" => 0, "XML::LibXML::XPathContext" => 0, "namespace::clean" => 0, "parent" => 0, "sort" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "File::Temp" => 0, "FindBin" => 0, "LWP::Simple" => 0, "Moose::Meta::Class" => 0, "Test::Exception" => 0, "Test::LoadAllModules" => 0, "Test::MockTime" => 0, "Test::Warnings" => 0, "lib" => 0, "vars" => 0 }, "VERSION" => "0.89", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Data::Stream::Bulk::Callback" => 0, "DateTime::Format::HTTP" => 0, "Digest::HMAC_SHA1" => 0, "Digest::MD5" => 0, "Digest::MD5::File" => 0, "Digest::SHA" => 0, "Exporter::Tiny" => 0, "File::Find::Rule" => 0, "File::Temp" => 0, "File::stat" => 0, "FindBin" => 0, "Getopt::Long" => 0, "HTTP::Date" => 0, "HTTP::Response" => 0, "HTTP::Status" => 0, "Hash::Util" => 0, "IO::File" => "1.14", "LWP" => "6.03", "LWP::Simple" => 0, "LWP::UserAgent::Determined" => 0, "MIME::Base64" => 0, "MIME::Types" => 0, "Moose" => "0.85", "Moose::Meta::Class" => 0, "Moose::Object" => 0, "Moose::Role" => 0, "Moose::Util" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Role::Parameterized" => 0, "MooseX::StrictConstructor" => "0.16", "MooseX::Types::DateTime::MoreCoercions" => "0.07", "Path::Class" => 0, "Pod::Usage" => 0, "Ref::Util" => 0, "Regexp::Common" => 0, "Scalar::Util" => 0, "Sub::Override" => 0, "Term::Encoding" => 0, "Term::ProgressBar::Simple" => 0, "Test::Deep" => 0, "Test::Exception" => 0, "Test::LoadAllModules" => 0, "Test::MockTime" => 0, "Test::More" => 0, "Test::Warnings" => 0, "Time::Piece" => 0, "URI" => 0, "URI::Escape" => 0, "URI::QueryParam" => 0, "XML::LibXML" => 0, "XML::LibXML::XPathContext" => 0, "lib" => 0, "namespace::clean" => 0, "parent" => 0, "sort" => 0, "strict" => 0, "vars" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); README.mkdn100644000765000024 3522013620607144 14667 0ustar00leostaff000000000000Net-Amazon-S3-0.89# NAME Net::Amazon::S3 - Use the Amazon S3 - Simple Storage Service # VERSION version 0.89 # SYNOPSIS use Net::Amazon::S3; my $aws_access_key_id = 'fill me in'; my $aws_secret_access_key = 'fill me in too'; my $s3 = Net::Amazon::S3->new( { aws_access_key_id => $aws_access_key_id, aws_secret_access_key => $aws_secret_access_key, # or use an IAM role. use_iam_role => 1 retry => 1, } ); # a bucket is a globally-unique directory # list all buckets that i own my $response = $s3->buckets; foreach my $bucket ( @{ $response->{buckets} } ) { print "You have a bucket: " . $bucket->bucket . "\n"; } # create a new bucket my $bucketname = 'acmes_photo_backups'; my $bucket = $s3->add_bucket( { bucket => $bucketname } ) or die $s3->err . ": " . $s3->errstr; # or use an existing bucket $bucket = $s3->bucket($bucketname); # store a file in the bucket $bucket->add_key_filename( '1.JPG', 'DSC06256.JPG', { content_type => 'image/jpeg', }, ) or die $s3->err . ": " . $s3->errstr; # store a value in the bucket $bucket->add_key( 'reminder.txt', 'this is where my photos are backed up' ) or die $s3->err . ": " . $s3->errstr; # list files in the bucket $response = $bucket->list_all or die $s3->err . ": " . $s3->errstr; foreach my $key ( @{ $response->{keys} } ) { my $key_name = $key->{key}; my $key_size = $key->{size}; print "Bucket contains key '$key_name' of size $key_size\n"; } # fetch file from the bucket $response = $bucket->get_key_filename( '1.JPG', 'GET', 'backup.jpg' ) or die $s3->err . ": " . $s3->errstr; # fetch value from the bucket $response = $bucket->get_key('reminder.txt') or die $s3->err . ": " . $s3->errstr; print "reminder.txt:\n"; print " content length: " . $response->{content_length} . "\n"; print " content type: " . $response->{content_type} . "\n"; print " etag: " . $response->{content_type} . "\n"; print " content: " . $response->{value} . "\n"; # delete keys $bucket->delete_key('reminder.txt') or die $s3->err . ": " . $s3->errstr; $bucket->delete_key('1.JPG') or die $s3->err . ": " . $s3->errstr; # and finally delete the bucket $bucket->delete_bucket or die $s3->err . ": " . $s3->errstr; # DESCRIPTION This module provides a Perlish interface to Amazon S3. From the developer blurb: "Amazon S3 is storage for the Internet. It is designed to make web-scale computing easier for developers. Amazon S3 provides a simple web services interface that can be used to store and retrieve any amount of data, at any time, from anywhere on the web. It gives any developer access to the same highly scalable, reliable, fast, inexpensive data storage infrastructure that Amazon uses to run its own global network of web sites. The service aims to maximize benefits of scale and to pass those benefits on to developers". To find out more about S3, please visit: http://s3.amazonaws.com/ To use this module you will need to sign up to Amazon Web Services and provide an "Access Key ID" and " Secret Access Key". If you use this module, you will incurr costs as specified by Amazon. Please check the costs. If you use this module with your Access Key ID and Secret Access Key you must be responsible for these costs. I highly recommend reading all about S3, but in a nutshell data is stored in values. Values are referenced by keys, and keys are stored in buckets. Bucket names are global. Note: This is the legacy interface, please check out [Net::Amazon::S3::Client](https://metacpan.org/pod/Net::Amazon::S3::Client) instead. Development of this code happens here: https://github.com/rustyconover/net-amazon-s3 # METHODS ## new Create a new S3 client object. Takes some arguments: - aws\_access\_key\_id Use your Access Key ID as the value of the AWSAccessKeyId parameter in requests you send to Amazon Web Services (when required). Your Access Key ID identifies you as the party responsible for the request. - aws\_secret\_access\_key Since your Access Key ID is not encrypted in requests to AWS, it could be discovered and used by anyone. Services that are not free require you to provide additional information, a request signature, to verify that a request containing your unique Access Key ID could only have come from you. DO NOT INCLUDE THIS IN SCRIPTS OR APPLICATIONS YOU DISTRIBUTE. YOU'LL BE SORRY - aws\_session\_token If you are using temporary credentials provided by the AWS Security Token Service, set the token here, and it will be added to the request in order to authenticate it. - use\_iam\_role If you'd like to use IAM provided temporary credentials, pass this option with a true value. - secure Set this to `0` if you don't want to use SSL-encrypted connections when talking to S3. Defaults to `1`. To use SSL-encrypted connections, LWP::Protocol::https is required. - keep\_alive\_cache\_size Set this to `0` to disable Keep-Alives. Default is `10`. - timeout How many seconds should your script wait before bailing on a request to S3? Defaults to 30. - retry If this library should retry upon errors. This option is recommended. This uses exponential backoff with retries after 1, 2, 4, 8, 16, 32 seconds, as recommended by Amazon. Defaults to off. - host The S3 host endpoint to use. Defaults to 's3.amazonaws.com'. This allows you to connect to any S3-compatible host. - use\_virtual\_host Use the virtual host method ('bucketname.s3.amazonaws.com') instead of specifying the bucket at the first part of the path. This is particularly useful if you want to access buckets not located in the US-Standard region (such as EU, Asia Pacific or South America). See [http://docs.aws.amazon.com/AmazonS3/latest/dev/VirtualHosting.html](http://docs.aws.amazon.com/AmazonS3/latest/dev/VirtualHosting.html) for the pros and cons. - authorization\_method Authorization implementation package name. This library provides [Net::Amazon::S3::Signature::V2](https://metacpan.org/pod/Net::Amazon::S3::Signature::V2) and [Net::Amazon::S3::Signature::V4](https://metacpan.org/pod/Net::Amazon::S3::Signature::V4) Default is Signature 4 if host is `s3.amazonaws.com`, Signature 2 otherwise ### Notes When using [Net::Amazon::S3](https://metacpan.org/pod/Net::Amazon::S3) in child processes using fork (such as in combination with the excellent [Parallel::ForkManager](https://metacpan.org/pod/Parallel::ForkManager)) you should create the S3 object in each child, use a fresh LWP::UserAgent in each child, or disable the [LWP::ConnCache](https://metacpan.org/pod/LWP::ConnCache) in the parent: $s3->ua( LWP::UserAgent->new( keep_alive => 0, requests_redirectable => [qw'GET HEAD DELETE PUT POST'] ); ## buckets Returns undef on error, else hashref of results ## add\_bucket Takes a hashref: - bucket The name of the bucket you want to add - acl\_short (optional) See the set\_acl subroutine for documentation on the acl\_short options - location\_constraint (option) Sets the location constraint of the new bucket. If left unspecified, the default S3 datacenter location will be used. Otherwise, you can set it to 'EU' for a European data center - note that costs are different. Returns 0 on failure, Net::Amazon::S3::Bucket object on success ## bucket BUCKET Takes a scalar argument, the name of the bucket you're creating Returns an (unverified) bucket object from an account. Does no network access. ## delete\_bucket Takes either a [Net::Amazon::S3::Bucket](https://metacpan.org/pod/Net::Amazon::S3::Bucket) object or a hashref containing - bucket The name of the bucket to remove Returns false (and fails) if the bucket isn't empty. Returns true if the bucket is successfully deleted. ## list\_bucket List all keys in this bucket. Takes a hashref of arguments: MANDATORY - bucket The name of the bucket you want to list keys on OPTIONAL - prefix Restricts the response to only contain results that begin with the specified prefix. If you omit this optional argument, the value of prefix for your query will be the empty string. In other words, the results will be not be restricted by prefix. - delimiter If this optional, Unicode string parameter is included with your request, then keys that contain the same string between the prefix and the first occurrence of the delimiter will be rolled up into a single result element in the CommonPrefixes collection. These rolled-up keys are not returned elsewhere in the response. For example, with prefix="USA/" and delimiter="/", the matching keys "USA/Oregon/Salem" and "USA/Oregon/Portland" would be summarized in the response as a single "USA/Oregon" element in the CommonPrefixes collection. If an otherwise matching key does not contain the delimiter after the prefix, it appears in the Contents collection. Each element in the CommonPrefixes collection counts as one against the MaxKeys limit. The rolled-up keys represented by each CommonPrefixes element do not. If the Delimiter parameter is not present in your request, keys in the result set will not be rolled-up and neither the CommonPrefixes collection nor the NextMarker element will be present in the response. - max-keys This optional argument limits the number of results returned in response to your query. Amazon S3 will return no more than this number of results, but possibly less. Even if max-keys is not specified, Amazon S3 will limit the number of results in the response. Check the IsTruncated flag to see if your results are incomplete. If so, use the Marker parameter to request the next page of results. For the purpose of counting max-keys, a 'result' is either a key in the 'Contents' collection, or a delimited prefix in the 'CommonPrefixes' collection. So for delimiter requests, max-keys limits the total number of list results, not just the number of keys. - marker This optional parameter enables pagination of large result sets. `marker` specifies where in the result set to resume listing. It restricts the response to only contain results that occur alphabetically after the value of marker. To retrieve the next page of results, use the last key from the current page of results as the marker in your next request. See also `next_marker`, below. If `marker` is omitted,the first page of results is returned. Returns undef on error and a hashref of data on success: The hashref looks like this: { bucket => $bucket_name, prefix => $bucket_prefix, common_prefixes => [$prefix1,$prefix2,...] marker => $bucket_marker, next_marker => $bucket_next_available_marker, max_keys => $bucket_max_keys, is_truncated => $bucket_is_truncated_boolean keys => [$key1,$key2,...] } Explanation of bits of that: - common\_prefixes If list\_bucket was requested with a delimiter, common\_prefixes will contain a list of prefixes matching that delimiter. Drill down into these prefixes by making another request with the prefix parameter. - is\_truncated B flag that indicates whether or not all results of your query were returned in this response. If your results were truncated, you can make a follow-up paginated request using the Marker parameter to retrieve the rest of the results. - next\_marker A convenience element, useful when paginating with delimiters. The value of `next_marker`, if present, is the largest (alphabetically) of all key names and all CommonPrefixes prefixes in the response. If the `is_truncated` flag is set, request the next page of results by setting `marker` to the value of `next_marker`. This element is only present in the response if the `delimiter` parameter was sent with the request. Each key is a hashref that looks like this: { key => $key, last_modified => $last_mod_date, etag => $etag, # An MD5 sum of the stored content. size => $size, # Bytes storage_class => $storage_class # Doc? owner_id => $owner_id, owner_displayname => $owner_name } ## list\_bucket\_all List all keys in this bucket without having to worry about 'marker'. This is a convenience method, but may make multiple requests to S3 under the hood. Takes the same arguments as list\_bucket. ## add\_key DEPRECATED. DO NOT USE ## get\_key DEPRECATED. DO NOT USE ## head\_key DEPRECATED. DO NOT USE ## delete\_key DEPRECATED. DO NOT USE # LICENSE This module contains code modified from Amazon that contains the following notice: # This software code is made available "AS IS" without warranties of any # kind. You may copy, display, modify and redistribute the software # code either by itself or as incorporated into your code; provided that # you do not remove any proprietary notices. Your use of this software # code is at your own risk and you waive any claim against Amazon # Digital Services, Inc. or its affiliates with respect to your use of # this software code. (c) 2006 Amazon Digital Services, Inc. or its # affiliates. # TESTING Testing S3 is a tricky thing. Amazon wants to charge you a bit of money each time you use their service. And yes, testing counts as using. Because of this, the application's test suite skips anything approaching a real test unless you set these three environment variables: - AMAZON\_S3\_EXPENSIVE\_TESTS Doesn't matter what you set it to. Just has to be set - AWS\_ACCESS\_KEY\_ID Your AWS access key - AWS\_ACCESS\_KEY\_SECRET Your AWS sekkr1t passkey. Be forewarned that setting this environment variable on a shared system might leak that information to another user. Be careful. # AUTHOR Leon Brocard and unknown Amazon Digital Services programmers. Brad Fitzpatrick - return values, Bucket object Pedro Figueiredo - since 0.54 # SEE ALSO [Net::Amazon::S3::Bucket](https://metacpan.org/pod/Net::Amazon::S3::Bucket) # AUTHOR Leo Lapworth # COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. 02client.t100755000765000024 2752413620607144 15142 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t#!perl use warnings; use strict; use lib 'lib'; use Digest::MD5::File qw(file_md5_hex); use LWP::Simple; use File::stat; use Test::More; use Test::Exception; use File::Temp qw/ :seekable /; unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) { plan skip_all => 'Testing this module for real costs money.'; } else { plan tests => 53; } use_ok('Net::Amazon::S3'); my $aws_access_key_id = $ENV{'AWS_ACCESS_KEY_ID'}; my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'}; my $s3 = Net::Amazon::S3->new( aws_access_key_id => $aws_access_key_id, aws_secret_access_key => $aws_secret_access_key, retry => 1, ); my $readme_size = stat('README.md')->size; my $readme_md5hex = file_md5_hex('README.md'); my $client = Net::Amazon::S3::Client->new( s3 => $s3 ); my @buckets = $client->buckets; my $bucket_name = 'net-amazon-s3-test-' . lc($aws_access_key_id) . '-'. time; my $bucket = $client->create_bucket( name => $bucket_name, acl_short => 'public-read', location_constraint => 'EU', ); eval { is( $bucket->name, $bucket_name, 'newly created bucket has correct name' ); like( $bucket->acl, qr{[a-z0-9]{64}.+?[a-z0-9]{64}.+?FULL_CONTROLhttp://acs.amazonaws.com/groups/global/AllUsersREAD}, 'newly created bucket is public-readable' ); is( $bucket->location_constraint, 'eu-west-1', 'newly created bucket is in the EU' ); my $stream = $bucket->list; until ( $stream->is_done ) { foreach my $object ( $stream->items ) { $object->delete; } } my $count = 0; $stream = $bucket->list; until ( $stream->is_done ) { foreach my $object ( $stream->items ) { $count++; } } is( $count, 0, 'newly created bucket has no objects' ); my $object = $bucket->object( key => 'this is the key' ); ok( !$object->exists, 'object does not exist yet' ); $object->put('this is the value'); ok( $object->exists, 'object now exists yet' ); my @objects; @objects = (); $stream = $bucket->list( { prefix => 'this is the key' } ); until ( $stream->is_done ) { foreach my $object ( $stream->items ) { push @objects, $object; } } is( @objects, 1, 'bucket list with prefix finds key' ); @objects = (); $stream = $bucket->list( { prefix => 'this is not the key' } ); until ( $stream->is_done ) { foreach my $object ( $stream->items ) { push @objects, $object; } } is( @objects, 0, 'bucket list with different prefix does not find key' ); @objects = (); $stream = $bucket->list; until ( $stream->is_done ) { foreach my $object ( $stream->items ) { push @objects, $object; } } is( @objects, 1, 'bucket list finds newly created key' ); is( $objects[0]->key, 'this is the key', 'newly created object has the right key' ); is( $objects[0]->etag, '94325a12f8db22ffb6934cc5f22f6698', 'newly created object has the right etag' ); is( $objects[0]->size, '17', 'newly created object has the right size' ); is( $object->get, 'this is the value', 'newly created object has the right value' ); is( $bucket->object( key => 'this is the key' )->get, 'this is the value', 'newly created object fetched by name has the right value' ); is( get( $object->uri ), undef, 'newly created object cannot be fetched by uri' ); $object->expires('2037-01-01'); is( get( $object->query_string_authentication_uri() ), 'this is the value', 'newly created object can be fetch by authentication uri' ); my $signed_url = $object->query_string_authentication_uri({ 'response-content-disposition' => 'attachment; filename=abc.doc' }); like( $signed_url, qr/response-content-disposition/, 'cuttom response headers included in the signed uri' ); is( get( $signed_url ), 'this is the value', 'newly created object can be fetch by authentication uri with custom headers' ); $object->delete; # upload a public object $object = $bucket->object( key => 'this is the public key', acl_short => 'public-read', content_type => 'text/plain', content_encoding => 'identity', expires => '2001-02-03', ); $object->put('this is the public value'); is( get( $object->uri ), 'this is the public value', 'newly created public object is publically accessible' ); is( ( head( $object->uri ) )[0], 'text/plain', 'newly created public object has the right content type' ); is( ( head( $object->uri ) )[3], $object->expires->epoch, 'newly created public object has the right expires' ); $object->delete; # delete a non-existant object $object = $bucket->object( key => 'not here' ); throws_ok { $object->get } qr/NoSuchKey/, 'getting non-existant object throws exception'; # upload a file with put_filename $object = $bucket->object( key => 'the readme' ); $object->put_filename('README.md'); @objects = (); $stream = $bucket->list; until ( $stream->is_done ) { foreach my $object ( $stream->items ) { push @objects, $object; } } is( @objects, 1, 'have newly uploaded object' ); is( $objects[0]->key, 'the readme', 'newly uploaded object has the right key' ); is( $objects[0]->etag, $readme_md5hex, 'newly uploaded object has the right etag' ); is( $objects[0]->size, $readme_size, 'newly created object has the right size' ); ok( $objects[0]->last_modified, 'newly created object has a last modified' ); $object->delete; # upload a public object with put_filename $object = $bucket->object( key => 'the public readme', acl_short => 'public-read' ); $object->put_filename('README.md'); is( length( get( $object->uri ) ), $readme_size, 'newly uploaded public object has the right size' ); $object->delete; # upload a file with put_filename with known md5hex size and AES256 encryption $object = $bucket->object( key => 'the new readme', etag => $readme_md5hex, size => $readme_size, encryption => 'AES256' ); $object->put_filename('README.md'); @objects = (); $stream = $bucket->list; until ( $stream->is_done ) { foreach my $object ( $stream->items ) { push @objects, $object; } } is( @objects, 1, 'have newly uploaded object' ); is( $objects[0]->key, 'the new readme', 'newly uploaded object has the right key' ); is( $objects[0]->etag, $readme_md5hex, 'newly uploaded object has the right etag' ); is( $objects[0]->size, $readme_size, 'newly created object has the right size' ); ok( $objects[0]->last_modified, 'newly created object has a last modified' ); # download an object with get_filename my $tmp_fh = File::Temp->new(); $object->get_filename($tmp_fh->filename); is( stat($tmp_fh->filename)->size, $readme_size, 'download has right size' ); is( file_md5_hex($tmp_fh->filename), $readme_md5hex, 'download has right etag' ); $object->delete; # upload a public object with put_filename with known md5hex and size $object = $bucket->object( key => 'the new public readme', etag => $readme_md5hex, size => $readme_size, acl_short => 'public-read' ); $object->put_filename( 'README.md', $readme_md5hex, $readme_size ); is( length( get( $object->uri ) ), $readme_size, 'newly uploaded public object has the right size' ); $object->delete; { # upload an object using multipart upload and then abort it $object = $bucket->object( key => 'new multipart file soon to be aborted', acl_short => 'public-read' ); my $upload_id; ok( $upload_id = $object->initiate_multipart_upload, "can initiate a new multipart upload -- $upload_id" ); #put part my $put_part_response; ok( $put_part_response = $object->put_part( part_number => 1, upload_id => $upload_id, value => 'x' x ( 5 * 1024 * 1024 ) ), 'Got a successful response for PUT part' ); ok( $put_part_response->header('ETag'), 'etag ok' ); ok( my $abort_response = $object->abort_multipart_upload( upload_id => $upload_id ), 'Got a successful response for DELETE multipart upload' ); ok( !$object->exists, "object has now been deleted" ); } # upload an object using multipart upload $object = $bucket->object( key => 'new multipart file', acl_short => 'public-read' ); my $upload_id; ok($upload_id = $object->initiate_multipart_upload, "can initiate a new multipart upload"); #put part my $put_part_response; ok( $put_part_response = $object->put_part(part_number => 1, upload_id => $upload_id, value => 'x' x (5 * 1024 * 1024)), 'Got a successful response for PUT part' ); my @etags; push @etags, $put_part_response->header('ETag'); ok( $put_part_response = $object->put_part(part_number => 2, upload_id => $upload_id, value => 'z' x (1024 * 1024)), 'Got a successful response for 2nd PUT part' ); push @etags, $put_part_response->header('ETag'); # TODO list part? - We've got this, but how to expose it nicely? #complete multipart upload my $complete_upload_response; ok( $complete_upload_response = $object->complete_multipart_upload( upload_id => $upload_id, part_numbers => [1,2], etags => \@etags), "successful response for complete multipart upload" ); #get the file and check that it looks like we expect ok($object->exists, "object has now been created"); $tmp_fh = File::Temp->new(); $object->get_filename($tmp_fh->filename); is( stat($tmp_fh->filename)->size, 6 * 1024 * 1024, "downloaded file has a size equivalent to the sum of it's parts"); $tmp_fh->seek((5 * 1024 * 1024) - 1, SEEK_SET); #jump to 5MB position my $test_bytes; read($tmp_fh, $test_bytes, 2); is($test_bytes, "xz", "The second chunk of the file begins in the correct place"); #test listing a multipart object $stream = $bucket->list({prefix => 'new multipart file'}); lives_ok {my @items = $stream->items} 'Listing a multipart file does not throw an exeption'; $object->delete; #test multi-object delete #make 3 identical objects @objects =(); for my $i (1..3) { my $bulk_object = $bucket->object( key => "bulk-readme-$i", etag => $readme_md5hex, size => $readme_size ); $bulk_object->put_filename('README.md'); push @objects, $bulk_object; } #now delete 2 of those objects ok($bucket->delete_multi_object(@objects[0..1]), "executed multi delete operation"); ok( !grep($_->exists, @objects[0..1]), "target objects no longer exist"); ok( $objects[2]->exists, "object not included in multi-object delete still exists" ); $objects[2]->delete; }; $bucket->delete; perlcritic.rc100644000765000024 46313620607144 15506 0ustar00leostaff000000000000Net-Amazon-S3-0.89severity = 5 only = 1 force = 0 verbose = 4 top = 50 theme = (pbp || security) && bugs include = NamingConventions ClassHierarchies exclude = Variables Modules::RequirePackage RequireUseStrict RequireUseWarnings criticism-fatal = 1 color = 1 allow-unsafe = 1 pager = less api-object-head.t100644000765000024 510213620607144 16377 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use HTTP::Status; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_object_head ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); expect_api_object_head 'head existing object' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_response_code => HTTP::Status::HTTP_OK, with_response_data => '', with_response_headers => { content_length => 10, content_type => 'text/plain', etag => 'some-key-etag', x_amz_metadata_foo => 'foo-1', date => 'Fri, 09 Sep 2011 23:36:00 GMT', }, expect_request => { HEAD => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => { content_type => 'text/plain', content_length => 10, etag => 'some-key-etag', value => '', date => 'Fri, 09 Sep 2011 23:36:00 GMT', 'x-amz-metadata-foo' => 'foo-1', 'content-type' => 'text/plain', 'content-length' => 10, }, ); expect_api_object_head 'with error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { HEAD => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_access_denied, throws => qr/^Net::Amazon::S3: Amazon responded with 403 Forbidden/i, expect_s3_err => 'network_error', expect_s3_errstr => '403 Forbidden', ); expect_api_object_head 'with error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { HEAD => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_no_such_bucket, expect_data => bool (0), expect_s3_err => undef,, expect_s3_errstr => undef,, ); expect_api_object_head 'with error no such object' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { HEAD => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_no_such_key, expect_data => bool (0), expect_s3_err => undef,, expect_s3_errstr => undef,, ); api-object-fetch.t100644000765000024 513013620607144 16570 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use HTTP::Status; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_object_fetch ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); expect_api_object_fetch 'fetch existing object' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_response_code => HTTP::Status::HTTP_OK, with_response_data => 'some-value', with_response_headers => { content_length => 10, content_type => 'text/plain', etag => 'some-key-etag', x_amz_metadata_foo => 'foo-1', date => 'Fri, 09 Sep 2011 23:36:00 GMT', }, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => { content_type => 'text/plain', content_length => 10, etag => 'some-key-etag', value => 'some-value', date => 'Fri, 09 Sep 2011 23:36:00 GMT', 'x-amz-metadata-foo' => 'foo-1', 'content-type' => 'text/plain', 'content-length' => 10, }, ); expect_api_object_fetch 'with error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_access_denied, throws => qr/^Net::Amazon::S3: Amazon responded with 403 Forbidden/i, expect_s3_err => 'network_error', expect_s3_errstr => '403 Forbidden', ); expect_api_object_fetch 'with error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_no_such_bucket, expect_data => bool (0), expect_s3_err => undef,, expect_s3_errstr => undef,, ); expect_api_object_fetch 'with error no such object' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_no_such_key, expect_data => bool (0), expect_s3_err => undef,, expect_s3_errstr => undef,, ); request-put-part.t100644000765000024 221713620607144 16731 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 2; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'put object' => ( request_class => 'Net::Amazon::S3::Request::PutPart', with_bucket => 'some-bucket', with_key => 'some/key', with_value => 'foo', with_upload_id => '123', with_part_number => '1', expect_request_method => 'PUT', expect_request_path => 'some-bucket/some/key?partNumber=1&uploadId=123', expect_request_headers => { }, ); behaves_like_net_amazon_s3_request 'put object with acl' => ( request_class => 'Net::Amazon::S3::Request::PutPart', with_bucket => 'some-bucket', with_key => 'some/key', with_value => 'foo', with_upload_id => '123', with_part_number => '1', with_acl_short => 'private', expect_request_method => 'PUT', expect_request_path => 'some-bucket/some/key?partNumber=1&uploadId=123', expect_request_headers => { 'x-amz-acl' => 'private' }, ); Amazon000755000765000024 013620607144 15416 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/NetS3.pm100755000765000024 6643513620607144 16442 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazonpackage Net::Amazon::S3; $Net::Amazon::S3::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; # ABSTRACT: Use the Amazon S3 - Simple Storage Service use Carp; use Digest::HMAC_SHA1; use Scalar::Util; use Net::Amazon::S3::Bucket; use Net::Amazon::S3::Client; use Net::Amazon::S3::Client::Bucket; use Net::Amazon::S3::Client::Object; use Net::Amazon::S3::HTTPRequest; use Net::Amazon::S3::Request; use Net::Amazon::S3::Request::AbortMultipartUpload; use Net::Amazon::S3::Request::CompleteMultipartUpload; use Net::Amazon::S3::Request::CreateBucket; use Net::Amazon::S3::Request::DeleteBucket; use Net::Amazon::S3::Request::DeleteMultiObject; use Net::Amazon::S3::Request::DeleteObject; use Net::Amazon::S3::Request::GetBucketAccessControl; use Net::Amazon::S3::Request::GetBucketLocationConstraint; use Net::Amazon::S3::Request::GetObject; use Net::Amazon::S3::Request::GetObjectAccessControl; use Net::Amazon::S3::Request::InitiateMultipartUpload; use Net::Amazon::S3::Request::ListAllMyBuckets; use Net::Amazon::S3::Request::ListBucket; use Net::Amazon::S3::Request::ListParts; use Net::Amazon::S3::Request::PutObject; use Net::Amazon::S3::Request::PutPart; use Net::Amazon::S3::Request::SetBucketAccessControl; use Net::Amazon::S3::Request::SetObjectAccessControl; use Net::Amazon::S3::Signature::V2; use Net::Amazon::S3::Signature::V4; use LWP::UserAgent::Determined; use URI::Escape qw(uri_escape_utf8); use XML::LibXML; use XML::LibXML::XPathContext; my $AMAZON_S3_HOST = 's3.amazonaws.com'; has 'use_iam_role' => ( is => 'ro', isa => 'Bool', required => 0, default => 0); has 'aws_access_key_id' => ( is => 'rw', isa => 'Str', required => 0 ); has 'aws_secret_access_key' => ( is => 'rw', isa => 'Str', required => 0 ); has 'secure' => ( is => 'ro', isa => 'Bool', required => 0, default => 1 ); has 'timeout' => ( is => 'ro', isa => 'Num', required => 0, default => 30 ); has 'retry' => ( is => 'ro', isa => 'Bool', required => 0, default => 0 ); has 'host' => ( is => 'ro', isa => 'Str', required => 0, default => $AMAZON_S3_HOST ); has 'use_virtual_host' => ( is => 'ro', isa => 'Bool', required => 0, lazy => 1, default => sub { $_[0]->authorization_method->enforce_use_virtual_host }, ); has 'libxml' => ( is => 'rw', isa => 'XML::LibXML', required => 0 ); has 'ua' => ( is => 'rw', isa => 'LWP::UserAgent', required => 0 ); has 'err' => ( is => 'rw', isa => 'Maybe[Str]', required => 0 ); has 'errstr' => ( is => 'rw', isa => 'Maybe[Str]', required => 0 ); has 'aws_session_token' => ( is => 'rw', isa => 'Str', required => 0 ); has authorization_method => ( is => 'ro', isa => 'Str', required => 0, lazy => 1, default => sub { $_[0]->host eq $AMAZON_S3_HOST ? 'Net::Amazon::S3::Signature::V4' : 'Net::Amazon::S3::Signature::V2' }, ); has keep_alive_cache_size => ( is => 'ro', isa => 'Int', required => 0, default => 10 ); __PACKAGE__->meta->make_immutable; sub BUILD { my $self = shift; if (!$self->use_iam_role) { if (!defined($self->aws_secret_access_key) || !defined($self->aws_access_key_id)) { die("Must specify aws_secret_access_key and aws_access_key_id"); } } my $ua; if ( $self->retry ) { $ua = LWP::UserAgent::Determined->new( keep_alive => $self->keep_alive_cache_size, requests_redirectable => [qw(GET HEAD DELETE PUT POST)], ); $ua->timing('1,2,4,8,16,32'); } else { $ua = LWP::UserAgent->new( keep_alive => $self->keep_alive_cache_size, requests_redirectable => [qw(GET HEAD DELETE PUT POST)], ); } $ua->timeout( $self->timeout ); $ua->env_proxy; $self->ua($ua); $self->libxml( XML::LibXML->new ); if ($self->use_iam_role) { eval "require VM::EC2::Security::CredentialCache" or die $@; my $creds = VM::EC2::Security::CredentialCache->get(); defined($creds) || die("Unable to retrieve IAM role credentials"); $self->aws_access_key_id($creds->accessKeyId); $self->aws_secret_access_key($creds->secretAccessKey); $self->aws_session_token($creds->sessionToken); } } sub buckets { my $self = shift; my $http_request = Net::Amazon::S3::Request::ListAllMyBuckets->new( s3 => $self ) ->http_request; # die $request->http_request->as_string; my $xpc = $self->_send_request($http_request); return undef unless $xpc && !$self->_remember_errors($xpc); my $owner_id = $xpc->findvalue("//s3:Owner/s3:ID"); my $owner_displayname = $xpc->findvalue("//s3:Owner/s3:DisplayName"); my @buckets; foreach my $node ( $xpc->findnodes(".//s3:Bucket") ) { push @buckets, Net::Amazon::S3::Bucket->new( { bucket => $xpc->findvalue( ".//s3:Name", $node ), creation_date => $xpc->findvalue( ".//s3:CreationDate", $node ), account => $self, } ); } return { owner_id => $owner_id, owner_displayname => $owner_displayname, buckets => \@buckets, }; } sub add_bucket { my ( $self, $conf ) = @_; my $http_request = Net::Amazon::S3::Request::CreateBucket->new( s3 => $self, bucket => $conf->{bucket}, acl_short => $conf->{acl_short}, location_constraint => $conf->{location_constraint}, ( $conf->{region} ? (region => $conf->{region}) : () ), )->http_request; return 0 unless $self->_send_request_expect_nothing($http_request); return $self->bucket( $conf->{bucket} ); } sub bucket { my ( $self, $bucket ) = @_; return $bucket if Scalar::Util::blessed( $bucket ) && $bucket->isa( 'Net::Amazon::S3::Bucket' ); return Net::Amazon::S3::Bucket->new( { bucket => $bucket, account => $self } ); } sub delete_bucket { my ( $self, $conf ) = @_; my $bucket; if ( eval { $conf->isa("Net::S3::Amazon::Bucket"); } ) { $bucket = $conf->bucket; } else { $bucket = $conf->{bucket}; } croak 'must specify bucket' unless $bucket; my $http_request = Net::Amazon::S3::Request::DeleteBucket->new( s3 => $self, bucket => $bucket, )->http_request; return $self->_send_request_expect_nothing($http_request); } sub list_bucket { my ( $self, $conf ) = @_; my $http_request = Net::Amazon::S3::Request::ListBucket->new( s3 => $self, bucket => $conf->{bucket}, delimiter => $conf->{delimiter}, max_keys => $conf->{max_keys}, marker => $conf->{marker}, prefix => $conf->{prefix}, )->http_request; my $xpc = $self->_send_request($http_request); return undef unless $xpc && !$self->_remember_errors($xpc); my $return = { bucket => $xpc->findvalue("//s3:ListBucketResult/s3:Name"), prefix => $xpc->findvalue("//s3:ListBucketResult/s3:Prefix"), marker => $xpc->findvalue("//s3:ListBucketResult/s3:Marker"), next_marker => $xpc->findvalue("//s3:ListBucketResult/s3:NextMarker"), max_keys => $xpc->findvalue("//s3:ListBucketResult/s3:MaxKeys"), is_truncated => ( scalar $xpc->findvalue("//s3:ListBucketResult/s3:IsTruncated") eq 'true' ? 1 : 0 ), }; my @keys; foreach my $node ( $xpc->findnodes(".//s3:Contents") ) { my $etag = $xpc->findvalue( ".//s3:ETag", $node ); $etag =~ s/^"//; $etag =~ s/"$//; push @keys, { key => $xpc->findvalue( ".//s3:Key", $node ), last_modified => $xpc->findvalue( ".//s3:LastModified", $node ), etag => $etag, size => $xpc->findvalue( ".//s3:Size", $node ), storage_class => $xpc->findvalue( ".//s3:StorageClass", $node ), owner_id => $xpc->findvalue( ".//s3:ID", $node ), owner_displayname => $xpc->findvalue( ".//s3:DisplayName", $node ), }; } $return->{keys} = \@keys; if ( $conf->{delimiter} ) { my @common_prefixes; my $strip_delim = qr/$conf->{delimiter}$/; foreach my $node ( $xpc->findnodes(".//s3:CommonPrefixes") ) { my $prefix = $xpc->findvalue( ".//s3:Prefix", $node ); # strip delimiter from end of prefix $prefix =~ s/$strip_delim//; push @common_prefixes, $prefix; } $return->{common_prefixes} = \@common_prefixes; } return $return; } sub list_bucket_all { my ( $self, $conf ) = @_; $conf ||= {}; my $bucket = $conf->{bucket}; croak 'must specify bucket' unless $bucket; my $response = $self->list_bucket($conf); return $response unless $response->{is_truncated}; my $all = $response; while (1) { my $next_marker = $response->{next_marker} || $response->{keys}->[-1]->{key}; $conf->{marker} = $next_marker; $conf->{bucket} = $bucket; $response = $self->list_bucket($conf); push @{ $all->{keys} }, @{ $response->{keys} }; last unless $response->{is_truncated}; } delete $all->{is_truncated}; delete $all->{next_marker}; return $all; } sub _compat_bucket { my ( $self, $conf ) = @_; return Net::Amazon::S3::Bucket->new( { account => $self, bucket => delete $conf->{bucket} } ); } # compat wrapper; deprecated as of 2005-03-23 sub add_key { my ( $self, $conf ) = @_; my $bucket = $self->_compat_bucket($conf); my $key = delete $conf->{key}; my $value = delete $conf->{value}; return $bucket->add_key( $key, $value, $conf ); } # compat wrapper; deprecated as of 2005-03-23 sub get_key { my ( $self, $conf ) = @_; my $bucket = $self->_compat_bucket($conf); return $bucket->get_key( $conf->{key} ); } # compat wrapper; deprecated as of 2005-03-23 sub head_key { my ( $self, $conf ) = @_; my $bucket = $self->_compat_bucket($conf); return $bucket->head_key( $conf->{key} ); } # compat wrapper; deprecated as of 2005-03-23 sub delete_key { my ( $self, $conf ) = @_; my $bucket = $self->_compat_bucket($conf); return $bucket->delete_key( $conf->{key} ); } sub _validate_acl_short { my ( $self, $policy_name ) = @_; # Current list at https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl if (!grep( { $policy_name eq $_ } qw(private public-read public-read-write aws-exec-read authenticated-read bucket-owner-read bucket-owner-full-control log-delivery-write ) ) ) { croak "$policy_name is not a supported canned access policy"; } } # $self->_send_request($HTTP::Request) # $self->_send_request(@params_to_make_request) sub _send_request { my ( $self, $http_request ) = @_; # warn $http_request->as_string; my $response = $self->_do_http($http_request); my $content = $response->content; return $content unless $response->content_type eq 'application/xml'; return unless $content; return $self->_xpc_of_content($content); } # centralize all HTTP work, for debugging sub _do_http { my ( $self, $http_request, $filename ) = @_; confess 'Need HTTP::Request object' if ( ref($http_request) ne 'HTTP::Request' ); # convenient time to reset any error conditions $self->err(undef); $self->errstr(undef); return $self->ua->request( $http_request, $filename ); } sub _send_request_expect_nothing { my ( $self, $http_request ) = @_; # warn $http_request->as_string; my $response = $self->_do_http($http_request); return 1 if $response->code =~ /^2\d\d$/; # anything else is a failure, and we save the parsed result $self->_remember_errors( $response->content ); return 0; } sub _croak_if_response_error { my ( $self, $response ) = @_; unless ( $response->code =~ /^2\d\d$/ ) { $self->err("network_error"); $self->errstr( $response->status_line ); croak "Net::Amazon::S3: Amazon responded with " . $response->status_line . "\n"; } } sub _xpc_of_content { my ( $self, $content ) = @_; my $doc = $self->libxml->parse_string($content); # warn $doc->toString(1); my $xpc = XML::LibXML::XPathContext->new($doc); # Set default XML document NS as S3 namespace. # Or default Amazon xmlns (for documents without NS). my $s3_ns = $doc->documentElement->lookupNamespaceURI || 'http://s3.amazonaws.com/doc/2006-03-01/'; $xpc->registerNs( 's3', $s3_ns ); return $xpc; } # returns 1 if errors were found sub _remember_errors { my ( $self, $src ) = @_; # Do not try to parse non-xml unless ( ref $src || $src =~ m/^[[:space:]]*err($code); $self->errstr($src); return 1; } my $xpc = ref $src ? $src : $self->_xpc_of_content($src); if ( $xpc->findnodes("//Error") ) { $self->err( $xpc->findvalue("//Error/Code") ); $self->errstr( $xpc->findvalue("//Error/Message") ); return 1; } return 0; } sub _urlencode { my ( $self, $unencoded ) = @_; return uri_escape_utf8( $unencoded, '^A-Za-z0-9_\-\.' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3 - Use the Amazon S3 - Simple Storage Service =head1 VERSION version 0.89 =head1 SYNOPSIS use Net::Amazon::S3; my $aws_access_key_id = 'fill me in'; my $aws_secret_access_key = 'fill me in too'; my $s3 = Net::Amazon::S3->new( { aws_access_key_id => $aws_access_key_id, aws_secret_access_key => $aws_secret_access_key, # or use an IAM role. use_iam_role => 1 retry => 1, } ); # a bucket is a globally-unique directory # list all buckets that i own my $response = $s3->buckets; foreach my $bucket ( @{ $response->{buckets} } ) { print "You have a bucket: " . $bucket->bucket . "\n"; } # create a new bucket my $bucketname = 'acmes_photo_backups'; my $bucket = $s3->add_bucket( { bucket => $bucketname } ) or die $s3->err . ": " . $s3->errstr; # or use an existing bucket $bucket = $s3->bucket($bucketname); # store a file in the bucket $bucket->add_key_filename( '1.JPG', 'DSC06256.JPG', { content_type => 'image/jpeg', }, ) or die $s3->err . ": " . $s3->errstr; # store a value in the bucket $bucket->add_key( 'reminder.txt', 'this is where my photos are backed up' ) or die $s3->err . ": " . $s3->errstr; # list files in the bucket $response = $bucket->list_all or die $s3->err . ": " . $s3->errstr; foreach my $key ( @{ $response->{keys} } ) { my $key_name = $key->{key}; my $key_size = $key->{size}; print "Bucket contains key '$key_name' of size $key_size\n"; } # fetch file from the bucket $response = $bucket->get_key_filename( '1.JPG', 'GET', 'backup.jpg' ) or die $s3->err . ": " . $s3->errstr; # fetch value from the bucket $response = $bucket->get_key('reminder.txt') or die $s3->err . ": " . $s3->errstr; print "reminder.txt:\n"; print " content length: " . $response->{content_length} . "\n"; print " content type: " . $response->{content_type} . "\n"; print " etag: " . $response->{content_type} . "\n"; print " content: " . $response->{value} . "\n"; # delete keys $bucket->delete_key('reminder.txt') or die $s3->err . ": " . $s3->errstr; $bucket->delete_key('1.JPG') or die $s3->err . ": " . $s3->errstr; # and finally delete the bucket $bucket->delete_bucket or die $s3->err . ": " . $s3->errstr; =head1 DESCRIPTION This module provides a Perlish interface to Amazon S3. From the developer blurb: "Amazon S3 is storage for the Internet. It is designed to make web-scale computing easier for developers. Amazon S3 provides a simple web services interface that can be used to store and retrieve any amount of data, at any time, from anywhere on the web. It gives any developer access to the same highly scalable, reliable, fast, inexpensive data storage infrastructure that Amazon uses to run its own global network of web sites. The service aims to maximize benefits of scale and to pass those benefits on to developers". To find out more about S3, please visit: http://s3.amazonaws.com/ To use this module you will need to sign up to Amazon Web Services and provide an "Access Key ID" and " Secret Access Key". If you use this module, you will incurr costs as specified by Amazon. Please check the costs. If you use this module with your Access Key ID and Secret Access Key you must be responsible for these costs. I highly recommend reading all about S3, but in a nutshell data is stored in values. Values are referenced by keys, and keys are stored in buckets. Bucket names are global. Note: This is the legacy interface, please check out L instead. Development of this code happens here: https://github.com/rustyconover/net-amazon-s3 =head1 METHODS =head2 new Create a new S3 client object. Takes some arguments: =over =item aws_access_key_id Use your Access Key ID as the value of the AWSAccessKeyId parameter in requests you send to Amazon Web Services (when required). Your Access Key ID identifies you as the party responsible for the request. =item aws_secret_access_key Since your Access Key ID is not encrypted in requests to AWS, it could be discovered and used by anyone. Services that are not free require you to provide additional information, a request signature, to verify that a request containing your unique Access Key ID could only have come from you. DO NOT INCLUDE THIS IN SCRIPTS OR APPLICATIONS YOU DISTRIBUTE. YOU'LL BE SORRY =item aws_session_token If you are using temporary credentials provided by the AWS Security Token Service, set the token here, and it will be added to the request in order to authenticate it. =item use_iam_role If you'd like to use IAM provided temporary credentials, pass this option with a true value. =item secure Set this to C<0> if you don't want to use SSL-encrypted connections when talking to S3. Defaults to C<1>. To use SSL-encrypted connections, LWP::Protocol::https is required. =item keep_alive_cache_size Set this to C<0> to disable Keep-Alives. Default is C<10>. =item timeout How many seconds should your script wait before bailing on a request to S3? Defaults to 30. =item retry If this library should retry upon errors. This option is recommended. This uses exponential backoff with retries after 1, 2, 4, 8, 16, 32 seconds, as recommended by Amazon. Defaults to off. =item host The S3 host endpoint to use. Defaults to 's3.amazonaws.com'. This allows you to connect to any S3-compatible host. =item use_virtual_host Use the virtual host method ('bucketname.s3.amazonaws.com') instead of specifying the bucket at the first part of the path. This is particularly useful if you want to access buckets not located in the US-Standard region (such as EU, Asia Pacific or South America). See L for the pros and cons. =item authorization_method Authorization implementation package name. This library provides L<< Net::Amazon::S3::Signature::V2 >> and L<< Net::Amazon::S3::Signature::V4 >> Default is Signature 4 if host is C<< s3.amazonaws.com >>, Signature 2 otherwise =back =head3 Notes When using L in child processes using fork (such as in combination with the excellent L) you should create the S3 object in each child, use a fresh LWP::UserAgent in each child, or disable the L in the parent: $s3->ua( LWP::UserAgent->new( keep_alive => 0, requests_redirectable => [qw'GET HEAD DELETE PUT POST'] ); =head2 buckets Returns undef on error, else hashref of results =head2 add_bucket Takes a hashref: =over =item bucket The name of the bucket you want to add =item acl_short (optional) See the set_acl subroutine for documentation on the acl_short options =item location_constraint (option) Sets the location constraint of the new bucket. If left unspecified, the default S3 datacenter location will be used. Otherwise, you can set it to 'EU' for a European data center - note that costs are different. =back Returns 0 on failure, Net::Amazon::S3::Bucket object on success =head2 bucket BUCKET Takes a scalar argument, the name of the bucket you're creating Returns an (unverified) bucket object from an account. Does no network access. =head2 delete_bucket Takes either a L object or a hashref containing =over =item bucket The name of the bucket to remove =back Returns false (and fails) if the bucket isn't empty. Returns true if the bucket is successfully deleted. =head2 list_bucket List all keys in this bucket. Takes a hashref of arguments: MANDATORY =over =item bucket The name of the bucket you want to list keys on =back OPTIONAL =over =item prefix Restricts the response to only contain results that begin with the specified prefix. If you omit this optional argument, the value of prefix for your query will be the empty string. In other words, the results will be not be restricted by prefix. =item delimiter If this optional, Unicode string parameter is included with your request, then keys that contain the same string between the prefix and the first occurrence of the delimiter will be rolled up into a single result element in the CommonPrefixes collection. These rolled-up keys are not returned elsewhere in the response. For example, with prefix="USA/" and delimiter="/", the matching keys "USA/Oregon/Salem" and "USA/Oregon/Portland" would be summarized in the response as a single "USA/Oregon" element in the CommonPrefixes collection. If an otherwise matching key does not contain the delimiter after the prefix, it appears in the Contents collection. Each element in the CommonPrefixes collection counts as one against the MaxKeys limit. The rolled-up keys represented by each CommonPrefixes element do not. If the Delimiter parameter is not present in your request, keys in the result set will not be rolled-up and neither the CommonPrefixes collection nor the NextMarker element will be present in the response. =item max-keys This optional argument limits the number of results returned in response to your query. Amazon S3 will return no more than this number of results, but possibly less. Even if max-keys is not specified, Amazon S3 will limit the number of results in the response. Check the IsTruncated flag to see if your results are incomplete. If so, use the Marker parameter to request the next page of results. For the purpose of counting max-keys, a 'result' is either a key in the 'Contents' collection, or a delimited prefix in the 'CommonPrefixes' collection. So for delimiter requests, max-keys limits the total number of list results, not just the number of keys. =item marker This optional parameter enables pagination of large result sets. C specifies where in the result set to resume listing. It restricts the response to only contain results that occur alphabetically after the value of marker. To retrieve the next page of results, use the last key from the current page of results as the marker in your next request. See also C, below. If C is omitted,the first page of results is returned. =back Returns undef on error and a hashref of data on success: The hashref looks like this: { bucket => $bucket_name, prefix => $bucket_prefix, common_prefixes => [$prefix1,$prefix2,...] marker => $bucket_marker, next_marker => $bucket_next_available_marker, max_keys => $bucket_max_keys, is_truncated => $bucket_is_truncated_boolean keys => [$key1,$key2,...] } Explanation of bits of that: =over =item common_prefixes If list_bucket was requested with a delimiter, common_prefixes will contain a list of prefixes matching that delimiter. Drill down into these prefixes by making another request with the prefix parameter. =item is_truncated B flag that indicates whether or not all results of your query were returned in this response. If your results were truncated, you can make a follow-up paginated request using the Marker parameter to retrieve the rest of the results. =item next_marker A convenience element, useful when paginating with delimiters. The value of C, if present, is the largest (alphabetically) of all key names and all CommonPrefixes prefixes in the response. If the C flag is set, request the next page of results by setting C to the value of C. This element is only present in the response if the C parameter was sent with the request. =back Each key is a hashref that looks like this: { key => $key, last_modified => $last_mod_date, etag => $etag, # An MD5 sum of the stored content. size => $size, # Bytes storage_class => $storage_class # Doc? owner_id => $owner_id, owner_displayname => $owner_name } =head2 list_bucket_all List all keys in this bucket without having to worry about 'marker'. This is a convenience method, but may make multiple requests to S3 under the hood. Takes the same arguments as list_bucket. =head2 add_key DEPRECATED. DO NOT USE =head2 get_key DEPRECATED. DO NOT USE =head2 head_key DEPRECATED. DO NOT USE =head2 delete_key DEPRECATED. DO NOT USE =head1 LICENSE This module contains code modified from Amazon that contains the following notice: # This software code is made available "AS IS" without warranties of any # kind. You may copy, display, modify and redistribute the software # code either by itself or as incorporated into your code; provided that # you do not remove any proprietary notices. Your use of this software # code is at your own risk and you waive any claim against Amazon # Digital Services, Inc. or its affiliates with respect to your use of # this software code. (c) 2006 Amazon Digital Services, Inc. or its # affiliates. =head1 TESTING Testing S3 is a tricky thing. Amazon wants to charge you a bit of money each time you use their service. And yes, testing counts as using. Because of this, the application's test suite skips anything approaching a real test unless you set these three environment variables: =over =item AMAZON_S3_EXPENSIVE_TESTS Doesn't matter what you set it to. Just has to be set =item AWS_ACCESS_KEY_ID Your AWS access key =item AWS_ACCESS_KEY_SECRET Your AWS sekkr1t passkey. Be forewarned that setting this environment variable on a shared system might leak that information to another user. Be careful. =back =head1 AUTHOR Leon Brocard and unknown Amazon Digital Services programmers. Brad Fitzpatrick - return values, Bucket object Pedro Figueiredo - since 0.54 =head1 SEE ALSO L =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut api-bucket-delete.t100644000765000024 342013620607144 16750 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_bucket_delete ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_bucket_not_empty ], qw[ fixture_error_no_such_bucket ], ); expect_api_bucket_delete 'delete bucket' => ( with_bucket => 'some-bucket', expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_data => bool (1), ); expect_api_bucket_delete 'error access denied' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_bucket_delete 'error bucket not empty' => ( with_bucket => 'some-bucket', fixture_error_bucket_not_empty, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => bool (0), expect_s3_err => 'BucketNotEmpty', expect_s3_errstr => 'Bucket not empty error message', ); expect_api_bucket_delete 'error no such bucket' => ( with_bucket => 'some-bucket', fixture_error_no_such_bucket, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => bool (0), expect_s3_err => 'NoSuchBucket', expect_s3_errstr => 'No such bucket error message', ); api-object-delete.t100644000765000024 356713620607144 16755 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; # Test::Warnings + our tests use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_object_delete ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); expect_api_object_delete 'delete object' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (1), ); expect_api_object_delete 'error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_access_denied, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_object_delete 'error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_no_such_bucket, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (0), expect_s3_err => 'NoSuchBucket', expect_s3_errstr => 'No such bucket error message', ); expect_api_object_delete 'error no such key' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_no_such_key, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (0), expect_s3_err => 'NoSuchKey', expect_s3_errstr => 'No such key error message', ); api-bucket-create.t100644000765000024 573613620607144 16765 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 6; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_bucket_create ], ); use Shared::Examples::Net::Amazon::S3::Operation::Bucket::Create ( qw[ create_bucket_in_ca_central_1_content_xml ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_bucket_already_exists ], qw[ fixture_error_invalid_bucket_name ], ); expect_api_bucket_create 'simple create bucket (default region us-east-1)' => ( with_bucket => 'some-bucket', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => all ( obj_isa ('Net::Amazon::S3::Bucket'), methods (bucket => 'some-bucket'), ), ); expect_api_bucket_create 'create bucket in different region' => ( with_bucket => 'some-bucket', with_region => 'ca-central-1', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => create_bucket_in_ca_central_1_content_xml, expect_data => all ( obj_isa ('Net::Amazon::S3::Bucket'), methods (bucket => 'some-bucket'), ), ); expect_api_bucket_create 'create bucket with acl' => ( with_bucket => 'some-bucket', with_acl => 'private', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_request_headers => { x_amz_acl => 'private' }, expect_data => all ( obj_isa ('Net::Amazon::S3::Bucket'), methods (bucket => 'some-bucket'), ), ); expect_api_bucket_create 'error access denied' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_bucket_create 'error bucket already exists' => ( with_bucket => 'some-bucket', fixture_error_bucket_already_exists, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => bool (0), expect_s3_err => 'BucketAlreadyExists', expect_s3_errstr => 'Bucket already exists error message', ); expect_api_bucket_create 'error invalid bucket name' => ( with_bucket => 'some-bucket', fixture_error_invalid_bucket_name, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => bool (0), expect_s3_err => 'InvalidBucketName', expect_s3_errstr => 'Invalid bucket name error message', ); api-object-create.t100644000765000024 704713620607144 16753 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 5; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_object_create ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); expect_api_object_create 'create object from scalar value' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', expect_data => bool (1), expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_request_content => 'some value', expect_request_headers => { content_length => 10, content_md5 => undef, expires => undef, }, ); expect_api_object_create 'create object with server side encryption' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', with_encryption => 'AES256', expect_data => bool (1), expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_request_content => 'some value', expect_request_headers => { content_length => 10, content_md5 => undef, expires => undef, x_amz_server_side_encryption => 'AES256', }, ); expect_api_object_create 'create object with headers recognized by Client::Bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', with_cache_control => 'private', with_content_disposition => 'inline', with_content_encoding => 'identity', with_content_type => 'text/plain', with_expires => 'Fri, 09 Sep 2011 23:36:00 GMT', with_storage_class => 'reduced_redundancy', with_user_metadata => { Foo => 1, Bar => 2 }, expect_data => bool (1), expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_request_content => 'some value', expect_request_headers => { cache_control => 'private', content_disposition => 'inline', content_encoding => 'identity', content_length => 10, content_type => 'text/plain', content_md5 => undef, expires => 'Fri, 09 Sep 2011 23:36:00 GMT', x_amz_meta_bar => 2, x_amz_meta_foo => 1, x_amz_storage_class => 'reduced_redundancy', }, ); expect_api_object_create 'error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', fixture_error_access_denied, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_object_create 'error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', fixture_error_no_such_bucket, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (0), expect_s3_err => 'NoSuchBucket', expect_s3_errstr => 'No such bucket error message', ); api-object-acl-get.t100644000765000024 370613620607144 17022 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_object_acl_get ], ); use Shared::Examples::Net::Amazon::S3::ACL ( qw[ acl_xml ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); expect_api_object_acl_get 'get bucket acl' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_response_data => acl_xml, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_data => acl_xml, ); expect_api_object_acl_get 'with error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_access_denied, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, throws => qr/^Net::Amazon::S3: Amazon responded with 403 Forbidden/i, expect_s3_err => 'network_error', expect_s3_errstr => '403 Forbidden', ); expect_api_object_acl_get 'with error bucket not found' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_no_such_bucket, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_data => undef, expect_s3_err => undef, expect_s3_errstr => undef, ); expect_api_object_acl_get 'with error bucket not found' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_no_such_key, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_data => undef, expect_s3_err => undef, expect_s3_errstr => undef, ); api-object-acl-set.t100644000765000024 530013620607144 17026 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 5; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_object_acl_set ], ); use Shared::Examples::Net::Amazon::S3::ACL ( qw[ acl_xml ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); expect_api_object_acl_set 'set bucket acl via canned acl header' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_acl_short => 'private', with_response_data => acl_xml, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_request_content => '', expect_request_headers => { x_amz_acl => 'private', }, expect_data => bool (1), ); expect_api_object_acl_set 'set bucket acl via xml acl' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_acl_xml => acl_xml, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_request_content => acl_xml, expect_request_headers => { x_amz_acl => undef, }, expect_data => bool (1), ); expect_api_object_acl_set 'with error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_acl_short => 'private', fixture_error_access_denied, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_object_acl_set 'with error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_acl_short => 'private', fixture_error_no_such_bucket, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_data => bool (0), expect_s3_err => 'NoSuchBucket', expect_s3_errstr => 'No such bucket error message', ); expect_api_object_acl_set 'with error no such object' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_acl_short => 'private', fixture_error_no_such_key, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key?acl' }, expect_data => bool (0), expect_s3_err => 'NoSuchKey', expect_s3_errstr => 'No such key error message', ); api-bucket-acl-get.t100644000765000024 257613620607144 17035 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_bucket_acl_get ], ); use Shared::Examples::Net::Amazon::S3::ACL ( qw[ acl_xml ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); expect_api_bucket_acl_get 'get bucket acl' => ( with_bucket => 'some-bucket', with_response_data => acl_xml, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?acl' }, expect_data => acl_xml, ); expect_api_bucket_acl_get 'with error access denied' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?acl' }, throws => qr/^Net::Amazon::S3: Amazon responded with 403 Forbidden/i, expect_s3_err => 'network_error', expect_s3_errstr => '403 Forbidden', ); expect_api_bucket_acl_get 'with error bucket not found' => ( with_bucket => 'some-bucket', fixture_error_no_such_bucket, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?acl' }, expect_data => undef, expect_s3_err => undef, expect_s3_errstr => undef, ); api-bucket-acl-set.t100644000765000024 400013620607144 17031 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_bucket_acl_set ], ); use Shared::Examples::Net::Amazon::S3::ACL ( qw[ acl_xml ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); expect_api_bucket_acl_set 'set bucket acl via canned acl header' => ( with_bucket => 'some-bucket', with_acl_short => 'private', with_response_data => acl_xml, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/?acl' }, expect_request_content => '', expect_request_headers => { x_amz_acl => 'private', }, expect_data => bool (1), ); expect_api_bucket_acl_set 'set bucket acl via xml acl' => ( with_bucket => 'some-bucket', with_acl_xml => acl_xml, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/?acl' }, expect_request_content => acl_xml, expect_request_headers => { x_amz_acl => undef, }, expect_data => bool (1), ); expect_api_bucket_acl_set 'with error access denied' => ( with_bucket => 'some-bucket', with_acl_short => 'private', fixture_error_access_denied, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/?acl' }, expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_bucket_acl_set 'with error bucket not found' => ( with_bucket => 'some-bucket', with_acl_short => 'private', fixture_error_no_such_bucket, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/?acl' }, expect_data => bool (0), expect_s3_err => 'NoSuchBucket', expect_s3_errstr => 'No such bucket error message', ); request-get-object.t100644000765000024 106613620607144 17201 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'get object' => ( request_class => 'Net::Amazon::S3::Request::GetObject', with_bucket => 'some-bucket', with_key => 'some/key', with_method => 'GET', expect_request_method => 'GET', expect_request_path => 'some-bucket/some/key', expect_request_headers => { }, expect_request_content => '', ); request-list-parts.t100644000765000024 211313620607144 17252 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 2; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'list parts' => ( request_class => 'Net::Amazon::S3::Request::ListParts', with_bucket => 'some-bucket', with_key => 'some/key', with_upload_id => '123', expect_request_method => 'GET', expect_request_path => 'some-bucket/some/key?uploadId=123', expect_request_headers => { }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'list parts with acl' => ( request_class => 'Net::Amazon::S3::Request::ListParts', with_bucket => 'some-bucket', with_key => 'some/key', with_upload_id => '123', with_acl_short => 'private', expect_request_method => 'GET', expect_request_path => 'some-bucket/some/key?uploadId=123', expect_request_headers => { 'x-amz-acl' => 'private' }, expect_request_content => '', ); request-put-object.t100644000765000024 260013620607144 17225 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'put object' => ( request_class => 'Net::Amazon::S3::Request::PutObject', with_bucket => 'some-bucket', with_key => 'some/key', with_value => 'foo', expect_request_method => 'PUT', expect_request_path => 'some-bucket/some/key', expect_request_headers => { }, ); behaves_like_net_amazon_s3_request 'put object with acl' => ( request_class => 'Net::Amazon::S3::Request::PutObject', with_bucket => 'some-bucket', with_key => 'some/key', with_acl_short => 'private', with_value => 'foo', expect_request_method => 'PUT', expect_request_path => 'some-bucket/some/key', expect_request_headers => { 'x-amz-acl' => 'private' }, ); behaves_like_net_amazon_s3_request 'put object with service side encryption' => ( request_class => 'Net::Amazon::S3::Request::PutObject', with_bucket => 'some-bucket', with_key => 'some/key', with_encryption => 'AES256', with_value => 'foo', expect_request_method => 'PUT', expect_request_path => 'some-bucket/some/key', expect_request_headers => { 'x-amz-server-side-encryption' => 'AES256' }, ); client-object-fetch.t100644000765000024 410013620607144 17271 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use HTTP::Status; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_object_fetch ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); expect_client_object_fetch 'fetch existing object' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_response_code => HTTP::Status::HTTP_OK, with_response_data => 'some-value', with_response_headers => { content_length => 10, content_type => 'text/plain', etag => '8c561147ab3ce19bb8e73db4a47cc6ac', x_amz_metadata_foo => 'foo-1', date => 'Fri, 09 Sep 2011 23:36:00 GMT', }, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => 'some-value', ); expect_client_object_fetch 'with error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_access_denied, throws => qr/^AccessDenied: Access denied error message/i, ); expect_client_object_fetch 'with error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_no_such_bucket, throws => qr/^NoSuchBucket: No such bucket error message/i, ); expect_client_object_fetch 'with error no such object' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/some-key' }, fixture_error_no_such_key, throws => qr/^NoSuchKey: No such key error message/i, ); request-list-bucket.t100644000765000024 373413620607144 17410 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 5; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'list bucket' => ( request_class => 'Net::Amazon::S3::Request::ListBucket', with_bucket => 'some-bucket', expect_request_method => 'GET', expect_request_path => 'some-bucket/?max-keys=1000', expect_request_headers => { }, ); behaves_like_net_amazon_s3_request 'list bucket with prefix' => ( request_class => 'Net::Amazon::S3::Request::ListBucket', with_bucket => 'some-bucket', with_prefix => 'some-prefix', expect_request_method => 'GET', expect_request_path => 'some-bucket/?max-keys=1000&prefix=some-prefix', expect_request_headers => { }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'list bucket with delimiter' => ( request_class => 'Net::Amazon::S3::Request::ListBucket', with_bucket => 'some-bucket', with_delimiter => '&', expect_request_method => 'GET', expect_request_path => 'some-bucket/?delimiter=%26&max-keys=1000', expect_request_headers => { }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'list bucket with max-keys' => ( request_class => 'Net::Amazon::S3::Request::ListBucket', with_bucket => 'some-bucket', with_max_keys => '200', expect_request_method => 'GET', expect_request_path => 'some-bucket/?max-keys=200', expect_request_headers => { }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'list bucket with marker' => ( request_class => 'Net::Amazon::S3::Request::ListBucket', with_bucket => 'some-bucket', with_marker => 'x', expect_request_method => 'GET', expect_request_path => 'some-bucket/?marker=x&max-keys=1000', expect_request_headers => { }, expect_request_content => '', ); examples000755000765000024 013620607144 14513 5ustar00leostaff000000000000Net-Amazon-S3-0.89backup_cpan.pl100755000765000024 763313620607144 17472 0ustar00leostaff000000000000Net-Amazon-S3-0.89/examples#!/home/acme/bin/perl use strict; use warnings; use lib 'lib'; use Data::Stream::Bulk::Path::Class; use Net::Amazon::S3; use Perl6::Say; use Path::Class; use Set::Object; use Term::ProgressBar::Simple; use List::Util qw(sum); use Digest::MD5::File qw(file_md5_hex); use BerkeleyDB::Manager; use Cwd; use Config; my $m = BerkeleyDB::Manager->new( home => Path::Class::Dir->new(cwd), db_class => 'BerkeleyDB::Hash', create => 1, ); my $db = $m->open_db( file => 'md5_cache' ); my $s3 = Net::Amazon::S3->new( aws_access_key_id => 'XXX', aws_secret_access_key => 'XXX', retry => 1, ); my $client = Net::Amazon::S3::Client->new( s3 => $s3 ); my $bucket = $client->bucket( name => 'minicpan' ); my $root = '/home/acme/Public/minicpan/'; my $file_stream = Data::Stream::Bulk::Path::Class->new( dir => Path::Class::Dir->new($root), only_files => 1, ); my %files; my $file_set = Set::Object->new(); until ( $file_stream->is_done ) { foreach my $filename ( $file_stream->items ) { my $key = $filename->relative($root)->stringify; #[rootname]path/to/file.txt:,,, my $stat = $filename->stat; my $ctime = $stat->ctime; my $mtime = $stat->mtime; my $size = $stat->size; my $inodenum = $stat->ino; my $cachekey = "$key:$ctime,$mtime,$size,$inodenum"; $db->db_get( $cachekey, my $md5_hex ); if ($md5_hex) { #say "hit $cachekey $md5hex"; } else { $md5_hex = file_md5_hex($filename) || die "Failed to find MD5 for $filename"; $m->txn_do( sub { $db->db_put( $cachekey, $md5_hex ); } ); #say "miss $cachekey $md5_hex"; } $files{$key} = { filename => $filename, key => $key, md5_hex => $md5_hex, size => -s $filename, }; $file_set->insert($key); } } my %objects; my $s3_set = Set::Object->new(); my $object_stream = $bucket->list; until ( $object_stream->is_done ) { foreach my $object ( $object_stream->items ) { my $key = $object->key; $objects{$key} = { filename => file( $root, $key )->stringify, key => $key, md5_hex => $object->etag, size => $object->size, }; # say $object->key . ' ' . $object->size . ' ' . $object->etag; $s3_set->insert( $object->key ); } } my @to_add; my @to_delete; foreach my $key ( sort keys %files ) { my $file = $files{$key}; my $object = $objects{$key}; if ($object) { if ( $file->{md5_hex} eq $object->{md5_hex} ) { # say "$key same"; } else { # say "$key different"; push @to_add, $file; } } else { #say "$key missing"; push @to_add, $file; } } foreach my $key ( sort keys %objects ) { my $object = $objects{$key}; my $file = $files{$key}; if ($file) { } else { # say "$key to delete"; push @to_delete, $object; } } my $total_size = sum map { file( $_->{filename} )->stat->size } @to_add; $total_size += scalar(@to_delete); my $progress = Term::ProgressBar::Simple->new($total_size); foreach my $file (@to_add) { my $key = $file->{key}; my $filename = $file->{filename}; my $md5_hex = $file->{md5_hex}; my $size = $file->{size}; # say "put $key"; $progress += $size; my $object = $bucket->object( key => $key, etag => $md5_hex, size => $size ); $object->put_filename($filename); } foreach my $object (@to_delete) { my $key = $object->{key}; my $filename = $object->{filename}; my $object = $bucket->object(key => $key); # say "delete $key"; $object->delete; $progress++; } client-bucket-delete.t100644000765000024 311513620607144 17456 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_bucket_delete ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_bucket_not_empty ], qw[ fixture_error_no_such_bucket ], ); expect_client_bucket_delete 'delete bucket' => ( with_bucket => 'some-bucket', expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_data => bool (1), ); expect_client_bucket_delete 'error access denied' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', throws => qr/^AccessDenied: Access denied error message/, ); expect_client_bucket_delete 'error bucket not empty' => ( with_bucket => 'some-bucket', fixture_error_bucket_not_empty, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', throws => qr/^BucketNotEmpty: Bucket not empty error message/, ); expect_client_bucket_delete 'error no such bucket' => ( with_bucket => 'some-bucket', fixture_error_no_such_bucket, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', throws => qr/^NoSuchBucket: No such bucket error message/, ); client-object-delete.t100644000765000024 326413620607144 17454 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; # Test::Warnings + our tests use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_object_delete ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); expect_client_object_delete 'delete object' => ( with_bucket => 'some-bucket', with_key => 'some-key', expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (1), ); expect_client_object_delete 'error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_access_denied, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, throws => qr/^AccessDenied: Access denied error message/, ); expect_client_object_delete 'error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_no_such_bucket, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, throws => qr/^NoSuchBucket: No such bucket error message/, ); expect_client_object_delete 'error no such key' => ( with_bucket => 'some-bucket', with_key => 'some-key', fixture_error_no_such_key, expect_request => { DELETE => 'https://some-bucket.s3.amazonaws.com/some-key' }, throws => qr/^NoSuchKey: No such key error message/, ); client-bucket-create.t100644000765000024 535613620607144 17470 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 6; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_bucket_create ], ); use Shared::Examples::Net::Amazon::S3::Operation::Bucket::Create ( qw[ create_bucket_in_ca_central_1_content_xml ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_bucket_already_exists ], qw[ fixture_error_invalid_bucket_name ], ); expect_client_bucket_create 'create bucket' => ( with_bucket => 'some-bucket', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_data => all ( obj_isa ('Net::Amazon::S3::Client::Bucket'), methods (name => 'some-bucket'), ), ); expect_client_bucket_create 'create bucket in different region' => ( with_bucket => 'some-bucket', with_region => 'ca-central-1', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => create_bucket_in_ca_central_1_content_xml, expect_data => all ( obj_isa ('Net::Amazon::S3::Client::Bucket'), methods (name => 'some-bucket'), ), ); expect_client_bucket_create 'create bucket with acl' => ( with_bucket => 'some-bucket', with_acl => 'private', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_request_headers => { x_amz_acl => 'private' }, expect_data => all ( obj_isa ('Net::Amazon::S3::Client::Bucket'), methods (name => 'some-bucket'), ), ); expect_client_bucket_create 'error access denied' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', throws => qr/^AccessDenied: Access denied error message/, ); expect_client_bucket_create 'error bucket already exists' => ( with_bucket => 'some-bucket', fixture_error_bucket_already_exists, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', throws => qr/^BucketAlreadyExists: Bucket already exists error message/, ); expect_client_bucket_create 'error invalid bucket name' => ( with_bucket => 'some-bucket', fixture_error_invalid_bucket_name, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, throws => qr/^InvalidBucketName: Invalid bucket name error message/, ); client-object-create.t100644000765000024 760513620607144 17460 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 5; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_object_create ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); expect_client_object_create 'create object from scalar value' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', with_response_headers => { etag => '5946210c9e93ae37891dfe96c3e39614' }, expect_data => '', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_request_content => 'some value', expect_request_headers => { content_length => 10, content_md5 => 'WUYhDJ6TrjeJHf6Ww+OWFA==', expires => undef, }, ); expect_client_object_create 'create object from scalar value' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', with_encryption => 'AES256', with_response_headers => { etag => '5946210c9e93ae37891dfe96c3e39614' }, expect_data => '', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_request_content => 'some value', expect_request_headers => { content_length => 10, content_md5 => 'WUYhDJ6TrjeJHf6Ww+OWFA==', expires => undef, x_amz_server_side_encryption => 'AES256', }, ); expect_client_object_create 'create object with headers recognized by Client::Bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', with_response_headers => { etag => '5946210c9e93ae37891dfe96c3e39614' }, with_cache_control => 'private', with_content_disposition => 'inline', with_content_encoding => 'identity', with_content_type => 'text/plain', with_expires => DateTime->new( year => 2011, month => 9, day => 9, hour => 23, minute => 36, time_zone => 'UTC', ), with_storage_class => 'reduced_redundancy', with_user_metadata => { Foo => 1, Bar => 2 }, expect_data => '', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_request_content => 'some value', expect_request_headers => { cache_control => 'private', content_disposition => 'inline', content_encoding => 'identity', content_length => 10, content_type => 'text/plain', content_md5 => 'WUYhDJ6TrjeJHf6Ww+OWFA==', expires => 'Fri, 09 Sep 2011 23:36:00 GMT', x_amz_meta_bar => 2, x_amz_meta_foo => 1, x_amz_storage_class => 'REDUCED_REDUNDANCY', }, ); expect_client_object_create 'error access denied' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', fixture_error_access_denied, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, throws => qr/^AccessDenied: Access denied error message/, ); expect_client_object_create 'error no such bucket' => ( with_bucket => 'some-bucket', with_key => 'some-key', with_value => 'some value', fixture_error_no_such_bucket, expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/some-key' }, expect_data => bool (0), throws => qr/^NoSuchBucket: No such bucket error message/, ); request-delete-bucket.t100644000765000024 76613620607144 17661 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'delete bucket' => ( request_class => 'Net::Amazon::S3::Request::DeleteBucket', with_bucket => 'some-bucket', expect_request_method => 'DELETE', expect_request_path => 'some-bucket/', expect_request_headers => { }, expect_request_content => '', ); request-create-bucket.t100644000765000024 357113620607144 17677 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); use Shared::Examples::Net::Amazon::S3::Operation::Bucket::Create ( qw[ create_bucket_in_ca_central_1_content_xml ], ); behaves_like_net_amazon_s3_request 'create bucket' => ( request_class => 'Net::Amazon::S3::Request::CreateBucket', with_bucket => 'some-bucket', expect_request_method => 'PUT', expect_request_path => 'some-bucket/', expect_request_headers => { }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'create bucket with acl' => ( request_class => 'Net::Amazon::S3::Request::CreateBucket', with_bucket => 'some-bucket', with_acl_short => 'private', expect_request_method => 'PUT', expect_request_path => 'some-bucket/', expect_request_headers => { 'x-amz-acl' => 'private' }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'create bucket in region' => ( request_class => 'Net::Amazon::S3::Request::CreateBucket', with_bucket => 'some-bucket', with_location_constraint => 'ca-central-1', expect_request_method => 'PUT', expect_request_path => 'some-bucket/', expect_request_headers => { }, expect_request_content => create_bucket_in_ca_central_1_content_xml, ); behaves_like_net_amazon_s3_request 'create bucket in region with acl' => ( request_class => 'Net::Amazon::S3::Request::CreateBucket', with_bucket => 'some-bucket', with_acl_short => 'private', with_location_constraint => 'ca-central-1', expect_request_method => 'PUT', expect_request_path => 'some-bucket/', expect_request_headers => { 'x-amz-acl' => 'private' }, expect_request_content => create_bucket_in_ca_central_1_content_xml, ); client-bucket-acl-get.t100644000765000024 243513620607144 17534 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_bucket_acl_get ], ); use Shared::Examples::Net::Amazon::S3::ACL ( qw[ acl_xml ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); expect_client_bucket_acl_get 'get bucket acl' => ( with_bucket => 'some-bucket', with_response_data => acl_xml, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?acl' }, expect_data => acl_xml, ); expect_client_bucket_acl_get 'get bucket acl with access denied error' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?acl' }, throws => qr/^AccessDenied: Access denied error message/, ); expect_client_bucket_acl_get 'get bucket acl with bucket not found error' => ( with_bucket => 'some-bucket', fixture_error_no_such_bucket, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?acl' }, throws => qr/^NoSuchBucket: No such bucket error message/, ); request-delete-object.t100644000765000024 104113620607144 17655 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'delete object' => ( request_class => 'Net::Amazon::S3::Request::DeleteObject', with_bucket => 'some-bucket', with_key => 'some/key', expect_request_method => 'DELETE', expect_request_path => 'some-bucket/some/key', expect_request_headers => { }, expect_request_content => '', ); api-bucket-objects-list.t100644000765000024 1536713620607144 20145 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 7; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3 ( qw[ s3_api_with_signature_2 ], ); use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_bucket_objects_list ], ); use Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::List ( qw[ list_bucket_objects_v1 ], qw[ list_bucket_objects_v1_with_filter_truncated ], qw[ list_bucket_objects_v1_with_delimiter ], qw[ list_bucket_objects_v1_with_prefix_and_delimiter ], qw[ list_bucket_objects_v1_google_cloud_storage ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); expect_api_bucket_objects_list 'list objects (version 1)' => ( with_bucket => 'some-bucket', with_response_data => list_bucket_objects_v1, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/' }, expect_data => { bucket => 'some-bucket', prefix => '', marker => '', next_marker => '', max_keys => 1000, is_truncated => bool (0), keys => [ { key => 'my-image.jpg', last_modified => '2009-10-12T17:50:30.000Z', etag => 'fba9dede5f27731c9771645a39863328', size => 434234, storage_class => 'STANDARD', owner_id => '75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a', owner_displayname => 'mtd@amazon.com', }, { key => 'my-third-image.jpg', last_modified => '2009-10-12T17:50:30.000Z', etag => '1b2cf535f27731c974343645a3985328', size => 64994, storage_class => 'STANDARD_IA', owner_id => '75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a', owner_displayname => 'mtd@amazon.com', } ], }, ); expect_api_bucket_objects_list 'list objects with filters (version 1)' => ( with_bucket => 'some-bucket', with_response_data => list_bucket_objects_v1_with_filter_truncated, with_prefix => 'N', with_marker => 'Ned', with_max_keys => 40, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?marker=Ned&max-keys=40&prefix=N' }, expect_data => { bucket => 'some-bucket', prefix => 'N', marker => 'Ned', next_marker => '', max_keys => 40, is_truncated => bool (1), keys => [ { key => 'Nelson', last_modified => '2006-01-01T12:00:00.000Z', etag => '828ef3fdfa96f00ad9f27c383fc9ac7f', size => 5, storage_class => 'STANDARD', owner_id => 'bcaf161ca5fb16fd081034f', owner_displayname => 'webfile', }, { key => 'Neo', last_modified => '2006-01-01T12:00:00.000Z', etag => '828ef3fdfa96f00ad9f27c383fc9ac7f', size => 4, storage_class => 'STANDARD', owner_id => 'bcaf1ffd86a5fb16fd081034f', owner_displayname => 'webfile', } ], }, ); expect_api_bucket_objects_list 'list objects with delimiter (version 1)' => ( with_bucket => 'some-bucket', with_response_data => list_bucket_objects_v1_with_delimiter, with_delimiter => '/', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?delimiter=%2F' }, expect_data => { bucket => 'some-bucket', prefix => '', marker => '', next_marker => '', max_keys => 1000, is_truncated => bool (0), keys => [ { key => 'sample.jpg', last_modified => '2011-02-26T01:56:20.000Z', etag => 'bf1d737a4d46a19f3bced6905cc8b902', size => 142863, storage_class => 'STANDARD', owner_id => 'canonical-user-id', owner_displayname => 'display-name', } ], common_prefixes => [ 'photos', ], }, ); expect_api_bucket_objects_list 'list objects with prefix and delimiter (version 1)' => ( with_bucket => 'some-bucket', with_response_data => list_bucket_objects_v1_with_prefix_and_delimiter, with_delimiter => '/', with_prefix => 'photos/2006/', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?delimiter=%2F&prefix=photos%2F2006%2F' }, expect_data => { bucket => 'some-bucket', prefix => 'photos/2006/', marker => '', next_marker => '', max_keys => 1000, is_truncated => bool (0), keys => [], common_prefixes => [ 'photos/2006/February', 'photos/2006/January', ], }, ); expect_api_bucket_objects_list 'error access denied' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/' }, expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_bucket_objects_list 'error no such bucket' => ( with_bucket => 'some-bucket', fixture_error_no_such_bucket, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/' }, expect_data => bool (0), expect_s3_err => 'NoSuchBucket', expect_s3_errstr => 'No such bucket error message', ); expect_api_bucket_objects_list 'list objects (version 1) on Google Cloud Storage' => ( with_bucket => 'gcs-bucket', with_response_data => list_bucket_objects_v1_google_cloud_storage, with_s3 => s3_api_with_signature_2(host => 'storage.googleapis.com'), expect_request => { GET => 'https://gcs-bucket.storage.googleapis.com/' }, expect_data => { bucket => 'gcs-bucket', prefix => '', marker => '', max_keys => '', next_marker => 'next/marker/is/foo', is_truncated => bool (1), keys => [ { key => 'path/to/value', last_modified => '2017-04-21T22:06:03.413Z', etag => '1f52bad2879ca96dacd7a40f33001230', size => 742213, storage_class => '', owner_id => '', owner_displayname => '', }, { key => 'path/to/value2', last_modified => '2018-04-21T22:06:03.413Z', etag => '1f52bad2889ca96dacd7a40f33001230', size => 742214, storage_class => '', owner_id => '', owner_displayname => '', } ], }, ); S3000755000765000024 013620607144 15703 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/AmazonBucket.pm100644000765000024 4322613620607144 17645 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3package Net::Amazon::S3::Bucket; $Net::Amazon::S3::Bucket::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; use Carp; use File::stat; use IO::File 1.14; has 'account' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 ); has 'bucket' => ( is => 'ro', isa => 'Str', required => 1 ); has 'creation_date' => ( is => 'ro', isa => 'Maybe[Str]', required => 0 ); has 'region' => ( is => 'ro', lazy => 1, predicate => 'has_region', default => sub { $_[0]->_head_region }, ); __PACKAGE__->meta->make_immutable; # ABSTRACT: convenience object for working with Amazon S3 buckets # returns bool sub add_key { my ( $self, $key, $value, $conf ) = @_; if ( ref($value) eq 'SCALAR' ) { $conf->{'Content-Length'} ||= -s $$value; $value = _content_sub($$value); } else { $conf->{'Content-Length'} ||= length $value; } my $acl_short; if ( $conf->{acl_short} ) { $acl_short = $conf->{acl_short}; delete $conf->{acl_short}; } my $encryption = delete $conf->{encryption}; my $http_request = Net::Amazon::S3::Request::PutObject->new( s3 => $self->account, bucket => $self->bucket, key => $key, value => $value, acl_short => $acl_short, (encryption => $encryption) x!! defined $encryption, headers => $conf, )->http_request; if ( ref($value) ) { # we may get a 307 redirect; ask server to signal 100 Continue # before reading the content from CODE reference (_content_sub) $http_request->header('Expect' => '100-continue'); } return $self->account->_send_request_expect_nothing($http_request); } sub add_key_filename { my ( $self, $key, $value, $conf ) = @_; return $self->add_key( $key, \$value, $conf ); } sub copy_key { my ( $self, $key, $source, $conf ) = @_; my $acl_short; if ( defined $conf ) { if ( $conf->{acl_short} ) { $acl_short = $conf->{acl_short}; delete $conf->{acl_short}; } $conf->{'x-amz-metadata-directive'} ||= 'REPLACE'; } else { $conf = {}; } $conf->{'x-amz-copy-source'} = $source; my $encryption = delete $conf->{encryption}; my $acct = $self->account; my $http_request = Net::Amazon::S3::Request::PutObject->new( s3 => $self->account, bucket => $self->bucket, key => $key, value => '', acl_short => $acl_short, (encryption => $encryption) x!! defined $encryption, headers => $conf, )->http_request; my $response = $acct->_do_http( $http_request ); my $xpc = $acct->_xpc_of_content( $response->content ); if ( !$response->is_success || !$xpc || $xpc->findnodes("//Error") ) { $acct->_remember_errors( $response->content ); return 0; } return 1; } sub edit_metadata { my ( $self, $key, $conf ) = @_; croak "Need configuration hash" unless defined $conf; return $self->copy_key( $key, "/" . $self->bucket . "/" . $key, $conf ); } sub head_key { my ( $self, $key ) = @_; return $self->get_key( $key, "HEAD" ); } sub query_string_authentication_uri { my ( $self, $key, $expires_at ) = @_; my $request = Net::Amazon::S3::Request::GetObject->new( s3 => $self->account, bucket => $self, key => $key, method => 'GET', ); return $request->query_string_authentication_uri( $expires_at ); } sub get_key { my ( $self, $key, $method, $filename ) = @_; $filename = $$filename if ref $filename; my $acct = $self->account; my $http_request = Net::Amazon::S3::Request::GetObject->new( s3 => $acct, bucket => $self->bucket, key => $key, method => $method || 'GET', )->http_request; my $response = $acct->_do_http( $http_request, $filename ); if ( $response->code == 404 ) { return undef; } $acct->_croak_if_response_error($response); my $etag = $response->header('ETag'); if ($etag) { $etag =~ s/^"//; $etag =~ s/"$//; } my $return; foreach my $header ( $response->headers->header_field_names ) { $return->{ lc $header } = $response->header($header); } $return->{content_length} = $response->content_length || 0; $return->{content_type} = $response->content_type; $return->{etag} = $etag; $return->{value} = $response->content; return $return; } sub get_key_filename { my ( $self, $key, $method, $filename ) = @_; return $self->get_key( $key, $method, \$filename ); } # returns bool sub delete_multi_object { my $self = shift; my @objects = @_; return unless( scalar(@objects) ); # Since delete can handle up to 1000 requests, be a little bit nicer # and slice up requests and also allow keys to be strings # rather than only objects. my $last_result; while (scalar(@objects) > 0) { my $http_request = Net::Amazon::S3::Request::DeleteMultiObject->new( s3 => $self->account, bucket => $self, keys => [map { if (ref($_)) { $_->key } else { $_ } } splice @objects, 0, ((scalar(@objects) > 1000) ? 1000 : scalar(@objects))] )->http_request; my $xpc = $self->account->_send_request($http_request); return undef unless $xpc && !$self->account->_remember_errors($xpc); } return 1; } sub delete_key { my ( $self, $key ) = @_; croak 'must specify key' unless defined $key && length $key; my $http_request = Net::Amazon::S3::Request::DeleteObject->new( s3 => $self->account, bucket => $self->bucket, key => $key, )->http_request; return $self->account->_send_request_expect_nothing($http_request); } sub delete_bucket { my $self = shift; croak "Unexpected arguments" if @_; return $self->account->delete_bucket($self); } sub list { my $self = shift; my $conf = shift || {}; $conf->{bucket} = $self->bucket; return $self->account->list_bucket($conf); } sub list_all { my $self = shift; my $conf = shift || {}; $conf->{bucket} = $self->bucket; return $self->account->list_bucket_all($conf); } sub get_acl { my ( $self, $key ) = @_; my $account = $self->account; my $http_request; if ($key) { $http_request = Net::Amazon::S3::Request::GetObjectAccessControl->new( s3 => $account, bucket => $self->bucket, key => $key, )->http_request; } else { $http_request = Net::Amazon::S3::Request::GetBucketAccessControl->new( s3 => $account, bucket => $self->bucket, )->http_request; } my $response = $account->_do_http($http_request); if ( $response->code == 404 ) { return undef; } $account->_croak_if_response_error($response); return $response->content; } sub set_acl { my ( $self, $conf ) = @_; $conf ||= {}; my $key = $conf->{key}; my $http_request; if ($key) { $http_request = Net::Amazon::S3::Request::SetObjectAccessControl->new( s3 => $self->account, bucket => $self->bucket, key => $key, acl_short => $conf->{acl_short}, acl_xml => $conf->{acl_xml}, )->http_request; } else { $http_request = Net::Amazon::S3::Request::SetBucketAccessControl->new( s3 => $self->account, bucket => $self->bucket, acl_short => $conf->{acl_short}, acl_xml => $conf->{acl_xml}, )->http_request; } return $self->account->_send_request_expect_nothing($http_request); } sub get_location_constraint { my ($self) = @_; my $http_request = Net::Amazon::S3::Request::GetBucketLocationConstraint->new( s3 => $self->account, bucket => $self->bucket, )->http_request; my $xpc = $self->account->_send_request($http_request); return undef unless $xpc && !$self->account->_remember_errors($xpc); my $lc = $xpc->findvalue("//s3:LocationConstraint"); # S3 documentation: https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketGETlocation.html # When the bucket's region is US East (N. Virginia), # Amazon S3 returns an empty string for the bucket's region if ( defined $lc && $lc eq '' ) { $lc = 'us-east-1'; } return $lc; } # proxy up the err requests sub err { $_[0]->account->err } sub errstr { $_[0]->account->errstr } sub _content_sub { my $filename = shift; my $stat = stat($filename); my $remaining = $stat->size; my $blksize = $stat->blksize || 4096; croak "$filename not a readable file with fixed size" unless -r $filename and ( -f _ || $remaining ); my $fh = IO::File->new( $filename, 'r' ) or croak "Could not open $filename: $!"; $fh->binmode; return sub { my $buffer; # upon retries the file is closed and we must reopen it unless ( $fh->opened ) { $fh = IO::File->new( $filename, 'r' ) or croak "Could not open $filename: $!"; $fh->binmode; $remaining = $stat->size; } # warn "read remaining $remaining"; unless ( my $read = $fh->read( $buffer, $blksize ) ) { # warn "read $read buffer $buffer remaining $remaining"; croak "Error while reading upload content $filename ($remaining remaining) $!" if $! and $remaining; # otherwise, we found EOF $fh->close or croak "close of upload content $filename failed: $!"; $buffer ||= '' ; # LWP expects an emptry string on finish, read returns 0 } $remaining -= length($buffer); return $buffer; }; } sub _head_region { my ($self) = @_; my $protocol = $self->account->secure ? 'https' : 'http'; my $host = $self->account->host; my $path = $self->bucket; my @retry = (1, 2, (4) x 8); if ($self->account->use_virtual_host) { $host = "$path.$host"; $path = ''; } my $request_uri = "${protocol}://${host}/$path"; while (@retry) { my $request = HTTP::Request->new (HEAD => $request_uri); # Disable redirects my $requests_redirectable = $self->account->ua->requests_redirectable; $self->account->ua->requests_redirectable( [] ); my $response = $self->account->_do_http( $request ); $self->account->ua->requests_redirectable( $requests_redirectable ); return $response->header ('x-amz-bucket-region') if $response->header ('x-amz-bucket-region'); print STDERR "Invalid bucket head response; $request_uri\n"; print STDERR $response->as_string; sleep shift @retry; } die "Cannot determine bucket region; bucket=${\ $self->bucket }"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Bucket - convenience object for working with Amazon S3 buckets =head1 VERSION version 0.89 =head1 SYNOPSIS use Net::Amazon::S3; my $bucket = $s3->bucket("foo"); ok($bucket->add_key("key", "data")); ok($bucket->add_key("key", "data", { content_type => "text/html", 'x-amz-meta-colour' => 'orange', })); # Enable server-side encryption ok($bucket->add_key("key", "data", { encryption => 'AES256', })); # the err and errstr methods just proxy up to the Net::Amazon::S3's # objects err/errstr methods. $bucket->add_key("bar", "baz") or die $bucket->err . $bucket->errstr; # fetch a key $val = $bucket->get_key("key"); is( $val->{value}, 'data' ); is( $val->{content_type}, 'text/html' ); is( $val->{etag}, 'b9ece18c950afbfa6b0fdbfa4ff731d3' ); is( $val->{'x-amz-meta-colour'}, 'orange' ); # returns undef on missing or on error (check $bucket->err) is(undef, $bucket->get_key("non-existing-key")); die $bucket->errstr if $bucket->err; # fetch a key's metadata $val = $bucket->head_key("key"); is( $val->{value}, '' ); is( $val->{content_type}, 'text/html' ); is( $val->{etag}, 'b9ece18c950afbfa6b0fdbfa4ff731d3' ); is( $val->{'x-amz-meta-colour'}, 'orange' ); # delete a key ok($bucket->delete_key($key_name)); ok(! $bucket->delete_key("non-exist-key")); # delete the entire bucket (Amazon requires it first be empty) $bucket->delete_bucket; =head1 DESCRIPTION This module represents an S3 bucket. You get a bucket object from the Net::Amazon::S3 object. =for test_synopsis no strict 'vars' =head1 METHODS =head2 new Create a new bucket object. Expects a hash containing these two arguments: =over =item bucket =item account =back =head2 add_key Takes three positional parameters: =over =item key =item value =item configuration A hash of configuration data for this key. (See synopsis); =back Returns a boolean. =head2 add_key_filename Use this to upload a large file to S3. Takes three positional parameters: =over =item key =item filename =item configuration A hash of configuration data for this key. (See synopsis); =back Returns a boolean. =head2 copy_key Creates (or replaces) a key, copying its contents from another key elsewhere in S3. Takes the following parameters: =over =item key The key to (over)write =item source Where to copy the key from. Should be in the form C/I>/. =item conf Optional configuration hash. If present and defined, the configuration (ACL and headers) there will be used for the new key; otherwise it will be copied from the source key. =back =head2 edit_metadata Changes the metadata associated with an existing key. Arguments: =over =item key The key to edit =item conf The new configuration hash to use =back =head2 head_key KEY Takes the name of a key in this bucket and returns its configuration hash =head2 query_string_authentication_uri KEY, EXPIRES_AT Takes key and expiration time (epoch time) and returns uri signed with query parameter =head2 get_key $key_name [$method] Takes a key name and an optional HTTP method (which defaults to C. Fetches the key from AWS. On failure: Returns undef on missing content, throws an exception (dies) on server errors. On success: Returns a hashref of { content_type, etag, value, @meta } on success. Other values from the server are there too, with the key being lowercased. =head2 get_key_filename $key_name $method $filename Use this to download large files from S3. Takes a key name and an optional HTTP method (which defaults to C. Fetches the key from AWS and writes it to the filename. THe value returned will be empty. On failure: Returns undef on missing content, throws an exception (dies) on server errors. On success: Returns a hashref of { content_type, etag, value, @meta } on success =head2 delete_key $key_name Removes C<$key> from the bucket. Forever. It's gone after this. Returns true on success and false on failure =head2 delete_bucket Delete the current bucket object from the server. Takes no arguments. Fails if the bucket has anything in it. This is an alias for C<< $s3->delete_bucket($bucket) >> =head2 list List all keys in this bucket. see L for documentation of this method. =head2 list_all List all keys in this bucket without having to worry about 'marker'. This may make multiple requests to S3 under the hood. see L for documentation of this method. =head2 get_acl Takes one optional positional parameter =over =item key (optional) If no key is specified, it returns the acl for the bucket. =back Returns an acl in XML format. =head2 set_acl Takes a configuration hash_ref containing: =over =item acl_xml (cannot be used in conjunction with acl_short) An XML string which contains access control information which matches Amazon's published schema. There is an example of one of these XML strings in the tests for this module. =item acl_short (cannot be used in conjunction with acl_xml) You can use the shorthand notation instead of specifying XML for certain 'canned' types of acls. (from the Amazon API documentation) private: Owner gets FULL_CONTROL. No one else has any access rights. This is the default. public-read:Owner gets FULL_CONTROL and the anonymous principal is granted READ access. If this policy is used on an object, it can be read from a browser with no authentication. public-read-write:Owner gets FULL_CONTROL, the anonymous principal is granted READ and WRITE access. This is a useful policy to apply to a bucket, if you intend for any anonymous user to PUT objects into the bucket. authenticated-read:Owner gets FULL_CONTROL, and any principal authenticated as a registered Amazon S3 user is granted READ access. =item key (optional) If the key is not set, it will apply the acl to the bucket. =back Returns a boolean. =head2 get_location_constraint Retrieves the location constraint set when the bucket was created. Returns a string (eg, 'EU'), or undef if no location constraint was set. =head2 err The S3 error code for the last error the object ran into =head2 errstr A human readable error string for the last error the object ran into =head1 SEE ALSO L =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Client.pm100644000765000024 1367713620607144 17655 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3package Net::Amazon::S3::Client; $Net::Amazon::S3::Client::VERSION = '0.89'; use Moose 0.85; use HTTP::Status qw(is_error status_message); use MooseX::StrictConstructor 0.16; use Moose::Util::TypeConstraints; # ABSTRACT: An easy-to-use Amazon S3 client type 'Etag' => where { $_ =~ /^[a-z0-9]{32}(?:-\d+)?$/ }; has 's3' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 ); __PACKAGE__->meta->make_immutable; sub bucket_class { 'Net::Amazon::S3::Client::Bucket' } sub buckets { my $self = shift; my $s3 = $self->s3; my $http_request = Net::Amazon::S3::Request::ListAllMyBuckets->new( s3 => $s3 ) ->http_request; my $xpc = $self->_send_request_xpc($http_request); my $owner_id = $xpc->findvalue('/s3:ListAllMyBucketsResult/s3:Owner/s3:ID'); my $owner_display_name = $xpc->findvalue( '/s3:ListAllMyBucketsResult/s3:Owner/s3:DisplayName'); my @buckets; foreach my $node ( $xpc->findnodes('/s3:ListAllMyBucketsResult/s3:Buckets/s3:Bucket') ) { push @buckets, $self->bucket_class->new( { client => $self, name => $xpc->findvalue( './s3:Name', $node ), creation_date => $xpc->findvalue( './s3:CreationDate', $node ), owner_id => $owner_id, owner_display_name => $owner_display_name, } ); } return @buckets; } sub create_bucket { my ( $self, %conf ) = @_; my $bucket = $self->bucket_class->new( client => $self, name => $conf{name}, ); $bucket->_create( acl_short => $conf{acl_short}, location_constraint => $conf{location_constraint}, ); return $bucket; } sub bucket { my ( $self, %conf ) = @_; return $self->bucket_class->new( client => $self, %conf, ); } sub _send_request_raw { my ( $self, $http_request, $filename ) = @_; return $self->s3->ua->request( $http_request, $filename ); } sub _send_request { my ( $self, $http_request, $filename ) = @_; my $http_response = $self->_send_request_raw( $http_request, $filename ); my $content = $http_response->content; my $content_type = $http_response->content_type; my $code = $http_response->code; if ( is_error($code) ) { if ( $content_type eq 'application/xml' ) { my $xpc = $self->s3->_xpc_of_content ($content); if ( $xpc->findnodes('/Error') ) { my $code = $xpc->findvalue('/Error/Code'); my $message = $xpc->findvalue('/Error/Message'); confess("$code: $message"); } else { confess status_message($code); } } else { confess status_message($code); } } return $http_response; } sub _send_request_content { my ( $self, $http_request, $filename ) = @_; my $http_response = $self->_send_request( $http_request, $filename ); return $http_response->content; } sub _send_request_xpc { my ( $self, $http_request, $filename ) = @_; my $http_response = $self->_send_request( $http_request, $filename ); return $self->s3->_xpc_of_content( $http_response->content ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Client - An easy-to-use Amazon S3 client =head1 VERSION version 0.89 =head1 SYNOPSIS my $s3 = Net::Amazon::S3->new( aws_access_key_id => $aws_access_key_id, aws_secret_access_key => $aws_secret_access_key, retry => 1, ); my $client = Net::Amazon::S3::Client->new( s3 => $s3 ); # list all my buckets # returns a list of L objects my @buckets = $client->buckets; foreach my $bucket (@buckets) { print $bucket->name . "\n"; } # create a new bucket # returns a L object my $bucket = $client->create_bucket( name => $bucket_name, acl_short => 'private', location_constraint => 'us-east-1', ); # or use an existing bucket # returns a L object my $bucket = $client->bucket( name => $bucket_name ); =head1 DESCRIPTION The L module was written when the Amazon S3 service had just come out and it is a light wrapper around the APIs. Some bad API decisions were also made. The L, L and L classes are designed after years of usage to be easy to use for common tasks. These classes throw an exception when a fatal error occurs. It also is very careful to pass an MD5 of the content when uploaded to S3 and check the resultant ETag. WARNING: This is an early release of the Client classes, the APIs may change. =for test_synopsis no strict 'vars' =head1 METHODS =head2 buckets # list all my buckets # returns a list of L objects my @buckets = $client->buckets; foreach my $bucket (@buckets) { print $bucket->name . "\n"; } =head2 create_bucket # create a new bucket # returns a L object my $bucket = $client->create_bucket( name => $bucket_name, acl_short => 'private', location_constraint => 'us-east-1', ); =head2 bucket # or use an existing bucket # returns a L object my $bucket = $client->bucket( name => $bucket_name ); =head2 bucket_class # returns string "Net::Amazon::S3::Client::Bucket" # subclasses will want to override this. my $bucket_class = $client->bucket_class =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut api-service-buckets-list.t100644000765000024 374613620607144 20315 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_list_all_my_buckets ], ); use Shared::Examples::Net::Amazon::S3::Operation::Service::Buckets::List ( qw[ buckets_list_with_displayname ], qw[ buckets_list_without_displayname ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], ); expect_api_list_all_my_buckets 'list all my buckets with displayname' => ( with_response_data => buckets_list_with_displayname, expect_request => { GET => 'https://s3.amazonaws.com/' }, expect_data => { owner_id => 'bcaf1ffd86f461ca5fb16fd081034f', owner_displayname => 'webfile', buckets => [ all ( obj_isa ('Net::Amazon::S3::Bucket'), methods (bucket => 'quotes'), ), all ( obj_isa ('Net::Amazon::S3::Bucket'), methods (bucket => 'samples'), ), ], }, ); expect_api_list_all_my_buckets 'list all my buckets without displayname' => ( with_response_data => buckets_list_without_displayname, expect_request => { GET => 'https://s3.amazonaws.com/' }, expect_data => { owner_id => 'bcaf1ffd86f461ca5fb16fd081034f', owner_displayname => '', buckets => [ all ( obj_isa ('Net::Amazon::S3::Bucket'), methods (bucket => 'quotes'), ), all ( obj_isa ('Net::Amazon::S3::Bucket'), methods (bucket => 'samples'), ), ], }, ); expect_api_list_all_my_buckets 'list all my buckets without displayname' => ( fixture_error_access_denied, expect_request => { GET => 'https://s3.amazonaws.com/' }, expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); request-list-all-buckets.t100644000765000024 71013620607144 20310 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'list all buckets' => ( request_class => 'Net::Amazon::S3::Request::ListAllMyBuckets', expect_request_method => 'GET', expect_request_path => '', expect_request_headers => { }, expect_request_content => '', ); Request.pm100644000765000024 1200613620607144 20050 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3package Net::Amazon::S3::Request; $Net::Amazon::S3::Request::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; use Moose::Util::TypeConstraints; use Regexp::Common qw /net/; # ABSTRACT: Base class for request objects enum 'AclShort' => # Current list at https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl [ qw(private public-read public-read-write aws-exec-read authenticated-read bucket-owner-read bucket-owner-full-control log-delivery-write ) ]; enum 'LocationConstraint' => [ # https://docs.aws.amazon.com/general/latest/gr/rande.html#s3_region 'ap-northeast-1', 'ap-northeast-2', 'ap-northeast-3', 'ap-south-1', 'ap-southeast-1', 'ap-southeast-2', 'ca-central-1', 'cn-north-1', 'cn-northwest-1', 'eu-central-1', 'eu-north-1', 'eu-west-1', 'eu-west-2', 'eu-west-3', 'sa-east-1', 'us-east-1', 'us-east-2', 'us-west-1', 'us-west-2', ]; subtype 'MaybeLocationConstraint' => as 'Maybe[LocationConstraint]' ; # maintain backward compatiblity with 'US' and 'EU' values my %location_constraint_alias = ( US => 'us-east-1', EU => 'eu-west-1', ); enum 'LocationConstraintAlias' => [ keys %location_constraint_alias ]; coerce 'LocationConstraint' => from 'LocationConstraintAlias' => via { $location_constraint_alias{$_} } ; coerce 'MaybeLocationConstraint' => from 'LocationConstraintAlias' => via { $location_constraint_alias{$_} } ; # To comply with Amazon S3 requirements, bucket names must: # Contain lowercase letters, numbers, periods (.), underscores (_), and dashes (-) # Start with a number or letter # Be between 3 and 255 characters long # Not be in an IP address style (e.g., "192.168.5.4") subtype 'BucketName1' => as 'Str' => where { $_ =~ /^[a-zA-Z0-9._-]+$/; } => message { "Bucket name ($_) must contain lowercase letters, numbers, periods (.), underscores (_), and dashes (-)"; }; subtype 'BucketName2' => as 'BucketName1' => where { $_ =~ /^[a-zA-Z0-9]/; } => message { "Bucket name ($_) must start with a number or letter"; }; subtype 'BucketName3' => as 'BucketName2' => where { length($_) >= 3 && length($_) <= 255; } => message { "Bucket name ($_) must be between 3 and 255 characters long"; }; subtype 'BucketName' => as 'BucketName3' => where { $_ !~ /^$RE{net}{IPv4}$/; } => message { "Bucket name ($_) must not be in an IP address style (e.g., '192.168.5.4')"; }; has 's3' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 ); has '_http_request_content' => ( is => 'ro', init_arg => undef, isa => 'Maybe[Str]', lazy => 1, builder => '_request_content', ); __PACKAGE__->meta->make_immutable; sub _request_content { ''; } sub _request_path { ''; } sub _request_headers { } sub _request_query_action { } sub _request_query_params { } sub _request_query_string { my ($self) = @_; my %query_params = $self->_request_query_params; my @parts = ( ($self->_request_query_action) x!! $self->_request_query_action, map "$_=${\ $self->s3->_urlencode( $query_params{$_} ) }", sort keys %query_params, ); return '' unless @parts; return '?' . join '&', @parts; } sub _http_request_path { my ($self) = @_; return $self->_request_path . $self->_request_query_string; } sub _http_request_headers { my ($self) = @_; return +{ $self->_request_headers }; } sub _build_signed_request { my ($self, %params) = @_; $params{path} = $self->_http_request_path unless exists $params{path}; $params{method} = $self->_http_request_method unless exists $params{method}; $params{headers} = $self->_http_request_headers unless exists $params{headers}; $params{content} = $self->_http_request_content unless exists $params{content} or ! defined $self->_http_request_content; # Although Amazon's Signature 4 test suite explicitely handles // it appears # it's inconsistent with their implementation so removing it here $params{path} =~ s{//+}{/}g; return Net::Amazon::S3::HTTPRequest->new( %params, s3 => $self->s3, $self->can( 'bucket' ) ? (bucket => $self->bucket) : (), ); } sub _build_http_request { my ($self, %params) = @_; return $self->_build_signed_request( %params )->http_request; } sub http_request { my $self = shift; return $self->_build_http_request; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request - Base class for request objects =head1 VERSION version 0.89 =head1 SYNOPSIS # do not instantiate directly =head1 DESCRIPTION This module is a base class for all the Net::Amazon::S3::Request::* classes. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut api-bucket-objects-delete.t100644000765000024 344713620607144 20410 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_bucket_objects_delete ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); use Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::Delete ( qw[ fixture_response_quiet_without_errors ], ); expect_api_bucket_objects_delete 'delete multiple objects' => ( with_bucket => 'some-bucket', with_keys => [qw[ key-1 key-2 ]], fixture_response_quiet_without_errors, expect_request => { POST => 'https://some-bucket.s3.amazonaws.com/?delete' }, expect_data => bool (1), expect_request_content => <<'XML', true key-1 key-2 XML ); expect_api_bucket_objects_delete 'with error access denied' => ( with_bucket => 'some-bucket', with_keys => [qw[ key-1 key-2 ]], fixture_error_access_denied, expect_request => { POST => 'https://some-bucket.s3.amazonaws.com/?delete' }, expect_data => bool (0), expect_s3_err => 'AccessDenied', expect_s3_errstr => 'Access denied error message', ); expect_api_bucket_objects_delete 'with error no such bucket' => ( with_bucket => 'some-bucket', with_keys => [qw[ key-1 key-2 ]], fixture_error_no_such_bucket, expect_request => { POST => 'https://some-bucket.s3.amazonaws.com/?delete' }, expect_data => bool (0), expect_s3_err => 'NoSuchBucket', expect_s3_errstr => 'No such bucket error message', ); client-bucket-objects-list.t100644000765000024 1232613620607144 20642 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 6; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_bucket_objects_list ], ); use Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::List ( qw[ list_bucket_objects_v1 ], qw[ list_bucket_objects_v1_with_filter ], qw[ list_bucket_objects_v1_with_delimiter ], qw[ list_bucket_objects_v1_with_prefix_and_delimiter ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); expect_client_bucket_objects_list 'list objects (version 1)' => ( with_bucket => 'some-bucket', with_response_data => list_bucket_objects_v1, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?max-keys=1000' }, expect_data => methods (get_more => [ all ( obj_isa ('Net::Amazon::S3::Client::Object'), methods (bucket => methods(name => 'some-bucket')), methods (key => 'my-image.jpg'), methods (last_modified_raw => '2009-10-12T17:50:30.000Z'), methods (etag => 'fba9dede5f27731c9771645a39863328'), methods (size => 434234), ), all ( obj_isa ('Net::Amazon::S3::Client::Object'), methods (bucket => methods(name => 'some-bucket')), methods (key => 'my-third-image.jpg'), methods (last_modified_raw => '2009-10-12T17:50:30.000Z'), methods (etag => '1b2cf535f27731c974343645a3985328'), methods (size => 64994), ), ]), ); expect_client_bucket_objects_list 'list objects with filters (version 1)' => ( with_bucket => 'some-bucket', # truncated is not supported by shared examples yet (multiple requests => client reads while is truncated) with_response_data => list_bucket_objects_v1_with_filter, with_prefix => 'N', with_marker => 'Ned', with_max_keys => 40, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?max-keys=1000&prefix=N' }, expect_data => methods (get_more => [ all ( obj_isa ('Net::Amazon::S3::Client::Object'), methods (bucket => methods(name => 'some-bucket')), methods (key => 'Nelson'), methods (last_modified_raw => '2006-01-01T12:00:00.000Z'), methods (etag => '828ef3fdfa96f00ad9f27c383fc9ac7f'), methods (size => 5), ), all ( obj_isa ('Net::Amazon::S3::Client::Object'), methods (bucket => methods(name => 'some-bucket')), methods (key => 'Neo'), methods (last_modified_raw => '2006-01-01T12:00:00.000Z'), methods (etag => '828ef3fdfa96f00ad9f27c383fc9ac7f'), methods (size => 4), ), ]), ); # Client doesn't support common prefixes expect_client_bucket_objects_list 'list objects with delimiter (version 1)' => ( with_bucket => 'some-bucket', with_response_data => list_bucket_objects_v1_with_delimiter, with_delimiter => '/', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?delimiter=%2F&max-keys=1000' }, expect_data => methods (get_more => [ all ( obj_isa ('Net::Amazon::S3::Client::Object'), methods (bucket => methods(name => 'some-bucket')), methods (key => 'sample.jpg'), methods (last_modified_raw => '2011-02-26T01:56:20.000Z'), methods (etag => 'bf1d737a4d46a19f3bced6905cc8b902'), methods (size => 142863), ), ]), ); # Client doesn't support common prefixes expect_client_bucket_objects_list 'list objects with prefix and delimiter (version 1)' => ( with_bucket => 'some-bucket', with_response_data => list_bucket_objects_v1_with_prefix_and_delimiter, with_delimiter => '/', with_prefix => 'photos/2006/', expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?delimiter=%2F&max-keys=1000&prefix=photos%2F2006%2F' }, expect_data => methods (get_more => undef), ); expect_client_bucket_objects_list 'error access denied' => ( with_bucket => 'some-bucket', fixture_error_access_denied, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?max-keys=1000' }, expect_data => code(sub { return 0, "expect throw but lives" if eval { $_[0]->get_more; 1 }; my $error = $@; Test::Deep::cmp_details $error, re(qr/^AccessDenied: Access denied error message/); }), ); expect_client_bucket_objects_list 'error no such bucket' => ( with_bucket => 'some-bucket', fixture_error_no_such_bucket, expect_request => { GET => 'https://some-bucket.s3.amazonaws.com/?max-keys=1000' }, expect_data => methods (get_more => undef), expect_data => code(sub { return 0, "expect throw but lives" if eval { $_[0]->get_more; 1 }; my $error = $@; Test::Deep::cmp_details $error, re(qr/^NoSuchBucket: No such bucket error message/); }), ); Features.pod100644000765000024 1730113620607144 20347 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3# PODNAME:Net::Amazon::S3::Features # ABSTRACT: Features available in Net::Amazon::S3 __CUT__ __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Features - Features available in Net::Amazon::S3 =head1 VERSION version 0.89 =head1 API COMPARISON Net::Amazon::S3 supports two APIs with different feature support. This document describes current behaviour. =head2 Error reporting How API signals operation error =over =item set S3 err Operation returns expression evaluated as false and C<< err >> with C<< errstr >> are populated from response content =item set network error Populates S3 err with C<< network_error >> constant and S3 errstr with http status line (eg: C<< 404 Not Found >>) and throws. =item confess Operation throws using C<< confess >> =back =head2 Feature support For details see corresponding C<< api-operation >> / C<< client-operation >> test file |-----------------------+----------------------------+--------------------------| | operation | Net::Amazon::S3 (API) | Net::Amazon::S3::Client | |-----------------------+----------------------------+--------------------------| | service-buckets-list | | | | - returns | Bucket instances in struct | Bucket instances (list) | | - errors | set S3 err | confess | |-----------------------+----------------------------+--------------------------| | bucket-acl-get | | | | - returns | response body (XML) | response body (XML) | | | (undef on Not Found) | | | - errors | set network error | confess | | | (none on Not Found) | | |-----------------------+----------------------------+--------------------------| | bucket-acl-set | | | | - with canned acl | yes, as acl_short | N/A | | - with xml acl | yes, as acl_xml | N/A | | - returns | boolean | N/A | | - errors | set S3 err | N/A | |-----------------------+----------------------------+--------------------------| | bucket-create | | | | - with region | yes | yes | | - returns | Bucket instance | Bucket instance | | - errors | set S3 err | confess | |-----------------------+----------------------------+--------------------------| | bucket-delete | | | | - returns | boolean | true | | - errors | set S3 err | confess | |-----------------------+----------------------------+--------------------------| | bucket-objects-list | | | | - list version 1 | yes | yes | | - list version 2 | no | no | | - common prefixes | supported | not supported | | - list all | list all method | yes | | - returns | struct with list | iterator (Object list) | | - errors | set S3 err | confess during iteration | |-----------------------+----------------------------+--------------------------| | bucket-objects-delete | | | | - returns | boolean | HTTP::Response object | | - errors | set S3 err | confess | |-----------------------+----------------------------+--------------------------| | object-acl-get | | | | - returns | response body (XML) | N/A | | | (undef on Not Found) | N/A | | - errors | set network error | N/A | | | (none on Not Found) | N/A | |-----------------------+----------------------------+--------------------------| | object-acl-set | | | | - with canned acl | yes, as acl_short | N/A | | - with xml acl | yes, as acl_xml | N/A | | - returns | boolean | N/A | | - errors | set S3 err | N/A | |-----------------------+----------------------------+--------------------------| | object-copy | | | | - returns | boolean | N/A | | - errors | set S3 err | N/A | |-----------------------+----------------------------+--------------------------| | object-create | | | | - returns | boolean | empty string | | - errors | set S3 err | confess | |-----------------------+----------------------------+--------------------------| | object-delete | | | | - returns | boolean | true | | - errors | set S3 err | confess | |-----------------------+----------------------------+--------------------------| | object-fetch | | | | - returns | struct with value | value | | | (undef on Not Found) | | | - errors | set network error | confess | | | (none on Not Found) | | |-----------------------+----------------------------+--------------------------| | object-head | | | | - returns | boolean | N/A | | - errors | set S3 err | N/A | |-----------------------+----------------------------+--------------------------| =head2 TODO plan (asorted, not promised) =over =item normalize error reporting Make every operation to behave similar (especially C<< Net::Amazon::S3 >> =item make error reporting pluggable With possibility to inject user's own reporting =item unify features Both APIs should support same set of operations =item support all AWS S3 operations and x-amz-* headers https://docs.aws.amazon.com/AmazonS3/latest/API/Welcome.html =item add async API (AnyEvent / IO::Async) =back =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Signature.pm100644000765000024 277313620607144 20353 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3package Net::Amazon::S3::Signature; # ABSTRACT: S3 Signature implementation base class $Net::Amazon::S3::Signature::VERSION = '0.89'; use Moose; has http_request => ( is => 'ro', isa => 'Net::Amazon::S3::HTTPRequest', ); sub sign_request { my ($self, $request); return; } sub sign_uri { my ($self, $uri, $expires_at); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Signature - S3 Signature implementation base class =head1 VERSION version 0.89 =head1 METHODS =head2 new Signature class should accept HTTPRequest instance and determine every required parameter via this instance =head2 sign_request( $request ) Signature class should return authenticated request based on given parameter. Parameter can be modified. =head2 sign_uri( $request, $expires_at? ) Signature class should return authenticated uri based on given request. $expires_at is expiration time in seconds (epoch). Default and maximal allowed value may depend on signature version. Default request date is current time. Signature class should accept provided C<< X-Amz-Date >> header instead (if signing request) or query parameter (if signing uri) =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut request-delete-multi-object.t100644000765000024 334113620607144 21012 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'delete multi object with empty keys' => ( request_class => 'Net::Amazon::S3::Request::DeleteMultiObject', with_bucket => 'some-bucket', with_keys => [], expect_request_method => 'POST', expect_request_path => 'some-bucket/?delete', expect_request_headers => { 'Content-MD5' => 'hWgjGHog2fcu6stNeIAJsw==', 'Content-Length' => 76, 'Content-Type' => 'application/xml', }, expect_request_content => <<'EOXML', true EOXML ); behaves_like_net_amazon_s3_request 'delete multi object with some keys' => ( request_class => 'Net::Amazon::S3::Request::DeleteMultiObject', with_bucket => 'some-bucket', with_keys => [ 'some/key', '' ], expect_request_method => 'POST', expect_request_path => 'some-bucket/?delete', expect_request_headers => { 'Content-MD5' => '+6onPaU8IPGxGhWh0ULBJg==', 'Content-Length' => 159, 'Content-Type' => 'application/xml', }, expect_request_content => <<'EOXML', true some/key <another/key> EOXML ); behaves_like_net_amazon_s3_request 'delete multi object with more than 1_000 keys' => ( request_class => 'Net::Amazon::S3::Request::DeleteMultiObject', with_bucket => 'some-bucket', with_keys => [ 0 .. 1_000 ], throws => re( qr/The maximum number of keys is 1000/ ), ); client-service-buckets-list.t100644000765000024 416713620607144 21020 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_list_all_my_buckets ], ); use Shared::Examples::Net::Amazon::S3::Operation::Service::Buckets::List ( qw[ buckets_list_with_displayname ], qw[ buckets_list_without_displayname ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], ); expect_client_list_all_my_buckets 'list all my buckets with displayname' => ( with_response_data => buckets_list_with_displayname, expect_request => { GET => 'https://s3.amazonaws.com/' }, expect_data => [ all ( obj_isa ('Net::Amazon::S3::Client::Bucket'), methods (name => 'quotes'), methods (owner_id => 'bcaf1ffd86f461ca5fb16fd081034f'), methods (owner_display_name => 'webfile'), ), all ( obj_isa ('Net::Amazon::S3::Client::Bucket'), methods (name => 'samples'), methods (owner_id => 'bcaf1ffd86f461ca5fb16fd081034f'), methods (owner_display_name => 'webfile'), ), ], ); expect_client_list_all_my_buckets 'list all my buckets without displayname' => ( with_response_data => buckets_list_without_displayname, expect_request => { GET => 'https://s3.amazonaws.com/' }, expect_data => [ all ( obj_isa ('Net::Amazon::S3::Client::Bucket'), methods (name => 'quotes'), methods (owner_id => 'bcaf1ffd86f461ca5fb16fd081034f'), methods (owner_display_name => ''), ), all ( obj_isa ('Net::Amazon::S3::Client::Bucket'), methods (name => 'samples'), methods (owner_id => 'bcaf1ffd86f461ca5fb16fd081034f'), methods (owner_display_name => ''), ), ], ); expect_client_list_all_my_buckets 'list all my buckets without displayname' => ( fixture_error_access_denied, expect_request => { GET => 'https://s3.amazonaws.com/' }, throws => qr/^AccessDenied: Access denied error message/, ); client-bucket-objects-delete.t100644000765000024 337113620607144 21111 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Client ( qw[ expect_client_bucket_objects_delete ], ); use Shared::Examples::Net::Amazon::S3::Error ( qw[ fixture_error_access_denied ], qw[ fixture_error_no_such_bucket ], ); use Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::Delete ( qw[ fixture_response_quiet_without_errors ], ); expect_client_bucket_objects_delete 'delete multiple objects' => ( with_bucket => 'some-bucket', with_keys => [qw[ key-1 key-2 ]], fixture_response_quiet_without_errors, expect_request => { POST => 'https://some-bucket.s3.amazonaws.com/?delete' }, expect_data => all ( obj_isa ('HTTP::Response'), methods (is_success => bool (1)), ), expect_request_content => <<'XML', true key-1 key-2 XML ); expect_client_bucket_objects_delete 'with error access denied' => ( with_bucket => 'some-bucket', with_keys => [qw[ key-1 key-2 ]], fixture_error_access_denied, expect_request => { POST => 'https://some-bucket.s3.amazonaws.com/?delete' }, throws => qr/^AccessDenied: Access denied error message/, ); expect_client_bucket_objects_delete 'with error no such bucket' => ( with_bucket => 'some-bucket', with_keys => [qw[ key-1 key-2 ]], fixture_error_no_such_bucket, expect_request => { POST => 'https://some-bucket.s3.amazonaws.com/?delete' }, throws => qr/^NoSuchBucket: No such bucket error message/, ); HTTPRequest.pm100755000765000024 1024213620607144 20553 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3package Net::Amazon::S3::HTTPRequest; $Net::Amazon::S3::HTTPRequest::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; use HTTP::Date; use MIME::Base64 qw( encode_base64 ); use Moose::Util::TypeConstraints; use URI::Escape qw( uri_escape_utf8 ); use URI::QueryParam; use URI; use Net::Amazon::S3::Signature::V2; # ABSTRACT: Create a signed HTTP::Request my $METADATA_PREFIX = 'x-amz-meta-'; my $AMAZON_HEADER_PREFIX = 'x-amz-'; enum 'HTTPMethod' => [ qw(DELETE GET HEAD PUT POST) ]; with 'Net::Amazon::S3::Role::Bucket'; has '+bucket' => (required => 0); has 's3' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 ); has 'method' => ( is => 'ro', isa => 'HTTPMethod', required => 1 ); has 'path' => ( is => 'ro', isa => 'Str', required => 1 ); has 'headers' => ( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } ); has 'content' => ( is => 'ro', isa => 'Str|CodeRef|ScalarRef', required => 0, default => '' ); has 'metadata' => ( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } ); has use_virtual_host => ( is => 'ro', isa => 'Bool', lazy => 1, default => sub { $_[0]->s3->use_virtual_host }, ); has authorization_method => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { $_[0]->s3->authorization_method }, ); has region => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { $_[0]->bucket->region }, ); __PACKAGE__->meta->make_immutable; # make the HTTP::Request object sub _build_request { my $self = shift; my $method = $self->method; my $path = $self->path; my $headers = $self->headers; my $content = $self->content; my $metadata = $self->metadata; my $http_headers = $self->_merge_meta( $headers, $metadata ); my $protocol = $self->s3->secure ? 'https' : 'http'; my $host = $self->s3->host; my $uri = "$protocol://$host/$path"; if ($self->use_virtual_host) { # use https://bucketname.s3.amazonaws.com instead of https://s3.amazonaws.com/bucketname # see http://docs.aws.amazon.com/AmazonS3/latest/dev/VirtualHosting.html $uri =~ s{$host/(.*?)/}{$1.$host/}; } return HTTP::Request->new( $method, $uri, $http_headers, $content ); } sub http_request { my $self = shift; my $request = $self->_build_request; $self->authorization_method->new( http_request => $self )->sign_request( $request ) unless $request->header( 'Authorization' ); return $request; } sub query_string_authentication_uri { my ( $self, $expires ) = @_; my $request = $self->_build_request; my $sign = $self->authorization_method->new( http_request => $self ); return $sign->sign_uri( $request, $expires ); } sub _merge_meta { my ( $self, $headers, $metadata ) = @_; $headers ||= {}; $metadata ||= {}; my $http_header = HTTP::Headers->new; while ( my ( $k, $v ) = each %$headers ) { $http_header->header( $k => $v ); } while ( my ( $k, $v ) = each %$metadata ) { $http_header->header( "$METADATA_PREFIX$k" => $v ); } return $http_header; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::HTTPRequest - Create a signed HTTP::Request =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::HTTPRequest->new( s3 => $self->s3, method => 'PUT', path => $self->bucket . '/', headers => $headers, content => $content, )->http_request; =head1 DESCRIPTION This module creates an HTTP::Request object that is signed appropriately for Amazon S3. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method creates, signs and returns a HTTP::Request object. =head2 query_string_authentication_uri This method creates, signs and returns a query string authentication URI. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Role000755000765000024 013620607144 16604 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3Bucket.pm100644000765000024 271113620607144 20520 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Rolepackage Net::Amazon::S3::Role::Bucket; # ABSTRACT: Bucket role $Net::Amazon::S3::Role::Bucket::VERSION = '0.89'; use Moose::Role; use Scalar::Util; around BUILDARGS => sub { my ($orig, $class, %params) = @_; $params{region} = $params{bucket}->region if $params{bucket} and Scalar::Util::blessed( $params{bucket} ) and ! $params{region} and $params{bucket}->has_region ; $params{bucket} = $params{bucket}->name if $params{bucket} and Scalar::Util::blessed( $params{bucket} ) and $params{bucket}->isa( 'Net::Amazon::S3::Client::Bucket' ) ; $params{bucket} = Net::Amazon::S3::Bucket->new( bucket => $params{bucket}, account => $params{s3}, (region => $params{region}) x!! $params{region}, ) if $params{bucket} and ! ref $params{bucket}; delete $params{region}; $class->$orig( %params ); }; has bucket => ( is => 'ro', isa => 'Net::Amazon::S3::Bucket', required => 1, ); 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Role::Bucket - Bucket role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Signature000755000765000024 013620607144 17644 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3V4.pm100644000765000024 625113620607144 20637 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Signaturepackage Net::Amazon::S3::Signature::V4; # ABSTRACT: V4 signatures $Net::Amazon::S3::Signature::V4::VERSION = '0.89'; use Moose; use Net::Amazon::S3::Signature::V4Implementation; use Digest::SHA; use Ref::Util; use Net::Amazon::S3::Signature::V2; use namespace::clean; extends 'Net::Amazon::S3::Signature'; sub enforce_use_virtual_host { 1; } sub redirect_handler { my ($self, $http_request, $response, $ua, $h) = @_; my $region = $response->header('x-amz-bucket-region') or return; # change the bucket region in request my $request = $response->request; $request->uri( $response->header( 'location' ) ); # sign the request again $request->headers->remove_header('Authorization'); $request->headers->remove_header('x-amz-date'); $http_request->_sign_request( $request, $region ); return $request; } sub _bucket_region { my ($self) = @_; return $self->http_request->region; } sub _sign { my ($self, $region) = @_; return Net::Amazon::S3::Signature::V4Implementation->new( $self->http_request->s3->aws_access_key_id, $self->http_request->s3->aws_secret_access_key, $region || $self->_bucket_region, 's3', ); } sub _host_to_region_host { my ($self, $sign, $request) = @_; my $host = $request->uri->host; return if $sign->{endpoint} eq 'us-east-1'; return unless $host =~ s/(?<=\bs3)(?=\.amazonaws\.com$)/"-" . $sign->{endpoint}/e; $request->uri->host( $host ); } sub sign_request { my ($self, $request, $region) = @_; my $sha = Digest::SHA->new( '256' ); if (Ref::Util::is_coderef( my $coderef = $request->content )) { while (length (my $snippet = $coderef->())) { $sha->add ($snippet); } $request->header( $Net::Amazon::S3::Signature::V4Implementation::X_AMZ_CONTENT_SHA256 => $sha->hexdigest ); } unless ($request->header ('x-amz-security-token')) { my $aws_session_token = $self->http_request->s3->aws_session_token; $request->header ('x-amz-security-token' => $aws_session_token) if defined $aws_session_token; } my $sign = $self->_sign( $region ); $self->_host_to_region_host( $sign, $request ); $sign->sign( $request ); return $request; } sub sign_uri { my ($self, $request, $expires_at) = @_; unless ($request->uri->query_param('x-amz-security-token')) { my $aws_session_token = $self->http_request->s3->aws_session_token; $request->uri->query_param('x-amz-security-token' => $aws_session_token) if defined $aws_session_token; } my $sign = $self->_sign; $self->_host_to_region_host( $sign, $request ); return $sign->sign_uri( $request->uri, $expires_at - time ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Signature::V4 - V4 signatures =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut V2.pm100644000765000024 1205113620607144 20650 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Signaturepackage Net::Amazon::S3::Signature::V2; # ABSTRACT: V2 signatures $Net::Amazon::S3::Signature::V2::VERSION = '0.89'; use Moose; use URI::Escape qw( uri_escape_utf8 ); use HTTP::Date qw[ time2str ]; use MIME::Base64 qw( encode_base64 ); use URI::QueryParam; use URI; use namespace::clean; extends 'Net::Amazon::S3::Signature'; my $AMAZON_HEADER_PREFIX = 'x-amz-'; sub enforce_use_virtual_host { 0; } sub sign_request { my ($self, $request) = @_; $self->_add_auth_header( $request ); } sub sign_uri { my ($self, $request, $expires) = @_; my $aws_access_key_id = $self->http_request->s3->aws_access_key_id; my $canonical_string = $self->_canonical_string( $request, $expires ); my $encoded_canonical = $self->_encode( $canonical_string ); my $uri = URI->new( $request->uri ); $uri->query_param( AWSAccessKeyId => $aws_access_key_id ); $uri->query_param( Expires => $expires ); $uri->query_param( Signature => $encoded_canonical ); $uri->as_string; } sub _add_auth_header { my ( $self, $request ) = @_; my $aws_access_key_id = $self->http_request->s3->aws_access_key_id; my $aws_secret_access_key = $self->http_request->s3->aws_secret_access_key; my $aws_session_token = $self->http_request->s3->aws_session_token; if ( not $request->headers->header('Date') ) { $request->header( Date => time2str(time) ); } if ( not $request->header('x-amz-security-token') and defined $aws_session_token ) { $request->header( 'x-amz-security-token' => $aws_session_token ); } my $canonical_string = $self->_canonical_string( $request ); my $encoded_canonical = $self->_encode( $canonical_string ); $request->header( Authorization => "AWS $aws_access_key_id:$encoded_canonical" ); } sub _canonical_string { my ( $self, $request, $expires ) = @_; my $method = $request->method; my $path = $self->http_request->path; my %interesting_headers = (); for my $key ($request->headers->header_field_names) { my $lk = lc $key; if ( $lk eq 'content-md5' or $lk eq 'content-type' or $lk eq 'date' or $lk =~ /^$AMAZON_HEADER_PREFIX/ ) { $interesting_headers{$lk} = $self->_trim( $request->header( $lk ) ); } } # these keys get empty strings if they don't exist $interesting_headers{'content-type'} ||= ''; $interesting_headers{'content-md5'} ||= ''; # just in case someone used this. it's not necessary in this lib. $interesting_headers{'date'} = '' if $interesting_headers{'x-amz-date'}; # if you're using expires for query string auth, then it trumps date # (and x-amz-date) $interesting_headers{'date'} = $expires if $expires; my $buf = "$method\n"; foreach my $key ( sort keys %interesting_headers ) { if ( $key =~ /^$AMAZON_HEADER_PREFIX/ ) { $buf .= "$key:$interesting_headers{$key}\n"; } else { $buf .= "$interesting_headers{$key}\n"; } } # don't include anything after the first ? in the resource... $path =~ /^([^?]*)/; $buf .= "/$1"; # ...unless there any parameters we're interested in... if ( $path =~ /[&?](acl|torrent|location|uploads|delete)($|=|&)/ ) { $buf .= "?$1"; } elsif ( my %query_params = URI->new($path)->query_form ){ #see if the remaining parsed query string provides us with any query string or upload id if($query_params{partNumber} && $query_params{uploadId}){ #re-evaluate query string, the order of the params is important for request signing, so we can't depend on URI to do the right thing $buf .= sprintf("?partNumber=%s&uploadId=%s", $query_params{partNumber}, $query_params{uploadId}); } elsif($query_params{uploadId}){ $buf .= sprintf("?uploadId=%s",$query_params{uploadId}); } } return $buf; } # finds the hmac-sha1 hash of the canonical string and the aws secret access key and then # base64 encodes the result (optionally urlencoding after that). sub _encode { my ( $self, $str, $urlencode ) = @_; my $hmac = Digest::HMAC_SHA1->new($self->http_request->s3->aws_secret_access_key); $hmac->add($str); my $b64 = encode_base64( $hmac->digest, '' ); if ($urlencode) { return $self->_urlencode($b64); } else { return $b64; } } sub _urlencode { my ( $self, $unencoded ) = @_; return uri_escape_utf8( $unencoded, '^A-Za-z0-9_-' ); } sub _trim { my ( $self, $value ) = @_; $value =~ s/^\s+//; $value =~ s/\s+$//; return $value; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Signature::V2 - V2 signatures =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut request-abort-multipart-upload.t100644000765000024 114713620607144 21566 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'abort multipart upload' => ( request_class => 'Net::Amazon::S3::Request::AbortMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/key', with_upload_id => '123&456', expect_request_method => 'DELETE', expect_request_path => 'some-bucket/some/key?uploadId=123%26456', expect_request_headers => { }, expect_request_content => '', ); Client000755000765000024 013620607144 17121 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3Object.pm100755000765000024 4645413620607144 21065 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Clientpackage Net::Amazon::S3::Client::Object; $Net::Amazon::S3::Client::Object::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; use DateTime::Format::HTTP; use Digest::MD5 qw(md5 md5_hex); use Digest::MD5::File qw(file_md5 file_md5_hex); use File::stat; use MIME::Base64; use Moose::Util::TypeConstraints; use MooseX::Types::DateTime::MoreCoercions 0.07 qw( DateTime ); use IO::File 1.14; use Ref::Util (); # ABSTRACT: An easy-to-use Amazon S3 client object enum 'AclShort' => # Current list at https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#canned-acl [ qw(private public-read public-read-write aws-exec-read authenticated-read bucket-owner-read bucket-owner-full-control log-delivery-write ) ]; enum 'StorageClass' => [ qw(standard reduced_redundancy standard_ia onezone_ia) ]; has 'client' => ( is => 'ro', isa => 'Net::Amazon::S3::Client', required => 1 ); has 'bucket' => ( is => 'ro', isa => 'Net::Amazon::S3::Client::Bucket', required => 1 ); has 'key' => ( is => 'ro', isa => 'Str', required => 1 ); has 'etag' => ( is => 'ro', isa => 'Etag', required => 0 ); has 'size' => ( is => 'ro', isa => 'Int', required => 0 ); has 'last_modified' => ( is => 'ro', isa => DateTime, coerce => 1, required => 0, default => sub { shift->last_modified_raw }, lazy => 1 ); has 'last_modified_raw' => ( is => 'ro', isa => 'Str', required => 0 ); has 'expires' => ( is => 'rw', isa => DateTime, coerce => 1, required => 0 ); has 'acl_short' => ( is => 'ro', isa => 'AclShort', required => 0, default => 'private' ); has 'content_type' => ( is => 'ro', isa => 'Str', required => 0, default => 'binary/octet-stream' ); has 'content_disposition' => ( is => 'ro', isa => 'Str', required => 0, ); has 'content_encoding' => ( is => 'ro', isa => 'Str', required => 0, ); has 'cache_control' => ( is => 'ro', isa => 'Str', required => 0, ); has 'storage_class' => ( is => 'ro', isa => 'StorageClass', required => 0, default => 'standard', ); has 'user_metadata' => ( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} }, ); has 'website_redirect_location' => ( is => 'ro', isa => 'Str', required => 0, ); has 'encryption' => ( is => 'ro', isa => 'Maybe[Str]', required => 0, ); __PACKAGE__->meta->make_immutable; sub exists { my $self = shift; my $http_request = Net::Amazon::S3::Request::GetObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, method => 'HEAD', )->http_request; my $http_response = $self->client->_send_request_raw($http_request); return $http_response->code == 200 ? 1 : 0; } sub _get { my $self = shift; my $http_request = Net::Amazon::S3::Request::GetObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, method => 'GET', )->http_request; my $http_response = $self->client->_send_request($http_request); my $content = $http_response->content; $self->_load_user_metadata($http_response); my $etag = $self->etag || $self->_etag($http_response); unless ($self->_is_multipart_etag($etag)) { my $md5_hex = md5_hex($content); confess 'Corrupted download' if $etag ne $md5_hex; } return $http_response; } sub get { my $self = shift; return $self->_get->content; } sub get_decoded { my $self = shift; return $self->_get->decoded_content(@_); } sub get_callback { my ( $self, $callback ) = @_; my $http_request = Net::Amazon::S3::Request::GetObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, method => 'GET', )->http_request; my $http_response = $self->client->_send_request( $http_request, $callback ); return $http_response; } sub get_filename { my ( $self, $filename ) = @_; my $http_request = Net::Amazon::S3::Request::GetObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, method => 'GET', )->http_request; my $http_response = $self->client->_send_request( $http_request, $filename ); $self->_load_user_metadata($http_response); my $etag = $self->etag || $self->_etag($http_response); unless ($self->_is_multipart_etag($etag)) { my $md5_hex = file_md5_hex($filename); confess 'Corrupted download' if $etag ne $md5_hex; } } sub _load_user_metadata { my ( $self, $http_response ) = @_; my %user_metadata; for my $header_name ($http_response->header_field_names) { my ($metadata_name) = lc($header_name) =~ /\A x-amz-meta- (.*) \z/xms or next; $user_metadata{$metadata_name} = $http_response->header($header_name); } %{ $self->user_metadata } = %user_metadata; } sub put { my ( $self, $value ) = @_; $self->_put( $value, length $value, md5_hex($value) ); } sub _put { my ( $self, $value, $size, $md5_hex ) = @_; my $md5_base64 = encode_base64( pack( 'H*', $md5_hex ) ); chomp $md5_base64; my $conf = { 'Content-MD5' => $md5_base64, 'Content-Length' => $size, 'Content-Type' => $self->content_type, }; if ( $self->expires ) { $conf->{Expires} = DateTime::Format::HTTP->format_datetime( $self->expires ); } if ( $self->content_encoding ) { $conf->{'Content-Encoding'} = $self->content_encoding; } if ( $self->content_disposition ) { $conf->{'Content-Disposition'} = $self->content_disposition; } if ( $self->cache_control ) { $conf->{'Cache-Control'} = $self->cache_control; } if ( $self->storage_class && $self->storage_class ne 'standard' ) { $conf->{'x-amz-storage-class'} = uc $self->storage_class; } if ( $self->website_redirect_location ) { $conf->{'x-amz-website-redirect-location'} = $self->website_redirect_location; } $conf->{"x-amz-meta-\L$_"} = $self->user_metadata->{$_} for keys %{ $self->user_metadata }; my $http_request = Net::Amazon::S3::Request::PutObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, value => $value, headers => $conf, acl_short => $self->acl_short, encryption => $self->encryption, )->http_request; my $http_response = $self->client->_send_request($http_request); confess 'Error uploading ' . $http_response->as_string if $http_response->code != 200; my $etag = $self->_etag($http_response); confess "Corrupted upload got $etag expected $md5_hex" if $etag ne $md5_hex; } sub put_filename { my ( $self, $filename ) = @_; my $md5_hex = $self->etag || file_md5_hex($filename); my $size = $self->size; unless ($size) { my $stat = stat($filename) || confess("No $filename: $!"); $size = $stat->size; } $self->_put( $self->_content_sub($filename), $size, $md5_hex ); } sub delete { my $self = shift; my $http_request = Net::Amazon::S3::Request::DeleteObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, )->http_request; $self->client->_send_request($http_request); } sub initiate_multipart_upload { my $self = shift; my %args = Ref::Util::is_plain_hashref($_[0]) ? %{$_[0]} : @_; my $http_request = Net::Amazon::S3::Request::InitiateMultipartUpload->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, encryption => $self->encryption, ($args{headers} ? (headers => $args{headers}) : ()), )->http_request; my $xpc = $self->client->_send_request_xpc($http_request); my $upload_id = $xpc->findvalue('//s3:UploadId'); confess "Couldn't get upload id from initiate_multipart_upload response XML" unless $upload_id; return $upload_id; } sub complete_multipart_upload { my $self = shift; my %args = ref($_[0]) ? %{$_[0]} : @_; #set default args $args{s3} = $self->client->s3; $args{key} = $self->key; $args{bucket} = $self->bucket->name; my $http_request = Net::Amazon::S3::Request::CompleteMultipartUpload->new(%args)->http_request; return $self->client->_send_request($http_request); } sub abort_multipart_upload { my $self = shift; my %args = ref($_[0]) ? %{$_[0]} : @_; #set default args $args{s3} = $self->client->s3; $args{key} = $self->key; $args{bucket} = $self->bucket->name; my $http_request = Net::Amazon::S3::Request::AbortMultipartUpload->new(%args)->http_request; return $self->client->_send_request($http_request); } sub put_part { my $self = shift; my %args = ref($_[0]) ? %{$_[0]} : @_; #set default args $args{s3} = $self->client->s3; $args{key} = $self->key; $args{bucket} = $self->bucket->name; #work out content length header $args{headers}->{'Content-Length'} = length $args{value} if(defined $args{value}); my $http_request = Net::Amazon::S3::Request::PutPart->new(%args)->http_request; return $self->client->_send_request($http_request); } sub list_parts { confess "Not implemented"; # TODO - Net::Amazon::S3::Request:ListParts is implemented, but need to # define better interface at this level. Currently returns raw XML. } sub uri { my $self = shift; return Net::Amazon::S3::Request::GetObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, method => 'GET', )->http_request->uri; } sub query_string_authentication_uri { my ($self, $query_form) = @_; return Net::Amazon::S3::Request::GetObject->new( s3 => $self->client->s3, bucket => $self->bucket->name, key => $self->key, method => 'GET', )->query_string_authentication_uri( $self->expires->epoch, $query_form ); } sub _content_sub { my $self = shift; my $filename = shift; my $stat = stat($filename); my $remaining = $stat->size; my $blksize = $stat->blksize || 4096; confess "$filename not a readable file with fixed size" unless -r $filename and ( -f _ || $remaining ); my $fh = IO::File->new( $filename, 'r' ) or confess "Could not open $filename: $!"; $fh->binmode; return sub { my $buffer; # upon retries the file is closed and we must reopen it unless ( $fh->opened ) { $fh = IO::File->new( $filename, 'r' ) or confess "Could not open $filename: $!"; $fh->binmode; $remaining = $stat->size; } # warn "read remaining $remaining"; unless ( my $read = $fh->read( $buffer, $blksize ) ) { # warn "read $read buffer $buffer remaining $remaining"; confess "Error while reading upload content $filename ($remaining remaining) $!" if $! and $remaining; # otherwise, we found EOF $fh->close or confess "close of upload content $filename failed: $!"; $buffer ||= '' ; # LWP expects an emptry string on finish, read returns 0 } $remaining -= length($buffer); return $buffer; }; } sub _etag { my ( $self, $http_response ) = @_; my $etag = $http_response->header('ETag'); if ($etag) { $etag =~ s/^"//; $etag =~ s/"$//; } return $etag; } sub _is_multipart_etag { my ( $self, $etag ) = @_; return 1 if($etag =~ /\-\d+$/); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Client::Object - An easy-to-use Amazon S3 client object =head1 VERSION version 0.89 =head1 SYNOPSIS # show the key print $object->key . "\n"; # show the etag of an existing object (if fetched by listing # a bucket) print $object->etag . "\n"; # show the size of an existing object (if fetched by listing # a bucket) print $object->size . "\n"; # to create a new object my $object = $bucket->object( key => 'this is the key' ); $object->put('this is the value'); # to get the vaue of an object my $value = $object->get; # to see if an object exists if ($object->exists) { ... } # to delete an object $object->delete; # to create a new object which is publically-accessible with a # content-type of text/plain which expires on 2010-01-02 my $object = $bucket->object( key => 'this is the public key', acl_short => 'public-read', content_type => 'text/plain', expires => '2010-01-02', ); $object->put('this is the public value'); # return the URI of a publically-accessible object my $uri = $object->uri; # to store a new object with server-side encryption enabled my $object = $bucket->object( key => 'my secret', encryption => 'AES256', ); $object->put('this data will be stored using encryption.'); # upload a file my $object = $bucket->object( key => 'images/my_hat.jpg', content_type => 'image/jpeg', ); $object->put_filename('hat.jpg'); # upload a file if you already know its md5_hex and size my $object = $bucket->object( key => 'images/my_hat.jpg', content_type => 'image/jpeg', etag => $md5_hex, size => $size, ); $object->put_filename('hat.jpg'); # download the value of the object into a file my $object = $bucket->object( key => 'images/my_hat.jpg' ); $object->get_filename('hat_backup.jpg'); # use query string authentication my $object = $bucket->object( key => 'images/my_hat.jpg', expires => '2009-03-01', ); my $uri = $object->query_string_authentication_uri(); =head1 DESCRIPTION This module represents objects in buckets. =for test_synopsis no strict 'vars' =head1 METHODS =head2 etag # show the etag of an existing object (if fetched by listing # a bucket) print $object->etag . "\n"; =head2 delete # to delete an object $object->delete; =head2 exists # to see if an object exists if ($object->exists) { ... } =head2 get # to get the vaue of an object my $value = $object->get; =head2 get_decoded # get the value of an object, and decode any Content-Encoding and/or # charset; see decoded_content in HTTP::Response my $value = $object->get_decoded; =head2 get_filename # download the value of the object into a file my $object = $bucket->object( key => 'images/my_hat.jpg' ); $object->get_filename('hat_backup.jpg'); =head2 last_modified, last_modified_raw # get the last_modified data as DateTime (slow) my $dt = $obj->last_modified; # or raw string in form '2015-05-15T10:12:40.000Z' (fast) # use this form if you are working with thousands of objects and # do not actually need an expensive DateTime for each of them my $raw = $obj->last_modified_raw; =head2 key # show the key print $object->key . "\n"; =head2 put # to create a new object my $object = $bucket->object( key => 'this is the key' ); $object->put('this is the value'); # to create a new object which is publically-accessible with a # content-type of text/plain my $object = $bucket->object( key => 'this is the public key', acl_short => 'public-read', content_type => 'text/plain', ); $object->put('this is the public value'); You may also set Content-Encoding using C, and Content-Disposition using C. You may specify the S3 storage class by setting C to either C, C, C, or C; the default is C. You may set website-redirect-location object metadata by setting C to either another object name in the same bucket, or to an external URL. =head2 put_filename # upload a file my $object = $bucket->object( key => 'images/my_hat.jpg', content_type => 'image/jpeg', ); $object->put_filename('hat.jpg'); # upload a file if you already know its md5_hex and size my $object = $bucket->object( key => 'images/my_hat.jpg', content_type => 'image/jpeg', etag => $md5_hex, size => $size, ); $object->put_filename('hat.jpg'); You may also set Content-Encoding using C, and Content-Disposition using C. You may specify the S3 storage class by setting C to either C, C, C, or C; the default is C. You may set website-redirect-location object metadata by setting C to either another object name in the same bucket, or to an external URL. User metadata may be set by providing a non-empty hashref as C. =head2 query_string_authentication_uri # use query string authentication, forcing download with custom filename my $object = $bucket->object( key => 'images/my_hat.jpg', expires => '2009-03-01', ); my $uri = $object->query_string_authentication_uri({ 'response-content-disposition' => 'attachment; filename=abc.doc', }); =head2 size # show the size of an existing object (if fetched by listing # a bucket) print $object->size . "\n"; =head2 uri # return the URI of a publically-accessible object my $uri = $object->uri; =head2 initiate_multipart_upload #initiate a new multipart upload for this object my $object = $bucket->object( key => 'massive_video.avi' ); my $upload_id = $object->initiate_multipart_upload; =head2 put_part #add a part to a multipart upload my $put_part_response = $object->put_part( upload_id => $upload_id, part_number => 1, value => $chunk_content, ); my $part_etag = $put_part_response->header('ETag') Returns an L object. It is necessary to keep the ETags for each part, as these are required to complete the upload. =head2 complete_multipart_upload #complete a multipart upload $object->complete_multipart_upload( upload_id => $upload_id, etags => [$etag_1, $etag_2], part_numbers => [$part_number_1, $part_number2], ); The etag and part_numbers parameters are ordered lists specifying the part numbers and ETags for each individual part of the multipart upload. =head2 user_metadata my $object = $bucket->object(key => $key); my $content = $object->get; # or use $object->get_filename($filename) # return the user metadata downloaded, as a hashref my $user_metadata = $object->user_metadata; To upload an object with user metadata, set C at construction time to a hashref, with no C prefixes on the key names. When downloading an object, the C, C and C ethods set the contents of C to the same format. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Bucket.pm100755000765000024 2047213620607144 21064 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Clientpackage Net::Amazon::S3::Client::Bucket; $Net::Amazon::S3::Client::Bucket::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; use Data::Stream::Bulk::Callback; use MooseX::Types::DateTime::MoreCoercions 0.07 qw( DateTime ); # ABSTRACT: An easy-to-use Amazon S3 client bucket has 'client' => ( is => 'ro', isa => 'Net::Amazon::S3::Client', required => 1 ); has 'name' => ( is => 'ro', isa => 'Str', required => 1 ); has 'creation_date' => ( is => 'ro', isa => DateTime, coerce => 1, required => 0 ); has 'owner_id' => ( is => 'ro', isa => 'Str', required => 0 ); has 'owner_display_name' => ( is => 'ro', isa => 'Str', required => 0 ); has 'region' => ( is => 'ro', lazy => 1, predicate => 'has_region', default => sub { $_[0]->location_constraint }, ); __PACKAGE__->meta->make_immutable; sub _create { my ( $self, %conf ) = @_; my $http_request = Net::Amazon::S3::Request::CreateBucket->new( s3 => $self->client->s3, bucket => $self->name, acl_short => $conf{acl_short}, location_constraint => $conf{location_constraint}, )->http_request; $self->client->_send_request($http_request); } sub delete { my $self = shift; my $http_request = Net::Amazon::S3::Request::DeleteBucket->new( s3 => $self->client->s3, bucket => $self->name, )->http_request; $self->client->_send_request($http_request); } sub acl { my $self = shift; my $http_request = Net::Amazon::S3::Request::GetBucketAccessControl->new( s3 => $self->client->s3, bucket => $self->name, )->http_request; return $self->client->_send_request_content($http_request); } sub location_constraint { my $self = shift; my $http_request = Net::Amazon::S3::Request::GetBucketLocationConstraint->new( s3 => $self->client->s3, bucket => $self->name, )->http_request; my $xpc = $self->client->_send_request_xpc($http_request); my $lc = $xpc->findvalue('/s3:LocationConstraint'); if ( defined $lc && $lc eq '' ) { $lc = 'us-east-1'; } return $lc; } sub object_class { 'Net::Amazon::S3::Client::Object' } sub list { my ( $self, $conf ) = @_; $conf ||= {}; my $prefix = $conf->{prefix}; my $delimiter = $conf->{delimiter}; my $marker = undef; my $end = 0; return Data::Stream::Bulk::Callback->new( callback => sub { return undef if $end; my $http_request = Net::Amazon::S3::Request::ListBucket->new( s3 => $self->client->s3, bucket => $self->name, marker => $marker, prefix => $prefix, delimiter => $delimiter, )->http_request; my $xpc = $self->client->_send_request_xpc($http_request); my @objects; foreach my $node ( $xpc->findnodes('/s3:ListBucketResult/s3:Contents') ) { my $etag = $xpc->findvalue( "./s3:ETag", $node ); $etag =~ s/^"//; $etag =~ s/"$//; # storage_class => $xpc->findvalue( ".//s3:StorageClass", $node ), # owner_id => $xpc->findvalue( ".//s3:ID", $node ), # owner_displayname => # $xpc->findvalue( ".//s3:DisplayName", $node ), push @objects, $self->object_class->new( client => $self->client, bucket => $self, key => $xpc->findvalue( './s3:Key', $node ), last_modified_raw => $xpc->findvalue( './s3:LastModified', $node ), etag => $etag, size => $xpc->findvalue( './s3:Size', $node ), ); } return undef unless @objects; my $is_truncated = scalar $xpc->findvalue( '/s3:ListBucketResult/s3:IsTruncated') eq 'true' ? 1 : 0; $end = 1 unless $is_truncated; $marker = $xpc->findvalue('/s3:ListBucketResult/s3:NextMarker') || $objects[-1]->key; return \@objects; } ); } sub delete_multi_object { my $self = shift; my @objects = @_; return unless( scalar(@objects) ); # Since delete can handle up to 1000 requests, be a little bit nicer # and slice up requests and also allow keys to be strings # rather than only objects. my $last_result; while (scalar(@objects) > 0) { my $http_request = Net::Amazon::S3::Request::DeleteMultiObject->new( s3 => $self->client->s3, bucket => $self->name, keys => [map { if (ref($_)) { $_->key } else { $_ } } splice @objects, 0, ((scalar(@objects) > 1000) ? 1000 : scalar(@objects))] )->http_request; $last_result = $self->client->_send_request($http_request); if (!$last_result->is_success()) { last; } } return $last_result; } sub object { my ( $self, %conf ) = @_; return $self->object_class->new( client => $self->client, bucket => $self, %conf, ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Client::Bucket - An easy-to-use Amazon S3 client bucket =head1 VERSION version 0.89 =head1 SYNOPSIS # return the bucket name print $bucket->name . "\n"; # return the bucket location constraint print "Bucket is in the " . $bucket->location_constraint . "\n"; # return the ACL XML my $acl = $bucket->acl; # list objects in the bucket # this returns a L object which returns a # stream of L objects, as it may # have to issue multiple API requests my $stream = $bucket->list; until ( $stream->is_done ) { foreach my $object ( $stream->items ) { ... } } # or list by a prefix my $prefix_stream = $bucket->list( { prefix => 'logs/' } ); # returns a L, which can then # be used to get or put my $object = $bucket->object( key => 'this is the key' ); # delete the bucket (it must be empty) $bucket->delete; =head1 DESCRIPTION This module represents buckets. =for test_synopsis no strict 'vars' =head1 METHODS =head2 acl # return the ACL XML my $acl = $bucket->acl; =head2 delete # delete the bucket (it must be empty) $bucket->delete; =head2 list # list objects in the bucket # this returns a L object which returns a # stream of L objects, as it may # have to issue multiple API requests my $stream = $bucket->list; until ( $stream->is_done ) { foreach my $object ( $stream->items ) { ... } } # or list by a prefix my $prefix_stream = $bucket->list( { prefix => 'logs/' } ); # you can emulate folders by using prefix with delimiter # which shows only entries starting with the prefix but # not containing any more delimiter (thus no subfolders). my $folder_stream = $bucket->list( { prefix => 'logs/', delimiter => '/' } ); =head2 location_constraint # return the bucket location constraint print "Bucket is in the " . $bucket->location_constraint . "\n"; =head2 name # return the bucket name print $bucket->name . "\n"; =head2 object # returns a L, which can then # be used to get or put my $object = $bucket->object( key => 'this is the key' ); =head2 delete_multi_object # delete multiple objects using a multi object delete operation # Accepts a list of L objects. $bucket->delete_multi_object($object1, $object2) =head2 object_class # returns string "Net::Amazon::S3::Client::Object" # allowing subclasses to add behavior. my $object_class = $bucket->object_class; =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut query-string-authentication-uri.t100644000765000024 273013620607144 21752 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 2; use Test::Warnings; use Test::Deep; use Test::MockTime ( qw[ set_fixed_time ], ); use Hash::Util; use Shared::Examples::Net::Amazon::S3 ( qw[ s3_api_with_signature_4 ], qw[ s3_api_with_signature_2 ], qw[ expect_net_amazon_s3_feature ], ); set_fixed_time '2011-09-09T23:36:00Z'; expect_net_amazon_s3_feature "Signature V4 query_string_authentication_uri" => ( feature => 'signed_uri', with_s3 => s3_api_with_signature_4, with_bucket => 'some-bucket', with_key => 'some/key', with_expire_at => time + 123_000, with_region => 'eu-west-1', expect_uri => 'https://some-bucket.s3-eu-west-1.amazonaws.com/some/key?X-Amz-Algorithm=AWS4-HMAC-SHA256&X-Amz-Credential=AKIDEXAMPLE%2F20110909%2Feu-west-1%2Fs3%2Faws4_request&X-Amz-Date=20110909T233600Z&X-Amz-Expires=123000&X-Amz-SignedHeaders=host&X-Amz-Signature=93da6eea1ab776752fbde0d235f04e1513207a88a3cf1ff45fe4ad05505e45a1', ); expect_net_amazon_s3_feature "Signature V2 query_string_authentication_uri" => ( feature => 'signed_uri', with_s3 => s3_api_with_signature_2, with_bucket => 'some-bucket', with_key => 'some/key', with_expire_at => time + 123_000, with_region => 'eu-west-1', expect_uri => 'https://some-bucket.s3.amazonaws.com/some/key?AWSAccessKeyId=AKIDEXAMPLE&Expires=1315734360&Signature=YtOFhJwsOcNKz5xW7dF6TlrqZT0%3D', ); Request000755000765000024 013620607144 17333 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3Object.pm100644000765000024 174413620607144 21245 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::Object; # ABSTRACT: Base class for all S3 Object operations $Net::Amazon::S3::Request::Object::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Bucket'; has key => ( is => 'ro', isa => 'Str', required => 1, ); override _request_path => sub { my ($self) = @_; return super . (join '/', map {$self->s3->_urlencode($_)} split /\//, $self->key); }; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Object - Base class for all S3 Object operations =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Bucket.pm100644000765000024 163713620607144 21255 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::Bucket; # ABSTRACT: Base class for all S3 Bucket operations $Net::Amazon::S3::Request::Bucket::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Service'; with 'Net::Amazon::S3::Role::Bucket'; override _request_path => sub { my ($self) = @_; return super . $self->bucket->bucket . "/"; }; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Bucket - Base class for all S3 Bucket operations =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut signature-v4-with-security-token.t100644000765000024 146013620607144 21752 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 2; use Test::Deep; use Test::Warnings qw[ :no_end_test had_no_warnings ]; use Shared::Examples::Net::Amazon::S3::API ( qw[ expect_api_bucket_create ], ); use Shared::Examples::Net::Amazon::S3 ( qw[ s3_api_with_signature_4 ], ); expect_api_bucket_create 'create bucket using Signature 4 and session token' => ( with_s3 => s3_api_with_signature_4 (aws_session_token => 'security-token'), with_bucket => 'some-bucket', with_region => 'us-east-1', expect_request => { PUT => 'https://some-bucket.s3.amazonaws.com/' }, expect_request_content => '', expect_request_headers => { 'x-amz-security-token' => 'security-token' }, expect_data => ignore, ); had_no_warnings; Service.pm100644000765000024 141213620607144 21427 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::Service; # ABSTRACT: Base class for all S3 Service operations $Net::Amazon::S3::Request::Service::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request'; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Service - Base class for all S3 Service operations =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut PutPart.pm100755000765000024 400313620607144 21430 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::PutPart; $Net::Amazon::S3::Request::PutPart::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Object'; with 'Net::Amazon::S3::Request::Role::Query::Param::Upload_id'; with 'Net::Amazon::S3::Request::Role::Query::Param::Part_number'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Copy_source'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::PUT'; has 'value' => ( is => 'ro', isa => 'Str|CodeRef|ScalarRef', required => 0 ); has 'headers' => ( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } ); __PACKAGE__->meta->make_immutable; sub _request_headers { my ($self) = @_; return %{ $self->headers }; } sub http_request { my $self = shift; return $self->_build_http_request( content => scalar( defined( $self->value ) ? $self->value : '' ), ); } 1; =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::PutPart - An internal class to put part of a multipart upload =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::PutPart->new( s3 => $s3, bucket => $bucket, key => $key, value => $value, acl_short => $acl_short, headers => $conf, part_number => $part_number, upload_id => $upload_id )->http_request; =head1 DESCRIPTION This module puts an object. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ # ABSTRACT: An internal class to put part of a multipart upload Amazon000755000765000024 013620607144 20402 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/NetS3.pm100644000765000024 3002313620607144 21403 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazonpackage Shared::Examples::Net::Amazon::S3; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; use Hash::Util; use Ref::Util ( qw[ is_regexpref ], ); use Test::Deep; use Test::More; use Net::Amazon::S3; use Shared::Examples::Net::Amazon::S3::API; use Shared::Examples::Net::Amazon::S3::Client; use Shared::Examples::Net::Amazon::S3::Request; our @EXPORT_OK = ( qw[ s3_api_with_signature_4 ], qw[ s3_api_with_signature_2 ], qw[ expect_net_amazon_s3_feature ], qw[ expect_net_amazon_s3_operation ], qw[ expect_operation_list_all_my_buckets ], qw[ expect_operation_bucket_create ], qw[ expect_operation_bucket_delete ], ); sub s3_api_with_signature_4 { Net::Amazon::S3->new ( @_, aws_access_key_id => 'AKIDEXAMPLE', aws_secret_access_key => 'wJalrXUtnFEMI/K7MDENG+bPxRfiCYEXAMPLEKEY', authorization_method => 'Net::Amazon::S3::Signature::V4', secure => 1, use_virtual_host => 1, ); } sub s3_api_with_signature_2 { Net::Amazon::S3->new ( @_, aws_access_key_id => 'AKIDEXAMPLE', aws_secret_access_key => 'wJalrXUtnFEMI/K7MDENG+bPxRfiCYEXAMPLEKEY', authorization_method => 'Net::Amazon::S3::Signature::V2', secure => 1, use_virtual_host => 1, ); } sub expect_net_amazon_s3_feature { my ($title, %params) = @_; my $s3 = delete $params{with_s3}; my $feature = delete $params{feature}; my $expectation = "expect_$feature"; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $title => sub { plan tests => 2; if (my $code = Shared::Examples::Net::Amazon::S3::API->can ($expectation)) { $code->( "using S3 API" => ( with_s3 => $s3, %params )); } else { fail "Net::Amazon::S3 feature expectation $expectation not found"; } if (my $code = Shared::Examples::Net::Amazon::S3::Client->can ($expectation)) { $code->( "using S3 Client" => ( with_client => Net::Amazon::S3::Client->new (s3 => $s3), %params )); } else { fail "Net::Amazon::S3::Client feature expectation $expectation not found"; } }; } sub _keys_operation { return ( qw[ -shared_examples ], qw[ with_s3 ], qw[ with_client ], qw[ shared_examples ], qw[ with_response_code ], qw[ with_response_data ], qw[ with_response_headers ], qw[ expect_s3_err ], qw[ expect_s3_errstr ], qw[ expect_data ], qw[ expect_request ], qw[ expect_request_content ], qw[ expect_request_headers ], qw[ throws ], ); } sub _expect_request { my ($request, $expect, $title) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; my ($method, $uri) = %$expect; cmp_deeply $request, all ( methods (method => $method), methods (uri => methods (as_string => $uri)), ), $title || 'expect request' ; } sub _expect_request_content { my ($request, $expected, $title) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; my $got = Shared::Examples::Net::Amazon::S3::Request::_canonical_xml ($request->content); $expected = Shared::Examples::Net::Amazon::S3::Request::_canonical_xml ($expected); cmp_deeply $got, $expected, $title || "expect request content"; } sub _expect_request_headers { my ($request, $expected, $title) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; my %got = map +($_ => scalar $request->header ($_)), keys %$expected; cmp_deeply \ %got, $expected, $title || "expect request headers" ; } sub _expect_s3_err { my ($got, $expected, $title) = @_; SKIP: { skip "Net::Amazon::S3->err test irrelevant for Client", 1 if eq_deeply $got, obj_isa ('Net::Amazon::S3::Client'); cmp_deeply $got, methods (err => $expected), $title || 'expect S3->err'; } } sub _expect_s3_errstr { my ($got, $expected, $title) = @_; SKIP: { skip "Net::Amazon::S3->errstr test irrelevant for Client", 1 if eq_deeply $got, obj_isa ('Net::Amazon::S3::Client'); cmp_deeply $got, methods (errstr => $expected), $title || 'expect S3->errstr'; } } sub _expect_operation { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; my $class = delete $params{-shared_examples}; my $operation = delete $params{-operation}; my $api = $class->_default_with_api (\%params); my $guard = $class->_mock_http_response (%params, into => \ (my $request)); if (my $code = $class->can ($operation)) { subtest $title => sub { plan tests => 1 + int (!! exists $params{expect_request}) + int (!! exists $params{expect_request_content}) + int (!! exists $params{expect_request_headers}) + int (!! exists $params{expect_s3_err}) + int (!! exists $params{expect_s3_errstr}) ; my $got; my $lives = eval { $got = $api->$code (%params); 1 }; my $error = $@; if ($lives) { exists $params{throws} ? fail "operation expected to throw but lives" : cmp_deeply $got, $params{expect_data}, "expect operation return data" ; } else { $params{throws} = re $params{throws} if is_regexpref $params{throws}; $params{throws} = obj_isa $params{throws} if defined $params{throws} && ! ref $params{throws}; defined $params{throws} ? cmp_deeply $error, $params{throws}, "it should throw" : do { fail "operation expected to live but died" ; diag $error } ; } _expect_request $request, $params{expect_request} if exists $params{expect_request}; _expect_request_content $request, $params{expect_request_content} if exists $params{expect_request_content}; _expect_request_headers ($request, $params{expect_request_headers}) if exists $params{expect_request_headers}; _expect_s3_err $api, $params{expect_s3_err} if exists $params{expect_s3_err}; _expect_s3_errstr $api, $params{expect_s3_errstr} if exists $params{expect_s3_errstr}; }; } else { fail $title or diag "Operation ${class}::$operation not found"; } } sub expect_operation_list_all_my_buckets { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_list_all_my_buckets'; } sub expect_operation_bucket_acl_get { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_bucket_acl_get'; } sub expect_operation_bucket_acl_set { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_acl_xml ], qw[ with_acl_short ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_bucket_acl_set'; } sub expect_operation_bucket_create { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_acl ], qw[ with_region ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_bucket_create'; } sub expect_operation_bucket_delete { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_bucket_delete'; } sub expect_operation_bucket_objects_list { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_delimiter ], qw[ with_max_keys ], qw[ with_marker ], qw[ with_prefix ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_bucket_objects_list'; } sub expect_operation_bucket_objects_delete { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_keys ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_bucket_objects_delete'; } sub expect_operation_object_acl_get { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_key ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_object_acl_get'; } sub expect_operation_object_acl_set { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_key ], qw[ with_acl_xml ], qw[ with_acl_short ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_object_acl_set'; } sub expect_operation_object_create { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_headers ], qw[ with_key ], qw[ with_value ], qw[ with_cache_control ], qw[ with_content_disposition ], qw[ with_content_encoding ], qw[ with_content_type ], qw[ with_encryption ], qw[ with_expires ], qw[ with_storage_class ], qw[ with_user_metadata ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_object_create'; } sub expect_operation_object_delete { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_key ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_object_delete'; } sub expect_operation_object_fetch { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_key ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_object_fetch'; } sub expect_operation_object_head { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_bucket ], qw[ with_key ], _keys_operation, ; _expect_operation $title, %params, -operation => 'operation_object_head'; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3 - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut request-complete-multipart-upload.t100644000765000024 435713620607144 22275 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 3; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'abort multipart upload with empty parts' => ( request_class => 'Net::Amazon::S3::Request::CompleteMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/key', with_upload_id => '123&456', with_etags => [ ], with_part_numbers => [ ], expect_request_method => 'POST', expect_request_path => 'some-bucket/some/key?uploadId=123%26456', expect_request_headers => { 'Content-MD5' => ignore, 'Content-Length' => ignore, 'Content-Type' => 'application/xml', }, expect_request_content => <<'EOXML', EOXML ); behaves_like_net_amazon_s3_request 'abort multipart upload with some parts' => ( request_class => 'Net::Amazon::S3::Request::CompleteMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/key', with_upload_id => '123&456', with_etags => [ 'etag01', 'etag02' ], with_part_numbers => [ 1, 2 ], expect_request_method => 'POST', expect_request_path => 'some-bucket/some/key?uploadId=123%26456', expect_request_headers => { 'Content-MD5' => ignore, 'Content-Length' => ignore, 'Content-Type' => 'application/xml', }, expect_request_content => <<'EOXML', 1 etag01 2 etag02 EOXML ); behaves_like_net_amazon_s3_request 'abort multipart upload with uneven argument arrays' => ( request_class => 'Net::Amazon::S3::Request::CompleteMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/ %/key', with_upload_id => '123&456', with_etags => [ 'etag01', 'etag02' ], with_part_numbers => [ 1, 2, 3 ], throws => re( qr/must have an equally sized list of etags and part numbers/ ), ); request-get-object-access-control.t100644000765000024 107013620607144 22111 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'get object access control' => ( request_class => 'Net::Amazon::S3::Request::GetObjectAccessControl', with_bucket => 'some-bucket', with_key => 'some/key', expect_request_method => 'GET', expect_request_path => 'some-bucket/some/key?acl', expect_request_headers => { }, expect_request_content => '', ); request-get-bucket-access-control.t100644000765000024 101513620607144 22117 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'get bucket access control' => ( request_class => 'Net::Amazon::S3::Request::GetBucketAccessControl', with_bucket => 'some-bucket', expect_request_method => 'GET', expect_request_path => 'some-bucket/?acl', expect_request_headers => { }, expect_request_content => '', ); request-initiate-multipart-upload.t100644000765000024 374113620607144 22267 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 5; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'initiate multipart upload' => ( request_class => 'Net::Amazon::S3::Request::InitiateMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/key', expect_request_method => 'POST', expect_request_path => 'some-bucket/some/key?uploads', expect_request_headers => { }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'initiate multipart upload with acl' => ( request_class => 'Net::Amazon::S3::Request::InitiateMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/key', with_acl_short => 'private', expect_request_method => 'POST', expect_request_path => 'some-bucket/some/key?uploads', expect_request_headers => { 'x-amz-acl' => 'private' }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'initiate multipart upload with service side encryption' => ( request_class => 'Net::Amazon::S3::Request::InitiateMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/key', with_encryption => 'AES256', expect_request_method => 'POST', expect_request_path => 'some-bucket/some/key?uploads', expect_request_headers => { 'x-amz-server-side-encryption' => 'AES256' }, expect_request_content => '', ); behaves_like_net_amazon_s3_request 'initiate multipart upload with headers' => ( request_class => 'Net::Amazon::S3::Request::InitiateMultipartUpload', with_bucket => 'some-bucket', with_key => 'some/key', with_headers => { 'x-amz-meta-test' => 99 }, expect_request_method => 'POST', expect_request_path => 'some-bucket/some/key?uploads', expect_request_headers => { 'x-amz-meta-test' => 99 }, expect_request_content => '', ); request-set-object-access-control.t100644000765000024 332313620607144 22130 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'set object access control with header acl' => ( request_class => 'Net::Amazon::S3::Request::SetObjectAccessControl', with_bucket => 'some-bucket', with_key => 'some/key', with_acl_short => 'private', expect_request_method => 'PUT', expect_request_path => 'some-bucket/some/key?acl', expect_request_headers => { 'x-amz-acl' => 'private' }, ); behaves_like_net_amazon_s3_request 'set object access control with body acl' => ( request_class => 'Net::Amazon::S3::Request::SetObjectAccessControl', with_bucket => 'some-bucket', with_key => 'some/key', with_acl_xml => 'private', expect_request_method => 'PUT', expect_request_path => 'some-bucket/some/key?acl', expect_request_headers => { }, ); behaves_like_net_amazon_s3_request 'set object access control without body or header acl' => ( request_class => 'Net::Amazon::S3::Request::SetObjectAccessControl', with_bucket => 'some-bucket', with_key => 'some/key', throws => re( qr/need either acl_xml or acl_short/ ), ); behaves_like_net_amazon_s3_request 'set object access control with both body and header acl specified' => ( request_class => 'Net::Amazon::S3::Request::SetObjectAccessControl', with_bucket => 'some-bucket', with_key => 'some/key', with_acl_short => 'private', with_acl_xml => 'private', throws => re( qr/can not provide both acl_xml and acl_short/ ), ); request-set-bucket-access-control.t100644000765000024 306713620607144 22144 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 4; use Test::Deep; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'set bucket access control with header acl' => ( request_class => 'Net::Amazon::S3::Request::SetBucketAccessControl', with_bucket => 'some-bucket', with_acl_short => 'private', expect_request_method => 'PUT', expect_request_path => 'some-bucket/?acl', expect_request_headers => { 'x-amz-acl' => 'private' }, ); behaves_like_net_amazon_s3_request 'set bucket access control with body acl' => ( request_class => 'Net::Amazon::S3::Request::SetBucketAccessControl', with_bucket => 'some-bucket', with_acl_xml => 'private', expect_request_method => 'PUT', expect_request_path => 'some-bucket/?acl', expect_request_headers => { }, ); behaves_like_net_amazon_s3_request 'set bucket access control without body or header acl' => ( request_class => 'Net::Amazon::S3::Request::SetBucketAccessControl', with_bucket => 'some-bucket', throws => re( qr/need either acl_xml or acl_short/ ), ); behaves_like_net_amazon_s3_request 'set bucket access control with both body and header acl specified' => ( request_class => 'Net::Amazon::S3::Request::SetBucketAccessControl', with_bucket => 'some-bucket', with_acl_short => 'private', with_acl_xml => 'private', throws => re( qr/can not provide both acl_xml and acl_short/ ), ); PutObject.pm100644000765000024 335513620607144 21736 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::PutObject; $Net::Amazon::S3::Request::PutObject::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Object'; # ABSTRACT: An internal class to put an object with 'Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Encryption'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::PUT'; has 'value' => ( is => 'ro', isa => 'Str|CodeRef|ScalarRef', required => 1 ); has 'headers' => ( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } ); __PACKAGE__->meta->make_immutable; sub _request_headers { my ($self) = @_; return %{ $self->headers }; } sub http_request { my $self = shift; return $self->_build_http_request( content => $self->value, ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::PutObject - An internal class to put an object =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::PutObject->new( s3 => $s3, bucket => $bucket, key => $key, value => $value, acl_short => $acl_short, headers => $conf, )->http_request; =head1 DESCRIPTION This module puts an object. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GetObject.pm100644000765000024 307413620607144 21703 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::GetObject; $Net::Amazon::S3::Request::GetObject::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Object'; with 'Net::Amazon::S3::Request::Role::HTTP::Method'; # ABSTRACT: An internal class to get an object __PACKAGE__->meta->make_immutable; sub query_string_authentication_uri { my ( $self, $expires, $query_form ) = @_; my $uri = URI->new( $self->_request_path ); $uri->query_form( %$query_form ) if $query_form; return $self->_build_signed_request( path => $uri->as_string, )->query_string_authentication_uri($expires); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::GetObject - An internal class to get an object =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::GetObject->new( s3 => $s3, bucket => $bucket, key => $key, method => 'GET', )->http_request; =head1 DESCRIPTION This module gets an object. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head2 query_string_authentication_uri This method returns query string authentication URI. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ListParts.pm100755000765000024 217413620607144 21765 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::ListParts; $Net::Amazon::S3::Request::ListParts::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Object'; # ABSTRACT: List the parts in a multipart upload. with 'Net::Amazon::S3::Request::Role::Query::Param::Upload_id'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::GET'; has 'headers' => ( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } ); __PACKAGE__->meta->make_immutable; sub _request_headers { my ($self) = @_; return %{ $self->headers }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::ListParts - List the parts in a multipart upload. =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ListBucket.pm100644000765000024 277113620607144 22111 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::ListBucket; $Net::Amazon::S3::Request::ListBucket::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; use URI::Escape qw(uri_escape_utf8); extends 'Net::Amazon::S3::Request::Bucket'; # ABSTRACT: An internal class to list a bucket with 'Net::Amazon::S3::Request::Role::Query::Param::Delimiter'; with 'Net::Amazon::S3::Request::Role::Query::Param::Marker'; with 'Net::Amazon::S3::Request::Role::Query::Param::Max_keys'; with 'Net::Amazon::S3::Request::Role::Query::Param::Prefix'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::GET'; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::ListBucket - An internal class to list a bucket =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::ListBucket->new( s3 => $s3, bucket => $bucket, delimiter => $delimiter, max_keys => $max_keys, marker => $marker, )->http_request; =head1 DESCRIPTION This module lists a bucket. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut S3000755000765000024 013620607144 20667 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/AmazonACL.pm100644000765000024 251613620607144 21770 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3package Shared::Examples::Net::Amazon::S3::ACL; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::ACL::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; our @EXPORT_OK = ( qw[ acl_xml ], ); sub acl_xml { <<'XML'; 75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a CustomersName@amazon.com 75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a CustomersName@amazon.com FULL_CONTROL XML } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::ACL - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut API.pm100644000765000024 1511413620607144 22020 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3package Shared::Examples::Net::Amazon::S3::API; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::API::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; use Hash::Util; use Test::Deep; use Test::More; use Net::Amazon::S3; use Shared::Examples::Net::Amazon::S3; our @EXPORT_OK = ( qw[ expect_signed_uri ], qw[ expect_api_list_all_my_buckets ], qw[ expect_api_bucket_acl_get ], qw[ expect_api_bucket_acl_set ], qw[ expect_api_bucket_create ], qw[ expect_api_bucket_delete ], qw[ expect_api_bucket_objects_list ], qw[ expect_api_bucket_objects_delete ], qw[ expect_api_object_acl_get ], qw[ expect_api_object_acl_set ], qw[ expect_api_object_create ], qw[ expect_api_object_delete ], qw[ expect_api_object_fetch ], qw[ expect_api_object_head ], ); sub _exporter_expand_sub { my ($self, $name, $args, $globals) = @_; my $s3_operation = $name; $s3_operation =~ s/_api_/_operation_/; return +( $name => eval <<"GEN_SUB" ); sub { push \@_, -shared_examples => __PACKAGE__; goto \\& Shared::Examples::Net::Amazon::S3::$s3_operation; } GEN_SUB } sub _default_with_api { my ($self, $params) = @_; $params->{with_s3} ||= Shared::Examples::Net::Amazon::S3::s3_api_with_signature_2 (); } sub _mock_http_response { my (undef, %params) = @_; $params{with_response_code} ||= HTTP::Status::HTTP_OK; my %headers = ( content_type => 'application/xml', %{ $params{with_response_headers} || {} }, ); my $guard = Sub::Override->new; $guard->replace ( 'Net::Amazon::S3::_do_http' => sub { ${ $params{into} } = $_[1]; HTTP::Response->new ( $params{with_response_code}, HTTP::Status::status_message ($params{with_response_code}), [ %headers ], $params{with_response_data}, ), } ); $guard; } sub expect_signed_uri { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; Hash::Util::lock_keys %params, qw[ with_s3 ], qw[ with_bucket ], qw[ with_region ], qw[ with_key ], qw[ with_expire_at ], qw[ expect_uri ], ; my $got = Net::Amazon::S3::Bucket ->new ({ account => $params{with_s3}, bucket => $params{with_bucket}, region => $params{with_region}, }) ->query_string_authentication_uri ( $params{with_key}, $params{with_expire_at} ); cmp_deeply $got, $params{expect_uri}, $title; } sub operation_list_all_my_buckets { my ($self, %params) = @_; $self->buckets; } sub operation_bucket_acl_get { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->get_acl ; } sub operation_bucket_acl_set { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->set_acl ({ (acl_short => $params{with_acl_short}) x!! exists $params{with_acl_short}, (acl_xml => $params{with_acl_xml}) x!! exists $params{with_acl_xml}, }) ; } sub operation_bucket_create { my ($self, %params) = @_; $self ->add_bucket ({ bucket => $params{with_bucket}, (acl_short => $params{with_acl}) x!! exists $params{with_acl}, (location_constraint => $params{with_region}) x!! exists $params{with_region}, (region => $params{with_region}) x!! exists $params{with_region}, }) ; } sub operation_bucket_delete { my ($self, %params) = @_; $self ->delete_bucket ({ bucket => $params{with_bucket}, }) ; } sub operation_bucket_objects_list { my ($self, %params) = @_; $self ->list_bucket ({ bucket => $params{with_bucket}, delimiter => $params{with_delimiter}, max_keys => $params{with_max_keys}, marker => $params{with_marker}, prefix => $params{with_prefix}, }) ; } sub operation_bucket_objects_delete { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->delete_multi_object (@{ $params{with_keys} }) ; } sub operation_object_acl_get { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->get_acl ($params{with_key}) ; } sub operation_object_acl_set { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->set_acl ({ key => $params{with_key}, (acl_short => $params{with_acl_short}) x!! exists $params{with_acl_short}, (acl_xml => $params{with_acl_xml}) x!! exists $params{with_acl_xml}, }) ; } sub operation_object_create { my ($self, %params) = @_; my $headers = { %{ $params{with_headers} || {} } }; $headers->{$_} = $params{"with_$_"} for grep exists $params{"with_$_"}, qw[ cache_control ], qw[ content_disposition ], qw[ content_encoding ], qw[ content_type ], qw[ encryption ], qw[ expires ], ; $headers->{x_amz_storage_class} = $params{with_storage_class} if $params{with_storage_class}; $headers->{"x_amz_meta_\L$_"} = $params{with_user_metadata}{$_} for keys %{ $params{with_user_metadata} || {} }; $self ->bucket ($params{with_bucket}) ->add_key ( $params{with_key}, $params{with_value}, $headers, ) ; } sub operation_object_delete { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->delete_key ($params{with_key}) ; } sub operation_object_fetch { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->get_key ($params{with_key}, 'GET') ; } sub operation_object_head { my ($self, %params) = @_; $self ->bucket ($params{with_bucket}) ->head_key ($params{with_key}) ; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::API - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DeleteBucket.pm100644000765000024 215713620607144 22376 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::DeleteBucket; $Net::Amazon::S3::Request::DeleteBucket::VERSION = '0.89'; use Moose 0.85; extends 'Net::Amazon::S3::Request::Bucket'; # ABSTRACT: An internal class to delete a bucket with 'Net::Amazon::S3::Request::Role::HTTP::Method::DELETE'; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::DeleteBucket - An internal class to delete a bucket =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::DeleteBucket->new( s3 => $s3, bucket => $bucket, )->http_request; =head1 DESCRIPTION This module deletes a bucket. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DeleteObject.pm100644000765000024 225013620607144 22361 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::DeleteObject; $Net::Amazon::S3::Request::DeleteObject::VERSION = '0.89'; use Moose 0.85; use Moose::Util::TypeConstraints; extends 'Net::Amazon::S3::Request::Object'; # ABSTRACT: An internal class to delete an object with 'Net::Amazon::S3::Request::Role::HTTP::Method::DELETE'; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::DeleteObject - An internal class to delete an object =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::DeleteObject->new( s3 => $s3, bucket => $bucket, key => $key, )->http_request; =head1 DESCRIPTION This module deletes an object. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CreateBucket.pm100644000765000024 356713620607144 22405 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::CreateBucket; $Net::Amazon::S3::Request::CreateBucket::VERSION = '0.89'; use Moose 0.85; extends 'Net::Amazon::S3::Request::Bucket'; # ABSTRACT: An internal class to create a bucket with 'Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::PUT'; has 'location_constraint' => ( is => 'ro', isa => 'MaybeLocationConstraint', coerce => 1, required => 0 ); __PACKAGE__->meta->make_immutable; sub _request_content { my ($self) = @_; my $content = ''; if ( defined $self->location_constraint && $self->location_constraint ne 'us-east-1') { $content = "" . $self->location_constraint . ""; } } sub http_request { my $self = shift; return $self->_build_http_request( region => 'us-east-1', ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::CreateBucket - An internal class to create a bucket =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::CreateBucket->new( s3 => $s3, bucket => $bucket, acl_short => $acl_short, location_constraint => $location_constraint, )->http_request; =head1 DESCRIPTION This module creates a bucket. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut request-get-bucket-location-constraint.t100644000765000024 103413620607144 23173 0ustar00leostaff000000000000Net-Amazon-S3-0.89/t use strict; use warnings; use Test::More tests => 1 + 1; use Test::Warnings; use Shared::Examples::Net::Amazon::S3::Request ( qw[ behaves_like_net_amazon_s3_request ], ); behaves_like_net_amazon_s3_request 'get bucket location constraint' => ( request_class => 'Net::Amazon::S3::Request::GetBucketLocationConstraint', with_bucket => 'some-bucket', expect_request_method => 'GET', expect_request_path => 'some-bucket/?location', expect_request_headers => { }, expect_request_content => '', ); Error.pm100644000765000024 412113620607144 22454 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3package Shared::Examples::Net::Amazon::S3::Error; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::Error::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; use HTTP::Status; our @EXPORT_OK = ( qw[ fixture_error_access_denied ], qw[ fixture_error_bucket_already_exists ], qw[ fixture_error_bucket_not_empty ], qw[ fixture_error_invalid_bucket_name ], qw[ fixture_error_no_such_bucket ], qw[ fixture_error_no_such_key ], ); sub _error_fixture { my ($error_code, $http_status) = @_; my $error_message = $error_code; $error_message =~ s/ (?<=[[:lower:]]) ([[:upper:]])/ \L$1\E/gx; +( with_response_code => $http_status, with_response_data => <<"XML", $error_code $error_message error message /some-resource 4442587FB7D0A2F9 XML ); } sub fixture_error_access_denied { _error_fixture AccessDenied => HTTP::Status::HTTP_FORBIDDEN; } sub fixture_error_bucket_already_exists { _error_fixture BucketAlreadyExists => HTTP::Status::HTTP_CONFLICT; } sub fixture_error_bucket_not_empty { _error_fixture BucketNotEmpty => HTTP::Status::HTTP_CONFLICT; } sub fixture_error_invalid_bucket_name { _error_fixture InvalidBucketName => HTTP::Status::HTTP_BAD_REQUEST; } sub fixture_error_no_such_bucket { _error_fixture NoSuchBucket => HTTP::Status::HTTP_NOT_FOUND; } sub fixture_error_no_such_key { _error_fixture NoSuchKey => HTTP::Status::HTTP_NOT_FOUND; } __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::Error - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Client.pm100644000765000024 1312413620607144 22624 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3package Shared::Examples::Net::Amazon::S3::Client; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::Client::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; use Hash::Util; use HTTP::Response; use HTTP::Status; use Sub::Override; use Test::Deep; use Test::More; use Net::Amazon::S3::Client; use Shared::Examples::Net::Amazon::S3; our @EXPORT_OK = ( qw[ expect_signed_uri ], qw[ expect_client_list_all_my_buckets ], qw[ expect_client_bucket_acl_get ], qw[ expect_client_bucket_create ], qw[ expect_client_bucket_delete ], qw[ expect_client_bucket_objects_list ], qw[ expect_client_bucket_objects_delete ], qw[ expect_client_object_create ], qw[ expect_client_object_delete ], qw[ expect_client_object_fetch ], ); sub _exporter_expand_sub { my ($self, $name, $args, $globals) = @_; my $s3_operation = $name; $s3_operation =~ s/_client_/_operation_/; return +( $name => eval <<"GEN_SUB" ); sub { push \@_, -shared_examples => __PACKAGE__; goto \\& Shared::Examples::Net::Amazon::S3::$s3_operation; } GEN_SUB } sub _default_with_api { my ($self, $params) = @_; $params->{with_client} ||= Net::Amazon::S3::Client->new ( s3 => Shared::Examples::Net::Amazon::S3::s3_api_with_signature_2 () ); } sub _mock_http_response { my ($self, %params) = @_; $params{with_response_code} ||= HTTP::Status::HTTP_OK; my %headers = ( content_type => 'application/xml', %{ $params{with_response_headers} || {} }, ); my $guard = Sub::Override->new; $guard->replace ( 'Net::Amazon::S3::Client::_send_request_raw' => sub { ${ $params{into} } = $_[1]; HTTP::Response->new ( $params{with_response_code}, HTTP::Status::status_message ($params{with_response_code}), [ %headers ], $params{with_response_data}, ), } ); $guard; } sub expect_signed_uri { my ($title, %params) = @_; Hash::Util::lock_keys %params, qw[ with_client ], qw[ with_bucket ], qw[ with_region ], qw[ with_key ], qw[ with_expire_at ], qw[ expect_uri ], ; my $guard = Sub::Override->new ( 'Net::Amazon::S3::Bucket::region' => sub { $params{with_region } }, ); my $got = $params{with_client} ->bucket ( name => $params{with_bucket}, ) ->object ( key => $params{with_key}, expires => $params{with_expire_at}, ) ->query_string_authentication_uri ; cmp_deeply $got, $params{expect_uri}, $title; } sub operation_list_all_my_buckets { my ($self, %params) = @_; [ $_[0]->buckets ]; } sub operation_bucket_acl_get { my ($self, %params) = @_; $self ->bucket (name => $params{with_bucket}) ->acl ; } sub operation_bucket_create { my ($self, %params) = @_; $self->create_bucket( name => $params{with_bucket}, (acl_short => $params{with_acl}) x!! exists $params{with_acl}, (location_constraint => $params{with_region}) x!! exists $params{with_region}, ); } sub operation_bucket_delete { my ($self, %params) = @_; $self ->bucket (name => $params{with_bucket}) ->delete ; } sub operation_bucket_objects_list { my ($self, %params) = @_; $self ->bucket (name => $params{with_bucket}) ->list ({ bucket => $params{with_bucket}, delimiter => $params{with_delimiter}, max_keys => $params{with_max_keys}, marker => $params{with_marker}, prefix => $params{with_prefix}, }) ; } sub operation_bucket_objects_delete { my ($self, %params) = @_; $self ->bucket (name => $params{with_bucket}) ->delete_multi_object (@{ $params{with_keys} }) ; } sub operation_object_create { my ($self, %params) = @_; $self ->bucket (name => $params{with_bucket}) ->object ( key => $params{with_key}, map +($_ => $params{"with_$_"}), grep exists $params{"with_$_"}, ( qw[ cache_control ], qw[ content_disposition ], qw[ content_encoding ], qw[ content_type ], qw[ encryption ], qw[ expires ], qw[ storage_class ], qw[ user_metadata ], ) ) ->${\ (ref $params{with_value} ? 'put_filename' : 'put' ) } ( ref $params{with_value} ? ${ $params{with_value} } : $params{with_value} ) ; } sub operation_object_delete { my ($self, %params) = @_; $self ->bucket (name => $params{with_bucket}) ->object (key => $params{with_key}) ->delete ; } sub operation_object_fetch { my ($self, %params) = @_; $self ->bucket (name => $params{with_bucket}) ->object (key => $params{with_key}) ->get ; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::Client - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Request.pm100644000765000024 1175313620607144 23044 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3package Shared::Examples::Net::Amazon::S3::Request; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::Request::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; use Test::More; use Test::Deep; use Moose qw[]; use Moose::Object; use Moose::Util; use XML::LibXML; use Net::Amazon::S3; use Net::Amazon::S3::Bucket; our @EXPORT_OK = ( qw[ behaves_like_net_amazon_s3_request ], qw[ expect_request_class ], qw[ expect_request_instance ], ); sub _canonical_xml { my ($xml) = @_; return $xml unless $xml; return $xml if ref $xml; my $canonical = eval { XML::LibXML->load_xml ( string => $xml, no_blanks => 1, )->toStringC14N }; return $xml unless defined $canonical; return $canonical; } sub _test_meta_build_http_request { my ($self, %params) = @_; return $self->_build_signed_request (%params); } sub _test_class { my ($request_class, %params) = @_; $params{superclasses} ||= []; $params{methods}{_build_http_request} = \& _test_meta_build_http_request; push @{ $params{superclasses} }, $request_class; return Moose::Meta::Class->create_anon_class (%params); } sub expect_request_class { my ($request_class) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; return use_ok $request_class; } sub expect_request_instance { my (%params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; my %with = map +( substr ($_, 5) => delete $params{$_} ), grep m/^with_/, keys %params ; $with{s3} = bless {}, 'Net::Amazon::S3'; my $test_class = _test_class $params{request_class}, map +( $_ => $params{$_} ), grep exists $params{$_}, qw [ roles ], ; my $request = eval { $test_class->name->new (%with) }; my $error = $@; if (exists $params{throws}) { if (defined $request) { fail "create instance should fail"; } else { cmp_deeply $error, $params{throws}, "create instance should fail"; } } else { ok defined $request, "should create (mocked) instance of $params{request_class}" or diag $error; } return $request; } sub expect_request_path { my ($request, $expected) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; return cmp_deeply $request->http_request->path, $expected, "it builds expected request path" ; } sub expect_request_method { my ($request, $expected) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; return cmp_deeply $request->http_request->method, $expected, "it builds expected request method" ; } sub expect_request_headers { my ($request, $expected) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; return cmp_deeply $request->http_request->headers, $expected, "it builds expected request headers" ; } sub expect_request_content { my ($request, $expected) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; # XML builders doesn't need to produce whitespaces for readability # wherease test expectation should be as readable as possible # compare canonicalized xml strings than return is _canonical_xml ($request->http_request->content), _canonical_xml ($expected), "it builds expected request XML content" ; } sub behaves_like_net_amazon_s3_request { my ($title, %params) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $title => sub { plan tests => 2 + scalar grep exists $params{$_}, qw[ expect_request_path ], qw[ expect_request_method ], qw[ expect_request_headers ], qw[ expect_request_content ], ; expect_request_class $params{request_class}; my $request = expect_request_instance %params; expect_request_path $request => $params{expect_request_path} if exists $params{expect_request_path}; expect_request_method $request => $params{expect_request_method} if exists $params{expect_request_method}; expect_request_headers $request => $params{expect_request_headers} if exists $params{expect_request_headers}; expect_request_content $request => $params{expect_request_content} if exists $params{expect_request_content}; }; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::Request - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut ListAllMyBuckets.pm100644000765000024 263613620607144 23233 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::ListAllMyBuckets; $Net::Amazon::S3::Request::ListAllMyBuckets::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Service'; # ABSTRACT: An internal class to list all buckets with 'Net::Amazon::S3::Request::Role::HTTP::Method::GET'; __PACKAGE__->meta->make_immutable; # AWS routes request without specific region to us-east-1 # # https://docs.aws.amazon.com/general/latest/gr/rande.html sub http_request { my $self = shift; return $self->_build_http_request( use_virtual_host => 0, region => 'us-east-1', ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::ListAllMyBuckets - An internal class to list all buckets =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::ListAllMyBuckets->new( s3 => $s3 ) ->http_request; =head1 DESCRIPTION This module lists all buckets. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTTP000755000765000024 013620607144 21013 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/RoleHeader.pm100644000765000024 315613620607144 22706 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTPpackage Net::Amazon::S3::Request::Role::HTTP::Header; # ABSTRACT: HTTP Header Role $Net::Amazon::S3::Request::Role::HTTP::Header::VERSION = '0.89'; use MooseX::Role::Parameterized; parameter name => ( is => 'ro', isa => 'Str', required => 1, ); parameter header => ( is => 'ro', isa => 'Str', ); parameter constraint => ( is => 'ro', isa => 'Str', init_arg => 'isa', required => 1, ); parameter required => ( is => 'ro', isa => 'Bool', default => 0, ); parameter default => ( is => 'ro', isa => 'Str|CodeRef', required => 0, ); role { my ($params) = @_; my $name = $params->name; my $header = $params->header; has $name => ( is => 'ro', isa => $params->constraint, (init_arg => undef) x!! $name =~ m/^_/, required => $params->required, (default => $params->default) x!! defined $params->default, ); around _request_headers => eval <<"INLINE"; sub { my (\$inner, \$self) = \@_; my \$value = \$self->$name; return (\$self->\$inner, (q[$header] => \$value) x!! defined \$value); }; INLINE }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Header - HTTP Header Role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Method.pm100644000765000024 217613620607144 22737 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTPpackage Net::Amazon::S3::Request::Role::HTTP::Method; # ABSTRACT: HTTP method role $Net::Amazon::S3::Request::Role::HTTP::Method::VERSION = '0.89'; use MooseX::Role::Parameterized; use Net::Amazon::S3::HTTPRequest; parameter method => ( is => 'ro', isa => 'HTTPMethod', required => 0, ); role { my ($params) = @_; has _http_request_method => ( is => 'ro', isa => 'HTTPMethod', $params->method ? ( init_arg => undef, default => $params->method, ) : ( init_arg => 'method', required => 1 ), ); }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Method - HTTP method role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Query000755000765000024 013620607144 21341 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/RoleParam.pm100644000765000024 321313620607144 23076 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Querypackage Net::Amazon::S3::Request::Role::Query::Param; # ABSTRACT: request query params role $Net::Amazon::S3::Request::Role::Query::Param::VERSION = '0.89'; use MooseX::Role::Parameterized; parameter param => ( is => 'ro', isa => 'Str', required => 1, ); parameter query_param => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { $_[0]->param }, ); parameter constraint => ( is => 'ro', isa => 'Str', required => 1, ); parameter required => ( is => 'ro', isa => 'Bool', default => 0, ); parameter default => ( is => 'ro', isa => 'Str|CodeRef', required => 0, ); role { my ($params) = @_; my $param = $params->param; my $query_param = $params->query_param; has $param => ( is => 'ro', isa => $params->constraint, required => $params->required, (default => $params->default) x!! defined $params->default, ); around _request_query_params => eval <<"INLINE"; sub { my (\$inner, \$self) = \@_; my \$value = \$self->$param; return (\$self->\$inner, (q[$query_param] => \$value) x!! defined \$value); }; INLINE }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Param - request query params role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DeleteMultiObject.pm100755000765000024 453713620607144 23411 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::DeleteMultiObject; $Net::Amazon::S3::Request::DeleteMultiObject::VERSION = '0.89'; use Moose 0.85; use Digest::MD5 qw/md5 md5_hex/; use MIME::Base64; use Carp qw/croak/; extends 'Net::Amazon::S3::Request::Bucket'; has 'keys' => ( is => 'ro', isa => 'ArrayRef', required => 1 ); with 'Net::Amazon::S3::Request::Role::Query::Action::Delete'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Content_length'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Content_md5'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Content_type' => { content_type => 'application/xml' }; with 'Net::Amazon::S3::Request::Role::HTTP::Method::POST'; __PACKAGE__->meta->make_immutable; sub _request_content { my ($self) = @_; #build XML doc my $xml_doc = XML::LibXML::Document->new('1.0','UTF-8'); my $root_element = $xml_doc->createElement('Delete'); $xml_doc->addChild($root_element); $root_element->appendTextChild('Quiet'=>'true'); #add content foreach my $key (@{$self->keys}){ my $obj_element = $xml_doc->createElement('Object'); $obj_element->appendTextChild('Key' => $key); $root_element->addChild($obj_element); } return $xml_doc->toString; } sub BUILD { my ($self) = @_; croak "The maximum number of keys is 1000" if (scalar(@{$self->keys}) > 1000); } 1; =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::DeleteMultiObject - An internal class to delete multiple objects from a bucket =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::DeleteMultiObject->new( s3 => $s3, bucket => $bucket, keys => [$key1, $key2], )->http_request; =head1 DESCRIPTION This module deletes multiple objects from a bucket. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ # ABSTRACT: An internal class to delete multiple objects from a bucket Action.pm100644000765000024 153513620607144 23260 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Querypackage Net::Amazon::S3::Request::Role::Query::Action; # ABSTRACT: query action role $Net::Amazon::S3::Request::Role::Query::Action::VERSION = '0.89'; use MooseX::Role::Parameterized; parameter action => ( is => 'ro', isa => 'Str', ); role { my ($params) = @_; my $action = $params->action; method '_request_query_action' => sub { $action }; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Action - query action role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut V4Implementation.pm100644000765000024 2654513620607144 23575 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Signature#package Net::Amazon::Signature::V4; package Net::Amazon::S3::Signature::V4Implementation; # ABSTRACT: Implements the Amazon Web Services signature version 4, AWS4-HMAC-SHA256 (copy of Net::Amazon::Signature::V4) use strict; use warnings; use sort 'stable'; use Digest::SHA qw/sha256_hex hmac_sha256 hmac_sha256_hex/; use Time::Piece (); use URI::Escape; use URI; use URI::QueryParam; our $ALGORITHM = 'AWS4-HMAC-SHA256'; our $MAX_EXPIRES = 604800; # Max, 7 days our $X_AMZ_ALGORITHM = 'X-Amz-Algorithm'; our $X_AMZ_CONTENT_SHA256 = 'X-Amz-Content-Sha256'; our $X_AMZ_CREDENTIAL = 'X-Amz-Credential'; our $X_AMZ_DATE = 'X-Amz-Date'; our $X_AMZ_EXPIRES = 'X-Amz-Expires'; our $X_AMZ_SIGNEDHEADERS = 'X-Amz-SignedHeaders'; our $X_AMZ_SIGNATURE = 'X-Amz-Signature'; our $VERSION = '0.19'; sub new { my $class = shift; my ( $access_key_id, $secret, $endpoint, $service ) = @_; my $self = { access_key_id => $access_key_id, secret => $secret, endpoint => $endpoint, service => $service, }; bless $self, $class; return $self; } sub sign { my ( $self, $request ) = @_; $request = $self->_augment_request( $request ); my $authz = $self->_authorization( $request ); $request->header( Authorization => $authz ); return $request; } sub sign_uri { my ( $self, $uri, $expires_in ) = @_; my $request = $self->_augment_uri( $uri, $expires_in ); my $signature = $self->_signature( $request ); $uri = $request->uri; my $query = $uri->query; $uri->query( undef ); $uri = $uri . '?' . $self->_sort_query_string( $query ); $uri .= "&$X_AMZ_SIGNATURE=$signature"; return $uri; } # _headers_to_sign: # Return the sorted lower case headers as required by the generation of canonical headers sub _headers_to_sign { my $req = shift; my @headers_to_sign = $req->uri->query_param( $X_AMZ_SIGNEDHEADERS ) ? $req->uri->query_param( $X_AMZ_SIGNEDHEADERS ) : $req->headers->header_field_names ; return sort { $a cmp $b } map { lc } @headers_to_sign } # _augment_request: # Append mandatory header fields sub _augment_request { my ( $self, $request ) = @_; $request->header($X_AMZ_DATE => $self->_format_amz_date( $self->_req_timepiece($request) )) unless $request->header($X_AMZ_DATE); $request->header($X_AMZ_CONTENT_SHA256 => sha256_hex($request->content)) unless $request->header($X_AMZ_CONTENT_SHA256); return $request; } # _augment_uri: # Append mandatory uri parameters sub _augment_uri { my ($self, $uri, $expires_in) = @_; my $request = HTTP::Request->new( GET => $uri ); $request->uri->query_param( $X_AMZ_DATE => $self->_format_amz_date( $self->_now ) ) unless $request->uri->query_param( $X_AMZ_DATE ); $request->uri->query_param( $X_AMZ_ALGORITHM => $ALGORITHM ) unless $request->uri->query_param( $X_AMZ_ALGORITHM ); $request->uri->query_param( $X_AMZ_CREDENTIAL => $self->_credential( $request ) ) unless $request->uri->query_param( $X_AMZ_CREDENTIAL ); $request->uri->query_param( $X_AMZ_EXPIRES => $expires_in || $MAX_EXPIRES ) unless $request->uri->query_param( $X_AMZ_EXPIRES ); $request->uri->query_param( $X_AMZ_EXPIRES => $MAX_EXPIRES ) if $request->uri->query_param( $X_AMZ_EXPIRES ) > $MAX_EXPIRES; $request->uri->query_param( $X_AMZ_SIGNEDHEADERS => 'host' ); return $request; } # _canonical_request: # Construct the canonical request string from an HTTP::Request. sub _canonical_request { my ( $self, $req ) = @_; my $creq_method = $req->method; my ( $creq_canonical_uri, $creq_canonical_query_string ) = ( $req->uri =~ m@([^?]*)\?(.*)$@ ) ? ( $1, $2 ) : ( $req->uri, '' ); $creq_canonical_uri =~ s@^https?://[^/]*/?@/@; $creq_canonical_uri = _simplify_uri( $creq_canonical_uri ); $creq_canonical_query_string = $self->_sort_query_string( $creq_canonical_query_string ); # Ensure Host header is present as its required if (!$req->header('host')) { $req->header('Host' => $req->uri->host); } my $creq_payload_hash = $req->header($X_AMZ_CONTENT_SHA256) # Signed uri doesn't have content || 'UNSIGNED-PAYLOAD'; # There's a bug in AMS4 which causes requests without x-amz-date set to be rejected # so we always add one if its not present. my $amz_date = $req->header($X_AMZ_DATE); my @sorted_headers = _headers_to_sign( $req ); my $creq_canonical_headers = join '', map { sprintf "%s:%s\x0a", lc, join ',', sort {$a cmp $b } _trim_whitespace($req->header($_) ) } @sorted_headers; my $creq_signed_headers = $self->_signed_headers( $req ); my $creq = join "\x0a", $creq_method, $creq_canonical_uri, $creq_canonical_query_string, $creq_canonical_headers, $creq_signed_headers, $creq_payload_hash; return $creq; } # _string_to_sign # Construct the string to sign. sub _string_to_sign { my ( $self, $req ) = @_; my $dt = $self->_req_timepiece( $req ); my $creq = $self->_canonical_request($req); my $sts_request_date = $self->_format_amz_date( $dt ); my $sts_credential_scope = join '/', $dt->strftime('%Y%m%d'), $self->{endpoint}, $self->{service}, 'aws4_request'; my $sts_creq_hash = sha256_hex( $creq ); my $sts = join "\x0a", $ALGORITHM, $sts_request_date, $sts_credential_scope, $sts_creq_hash; return $sts; } # _authorization # Construct the authorization string sub _signature { my ( $self, $req ) = @_; my $dt = $self->_req_timepiece( $req ); my $sts = $self->_string_to_sign( $req ); my $k_date = hmac_sha256( $dt->strftime('%Y%m%d'), 'AWS4' . $self->{secret} ); my $k_region = hmac_sha256( $self->{endpoint}, $k_date ); my $k_service = hmac_sha256( $self->{service}, $k_region ); my $k_signing = hmac_sha256( 'aws4_request', $k_service ); my $authz_signature = hmac_sha256_hex( $sts, $k_signing ); return $authz_signature; } sub _credential { my ( $self, $req ) = @_; my $dt = $self->_req_timepiece( $req ); my $authz_credential = join '/', $self->{access_key_id}, $dt->strftime('%Y%m%d'), $self->{endpoint}, $self->{service}, 'aws4_request'; return $authz_credential; } sub _signed_headers { my ( $self, $req ) = @_; my $authz_signed_headers = join ';', _headers_to_sign( $req ); return $authz_signed_headers; } sub _authorization { my ( $self, $req ) = @_; my $authz_signature = $self->_signature( $req ); my $authz_credential = $self->_credential( $req ); my $authz_signed_headers = $self->_signed_headers( $req ); my $authz = "$ALGORITHM Credential=$authz_credential,SignedHeaders=$authz_signed_headers,Signature=$authz_signature"; return $authz; } sub _simplify_uri { my $orig_uri = shift; my @parts = split /\//, $orig_uri; my @simple_parts = (); for my $part ( @parts ) { if ( ! length $part || $part eq '.' ) { } elsif ( $part eq '..' ) { pop @simple_parts; } else { push @simple_parts, $part; } } my $simple_uri = '/' . join '/', @simple_parts; $simple_uri .= '/' if $orig_uri =~ m@/$@ && $simple_uri !~ m@/$@; return $simple_uri; } sub _sort_query_string { my $self = shift; return '' unless $_[0]; my @params; for my $param ( split /&/, $_[0] ) { my ( $key, $value ) = map { tr/+/ /; uri_escape( uri_unescape( $_ ) ) } # escape all non-unreserved chars split /=/, $param; push @params, [$key, (defined $value ? $value : '')]; #push @params, [$key, $value]; } return join '&', map { join '=', grep defined, @$_ } sort { ( $a->[0] cmp $b->[0] ) || ( $a->[1] cmp $b->[1] ) } @params; } sub _trim_whitespace { return map { my $str = $_; $str =~ s/^\s*//; $str =~ s/\s*$//; $str } @_; } sub _str_to_timepiece { my $date = shift; if ( $date =~ m/^\d{8}T\d{6}Z$/ ) { # assume basic ISO 8601, as demanded by AWS return Time::Piece->strptime($date, '%Y%m%dT%H%M%SZ'); } else { # assume the format given in the AWS4 test suite $date =~ s/^.{5}//; # remove weekday, as Amazon's test suite contains internally inconsistent dates return Time::Piece->strptime($date, '%d %b %Y %H:%M:%S %Z'); } } sub _format_amz_date { my ($self, $dt) = @_; $dt->strftime('%Y%m%dT%H%M%SZ'); } sub _now { return scalar Time::Piece->gmtime; } sub _req_timepiece { my ($self, $req) = @_; my $x_date = $req->header($X_AMZ_DATE) || $req->uri->query_param($X_AMZ_DATE); my $date = $x_date || $req->header('Date'); if (!$date) { # No date set by the caller so set one up my $piece = $self->_now; $req->date($piece->epoch); return $piece } return _str_to_timepiece($date); } 1; # End of Net::Amazon::Signature::V4 __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Signature::V4Implementation - Implements the Amazon Web Services signature version 4, AWS4-HMAC-SHA256 (copy of Net::Amazon::Signature::V4) =head1 VERSION version 0.89 =head1 SYNOPSIS This module signs an HTTP::Request to Amazon Web Services by appending an Authorization header. Amazon Web Services signature version 4, AWS4-HMAC-SHA256, is used. use Net::Amazon::Signature::V4; my $sig = Net::Amazon::Signature::V4->new( $access_key_id, $secret, $endpoint, $service ); my $req = HTTP::Request->parse( $request_string ); my $signed_req = $sig->sign( $req ); ... The primary purpose of this module is to be used by Net::Amazon::Glacier. =head1 VERSION Version 0.19 =head1 METHODS =head2 new( $access_key_id, $secret, $endpoint, $service ) Constructs the signature object, which is used to sign requests. Note that the access key ID is an alphanumeric string, not your account ID. The endpoint could be "eu-west-1", and the service could be "glacier". =head2 sign( $request ) Signs a request with your credentials by appending the Authorization header. $request should be an HTTP::Request. The signed request is returned. =head2 sign_uri( $uri, $expires_in? ) Signs an uri with your credentials by appending the Authorization query parameters. C<< $expires_in >> integer value in range 1..604800 (1 second .. 7 days). C<< $expires_in >> default value is its maximum: 604800 The signed uri is returned. =head1 AUTHOR Tim Nordenfur, C<< >> Maintained by Dan Book, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Net::Amazon::Signature::V4 You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 LICENSE AND COPYRIGHT Copyright 2012 Tim Nordenfur. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut AbortMultipartUpload.pm100644000765000024 361113620607144 24150 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::AbortMultipartUpload; $Net::Amazon::S3::Request::AbortMultipartUpload::VERSION = '0.89'; use Moose 0.85; use Digest::MD5 qw/md5 md5_hex/; use MIME::Base64; use Carp qw/croak/; use XML::LibXML; extends 'Net::Amazon::S3::Request::Object'; with 'Net::Amazon::S3::Request::Role::Query::Param::Upload_id'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::DELETE'; __PACKAGE__->meta->make_immutable; 1; =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::AbortMultipartUpload - An internal class to complete a multipart upload =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::AbortMultipartUpload->new( s3 => $s3, bucket => $bucket, key => $key upload_id => $upload_id, )->http_request; =head1 DESCRIPTION This module aborts a multipart upload. =head1 NAME Net::Amazon::S3::Request::AbortMultipartUpload - An internal class to abort a multipart upload =head1 VERSION version 0.59 =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Pedro Figueiredo =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ # ABSTRACT: An internal class to complete a multipart upload Method000755000765000024 013620607144 22233 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTPPUT.pm100644000765000024 136413620607144 23405 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Methodpackage Net::Amazon::S3::Request::Role::HTTP::Method::PUT; # ABSTRACT: HTTP PUT method role $Net::Amazon::S3::Request::Role::HTTP::Method::PUT::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::HTTP::Method' => { method => 'PUT' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Method::PUT - HTTP PUT method role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GET.pm100644000765000024 136413620607144 23354 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Methodpackage Net::Amazon::S3::Request::Role::HTTP::Method::GET; # ABSTRACT: HTTP GET method role $Net::Amazon::S3::Request::Role::HTTP::Method::GET::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::HTTP::Method' => { method => 'GET' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Method::GET - HTTP GET method role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut POST.pm100644000765000024 137213620607144 23521 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Methodpackage Net::Amazon::S3::Request::Role::HTTP::Method::POST; # ABSTRACT: HTTP POST method role $Net::Amazon::S3::Request::Role::HTTP::Method::POST::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::HTTP::Method' => { method => 'POST' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Method::POST - HTTP POST method role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Action000755000765000024 013620607144 22556 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/QueryAcl.pm100644000765000024 137213620607144 23756 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Actionpackage Net::Amazon::S3::Request::Role::Query::Action::Acl; # ABSTRACT: acl query action role $Net::Amazon::S3::Request::Role::Query::Action::Acl::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Action' => { action => 'acl' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Action::Acl - acl query action role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SetBucketAccessControl.pm100644000765000024 350213620607144 24405 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::SetBucketAccessControl; $Net::Amazon::S3::Request::SetBucketAccessControl::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Bucket'; # ABSTRACT: An internal class to set a bucket's access control with 'Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short'; has 'acl_xml' => ( is => 'ro', isa => 'Maybe[Str]', required => 0 ); with 'Net::Amazon::S3::Request::Role::Query::Action::Acl'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::PUT'; __PACKAGE__->meta->make_immutable; sub _request_content { my ($self) = @_; return $self->acl_xml || ''; } sub BUILD { my ($self) = @_; unless ( $self->acl_xml || $self->acl_short ) { confess "need either acl_xml or acl_short"; } if ( $self->acl_xml && $self->acl_short ) { confess "can not provide both acl_xml and acl_short"; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::SetBucketAccessControl - An internal class to set a bucket's access control =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::SetBucketAccessControl->new( s3 => $s3, bucket => $bucket, acl_short => $acl_short, acl_xml => $acl_xml, )->http_request; =head1 DESCRIPTION This module sets a bucket's access control. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut SetObjectAccessControl.pm100644000765000024 353313620607144 24402 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::SetObjectAccessControl; $Net::Amazon::S3::Request::SetObjectAccessControl::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Object'; # ABSTRACT: An internal class to set an object's access control has 'acl_xml' => ( is => 'ro', isa => 'Maybe[Str]', required => 0 ); with 'Net::Amazon::S3::Request::Role::Query::Action::Acl'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::PUT'; __PACKAGE__->meta->make_immutable; sub _request_content { my ($self) = @_; return $self->acl_xml || ''; } sub BUILD { my ($self) = @_; unless ( $self->acl_xml || $self->acl_short ) { confess "need either acl_xml or acl_short"; } if ( $self->acl_xml && $self->acl_short ) { confess "can not provide both acl_xml and acl_short"; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::SetObjectAccessControl - An internal class to set an object's access control =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::SetObjectAccessControl->new( s3 => $s3, bucket => $bucket, key => $key, acl_short => $acl_short, acl_xml => $acl_xml, )->http_request; =head1 DESCRIPTION This module sets an object's access control. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GetBucketAccessControl.pm100644000765000024 243513620607144 24375 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::GetBucketAccessControl; $Net::Amazon::S3::Request::GetBucketAccessControl::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Bucket'; # ABSTRACT: An internal class to get a bucket's access control with 'Net::Amazon::S3::Request::Role::Query::Action::Acl'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::GET'; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::GetBucketAccessControl - An internal class to get a bucket's access control =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::GetBucketAccessControl->new( s3 => $s3, bucket => $bucket, )->http_request; =head1 DESCRIPTION This module gets a bucket's access control. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GetObjectAccessControl.pm100644000765000024 246413620607144 24370 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::GetObjectAccessControl; $Net::Amazon::S3::Request::GetObjectAccessControl::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Object'; # ABSTRACT: An internal class to get an object's access control with 'Net::Amazon::S3::Request::Role::Query::Action::Acl'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::GET'; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::GetObjectAccessControl - An internal class to get an object's access control =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::GetObjectAccessControl->new( s3 => $s3, bucket => $bucket, key => $key, )->http_request; =head1 DESCRIPTION This module gets an object's access control. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut CompleteMultipartUpload.pm100755000765000024 511613620607144 24656 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::CompleteMultipartUpload; $Net::Amazon::S3::Request::CompleteMultipartUpload::VERSION = '0.89'; use Moose 0.85; use Digest::MD5 qw/md5 md5_hex/; use MIME::Base64; use Carp qw/croak/; use XML::LibXML; extends 'Net::Amazon::S3::Request::Object'; with 'Net::Amazon::S3::Request::Role::Query::Param::Upload_id'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Content_length'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Content_md5'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Content_type' => { content_type => 'application/xml' }; with 'Net::Amazon::S3::Request::Role::HTTP::Method::POST'; has 'etags' => ( is => 'ro', isa => 'ArrayRef', required => 1 ); has 'part_numbers' => ( is => 'ro', isa => 'ArrayRef', required => 1 ); __PACKAGE__->meta->make_immutable; sub _request_content { my ($self) = @_; #build XML doc my $xml_doc = XML::LibXML::Document->new('1.0','UTF-8'); my $root_element = $xml_doc->createElement('CompleteMultipartUpload'); $xml_doc->addChild($root_element); #add content for(my $i = 0; $i < scalar(@{$self->part_numbers}); $i++ ){ my $part = $xml_doc->createElement('Part'); $part->appendTextChild('PartNumber' => $self->part_numbers->[$i]); $part->appendTextChild('ETag' => $self->etags->[$i]); $root_element->addChild($part); } return $xml_doc->toString; } sub BUILD { my ($self) = @_; croak "must have an equally sized list of etags and part numbers" unless scalar(@{$self->part_numbers}) == scalar(@{$self->etags}); } 1; =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::CompleteMultipartUpload - An internal class to complete a multipart upload =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::CompleteMultipartUpload->new( s3 => $s3, bucket => $bucket, etags => \@etags, part_numbers => \@part_numbers, )->http_request; =head1 DESCRIPTION This module completes a multipart upload. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ # ABSTRACT: An internal class to complete a multipart upload InitiateMultipartUpload.pm100755000765000024 320013620607144 24644 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::InitiateMultipartUpload; $Net::Amazon::S3::Request::InitiateMultipartUpload::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Object'; has 'headers' => ( is => 'ro', isa => 'HashRef', required => 0, default => sub { {} } ); with 'Net::Amazon::S3::Request::Role::Query::Action::Uploads'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short'; with 'Net::Amazon::S3::Request::Role::HTTP::Header::Encryption'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::POST'; __PACKAGE__->meta->make_immutable; sub _request_headers { my ($self) = @_; return %{ $self->headers }; } 1; =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::InitiateMultipartUpload - An internal class to begin a multipart upload =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::InitiateMultipartUpload->new( s3 => $s3, bucket => $bucket, keys => $key, )->http_request; =head1 DESCRIPTION This module begins a multipart upload =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut __END__ #ABSTRACT: An internal class to begin a multipart upload DELETE.pm100644000765000024 140613620607144 23674 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Methodpackage Net::Amazon::S3::Request::Role::HTTP::Method::DELETE; # ABSTRACT: HTTP DELETE method role $Net::Amazon::S3::Request::Role::HTTP::Method::DELETE::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::HTTP::Method' => { method => 'DELETE' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Method::DELETE - HTTP DELETE method role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Param000755000765000024 013620607144 22401 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/QueryPrefix.pm100644000765000024 147513620607144 24343 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Parampackage Net::Amazon::S3::Request::Role::Query::Param::Prefix; # ABSTRACT: prefix query param role $Net::Amazon::S3::Request::Role::Query::Param::Prefix::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Param' => { param => 'prefix', constraint => 'Maybe[Str]', required => 0, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Param::Prefix - prefix query param role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Marker.pm100644000765000024 147513620607144 24327 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Parampackage Net::Amazon::S3::Request::Role::Query::Param::Marker; # ABSTRACT: marker query param role $Net::Amazon::S3::Request::Role::Query::Param::Marker::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Param' => { param => 'marker', constraint => 'Maybe[Str]', required => 0, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Param::Marker - marker query param role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Delete.pm100644000765000024 141413620607144 24456 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Actionpackage Net::Amazon::S3::Request::Role::Query::Action::Delete; # ABSTRACT: delete query action role $Net::Amazon::S3::Request::Role::Query::Action::Delete::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Action' => { action => 'delete' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Action::Delete - delete query action role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Max_keys.pm100644000765000024 157513620607144 24667 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Parampackage Net::Amazon::S3::Request::Role::Query::Param::Max_keys; # ABSTRACT: max-keys query param role $Net::Amazon::S3::Request::Role::Query::Param::Max_keys::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Param' => { param => 'max_keys', query_param => 'max-keys', constraint => 'Maybe[Str]', required => 0, default => 1000, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Param::Max_keys - max-keys query param role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Uploads.pm100644000765000024 142213620607144 24662 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Actionpackage Net::Amazon::S3::Request::Role::Query::Action::Uploads; # ABSTRACT: uploads query action role $Net::Amazon::S3::Request::Role::Query::Action::Uploads::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Action' => { action => 'uploads' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Action::Uploads - uploads query action role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Header000755000765000024 013620607144 22203 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTPAcl_short.pm100644000765000024 153513620607144 24623 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Headerpackage Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short; # ABSTRACT: x-amz-acl header role $Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::HTTP::Header' => { name => 'acl_short', header => 'x-amz-acl', isa => 'Maybe[AclShort]', required => 0, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Header::Acl_short - x-amz-acl header role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Upload_id.pm100644000765000024 154713620607144 25006 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Parampackage Net::Amazon::S3::Request::Role::Query::Param::Upload_id; # ABSTRACT: upload_id query param role $Net::Amazon::S3::Request::Role::Query::Param::Upload_id::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Param' => { param => 'upload_id', query_param => 'uploadId', constraint => 'Str', required => 1, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Param::Upload_id - upload_id query param role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Delimiter.pm100644000765000024 151713620607144 25021 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Parampackage Net::Amazon::S3::Request::Role::Query::Param::Delimiter; # ABSTRACT: delimiter query param role $Net::Amazon::S3::Request::Role::Query::Param::Delimiter::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Param' => { param => 'delimiter', constraint => 'Maybe[Str]', required => 0, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Param::Delimiter - delimiter query param role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Location.pm100644000765000024 143013620607144 25022 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Actionpackage Net::Amazon::S3::Request::Role::Query::Action::Location; # ABSTRACT: location query action role $Net::Amazon::S3::Request::Role::Query::Action::Location::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Action' => { action => 'location' }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Action::Location - location query action role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut GetBucketLocationConstraint.pm100644000765000024 250513620607144 25446 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Requestpackage Net::Amazon::S3::Request::GetBucketLocationConstraint; $Net::Amazon::S3::Request::GetBucketLocationConstraint::VERSION = '0.89'; use Moose 0.85; use MooseX::StrictConstructor 0.16; extends 'Net::Amazon::S3::Request::Bucket'; # ABSTRACT: An internal class to get a bucket's location constraint with 'Net::Amazon::S3::Request::Role::Query::Action::Location'; with 'Net::Amazon::S3::Request::Role::HTTP::Method::GET'; __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::GetBucketLocationConstraint - An internal class to get a bucket's location constraint =head1 VERSION version 0.89 =head1 SYNOPSIS my $http_request = Net::Amazon::S3::Request::GetBucketLocationConstraint->new( s3 => $s3, bucket => $bucket, )->http_request; =head1 DESCRIPTION This module gets a bucket's location constraint. =for test_synopsis no strict 'vars' =head1 METHODS =head2 http_request This method returns a HTTP::Request object. =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Encryption.pm100644000765000024 162513620607144 25037 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Headerpackage Net::Amazon::S3::Request::Role::HTTP::Header::Encryption; # ABSTRACT: x-amz-server-side-encryption header role $Net::Amazon::S3::Request::Role::HTTP::Header::Encryption::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::HTTP::Header' => { name => 'encryption', header => 'x-amz-server-side-encryption', isa => 'Maybe[Str]', required => 0, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Header::Encryption - x-amz-server-side-encryption header role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Content_md5.pm100644000765000024 177413620607144 25071 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Headerpackage Net::Amazon::S3::Request::Role::HTTP::Header::Content_md5; # ABSTRACT: Content-MD5 header role $Net::Amazon::S3::Request::Role::HTTP::Header::Content_md5::VERSION = '0.89'; use Moose::Role; use Digest::MD5 qw[]; use MIME::Base64 qw[]; around _request_headers => sub { my ($inner, $self) = @_; my $content = $self->_http_request_content; my $value = MIME::Base64::encode_base64( Digest::MD5::md5( $content ) ); chomp $value; return ($self->$inner, ('Content-MD5' => $value)); }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Header::Content_md5 - Content-MD5 header role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Copy_source.pm100644000765000024 236313620607144 25177 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Headerpackage Net::Amazon::S3::Request::Role::HTTP::Header::Copy_source; # ABSTRACT: x-amz-copy-source header role $Net::Amazon::S3::Request::Role::HTTP::Header::Copy_source::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::HTTP::Header' => { name => '_copy_source', header => 'x-amz-copy-source', isa => 'Maybe[Str]', required => 0, default => sub { my ($self) = @_; defined $self->copy_source_bucket && defined $self->copy_source_key ? $self->copy_source_bucket.'/'.$self->copy_source_key : undef; }, }; has 'copy_source_bucket' => ( is => 'ro', isa => 'Str', required => 0 ); has 'copy_source_key' => ( is => 'ro', isa => 'Str', required => 0 ); 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Header::Copy_source - x-amz-copy-source header role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Part_number.pm100644000765000024 156313620607144 25362 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/Query/Parampackage Net::Amazon::S3::Request::Role::Query::Param::Part_number; # ABSTRACT: partNumber query param role $Net::Amazon::S3::Request::Role::Query::Param::Part_number::VERSION = '0.89'; use Moose::Role; with 'Net::Amazon::S3::Request::Role::Query::Param' => { param => 'part_number', query_param => 'partNumber', constraint => 'Int', required => 1, }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::Query::Param::Part_number - partNumber query param role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Content_type.pm100644000765000024 202113620607144 25347 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Headerpackage Net::Amazon::S3::Request::Role::HTTP::Header::Content_type; # ABSTRACT: Content-Type header role $Net::Amazon::S3::Request::Role::HTTP::Header::Content_type::VERSION = '0.89'; use MooseX::Role::Parameterized; parameter content_type => ( is => 'ro', isa => 'Str', required => 1, ); role { my ($params) = @_; my $content_type = $params->content_type; around _request_headers => sub { my ($inner, $self) = @_; return ($self->$inner, ('Content-Type' => $content_type)); }; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Header::Content_type - Content-Type header role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Content_length.pm100644000765000024 167113620607144 25661 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Net/Amazon/S3/Request/Role/HTTP/Headerpackage Net::Amazon::S3::Request::Role::HTTP::Header::Content_length; # ABSTRACT: Content-Lenghth header role $Net::Amazon::S3::Request::Role::HTTP::Header::Content_length::VERSION = '0.89'; use Moose::Role; use Digest::MD5 qw[]; use MIME::Base64 qw[]; around _request_headers => sub { my ($inner, $self) = @_; my $content = $self->_http_request_content; return ($self->$inner, ('Content-Length' => length $content)); }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Net::Amazon::S3::Request::Role::HTTP::Header::Content_length - Content-Lenghth header role =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Bucket000755000765000024 013620607144 24044 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3/OperationCreate.pm100644000765000024 201613620607144 25744 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3/Operation/Bucketpackage Shared::Examples::Net::Amazon::S3::Operation::Bucket::Create; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::Operation::Bucket::Create::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; our @EXPORT_OK = ( qw[ create_bucket_in_ca_central_1_content_xml ], ); sub create_bucket_in_ca_central_1_content_xml { <<'EOXML'; ca-central-1 EOXML } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::Operation::Bucket::Create - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Objects000755000765000024 013620607144 25435 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3/Operation/BucketList.pm100644000765000024 1453513620607144 27076 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3/Operation/Bucket/Objectspackage Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::List; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::List::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; our @EXPORT_OK = ( qw[ list_bucket_objects_v1 ], qw[ list_bucket_objects_v1_with_filter_truncated ], qw[ list_bucket_objects_v1_with_filter ], qw[ list_bucket_objects_v1_with_delimiter ], qw[ list_bucket_objects_v1_with_prefix_and_delimiter ], qw[ list_bucket_objects_v1_google_cloud_storage ], ); sub list_bucket_objects_v1 { <<'EOXML'; some-bucket 1000 false my-image.jpg 2009-10-12T17:50:30.000Z "fba9dede5f27731c9771645a39863328" 434234 STANDARD 75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a mtd@amazon.com my-third-image.jpg 2009-10-12T17:50:30.000Z "1b2cf535f27731c974343645a3985328" 64994 STANDARD_IA 75aa57f09aa0c8caeab4f8c24e99d10f8e7faeebf76c078efc7c6caea54ba06a mtd@amazon.com EOXML } sub list_bucket_objects_v1_with_filter_truncated { <<'EOXML'; some-bucket N Ned 40 true Nelson 2006-01-01T12:00:00.000Z "828ef3fdfa96f00ad9f27c383fc9ac7f" 5 STANDARD bcaf161ca5fb16fd081034f webfile Neo 2006-01-01T12:00:00.000Z "828ef3fdfa96f00ad9f27c383fc9ac7f" 4 STANDARD bcaf1ffd86a5fb16fd081034f webfile EOXML } sub list_bucket_objects_v1_with_filter { <<'EOXML'; some-bucket N Ned 40 false Nelson 2006-01-01T12:00:00.000Z "828ef3fdfa96f00ad9f27c383fc9ac7f" 5 STANDARD bcaf161ca5fb16fd081034f webfile Neo 2006-01-01T12:00:00.000Z "828ef3fdfa96f00ad9f27c383fc9ac7f" 4 STANDARD bcaf1ffd86a5fb16fd081034f webfile EOXML } sub list_bucket_objects_v1_with_delimiter { <<'EOXML'; some-bucket 1000 / false sample.jpg 2011-02-26T01:56:20.000Z "bf1d737a4d46a19f3bced6905cc8b902" 142863 canonical-user-id display-name STANDARD photos/ EOXML } sub list_bucket_objects_v1_with_prefix_and_delimiter { <<'EOXML'; some-bucket photos/2006/ 1000 / false photos/2006/February/ photos/2006/January/ EOXML } sub list_bucket_objects_v1_google_cloud_storage { <<'EOXML'; gcs-bucket next/marker/is/foo true path/to/value 1473499153424000 1 2017-04-21T22:06:03.413Z "1f52bad2879ca96dacd7a40f33001230" 742213 path/to/value2 1473499153424001 1 2018-04-21T22:06:03.413Z "1f52bad2889ca96dacd7a40f33001230" 742214 EOXML } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::List - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Buckets000755000765000024 013620607144 25627 5ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3/Operation/ServiceList.pm100644000765000024 365613620607144 27252 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3/Operation/Service/Bucketspackage Shared::Examples::Net::Amazon::S3::Operation::Service::Buckets::List; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::Operation::Service::Buckets::List::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; our @EXPORT_OK = ( 'buckets_list_without_displayname', 'buckets_list_with_displayname', ); sub buckets_list_without_displayname { <<'XML'; bcaf1ffd86f461ca5fb16fd081034f quotes 2006-02-03T16:45:09.000Z samples 2006-02-03T16:41:58.000Z XML } sub buckets_list_with_displayname { <<'XML'; bcaf1ffd86f461ca5fb16fd081034f webfile quotes 2006-02-03T16:45:09.000Z samples 2006-02-03T16:41:58.000Z XML } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::Operation::Service::Buckets::List - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Delete.pm100644000765000024 207413620607144 27340 0ustar00leostaff000000000000Net-Amazon-S3-0.89/lib/Shared/Examples/Net/Amazon/S3/Operation/Bucket/Objectspackage Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::Delete; # ABSTRACT: used for testing and as example $Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::Delete::VERSION = '0.89'; use strict; use warnings; use parent qw[ Exporter::Tiny ]; our @EXPORT_OK = ( qw[ fixture_response_quiet_without_errors ], ); sub fixture_response_quiet_without_errors { with_response_data => <<'EOXML'; EOXML } 1; __END__ =pod =encoding UTF-8 =head1 NAME Shared::Examples::Net::Amazon::S3::Operation::Bucket::Objects::Delete - used for testing and as example =head1 VERSION version 0.89 =head1 AUTHOR Leo Lapworth =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2020 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut