<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
package IkiWiki::Plugin::amazon_s3;

use warnings;
no warnings 'redefine';
use strict;
use IkiWiki 3.00;
use IkiWiki::Render;
use Net::Amazon::S3;

# Store references to real subs before overriding them.
our %subs;
BEGIN {
	foreach my $sub (qw{IkiWiki::writefile IkiWiki::prune}) {
		$subs{$sub}=\&amp;$sub;
	}
};

sub import {
	hook(type =&gt; "getopt", id =&gt; "amazon_s3", call =&gt; \&amp;getopt);
	hook(type =&gt; "getsetup", id =&gt; "amazon_s3", call =&gt; \&amp;getsetup);
	hook(type =&gt; "checkconfig", id =&gt; "amazon_s3", call =&gt; \&amp;checkconfig);
}

sub getopt () {
        eval q{use Getopt::Long};
        error($@) if $@;
        Getopt::Long::Configure('pass_through');
        GetOptions("delete-bucket" =&gt; sub {
		my $bucket=getbucket();
		debug(gettext("deleting bucket.."));
		my $resp = $bucket-&gt;list_all or die $bucket-&gt;err . ": " . $bucket-&gt;errstr;
		foreach my $key (@{$resp-&gt;{keys}}) {
			debug("\t".$key-&gt;{key});
			$bucket-&gt;delete_key($key-&gt;{key}) or die $bucket-&gt;err . ": " . $bucket-&gt;errstr;
		}
		$bucket-&gt;delete_bucket or die $bucket-&gt;err . ": " . $bucket-&gt;errstr;
		debug(gettext("done"));
		exit(0);
	});
}

sub getsetup () {
	return
		plugin =&gt; {
			safe =&gt; 0,
			rebuild =&gt; 0,
		},
		amazon_s3_key_id =&gt; {
			type =&gt; "string",
			example =&gt; "XXXXXXXXXXXXXXXXXXXX",
			description =&gt; "public access key id",
			safe =&gt; 1,
			rebuild =&gt; 0,
		},
		amazon_s3_key_id =&gt; {
			type =&gt; "string",
			example =&gt; "$ENV{HOME}/.s3_key",
			description =&gt; "file holding secret key (must not be readable by others!)",
			safe =&gt; 0, # ikiwiki reads this file
			rebuild =&gt; 0,
		},
		amazon_s3_bucket =&gt; {
			type =&gt; "string",
			example =&gt; "mywiki",
			description =&gt; "globally unique name of bucket to store wiki in",
			safe =&gt; 1,
			rebuild =&gt; 1,
		},
		amazon_s3_prefix =&gt; {
			type =&gt; "string",
			example =&gt; "wiki/",
			description =&gt; "a prefix to prepend to each page name",
			safe =&gt; 1,
			rebuild =&gt; 1,
		},
		amazon_s3_location =&gt; {
			type =&gt; "string",
			example =&gt; "EU",
			description =&gt; "which S3 datacenter to use (leave blank for default)",
			safe =&gt; 1,
			rebuild =&gt; 1,
		},
		amazon_s3_dupindex =&gt; {
			type =&gt; "boolean",
			example =&gt; 0,
			description =&gt; "store each index file twice? (allows urls ending in \"/index.html\" and \"/\")",
			safe =&gt; 1,
			rebuild =&gt; 1,
		},
}

sub checkconfig {
	foreach my $field (qw{amazon_s3_key_id amazon_s3_key_file
	                      amazon_s3_bucket}) {
		if (! exists $config{$field} || ! defined $config{$field}) {
			error(sprintf(gettext("Must specify %s"), $field));
		}
	}
	if (! exists $config{amazon_s3_prefix} ||
	    ! defined $config{amazon_s3_prefix}) {
	    $config{amazon_s3_prefix}="wiki/";
	}
}

{
my $bucket;
sub getbucket {
	return $bucket if defined $bucket;
	
	open(IN, "&lt;", $config{amazon_s3_key_file}) || error($config{amazon_s3_key_file}.": ".$!);
	my $key=&lt;IN&gt;;
	chomp $key;
	close IN;

	my $s3=Net::Amazon::S3-&gt;new({
		aws_access_key_id =&gt; $config{amazon_s3_key_id},
		aws_secret_access_key =&gt; $key,
		retry =&gt; 1,
	});

	# make sure the bucket exists
	if (exists $config{amazon_s3_location}) {
		$bucket=$s3-&gt;add_bucket({
			bucket =&gt; $config{amazon_s3_bucket},
			location_constraint =&gt; $config{amazon_s3_location},
		});
	}
	else {
		$bucket=$s3-&gt;add_bucket({
			bucket =&gt; $config{amazon_s3_bucket},
		});
	}

	if (! $bucket) {
		# Try to use existing bucket.
		$bucket=$s3-&gt;bucket($config{amazon_s3_bucket});
	}
	if (! $bucket) {
		error(gettext("Failed to create S3 bucket: ").
			$s3-&gt;err.": ".$s3-&gt;errstr."\n");
	}

	return $bucket;
}
}

# Given a file, return any S3 keys associated with it.
sub file2keys ($) {
	my $file=shift;

	my @keys;
	if ($file =~ /^\Q$config{destdir}\/\E(.*)/) {
		push @keys, $config{amazon_s3_prefix}.$1;

		# Munge foo/index.html to foo/
		if ($keys[0]=~/(^|.*\/)index.$config{htmlext}$/) {
			# A duplicate might need to be stored under the
			# unmunged name too.
			if (!$config{usedirs} || $config{amazon_s3_dupindex}) {
				push @keys, $1;
			}
			else {
				@keys=($1);
			}
		}
	}
	return @keys;
}

package IkiWiki;
use File::MimeInfo;
use Encode;

# This is a wrapper around the real writefile.
sub writefile ($$$;$$) {
        my $file=shift;
        my $destdir=shift;
        my $content=shift;
        my $binary=shift;
        my $writer=shift;

	# First, write the file to disk.
	my $ret=$IkiWiki::Plugin::amazon_s3::subs{'IkiWiki::writefile'}-&gt;($file, $destdir, $content, $binary, $writer);

	my @keys=IkiWiki::Plugin::amazon_s3::file2keys("$destdir/$file");

	# Store the data in S3.
	if (@keys) {
		my $bucket=IkiWiki::Plugin::amazon_s3::getbucket();

		# The http layer tries to downgrade utf-8
		# content, but that can fail (see
		# http://rt.cpan.org/Ticket/Display.html?id=35710),
		# so force convert it to bytes.
		$content=encode_utf8($content) if defined $content;

		my %opts=(
			acl_short =&gt; 'public-read',
			content_type =&gt; mimetype("$destdir/$file"),
		);

		# If there are multiple keys to write, data is sent
		# multiple times.
		# TODO: investigate using the new copy operation.
		#       (It may not be robust enough.)
		foreach my $key (@keys) {
			my $res;
			if (! $writer) {
				$res=$bucket-&gt;add_key($key, $content, \%opts);
			}
			else {
				# This test for empty files is a workaround
				# for this bug:
				# http://rt.cpan.org//Ticket/Display.html?id=35731
				if (-z "$destdir/$file") {
					$res=$bucket-&gt;add_key($key, "", \%opts);
				}
				else {
					# read back in the file that the writer emitted
					$res=$bucket-&gt;add_key_filename($key, "$destdir/$file", \%opts);
				}
			}
			if (! $res) {
				error(gettext("Failed to save file to S3: ").
					$bucket-&gt;err.": ".$bucket-&gt;errstr."\n");
			}
		}
	}

	return $ret;
}

# This is a wrapper around the real prune.
sub prune ($) {
	my $file=shift;

	my @keys=IkiWiki::Plugin::amazon_s3::file2keys($file);

	# Prune files out of S3 too.
	if (@keys) {
		my $bucket=IkiWiki::Plugin::amazon_s3::getbucket();

		foreach my $key (@keys) {
			my $res=$bucket-&gt;delete_key($key);
			if (! $res) {
				error(gettext("Failed to delete file from S3: ").
					$bucket-&gt;err.": ".$bucket-&gt;errstr."\n");
			}
		}
	}

	return $IkiWiki::Plugin::amazon_s3::subs{'IkiWiki::prune'}-&gt;($file);
}

1
</pre></body></html>