s3

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Carp;
   5 use Pod::Usage qw( pod2usage );
   6 use Getopt::Long qw( :config gnu_getopt );
   7 use English qw( -no_match_vars );
   8 my $VERSION = '0.0.1';
   9
  10 # Other recommended modules (uncomment to use):
  11 #  use IO::Prompt;
  12 #  use Readonly;
  13 use File::Basename qw( basename );
  14 use File::Spec::Functions qw( catfile );
  15 use Data::Dumper;
  16 $Data::Dumper::Indent = 1;
  17
  18 # Integrated logging facility
  19 use Log::Log4perl qw( :easy :no_extra_logdie_message );
  20 Log::Log4perl->easy_init({level => $WARN, layout => '[%d %-5p] %m%n'});
  21
  22 use Net::Amazon::S3;
  23 use Config::Tiny;
  24
  25 my %config = (
  26    configfile    => "$ENV{HOME}/.aws",
  27    'load-config' => 1,
  28    data          => '',
  29 );
  30 GetOptions(
  31    \%config,
  32    qw(
  33      usage! help! man! version!
  34      id=s secret=s
  35      delimiter=s max-keys=s marker=s dir! ls! l!
  36      meta|m=s@ header|h=s@ acl=s data=s
  37      clear! add=s@ del=s@
  38      )
  39 );
  40 pod2usage(message => "$0 $VERSION", -verbose => 99, -sections => ' ')
  41   if $config{version};
  42 pod2usage(-verbose => 99, -sections => 'USAGE') if $config{usage};
  43 pod2usage(-verbose => 99, -sections => 'USAGE|EXAMPLES|OPTIONS')
  44   if $config{help};
  45 pod2usage(-verbose => 2) if $config{man};
  46
  47 # Script implementation here
  48 if ($config{'load-config'} && -r $config{configfile}) {
  49    my $tiny = Config::Tiny->read($config{configfile})->{_};
  50    while (my ($k, $v) = each %$tiny) {
  51       next if exists $config{$k};
  52       $config{$k} = $v;
  53    }
  54 } ## end if ($config{'load-config'...
  55
  56 my $target  = 'Object';
  57 my $command = lc shift @ARGV;
  58 if ($command eq 'bucket') {
  59    $target  = 'Bucket';
  60    $command = lc shift @ARGV;
  61 }
  62
  63 $command =~ s/^_+//;
  64
  65 DEBUG "command: $command";
  66
  67 my $sub = Operations->can($command)
  68   or LOGDIE "unknown command '$command'";
  69
  70 my $s3 = Net::Amazon::S3->new(
  71    {
  72       aws_access_key_id     => $config{id},
  73       aws_secret_access_key => $config{secret},
  74       retry                 => 1,
  75    }
  76 );
  77
  78 $sub->($s3, \%config, @ARGV);
  79
  80 sub s3path_split {
  81    my ($s3path) = @_;
  82    LOGDIE "no s3path" unless defined $s3path;
  83
  84    for my $regex (
  85 qr{\A (?: : | s3:// | http://s3.amazonaws.com/ ) ([^/]+) (?: / (.*))?}mxs,
  86       qr{\A http:// (.+?) \.s3\.amazonaws\.com (?: / (.*))?}mxs,
  87       qr{\A http:// ([^/]+) (?: / (.*))?}mxs,    # keep as last option
  88      )
  89    {
  90       if (my ($bucket, $key) = $s3path =~ /$regex/) {
  91          return ($bucket, $key);
  92       }
  93    } ## end for my $regex (...
  94    return;
  95 } ## end sub s3path_split
  96
  97 sub is_s3path {
  98    return scalar s3path_split($_[0]);
  99 }
 100
 101 sub fh2fh {
 102    my ($ifh, $ofh) = @_;
 103    while (1) {
 104       my $nread = read($ifh, my $buffer, 4096);
 105       LOGDIE "read(): $OS_ERROR" unless defined $nread;
 106       last unless $nread;
 107       print {$ofh} $buffer
 108         or LOGDIE "print(): $OS_ERROR";
 109    } ## end while (1)
 110    return;
 111 } ## end sub fh2fh
 112
 113 sub cp_local {
 114    my ($src, $dst) = @_;
 115
 116    # Copy the file locally...
 117    my @src_stat = stat $src or LOGDIE "stat(): $OS_ERROR";
 118
 119    $dst = resolve_dst($dst, $src);
 120    my @dst_stat = stat $dst;
 121    LOGDIE "refusing to copy '$src' onto itself"
 122      if @dst_stat
 123         && ($src_stat[0] == $dst_stat[0])
 124         && ($src_stat[1] == $dst_stat[1]);
 125
 126    open my $ifh, '<', $src
 127      or LOGDIE "open('$src'): $OS_ERROR";
 128    binmode $ifh;
 129    open my $ofh, '>', $dst
 130      or LOGDIE "open('$dst'): $OS_ERROR";
 131    binmode $ofh;
 132
 133    fh2fh($ifh, $ofh);
 134
 135    close $ofh or LOGDIE "close('$dst'): $OS_ERROR";
 136    close $ifh;
 137 } ## end sub cp_local
 138
 139 sub resolve_dst {
 140    my ($dst, $src) = @_;
 141
 142    return is_s3path($dst)
 143      ? ((substr($dst, -1, 1) eq '/') ? $dst . basename($src) : $dst)
 144      : ((-d $dst) ? catfile($dst, basename($src)) : $dst);
 145 } ## end sub resolve_dst
 146
 147 package Operations;
 148 use strict;
 149 use warnings;
 150 use Log::Log4perl qw( :easy :no_extra_logdie_message );
 151 use Data::Dumper;
 152 use English qw( -no_match_vars );
 153
 154 sub _canonical {
 155    my ($bucket, $key) = @_;
 156    $key = '' unless defined $key;
 157    return "http://$bucket.s3.amazonaws.com/$key";
 158 }
 159
 160 sub list {
 161    my ($s3, $config, $s3path) = @_;
 162
 163    if (scalar(@_) == 2) {
 164       DEBUG 'getting buckets list';
 165       my $response = $s3->buckets() or LOGDIE $s3->err();
 166       for my $bucket (@{$response->{buckets}}) {
 167          (my $date = $bucket->creation_date()) =~ s/T/ /;
 168          print {*STDOUT} $date, ' ', _canonical($bucket->bucket()), "\n";
 169       }
 170       return;
 171    } ## end if (scalar(@_) == 2)
 172
 173    my ($bucket, $prefix) = main::s3path_split($s3path);
 174    my %parameters = (bucket => $bucket);
 175    $parameters{prefix} = $prefix if defined $prefix;
 176
 177    for my $field (qw( delimiter max-keys marker )) {
 178       $parameters{$field} = $config->{$field}
 179         if exists $config->{$field};
 180    }
 181
 182    if ($config->{ls}) {
 183       $parameters{prefix} = ''
 184         unless defined($parameters{prefix});
 185       $parameters{prefix} .= '/'
 186         if length($parameters{prefix})
 187            && substr($parameters{prefix}, -1, 1) ne '/';
 188       $parameters{delimiter} = '/';
 189    } ## end if ($config->{ls})
 190
 191    DEBUG Dumper \%parameters;
 192
 193    my $response =
 194      (exists($parameters{'max-keys'}) || exists($parameters{marker}))
 195      ? $s3->list_bucket(\%parameters)
 196      : $s3->list_bucket_all(\%parameters);
 197    $response or LOGDIE $s3->err();
 198    DEBUG Dumper($response);
 199
 200    for my $file (@{$response->{common_prefixes} || []},
 201       @{$response->{keys} || []})
 202    {
 203       my ($name, $date, $size, $owner) =
 204         ($file . '/', '1970-01-01T00:00:00.000Z', 0, '-', 0);
 205       ($name, $date, $size, $owner) =
 206         @{$file}{qw(key last_modified size owner_displayname)}
 207         if ref $file;
 208       $name = _canonical($bucket, $name);
 209       $date =~ s/T/ /;
 210
 211       if ($config{l}) {    # a-la ls -l
 212          print {*STDOUT} "---------- 1 $owner $owner $size $date $name\n";
 213       }
 214       else {               # simply the name
 215          print {*STDOUT} $name, "\n";
 216       }
 217    } ## end for my $file (@{$response...
 218
 219    print {*STDOUT} ":next-marker $response->{next_marker}\n"
 220      if $response->{is_truncated};
 221
 222    return;
 223 } ## end sub list
 224
 225 sub ls {
 226    my ($s3, $config, @rest) = @_;
 227    LOGDIE 'no bucket or path' unless @rest;
 228    list($s3, {%$config, ls => 1}, $_) for @rest;
 229    return;
 230 } ## end sub ls
 231
 232 sub dir {
 233    my ($s3, $config, @rest) = @_;
 234    return ls($s3, {%$config, l => 1}, @rest);
 235 }
 236
 237 sub add {
 238    my ($s3, $config, $s3path, $filename) = @_;
 239
 240    my ($bucket, $key) = main::s3path_split($s3path);
 241
 242    LOGDIE "no bucket" unless defined($bucket);
 243    return create($s3, $config, $bucket) unless defined $key;
 244
 245    my %options;
 246    for my $meta (@{$config->{meta} || []}) {
 247       my ($name, $value) = split /:/, $meta, 2;
 248       $options{'x-amz-meta-' . lc($name)} = $value;
 249    }
 250    for my $header (@{$config->{header} || []}) {
 251       my ($name, $value) = split /:/, $header, 2;
 252       $options{$name} = $value;
 253    }
 254    $options{'x-amz-acl'} = $config->{acl}
 255      if exists $config->{acl};
 256
 257    my $bucket_obj = $s3->bucket($bucket);
 258    my $response =
 259      defined($filename)
 260      ? $bucket_obj->add_key_filename($key, $filename, \%options)
 261      : $bucket_obj->add_key($key, $config->{data}, \%options);
 262    LOGDIE $s3->err() unless $response;
 263
 264    INFO "key '$key' successfully created in bucket '$bucket'";
 265    return;
 266 } ## end sub add
 267
 268 sub create {
 269    my ($s3, $config, $bucket) = @_;
 270    INFO "adding bucket '$bucket'";
 271    my %parameters = (bucket => $bucket);
 272    $parameters{acl_short} = $config->{acl} if exists $config->{acl};
 273    $parameters{location_constraint} = $config->{location}
 274      if exists $config->{location};
 275    $s3->add_bucket(\%parameters) or LOGDIE $s3->err();
 276    INFO "bucket '$bucket' correctly created";
 277    return;
 278 } ## end sub create
 279
 280 sub copy {
 281    my ($s3, $config, $src, $dst) = @_;
 282
 283    LOGDIE "no parameters" unless defined $src;
 284    my ($src_bucket, $src_key) = main::s3path_split($src);
 285    LOGDIE "invalid source" unless defined $src_key;
 286
 287    LOGDIE "no destination" unless defined $dst;
 288    my ($dst_bucket, $dst_key) = main::s3path_split($dst);
 289    LOGDIE "invalid destination" unless defined $dst_key;
 290
 291    LOGDIE "refusing to copy '$src' onto itself"
 292      if ($src_bucket eq $dst_bucket) && ($src_key eq $dst_key);
 293
 294    my %options;
 295    for my $meta (@{$config->{meta} || []}) {
 296       my ($name, $value) = split /:/, $meta, 2;
 297       $options{'x-amz-meta-' . lc($name)} = $value;
 298    }
 299    for my $header (@{$config->{header} || []}) {
 300       my ($name, $value) = split /:/, $header, 2;
 301       $options{$name} = $value;
 302    }
 303    $options{'x-amz-acl'} = $config->{acl}
 304      if exists $config->{acl};
 305
 306    $s3->bucket($dst_bucket)
 307      ->copy_key($dst_key, "/$src_bucket/$src_key", \%options)
 308      or LOGDIE $s3->err();
 309
 310    INFO "copied '$dst' from '$src'";
 311    return;
 312 } ## end sub copy
 313
 314 sub get {
 315    my ($s3, $config, $s3path, $filename) = @_;
 316
 317    my ($bucket, $key) = main::s3path_split($s3path);
 318    LOGDIE "no key in '$s3path'" unless defined $key;
 319
 320    my $response;
 321    eval {
 322       my $bobj = $s3->bucket($bucket);
 323       $response =
 324         defined($filename)
 325         ? $bobj->get_key_filename($key, 'GET',
 326          main::resolve_dst($filename, $key))
 327         : $bobj->get_key($key);
 328       1;
 329    } or LOGDIE "server error getting '$s3path': ", $s3->err();
 330
 331    LOGDIE "missing content for '$s3path'" unless defined $response;
 332    print {*STDOUT} $response->{value};
 333
 334    return;
 335 } ## end sub get
 336
 337 =begin comment
 338
 339 Can perform both cp and mv, this is only the "framework" logic
 340 that uses $callback_for in order to understand which operations
 341 has to be applied exactly in the different situations. The
 342 $callback_for is an hash reference with the following keys:
 343
 344  l2l - local to local
 345  l2r - local to remote (S3)
 346  r2l - remote (S3) to local
 347  r2r - remote (S3) to remote (S3)
 348
 349 =end comment
 350
 351 =cut
 352
 353 sub _cp_or_mv {
 354    my ($callback_for, $s3, $config, @list) = @_;
 355
 356    LOGDIE "no parameters" unless @list;
 357    my $dst = pop @list;
 358    LOGDIE "no destination" unless @list > 0;
 359
 360    if (main::is_s3path($dst)) {    # dst is in S3
 361       LOGDIE "$dst should end with '/' with more than one source"
 362         if (@list > 1) && (substr($dst, -1, 1) ne '/');
 363       for my $src (@list) {
 364          my $this_dst = main::resolve_dst($dst, $src);
 365          if (main::is_s3path($src)) {
 366             $callback_for->{r2r}->($s3, $config, $src, $this_dst);
 367          }
 368          else {
 369             my %config = %$config;
 370
 371             if (!grep { m/^content[_-]type:/imxs }
 372                @{$config{header} || []})
 373             {
 374                require LWP::MediaTypes;
 375                my $ct = LWP::MediaTypes::guess_media_type($src);
 376                INFO "Content-Type for '$src' set to $ct";
 377                unshift @{$config{header}}, 'Content-Type:' . $ct;
 378             } ## end if (!grep { m/^content[_-]type:/imxs...
 379
 380             unshift @{$config{meta}}, 'stat:' . join ',', stat $src;
 381
 382             $callback_for->{l2r}->($s3, \%config, $src, $this_dst);
 383          } ## end else [ if (main::is_s3path($src...
 384       } ## end for my $src (@list)
 385    } ## end if (main::is_s3path($dst...
 386    else {    # dst is local
 387       LOGDIE "$dst should be a directory with more than one source"
 388         if (@list > 1) && !-d $dst;
 389       main::is_s3path($_)
 390         ? $callback_for->{r2l}->($s3, $config, $_, $dst)
 391         : $callback_for->{l2l}->($_, $dst)
 392         for @list;
 393    } ## end else [ if (main::is_s3path($dst...
 394
 395    return;
 396 } ## end sub cp
 397
 398 sub cp {
 399    return _cp_or_mv({
 400       r2r => \&copy,
 401       l2r => sub {
 402          my ($s3, $config, $src, $dst) = @_;
 403          add($s3, $config, $dst, $src); # swap dst and src for add!
 404       },
 405       r2l => \&get,
 406       l2l => \&main::cp_local,
 407    }, @_);
 408 }
 409
 410 sub mv {
 411    return _cp_or_mv({
 412       r2r => sub {
 413          copy(@_);
 414          _delete(@_);
 415       },
 416       l2r => sub {
 417          my ($s3, $config, $src, $dst) = @_;
 418          add($s3, $config, $dst, $src); # swap dst and src for add!
 419          unlink $src or LOGDIE "could not delete '$src': $OS_ERROR";
 420          return;
 421       },
 422       r2l => sub {
 423          get(@_);
 424          _delete(@_);
 425       },
 426       l2l => sub {
 427          my ($src, $dst) = @_;
 428
 429          # Try a simple rename, if possible
 430          rename($src, $dst) and return;
 431
 432          # Fall back to copy-and-delete
 433          main::cp_local($src, $dst);
 434          unlink $src or LOGDIE "could not delete '$src': $OS_ERROR";
 435
 436          return;
 437       },
 438    }, @_);
 439 }
 440
 441
 442 sub cat {
 443    my ($s3, $config, @paths) = @_;
 444    for my $path (@paths) {
 445       if (main::is_s3path($path)) {
 446          get($s3, $config, $path);
 447       }
 448       else {
 449          open my $fh, '<', $path
 450            or LOGDIE "open('$path'): $OS_ERROR";
 451          main::fh2fh($fh, \*STDOUT);
 452       }
 453    } ## end for my $path (@paths)
 454    return;
 455 } ## end sub cat
 456
 457 sub show {
 458    my ($s3, $config, $s3path) = @_;
 459
 460    my ($bucket, $key) = main::s3path_split($s3path);
 461    LOGDIE "no key in '$s3path'" unless defined $key;
 462
 463    my $response;
 464    eval {
 465       $response = $s3->bucket($bucket)->head_key($key);
 466       1;
 467    } or LOGDIE "server error getting '$s3path' metadata: ", $s3->err();
 468
 469    LOGDIE "'$s3path': no such s3path"
 470      unless defined $response;
 471
 472    delete $response->{value};
 473    for my $header (sort keys %$response) {
 474       (my $hname = $header) =~ s/_/-/g;
 475       next if ($hname ne $header) && exists $response->{$hname};
 476       print {*STDOUT} "$header: $response->{$header}\n";
 477    }
 478
 479    return;
 480 } ## end sub show
 481
 482 sub _set_meta {
 483    my ($s3, $config, $hmeta, $bucket, $key) = @_;
 484
 485    $hmeta = {} if $config->{clear};
 486
 487    for my $deletion (@{$config->{del} || []}) {
 488       my ($target, $value) = split /:/, $deletion, 2;
 489       $target = lc "x-amz-meta-$target";
 490       next unless exists $hmeta->{$target};
 491       $value = $hmeta->{$target} unless defined $value;
 492       delete $hmeta->{$target} if $hmeta->{$target} eq $value;
 493    } ## end for my $deletion (@{$config...
 494
 495    for my $addition (@{$config->{add} || []}) {
 496       my ($target, $value) = split /:/, $addition, 2;
 497       $hmeta->{lc("x-amz-meta-$target")} = $value;
 498    }
 499
 500    $s3->bucket($bucket)->edit_metadata($key, $hmeta)
 501      or LOGDIE 'editing metadata failed: ', $s3->err();
 502    return;
 503 } ## end sub _set_meta
 504
 505 sub meta {
 506    my ($s3, $config, $s3path) = @_;
 507
 508    my ($bucket, $key) = main::s3path_split($s3path);
 509    LOGDIE "no key in '$s3path'" unless defined $key;
 510
 511    my $response;
 512    eval {
 513       $response = $s3->bucket($bucket)->head_key($key);
 514       1;
 515    } or LOGDIE "server error getting '$s3path' metadata: ", $s3->err();
 516
 517    LOGDIE "'$s3path': no such s3path"
 518      unless defined $response;
 519
 520    my %meta =
 521      map { lc($_) => $response->{$_} }
 522      grep { m/^x-amz-meta-/mxsi } keys %$response;
 523
 524    return _set_meta($s3, $config, \%meta, $bucket, $key)
 525      if exists($config->{clear})
 526         || exists($config->{add})
 527         || exists($config{del});
 528
 529    for my $meta (sort keys %meta) {
 530       (my $name = $meta) =~ s/^x-amz-meta-//mxsi;
 531       print {*STDOUT} "$name: $response->{$meta}\n";
 532    }
 533
 534    return;
 535 } ## end sub meta
 536
 537 sub _set_acl {
 538    my ($s3, $config, $acl, $bucket, $key) = @_;    # yes, @key as array
 539
 540    $acl->clear() if $config->{clear};
 541
 542    for my $deletion (@{$config->{del} || []}) {
 543       my ($target, $permission) = split /:/, $deletion, 2;
 544       $acl->delete($target, $permission);
 545    }
 546
 547    for my $addition (@{$config->{add} || []}) {
 548       my ($target, $permission) = split /:/, $addition, 2;
 549       $acl->add($target, $permission);
 550    }
 551
 552    INFO "setting ACL:\n", $acl->stringify();
 553
 554    my %conf = (acl => $acl);
 555    $conf{key} = $key if defined $key;
 556    $s3->bucket($bucket)->set_acl(\%conf)
 557      or LOGDIE "setting ACL: ", $s3->err();
 558
 559    return;
 560 } ## end sub _set_acl
 561
 562 sub acl {
 563    return _acl_noACL(@_) unless Net::Amazon::S3::ACL->can('new');
 564
 565    my ($s3, $config, $s3path) = @_;
 566
 567    my ($bucket, $key) = main::s3path_split($s3path);
 568    my $acl = $s3->bucket($bucket)->get_acl({key => $key});
 569
 570    LOGDIE "could not get ACL for '$s3path': ", $s3->err()
 571      unless $acl;
 572
 573    return _set_acl($s3, $config, $acl, $bucket, $key)
 574      if exists($config->{clear})
 575         || exists($config->{add})
 576         || exists($config{del});
 577
 578    print {*STDOUT} $acl->stringify();
 579
 580    return;
 581 } ## end sub acl
 582
 583 sub _acl_noACL {
 584    my ($s3, $config, $s3path) = @_;
 585
 586    LOGDIE 'sorry, get Net::Amazon::S3::ACL to set up the ACL'
 587      if exists($config->{clear})
 588         || exists($config->{add})
 589         || exists($config{del});
 590
 591    my ($bucket, $key) = main::s3path_split($s3path);
 592    my $acl = $s3->bucket($bucket)->get_acl($key);
 593
 594    LOGDIE "could not get ACL for '$s3path': ", $s3->err()
 595      unless $acl;
 596
 597    print {*STDOUT} $acl;
 598    return;
 599 }
 600
 601 sub _delete {
 602    my ($s3, $config, $s3path) = @_;
 603
 604    my ($bucket, $key) = main::s3path_split($s3path);
 605
 606    my $bobj = $s3->bucket($bucket);
 607    if (!defined $key) {    # bucket-oriented operation
 608       INFO "deleting bucket '$bucket'";
 609       $bobj->delete_bucket() or LOGDIE $s3->err();
 610    }
 611    else {
 612       INFO "deleting key '$key' in bucket '$bucket'";
 613       $bobj->delete_key($key)
 614         or LOGDIE "unable to delete '$s3path': ", $s3->err();
 615    }
 616
 617    return;
 618 } ## end sub _delete
 619
 620 {
 621    no warnings;
 622    *delete = \&delete;
 623 }
 624
 625 sub locate {
 626    my ($s3, $config, $s3path) = @_;
 627
 628    my ($bucket, $key) = main::s3path_split($s3path);
 629    my $response = $s3->bucket($bucket)->get_location_constraint()
 630      || '(plausibly US)';
 631    print {*STDOUT} $response, "\n";
 632
 633    return;
 634 } ## end sub locate
 635
 636 sub rm {
 637    my ($s3, $config, @list) = @_;
 638    _delete($s3, $config, $_) for @list;
 639    return;
 640 }
 641
 642 __END__
 643
 644 =head1 NAME
 645
 646 s3 - command-line utility to interact with S3
 647
 648 =head1 VERSION
 649
 650 Ask the version number to the script itself, calling:
 651
 652    shell$ s3 --version
 653
 654 =head1 USAGE
 655
 656    s3 [--usage] [--help] [--man] [--version]
 657
 658    # generic options, valid for all commands
 659    s3 <command> [--id <id>] [--secret <string>] [<options...>]
 660
 661    # "pure" commands
 662    s3 acl    [--clear] [--add <spec>] [--del <spec>] <s3path>
 663
 664    s3 add    [--meta <meta>] [--header <header>] [--acl <acl>]
 665              [--data <data>] [--location <place>] <s3path> [<filename>]
 666
 667    s3 copy   [--meta <meta>] [--header <header>] [--acl <acl>]
 668              <s3path-src> <s3path-dst>
 669
 670    s3 create [--acl <acl>] [--location <location>] <bucket-name>
 671
 672    s3 delete <s3path>
 673
 674    s3 get    <s3path> [<filename|dirname>]
 675
 676    s3 list   [--ls] [-l] [--delimiter <string>] [--max-keys <n>]
 677              [--marker <n>] [<s3path>]
 678
 679    s3 locate <s3path>
 680
 681    s3 meta   [--clear] [--add <spec>] [--del <spec>] <s3path>
 682
 683    s3 show   <s3path>
 684
 685    # "filesyste-oriented" commands
 686    s3 cat [<filename|s3path>] ...
 687
 688    s3 cp  <src> [<src2> [<src3 ...]] <dst>
 689
 690    s3 dir [--delimiter <string>] [--max-keys <n>]
 691           [--marker <n>] [<s3path>]
 692
 693    s3 ls  [-l] [--delimiter <string>] [--max-keys <n>]
 694           [--marker <n>] [<s3path>]
 695
 696    s3 rm  <s3path> [<s3path2> [<s3path3> ...]]
 697
 698
 699 =head1 EXAMPLES
 700
 701    # list all buckets
 702    s3 list
 703
 704    # create two buckets
 705    s3 create mybucket
 706    s3 add mybucket-x
 707
 708    # locate a bucket
 709    s3 localte :mybucket
 710
 711    # list keys
 712    s3 list :mybucket
 713    s3 list :mybucket/some/prefix
 714    s3 ls :mybucket/some/directory
 715    s3 ls -l :mybucket/some/directory/extended-print
 716    s3 dir :mybucket/ditto/as/above
 717
 718    # create a key
 719    s3 add :mybucket/empty
 720    s3 add :mybucket/cmdline-data --data 'Hello, World!'
 721    s3 add :mybucket/fromfile /path/to/somefile
 722
 723    # get contents of one or more keys
 724    s3 get :mybucket/key
 725    s3 get :mybucket/tofile /path/to/destination
 726    s3 cat :mybucket/key :mybucket-x/key-x
 727
 728    # make copies...
 729    s3 copy :mybucket/source :mybucket-x/destination-copy
 730    s3 cp /path/to/localfile :mybucket/remote
 731    s3 cp /local/file :mybucket/remote/file /path/to/localdir
 732    s3 cp /local/file :mybucket/remote/file :mybucket-x/path/to/remotedir/
 733
 734    # move stuff
 735    s3 mv :mybucket/something /path/to/local
 736    s3 mv /path/to/something :mybucket/remote
 737    s3 mv /local/file :mybucket/remote/file :mybucket-x/path/to/remotedir/
 738
 739    # get headers
 740    s3 show :mybucket/somekey
 741
 742    # get/set metadata
 743    s3 meta :mybucket/somekey
 744    s3 meta :mybucket/somekey --add colour:green --del taste:awful
 745
 746    # get/set ACL
 747    s3 acl :mybucket
 748    s3 acl :mybucket/somekey
 749    s3 acl :mybucket/somekey --add any:read --del foo@example.com
 750
 751    # finally, delete stuff
 752    s3 delete :mybucket/somekey
 753    s3 delete :mybucket-x
 754    s3 rm :mybucket
 755
 756 =head1 DESCRIPTION
 757
 758 =for l'autore, da riempire:
 759    Fornite una descrizione completa del modulo e delle sue caratteristiche.
 760    Aiutatevi a strutturare il testo con le sottosezioni (=head2, =head3)
 761    se necessario.
 762
 763 =head2 S3 paths
 764
 765 We use the term I<s3path> to indicate an identifier for a S3 resource.
 766 A I<s3path> can be any of the following:
 767
 768    :bucket
 769    :bucket/prefix
 770
 771    s3://bucket
 772    s3://bucket/prefix
 773
 774    http://s3.amazonaws.com/bucket
 775    http://s3.amazonaws.com/bucket/prefix
 776
 777    http://bucket.s3.amazonaws.com/
 778    http://bucket.s3.amazonaws.com/prefix
 779
 780    http://bucket
 781    http://bucket/prefix
 782
 783 The forms with the I<bucket> only are I<improper s3path>s, while the
 784 other ones are I<proper s3path>s because they include a I<key>/I<prefix>
 785 as well. When the I<prefix> resolves to a I<key> we'll say that it's
 786 a I<full s3path>.
 787
 788
 789 =head2 Permissions
 790
 791 Permissions can be specified in the short or in the long form, depending
 792 on the command. In particular, only the L</acl> command support the long
 793 format, so we'll discuss the short one here.
 794
 795 The short format for specifying permissions is a single word that can
 796 be any of the following options (from the Amazon API documentation):
 797
 798 =over
 799
 800 =item B<< private >>
 801
 802 Owner gets FULL_CONTROL. No one else has any access
 803 rights.  This is the default.
 804
 805 =item B<< public-read >>
 806
 807 Owner gets FULL_CONTROL and the anonymous principal is
 808 granted READ access. If this policy is used on an object, it can be
 809 read from a browser with no authentication.
 810
 811 =item B<< public-read-write >>
 812
 813 Owner gets FULL_CONTROL, the anonymous principal
 814 is granted READ and WRITE access. This is a useful policy to apply
 815 to a bucket, if you intend for any anonymous user to PUT objects
 816 into the bucket.
 817
 818 =item B<< authenticated-read >>
 819
 820 Owner gets FULL_CONTROL, and any principal
 821 authenticated as a registered Amazon S3 user is granted READ
 822 access.
 823
 824 =back
 825
 826
 827
 828 =head1 OPTIONS
 829
 830 Each command can have its own options, but the following ones are either
 831 common to them all or meta-options.
 832
 833 =over
 834
 835 =item --help
 836
 837 print a somewhat more verbose help, showing usage, this description of
 838 the options and some examples from the synopsis.
 839
 840 =item --id <ID>
 841
 842 the Amazon AWS ID for the account to use. By default, it is read
 843 from F<~/.aws>.
 844
 845 =item --man
 846
 847 print out the full documentation for the script.
 848
 849 =item --secret <secret>
 850
 851 the secret shared with Amazon for signing requests. By default, it
 852 is read from F<~/.aws>.
 853
 854 =item --usage
 855
 856 print a concise usage line and exit.
 857
 858 =item --version
 859
 860 print the version of the script.
 861
 862 =back
 863
 864 =head1 COMMANDS
 865
 866 Most commands have different behaviours in the DWIM spirit.
 867
 868 The commands can be broadly divided into two main classes: the I<pure>
 869 S3 commands, and the ones that somehow impose a filesystem metaphor.
 870
 871 The I<pure> commands are a more or less direct mapping of the API that
 872 S3 exposes. It's well suited when you have to do S3 operations, e.g. as
 873 part of some scripting.
 874
 875 The I<filesystem>-oriented commands work under the assumption that
 876 keys are organised hyerarchically similarly to a filesystem; it's probably
 877 best suited when you want to somehow forget that you're dealing with S3,
 878 and want to get the job done while feeling at home.
 879
 880 =head2 I<Pure> Commands
 881
 882 =over
 883
 884 =item B<< acl [--clear] [--add <spec>] [--del <spec>] <s3path> >>
 885
 886 get or set the Access Control Policy for the given resource. Options
 887 are:
 888
 889 =over
 890
 891 =item --add <target>:<permission>
 892
 893 add/set the given permission to the given target. Can be given multiple
 894 times.
 895
 896 =item --clear
 897
 898 clear all the currently set permissions
 899
 900 =item --del <target>[:<permission>]
 901
 902 delete a permission. If the permission is specified, deletes the
 903 permission only if present; otherwise, the given target is wiped out.
 904 Can be given multiple times.
 905
 906 =back
 907
 908 B<NOTE>: to be able to set the ACL, you'll need L<Net::Amazon::S3::ACL> and
 909 a modified version of L<Net::Amazon::S3::Bucket> (hopefully the needed
 910 changes will be included in L<Net::Amazon::S3> some day). If you want, you
 911 can find the module and the patch at
 912 L<http://rt.cpan.org/Ticket/Display.html?id=38847> (take the stuff in the
 913 reply, ignore the first message).
 914
 915 =item B<< add [--meta <meta>] [--header <header>] [--acl <acl>] [--data <data>] [--location <place>] <s3path> [<filename>] >>
 916
 917 add a resource in S3.
 918
 919 If the path contains a bucket name only, then this command is simply a
 920 shortcut for the L</create> command, which creates the bucket. In this
 921 case, all parameters specific to L</add> are ignored.
 922
 923 If the path contains a key as well, then the relative object is
 924 created. In this case there are the following options:
 925
 926 =over
 927
 928 =item --acl <permission>
 929
 930 set the short permission (see L</Permissions>).
 931
 932 =item --data <data>
 933
 934 get the data to be put into the object from the command line; useful
 935 for one-shot file creations.
 936
 937 =item --header <name>:<value>
 938
 939 set the given header in the request to be sent to the server. Can
 940 be given multiple times.
 941
 942 =item --location <place>
 943
 944 see L</copy>.
 945
 946 =item --meta <name>:<value>
 947
 948 add metadata when creating the object; it's actually a shorthand
 949 for the I<header> option above. Can be given multiple times.
 950
 951 =back
 952
 953
 954 =item B<< copy [--meta <meta>] [--header <header>] [--acl <acl>]  <s3path-src> <s3path-dst> >>
 955
 956 copy one object into a new one, remotely.
 957
 958 During the copy, metadata are usually preserved unless you provide yours.
 959 The same does not apply to ACL, which defaults to... the default.
 960
 961 Options:
 962
 963 =over
 964
 965 =item --acl <permission>
 966
 967 set the short permission (see L</Permissions>).
 968
 969 =item --header <name>:<value>
 970
 971 set the given header in the request to be sent to the server. Can
 972 be given multiple times.
 973
 974 =item --meta <name>:<value>
 975
 976 add metadata when creating the object; it's actually a shorthand
 977 for the I<header> option above. Can be given multiple times.
 978
 979 =back
 980
 981 =item B<< create [--acl <acl>] [--location <location>] <bucket-name> >>
 982
 983 create a bucket. Options are:
 984
 985 =over
 986
 987 =item --acl <permission>
 988
 989 set the short permission (see L</Permissions>).
 990
 991 =item --location <place>
 992
 993 the location constraint for bucket storage. Currently, you can only
 994 specify C<EU>; otherwise, the bucket will be created in the phantomatic
 995 I<default location>, which should be in the U.S.
 996
 997 =back
 998
 999 =item B<< delete <s3path> >>
1000
1001 remove the given resource, whether it's a bucket or a fully qualified key.
1002
1003 =item B<< get <s3path> [<filename|dirname>] >>
1004
1005 get the given object (I<s3path> must be a proper path).
1006
1007 If a filename is given, the object's contents are printed to the file.
1008
1009 If a directory name is given, the object's contents are saved into a file
1010 in the given directory. The filename will be derived by the object's key
1011 using the C<basename> function in L<File::Basename>.
1012
1013 By default, the object's contents will be printed to standard output.
1014
1015 =item B<< list [--ls] [-l] [--delimiter <string>] [--max-keys <n>] [--marker <n>] [s3path>] >>
1016
1017 If issued without any parameter, the list of buckets will be printed.
1018
1019 If the I<s3path> is improper (i.e. it only contains the bucket name),
1020 then the full list of objects in the bucket is printed out.
1021
1022 If the I<s3path> is proper, two possible behaviours are possible:
1023
1024 =over
1025
1026 =item *
1027
1028 if L</--ls> is given the I<prefix> in the
1029 I<s3path> is regarded as an equivalent I<directory name> and the contents
1030 of this I<virtual directory> are printed out. In this case, the I<prefix>
1031 is automatically appended with a forward slash C</> if it lack one, and
1032 the search is set with the forward slash C</> delimiter.
1033
1034 =item *
1035
1036 otherwise, all objects matching the given I<prefix> are printed out.
1037
1038 =back
1039
1040 Options:
1041
1042 =over
1043
1044 =item --ls
1045
1046 treat the keys as UNIX-style paths, and mimic what the C<ls> command would
1047 do. This option implies L</--delimiter> set to C</>.
1048
1049 =item -l
1050
1051 be verbose when printing out. When a list of keys is printed, it vaguely
1052 resembles what the command C<ls -l> does.
1053
1054 =item --delimiter <string>
1055
1056 =item --max-keys <n>
1057
1058 =item --marker <n>
1059
1060 See Amazon AWS documentation for these three parameters. The first one
1061 allows you to restrict the output list by summarising keys, while the other
1062 two allow for pagination (by default any pagination is handled automatically,
1063 at the expense of making repeated calls under the hood).
1064
1065 =back
1066
1067
1068 =item B<< locate <s3path> >>
1069
1070 get the location for the given resource (this is actually the location
1071 of the bucket). Note that, due to an inconsistent behaviour in
1072 L<Net::Amazon::S3>, you can't be certain if a given bucket is in the
1073 I<default> location or if an error occurred.
1074
1075 =item B<< meta [--clear] [--add <spec>] [--del <spec>] <s3path> >>
1076
1077 change the metadata for the given resource. Options:
1078
1079 =over
1080
1081 =item --add <name>:<value>
1082
1083 add the given metadata.
1084
1085 =item --clear
1086
1087 remove all metadata.
1088
1089 =item --del <name>[:<value>]
1090
1091 delete the metadata given by I<name>. If a I<value> is present, then the
1092 metadata is removed only if its current value is equal to I<value>.
1093
1094 =back
1095
1096 =item B<< show <s3path> >>
1097
1098 get information about the given object (I<s3path> must be a fully qualified
1099 one). These info include all the headers of a HEAD request for the given
1100 resource.
1101
1102 =back
1103
1104 =head2 I<Filesystem-Oriented> Commands
1105
1106 These commands rely upon the assumption that the keys for the objects
1107 can be treated like normal UNIX paths in a filesystem. Each command tries
1108 to reproduce the corresponding system command, at least in its basic
1109 functionality.
1110
1111 =over
1112
1113 =item B<< cat [<filename|s3path>] ... >>
1114
1115 output the given resources. Note that you can intermix local files and
1116 remote I<s3path>s.
1117
1118 =item B<< cp  <src> [<src2> [<src3 ...]] <dst> >>
1119
1120 make a copy. Both the source and the destinations can be (independently)
1121 in the local system or in the S3 one. Yes, also the local copy should
1122 work.
1123
1124 Like the C<cp> system command, if you want to specify more than two
1125 arguments the last one must be a directory. For the local filesystem the
1126 check is straightforward; for the remote one the destination must end with
1127 a slash.
1128
1129 If the destination is a directory, the target filename will be derived
1130 by the corresponding source filename by means of C<basename> in
1131 L<File::Basename>.
1132
1133 =item B<< dir [--delimiter <string>] [--max-keys <n>] [--marker <n>] [<s3path>] >>
1134
1135 same as command L</ls> with the C<-l> option.
1136
1137 =item B<< ls  [-l] [--delimiter <string>] [--max-keys <n>] [--marker <n>] [<s3path>] >>
1138
1139 same as the L</list> command, with the L</--ls> option.
1140
1141 =item B<< mv  <src> [<src2> [<src3 ...]] <dst> >>
1142
1143 move resources. Both the source and the destinations can be (independently)
1144 in the local system or in the S3 one. Yes, also the local mv should
1145 work.
1146
1147 Like the C<mv> system command, if you want to specify more than two
1148 arguments the last one must be a directory. For the local filesystem the
1149 check is straightforward; for the remote one the destination must end with
1150 a slash.
1151
1152 If the destination is a directory, the target filename will be derived
1153 by the corresponding source filename by means of C<basename> in
1154 L<File::Basename>.
1155
1156 B<NOTE>: the "mv" is more or less implemented as a copy-then-delete. If
1157 the deletion isn't successful, the copy is B<NOT> deleted. This is
1158 regarded as a feature, considering that traffic wit S3 is paid.
1159
1160 =item B<< rm <s3path> [<s3path2> [<s3path3> ...]] >>
1161
1162 remove the given resources.
1163
1164 =back
1165
1166
1167 =head1 DIAGNOSTICS
1168
1169 Any error coming from AWS S3 is printed on the standard output.
1170
1171
1172 =head1 CONFIGURATION AND ENVIRONMENT
1173
1174 s3 reads its configuration from F<~/.aws>. It should be an INI-style
1175 file like this:
1176
1177    id = your-AWS-id
1178    secret = your-AWS-secret
1179
1180
1181 =head1 DEPENDENCIES
1182
1183 =over
1184
1185 =item *
1186
1187 L<Net::Amazon::S3>
1188
1189 =item *
1190
1191 L<Net::Amazon::S3::ACL>, which will hopefully be included in
1192 L<Net::Amazon::S3>. This is only required if you want to play with
1193 ACLs.
1194
1195 =item *
1196
1197 L<Log::Log4perl>
1198
1199 =item *
1200
1201 L<Config::Tiny>
1202
1203 =back
1204
1205
1206 =head1 BUGS AND LIMITATIONS
1207
1208 No bugs have been reported.
1209
1210 Please report any bugs or feature requests through http://rt.cpan.org/
1211
1212 The "cp" and "mv" commands sort-of do what the system counterparts do
1213 when source and destination are in the local filesystem. The "sort-of"
1214 means that at the end you'll have a file in the destination that has
1215 the same contents of the source, and the source will be deleted if it's
1216 a "mv". Anything beyond this (e.g. permissions, etc.) is not handled.
1217
1218 An interactive mode could be added.
1219
1220
1221 =head1 AUTHOR
1222
1223 Flavio Poletti C<flavio@polettix.it>
1224
1225
1226 =head1 LICENCE AND COPYRIGHT
1227
1228 Copyright (c) 2008, Flavio Poletti C<flavio@polettix.it>. All rights reserved.
1229
1230 This script is free software; you can redistribute it and/or
1231 modify it under the same terms as Perl itself. See L<perlartistic>
1232 and L<perlgpl>.
1233
1234 Questo script è software libero: potete ridistribuirlo e/o
1235 modificarlo negli stessi termini di Perl stesso. Vedete anche
1236 L<perlartistic> e L<perlgpl>.
1237
1238
1239 =head1 DISCLAIMER OF WARRANTY
1240
1241 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
1242 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
1243 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
1244 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
1245 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1246 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
1247 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
1248 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
1249 NECESSARY SERVICING, REPAIR, OR CORRECTION.
1250
1251 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
1252 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
1253 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
1254 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
1255 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
1256 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
1257 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
1258 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
1259 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
1260 SUCH DAMAGES.
1261
1262 =head1 NEGAZIONE DELLA GARANZIA
1263
1264 Poiché questo software viene dato con una licenza gratuita, non
1265 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
1266 dalle leggi applicabili. A meno di quanto possa essere specificato
1267 altrove, il proprietario e detentore del copyright fornisce questo
1268 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
1269 o implicita, includendo fra l'altro (senza però limitarsi a questo)
1270 eventuali garanzie implicite di commerciabilità e adeguatezza per
1271 uno scopo particolare. L'intero rischio riguardo alla qualità ed
1272 alle prestazioni di questo software rimane a voi. Se il software
1273 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
1274 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
1275
1276 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
1277 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
1278 di copyright, o qualunque altra parte che possa modificare, o redistribuire
1279 questo software così come consentito dalla licenza di cui sopra, potrà
1280 essere considerato responsabile nei vostri confronti per danni, ivi
1281 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
1282 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
1283 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
1284 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
1285 sostenute da voi o da terze parti o un fallimento del software ad
1286 operare con un qualsivoglia altro software. Tale negazione di garanzia
1287 rimane in essere anche se i dententori del copyright, o qualsiasi altra
1288 parte, è stata avvisata della possibilità di tali danneggiamenti.
1289
1290 Se decidete di utilizzare questo software, lo fate a vostro rischio
1291 e pericolo. Se pensate che i termini di questa negazione di garanzia
1292 non si confacciano alle vostre esigenze, o al vostro modo di
1293 considerare un software, o ancora al modo in cui avete sempre trattato
1294 software di terze parti, non usatelo. Se lo usate, accettate espressamente
1295 questa negazione di garanzia e la piena responsabilità per qualsiasi
1296 tipo di danno, di qualsiasi natura, possa derivarne.
1297
1298 =cut