#!/usr/bin/perl
use v5.10; use strict; use warnings;
use DateTime; use DateTime::Duration; use DateTime::Format::Duration; use DateTime::Format::Strptime; use Time::HiRes qw(time); use Path::Class qw(dir file); use File::stat; use IPC::Run qw(run); use Try::Tiny; use List::Util qw(any); use Scalar::Util qw(blessed); use Config::YAML; use Getopt::Long; use Pod::Usage; use Net::SFTP::Foreign; use Fcntl qw(:flock S_ISDIR);
my %options = ( config => ''.file($0)->absolute->dir->parent->file('etc', 'rsync-backup.yaml'), help => 0, list => 0, backup => 0, expire => 0, force => 0, 'dry-run' => 0, now => undef ); GetOptions(%options, 'config=s', 'help!', 'backup!', 'list!', 'expire!', 'dry-run!', 'force!', 'now=s') or pod2usage; if ($options{help}) { pod2usage(-verbose => 2); } unless (grep $_, @options{qw(backup list expire)}) { pod2usage('No operation specified'); }
my $config = Config::YAML->new( config => $options{config}, host => undef, root => '/mnt/backup', lock => '/run/rsync-backup.lock', ssh_cmd => '/usr/bin/ssh', ssh_opts => [qw()], mv_cmd => '/bin/mv', rm_cmd => '/bin/rm', btrfs_cmd => '/bin/btrfs', rsync_cmd => '/usr/bin/rsync', rsync_opts => [qw(-a -H -A -S -X -x --delete --delete-excluded -v --human-readable)], rsync_fake_super => 'auto', rsync_filters => [ '- /**/lost+found', '- /lost+found', '- ##', '- .#', '- *.tmp', '- *~' ], ); my $default_expire = { 'all' => '7 days', 'daily' => '14 days', 'weekly' => '6 months', 'monthly' => 'forever' }; my $default_min_snapshots = 2;
my $snapshot_name_format = '%Y%m%d-%H%M%S-%3N'; my $snapshot_name_parser = DateTime::Format::Strptime->new( pattern => $snapshot_name_format, time_zone => 'local' );
my $now = DateTime->from_epoch(epoch => time()); if($options{now}) { $now = $snapshot_name_parser->parse_datetime($options{now}); die "Cannot parse now, please use '$snapshot_name_format' format" unless($now); } my $local_now = $now->clone->set_time_zone('local'); my $now_snapshot_name = $local_now->strftime($snapshot_name_format);
my @interval_formats = ( DateTime::Format::Duration->new(pattern => '%m months'), DateTime::Format::Duration->new(pattern => '%m month'), DateTime::Format::Duration->new(pattern => '%e days'), DateTime::Format::Duration->new(pattern => '%e day'), DateTime::Format::Duration->new(pattern => '%ed'), DateTime::Format::Duration->new(pattern => '%H hours'), DateTime::Format::Duration->new(pattern => '%H hour'), DateTime::Format::Duration->new(pattern => '%Hh'), DateTime::Format::Duration->new(pattern => '%M minutes'), DateTime::Format::Duration->new(pattern => '%M minute') ); my $grace_interval = DateTime::Duration->new(minutes => 5);
my $expired_suffix = '.expired';
my $sftp; my @ssh_cmd; if ($config->{host}) { @ssh_cmd = ($config->{ssh_cmd}, @{$config->{ssh_opts}}, $config->{host}); my @rsync_ssh_cmd = ('--rsh', join(' ', ($config->{ssh_cmd}, @{$config->{ssh_opts}}))); push(@{$config->{rsync_opts}}, @rsync_ssh_cmd);
$sftp = Net::SFTP::Foreign->new(host => $config->{host},
ssh_cmd => $config->{ssh_cmd},
more => $config->{ssh_opts});
} if ($config->{rsync_fake_super} eq 'force' || ($config->{host} && $config->{rsync_fake_super} eq 'auto')) { #push(@{$config->{rsync_opts}}, '-M', '--fake-super'); push(@{$config->{rsync_opts}}, '--rsync-path', 'rsync --fake-super'); }
if ($sftp) { my $stat = $sftp->stat($config->{root}); unless ($stat && S_ISDIR($stat->perm)) { die "backup root not found"; } } else { unless(-d $config->{root}) { die "backup root not found"; } }
if ($options{list}) { while(my ($backup_name, $backup) = each(%{$config->{backups}})) { my $backup_dir = dir($config->{root}, ($backup->{backup_dir} || $backup_name)); my $snapshots = load_snapshots($backup_dir);
say "Snapshots for '$backup_name':";
foreach (@$snapshots) {
say " $_->{dir}";
}
}
}
if ($options{backup}) { my $lock_fh = lock_file();
while(my ($backup_name, $backup) = each(%{$config->{backups}})) {
my $backup_dir = dir($config->{root}, ($backup->{backup_dir} || $backup_name));
my $current_dir = $backup_dir->subdir('current');
my $snapshot_dir = $backup_dir->subdir($now_snapshot_name);
my $log_dir = $backup_dir->subdir('log');
my $last = $backup_dir->file('last');
if ($sftp) {
$sftp->mkpath($backup_dir);
} else {
unless(-d $backup_dir) {
$backup_dir->mkpath();
}
}
my $snapshots = load_snapshots($backup_dir);
my $last_dir = 0 + @$snapshots ? $snapshots->[-1]->{dir} : undef;
my $log_file = $log_dir->file($now_snapshot_name.'.log');
my $tmp_log_file;
if ($sftp) {
$sftp->mkpath($log_dir);
$tmp_log_file = Path::Class::tempdir(CLEANUP => 1)->file($now_snapshot_name.'.log');
} else {
$log_dir->mkpath();
$tmp_log_file = $log_file;
}
say "Backing up '$backup_name':";
say " current dir: $current_dir";
say " last dir: ".($last_dir ? $last_dir : "<none>");
say " snapshot dir: $snapshot_dir";
say " log file: $log_file";
my $interval;
foreach (@interval_formats) {
$interval = $_->parse_duration($backup->{age});
last if($interval->is_positive);
}
unless($interval->is_positive) {
$interval = DateTime::Duration->new(days => 1);
say "Cannot parse backup interval, using default: 1 day";
}
$interval -= $grace_interval;
my $stat = $sftp ? $sftp->stat($last) : (-e $last && stat($last));
if ($stat && $stat->mtime() > ($now - $interval)->epoch()) {
if($options{force}) {
say "Backup is recent but we are forced to backup anyway";
} else {
say "Backup is recent, skipping";
next;
}
}
notify("Starting '$backup_name'");
my $log;
try {
$log = $tmp_log_file->opena();
} catch {
notify("Cannot open backup log for '$backup_name': $_", 'error');
die $_;
};
try {
my $start_time = DateTime->now();
local *STDOUT;
local *STDERR;
open(STDOUT, '>&', $options{'dry-run'} ? 1 : $log) || die "Cannot redirect STDOUT: $!";
open(STDERR, '>&', $options{'dry-run'} ? 2 : $log) || die "Cannot redirect STDERR: $!";
die "Backup root not specified" unless($backup->{root});
if($backup->{check}) {
run(['bash', '-c', $backup->{check}], '>&', $log) || die "pre backup check failed: $?, skipping backup";
}
if ($config->{subvolumes}) {
if (!($sftp ? $sftp->test_e($current_dir) : -e $current_dir)) {
my @cmd = (@ssh_cmd, $config->{btrfs_cmd}, 'subvolume', 'create', $current_dir);
if ($options{'dry-run'}) {
say "create subvolume command: ".join(' ', @cmd);
} else {
run(\@cmd, '>&', $log) or die "cannot create subvolume: $?";
}
}
}
my @rsync_cmd = ($config->{rsync_cmd},
@{$config->{rsync_opts}},
map({ ('-f', $_) } @{$config->{rsync_filters}}, @{$backup->{filters} || []}),
($last_dir && !$config->{subvolumes} ? ('--link-dest', $last_dir) : ()),
$backup->{root}.'/',
($config->{host} ? $config->{host}.':' : '').$current_dir);
my @mv_cmd;
if ($config->{subvolumes}) {
@mv_cmd = (@ssh_cmd, $config->{btrfs_cmd}, 'subvolume', 'snapshot', '-r', $current_dir, $snapshot_dir);
} else {
@mv_cmd = (@ssh_cmd, $config->{mv_cmd}, $current_dir, $snapshot_dir);
};
if ($options{'dry-run'}) {
say "rsync command: ".join(' ', @rsync_cmd);
say "mv command: ".join(' ', @mv_cmd);
} else {
#Backup should not fail if files vanish during backup, so ignore return code 24
run(\@rsync_cmd, '>&', $log) or ($? >> 8 == 24) or die "rsync error: $?";
run(\@mv_cmd, '>&', $log) or die "move error: $?";
if ($sftp) {
$sftp->put_content("", $last);
$sftp->utime($last, $now->epoch, $now->epoch);
} else {
$last->touch();
utime($now->epoch, $now->epoch, $last);
}
}
my $end_time = DateTime->now();
my $elapsed = DateTime::Format::Duration->new(pattern => '%Hh%Mm%Ss')
->format_duration(($end_time - $start_time)->clock_duration);
notify("Completed '$backup_name', took: ".$elapsed);
say $log "Completed, took: ".$elapsed;
} catch {
notify("Error '$backup_name': $_", 'error');
say $log "Error: $_";
};
$log->close;
if ($sftp) {
$sftp->put($tmp_log_file, $log_file);
$tmp_log_file->remove;
}
}
$lock_fh->close;
}
if ($options{expire}) { my $lock_fh = lock_file();
my @expire_types = (
{ key => 'all' },
{ key => 'daily', truncate => 'day', subtract => { days => 1 } },
{ key => 'weekly', truncate => 'week', subtract => { weeks => 1 } },
{ key => 'monthly', truncate => 'month', subtract => { months => 1 } });
while(my ($backup_name, $backup) = each(%{$config->{backups}})) {
my $backup_dir = dir($config->{root}, ($backup->{backup_dir} || $backup_name));
my $snapshots = load_snapshots($backup_dir);
my $expire_config = $backup->{expire} || $default_expire;
my $min_snapshots = $backup->{min_snapshots} || $default_min_snapshots;
if(0 + @$snapshots <= $min_snapshots) {
say "Not enough snapshots to expire in '$backup_name'";
next;
}
foreach (1 .. $min_snapshots) {
$snapshots->[-$_]->{save} = 1;
}
my %expire;
while(my ($name, $duration) = each(%$expire_config)) {
unless (any { $name eq $_->{key} } @expire_types) {
say "Warning: unknown expiration key: $name, skipping";
next;
}
if ($duration eq 'forever') {
# nothing to do, leave as is
} else {
foreach (@interval_formats) {
my $parsed = $_->parse_duration($duration);
if($parsed->is_positive) {
$duration = $parsed;
last;
}
}
unless (blessed($duration)) {
say "Warning: cannot parse expiration interval for $name: $duration, skipping";
next;
}
}
$expire{$name} = $duration;
}
foreach my $expire_type (@expire_types) {
my $key = $expire_type->{key};
my $duration = $expire{$key};
next unless $duration;
if ($key eq 'all') {
if (''.$duration ne 'forever') {
my $from_date = $local_now->clone->subtract_duration($expire{$key});
foreach (@$snapshots) {
$_->{save} = 1 if($_->{date} > $from_date);
}
}
} else {
my $to_date = $local_now->clone->truncate(to => $expire_type->{truncate});
my $end_date = ''.$duration eq 'forever' ? $snapshots->[0]->{date}
: $to_date->clone->subtract_duration($duration);
my @snapshots = grep { $_->{date} >= $end_date } @$snapshots;
while($end_date <= $to_date) {
my $from_date = $to_date->clone->subtract(%{$expire_type->{subtract}});
my @current = grep {$_->{date} > $from_date && $_->{date} <= $to_date} @snapshots;
$current[-1]->{save} = 1 if(@current);
$to_date = $from_date;
}
}
}
if ($options{'dry-run'}) {
say "Snapshots to expire for '$backup_name':";
foreach (@$snapshots) {
say " $_->{dir}" unless $_->{save};
}
} else {
foreach (@$snapshots) {
next if $_->{save};
notify("Expiring '$backup_name/".$_->{date}->strftime($snapshot_name_format)."'");
try {
if ($config->{subvolumes}) {
#apparently owner cannot delete readonly subvolumes, we have to make them writable first
my @make_writable_cmd = [@ssh_cmd, $config->{btrfs_cmd}, 'property', 'set', '-ts', $_->{dir}, 'ro', 'false'];
run(@make_writable_cmd) or die "make writable error: $?";
my @remove_cmd = [@ssh_cmd, $config->{btrfs_cmd}, 'subvolume', 'delete', $_->{dir}];
run(@remove_cmd) or die "remove error: $?";
} else {
my @cmd = [@ssh_cmd, $config->{mv_cmd}, $_->{dir}, $_->{dir}.$expired_suffix];
run(@cmd) or die "remove error: $?";
}
} catch {
notify("Error '$backup_name': $_", 'error');
}
}
}
if (!$config->{subvolumes}) {
my $expired_snapshots = load_snapshots($backup_dir, $expired_suffix);
if ($options{'dry-run'}) {
say "Snapshots to remove for '$backup_name':";
foreach (@$expired_snapshots) {
say " $_->{dir}" unless $_->{save};
}
} else {
foreach (@$expired_snapshots) {
next if $_->{save};
notify("Removing '$backup_name/".$_->{date}->strftime($snapshot_name_format)."'");
try {
my $start_time = DateTime->now();
run([@ssh_cmd, $config->{rm_cmd}, '-r', '-f', $_->{dir}]) or die "remove error: $?";
my $end_time = DateTime->now();
my $elapsed = DateTime::Format::Duration->new(pattern => '%Hh%Mm%Ss')
->format_duration(($end_time - $start_time)->clock_duration);
notify("Done removing '$backup_name/"
.$_->{date}->strftime($snapshot_name_format)."', took: ".$elapsed);
} catch {
notify("Error '$backup_name': $_", 'error');
}
}
}
}
}
$lock_fh->close;
}
sub lock_file { my $lock_fh = file($config->{lock})->openw() or die "Can't write to $config->{lock} $!"; flock($lock_fh, LOCK_EX | LOCK_NB) or die "Can't not lock '$config->{lock}' - $!"; truncate($lock_fh, 0); say $lock_fh $$; return $lock_fh; }
sub load_snapshots { my ($backup_dir, $suffix) = @_; $suffix //= ''; my @snapshots; if ($sftp) { foreach my $entry (@{$sftp->ls($backup_dir)}) { next unless (S_ISDIR($entry->{a}->perm)); my $name = $entry->{filename}; next unless ($name =~ s/\Q$suffix\E$//); my $date = $snapshot_name_parser->parse_datetime($name); next unless($date); push(@snapshots, {date => $date, dir => file($backup_dir, $entry->{filename})}); } } else { while (my $file = $backup_dir->next) { next unless ($file->is_dir); my $name = ''.$file; next unless ($name =~ s/\Q$suffix\E$//); my $date = $snapshot_name_parser->parse_datetime($name); next unless($date); push(@snapshots, {date => $date, dir => $file}); } } @snapshots = sort { $a->{date} cmp $b->{date} } @snapshots; return @snapshots; }
sub notify { my ($message, $level) = @; say $message; my $header = 'Backup'; $level ||= 'info'; $header = quotemeta($header); $message = quotemeta($message); $level = quotemeta($level); run(['who'], '>', sub { my %seen; while($[0] =~ /^(\w+)\s+.*?(?:(:(\d+)(?:.\d+)?))$/mg) { my ($user, $display) = ($1, $2); my $uid = getpwnam($user); next if($seen{$user}->{$display}); $seen{$user}->{$display} = 1; run(['sudo', '-u', $user, 'bash', '-c', qq{XDG_RUNTIME_DIR=/run/user/$uid DISPLAY=:$display notify-send -i "$level" "$header" "$message"}]); } }); }
END
=head1 NAME
rsync-backup - Simple script that maintains your backups using rsync.
=head1 SYNOPSIS
rsync-backup [--config=config] --backup [--force] [--dry-run] [--now=date]
rsync-backup [--config=config] --list
rsync-backup [--config=config] --expire [--dry-run] [--now=date]
rsync-backup --help
=head1 OPTIONS
=over 8
=item B<--help>
Prints a brief help message and exits.
=item B<--config>
Specifies config file for you backup configuration.
=item B<--backup>
Runs backup opration.
=item B<--expire>
Expires (deletes) old backups.
=item B<--list>
Lists existing backups.
=item B<--force>
Forces backup even if existing backup is not old enough.
=item B<--dry-run>
No real backup or removal would happen.
=item B<--now>
Forces given date on a script. Useful when convering backups from other systems
=back
=head1 DESCRIPTION
This program maintains backups of your system using rsync.
=cut