error if ping fails, rather than printing debug
[ikiwiki] / 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 => "getsetup", id => "amazon_s3", call => \&getsetup);
22         hook(type => "checkconfig", id => "amazon_s3", call => \&checkconfig);
23 } # }}}
24
25 sub getopt () { #{{{
26         eval q{use Getopt::Long};
27         error($@) if $@;
28         Getopt::Long::Configure('pass_through');
29         GetOptions("delete-bucket" => sub {
30                 my $bucket=getbucket();
31                 debug(gettext("deleting bucket.."));
32                 my $resp = $bucket->list_all or die $bucket->err . ": " . $bucket->errstr;
33                 foreach my $key (@{$resp->{keys}}) {
34                         debug("\t".$key->{key});
35                         $bucket->delete_key($key->{key}) or die $bucket->err . ": " . $bucket->errstr;
36                 }
37                 $bucket->delete_bucket or die $bucket->err . ": " . $bucket->errstr;
38                 debug(gettext("done"));
39                 exit(0);
40         });
41 } #}}}
42
43 sub getsetup () { #{{{
44         return
45                 plugin => {
46                         safe => 0,
47                         rebuild => 0,
48                 },
49                 amazon_s3_key_id => {
50                         type => "string",
51                         example => "XXXXXXXXXXXXXXXXXXXX",
52                         description => "public access key id",
53                         safe => 1,
54                         rebuild => 0,
55                 },
56                 amazon_s3_key_id => {
57                         type => "string",
58                         example => "$ENV{HOME}/.s3_key",
59                         description => "file holding secret key (must not be readable by others!)",
60                         safe => 0, # ikiwiki reads this file
61                         rebuild => 0,
62                 },
63                 amazon_s3_bucket => {
64                         type => "string",
65                         example => "mywiki",
66                         description => "globally unique name of bucket to store wiki in",
67                         safe => 1,
68                         rebuild => 1,
69                 },
70                 amazon_s3_prefix => {
71                         type => "string",
72                         example => "wiki/",
73                         description => "a prefix to prepend to each page name",
74                         safe => 1,
75                         rebuild => 1,
76                 },
77                 amazon_s3_location => {
78                         type => "string",
79                         example => "EU",
80                         description => "which S3 datacenter to use (leave blank for default)",
81                         safe => 1,
82                         rebuild => 1,
83                 },
84                 amazon_s3_dupindex => {
85                         type => "boolean",
86                         example => 0,
87                         description => "store each index file twice? (allows urls ending in \"/index.html\" and \"/\")",
88                         safe => 1,
89                         rebuild => 1,
90                 },
91 } #}}}
92
93 sub checkconfig { #{{{
94         foreach my $field (qw{amazon_s3_key_id amazon_s3_key_file
95                               amazon_s3_bucket}) {
96                 if (! exists $config{$field} || ! defined $config{$field}) {
97                         error(sprintf(gettext("Must specify %s"), $field));
98                 }
99         }
100         if (! exists $config{amazon_s3_prefix} ||
101             ! defined $config{amazon_s3_prefix}) {
102             $config{amazon_s3_prefix}="wiki/";
103         }
104 } #}}}
105
106 {
107 my $bucket;
108 sub getbucket { #{{{
109         return $bucket if defined $bucket;
110         
111         open(IN, "<", $config{amazon_s3_key_file}) || error($config{amazon_s3_key_file}.": ".$!);
112         my $key=<IN>;
113         chomp $key;
114         close IN;
115
116         my $s3=Net::Amazon::S3->new({
117                 aws_access_key_id => $config{amazon_s3_key_id},
118                 aws_secret_access_key => $key,
119                 retry => 1,
120         });
121
122         # make sure the bucket exists
123         if (exists $config{amazon_s3_location}) {
124                 $bucket=$s3->add_bucket({
125                         bucket => $config{amazon_s3_bucket},
126                         location_constraint => $config{amazon_s3_location},
127                 });
128         }
129         else {
130                 $bucket=$s3->add_bucket({
131                         bucket => $config{amazon_s3_bucket},
132                 });
133         }
134
135         if (! $bucket) {
136                 error(gettext("Failed to create bucket in S3: ").
137                         $s3->err.": ".$s3->errstr."\n");
138         }
139
140         return $bucket;
141 } #}}}
142 }
143
144 # Given a file, return any S3 keys associated with it.
145 sub file2keys ($) { #{{{
146         my $file=shift;
147
148         my @keys;
149         if ($file =~ /^\Q$config{destdir}\/\E(.*)/) {
150                 push @keys, $config{amazon_s3_prefix}.$1;
151
152                 # Munge foo/index.html to foo/
153                 if ($keys[0]=~/(^|.*\/)index.$config{htmlext}$/) {
154                         # A duplicate might need to be stored under the
155                         # unmunged name too.
156                         if (!$config{usedirs} || $config{amazon_s3_dupindex}) {
157                                 push @keys, $1;
158                         }
159                         else {
160                                 @keys=($1);
161                         }
162                 }
163         }
164         return @keys;
165 } #}}}
166
167 package IkiWiki;
168 use File::MimeInfo;
169 use Encode;
170
171 # This is a wrapper around the real writefile.
172 sub writefile ($$$;$$) { #{{{
173         my $file=shift;
174         my $destdir=shift;
175         my $content=shift;
176         my $binary=shift;
177         my $writer=shift;
178
179         # First, write the file to disk.
180         my $ret=$IkiWiki::Plugin::amazon_s3::subs{'IkiWiki::writefile'}->($file, $destdir, $content, $binary, $writer);
181                 
182         my @keys=IkiWiki::Plugin::amazon_s3::file2keys("$destdir/$file");
183
184         # Store the data in S3.
185         if (@keys) {
186                 my $bucket=IkiWiki::Plugin::amazon_s3::getbucket();
187
188                 # The http layer tries to downgrade utf-8
189                 # content, but that can fail (see
190                 # http://rt.cpan.org/Ticket/Display.html?id=35710),
191                 # so force convert it to bytes.
192                 $content=encode_utf8($content) if defined $content;
193
194                 my %opts=(
195                         acl_short => 'public-read',
196                         content_type => mimetype("$destdir/$file"),
197                 );
198
199                 # If there are multiple keys to write, data is sent
200                 # multiple times.
201                 # TODO: investigate using the new copy operation.
202                 #       (It may not be robust enough.)
203                 foreach my $key (@keys) {
204                         my $res;
205                         if (! $writer) {
206                                 $res=$bucket->add_key($key, $content, \%opts);
207                         }
208                         else {
209                                 # This test for empty files is a workaround
210                                 # for this bug:
211                                 # http://rt.cpan.org//Ticket/Display.html?id=35731
212                                 if (-z "$destdir/$file") {
213                                         $res=$bucket->add_key($key, "", \%opts);
214                                 }
215                                 else {
216                                         # read back in the file that the writer emitted
217                                         $res=$bucket->add_key_filename($key, "$destdir/$file", \%opts);
218                                 }
219                         }
220                         if (! $res) {
221                                 error(gettext("Failed to save file to S3: ").
222                                         $bucket->err.": ".$bucket->errstr."\n");
223                         }
224                 }
225         }
226
227         return $ret;
228 } #}}}
229
230 # This is a wrapper around the real prune.
231 sub prune ($) { #{{{
232         my $file=shift;
233
234         my @keys=IkiWiki::Plugin::amazon_s3::file2keys($file);
235
236         # Prune files out of S3 too.
237         if (@keys) {
238                 my $bucket=IkiWiki::Plugin::amazon_s3::getbucket();
239
240                 foreach my $key (@keys) {
241                         my $res=$bucket->delete_key($key);
242                         if (! $res) {
243                                 error(gettext("Failed to delete file from S3: ").
244                                         $bucket->err.": ".$bucket->errstr."\n");
245                         }
246                 }
247         }
248
249         return $IkiWiki::Plugin::amazon_s3::subs{'IkiWiki::prune'}->($file);
250 } #}}}
251
252 1