some comments
[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 => "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