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}->($s3, $config, $_, $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 => sub {
 407          my ($s3, $config, $src, $dst);
 408          main::cp_local($src, $dst);
 409       },
 410    }, @_);
 411 }
 412
 413 sub mv {
 414    return _cp_or_mv({
 415       r2r => sub {
 416          copy(@_);
 417          _delete(@_);
 418       },
 419       l2r => sub {
 420          my ($s3, $config, $src, $dst) = @_;
 421          add($s3, $config, $dst, $src); # swap dst and src for add!
 422          unlink $src or LOGDIE "could not delete '$src': $OS_ERROR";
 423          return;
 424       },
 425       r2l => sub {
 426          get(@_);
 427          _delete(@_);
 428       },
 429       l2l => sub {
 430          my ($s3, $config, $src, $dst) = @_;
 431
 432          # Try a simple rename, if possible
 433          rename($src, $dst) and return;
 434
 435          # Fall back to copy-and-delete
 436          main::cp_local($src, $dst);
 437          unlink $src or LOGDIE "could not delete '$src': $OS_ERROR";
 438
 439          return;
 440       },
 441    }, @_);
 442 }
 443
 444
 445 sub cat {
 446    my ($s3, $config, @paths) = @_;
 447    for my $path (@paths) {
 448       if (main::is_s3path($path)) {
 449          get($s3, $config, $path);
 450       }
 451       else {
 452          open my $fh, '<', $path
 453            or LOGDIE "open('$path'): $OS_ERROR";
 454          main::fh2fh($fh, \*STDOUT);
 455       }
 456    } ## end for my $path (@paths)
 457    return;
 458 } ## end sub cat
 459
 460 sub show {
 461    my ($s3, $config, $s3path) = @_;
 462
 463    my ($bucket, $key) = main::s3path_split($s3path);
 464    LOGDIE "no key in '$s3path'" unless defined $key;
 465
 466    my $response;
 467    eval {
 468       $response = $s3->bucket($bucket)->head_key($key);
 469       1;
 470    } or LOGDIE "server error getting '$s3path' metadata: ", $s3->err();
 471
 472    LOGDIE "'$s3path': no such s3path"
 473      unless defined $response;
 474
 475    delete $response->{value};
 476    for my $header (sort keys %$response) {
 477       (my $hname = $header) =~ s/_/-/g;
 478       next if ($hname ne $header) && exists $response->{$hname};
 479       print {*STDOUT} "$header: $response->{$header}\n";
 480    }
 481
 482    return;
 483 } ## end sub show
 484
 485 sub _set_meta {
 486    my ($s3, $config, $hmeta, $bucket, $key) = @_;
 487
 488    $hmeta = {} if $config->{clear};
 489
 490    for my $deletion (@{$config->{del} || []}) {
 491       my ($target, $value) = split /:/, $deletion, 2;
 492       $target = lc "x-amz-meta-$target";
 493       next unless exists $hmeta->{$target};
 494       $value = $hmeta->{$target} unless defined $value;
 495       delete $hmeta->{$target} if $hmeta->{$target} eq $value;
 496    } ## end for my $deletion (@{$config...
 497
 498    for my $addition (@{$config->{add} || []}) {
 499       my ($target, $value) = split /:/, $addition, 2;
 500       $hmeta->{lc("x-amz-meta-$target")} = $value;
 501    }
 502
 503    $s3->bucket($bucket)->edit_metadata($key, $hmeta)
 504      or LOGDIE 'editing metadata failed: ', $s3->err();
 505    return;
 506 } ## end sub _set_meta
 507
 508 sub meta {
 509    my ($s3, $config, $s3path) = @_;
 510
 511    my ($bucket, $key) = main::s3path_split($s3path);
 512    LOGDIE "no key in '$s3path'" unless defined $key;
 513
 514    my $response;
 515    eval {
 516       $response = $s3->bucket($bucket)->head_key($key);
 517       1;
 518    } or LOGDIE "server error getting '$s3path' metadata: ", $s3->err();
 519
 520    LOGDIE "'$s3path': no such s3path"
 521      unless defined $response;
 522
 523    my %meta =
 524      map { lc($_) => $response->{$_} }
 525      grep { m/^x-amz-meta-/mxsi } keys %$response;
 526
 527    return _set_meta($s3, $config, \%meta, $bucket, $key)
 528      if exists($config->{clear})
 529         || exists($config->{add})
 530         || exists($config{del});
 531
 532    for my $meta (sort keys %meta) {
 533       (my $name = $meta) =~ s/^x-amz-meta-//mxsi;
 534       print {*STDOUT} "$name: $response->{$meta}\n";
 535    }
 536
 537    return;
 538 } ## end sub meta
 539
 540 sub _set_acl {
 541    my ($s3, $config, $acl, $bucket, $key) = @_;    # yes, @key as array
 542
 543    $acl->clear() if $config->{clear};
 544
 545    for my $deletion (@{$config->{del} || []}) {
 546       my ($target, $permission) = split /:/, $deletion, 2;
 547       $acl->delete($target, $permission);
 548    }
 549
 550    for my $addition (@{$config->{add} || []}) {
 551       my ($target, $permission) = split /:/, $addition, 2;
 552       $acl->add($target, $permission);
 553    }
 554
 555    INFO "setting ACL:\n", $acl->stringify();
 556
 557    my %conf = (acl => $acl);
 558    $conf{key} = $key if defined $key;
 559    $s3->bucket($bucket)->set_acl(\%conf)
 560      or LOGDIE "setting ACL: ", $s3->err();
 561
 562    return;
 563 } ## end sub _set_acl
 564
 565 sub acl {
 566    return _acl_noACL(@_) unless Net::Amazon::S3::ACL->can('new');
 567
 568    my ($s3, $config, $s3path) = @_;
 569
 570    my ($bucket, $key) = main::s3path_split($s3path);
 571    my $acl = $s3->bucket($bucket)->get_acl({key => $key});
 572
 573    LOGDIE "could not get ACL for '$s3path': ", $s3->err()
 574      unless $acl;
 575
 576    return _set_acl($s3, $config, $acl, $bucket, $key)
 577      if exists($config->{clear})
 578         || exists($config->{add})
 579         || exists($config{del});
 580
 581    print {*STDOUT} $acl->stringify();
 582
 583    return;
 584 } ## end sub acl
 585
 586 sub _acl_noACL {
 587    my ($s3, $config, $s3path) = @_;
 588
 589    LOGDIE 'sorry, get Net::Amazon::S3::ACL to set up the ACL'
 590      if exists($config->{clear})
 591         || exists($config->{add})
 592         || exists($config{del});
 593
 594    my ($bucket, $key) = main::s3path_split($s3path);
 595    my $acl = $s3->bucket($bucket)->get_acl($key);
 596
 597    LOGDIE "could not get ACL for '$s3path': ", $s3->err()
 598      unless $acl;
 599
 600    print {*STDOUT} $acl;
 601    return;
 602 }
 603
 604 sub _delete {
 605    my ($s3, $config, $s3path) = @_;
 606
 607    my ($bucket, $key) = main::s3path_split($s3path);
 608
 609    my $bobj = $s3->bucket($bucket);
 610    if (!defined $key) {    # bucket-oriented operation
 611       INFO "deleting bucket '$bucket'";
 612       $bobj->delete_bucket() or LOGDIE $s3->err();
 613    }
 614    else {
 615       INFO "deleting key '$key' in bucket '$bucket'";
 616       $bobj->delete_key($key)
 617         or LOGDIE "unable to delete '$s3path': ", $s3->err();
 618    }
 619
 620    return;
 621 } ## end sub _delete
 622
 623 {
 624    no warnings;
 625    *delete = \&delete;
 626 }
 627
 628 sub locate {
 629    my ($s3, $config, $s3path) = @_;
 630
 631    my ($bucket, $key) = main::s3path_split($s3path);
 632    my $response = $s3->bucket($bucket)->get_location_constraint()
 633      || '(plausibly US)';
 634    print {*STDOUT} $response, "\n";
 635
 636    return;
 637 } ## end sub locate
 638
 639 sub rm {
 640    my ($s3, $config, @list) = @_;
 641    _delete($s3, $config, $_) for @list;
 642    return;
 643 }
 644
 645 __END__
 646
 647 =head1 NAME
 648
 649 s3 - command-line utility to interact with S3
 650
 651 =head1 VERSION
 652
 653 Ask the version number to the script itself, calling:
 654
 655    shell$ s3 --version
 656
 657 =head1 USAGE
 658
 659    s3 [--usage] [--help] [--man] [--version]
 660
 661    # generic options, valid for all commands
 662    s3 <command> [--id <id>] [--secret <string>] [<options...>]
 663
 664    # "pure" commands
 665    s3 acl    [--clear] [--add <spec>] [--del <spec>] <s3path>
 666
 667    s3 add    [--meta <meta>] [--header <header>] [--acl <acl>]
 668              [--data <data>] [--location <place>] <s3path> [<filename>]
 669
 670    s3 copy   [--meta <meta>] [--header <header>] [--acl <acl>]
 671              <s3path-src> <s3path-dst>
 672
 673    s3 create [--acl <acl>] [--location <location>] <bucket-name>
 674
 675    s3 delete <s3path>
 676
 677    s3 get    <s3path> [<filename|dirname>]
 678
 679    s3 list   [--ls] [-l] [--delimiter <string>] [--max-keys <n>]
 680              [--marker <n>] [<s3path>]
 681
 682    s3 locate <s3path>
 683
 684    s3 meta   [--clear] [--add <spec>] [--del <spec>] <s3path>
 685
 686    s3 show   <s3path>
 687
 688    # "filesyste-oriented" commands
 689    s3 cat [<filename|s3path>] ...
 690
 691    s3 cp  <src> [<src2> [<src3 ...]] <dst>
 692
 693    s3 dir [--delimiter <string>] [--max-keys <n>]
 694           [--marker <n>] [<s3path>]
 695
 696    s3 ls  [-l] [--delimiter <string>] [--max-keys <n>]
 697           [--marker <n>] [<s3path>]
 698
 699    s3 rm  <s3path> [<s3path2> [<s3path3> ...]]
 700
 701
 702 =head1 EXAMPLES
 703
 704    # list all buckets
 705    s3 list
 706
 707    # create two buckets
 708    s3 create mybucket
 709    s3 add mybucket-x
 710
 711    # locate a bucket
 712    s3 localte :mybucket
 713
 714    # list keys
 715    s3 list :mybucket
 716    s3 list :mybucket/some/prefix
 717    s3 ls :mybucket/some/directory
 718    s3 ls -l :mybucket/some/directory/extended-print
 719    s3 dir :mybucket/ditto/as/above
 720
 721    # create a key
 722    s3 add :mybucket/empty
 723    s3 add :mybucket/cmdline-data --data 'Hello, World!'
 724    s3 add :mybucket/fromfile /path/to/somefile
 725
 726    # get contents of one or more keys
 727    s3 get :mybucket/key
 728    s3 get :mybucket/tofile /path/to/destination
 729    s3 cat :mybucket/key :mybucket-x/key-x
 730
 731    # make copies...
 732    s3 copy :mybucket/source :mybucket-x/destination-copy
 733    s3 cp /path/to/localfile :mybucket/remote
 734    s3 cp /local/file :mybucket/remote/file /path/to/localdir
 735    s3 cp /local/file :mybucket/remote/file :mybucket-x/path/to/remotedir/
 736
 737    # move stuff
 738    s3 mv :mybucket/something /path/to/local
 739    s3 mv /path/to/something :mybucket/remote
 740    s3 mv /local/file :mybucket/remote/file :mybucket-x/path/to/remotedir/
 741
 742    # get headers
 743    s3 show :mybucket/somekey
 744
 745    # get/set metadata
 746    s3 meta :mybucket/somekey
 747    s3 meta :mybucket/somekey --add colour:green --del taste:awful
 748
 749    # get/set ACL
 750    s3 acl :mybucket
 751    s3 acl :mybucket/somekey
 752    s3 acl :mybucket/somekey --add any:read --del foo@example.com
 753
 754    # finally, delete stuff
 755    s3 delete :mybucket/somekey
 756    s3 delete :mybucket-x
 757    s3 rm :mybucket
 758
 759 =head1 DESCRIPTION
 760
 761 =for l'autore, da riempire:
 762    Fornite una descrizione completa del modulo e delle sue caratteristiche.
 763    Aiutatevi a strutturare il testo con le sottosezioni (=head2, =head3)
 764    se necessario.
 765
 766 =head2 S3 paths
 767
 768 We use the term I<s3path> to indicate an identifier for a S3 resource.
 769 A I<s3path> can be any of the following:
 770
 771    :bucket
 772    :bucket/prefix
 773
 774    s3://bucket
 775    s3://bucket/prefix
 776
 777    http://s3.amazonaws.com/bucket
 778    http://s3.amazonaws.com/bucket/prefix
 779
 780    http://bucket.s3.amazonaws.com/
 781    http://bucket.s3.amazonaws.com/prefix
 782
 783    http://bucket
 784    http://bucket/prefix
 785
 786 The forms with the I<bucket> only are I<improper s3path>s, while the
 787 other ones are I<proper s3path>s because they include a I<key>/I<prefix>
 788 as well. When the I<prefix> resolves to a I<key> we'll say that it's
 789 a I<full s3path>.
 790
 791
 792 =head2 Permissions
 793
 794 Permissions can be specified in the short or in the long form, depending
 795 on the command. In particular, only the L</acl> command support the long
 796 format, so we'll discuss the short one here.
 797
 798 The short format for specifying permissions is a single word that can
 799 be any of the following options (from the Amazon API documentation):
 800
 801 =over
 802
 803 =item B<< private >>
 804
 805 Owner gets FULL_CONTROL. No one else has any access
 806 rights.  This is the default.
 807
 808 =item B<< public-read >>
 809
 810 Owner gets FULL_CONTROL and the anonymous principal is
 811 granted READ access. If this policy is used on an object, it can be
 812 read from a browser with no authentication.
 813
 814 =item B<< public-read-write >>
 815
 816 Owner gets FULL_CONTROL, the anonymous principal
 817 is granted READ and WRITE access. This is a useful policy to apply
 818 to a bucket, if you intend for any anonymous user to PUT objects
 819 into the bucket.
 820
 821 =item B<< authenticated-read >>
 822
 823 Owner gets FULL_CONTROL, and any principal
 824 authenticated as a registered Amazon S3 user is granted READ
 825 access.
 826
 827 =back
 828
 829
 830
 831 =head1 OPTIONS
 832
 833 Each command can have its own options, but the following ones are either
 834 common to them all or meta-options.
 835
 836 =over
 837
 838 =item --help
 839
 840 print a somewhat more verbose help, showing usage, this description of
 841 the options and some examples from the synopsis.
 842
 843 =item --id <ID>
 844
 845 the Amazon AWS ID for the account to use. By default, it is read
 846 from F<~/.aws>.
 847
 848 =item --man
 849
 850 print out the full documentation for the script.
 851
 852 =item --secret <secret>
 853
 854 the secret shared with Amazon for signing requests. By default, it
 855 is read from F<~/.aws>.
 856
 857 =item --usage
 858
 859 print a concise usage line and exit.
 860
 861 =item --version
 862
 863 print the version of the script.
 864
 865 =back
 866
 867 =head1 COMMANDS
 868
 869 Most commands have different behaviours in the DWIM spirit.
 870
 871 The commands can be broadly divided into two main classes: the I<pure>
 872 S3 commands, and the ones that somehow impose a filesystem metaphor.
 873
 874 The I<pure> commands are a more or less direct mapping of the API that
 875 S3 exposes. It's well suited when you have to do S3 operations, e.g. as
 876 part of some scripting.
 877
 878 The I<filesystem>-oriented commands work under the assumption that
 879 keys are organised hyerarchically similarly to a filesystem; it's probably
 880 best suited when you want to somehow forget that you're dealing with S3,
 881 and want to get the job done while feeling at home.
 882
 883 =head2 I<Pure> Commands
 884
 885 =over
 886
 887 =item B<< acl [--clear] [--add <spec>] [--del <spec>] <s3path> >>
 888
 889 get or set the Access Control Policy for the given resource. Options
 890 are:
 891
 892 =over
 893
 894 =item --add <target>:<permission>
 895
 896 add/set the given permission to the given target. Can be given multiple
 897 times.
 898
 899 =item --clear
 900
 901 clear all the currently set permissions
 902
 903 =item --del <target>[:<permission>]
 904
 905 delete a permission. If the permission is specified, deletes the
 906 permission only if present; otherwise, the given target is wiped out.
 907 Can be given multiple times.
 908
 909 =back
 910
 911 B<NOTE>: to be able to set the ACL, you'll need L<Net::Amazon::S3::ACL> and
 912 a modified version of L<Net::Amazon::S3::Bucket> (hopefully the needed
 913 changes will be included in L<Net::Amazon::S3> some day). If you want, you
 914 can find the module and the patch at
 915 L<http://rt.cpan.org/Ticket/Display.html?id=38847> (take the stuff in the
 916 reply, ignore the first message).
 917
 918 =item B<< add [--meta <meta>] [--header <header>] [--acl <acl>] [--data <data>] [--location <place>] <s3path> [<filename>] >>
 919
 920 add a resource in S3.
 921
 922 If the path contains a bucket name only, then this command is simply a
 923 shortcut for the L</create> command, which creates the bucket. In this
 924 case, all parameters specific to L</add> are ignored.
 925
 926 If the path contains a key as well, then the relative object is
 927 created. In this case there are the following options:
 928
 929 =over
 930
 931 =item --acl <permission>
 932
 933 set the short permission (see L</Permissions>).
 934
 935 =item --data <data>
 936
 937 get the data to be put into the object from the command line; useful
 938 for one-shot file creations.
 939
 940 =item --header <name>:<value>
 941
 942 set the given header in the request to be sent to the server. Can
 943 be given multiple times.
 944
 945 =item --location <place>
 946
 947 see L</copy>.
 948
 949 =item --meta <name>:<value>
 950
 951 add metadata when creating the object; it's actually a shorthand
 952 for the I<header> option above. Can be given multiple times.
 953
 954 =back
 955
 956
 957 =item B<< copy [--meta <meta>] [--header <header>] [--acl <acl>]  <s3path-src> <s3path-dst> >>
 958
 959 copy one object into a new one, remotely.
 960
 961 During the copy, metadata are usually preserved unless you provide yours.
 962 The same does not apply to ACL, which defaults to... the default.
 963
 964 Options:
 965
 966 =over
 967
 968 =item --acl <permission>
 969
 970 set the short permission (see L</Permissions>).
 971
 972 =item --header <name>:<value>
 973
 974 set the given header in the request to be sent to the server. Can
 975 be given multiple times.
 976
 977 =item --meta <name>:<value>
 978
 979 add metadata when creating the object; it's actually a shorthand
 980 for the I<header> option above. Can be given multiple times.
 981
 982 =back
 983
 984 =item B<< create [--acl <acl>] [--location <location>] <bucket-name> >>
 985
 986 create a bucket. Options are:
 987
 988 =over
 989
 990 =item --acl <permission>
 991
 992 set the short permission (see L</Permissions>).
 993
 994 =item --location <place>
 995
 996 the location constraint for bucket storage. Currently, you can only
 997 specify C<EU>; otherwise, the bucket will be created in the phantomatic
 998 I<default location>, which should be in the U.S.
 999
1000 =back
1001
1002 =item B<< delete <s3path> >>
1003
1004 remove the given resource, whether it's a bucket or a fully qualified key.
1005
1006 =item B<< get <s3path> [<filename|dirname>] >>
1007
1008 get the given object (I<s3path> must be a proper path).
1009
1010 If a filename is given, the object's contents are printed to the file.
1011
1012 If a directory name is given, the object's contents are saved into a file
1013 in the given directory. The filename will be derived by the object's key
1014 using the C<basename> function in L<File::Basename>.
1015
1016 By default, the object's contents will be printed to standard output.
1017
1018 =item B<< list [--ls] [-l] [--delimiter <string>] [--max-keys <n>] [--marker <n>] [s3path>] >>
1019
1020 If issued without any parameter, the list of buckets will be printed.
1021
1022 If the I<s3path> is improper (i.e. it only contains the bucket name),
1023 then the full list of objects in the bucket is printed out.
1024
1025 If the I<s3path> is proper, two possible behaviours are possible:
1026
1027 =over
1028
1029 =item *
1030
1031 if L</--ls> is given the I<prefix> in the
1032 I<s3path> is regarded as an equivalent I<directory name> and the contents
1033 of this I<virtual directory> are printed out. In this case, the I<prefix>
1034 is automatically appended with a forward slash C</> if it lack one, and
1035 the search is set with the forward slash C</> delimiter.
1036
1037 =item *
1038
1039 otherwise, all objects matching the given I<prefix> are printed out.
1040
1041 =back
1042
1043 Options:
1044
1045 =over
1046
1047 =item --ls
1048
1049 treat the keys as UNIX-style paths, and mimic what the C<ls> command would
1050 do. This option implies L</--delimiter> set to C</>.
1051
1052 =item -l
1053
1054 be verbose when printing out. When a list of keys is printed, it vaguely
1055 resembles what the command C<ls -l> does.
1056
1057 =item --delimiter <string>
1058
1059 =item --max-keys <n>
1060
1061 =item --marker <n>
1062
1063 See Amazon AWS documentation for these three parameters. The first one
1064 allows you to restrict the output list by summarising keys, while the other
1065 two allow for pagination (by default any pagination is handled automatically,
1066 at the expense of making repeated calls under the hood).
1067
1068 =back
1069
1070
1071 =item B<< locate <s3path> >>
1072
1073 get the location for the given resource (this is actually the location
1074 of the bucket). Note that, due to an inconsistent behaviour in
1075 L<Net::Amazon::S3>, you can't be certain if a given bucket is in the
1076 I<default> location or if an error occurred.
1077
1078 =item B<< meta [--clear] [--add <spec>] [--del <spec>] <s3path> >>
1079
1080 change the metadata for the given resource. Options:
1081
1082 =over
1083
1084 =item --add <name>:<value>
1085
1086 add the given metadata.
1087
1088 =item --clear
1089
1090 remove all metadata.
1091
1092 =item --del <name>[:<value>]
1093
1094 delete the metadata given by I<name>. If a I<value> is present, then the
1095 metadata is removed only if its current value is equal to I<value>.
1096
1097 =back
1098
1099 =item B<< show <s3path> >>
1100
1101 get information about the given object (I<s3path> must be a fully qualified
1102 one). These info include all the headers of a HEAD request for the given
1103 resource.
1104
1105 =back
1106
1107 =head2 I<Filesystem-Oriented> Commands
1108
1109 These commands rely upon the assumption that the keys for the objects
1110 can be treated like normal UNIX paths in a filesystem. Each command tries
1111 to reproduce the corresponding system command, at least in its basic
1112 functionality.
1113
1114 =over
1115
1116 =item B<< cat [<filename|s3path>] ... >>
1117
1118 output the given resources. Note that you can intermix local files and
1119 remote I<s3path>s.
1120
1121 =item B<< cp  <src> [<src2> [<src3 ...]] <dst> >>
1122
1123 make a copy. Both the source and the destinations can be (independently)
1124 in the local system or in the S3 one. Yes, also the local copy should
1125 work.
1126
1127 Like the C<cp> system command, if you want to specify more than two
1128 arguments the last one must be a directory. For the local filesystem the
1129 check is straightforward; for the remote one the destination must end with
1130 a slash.
1131
1132 If the destination is a directory, the target filename will be derived
1133 by the corresponding source filename by means of C<basename> in
1134 L<File::Basename>.
1135
1136 =item B<< dir [--delimiter <string>] [--max-keys <n>] [--marker <n>] [<s3path>] >>
1137
1138 same as command L</ls> with the C<-l> option.
1139
1140 =item B<< ls  [-l] [--delimiter <string>] [--max-keys <n>] [--marker <n>] [<s3path>] >>
1141
1142 same as the L</list> command, with the L</--ls> option.
1143
1144 =item B<< mv  <src> [<src2> [<src3 ...]] <dst> >>
1145
1146 move resources. Both the source and the destinations can be (independently)
1147 in the local system or in the S3 one. Yes, also the local mv should
1148 work.
1149
1150 Like the C<mv> system command, if you want to specify more than two
1151 arguments the last one must be a directory. For the local filesystem the
1152 check is straightforward; for the remote one the destination must end with
1153 a slash.
1154
1155 If the destination is a directory, the target filename will be derived
1156 by the corresponding source filename by means of C<basename> in
1157 L<File::Basename>.
1158
1159 B<NOTE>: the "mv" is more or less implemented as a copy-then-delete. If
1160 the deletion isn't successful, the copy is B<NOT> deleted. This is
1161 regarded as a feature, considering that traffic wit S3 is paid.
1162
1163 =item B<< rm <s3path> [<s3path2> [<s3path3> ...]] >>
1164
1165 remove the given resources.
1166
1167 =back
1168
1169
1170 =head1 DIAGNOSTICS
1171
1172 Any error coming from AWS S3 is printed on the standard output.
1173
1174
1175 =head1 CONFIGURATION AND ENVIRONMENT
1176
1177 s3 reads its configuration from F<~/.aws>. It should be an INI-style
1178 file like this:
1179
1180    id = your-AWS-id
1181    secret = your-AWS-secret
1182
1183
1184 =head1 DEPENDENCIES
1185
1186 =over
1187
1188 =item *
1189
1190 L<Net::Amazon::S3>
1191
1192 =item *
1193
1194 L<Net::Amazon::S3::ACL>, which will hopefully be included in
1195 L<Net::Amazon::S3>. This is only required if you want to play with
1196 ACLs.
1197
1198 =item *
1199
1200 L<Log::Log4perl>
1201
1202 =item *
1203
1204 L<Config::Tiny>
1205
1206 =back
1207
1208
1209 =head1 BUGS AND LIMITATIONS
1210
1211 No bugs have been reported.
1212
1213 Please report any bugs or feature requests through http://rt.cpan.org/
1214
1215 The "cp" and "mv" commands sort-of do what the system counterparts do
1216 when source and destination are in the local filesystem. The "sort-of"
1217 means that at the end you'll have a file in the destination that has
1218 the same contents of the source, and the source will be deleted if it's
1219 a "mv". Anything beyond this (e.g. permissions, etc.) is not handled.
1220
1221 An interactive mode could be added.
1222
1223
1224 =head1 AUTHOR
1225
1226 Flavio Poletti C<flavio@polettix.it>
1227
1228
1229 =head1 LICENCE AND COPYRIGHT
1230
1231 Copyright (c) 2008, Flavio Poletti C<flavio@polettix.it>. All rights reserved.
1232
1233 This script is free software; you can redistribute it and/or
1234 modify it under the same terms as Perl itself. See L<perlartistic>
1235 and L<perlgpl>.
1236
1237 Questo script è software libero: potete ridistribuirlo e/o
1238 modificarlo negli stessi termini di Perl stesso. Vedete anche
1239 L<perlartistic> e L<perlgpl>.
1240
1241
1242 =head1 DISCLAIMER OF WARRANTY
1243
1244 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
1245 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
1246 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
1247 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
1248 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1249 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
1250 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
1251 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
1252 NECESSARY SERVICING, REPAIR, OR CORRECTION.
1253
1254 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
1255 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
1256 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
1257 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
1258 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
1259 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
1260 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
1261 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
1262 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
1263 SUCH DAMAGES.
1264
1265 =head1 NEGAZIONE DELLA GARANZIA
1266
1267 Poiché questo software viene dato con una licenza gratuita, non
1268 c'è alcuna garanzia associata ad esso, ai fini e per quanto permesso
1269 dalle leggi applicabili. A meno di quanto possa essere specificato
1270 altrove, il proprietario e detentore del copyright fornisce questo
1271 software "così com'è" senza garanzia di alcun tipo, sia essa espressa
1272 o implicita, includendo fra l'altro (senza però limitarsi a questo)
1273 eventuali garanzie implicite di commerciabilità e adeguatezza per
1274 uno scopo particolare. L'intero rischio riguardo alla qualità ed
1275 alle prestazioni di questo software rimane a voi. Se il software
1276 dovesse dimostrarsi difettoso, vi assumete tutte le responsabilità
1277 ed i costi per tutti i necessari servizi, riparazioni o correzioni.
1278
1279 In nessun caso, a meno che ciò non sia richiesto dalle leggi vigenti
1280 o sia regolato da un accordo scritto, alcuno dei detentori del diritto
1281 di copyright, o qualunque altra parte che possa modificare, o redistribuire
1282 questo software così come consentito dalla licenza di cui sopra, potrà
1283 essere considerato responsabile nei vostri confronti per danni, ivi
1284 inclusi danni generali, speciali, incidentali o conseguenziali, derivanti
1285 dall'utilizzo o dall'incapacità di utilizzo di questo software. Ciò
1286 include, a puro titolo di esempio e senza limitarsi ad essi, la perdita
1287 di dati, l'alterazione involontaria o indesiderata di dati, le perdite
1288 sostenute da voi o da terze parti o un fallimento del software ad
1289 operare con un qualsivoglia altro software. Tale negazione di garanzia
1290 rimane in essere anche se i dententori del copyright, o qualsiasi altra
1291 parte, è stata avvisata della possibilità di tali danneggiamenti.
1292
1293 Se decidete di utilizzare questo software, lo fate a vostro rischio
1294 e pericolo. Se pensate che i termini di questa negazione di garanzia
1295 non si confacciano alle vostre esigenze, o al vostro modo di
1296 considerare un software, o ancora al modo in cui avete sempre trattato
1297 software di terze parti, non usatelo. Se lo usate, accettate espressamente
1298 questa negazione di garanzia e la piena responsabilità per qualsiasi
1299 tipo di danno, di qualsiasi natura, possa derivarne.
1300
1301 =cut