view release on metacpan or  search on metacpan

bin/simple-backuper  view on Meta::CPAN

#!/usr/bin/perl

package App::SimpleBackuper;

use strict;
use warnings;
use feature ':5.14';
use Getopt::Long;
use JSON::PP;
use Try::Tiny;
use Crypt::OpenSSL::RSA;
use POSIX qw(strftime);
use Data::Dumper;
use Time::HiRes;
use App::SimpleBackuper::DB;
use App::SimpleBackuper::StorageLocal;
use App::SimpleBackuper::StorageSFTP;
use App::SimpleBackuper::Backup;
use App::SimpleBackuper::Info;
use App::SimpleBackuper::RestoreDB;
use App::SimpleBackuper::Restore;
use App::SimpleBackuper::StorageCheck;
use App::SimpleBackuper::_format;

$| = 1;

# libcrypt-openssl-rsa-perl
# libdigest-sha-perl
# libnet-sftp-foreign-perl

sub usage {
	say foreach @_;
	print foreach <DATA>;
	exit -1;
}

GetOptions(
	\my %options,
	'cfg=s', 'db=s', 'backup-name=s', 'path=s', 'storage=s', 'destination=s', 'priv-key=s', 'write', 'verbose', 'quiet'
) or usage();

my $command = shift;

$options{cfg} //= '~/.simple-backuper/config' if $command and grep {$command eq $_} qw(backup storage-check storage-fix stats);

my %state = (profile => {total => - Time::HiRes::time});

if($options{cfg}) {
	$options{cfg} =~ s/^~/(getpwuid($>))[7]/e;
	open(my $h, "<", $options{cfg}) or usage("Can't read config '$options{cfg}': $!");
	my $config;
	try {
		$config = JSON::PP->new->utf8->relaxed(1)->decode(join('', <$h>));
	} catch {
		usage("Error while parsing json in config '$options{cfg}': $!");
	};
	close($h);
	$options{$_} ||= $config->{$_} foreach qw(db storage compression_level public_key space_limit files);
	
	exists $options{compression_level} or usage("Config doesn't contains 'compression_level'");
	$options{compression_level} =~ /^\d$/
		and $options{compression_level} >= 1
		and $options{compression_level} <= 9
		or usage("Bad value of 'compression_level' in config. Must be 1 to 9");
	
	exists $options{public_key} or usage("Config doesn't contains 'public_key'");
	$options{public_key} =~ s/^~/(getpwuid($>))[7]/e;
	open($h, '<', $options{public_key}) or usage("Can't read public_key file '$options{public_key}': $!");
	$state{rsa} = Crypt::OpenSSL::RSA->new_public_key( join('', <$h>) );
	close($h);
	
	exists $options{space_limit} or usage("Config diesn't contains 'space_limit'");
	if($options{space_limit} =~ /^(\d+)(k|m|g|t)$/i) {
		$options{space_limit} = $1 * {k => 1e3, m => 1e6, g => 1e9, t => 1e12}->{lc $2};
	} else {
		usage("Bad value of space_limit ($options{space_limit}). It should be a number with K, M, G or T at the end");
	}
	
	exists $options{files} or usage("Config doesn't contains 'files'");
	ref($options{files}) eq 'HASH' or usage("'files' in config should be an object");
	usage("File rule '$_' priority in config should be a number") foreach grep {$options{files}->{ $_ } !~ /^\d+$/} keys %{$options{files}};
	{
		my %files_rules;
		while(my($mask, $priority) = each %{ $options{files} }) {
			$mask =~ s/^~([^\/]*)/(getpwuid($1 ? getpwnam($1) : $<))[7]/e;
			$mask =~ s/\/$//;
			Encode::_utf8_off($mask);
			$files_rules{ $mask } = $priority;
		}
		$options{files} = \%files_rules;
	}
}