#!/usr/bin/perl -w
# Backups Blow by Brandon Low 
#
# Copyright 2007 Brandon Low 
# Released under the terms of the GPL v2
#
# http://lostlogicx.com/backupsblow/

package BackupsBlow::Transport::S3;

use strict;
use Exporter;
our (@EXPORT_OK, %EXPORT_TAGS, @ISA);
@ISA = qw(Exporter);
@EXPORT_OK = qw(&performBackup &removeBackups &listBackups &fixBackupPath);
%EXPORT_TAGS = ("all" => [@EXPORT_OK]);

use BackupsBlow::Config qw(:read);
use BackupsBlow::Util qw(:transport);
use BackupsBlow::Programs qw(:all);
use Net::Amazon::S3;

use Log::Log4perl;
my $logger=Log::Log4perl->get_logger();


# Returns the bucket on success or undef.
sub getBucket($) {
    my ($name)=@_;
    my $s3=Net::Amazon::S3->new(
        {
            aws_access_key_id => needConfig("USERNAME"),
            aws_secret_access_key => needConfig("PASSWORD"),
            secure => 1,
        }
    );
    my $bucket=$s3->bucket($name);
    unless ($bucket) {
        $logger->error("get bucket $name: ".$s3->err.': '.$s3->errstr);
    }
    return $bucket;
}

# Retries S3_TRIES times.
# Returns undef on failure.
sub addKey($$$;$) {
    my ($bucketName,$keyName,$keyValue,$conf)=@_;
    my $bucket=getBucket($bucketName);
    unless ($bucket) {
        $logger->error("add $keyName couldn't get bucket");
        return undef;
    }
    my $tries=configWhole("S3_TRIES",3);
    my $success;
    do {
        $success=$bucket->add_key($keyName,$keyValue,$conf);
        if ($success) {
            $logger->debug("add $keyName successful");
        } else {
            $logger->logwarn(
                "add $keyName: ".$bucket->err.': '.$bucket->errstr);
        }
        $tries-=1;
    } while (!$success && $tries);
    unless ($success) {
        $logger->error("add $keyName failed");
    }
    return $success;
}

# Retries S3_TRIES times.
# Returns @list on success or undef
sub listAll($) {
    my ($name)=@_;
    my $bucket=getBucket($name);
    unless ($bucket) {
        $logger->error("list $name couldn't get bucket");
        return undef;
    }
    my $tries=configWhole("S3_TRIES",3);
    my $list;
    do {
        $list=$bucket->list_all;
        unless ($list) {
            $logger->logwarn("ls $name: ".$bucket->err.': '.$bucket->errstr);
        }
        $tries-=1;
    } while (!$list && $tries);
    $logger->error("list $name failed") unless ($list);
    return $list?$list->{keys}:undef;
}

# Removes all of the _splits_ of a backup up to specified count.
sub removeBackupSplitsInner ($$$) {
    my ($bucket,$name,$count)=@_;
    my $digits=configWhole("S3_OBJECT_SUFFIX_DIGITS",5);
    my $allSuccessful=1;
    for (my $i=0; $i < $count; $i+=1) {
        my $suffix=sprintf(".%0".$digits."d",$i);
        my $success=$bucket->delete_key($name.$suffix);
        unless ($success) {
            $logger->logwarn(
                "rm split $name$suffix: ".$bucket->err.': '.$bucket->errstr);
            $allSuccessful=undef;
        }
    }
    return $allSuccessful;
}
# This is a wrapper for the above that is callable by public subs
sub removeBackupSplits ($$$) {
    my ($bucketName,$name,$count)=@_;
    my $bucket=getBucket($bucketName);
    unless ($bucket) {
        $logger->error("rm splits $name couldn't get bucket");
        return;
    }
    removeBackupSplitsInner($bucket,$name,$count);
}

# Removes the named backup from the named bucket
sub removeBackup ($$) {
    my ($bucketName,$name)=@_;
    my $bucket=getBucket($bucketName);
    unless ($bucket) {
        $logger->error("rm $name couldn't get bucket");
        return;
    }

    my $backup=$bucket->get_key($name);
    unless ($backup) {
        $logger->error("get $name: ".$bucket->err.': '.$bucket->errstr);
        next;
    }
    my $success=removeBackupSplitsInner($bucket,$name,$backup->{value});
    if ($success) {
        $bucket->delete_key($name) || $logger->error(
            "rm $name: ".$bucket->err.': '.$bucket->errstr);
    } else {
        $logger->error("rm $name splits failed, keeping index");
    }
}

#--------------------BEGIN EXPORTED SUBS--------------------

sub fixBackupPath ($) {
    return $_[0];
}

# Removes the listed backups and all of their splits.
sub removeBackups ($$) {
    my ($bucketName,$backupNames)=@_;
    foreach my $backupName(@$backupNames) {
        removeBackup($bucketName,$backupName);
    }
}

# Takes a bucket name to list
# Returns an array of files in that bucket, excluding split parts
sub listBackups ($) {
    my ($bucketName)=@_;
    my $digits=configWhole("S3_OBJECT_SUFFIX_DIGITS",5);

    my %splits;
    my %retval;
    my $list=listAll($bucketName) || die("Listing failed");
    foreach my $object(@$list) {
        my $key=$object->{key};
        if ($key =~ m/\.[0-9]{$digits}$/) {
            my $split=$key;
            $split=~s/^.*\.([0-9]{$digits})$/$1/;
            $key=~s/\.[0-9]{$digits}$//;
            next if (defined($retval{$key}));
            unless (defined($splits{$key}) && $splits{$key} > $split) {
                $splits{$key}=$split;
            }
        } else {
            $retval{$key}=1;
            delete($splits{$key});
        }
    }
    while (my ($key,$count) = each(%splits)) {
        $logger->logwarn("Deleting partial backup: " . $key);
        removeBackupSplits($bucketName,$key,$count+1);
    }
    return keys(%retval);
}

sub performBackup ($$$$) {
    my ($bucketName,$backupName,$incFile,$errFile)=@_;
    my $size=configWhole("S3_OBJECT_SIZE",100000000);
    my $digits=configWhole("S3_OBJECT_SUFFIX_DIGITS",5);

    my $command=buildTarCommand($incFile, $errFile);

    # Use bfr if it's available to allow tar to keep working while blocks
    # are written to S3
    my $bfr=program("bfr");
    if ($bfr) {
        my @command;
        push(@command,$command);
        push(@command,"$bfr -b $size");
        $command=join("|",@command);
    }

    open(DATAFILE,"$command|");
    my $success=1;
    my $count=0;
    do {
        my $suffix=sprintf(".%0".$digits."d",$count);
        my $bytes=0;
        my $input;
        do {
            my $rc=read(DATAFILE,$input,$size-$bytes,-0);
            unless (defined($rc)) {
                die("Error reading stream: $!");
            }
            $bytes+=$rc;
        } until (eof(DATAFILE) || $bytes >= $size);
        if ($bytes > 0) {
            $success&=addKey($bucketName,$backupName.$suffix,$input);
            $count+=1;
        }
    } until (eof(DATAFILE) || !$success);
    $success&=close(DATAFILE);

    if ($success) {
        addKey($bucketName,$backupName,$count,{'Content-Type'=>'text/plain'});
    } else {
        removeBackupSplits($bucketName,$backupName,$count);
        die("Failed to perform backup.");
    }
}

1;