さくらのクラウドディスクアーカイブスクリプト

gistfile1.txt

#!env perl
# sacloud_archive.pl
# さくらのクラウドのディスクをアーカイブする
# アーカイブファイル名は、「ディスク名-YYYYMMDDThhmmss」とする。
# $KEEP_ARCHIVES 世代をアーカイブとして保存する。
# TODO アーカイブするのを自サーバのディスクだけに制限する。
use strict;
use warnings;
use Mojo::UserAgent;
use Mojo::Log;
use Mojo::Util qw/dumper/;
use POSIX qw/strftime/;

my $LOGGER = Mojo::Log->new;
my $KEEP_ARCHIVES = 1;
my ( $SACLOUD_TOKEN, $SACLOUD_SECRET, $SACLOUD_ZONE )
    = @ENV{qw/SACLOUD_TOKEN SACLOUD_SECRET SACLOUD_ZONE/};
my ( $SLEEP_TIME, $MAX_SLEEP_TIME ) = ( 30, 3600 );
my $SAKURA_API_BASE
    = 'https://'
    . $SACLOUD_TOKEN . ':'
    . $SACLOUD_SECRET
    . '@secure.sakura.ad.jp/cloud/zone/'
    . $SACLOUD_ZONE
    . '/api/cloud/1.1/';

if ( !defined $SACLOUD_TOKEN or !defined $SACLOUD_SECRET ) {
    $LOGGER->fatal('SACLOUD_TOKEN and SACLOUD_SECRET are required.');
    exit 1;
}
if ( !defined $SACLOUD_ZONE ) {
    $SACLOUD_ZONE //= 'tk1v';
    $LOGGER->warn('SACLOUD_ZONE does not defined. Assume tk1v sandbox');
}

my $UA = Mojo::UserAgent->new;

my $disks = sacloud_disks();
$LOGGER->debug( dumper( +{ line => __LINE__, disks => $disks } ) );

foreach my $disk (@$disks) {
    my $datetime = datetime();
    my ( $disk_id, $disk_name ) = @$disk{qw/id name/};
    $LOGGER->info("sacloud_archive_create $disk_id($disk_name)");
    my $archive = sacloud_archive_create(
        +{  name          => "${disk_name}-$datetime",
            description   => "DAILY-BACKUP",
            sourcedisk_id => $disk_id
        }
    );
    $LOGGER->debug( dumper( +{ line => __LINE__, archive => $archive } ) );
    my $availability = sacloud_archive_waiting( $archive->{id} );
    if ( $availability eq 'available' ) {
        $LOGGER->info("sacloud_archive_create available $archive->{id}");
        my $archives = sacloud_archives_owned_by_user();
        my @sorted_archives = sort { $b->{name} cmp $a->{name} }
            grep { $_->{name} =~ m/\A${disk_name}\-\d{8}T\d{6}\z/ } @$archives;
        foreach my $old_archive (
            @sorted_archives[ 0 .. ( $#sorted_archives - $KEEP_ARCHIVES ) ] )
        {
            $LOGGER->info("sacloud_archive_delete $old_archive->{id}");
            my $archive_delete = sacloud_archive_delete( $old_archive->{id} );
        }
    }
    elsif ( $availability eq 'failed' ) {
        $LOGGER->error("sacloud_archive_create failed $archive->{id}");
    }
    else {
        $LOGGER->error(
            "sacloud_archive_create timeout($availability) $archive->{id}");
    }
}
exit;

sub datetime {
    return strftime( "%Y%m%dT%H%M%S", localtime );    # YYYYMMDDhhmmss
}

sub sacloud_archive_create {
    my ($params) = @_;
    my $archive_cmd = +{
        Archive => +{
            Name        => $params->{name},
            Description => $params->{description},
            SourceDisk  => +{ ID => $params->{sourcedisk_id} }
        }
    };
    my $outer_tx;
    $UA->post(
        "$SAKURA_API_BASE/archive" => json => $archive_cmd => sub {
            my ( $ua, $tx ) = @_;
            $outer_tx = $tx;
        }
    );
    Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
    my $json = $outer_tx->res->json;
    $LOGGER->debug( dumper( +{ line => __LINE__, json => $json } ) );
    return +{ id => $json->{Archive}{ID}, name => $json->{Archive}{Name} };
}

sub sacloud_archive_delete {
    my ($archiveid) = @_;
    my $delete
        = $UA->delete("$SAKURA_API_BASE/archive/$archiveid")->res->json;
    $LOGGER->debug( dumper( +{ line => __LINE__, delete => $delete } ) );
    return $delete;
}

sub sacloud_archive_waiting {
    my ($id) = @_;
    my $archive_availability;
    my $sleep = 0;
    while ( $sleep < $MAX_SLEEP_TIME ) {
        my $archive = $UA->get("$SAKURA_API_BASE/archive/$id")->res->json;
        $LOGGER->debug(
            dumper( +{ line => __LINE__, archive => $archive } ) );
        $archive_availability = $archive->{Archive}{Availability};
        last if grep { $archive_availability eq $_ } (qw/available failed/);
        my ( $max, $min )
            = @{ $archive->{Archive}{JobStatus}{Delays}{Finish} }
            {qw/Max Min/};
        my $min_sleep = ( $min < $SLEEP_TIME ) ? $min : $SLEEP_TIME;
        $LOGGER->info("sacloud_archive_waiting sleep $min_sleep sec $id");
        sleep $min_sleep;
        $sleep += $min_sleep;
    }
    $LOGGER->error("ARCHIVE ID $id FAILED")
        if $archive_availability eq 'failed';
    $LOGGER->error("ARCHIVE ID $id TOO LONG WAIT($MAX_SLEEP_TIME sec)")
        if $sleep >= $MAX_SLEEP_TIME;
    return $archive_availability;
}

sub sacloud_archives_owned_by_user {
    my $archives = $UA->get("$SAKURA_API_BASE/archive")->res->json;
    my @archives = map { +{ id => $_->{ID}, name => $_->{Name} } }
        grep { $_->{Scope} eq 'user' } @{ $archives->{Archives} };
    $LOGGER->debug( dumper( +{ line => __LINE__, archives => \@archives } ) );
    return [
        map { +{ id => $_->{ID}, name => $_->{Name} } }
        grep { $_->{Scope} eq 'user' } @{ $archives->{Archives} }
    ];
}

sub sacloud_disk_create {
    my ($params) = @_;
    my $disk_cmd = +{
        Disk => {
            Name        => $params->{name},
            Description => $params->{description},
        }
    };
    $disk_cmd->{Disk}{SourceDisk}{ID} = $params->{sourcedisk_id}
        if defined $params->{sourcedisk_id};
    $disk_cmd->{Disk}{Plan}{ID} = $params->{plan_id}
        if defined $params->{plan_id};
    $disk_cmd->{Disk}{SizeMB} = $params->{sizemb}
        if defined $params->{sizemb};
    $disk_cmd->{Disk}{Connection} = $params->{connection}
        if defined $params->{connection};
    my $outer_tx;
    $UA->post(
        "$SAKURA_API_BASE/disk" => json => $disk_cmd => sub {
            my ( $ua, $tx ) = @_;
            $outer_tx = $tx;
        }
    );
    Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
    my $json = $outer_tx->res->json;
    return +{ id => $json->{Disk}{ID}, name => $json->{Disk}{Name} };
}

sub sacloud_disk_waiting {
    my ($id) = @_;
    my ( $SLEEP_TIME, $MAX_SLEEP_TIME ) = ( 30, 3600 );
    my $disk_availability;
    my $sleep = 0;
    while ( $sleep < $MAX_SLEEP_TIME ) {
        my $disk = $UA->get("$SAKURA_API_BASE/disk/$id")->res->json;
        $LOGGER->debug( dumper( +{ line => __LINE__, disk => $disk } ) );
        $disk_availability = $disk->{Availability};
        last if grep { $disk_availability eq $_ } (qw/available failed/);
        $LOGGER->info("sacloud_disk_waiting sleep $id");
        sleep $SLEEP_TIME;
        $sleep += $SLEEP_TIME;
    }
    $LOGGER->error("DISK ID $id FAILED") if $disk_availability eq 'failed';
    $LOGGER->error("DISK ID $id TOO LONG WAIT($MAX_SLEEP_TIME sec)")
        if $sleep >= $MAX_SLEEP_TIME;
    return $disk_availability;
}

sub sacloud_disks {
    my $disks = $UA->get("$SAKURA_API_BASE/disk")->res->json;
    return [ map { +{ id => $_->{ID}, name => $_->{Name} } }
            @{ $disks->{Disks} } ];
}
__END__