PageRenderTime 36ms CodeModel.GetById 21ms app.highlight 8ms RepoModel.GetById 1ms app.codeStats 0ms

/backup-manager-upload

http://github.com/sukria/Backup-Manager
Perl | 1238 lines | 996 code | 149 blank | 93 comment | 107 complexity | 7f520a2b61382d37fcbb21133683b83e MD5 | raw file
   1#!/usr/bin/perl 
   2# Backup Manager Upload - Multiprotocol uploader for backup-manager.
   3# Copyright Š 2005-2016 The Backup Manager Authors
   4#
   5# See the AUTHORS file for details.
   6
   7use strict;
   8use warnings;
   9use BackupManager::Config;
  10use BackupManager::Dialog;
  11use POSIX qw(strftime);
  12use File::Temp qw(tempfile);
  13use File::Basename;
  14use File::stat;
  15
  16use constant TRUE => 1;
  17use constant FALSE => 0;
  18use constant E_SUCCESS    => 0;
  19use constant E_INVALID    => 10;
  20use constant E_FTP_FAILED => 20;
  21use constant E_SCP_FAILED => 21;
  22use constant E_S3_FAILED  => 22;
  23use constant E_UNKNOWN    => 23;
  24
  25# global vars
  26my $scp = '/usr/bin/scp';
  27my $ssh = '/usr/bin/ssh';
  28my $gpg = '/usr/bin/gpg';
  29my $split = '/usr/bin/split';
  30
  31my $g_list	= 0;
  32my $g_host 	= undef;
  33my $g_user 	= undef;
  34my $g_pass 	= undef;
  35my $g_ftpclean  = undef;
  36my $g_ftptest  = undef;
  37my $g_s3clean   = undef;
  38my $g_s3max_size = 4*1024*1024*1024; # 4G
  39my $g_sshclean   = undef;
  40my $g_protocol 	= 'scp';
  41my $g_remote_dir= '/var/archives/uploads';
  42my $g_bucket    = undef;
  43my $g_root_dir	= '/var/archives';
  44my $g_key_file	= undef;
  45my $g_gpg_recipient = undef;
  46
  47# first get the args
  48BackupManager::Config::getopt("$0 -m=mode -h=host -u=user [options] date\n
  49-v|--verbose	: Print on STDOUT what happens.
  50-m|--mode	: Transfer mode to use : ftp, scp, s3, or ssh-gpg.
  51-h|--host	: Remote hosts to connect to (separated by commas).
  52-u|--user	: User to use for connection.
  53-p|--password	: remote user's password (needed for ftp and s3 uploads).
  54-k|--key	: SSH key file to use for opening the scp session (only needed for scp mode).
  55-d|--directory	: Directory on the remote host where files will go (default is /var/archives/uploads).
  56-b|--bucket     : Amazon S3 storage bucket to use
  57-r|--root	: Root directory of your archives (default /var/archives).
  58-l|--list	: Only prints which files would be uploaded.
  59--gpg-recipient : Selects the public key used for gpg encryption (only for ssh-gpg mode).
  60--ftp-purge	: Purge the remote directory before uploading files in FTP mode.
  61--ftp-test	: Sends a test file before uploading archives in FTP mode.
  62--s3-purge	: Purge the remote directory before uploading files in S3 mode.
  63--s3-maxsize	: Maximum file size to upload.  If file execeds this size, it will be `split`. Default is 4GB
  64--ssh-purge	: Purge the remote directory before uploading files in SSH mode.
  65date		: All files >= date will be uploaded. Either a valid date (YYYYMMDD) or one of this words : today, yesterday",
  66'verbose'	=> sub { init_dialog($_[1]) },
  67'mode|m=s' 	=> \$g_protocol,
  68'host|h=s' 	=> \$g_host,
  69'user|u=s' 	=> \$g_user,
  70'password|p=s' 	=> \$g_pass,
  71'directory|d=s'	=> \$g_remote_dir,
  72'bucket|b=s'	=> \$g_bucket,
  73'key|k=s'	=> \$g_key_file,
  74'root|r=s'	=> \$g_root_dir,
  75'gpg-recipient=s' => \$g_gpg_recipient,
  76'ftp-purge'	=> \$g_ftpclean,
  77'ftp-test'	=> \$g_ftptest,
  78's3-purge'	=> \$g_s3clean,
  79's3-maxsize=i'	=> \$g_s3max_size,
  80'ssh-purge'	=> \$g_sshclean,
  81'list'		=> \$g_list,
  82);
  83
  84
  85
  86##############################################################
  87# Common subs (for all methods)
  88##############################################################
  89# {{{
  90
  91sub get_formated_date($)
  92{
  93	my $date = shift;
  94	unless (defined $date) {
  95		print_error "date is required, enter today, yesterday or YYYYMMDD";
  96		exit E_INVALID;
  97	}
  98
  99	if ($date eq 'today') {
 100		return strftime ('%Y%m%d', localtime);
 101	}
 102	elsif ($date eq 'yesterday') {
 103		return strftime ('%Y%m%d', localtime(time - (24 * 3600)));
 104	}
 105	elsif ($date =~ /^\d{4}\d{2}\d{2}$/) {
 106		return $date;
 107	}
 108	else {
 109		print_error "date $date is not valid, enter today, yesterday or YYYYMMDD";
 110		exit E_INVALID;
 111	}
 112}
 113
 114# The idea behind BM_UPLOADED_ARCHIVES is to have a database of what archives
 115# have been uploaded so far. This allows multiple execution of upload actions
 116# within a day without resending all archives of the day from the beginning.
 117
 118# Add one file,host pair to $BM_UPLOADED_ARCHIVES database.
 119# Called immediately *after* successful uploading of an archive.
 120sub appendto_uploaded_archives($$)
 121{
 122    my $file = shift;
 123    my $host = shift;
 124    unless ( defined $file and defined $host ) {
 125        print_error "required args needed";
 126        return FALSE;
 127    }
 128
 129    my $upload_fname = $ENV{BM_UPLOADED_ARCHIVES};
 130    unless ( defined $upload_fname ) {
 131        # Uncomment next line if you want the mandatory use
 132        # of BM_UPLOADED_ARCHIVES (ie always have it around).
 133        #print_error "BM_UPLOADED_ARCHIVES is not defined";
 134        return FALSE;
 135    }
 136
 137    # if $file already in database, append host to that line;
 138    # else append a lines "$file $host" to the end.
 139
 140    my $io_error = 0;
 141    if ( ! system( "grep -q \"^$file \" $upload_fname" ) ) {
 142        my $cmd = "sed -i \"s:^$file .*\$:\& $host:\" $upload_fname";
 143        $io_error = system("$cmd");
 144    }
 145    elsif ( open(my $fh, ">>", $upload_fname) ) {
 146        print($fh "$file $host\n") or $io_error = 1;
 147        close $fh;
 148    }
 149    else {
 150        $io_error = 2;
 151    }
 152    if ( $io_error ) {
 153        print_error "IO error: did not update $upload_fname with '$file $host'";
 154        return FALSE;
 155    }
 156
 157    return TRUE;
 158}
 159
 160# Get all files of the specified date; filter the list through 
 161# BM_UPLOADED_ARCHIVES if it is set in the environment.
 162# NOTE:  Doing the filtering here implies that the archive is considered
 163# uploaded if a single upload to a host succeeds; that is even when there
 164# are failures to other hosts (in case of multiple host uploading).
 165# To consider it uploaded when all hosts succeed, the filtering must be
 166# transfered to the individual upload subroutines (and check for existence
 167# of file,host pair in the database).
 168#
 169sub get_files_list_from_date($)
 170{
 171	my $date = shift;
 172	return [] unless defined $date;
 173
 174	my $ra_files = [];
 175
 176	unless (-d $g_root_dir) {
 177		my $msg = "root dir specified does not exists : $g_root_dir";
 178		print_error $msg;
 179        exit E_INVALID;
 180	}
 181
 182    # make sure we can read the root dir, when the secure mode is 
 183    # enabled, the repository might not be readable by us...
 184    unless (-r $g_root_dir) {
 185        print_error "The repository $g_root_dir is not readable by user \"$ENV{USER}\".";
 186        if ($ENV{BM_REPOSITORY_SECURE} eq "true") {
 187            print_error "The secure mode is enabled (BM_REPOSITORY_SECURE),";
 188            print_error "the upload user ($g_user) must be in the group \"BM_REPOSITORY_GROUP\".";
 189        }
 190        exit E_INVALID;
 191    }
 192
 193    my $upload_fname = $ENV{BM_UPLOADED_ARCHIVES};
 194    if ( defined $upload_fname ) {
 195        # filter file list through the BM_UPLOADED_ARCHIVES database
 196    	while (<$g_root_dir/*$date*>) {
 197            my $file = $_;
 198            my $cmd = "grep -q '$file' $upload_fname";
 199            if ( system ("$cmd") ) {
 200                push @{$ra_files}, $file;
 201            }
 202        }
 203    }
 204    else {
 205    	while (<$g_root_dir/*$date*>) {
 206            push @{$ra_files}, $_;
 207        }
 208	}
 209
 210	return $ra_files;
 211}
 212
 213sub get_hosts_from_str($) {
 214	my ($hosts_str) = @_;
 215	return [] unless defined $hosts_str;
 216
 217	my $ra_hosts = [];
 218
 219	$hosts_str =~ s/\s//g;
 220	foreach my $host (split /,/, $hosts_str) {
 221		push @{$ra_hosts}, $host;
 222	}
 223
 224	return $ra_hosts;
 225}
 226
 227sub get_tempfile(;$) {
 228    my ($template) = @_;
 229    $template ||= 'bmu-XXXXXX';
 230    
 231    return tempfile( 
 232        TEMPLATE => $template,
 233        DIR      => $ENV{BM_TEMP_DIR},
 234        UNLINK   => 1,
 235    );
 236}
 237
 238# }}}
 239
 240##############################################################
 241# SSH Mode
 242##############################################################
 243# {{{
 244
 245# returns all the ssh otpions needed for a valid SSH connection
 246sub get_ssh_opts {
 247    # look for a port to use
 248	my $ssh_port_switch="";
 249	my $scp_port_switch="";
 250    if ($ENV{BM_UPLOAD_SSH_PORT}) {
 251        $ssh_port_switch = "-p ".$ENV{BM_UPLOAD_SSH_PORT};
 252        $scp_port_switch = "-P ".$ENV{BM_UPLOAD_SSH_PORT};
 253    }
 254
 255	# look for keyfile to use
 256	my $keyfile_switch="";
 257	if (defined $g_key_file and (-e $g_key_file)) {
 258	    $keyfile_switch = "-i $g_key_file";
 259	}
 260    elsif (! (-e $g_key_file)) {
 261        print_error "Unable to read the SSH identity key : $g_key_file";
 262        exit E_SCP_FAILED;
 263    }
 264
 265    return {
 266        ssh => "$ssh_port_switch $keyfile_switch -o BatchMode=yes", 
 267        scp => "$scp_port_switch $keyfile_switch -B"
 268    };
 269}
 270
 271# Purge remote archives over SSH
 272# Uses backup-manager-purge
 273sub ssh_clean_directory
 274{
 275    my ($user, $host, $location) = @_;
 276	return 0 unless defined $user and
 277		defined $host and
 278		defined $location;
 279	
 280    my $ssh_options = get_ssh_opts->{'ssh'};
 281
 282    # the remote time to leave could be different as the local one.
 283    my $BM_ARCHIVE_TTL = $ENV{BM_ARCHIVE_TTL};
 284    if (defined $ENV{BM_UPLOAD_SSH_TTL} and
 285        length ($ENV{BM_UPLOAD_SSH_TTL})) {
 286        $BM_ARCHIVE_TTL = $ENV{BM_UPLOAD_SSH_TTL};
 287    }
 288    return 0 unless defined $BM_ARCHIVE_TTL;
 289    print_info "Cleaning remote directory through SSH";
 290
 291    # First, create the list of existing archives
 292    my ($fh, $in) = get_tempfile('ssh-archives-XXXXXX');
 293    my $cmd = "$ssh $ssh_options $user".'@'.$host." ls $location/*";
 294    my $buffer = `$cmd`;
 295    print $fh $buffer;
 296    close $fh;
 297
 298    my ($fh_out, $out) = get_tempfile('bm-purge-out-ssh-XXXXXX');
 299    system("/usr/bin/backup-manager-purge --ttl=$BM_ARCHIVE_TTL --files-from=$in > $out");
 300
 301    open (STDOUT_CMD, $out);
 302    while (<STDOUT_CMD>) {
 303        chomp();
 304        print_info "Purging $_";
 305        $cmd = "$ssh $ssh_options $user".'@'.$host." rm -f $_";
 306        system ("$cmd");
 307    }
 308    close STDOUT_CMD;
 309    undef $fh_out;
 310}
 311
 312# send one file with scp
 313# since Net::SSH is a wrapper to a system call of ssh, I don't use it.
 314sub send_file_with_scp($$$$$)
 315{
 316    my ($file, $user, $host, $location, $g_gpg_recipient) = @_;
 317	return 0 unless defined $file and 
 318		defined $user and
 319		defined $host and
 320		defined $location;
 321
 322    my $opts = get_ssh_opts;
 323    my ($ssh_opts, $scp_opts) = ($opts->{'ssh'}, $opts->{'scp'});
 324	
 325    my $cmd = "";
 326	if ( defined $g_gpg_recipient )	{	    
 327	    my $file_base = basename($file);
 328	    $cmd = "$gpg --encrypt --recipient $g_gpg_recipient --output - --batch $file | ";
 329	    $cmd .= "$ssh $ssh_opts -e none $user".'@'."$host ";
 330	    $cmd .= "\"cat - > $location/$file_base.gpg\" >&2";
 331	}
 332	else {
 333	    $cmd = "$scp $scp_opts $file $user".'@'.$host.':'.$location." >&2";
 334	}
 335
 336	# we use eval here to avoid crash with bad keys
 337	my $ret = eval { system($cmd) };
 338	if ($@ or $ret) {
 339		print_error "$scp failed for $file : $@ (command was : $cmd). " if $@;
 340		print_error "$scp failed for $file (command was : $cmd)" if $ret;
 341		print_error ("Unable to upload \"$file\". ".($! || $@ || $ret));
 342        return 0;
 343	}
 344    else {
 345        # use same name in both cases (gpg encryption is done on the fly);
 346        # continue if writing to uploaded archives file fails.
 347        appendto_uploaded_archives($file, $host);
 348    }
 349    return 1;
 350}
 351
 352# How to upload files with scp.
 353# Note that Key Authentication is used, see man ssh-keygen.
 354sub send_files_with_scp($$$$$)
 355{
 356	# getting args
 357	my ($user, $ra_hosts, $repository, $ra_files, $g_gpg_recipient) = @_;
 358	unless (defined $user and 
 359		defined $ra_hosts and
 360		defined $ra_files and
 361		defined $repository) {
 362		print_error "required args needed";
 363		return FALSE;
 364	}
 365
 366	# is scp here ?
 367	unless (-x $scp) {
 368		print_error "$scp is not here, cannot use this mode for transfer.";
 369        return FALSE;
 370	}
 371
 372	# if gpg requested, is it here?
 373	if (defined $g_gpg_recipient and (not -x $gpg)) {
 374		print_error "$gpg is not here, cannot use this mode for transfer.";
 375	    return FALSE;
 376	}
 377
 378	# if gpg requested, check whether given key is valid	    
 379	if (defined $g_gpg_recipient) {
 380	    my $gpg_out = `$gpg --batch --list-keys '$g_gpg_recipient' 2>/dev/null`;
 381
 382	    if ($gpg_out !~ /^pub/mi) {
 383		    print_error "gpg recipient $g_gpg_recipient is not a valid key, cannot use this mode for transfer.";
 384            return FALSE;
 385	    }
 386	}
 387    
 388    my $opts = get_ssh_opts;
 389    my ($ssh_opts, $scp_opts) = ($opts->{'ssh'}, $opts->{'scp'});
 390
 391    # loop on each hosts given and connect to them.
 392	foreach my $host (@{$ra_hosts}) {
 393            
 394        # make sure the target directory exists remotely
 395        my $ls_rep_cmd = "$ssh $ssh_opts $user\@$host \"ls $repository\" 2>/dev/null || echo notfound";
 396        my $out = `$ls_rep_cmd`;
 397        chomp $out;
 398
 399        # if failed, 
 400        if ($out eq 'notfound') {
 401            print_info "Creating $repository on $host";
 402            my $mkdir_rep_cmd = "$ssh $ssh_opts $user\@$host 'mkdir -p $repository' 2>/dev/null || echo failed";
 403            $out = `$mkdir_rep_cmd`;
 404            chomp $out;
 405            if ($out eq 'failed') {
 406                print_error "Unable to create $host:$repository";
 407                return FALSE;
 408            }
 409        }
 410	
 411		foreach my $file (@{$ra_files}) {
 412			chomp $file;
 413            
 414			if (-f $file and 
 415                send_file_with_scp($file, $user, $host, 
 416                                   $repository, $g_gpg_recipient)) {
 417				print_info "File $file uploaded successfully.";
 418			}
 419			elsif (! -f $file) {
 420				print_error "File $file cannot be uploaded, it does not exist locally.";
 421                return FALSE;
 422			}
 423            else {
 424                print_error "Error during the scp upload of $file";
 425                return FALSE;
 426            }
 427		}
 428
 429        # cleaning the repo
 430        ssh_clean_directory ($user, $host, $repository) if ($g_sshclean);
 431
 432	}
 433
 434    return TRUE;
 435}
 436# }}}
 437
 438##############################################################
 439# FTP Mode
 440##############################################################
 441# {{{
 442
 443# Function for testing upload before sending the archives
 444# The test file is uploaded, and its size is compared to the local file.
 445# If the size is correct, the test is successfull and we can continue
 446# with the archives.
 447sub ftp_upload_test_file($)
 448{
 449    my $ftp = shift;
 450	
 451	my $BM_REPOSITORY_ROOT = $ENV{BM_REPOSITORY_ROOT};
 452	my $ftp_test_filename = "2mb_file.dat";
 453	my $file_to_send = $BM_REPOSITORY_ROOT . "/" . $ftp_test_filename;
 454	
 455	if (!ftp_put_file ($ftp, $file_to_send)) {
 456		print_error "Unable to transfer $file_to_send: " . $ftp->message;
 457		return FALSE;
 458	}
 459	else {
 460		my $remote_filesize = $ftp->size($ftp_test_filename);
 461		# Delete both test files
 462		system("rm -f $BM_REPOSITORY_ROOT/$ftp_test_filename");
 463		$ftp->delete($ftp_test_filename);
 464		# Test filesize (should be 2MB)
 465		if($remote_filesize == 2097152) {
 466			return TRUE;
 467		}
 468		else {
 469			print_error "Remote and local test files filesize mismatch";
 470			return FALSE;
 471		}
 472	}
 473}
 474
 475sub ftptls_upload_test_file($)
 476{
 477    my $ftp = shift;
 478	
 479	my $BM_REPOSITORY_ROOT = $ENV{BM_REPOSITORY_ROOT};
 480	my $ftp_test_filename = "2mb_file.dat";
 481	my $file_to_send = $BM_REPOSITORY_ROOT . "/" . $ftp_test_filename;
 482	
 483	if (!ftptls_put_file ($ftp, $file_to_send)) {
 484		print_error "Unable to transfer $file_to_send: " . $ftp->message;
 485		return FALSE;
 486	}
 487	else {
 488		my $remote_filesize = $ftp->size($ftp_test_filename);
 489		# Delete both test files
 490		system("rm -f $BM_REPOSITORY_ROOT/$ftp_test_filename");
 491		$ftp->delete($ftp_test_filename);
 492		# Test filesize (should be 2MB)
 493		if($remote_filesize == 2097152) {
 494			return TRUE;
 495		}
 496		else {
 497			print_error "Remote and local test files filesize mismatch";
 498			return FALSE;
 499		}
 500	}
 501}
 502
 503# Function for purging a directory
 504# over FTP, the same way as the repository is purged.
 505# Every files with a date field too old according to BM_UPLOAD_FTP_TTL
 506# will be deleted.
 507sub ftp_clean_directory($)
 508{
 509    my $ftp = shift;
 510    
 511    # the remote time to leave could be different as the local one.
 512    my $BM_ARCHIVE_TTL = $ENV{BM_ARCHIVE_TTL};
 513    if (defined $ENV{BM_UPLOAD_FTP_TTL} and
 514        length ($ENV{BM_UPLOAD_FTP_TTL})) {
 515        $BM_ARCHIVE_TTL = $ENV{BM_UPLOAD_FTP_TTL};
 516    }
 517    return 0 unless defined $BM_ARCHIVE_TTL;
 518    print_info "Cleaning remote directory through FTP";
 519
 520    # First, create the list of existing archives
 521    my ($fh, $filename) = get_tempfile('ftp-archives-XXXXXX');
 522    my $BM_UPLOAD_FTP_SECURE = $ENV{"BM_UPLOAD_FTP_SECURE"};
 523    my $ra_files;
 524    if ($BM_UPLOAD_FTP_SECURE eq "true") {
 525		$ra_files = $ftp->list();
 526    }
 527    else {
 528		$ra_files = $ftp->ls();
 529    }
 530    foreach my $file (@$ra_files) {
 531        print $fh "$file\n";
 532    }
 533    close $fh;
 534    
 535    # Then delete every file listed as "outaded" by backup-manager-purge
 536    my ($fh_out, $out) = get_tempfile('bm-purge-out-ftp-XXXXXX');
 537    system ("/usr/bin/backup-manager-purge --ttl=$BM_ARCHIVE_TTL --files-from=$filename > $out");
 538    open (STDOUT_CMD, "<$out");
 539    while (<STDOUT_CMD>) {
 540        chomp();
 541        print_info "Purging $_";
 542        $ftp->delete ($_) or print_error "Unable to delete \"$_\".";
 543    }
 544    close STDOUT_CMD;
 545    undef $fh;
 546    return 1;
 547}
 548
 549sub ftp_connect_to_host ($)
 550{
 551    my ($host) = @_;
 552    my $ftp;
 553
 554    # get the passive mode from the configuration
 555    # default is set to true.
 556    my $BM_UPLOAD_FTP_PASSIVE = $ENV{"BM_UPLOAD_FTP_PASSIVE"};
 557    unless (defined $BM_UPLOAD_FTP_PASSIVE) {
 558        $BM_UPLOAD_FTP_PASSIVE = "true";
 559    }
 560    if ($BM_UPLOAD_FTP_PASSIVE eq "true") {
 561        $BM_UPLOAD_FTP_PASSIVE="1";
 562    }
 563    elsif ($BM_UPLOAD_FTP_PASSIVE eq "false") {
 564        $BM_UPLOAD_FTP_PASSIVE="0";
 565    }
 566    else {
 567        print_error "Unsupported value for BM_UPLOAD_FTP_PASSIVE : $BM_UPLOAD_FTP_PASSIVE";
 568        return undef;
 569    }
 570	
 571	# get the log level from the configuration for debug mode
 572	my $BM_LOGGER_LEVEL = $ENV{"BM_LOGGER_LEVEL"};
 573    unless (defined $BM_LOGGER_LEVEL) {
 574        $BM_LOGGER_LEVEL = "warning";
 575    }
 576    if ($BM_LOGGER_LEVEL eq "debug") {
 577        $BM_LOGGER_LEVEL="1";
 578    }
 579    else {
 580        $BM_LOGGER_LEVEL="0";
 581    }
 582
 583    # get the timeout from the configuration
 584    # default is set to 120.
 585    my $BM_UPLOAD_FTP_TIMEOUT = $ENV{"BM_UPLOAD_FTP_TIMEOUT"};
 586    unless (defined $BM_UPLOAD_FTP_TIMEOUT) {
 587        $BM_UPLOAD_FTP_TIMEOUT = 120;
 588    }
 589
 590    # trying to get Net::FTP.
 591    eval "use Net::FTP";
 592    if ($@) {
 593        print_error "Net::FTP is not available, cannot use ftp transfer mode";
 594        return undef;
 595    }
 596    eval {
 597        $ftp = new Net::FTP (
 598                $host, 
 599                Debug => $BM_LOGGER_LEVEL,
 600                Timeout => $BM_UPLOAD_FTP_TIMEOUT,
 601                Passive => $BM_UPLOAD_FTP_PASSIVE);
 602    };
 603    if ($@) {
 604        print_error "Unable to use the Net::FTP Perl module : $@";
 605        return undef;
 606    }
 607    return $ftp;
 608}
 609
 610sub ftptls_connect_to_host ($)
 611{
 612    my ($host) = @_;
 613    my $ftp;
 614
 615    eval "use Net::Lite::FTP";
 616    if ($@) {
 617        print_error "Net::Lite::FTP is not available, cannot use ftp secured transfer mode";
 618        return undef;
 619    }
 620    eval {
 621        $ftp = Net::Lite::FTP->new ();
 622        $ftp->open ($host, "21");
 623    };
 624    if ($@) {
 625        print_error "Unable to use the Net::Lite::FTP Perl module : $@";
 626        return undef;
 627    }
 628    return $ftp;
 629}
 630
 631
 632# How to upload files with ftp.
 633# We'll use the Net::FTP or the Net::Lite::FTP (for secured mode) module here.
 634# Net::Lite::FTP can be found here :
 635# http://search.cpan.org/~eyck/Net-Lite-FTP-0.61/lib/Net/Lite/FTP.pm
 636sub send_files_with_ftp($$$$$)
 637{
 638	# getting args
 639	my ($user, $passwd, $ra_hosts, $repository, $ra_files) = @_;
 640	unless (defined $user and 
 641		defined $passwd and
 642		defined $ra_hosts and
 643		defined $ra_files and
 644		defined $repository) {
 645		print_error "required args needed";
 646		return FALSE;
 647	}
 648	
 649    # get the secure mode from the configuration
 650    # default is set to false.
 651    my $BM_UPLOAD_FTP_SECURE = $ENV{"BM_UPLOAD_FTP_SECURE"};
 652    unless (defined $BM_UPLOAD_FTP_SECURE) {
 653        $BM_UPLOAD_FTP_SECURE = "false";
 654    }
 655    if ($BM_UPLOAD_FTP_SECURE eq "true") {
 656        $BM_UPLOAD_FTP_SECURE="1";
 657    }
 658    elsif ($BM_UPLOAD_FTP_SECURE eq "false") {
 659        $BM_UPLOAD_FTP_SECURE="0";
 660    }
 661    else {
 662        print_error "Unsupported value for BM_UPLOAD_FTP_SECURE : $BM_UPLOAD_FTP_SECURE";
 663        return FALSE;
 664    }
 665
 666    # loop on each hosts given and connect to them.
 667    foreach my $host (@{$ra_hosts}) {
 668
 669        my $ftp;
 670        
 671        # The FTP over TLS transfer mode
 672        if ($BM_UPLOAD_FTP_SECURE) {
 673            $ftp = ftptls_connect_to_host ($host);
 674            unless (defined $ftp) {
 675                print_error "Unable to connect to host: $host";
 676                return FALSE;
 677            }
 678
 679            unless (ftptls_login($ftp, $user, $passwd)) {
 680                print_error "Unable to login on ${host} in FTP TLS mode.";
 681                return FALSE;
 682            }
 683            unless (ftptls_cwd($ftp, $repository)) {
 684                print_info "The directory ${repository} does not exist, trying to create it.";
 685                unless (ftptls_mkdir($ftp, $repository)) {
 686                print_error  "Unable to create directory ${repository} in FTP TLS mode: " . $ftp->message;
 687                return FALSE;
 688                }
 689            }
 690            print_info "Logged on $host, in $repository (FTP TLS mode)";
 691        }
 692
 693        # The unencrypted FTP transfers
 694        else {
 695            $ftp = ftp_connect_to_host ($host);
 696            unless (defined $ftp) {
 697                print_error "Unable to connect to host: $host";
 698                return FALSE;
 699            }
 700
 701            unless (ftp_login($ftp, $user, $passwd)) {
 702                print_error "Unable to login on ${host} in FTP mode.";
 703                return FALSE;
 704            }
 705            unless (ftp_cwd($ftp, $repository)) {
 706                print_info "The directory ${repository} does not exist, trying to create it.";
 707                unless (ftp_mkdir($ftp, $repository)) {
 708                print_error  "Unable to create directory ${repository} in FTP mode: " . $ftp->message;
 709                return FALSE;
 710                }
 711            }
 712            print_info "Logged on $host, in $repository (FTP binary mode)";
 713        }
 714
 715        # Now that we're connected and logged in, test an upload if needed
 716        if ($g_ftptest) {
 717            if ($BM_UPLOAD_FTP_SECURE) {
 718                if (!ftptls_upload_test_file($ftp)) {
 719                    print_error "Unable to transfer test file";
 720                    return FALSE;
 721                }
 722                else {
 723                    print_info "Test file transferred\n";
 724                }
 725            }
 726            else {
 727                if (!ftp_upload_test_file($ftp)) {
 728                    print_error "Unable to transfer test file";
 729                    return FALSE;
 730                }
 731                else {
 732                    print_info "Test file transferred\n";
 733                }
 734            }
 735        }
 736
 737        # Now that we're connected and logged in, purge the repo if needed
 738        if ($g_ftpclean) {
 739            unless (ftp_clean_directory($ftp)) {
 740                print_error "Unable to clean the FTP directory.";
 741            }
 742        }
 743
 744        # Put all the files over the connection
 745        foreach my $file (@{$ra_files}) {
 746            chomp $file;
 747            # continue if writing to uploaded archives file fails.
 748            if ($BM_UPLOAD_FTP_SECURE) {
 749                if (ftptls_put_file ($ftp, $file)) {
 750                    appendto_uploaded_archives($file, $host);
 751                    print_info "File $file transfered\n";
 752                }
 753                else {
 754                    print_error "Unable to transfer $file";
 755                    return FALSE;
 756                }
 757            }
 758            else {
 759                if (ftp_put_file ($ftp, $file)) {
 760                    appendto_uploaded_archives($file, $host);
 761                    print_info "File $file transfered\n";
 762                }
 763                else {
 764                    print_error "Unable to transfer $file: " . $ftp->message;
 765                    return FALSE;
 766                }
 767            }
 768        }
 769        print_info "All transfers done, logging out from $host\n";
 770        $ftp->quit;
 771    }
 772    return TRUE;
 773}
 774
 775sub ftp_login ($$$)
 776{
 777    my ($ftp, $user, $passwd) = @_;
 778    return ($ftp->login($user, $passwd) and
 779            $ftp->binary());
 780}
 781
 782sub ftptls_login ($$$)
 783{
 784    my ($ftp, $user, $passwd) = @_;
 785    return ($ftp->user($user) and
 786            $ftp->pass($passwd));
 787}
 788
 789sub ftp_cwd ($$)
 790{
 791    my ($ftp, $repository) = @_;
 792    return ($ftp->cwd($repository));
 793}
 794
 795sub ftptls_cwd ($$)
 796{
 797    my ($ftp, $repository) = @_;
 798    return ($ftp->cwd($repository));
 799}
 800
 801sub ftp_mkdir ($$)
 802{
 803    my ($ftp, $repository) = @_;
 804    return ($ftp->mkdir($repository));
 805}
 806
 807sub ftptls_mkdir ($$)
 808{
 809    my ($ftp, $repository) = @_;
 810    return ($ftp->mkdir($repository));
 811}
 812
 813sub ftp_put_file ($$)
 814{
 815    my ($ftp, $file) = @_;
 816    return $ftp->put ($file);
 817}
 818
 819sub ftptls_put_file ($$)
 820{
 821    my ($ftp, $file) = @_;
 822    my $basename = basename ($file);
 823    return $ftp->put ($basename, $file);
 824}
 825
 826# }}}
 827
 828##############################################################
 829# Amazon S3 Mode
 830##############################################################
 831# {{{
 832
 833# Function for purging a directory
 834# from S3, the same way as the repository is purged.
 835# Every files with a date field too old according to BM_ARCHIVE_TTL
 836# will be deleted.
 837sub s3_clean_directory($)
 838{
 839    my ($bucket) = @_;
 840    my $BM_ARCHIVE_TTL = $ENV{BM_ARCHIVE_TTL};
 841    if (defined $ENV{BM_UPLOAD_S3_TTL} and
 842        length ($ENV{BM_UPLOAD_S3_TTL})) {
 843        $BM_ARCHIVE_TTL = $ENV{BM_UPLOAD_S3_TTL};
 844    }
 845    return 0 unless defined $BM_ARCHIVE_TTL;
 846    my $date_to_remove = `date +%Y%m%d --date "$BM_ARCHIVE_TTL days ago"`;
 847    chomp $date_to_remove;
 848
 849    my $response = $bucket->list;
 850    my @keys = @{ $response->{keys} };
 851
 852    foreach my $key (@keys) {
 853	my $date = undef;
 854	if ($key->{key} =~ /[\.\-](\d{8})\./) {
 855	    $date = $1;
 856	    if ($date and ($date <= $date_to_remove)) {
 857		print_info $key->{key} . " has to be deleted, too old ($date <= $date_to_remove).";
 858                $bucket->delete_key( $key->{key} );
 859	    }
 860	}
 861    }
 862    return 1;
 863}
 864
 865# How to upload files to s3.
 866# We'll use the Net::Amazon::S3 module here.
 867sub send_files_with_s3($$$$$$)
 868{
 869	# trying to get Net::Amazon::S3.
 870	eval "use Net::Amazon::S3";
 871	if ($@) {
 872		print_error "Net::Amazon::S3 is not available, cannot use S3 service : $@";
 873		return FALSE;
 874	}
 875
 876	if ($Net::Amazon::S3::VERSION < '0.39') {
 877		print_error "Net::Amazon::S3 >= 0.39 is required, but version ${Net::Amazon::S3::VERSION} was found, cannot use S3 service";
 878		return FALSE;
 879	}
 880
 881	# getting args
 882	my ($user, $passwd, $bucket, $ra_hosts, $repository, $ra_files) = @_;
 883
 884	unless (defined $user and 
 885		defined $passwd and
 886		defined $bucket and
 887		defined $ra_hosts and
 888		defined $ra_files and
 889		defined $repository) {
 890		print_error "required args needed";
 891		return FALSE;
 892	}
 893
 894	my $totalbytes = 0;
 895	my $starttime = time();
 896	my %uploaded;
 897	my $backup_bucket;
 898
 899	# loop on each hosts given and connect to them.
 900	foreach my $host (@{$ra_hosts}) {
 901		my $s3 = Net::Amazon::S3->new(
 902			{   
 903				aws_access_key_id => $user,
 904				aws_secret_access_key => $passwd,
 905				timeout => 300
 906			}
 907		);
 908
 909		unless (defined $s3) {
 910			print_error "Unable to connect to $host : $@\n";
 911			return FALSE;
 912		}
 913
 914		print_info "Connected to $host";
 915
 916		my $bucket_obj = $s3->bucket($bucket);
 917
 918		my $response = $bucket_obj->list;
 919
 920		if (not ( $response->{bucket} ) ) {
 921			print_info "Bucket $bucket does not exist... creating";
 922			$bucket_obj = $s3->add_bucket( { bucket => $bucket } );
 923			print_error "Could not create bucket $bucket" if not ( $bucket_obj );
 924		}
 925
 926		s3_clean_directory($bucket_obj) if ($g_s3clean);
 927
 928		foreach my $file (@{$ra_files}) {
 929			chomp $file;
 930			my @splits = $file;
 931			if( stat($file)->size > $g_s3max_size ) {
 932				my $split_prefix = "$file-split-";
 933				my $cmd = "$split -b $g_s3max_size $file $split_prefix";
 934				if( system($cmd) != 0 ) {
 935					print_error "Could not run '$cmd' to split $file into chunks of size $g_s3max_size";
 936					next;
 937				} else {
 938					@splits = glob("$split_prefix*");
 939				}
 940			}
 941
 942			for my $split (@splits) {
 943				my $filename = basename($split);
 944				my $file_length = stat($split)->size;
 945
 946				print_info "opened $split of length $file_length and will name the key $filename";
 947
 948				$totalbytes += $file_length;
 949				$bucket_obj->add_key_filename(
 950					$filename, $split,
 951					{
 952						content_type => "application/binary"
 953					}
 954				);
 955				$uploaded{$filename} = $file_length;
 956			}
 957            # For the S3 method, we assume success in any case.
 958            appendto_uploaded_archives($file, $host);
 959		}
 960
 961		# get a list of files and confirm uploads
 962		$response = $bucket_obj->list;
 963		my @keys = @{ $response->{keys} };
 964		foreach my $key ( @keys ) {
 965			if (not defined $uploaded{$key->{key}}) {
 966				next;
 967			}
 968			if ($key->{size} == $uploaded{$key->{key}}) {
 969				print_info $key->{key} . " uploaded sucessfully";
 970				delete $uploaded{$key->{key}};
 971			} 
 972			else {
 973				print_error $key->{key} . " did not upload sucessfully. S3 reports $key is " . $key->{size} . " bytes rather than " . $uploaded{$key->{key}};
 974				delete $uploaded{$key->{key}};
 975				return FALSE;
 976			}
 977		}
 978	}
 979
 980	print_info ("Uploaded $totalbytes bytes of data to S3 in " 
 981             .  (time() - $starttime) . " seconds");
 982    return TRUE;
 983}
 984
 985# }}}
 986
 987##############################################################
 988# Main
 989##############################################################
 990# {{{
 991
 992# date is always the last args.
 993my $date = $ARGV[$#ARGV];
 994$date = 'today' if (not defined $date or $date =~ /^-/);
 995
 996# the really needed args !
 997unless (defined $g_host and
 998	defined $g_user and 
 999	defined $g_protocol) {
1000	print $BackupManager::Config::usage, "\n";
1001	exit E_INVALID;
1002}
1003
1004if ($g_protocol eq 'ftp' and not defined $g_pass) {
1005    # try to read the password from the environment
1006    if (defined $ENV{BM_UPLOAD_FTP_PASSWORD}) {
1007        $g_pass = $ENV{BM_UPLOAD_FTP_PASSWORD};
1008    }
1009    else {
1010    	print $BackupManager::Config::usage, "\n";
1011    	exit E_INVALID;
1012    }
1013}
1014
1015if ($g_protocol eq 's3' and (not defined $g_bucket or not defined $g_pass)) {
1016    if (! defined $g_pass && defined $ENV{BM_UPLOAD_S3_SECRET_KEY}) {
1017        $g_pass = $ENV{BM_UPLOAD_S3_SECRET_KEY};
1018    }
1019    else {
1020	    print $BackupManager::Config::usage, "\n";
1021	    exit E_INVALID;
1022    }
1023}
1024
1025if ($g_protocol eq 'ssh-gpg' and (not defined $g_gpg_recipient)) {        
1026	print $BackupManager::Config::usage, "\n";
1027	exit E_INVALID;
1028}
1029
1030# storing hosts on memory
1031my $ra_hosts = get_hosts_from_str($g_host);
1032
1033# where to store archives...
1034$g_remote_dir = "/backup/uploads/" if (not defined $g_remote_dir); 
1035
1036# let's find which files needs to be uploaded.
1037my $ra_files = get_files_list_from_date(get_formated_date($date));
1038
1039# if user wants listing, just do it !
1040if ($g_list) {
1041	print_info "files to upload ($date) :";
1042	foreach my $file (@{$ra_files}) {
1043		print "- $file\n"; 
1044	}
1045	exit E_SUCCESS;
1046}
1047
1048# We'll now send the files with the appropriate transfer protocol
1049$g_protocol = lc $g_protocol;
1050
1051# FTP
1052if ($g_protocol eq 'ftp') {
1053	print_info "Trying to upload files with ftp";
1054	if (! send_files_with_ftp ($g_user, 
1055                               $g_pass, 
1056                               $ra_hosts, 
1057                               $g_remote_dir, 
1058                               $ra_files)) {
1059        print_error "The upload transfer \"$g_protocol\" failed.";
1060        exit E_FTP_FAILED;
1061    }
1062}
1063
1064# SSH related tranfers
1065elsif ($g_protocol eq 'scp' or 
1066       $g_protocol eq 'ssh' or 
1067       $g_protocol eq 'ssh-gpg') {
1068    
1069    if ($g_protocol eq 'ssh-gpg') {
1070	    print_info "Trying to upload files with ssh-gpg";
1071    }
1072    else {
1073	    $g_gpg_recipient = undef;
1074	    print_info "Trying to upload files with scp";
1075    }
1076    
1077    if (! send_files_with_scp ($g_user, 
1078                               $ra_hosts, 
1079                               $g_remote_dir, 
1080                               $ra_files, 
1081                               $g_gpg_recipient)) {
1082        print_error "The upload transfer \"$g_protocol\" failed.";
1083        exit E_SCP_FAILED;
1084    }
1085}
1086
1087# Amazon S3 WebService
1088elsif ($g_protocol eq 's3') {
1089    print_info "Trying to upload files to s3 service";
1090    if (! send_files_with_s3 ($g_user, 
1091                            $g_pass, 
1092                            $g_bucket, 
1093                            $ra_hosts, 
1094                            $g_remote_dir, 
1095                            $ra_files)) {
1096        print_error "The upload transfer \"$g_protocol\" failed.";
1097        exit E_S3_FAILED;
1098    }
1099}
1100
1101# Unknown protocol
1102else {
1103	print STDERR "mode '$g_protocol' is not supported\n";
1104	exit E_UNKNOWN;
1105}
1106
1107__END__
1108=head1 NAME
1109
1110backup-manager-upload - Multiprotocol uploader for backup-manager.
1111
1112=head1 SYNOPSIS
1113
1114backup-manager-upload [options] date 
1115
1116=head1 DESCRIPTION
1117
1118B<backup-manager-upload> will upload all the archives generated on the given 
1119date to the specified host with either ftp or scp.
1120It's also possible to use this program for uploading data to an Amazon S3 account.
1121Some metadates are available like "today" or "yesterday".
1122
1123=head1 REQUIRED ARGS
1124
1125=over 4
1126
1127=item B<--mode=>I<transfer-mode>
1128
1129Select the transfer mode to use : ftp, scp, or s3.
1130
1131=item B<--host=>I<hostname1,hostname2,...,hostnameN>
1132
1133Select a list of remote hosts to connect to.
1134
1135=item B<--user=>I<username>
1136
1137Select the user to use for connection.
1138
1139=back
1140
1141=head1 OPTIONAL ARGS
1142
1143=over 4
1144
1145=item B<--password=>I<password>
1146
1147Select the ftp user's password (only needed for ftp transfers).
1148
1149=item B<--key=>I<path_to_private_key>
1150
1151Select the ssh private key file to use when opening the ssh session for scp transfer.
1152Obviously, this is only needed for scp transfer mode.
1153If you don't specify a key file, the user's default private key will be used.
1154
1155=item B<--directory=>I<directory>
1156
1157Select the location on the remote host where files will be uploaded.
1158Default is /backup/uploads.
1159
1160=item B<--bucket=>I<bucket>
1161
1162Sets the bucket name for the Amazon S3 service backup into.
1163
1164=item B<--root=>I<directory>
1165
1166Select the local directory where files are.
1167Default is /var/archives
1168
1169=item B<--gpg-recipient=>I<gpg-recipient> 
1170
1171Select the gpg public key for encryptiong the archives when uploading
1172with the method ssh-gpg. This can be a short or long key id or a
1173descriptive name. The precise syntax is described in the gpg man page.
1174
1175=item B<--list>
1176
1177Just list the files to upload.
1178
1179=item B<--ftp-purge>
1180
1181Purge the remote directory before uploading files in FTP mode.
1182
1183=item B<--s3-purge>
1184
1185Purge the remote directory before uploading files in FTP mode.
1186
1187=item B<--ssh-purge>
1188
1189Purge the remote directory before uploading files in SSH mode.
1190
1191=item B<--verbose>
1192
1193Flag to enable verbose mode.
1194
1195=item B<date>
1196
1197Date pattern to select some files to upload, can be a valid date (YYYYMMDD) or 'today' or 'yesterday'.
1198
1199=back
1200
1201=head1 ERROR CODES
1202
1203If something goes wrong during an upload, backup-manager-upload will exit 
1204with a non null value. In such a case every error messages are sent to 
1205STDERR.
1206
1207Here are the possible error codes:
1208
1209=over 4
1210
1211=item bad command line (wrong arguments) : 10
1212
1213=item FTP transfer failure : 20
1214
1215=item SCP transfer failure : 21
1216
1217=item S3 transfer failure : 22
1218
1219=item Unknown upload method: 23
1220
1221=back
1222
1223=cut
1224
1225
1226=head1 SEE ALSO
1227
1228L<backup-manager(3)>
1229
1230=head1 AUTHORS
1231
1232Alexis Sukrieh - main code and design
1233
1234Brad Dixon - Amazon S3 upload method
1235
1236Jan Metzger - ssh-gpg upload method
1237
1238=cut