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