IkiWiki/Plugin/amazon_s3.pm

   1 #!/usr/bin/perl
   2 package IkiWiki::Plugin::amazon_s3;
   3
   4 use warnings;
   5 no warnings 'redefine';
   6 use strict;
   7 use IkiWiki 2.00;
   8 use IkiWiki::Render;
   9 use Net::Amazon::S3;
  10
  11 # Store references to real subs before overriding them.
  12 our %subs;
  13 BEGIN {
  14         foreach my $sub (qw{IkiWiki::writefile IkiWiki::prune}) {
  15                 $subs{$sub}=\&$sub;
  16         }
  17 };
  18
  19 sub import { #{{{
  20         hook(type => "getopt", id => "amazon_s3", call => \&getopt);
  21         hook(type => "checkconfig", id => "amazon_s3", call => \&checkconfig);
  22 } # }}}
  23
  24 sub getopt () { #{{{
  25         eval q{use Getopt::Long};
  26         error($@) if $@;
  27         Getopt::Long::Configure('pass_through');
  28         GetOptions("delete-bucket" => sub {
  29                 my $bucket=getbucket();
  30                 debug(gettext("deleting bucket.."));
  31                 my $resp = $bucket->list_all or die $bucket->err . ": " . $bucket->errstr;
  32                 foreach my $key (@{$resp->{keys}}) {
  33                         debug("\t".$key->{key});
  34                         $bucket->delete_key($key->{key}) or die $bucket->err . ": " . $bucket->errstr;
  35                 }
  36                 $bucket->delete_bucket or die $bucket->err . ": " . $bucket->errstr;
  37                 debug(gettext("done"));
  38                 exit(0);
  39         });
  40 } #}}}
  41
  42 sub checkconfig { #{{{
  43         foreach my $field (qw{amazon_s3_key_id amazon_s3_key_file
  44                               amazon_s3_bucket}) {
  45                 if (! exists $config{$field} || ! defined $config{$field}) {
  46                         error(sprintf(gettext("Must specify %s"), $field));
  47                 }
  48         }
  49         if (! exists $config{amazon_s3_prefix} ||
  50             ! defined $config{amazon_s3_prefix}) {
  51             $config{amazon_s3_prefix}="wiki/";
  52         }
  53 } #}}}
  54
  55 {
  56 my $bucket;
  57 sub getbucket { #{{{
  58         return $bucket if defined $bucket;
  59
  60         open(IN, "<", $config{amazon_s3_key_file}) || error($config{amazon_s3_key_file}.": ".$!);
  61         my $key=<IN>;
  62         chomp $key;
  63         close IN;
  64
  65         my $s3=Net::Amazon::S3->new({
  66                 aws_access_key_id => $config{amazon_s3_key_id},
  67                 aws_secret_access_key => $key,
  68                 retry => 1,
  69         });
  70
  71         # make sure the bucket exists
  72         if (exists $config{amazon_s3_location}) {
  73                 $bucket=$s3->add_bucket({
  74                         bucket => $config{amazon_s3_bucket},
  75                         location_constraint => $config{amazon_s3_location},
  76                 });
  77         }
  78         else {
  79                 $bucket=$s3->add_bucket({
  80                         bucket => $config{amazon_s3_bucket},
  81                 });
  82         }
  83
  84         if (! $bucket) {
  85                 error(gettext("Failed to create bucket in S3: ").
  86                         $s3->err.": ".$s3->errstr."\n");
  87         }
  88
  89         return $bucket;
  90 } #}}}
  91 }
  92
  93 # Given a file, return any S3 keys associated with it.
  94 sub file2keys ($) { #{{{
  95         my $file=shift;
  96
  97         my @keys;
  98         if ($file =~ /^\Q$config{destdir}\/\E(.*)/) {
  99                 push @keys, $config{amazon_s3_prefix}.$1;
 100
 101                 # Munge foo/index.html to foo/
 102                 if ($keys[0]=~/(^|.*\/)index.$config{htmlext}$/) {
 103                         # A duplicate might need to be stored under the
 104                         # unmunged name too.
 105                         if (!$config{usedirs} || $config{amazon_s3_dupindex}) {
 106                                 push @keys, $1;
 107                         }
 108                         else {
 109                                 @keys=($1);
 110                         }
 111                 }
 112         }
 113         return @keys;
 114 } #}}}
 115
 116 package IkiWiki;
 117 use File::MimeInfo;
 118 use Encode;
 119
 120 # This is a wrapper around the real writefile.
 121 sub writefile ($$$;$$) { #{{{
 122         my $file=shift;
 123         my $destdir=shift;
 124         my $content=shift;
 125         my $binary=shift;
 126         my $writer=shift;
 127
 128         # First, write the file to disk.
 129         my $ret=$IkiWiki::Plugin::amazon_s3::subs{'IkiWiki::writefile'}->($file, $destdir, $content, $binary, $writer);
 130
 131         my @keys=IkiWiki::Plugin::amazon_s3::file2keys("$destdir/$file");
 132
 133         # Store the data in S3.
 134         if (@keys) {
 135                 my $bucket=IkiWiki::Plugin::amazon_s3::getbucket();
 136
 137                 # The http layer tries to downgrade utf-8
 138                 # content, but that can fail (see
 139                 # http://rt.cpan.org/Ticket/Display.html?id=35710),
 140                 # so force convert it to bytes.
 141                 $content=encode_utf8($content) if defined $content;
 142
 143                 my %opts=(
 144                         acl_short => 'public-read',
 145                         content_type => mimetype("$destdir/$file"),
 146                 );
 147
 148                 # If there are multiple keys to write, data is sent
 149                 # multiple times.
 150                 # TODO: investigate using the new copy operation.
 151                 #       (It may not be robust enough.)
 152                 foreach my $key (@keys) {
 153                         my $res;
 154                         if (! $writer) {
 155                                 $res=$bucket->add_key($key, $content, \%opts);
 156                         }
 157                         else {
 158                                 # This test for empty files is a workaround
 159                                 # for this bug:
 160                                 # http://rt.cpan.org//Ticket/Display.html?id=35731
 161                                 if (-z "$destdir/$file") {
 162                                         $res=$bucket->add_key($key, "", \%opts);
 163                                 }
 164                                 else {
 165                                         # read back in the file that the writer emitted
 166                                         $res=$bucket->add_key_filename($key, "$destdir/$file", \%opts);
 167                                 }
 168                         }
 169                         if (! $res) {
 170                                 error(gettext("Failed to save file to S3: ").
 171                                         $bucket->err.": ".$bucket->errstr."\n");
 172                         }
 173                 }
 174         }
 175
 176         return $ret;
 177 } #}}}
 178
 179 # This is a wrapper around the real prune.
 180 sub prune ($) { #{{{
 181         my $file=shift;
 182
 183         my @keys=IkiWiki::Plugin::amazon_s3::file2keys($file);
 184
 185         # Prune files out of S3 too.
 186         if (@keys) {
 187                 my $bucket=IkiWiki::Plugin::amazon_s3::getbucket();
 188
 189                 foreach my $key (@keys) {
 190                         my $res=$bucket->delete_key($key);
 191                         if (! $res) {
 192                                 error(gettext("Failed to delete file from S3: ").
 193                                         $bucket->err.": ".$bucket->errstr."\n");
 194                         }
 195                 }
 196         }
 197
 198         return $IkiWiki::Plugin::amazon_s3::subs{'IkiWiki::prune'}->($file);
 199 } #}}}
 200
 201 1