/backup-manager-upload
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