/backup-manager-upload
http://github.com/sukria/Backup-Manager · Perl · 1238 lines · 921 code · 184 blank · 133 comment · 112 complexity · 7f520a2b61382d37fcbb21133683b83e MD5 · raw file
- #!/usr/bin/perl
- # Backup Manager Upload - Multiprotocol uploader for backup-manager.
- # Copyright Š 2005-2016 The Backup Manager Authors
- #
- # See the AUTHORS file for details.
- use strict;
- use warnings;
- use BackupManager::Config;
- use BackupManager::Dialog;
- use POSIX qw(strftime);
- use File::Temp qw(tempfile);
- use File::Basename;
- use File::stat;
- use constant TRUE => 1;
- use constant FALSE => 0;
- use constant E_SUCCESS => 0;
- use constant E_INVALID => 10;
- use constant E_FTP_FAILED => 20;
- use constant E_SCP_FAILED => 21;
- use constant E_S3_FAILED => 22;
- use constant E_UNKNOWN => 23;
- # global vars
- my $scp = '/usr/bin/scp';
- my $ssh = '/usr/bin/ssh';
- my $gpg = '/usr/bin/gpg';
- my $split = '/usr/bin/split';
- my $g_list = 0;
- my $g_host = undef;
- my $g_user = undef;
- my $g_pass = undef;
- my $g_ftpclean = undef;
- my $g_ftptest = undef;
- my $g_s3clean = undef;
- my $g_s3max_size = 4*1024*1024*1024; # 4G
- my $g_sshclean = undef;
- my $g_protocol = 'scp';
- my $g_remote_dir= '/var/archives/uploads';
- my $g_bucket = undef;
- my $g_root_dir = '/var/archives';
- my $g_key_file = undef;
- my $g_gpg_recipient = undef;
- # first get the args
- BackupManager::Config::getopt("$0 -m=mode -h=host -u=user [options] date\n
- -v|--verbose : Print on STDOUT what happens.
- -m|--mode : Transfer mode to use : ftp, scp, s3, or ssh-gpg.
- -h|--host : Remote hosts to connect to (separated by commas).
- -u|--user : User to use for connection.
- -p|--password : remote user's password (needed for ftp and s3 uploads).
- -k|--key : SSH key file to use for opening the scp session (only needed for scp mode).
- -d|--directory : Directory on the remote host where files will go (default is /var/archives/uploads).
- -b|--bucket : Amazon S3 storage bucket to use
- -r|--root : Root directory of your archives (default /var/archives).
- -l|--list : Only prints which files would be uploaded.
- --gpg-recipient : Selects the public key used for gpg encryption (only for ssh-gpg mode).
- --ftp-purge : Purge the remote directory before uploading files in FTP mode.
- --ftp-test : Sends a test file before uploading archives in FTP mode.
- --s3-purge : Purge the remote directory before uploading files in S3 mode.
- --s3-maxsize : Maximum file size to upload. If file execeds this size, it will be `split`. Default is 4GB
- --ssh-purge : Purge the remote directory before uploading files in SSH mode.
- date : All files >= date will be uploaded. Either a valid date (YYYYMMDD) or one of this words : today, yesterday",
- 'verbose' => sub { init_dialog($_[1]) },
- 'mode|m=s' => \$g_protocol,
- 'host|h=s' => \$g_host,
- 'user|u=s' => \$g_user,
- 'password|p=s' => \$g_pass,
- 'directory|d=s' => \$g_remote_dir,
- 'bucket|b=s' => \$g_bucket,
- 'key|k=s' => \$g_key_file,
- 'root|r=s' => \$g_root_dir,
- 'gpg-recipient=s' => \$g_gpg_recipient,
- 'ftp-purge' => \$g_ftpclean,
- 'ftp-test' => \$g_ftptest,
- 's3-purge' => \$g_s3clean,
- 's3-maxsize=i' => \$g_s3max_size,
- 'ssh-purge' => \$g_sshclean,
- 'list' => \$g_list,
- );
- ##############################################################
- # Common subs (for all methods)
- ##############################################################
- # {{{
- sub get_formated_date($)
- {
- my $date = shift;
- unless (defined $date) {
- print_error "date is required, enter today, yesterday or YYYYMMDD";
- exit E_INVALID;
- }
- if ($date eq 'today') {
- return strftime ('%Y%m%d', localtime);
- }
- elsif ($date eq 'yesterday') {
- return strftime ('%Y%m%d', localtime(time - (24 * 3600)));
- }
- elsif ($date =~ /^\d{4}\d{2}\d{2}$/) {
- return $date;
- }
- else {
- print_error "date $date is not valid, enter today, yesterday or YYYYMMDD";
- exit E_INVALID;
- }
- }
- # The idea behind BM_UPLOADED_ARCHIVES is to have a database of what archives
- # have been uploaded so far. This allows multiple execution of upload actions
- # within a day without resending all archives of the day from the beginning.
- # Add one file,host pair to $BM_UPLOADED_ARCHIVES database.
- # Called immediately *after* successful uploading of an archive.
- sub appendto_uploaded_archives($$)
- {
- my $file = shift;
- my $host = shift;
- unless ( defined $file and defined $host ) {
- print_error "required args needed";
- return FALSE;
- }
- my $upload_fname = $ENV{BM_UPLOADED_ARCHIVES};
- unless ( defined $upload_fname ) {
- # Uncomment next line if you want the mandatory use
- # of BM_UPLOADED_ARCHIVES (ie always have it around).
- #print_error "BM_UPLOADED_ARCHIVES is not defined";
- return FALSE;
- }
- # if $file already in database, append host to that line;
- # else append a lines "$file $host" to the end.
- my $io_error = 0;
- if ( ! system( "grep -q \"^$file \" $upload_fname" ) ) {
- my $cmd = "sed -i \"s:^$file .*\$:\& $host:\" $upload_fname";
- $io_error = system("$cmd");
- }
- elsif ( open(my $fh, ">>", $upload_fname) ) {
- print($fh "$file $host\n") or $io_error = 1;
- close $fh;
- }
- else {
- $io_error = 2;
- }
- if ( $io_error ) {
- print_error "IO error: did not update $upload_fname with '$file $host'";
- return FALSE;
- }
- return TRUE;
- }
- # Get all files of the specified date; filter the list through
- # BM_UPLOADED_ARCHIVES if it is set in the environment.
- # NOTE: Doing the filtering here implies that the archive is considered
- # uploaded if a single upload to a host succeeds; that is even when there
- # are failures to other hosts (in case of multiple host uploading).
- # To consider it uploaded when all hosts succeed, the filtering must be
- # transfered to the individual upload subroutines (and check for existence
- # of file,host pair in the database).
- #
- sub get_files_list_from_date($)
- {
- my $date = shift;
- return [] unless defined $date;
- my $ra_files = [];
- unless (-d $g_root_dir) {
- my $msg = "root dir specified does not exists : $g_root_dir";
- print_error $msg;
- exit E_INVALID;
- }
- # make sure we can read the root dir, when the secure mode is
- # enabled, the repository might not be readable by us...
- unless (-r $g_root_dir) {
- print_error "The repository $g_root_dir is not readable by user \"$ENV{USER}\".";
- if ($ENV{BM_REPOSITORY_SECURE} eq "true") {
- print_error "The secure mode is enabled (BM_REPOSITORY_SECURE),";
- print_error "the upload user ($g_user) must be in the group \"BM_REPOSITORY_GROUP\".";
- }
- exit E_INVALID;
- }
- my $upload_fname = $ENV{BM_UPLOADED_ARCHIVES};
- if ( defined $upload_fname ) {
- # filter file list through the BM_UPLOADED_ARCHIVES database
- while (<$g_root_dir/*$date*>) {
- my $file = $_;
- my $cmd = "grep -q '$file' $upload_fname";
- if ( system ("$cmd") ) {
- push @{$ra_files}, $file;
- }
- }
- }
- else {
- while (<$g_root_dir/*$date*>) {
- push @{$ra_files}, $_;
- }
- }
- return $ra_files;
- }
- sub get_hosts_from_str($) {
- my ($hosts_str) = @_;
- return [] unless defined $hosts_str;
- my $ra_hosts = [];
- $hosts_str =~ s/\s//g;
- foreach my $host (split /,/, $hosts_str) {
- push @{$ra_hosts}, $host;
- }
- return $ra_hosts;
- }
- sub get_tempfile(;$) {
- my ($template) = @_;
- $template ||= 'bmu-XXXXXX';
-
- return tempfile(
- TEMPLATE => $template,
- DIR => $ENV{BM_TEMP_DIR},
- UNLINK => 1,
- );
- }
- # }}}
- ##############################################################
- # SSH Mode
- ##############################################################
- # {{{
- # returns all the ssh otpions needed for a valid SSH connection
- sub get_ssh_opts {
- # look for a port to use
- my $ssh_port_switch="";
- my $scp_port_switch="";
- if ($ENV{BM_UPLOAD_SSH_PORT}) {
- $ssh_port_switch = "-p ".$ENV{BM_UPLOAD_SSH_PORT};
- $scp_port_switch = "-P ".$ENV{BM_UPLOAD_SSH_PORT};
- }
- # look for keyfile to use
- my $keyfile_switch="";
- if (defined $g_key_file and (-e $g_key_file)) {
- $keyfile_switch = "-i $g_key_file";
- }
- elsif (! (-e $g_key_file)) {
- print_error "Unable to read the SSH identity key : $g_key_file";
- exit E_SCP_FAILED;
- }
- return {
- ssh => "$ssh_port_switch $keyfile_switch -o BatchMode=yes",
- scp => "$scp_port_switch $keyfile_switch -B"
- };
- }
- # Purge remote archives over SSH
- # Uses backup-manager-purge
- sub ssh_clean_directory
- {
- my ($user, $host, $location) = @_;
- return 0 unless defined $user and
- defined $host and
- defined $location;
-
- my $ssh_options = get_ssh_opts->{'ssh'};
- # the remote time to leave could be different as the local one.
- my $BM_ARCHIVE_TTL = $ENV{BM_ARCHIVE_TTL};
- if (defined $ENV{BM_UPLOAD_SSH_TTL} and
- length ($ENV{BM_UPLOAD_SSH_TTL})) {
- $BM_ARCHIVE_TTL = $ENV{BM_UPLOAD_SSH_TTL};
- }
- return 0 unless defined $BM_ARCHIVE_TTL;
- print_info "Cleaning remote directory through SSH";
- # First, create the list of existing archives
- my ($fh, $in) = get_tempfile('ssh-archives-XXXXXX');
- my $cmd = "$ssh $ssh_options $user".'@'.$host." ls $location/*";
- my $buffer = `$cmd`;
- print $fh $buffer;
- close $fh;
- my ($fh_out, $out) = get_tempfile('bm-purge-out-ssh-XXXXXX');
- system("/usr/bin/backup-manager-purge --ttl=$BM_ARCHIVE_TTL --files-from=$in > $out");
- open (STDOUT_CMD, $out);
- while (<STDOUT_CMD>) {
- chomp();
- print_info "Purging $_";
- $cmd = "$ssh $ssh_options $user".'@'.$host." rm -f $_";
- system ("$cmd");
- }
- close STDOUT_CMD;
- undef $fh_out;
- }
- # send one file with scp
- # since Net::SSH is a wrapper to a system call of ssh, I don't use it.
- sub send_file_with_scp($$$$$)
- {
- my ($file, $user, $host, $location, $g_gpg_recipient) = @_;
- return 0 unless defined $file and
- defined $user and
- defined $host and
- defined $location;
- my $opts = get_ssh_opts;
- my ($ssh_opts, $scp_opts) = ($opts->{'ssh'}, $opts->{'scp'});
-
- my $cmd = "";
- if ( defined $g_gpg_recipient ) {
- my $file_base = basename($file);
- $cmd = "$gpg --encrypt --recipient $g_gpg_recipient --output - --batch $file | ";
- $cmd .= "$ssh $ssh_opts -e none $user".'@'."$host ";
- $cmd .= "\"cat - > $location/$file_base.gpg\" >&2";
- }
- else {
- $cmd = "$scp $scp_opts $file $user".'@'.$host.':'.$location." >&2";
- }
- # we use eval here to avoid crash with bad keys
- my $ret = eval { system($cmd) };
- if ($@ or $ret) {
- print_error "$scp failed for $file : $@ (command was : $cmd). " if $@;
- print_error "$scp failed for $file (command was : $cmd)" if $ret;
- print_error ("Unable to upload \"$file\". ".($! || $@ || $ret));
- return 0;
- }
- else {
- # use same name in both cases (gpg encryption is done on the fly);
- # continue if writing to uploaded archives file fails.
- appendto_uploaded_archives($file, $host);
- }
- return 1;
- }
- # How to upload files with scp.
- # Note that Key Authentication is used, see man ssh-keygen.
- sub send_files_with_scp($$$$$)
- {
- # getting args
- my ($user, $ra_hosts, $repository, $ra_files, $g_gpg_recipient) = @_;
- unless (defined $user and
- defined $ra_hosts and
- defined $ra_files and
- defined $repository) {
- print_error "required args needed";
- return FALSE;
- }
- # is scp here ?
- unless (-x $scp) {
- print_error "$scp is not here, cannot use this mode for transfer.";
- return FALSE;
- }
- # if gpg requested, is it here?
- if (defined $g_gpg_recipient and (not -x $gpg)) {
- print_error "$gpg is not here, cannot use this mode for transfer.";
- return FALSE;
- }
- # if gpg requested, check whether given key is valid
- if (defined $g_gpg_recipient) {
- my $gpg_out = `$gpg --batch --list-keys '$g_gpg_recipient' 2>/dev/null`;
- if ($gpg_out !~ /^pub/mi) {
- print_error "gpg recipient $g_gpg_recipient is not a valid key, cannot use this mode for transfer.";
- return FALSE;
- }
- }
-
- my $opts = get_ssh_opts;
- my ($ssh_opts, $scp_opts) = ($opts->{'ssh'}, $opts->{'scp'});
- # loop on each hosts given and connect to them.
- foreach my $host (@{$ra_hosts}) {
-
- # make sure the target directory exists remotely
- my $ls_rep_cmd = "$ssh $ssh_opts $user\@$host \"ls $repository\" 2>/dev/null || echo notfound";
- my $out = `$ls_rep_cmd`;
- chomp $out;
- # if failed,
- if ($out eq 'notfound') {
- print_info "Creating $repository on $host";
- my $mkdir_rep_cmd = "$ssh $ssh_opts $user\@$host 'mkdir -p $repository' 2>/dev/null || echo failed";
- $out = `$mkdir_rep_cmd`;
- chomp $out;
- if ($out eq 'failed') {
- print_error "Unable to create $host:$repository";
- return FALSE;
- }
- }
-
- foreach my $file (@{$ra_files}) {
- chomp $file;
-
- if (-f $file and
- send_file_with_scp($file, $user, $host,
- $repository, $g_gpg_recipient)) {
- print_info "File $file uploaded successfully.";
- }
- elsif (! -f $file) {
- print_error "File $file cannot be uploaded, it does not exist locally.";
- return FALSE;
- }
- else {
- print_error "Error during the scp upload of $file";
- return FALSE;
- }
- }
- # cleaning the repo
- ssh_clean_directory ($user, $host, $repository) if ($g_sshclean);
- }
- return TRUE;
- }
- # }}}
- ##############################################################
- # FTP Mode
- ##############################################################
- # {{{
- # Function for testing upload before sending the archives
- # The test file is uploaded, and its size is compared to the local file.
- # If the size is correct, the test is successfull and we can continue
- # with the archives.
- sub ftp_upload_test_file($)
- {
- my $ftp = shift;
-
- my $BM_REPOSITORY_ROOT = $ENV{BM_REPOSITORY_ROOT};
- my $ftp_test_filename = "2mb_file.dat";
- my $file_to_send = $BM_REPOSITORY_ROOT . "/" . $ftp_test_filename;
-
- if (!ftp_put_file ($ftp, $file_to_send)) {
- print_error "Unable to transfer $file_to_send: " . $ftp->message;
- return FALSE;
- }
- else {
- my $remote_filesize = $ftp->size($ftp_test_filename);
- # Delete both test files
- system("rm -f $BM_REPOSITORY_ROOT/$ftp_test_filename");
- $ftp->delete($ftp_test_filename);
- # Test filesize (should be 2MB)
- if($remote_filesize == 2097152) {
- return TRUE;
- }
- else {
- print_error "Remote and local test files filesize mismatch";
- return FALSE;
- }
- }
- }
- sub ftptls_upload_test_file($)
- {
- my $ftp = shift;
-
- my $BM_REPOSITORY_ROOT = $ENV{BM_REPOSITORY_ROOT};
- my $ftp_test_filename = "2mb_file.dat";
- my $file_to_send = $BM_REPOSITORY_ROOT . "/" . $ftp_test_filename;
-
- if (!ftptls_put_file ($ftp, $file_to_send)) {
- print_error "Unable to transfer $file_to_send: " . $ftp->message;
- return FALSE;
- }
- else {
- my $remote_filesize = $ftp->size($ftp_test_filename);
- # Delete both test files
- system("rm -f $BM_REPOSITORY_ROOT/$ftp_test_filename");
- $ftp->delete($ftp_test_filename);
- # Test filesize (should be 2MB)
- if($remote_filesize == 2097152) {
- return TRUE;
- }
- else {
- print_error "Remote and local test files filesize mismatch";
- return FALSE;
- }
- }
- }
- # Function for purging a directory
- # over FTP, the same way as the repository is purged.
- # Every files with a date field too old according to BM_UPLOAD_FTP_TTL
- # will be deleted.
- sub ftp_clean_directory($)
- {
- my $ftp = shift;
-
- # the remote time to leave could be different as the local one.
- my $BM_ARCHIVE_TTL = $ENV{BM_ARCHIVE_TTL};
- if (defined $ENV{BM_UPLOAD_FTP_TTL} and
- length ($ENV{BM_UPLOAD_FTP_TTL})) {
- $BM_ARCHIVE_TTL = $ENV{BM_UPLOAD_FTP_TTL};
- }
- return 0 unless defined $BM_ARCHIVE_TTL;
- print_info "Cleaning remote directory through FTP";
- # First, create the list of existing archives
- my ($fh, $filename) = get_tempfile('ftp-archives-XXXXXX');
- my $BM_UPLOAD_FTP_SECURE = $ENV{"BM_UPLOAD_FTP_SECURE"};
- my $ra_files;
- if ($BM_UPLOAD_FTP_SECURE eq "true") {
- $ra_files = $ftp->list();
- }
- else {
- $ra_files = $ftp->ls();
- }
- foreach my $file (@$ra_files) {
- print $fh "$file\n";
- }
- close $fh;
-
- # Then delete every file listed as "outaded" by backup-manager-purge
- my ($fh_out, $out) = get_tempfile('bm-purge-out-ftp-XXXXXX');
- system ("/usr/bin/backup-manager-purge --ttl=$BM_ARCHIVE_TTL --files-from=$filename > $out");
- open (STDOUT_CMD, "<$out");
- while (<STDOUT_CMD>) {
- chomp();
- print_info "Purging $_";
- $ftp->delete ($_) or print_error "Unable to delete \"$_\".";
- }
- close STDOUT_CMD;
- undef $fh;
- return 1;
- }
- sub ftp_connect_to_host ($)
- {
- my ($host) = @_;
- my $ftp;
- # get the passive mode from the configuration
- # default is set to true.
- my $BM_UPLOAD_FTP_PASSIVE = $ENV{"BM_UPLOAD_FTP_PASSIVE"};
- unless (defined $BM_UPLOAD_FTP_PASSIVE) {
- $BM_UPLOAD_FTP_PASSIVE = "true";
- }
- if ($BM_UPLOAD_FTP_PASSIVE eq "true") {
- $BM_UPLOAD_FTP_PASSIVE="1";
- }
- elsif ($BM_UPLOAD_FTP_PASSIVE eq "false") {
- $BM_UPLOAD_FTP_PASSIVE="0";
- }
- else {
- print_error "Unsupported value for BM_UPLOAD_FTP_PASSIVE : $BM_UPLOAD_FTP_PASSIVE";
- return undef;
- }
-
- # get the log level from the configuration for debug mode
- my $BM_LOGGER_LEVEL = $ENV{"BM_LOGGER_LEVEL"};
- unless (defined $BM_LOGGER_LEVEL) {
- $BM_LOGGER_LEVEL = "warning";
- }
- if ($BM_LOGGER_LEVEL eq "debug") {
- $BM_LOGGER_LEVEL="1";
- }
- else {
- $BM_LOGGER_LEVEL="0";
- }
- # get the timeout from the configuration
- # default is set to 120.
- my $BM_UPLOAD_FTP_TIMEOUT = $ENV{"BM_UPLOAD_FTP_TIMEOUT"};
- unless (defined $BM_UPLOAD_FTP_TIMEOUT) {
- $BM_UPLOAD_FTP_TIMEOUT = 120;
- }
- # trying to get Net::FTP.
- eval "use Net::FTP";
- if ($@) {
- print_error "Net::FTP is not available, cannot use ftp transfer mode";
- return undef;
- }
- eval {
- $ftp = new Net::FTP (
- $host,
- Debug => $BM_LOGGER_LEVEL,
- Timeout => $BM_UPLOAD_FTP_TIMEOUT,
- Passive => $BM_UPLOAD_FTP_PASSIVE);
- };
- if ($@) {
- print_error "Unable to use the Net::FTP Perl module : $@";
- return undef;
- }
- return $ftp;
- }
- sub ftptls_connect_to_host ($)
- {
- my ($host) = @_;
- my $ftp;
- eval "use Net::Lite::FTP";
- if ($@) {
- print_error "Net::Lite::FTP is not available, cannot use ftp secured transfer mode";
- return undef;
- }
- eval {
- $ftp = Net::Lite::FTP->new ();
- $ftp->open ($host, "21");
- };
- if ($@) {
- print_error "Unable to use the Net::Lite::FTP Perl module : $@";
- return undef;
- }
- return $ftp;
- }
- # How to upload files with ftp.
- # We'll use the Net::FTP or the Net::Lite::FTP (for secured mode) module here.
- # Net::Lite::FTP can be found here :
- # http://search.cpan.org/~eyck/Net-Lite-FTP-0.61/lib/Net/Lite/FTP.pm
- sub send_files_with_ftp($$$$$)
- {
- # getting args
- my ($user, $passwd, $ra_hosts, $repository, $ra_files) = @_;
- unless (defined $user and
- defined $passwd and
- defined $ra_hosts and
- defined $ra_files and
- defined $repository) {
- print_error "required args needed";
- return FALSE;
- }
-
- # get the secure mode from the configuration
- # default is set to false.
- my $BM_UPLOAD_FTP_SECURE = $ENV{"BM_UPLOAD_FTP_SECURE"};
- unless (defined $BM_UPLOAD_FTP_SECURE) {
- $BM_UPLOAD_FTP_SECURE = "false";
- }
- if ($BM_UPLOAD_FTP_SECURE eq "true") {
- $BM_UPLOAD_FTP_SECURE="1";
- }
- elsif ($BM_UPLOAD_FTP_SECURE eq "false") {
- $BM_UPLOAD_FTP_SECURE="0";
- }
- else {
- print_error "Unsupported value for BM_UPLOAD_FTP_SECURE : $BM_UPLOAD_FTP_SECURE";
- return FALSE;
- }
- # loop on each hosts given and connect to them.
- foreach my $host (@{$ra_hosts}) {
- my $ftp;
-
- # The FTP over TLS transfer mode
- if ($BM_UPLOAD_FTP_SECURE) {
- $ftp = ftptls_connect_to_host ($host);
- unless (defined $ftp) {
- print_error "Unable to connect to host: $host";
- return FALSE;
- }
- unless (ftptls_login($ftp, $user, $passwd)) {
- print_error "Unable to login on ${host} in FTP TLS mode.";
- return FALSE;
- }
- unless (ftptls_cwd($ftp, $repository)) {
- print_info "The directory ${repository} does not exist, trying to create it.";
- unless (ftptls_mkdir($ftp, $repository)) {
- print_error "Unable to create directory ${repository} in FTP TLS mode: " . $ftp->message;
- return FALSE;
- }
- }
- print_info "Logged on $host, in $repository (FTP TLS mode)";
- }
- # The unencrypted FTP transfers
- else {
- $ftp = ftp_connect_to_host ($host);
- unless (defined $ftp) {
- print_error "Unable to connect to host: $host";
- return FALSE;
- }
- unless (ftp_login($ftp, $user, $passwd)) {
- print_error "Unable to login on ${host} in FTP mode.";
- return FALSE;
- }
- unless (ftp_cwd($ftp, $repository)) {
- print_info "The directory ${repository} does not exist, trying to create it.";
- unless (ftp_mkdir($ftp, $repository)) {
- print_error "Unable to create directory ${repository} in FTP mode: " . $ftp->message;
- return FALSE;
- }
- }
- print_info "Logged on $host, in $repository (FTP binary mode)";
- }
- # Now that we're connected and logged in, test an upload if needed
- if ($g_ftptest) {
- if ($BM_UPLOAD_FTP_SECURE) {
- if (!ftptls_upload_test_file($ftp)) {
- print_error "Unable to transfer test file";
- return FALSE;
- }
- else {
- print_info "Test file transferred\n";
- }
- }
- else {
- if (!ftp_upload_test_file($ftp)) {
- print_error "Unable to transfer test file";
- return FALSE;
- }
- else {
- print_info "Test file transferred\n";
- }
- }
- }
- # Now that we're connected and logged in, purge the repo if needed
- if ($g_ftpclean) {
- unless (ftp_clean_directory($ftp)) {
- print_error "Unable to clean the FTP directory.";
- }
- }
- # Put all the files over the connection
- foreach my $file (@{$ra_files}) {
- chomp $file;
- # continue if writing to uploaded archives file fails.
- if ($BM_UPLOAD_FTP_SECURE) {
- if (ftptls_put_file ($ftp, $file)) {
- appendto_uploaded_archives($file, $host);
- print_info "File $file transfered\n";
- }
- else {
- print_error "Unable to transfer $file";
- return FALSE;
- }
- }
- else {
- if (ftp_put_file ($ftp, $file)) {
- appendto_uploaded_archives($file, $host);
- print_info "File $file transfered\n";
- }
- else {
- print_error "Unable to transfer $file: " . $ftp->message;
- return FALSE;
- }
- }
- }
- print_info "All transfers done, logging out from $host\n";
- $ftp->quit;
- }
- return TRUE;
- }
- sub ftp_login ($$$)
- {
- my ($ftp, $user, $passwd) = @_;
- return ($ftp->login($user, $passwd) and
- $ftp->binary());
- }
- sub ftptls_login ($$$)
- {
- my ($ftp, $user, $passwd) = @_;
- return ($ftp->user($user) and
- $ftp->pass($passwd));
- }
- sub ftp_cwd ($$)
- {
- my ($ftp, $repository) = @_;
- return ($ftp->cwd($repository));
- }
- sub ftptls_cwd ($$)
- {
- my ($ftp, $repository) = @_;
- return ($ftp->cwd($repository));
- }
- sub ftp_mkdir ($$)
- {
- my ($ftp, $repository) = @_;
- return ($ftp->mkdir($repository));
- }
- sub ftptls_mkdir ($$)
- {
- my ($ftp, $repository) = @_;
- return ($ftp->mkdir($repository));
- }
- sub ftp_put_file ($$)
- {
- my ($ftp, $file) = @_;
- return $ftp->put ($file);
- }
- sub ftptls_put_file ($$)
- {
- my ($ftp, $file) = @_;
- my $basename = basename ($file);
- return $ftp->put ($basename, $file);
- }
- # }}}
- ##############################################################
- # Amazon S3 Mode
- ##############################################################
- # {{{
- # Function for purging a directory
- # from S3, the same way as the repository is purged.
- # Every files with a date field too old according to BM_ARCHIVE_TTL
- # will be deleted.
- sub s3_clean_directory($)
- {
- my ($bucket) = @_;
- my $BM_ARCHIVE_TTL = $ENV{BM_ARCHIVE_TTL};
- if (defined $ENV{BM_UPLOAD_S3_TTL} and
- length ($ENV{BM_UPLOAD_S3_TTL})) {
- $BM_ARCHIVE_TTL = $ENV{BM_UPLOAD_S3_TTL};
- }
- return 0 unless defined $BM_ARCHIVE_TTL;
- my $date_to_remove = `date +%Y%m%d --date "$BM_ARCHIVE_TTL days ago"`;
- chomp $date_to_remove;
- my $response = $bucket->list;
- my @keys = @{ $response->{keys} };
- foreach my $key (@keys) {
- my $date = undef;
- if ($key->{key} =~ /[\.\-](\d{8})\./) {
- $date = $1;
- if ($date and ($date <= $date_to_remove)) {
- print_info $key->{key} . " has to be deleted, too old ($date <= $date_to_remove).";
- $bucket->delete_key( $key->{key} );
- }
- }
- }
- return 1;
- }
- # How to upload files to s3.
- # We'll use the Net::Amazon::S3 module here.
- sub send_files_with_s3($$$$$$)
- {
- # trying to get Net::Amazon::S3.
- eval "use Net::Amazon::S3";
- if ($@) {
- print_error "Net::Amazon::S3 is not available, cannot use S3 service : $@";
- return FALSE;
- }
- if ($Net::Amazon::S3::VERSION < '0.39') {
- print_error "Net::Amazon::S3 >= 0.39 is required, but version ${Net::Amazon::S3::VERSION} was found, cannot use S3 service";
- return FALSE;
- }
- # getting args
- my ($user, $passwd, $bucket, $ra_hosts, $repository, $ra_files) = @_;
- unless (defined $user and
- defined $passwd and
- defined $bucket and
- defined $ra_hosts and
- defined $ra_files and
- defined $repository) {
- print_error "required args needed";
- return FALSE;
- }
- my $totalbytes = 0;
- my $starttime = time();
- my %uploaded;
- my $backup_bucket;
- # loop on each hosts given and connect to them.
- foreach my $host (@{$ra_hosts}) {
- my $s3 = Net::Amazon::S3->new(
- {
- aws_access_key_id => $user,
- aws_secret_access_key => $passwd,
- timeout => 300
- }
- );
- unless (defined $s3) {
- print_error "Unable to connect to $host : $@\n";
- return FALSE;
- }
- print_info "Connected to $host";
- my $bucket_obj = $s3->bucket($bucket);
- my $response = $bucket_obj->list;
- if (not ( $response->{bucket} ) ) {
- print_info "Bucket $bucket does not exist... creating";
- $bucket_obj = $s3->add_bucket( { bucket => $bucket } );
- print_error "Could not create bucket $bucket" if not ( $bucket_obj );
- }
- s3_clean_directory($bucket_obj) if ($g_s3clean);
- foreach my $file (@{$ra_files}) {
- chomp $file;
- my @splits = $file;
- if( stat($file)->size > $g_s3max_size ) {
- my $split_prefix = "$file-split-";
- my $cmd = "$split -b $g_s3max_size $file $split_prefix";
- if( system($cmd) != 0 ) {
- print_error "Could not run '$cmd' to split $file into chunks of size $g_s3max_size";
- next;
- } else {
- @splits = glob("$split_prefix*");
- }
- }
- for my $split (@splits) {
- my $filename = basename($split);
- my $file_length = stat($split)->size;
- print_info "opened $split of length $file_length and will name the key $filename";
- $totalbytes += $file_length;
- $bucket_obj->add_key_filename(
- $filename, $split,
- {
- content_type => "application/binary"
- }
- );
- $uploaded{$filename} = $file_length;
- }
- # For the S3 method, we assume success in any case.
- appendto_uploaded_archives($file, $host);
- }
- # get a list of files and confirm uploads
- $response = $bucket_obj->list;
- my @keys = @{ $response->{keys} };
- foreach my $key ( @keys ) {
- if (not defined $uploaded{$key->{key}}) {
- next;
- }
- if ($key->{size} == $uploaded{$key->{key}}) {
- print_info $key->{key} . " uploaded sucessfully";
- delete $uploaded{$key->{key}};
- }
- else {
- print_error $key->{key} . " did not upload sucessfully. S3 reports $key is " . $key->{size} . " bytes rather than " . $uploaded{$key->{key}};
- delete $uploaded{$key->{key}};
- return FALSE;
- }
- }
- }
- print_info ("Uploaded $totalbytes bytes of data to S3 in "
- . (time() - $starttime) . " seconds");
- return TRUE;
- }
- # }}}
- ##############################################################
- # Main
- ##############################################################
- # {{{
- # date is always the last args.
- my $date = $ARGV[$#ARGV];
- $date = 'today' if (not defined $date or $date =~ /^-/);
- # the really needed args !
- unless (defined $g_host and
- defined $g_user and
- defined $g_protocol) {
- print $BackupManager::Config::usage, "\n";
- exit E_INVALID;
- }
- if ($g_protocol eq 'ftp' and not defined $g_pass) {
- # try to read the password from the environment
- if (defined $ENV{BM_UPLOAD_FTP_PASSWORD}) {
- $g_pass = $ENV{BM_UPLOAD_FTP_PASSWORD};
- }
- else {
- print $BackupManager::Config::usage, "\n";
- exit E_INVALID;
- }
- }
- if ($g_protocol eq 's3' and (not defined $g_bucket or not defined $g_pass)) {
- if (! defined $g_pass && defined $ENV{BM_UPLOAD_S3_SECRET_KEY}) {
- $g_pass = $ENV{BM_UPLOAD_S3_SECRET_KEY};
- }
- else {
- print $BackupManager::Config::usage, "\n";
- exit E_INVALID;
- }
- }
- if ($g_protocol eq 'ssh-gpg' and (not defined $g_gpg_recipient)) {
- print $BackupManager::Config::usage, "\n";
- exit E_INVALID;
- }
- # storing hosts on memory
- my $ra_hosts = get_hosts_from_str($g_host);
- # where to store archives...
- $g_remote_dir = "/backup/uploads/" if (not defined $g_remote_dir);
- # let's find which files needs to be uploaded.
- my $ra_files = get_files_list_from_date(get_formated_date($date));
- # if user wants listing, just do it !
- if ($g_list) {
- print_info "files to upload ($date) :";
- foreach my $file (@{$ra_files}) {
- print "- $file\n";
- }
- exit E_SUCCESS;
- }
- # We'll now send the files with the appropriate transfer protocol
- $g_protocol = lc $g_protocol;
- # FTP
- if ($g_protocol eq 'ftp') {
- print_info "Trying to upload files with ftp";
- if (! send_files_with_ftp ($g_user,
- $g_pass,
- $ra_hosts,
- $g_remote_dir,
- $ra_files)) {
- print_error "The upload transfer \"$g_protocol\" failed.";
- exit E_FTP_FAILED;
- }
- }
- # SSH related tranfers
- elsif ($g_protocol eq 'scp' or
- $g_protocol eq 'ssh' or
- $g_protocol eq 'ssh-gpg') {
-
- if ($g_protocol eq 'ssh-gpg') {
- print_info "Trying to upload files with ssh-gpg";
- }
- else {
- $g_gpg_recipient = undef;
- print_info "Trying to upload files with scp";
- }
-
- if (! send_files_with_scp ($g_user,
- $ra_hosts,
- $g_remote_dir,
- $ra_files,
- $g_gpg_recipient)) {
- print_error "The upload transfer \"$g_protocol\" failed.";
- exit E_SCP_FAILED;
- }
- }
- # Amazon S3 WebService
- elsif ($g_protocol eq 's3') {
- print_info "Trying to upload files to s3 service";
- if (! send_files_with_s3 ($g_user,
- $g_pass,
- $g_bucket,
- $ra_hosts,
- $g_remote_dir,
- $ra_files)) {
- print_error "The upload transfer \"$g_protocol\" failed.";
- exit E_S3_FAILED;
- }
- }
- # Unknown protocol
- else {
- print STDERR "mode '$g_protocol' is not supported\n";
- exit E_UNKNOWN;
- }
- __END__
- =head1 NAME
- backup-manager-upload - Multiprotocol uploader for backup-manager.
- =head1 SYNOPSIS
- backup-manager-upload [options] date
- =head1 DESCRIPTION
- B<backup-manager-upload> will upload all the archives generated on the given
- date to the specified host with either ftp or scp.
- It's also possible to use this program for uploading data to an Amazon S3 account.
- Some metadates are available like "today" or "yesterday".
- =head1 REQUIRED ARGS
- =over 4
- =item B<--mode=>I<transfer-mode>
- Select the transfer mode to use : ftp, scp, or s3.
- =item B<--host=>I<hostname1,hostname2,...,hostnameN>
- Select a list of remote hosts to connect to.
- =item B<--user=>I<username>
- Select the user to use for connection.
- =back
- =head1 OPTIONAL ARGS
- =over 4
- =item B<--password=>I<password>
- Select the ftp user's password (only needed for ftp transfers).
- =item B<--key=>I<path_to_private_key>
- Select the ssh private key file to use when opening the ssh session for scp transfer.
- Obviously, this is only needed for scp transfer mode.
- If you don't specify a key file, the user's default private key will be used.
- =item B<--directory=>I<directory>
- Select the location on the remote host where files will be uploaded.
- Default is /backup/uploads.
- =item B<--bucket=>I<bucket>
- Sets the bucket name for the Amazon S3 service backup into.
- =item B<--root=>I<directory>
- Select the local directory where files are.
- Default is /var/archives
- =item B<--gpg-recipient=>I<gpg-recipient>
- Select the gpg public key for encryptiong the archives when uploading
- with the method ssh-gpg. This can be a short or long key id or a
- descriptive name. The precise syntax is described in the gpg man page.
- =item B<--list>
- Just list the files to upload.
- =item B<--ftp-purge>
- Purge the remote directory before uploading files in FTP mode.
- =item B<--s3-purge>
- Purge the remote directory before uploading files in FTP mode.
- =item B<--ssh-purge>
- Purge the remote directory before uploading files in SSH mode.
- =item B<--verbose>
- Flag to enable verbose mode.
- =item B<date>
- Date pattern to select some files to upload, can be a valid date (YYYYMMDD) or 'today' or 'yesterday'.
- =back
- =head1 ERROR CODES
- If something goes wrong during an upload, backup-manager-upload will exit
- with a non null value. In such a case every error messages are sent to
- STDERR.
- Here are the possible error codes:
- =over 4
- =item bad command line (wrong arguments) : 10
- =item FTP transfer failure : 20
- =item SCP transfer failure : 21
- =item S3 transfer failure : 22
- =item Unknown upload method: 23
- =back
- =cut
- =head1 SEE ALSO
- L<backup-manager(3)>
- =head1 AUTHORS
- Alexis Sukrieh - main code and design
- Brad Dixon - Amazon S3 upload method
- Jan Metzger - ssh-gpg upload method
- =cut