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