git.gag.com Git - debian/amanda/blob - server-src/amidxtaped.pl

   1 #! @PERL@
   2 # Copyright (c) 2010 Zmanda, Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License version 2 as published
   6 # by the Free Software Foundation.
   7 #
   8 # This program is distributed in the hope that it will be useful, but
   9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11 # for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 #
  17 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 use lib '@amperldir@';
  21 use strict;
  22 use warnings;
  23
  24 ##
  25 # Interactive class
  26
  27 package main::Interactive;
  28 use base 'Amanda::Interactive';
  29 use Amanda::Util qw( weaken_ref );
  30 use Amanda::MainLoop;
  31 use Amanda::Feature;
  32 use Amanda::Debug qw( debug );
  33 use Amanda::Config qw( :getconf );
  34 use Amanda::Recovery::Scan qw( $DEFAULT_CHANGER );
  35
  36 sub new {
  37     my $class = shift;
  38     my %params = @_;
  39
  40     my $self = {
  41         clientservice => $params{'clientservice'},
  42     };
  43
  44     # (weak ref here to eliminate reference loop)
  45     weaken_ref($self->{'clientservice'});
  46
  47     return bless ($self, $class);
  48 }
  49
  50 sub abort() {
  51     my $self = shift;
  52
  53     debug("ignoring spurious Amanda::Recovery::Scan abort call");
  54 }
  55
  56 sub user_request {
  57     my $self = shift;
  58     my %params = @_;
  59     my $buffer = "";
  60
  61     my $steps = define_steps
  62         cb_ref => \$params{'finished_cb'};
  63
  64     step send_message => sub {
  65         if ($params{'err'}) {
  66             $self->{'clientservice'}->sendmessage("$params{err}");
  67         }
  68
  69         $steps->{'check_fe_feedme'}->();
  70     };
  71
  72     step check_fe_feedme => sub {
  73         # note that fe_amrecover_FEEDME implies fe_amrecover_splits
  74         if (!$self->{'clientservice'}->{'their_features'}->has(
  75                                     $Amanda::Feature::fe_amrecover_FEEDME)) {
  76             return $params{'finished_cb'}->("remote cannot prompt for volumes", undef);
  77         }
  78         $steps->{'send_feedme'}->();
  79     };
  80
  81     step send_feedme => sub {
  82         $self->{'clientservice'}->sendctlline("FEEDME $params{label}\r\n", $steps->{'read_response'});
  83     };
  84
  85     step read_response => sub {
  86         my ($err, $written) = @_;
  87         return $params{'finished_cb'}->($err, undef) if $err;
  88
  89         $self->{'clientservice'}->getline_async(
  90                 $self->{'clientservice'}->{'ctl_stream'}, $steps->{'got_response'});
  91     };
  92
  93     step got_response => sub {
  94         my ($err, $line) = @_;
  95         return $params{'finished_cb'}->($err, undef) if $err;
  96
  97         if ($line eq "OK\r\n") {
  98             return $params{'finished_cb'}->(undef, undef); # carry on as you were
  99         } elsif ($line =~ /^TAPE (.*)\r\n$/) {
 100             my $tape = $1;
 101             if ($tape eq getconf($CNF_AMRECOVER_CHANGER)) {
 102                 $tape = $Amanda::Recovery::Scan::DEFAULT_CHANGER;
 103             }
 104             return $params{'finished_cb'}->(undef, $tape); # use this device
 105         } else {
 106             return $params{'finished_cb'}->("got invalid response from remote", undef);
 107         }
 108     };
 109 };
 110
 111 ##
 112 # ClientService class
 113
 114 package main::ClientService;
 115 use base 'Amanda::ClientService';
 116
 117 use Amanda::Debug qw( debug info warning );
 118 use Amanda::Util qw( :constants );
 119 use Amanda::Feature;
 120 use Amanda::Config qw( :init :getconf );
 121 use Amanda::Changer;
 122 use Amanda::Recovery::Scan;
 123 use Amanda::Xfer qw( :constants );
 124 use Amanda::Cmdline;
 125 use Amanda::Recovery::Clerk;
 126 use Amanda::Recovery::Planner;
 127 use Amanda::Recovery::Scan;
 128 use Amanda::DB::Catalog;
 129 use Amanda::Disklist;
 130 use Amanda::Logfile qw( match_disk match_host );
 131
 132 # Note that this class performs its control IO synchronously.  This is adequate
 133 # for this service, as it never receives unsolicited input from the remote
 134 # system.
 135
 136 sub run {
 137     my $self = shift;
 138
 139     $self->{'my_features'} = Amanda::Feature::Set->mine();
 140     $self->{'their_features'} = Amanda::Feature::Set->old();
 141
 142     $self->setup_streams();
 143 }
 144
 145 sub setup_streams {
 146     my $self = shift;
 147
 148     # get started checking security for inetd or processing the REQ/REP
 149     # for amandad
 150     if ($self->from_inetd()) {
 151         if (!$self->check_inetd_security('main')) {
 152             $main::exit_status = 1;
 153             return $self->quit();
 154         }
 155         $self->{'ctl_stream'} = 'main';
 156         $self->{'data_stream'} = undef; # no data stream yet
 157     } else {
 158         my $req = $self->get_req();
 159
 160         # make some sanity checks
 161         my $errors = [];
 162         if (defined $req->{'options'}{'auth'} and defined $self->amandad_auth()
 163                 and $req->{'options'}{'auth'} ne $self->amandad_auth()) {
 164             my $reqauth = $req->{'options'}{'auth'};
 165             my $amauth = $self->amandad_auth();
 166             push @$errors, "recover program requested auth '$reqauth', " .
 167                            "but amandad is using auth '$amauth'";
 168             $main::exit_status = 1;
 169         }
 170
 171         # and pull out the features, if given
 172         if (defined($req->{'features'})) {
 173             $self->{'their_features'} = $req->{'features'};
 174         }
 175
 176         $self->send_rep(['CTL' => 'rw', 'DATA' => 'w'], $errors);
 177         return $self->quit() if (@$errors);
 178
 179         $self->{'ctl_stream'} = 'CTL';
 180         $self->{'data_stream'} = 'DATA';
 181     }
 182
 183     $self->read_command();
 184 }
 185
 186 sub read_command {
 187     my $self = shift;
 188     my $ctl_stream = $self->{'ctl_stream'};
 189     my $command = $self->{'command'} = {};
 190
 191     my @known_commands = qw(
 192         HOST DISK DATESTAMP LABEL DEVICE FSF HEADER
 193         FEATURES CONFIG );
 194     while (1) {
 195         $_ = $self->getline($ctl_stream);
 196         $_ =~ s/\r?\n$//g;
 197
 198         last if /^END$/;
 199         last if /^[0-9]+$/;
 200
 201         if (/^([A-Z]+)(=(.*))?$/) {
 202             my ($cmd, $val) = ($1, $3);
 203             if (!grep { $_ eq $cmd } @known_commands) {
 204                 $self->sendmessage("invalid command '$cmd'");
 205                 return $self->quit();
 206             }
 207             if (exists $command->{$cmd}) {
 208                 warning("got duplicate command key '$cmd' from remote");
 209             } else {
 210                 $command->{$cmd} = $val || 1;
 211             }
 212         }
 213
 214         # features are handled specially.  This is pretty weird!
 215         if (/^FEATURES=/) {
 216             my $featreply;
 217             my $featurestr = $self->{'my_features'}->as_string();
 218             if ($self->from_amandad) {
 219                 $featreply = "FEATURES=$featurestr\r\n";
 220             } else {
 221                 $featreply = $featurestr;
 222             }
 223
 224             $self->senddata($ctl_stream, $featreply);
 225         }
 226     }
 227
 228     # process some info from the command
 229     if ($command->{'FEATURES'}) {
 230         $self->{'their_features'} = Amanda::Feature::Set->from_string($command->{'FEATURES'});
 231     }
 232
 233     # load the configuration
 234     if (!$command->{'CONFIG'}) {
 235         die "no CONFIG line given";
 236     }
 237     config_init($CONFIG_INIT_EXPLICIT_NAME, $command->{'CONFIG'});
 238     my ($cfgerr_level, @cfgerr_errors) = config_errors();
 239     if ($cfgerr_level >= $CFGERR_ERRORS) {
 240         die "configuration errors; aborting connection";
 241     }
 242     Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER_PREFERRED);
 243
 244     # and the disklist
 245     my $diskfile = Amanda::Config::config_dir_relative(getconf($CNF_DISKFILE));
 246     $cfgerr_level = Amanda::Disklist::read_disklist('filename' => $diskfile);
 247     if ($cfgerr_level >= $CFGERR_ERRORS) {
 248         die "Errors processing disklist";
 249     }
 250
 251     $self->setup_data_stream();
 252 }
 253
 254 sub setup_data_stream {
 255     my $self = shift;
 256
 257     # if we're using amandad, then this is ready to roll - it's only inetd mode
 258     # that we need to fix
 259     if ($self->from_inetd()) {
 260         if ($self->{'their_features'}->has($Amanda::Feature::fe_recover_splits)) {
 261             # remote side is expecting CONNECT
 262             my $port = $self->connection_listen('DATA', 0);
 263             $self->senddata($self->{'ctl_stream'}, "CONNECT $port\n");
 264             $self->connection_accept('DATA', 30, sub { $self->got_connection(@_); });
 265         } else {
 266             $self->{'ctl_stream'} = undef; # don't use this for ctl anymore
 267             $self->{'data_stream'} = 'main';
 268             $self->make_plan();
 269         }
 270     } else {
 271         $self->make_plan();
 272     }
 273 }
 274
 275 sub got_connection {
 276     my $self = shift;
 277     my ($err) = @_;
 278
 279     if ($err) {
 280         $self->sendmessage("$err");
 281         return $self->quit();
 282     }
 283
 284     if (!$self->check_inetd_security('DATA')) {
 285         $main::exit_status = 1;
 286         return $self->quit();
 287     }
 288     $self->{'data_stream'} = 'DATA';
 289
 290     $self->make_plan();
 291 }
 292
 293 sub make_plan {
 294     my $self = shift;
 295
 296     # put together a dumpspec
 297     my $spec;
 298     if (exists $self->{'command'}{'HOST'}
 299      || exists $self->{'command'}{'DISK'}
 300      || exists $self->{'command'}{'DATESTAMP'}) {
 301         my $disk = $self->{'command'}{'DISK'};
 302         if (!$self->{'their_features'}->has($Amanda::Feature::fe_amrecover_correct_disk_quoting)) {
 303             debug("ignoring specified DISK, as it may be badly quoted");
 304             $disk = undef;
 305         }
 306         $spec = Amanda::Cmdline::dumpspec_t->new(
 307             $self->{'command'}{'HOST'},
 308             $disk,
 309             $self->{'command'}{'DATESTAMP'},
 310             undef,  # amidxtaped protocol does not provide a level (!?)
 311             undef); # amidxtaped protocol does not provide a write timestamp
 312     }
 313
 314     # figure out if this is a holding-disk recovery
 315     my $is_holding = 0;
 316     if (!exists $self->{'command'}{'LABEL'} and exists $self->{'command'}{'DEVICE'}) {
 317         $is_holding = 1;
 318     }
 319
 320     my $chg;
 321     if ($is_holding) {
 322         # for holding, give the clerk a null; it won't touch it
 323         $chg = Amanda::Changer->new("chg-null:");
 324     } else {
 325         # if not doing a holding-disk recovery, then we will need a changer.
 326         # If we're using the "default" changer, instantiate that.  There are
 327         # several ways the user can specify the default changer:
 328         my $use_default = 0;
 329         if (!exists $self->{'command'}{'DEVICE'}) {
 330             $use_default = 1;
 331         } elsif ($self->{'command'}{'DEVICE'} eq getconf($CNF_AMRECOVER_CHANGER)) {
 332             $use_default = 1;
 333         }
 334
 335         if ($use_default) {
 336             $chg = Amanda::Changer->new();
 337         } else {
 338             $chg = Amanda::Changer->new($self->{'command'}{'DEVICE'});
 339         }
 340
 341         # if we got a bogus changer, log it to the debug log, but allow the
 342         # scan algorithm to find a good one later.
 343         if ($chg->isa("Amanda::Changer::Error")) {
 344             warning("$chg");
 345             $chg = Amanda::Changer->new("chg-null:");
 346         }
 347     }
 348     my $inter = main::Interactive->new(clientservice => $self);
 349
 350     my $scan = Amanda::Recovery::Scan->new(
 351                         chg => $chg,
 352                         interactive => $inter);
 353     # XXX temporary
 354     $scan->{'scan_conf'}->{'driveinuse'} = Amanda::Recovery::Scan::SCAN_ASK;
 355     $scan->{'scan_conf'}->{'volinuse'} = Amanda::Recovery::Scan::SCAN_ASK;
 356     $scan->{'scan_conf'}->{'notfound'} = Amanda::Recovery::Scan::SCAN_ASK;
 357
 358     $self->{'clerk'} = Amanda::Recovery::Clerk->new(
 359         # note that we don't have any use for clerk_notif's, so we don't pass
 360         # a feedback object
 361         scan => $scan);
 362
 363     if ($is_holding) {
 364         # if this is a holding recovery, then the plan is pretty easy.  The holding
 365         # file is given to us in the aptly-named DEVICE command key, with a :0 suffix
 366         my $holding_file_tapespec = $self->{'command'}{'DEVICE'};
 367         my $holding_file = $self->tapespec_to_holding($holding_file_tapespec);
 368
 369         return Amanda::Recovery::Planner::make_plan(
 370             holding_file => $holding_file,
 371             $spec? (dumpspec => $spec) : (),
 372             plan_cb => sub { $self->plan_cb(@_); });
 373     } else {
 374         my $filelist = Amanda::Util::unmarshal_tapespec($self->{'command'}{'LABEL'});
 375
 376         # if LABEL was just a label, then FSF should contain the filenum we want to
 377         # start with.
 378         if ($filelist->[1][0] == 0) {
 379             if (exists $self->{'command'}{'FSF'}) {
 380                 $filelist->[1][0] = 0+$self->{'command'}{'FSF'};
 381                 # note that if this is a split dump, make_plan will helpfully find the
 382                 # remaining parts and include them in the restore.  Pretty spiffy.
 383             } else {
 384                 # we have only a label and (hopefully) a dumpspec, so let's see if the
 385                 # catalog can find a dump for us.
 386                 $filelist = $self->try_to_find_dump(
 387                         $self->{'command'}{'LABEL'},
 388                         $spec);
 389                 if (!$filelist) {
 390                     return $self->quit();
 391                 }
 392             }
 393         }
 394
 395         return Amanda::Recovery::Planner::make_plan(
 396             filelist => $filelist,
 397             $spec? (dumpspec => $spec) : (),
 398             plan_cb => sub { $self->plan_cb(@_); });
 399     }
 400 }
 401
 402 sub plan_cb {
 403     my $self = shift;
 404     my ($err, $plan) = @_;
 405
 406     if ($err) {
 407         $self->sendmessage("$err");
 408         return $self->quit();
 409     }
 410
 411     if (@{$plan->{'dumps'}} > 1) {
 412         $self->sendmessage("multiple matching dumps; cannot recover");
 413         return $self->quit();
 414     }
 415
 416     # check that the request-limit for this DLE allows this recovery.  because
 417     # of the bass-ackward way that amrecover specifies the dump to us, we can't
 418     # check the results until *after* the plan was created.
 419     my $dump = $plan->{'dumps'}->[0];
 420     my $dle = Amanda::Disklist::get_disk($dump->{'hostname'}, $dump->{'diskname'});
 421     my $recovery_limit;
 422     if ($dle && dumptype_seen($dle->{'config'}, $DUMPTYPE_RECOVERY_LIMIT)) {
 423         debug("using DLE recovery limit");
 424         $recovery_limit = dumptype_getconf($dle->{'config'}, $DUMPTYPE_RECOVERY_LIMIT);
 425     } elsif (getconf_seen($CNF_RECOVERY_LIMIT)) {
 426         debug("using global recovery limit as default");
 427         $recovery_limit = getconf($CNF_RECOVERY_LIMIT);
 428     }
 429     my $peer = $ENV{'AMANDA_AUTHENTICATED_PEER'};
 430     if (defined $recovery_limit) { # undef -> no recovery limit
 431         if (!$peer) {
 432             warning("a recovery limit is specified for this DLE, but no authenticted ".
 433                     "peer name is available; rejecting request.");
 434             $self->sendmessage("No matching dumps found");
 435             return $self->quit();
 436         }
 437         my $matched = 0;
 438         for my $rl (@$recovery_limit) {
 439             if (!defined $rl) {
 440                 # handle same-host with a case-insensitive string compare, not match_host
 441                 if (lc($peer) eq lc($dump->{'hostname'})) {
 442                     $matched = 1;
 443                     last;
 444                 }
 445             }
 446
 447             # otherwise use match_host to allow match expressions
 448             if (match_host($rl, $peer)) {
 449                 $matched = 1;
 450                 last;
 451             }
 452         }
 453         if (!$matched) {
 454             warning("authenticated peer '$peer' did not match recovery-limit ".
 455                     "config; rejecting request");
 456             $self->sendmessage("No matching dumps found");
 457             return $self->quit();
 458         }
 459     }
 460
 461     if (!$self->{'their_features'}->has($Amanda::Feature::fe_recover_splits)) {
 462         # if we have greater than one volume, we may need to prompt for a new
 463         # volume in mid-recovery.  Sadly, we have no way to inform the client of
 464         # this.  In hopes that this will "just work", we just issue a warning.
 465         my @vols = $plan->get_volume_list();
 466         warning("client does not support split dumps; restore may fail if " .
 467                 "interaction is necessary");
 468     }
 469
 470     # now set up the transfer
 471     $self->{'clerk'}->get_xfer_src(
 472         dump => $plan->{'dumps'}[0],
 473         xfer_src_cb => sub { $self->xfer_src_cb(@_); });
 474 }
 475
 476 sub xfer_src_cb {
 477     my $self = shift;
 478     my ($errors, $header, $xfer_src, $directtcp_supported) = @_;
 479
 480     if ($errors) {
 481         for (@$errors) {
 482             $self->sendmessage("$_");
 483         }
 484         return $self->quit();
 485     }
 486
 487     $self->{'xfer_src'} = $xfer_src;
 488     $self->{'xfer_src_supports_directtcp'} = $directtcp_supported;
 489     $self->{'header'} = $header;
 490
 491     debug("recovering from " . $header->summary());
 492
 493     # set up any filters that need to be applied, decryption first
 494     my @filters;
 495     if ($header->{'encrypted'}) {
 496         if ($header->{'srv_encrypt'}) {
 497             push @filters,
 498                 Amanda::Xfer::Filter::Process->new(
 499                     [ $header->{'srv_encrypt'}, $header->{'srv_decrypt_opt'} ], 0, 1);
 500         } elsif ($header->{'clnt_encrypt'}) {
 501             push @filters,
 502                 Amanda::Xfer::Filter::Process->new(
 503                     [ $header->{'clnt_encrypt'}, $header->{'clnt_decrypt_opt'} ], 0, 1);
 504         } else {
 505             $self->sendmessage("could not decrypt encrypted dump: no program specified");
 506             return $self->quit();
 507         }
 508
 509         $header->{'encrypted'} = 0;
 510         $header->{'srv_encrypt'} = '';
 511         $header->{'srv_decrypt_opt'} = '';
 512         $header->{'clnt_encrypt'} = '';
 513         $header->{'clnt_decrypt_opt'} = '';
 514         $header->{'encrypt_suffix'} = 'N';
 515     }
 516
 517     if ($header->{'compressed'}) {
 518         # need to uncompress this file
 519         debug("..with decompression applied");
 520
 521         if ($header->{'srvcompprog'}) {
 522             # TODO: this assumes that srvcompprog takes "-d" to decrypt
 523             push @filters,
 524                 Amanda::Xfer::Filter::Process->new(
 525                     [ $header->{'srvcompprog'}, "-d" ], 0, 1);
 526         } elsif ($header->{'clntcompprog'}) {
 527             # TODO: this assumes that clntcompprog takes "-d" to decrypt
 528             push @filters,
 529                 Amanda::Xfer::Filter::Process->new(
 530                     [ $header->{'clntcompprog'}, "-d" ], 0, 1);
 531         } else {
 532             push @filters,
 533                 Amanda::Xfer::Filter::Process->new(
 534                     [ $Amanda::Constants::UNCOMPRESS_PATH,
 535                       $Amanda::Constants::UNCOMPRESS_OPT ], 0, 1);
 536         }
 537
 538         # adjust the header
 539         $header->{'compressed'} = 0;
 540         $header->{'uncompress_cmd'} = '';
 541     }
 542     $self->{'xfer_filters'} = [ @filters ];
 543
 544     # only send the header if requested
 545     if ($self->{'command'}{'HEADER'}) {
 546         $self->send_header();
 547     } else {
 548         $self->expect_datapath();
 549     }
 550 }
 551
 552 sub send_header {
 553     my $self = shift;
 554
 555     my $header = $self->{'header'};
 556
 557     # filter out some things the remote might not be able to process
 558     if (!$self->{'their_features'}->has($Amanda::Feature::fe_amrecover_dle_in_header)) {
 559         $header->{'dle_str'} = undef;
 560     }
 561     if (!$self->{'their_features'}->has($Amanda::Feature::fe_amrecover_origsize_in_header)) {
 562         $header->{'orig_size'} = 0;
 563     }
 564
 565     # even with fe_amrecover_splits, amrecover doesn't like F_SPLIT_DUMPFILE.
 566     $header->{'type'} = $Amanda::Header::F_DUMPFILE;
 567
 568     my $hdr_str = $header->to_string(32768, 32768);
 569     Amanda::Util::full_write($self->wfd($self->{'data_stream'}), $hdr_str, length($hdr_str))
 570         or die "writing to $self->{data_stream}: $!";
 571
 572     $self->expect_datapath();
 573 }
 574
 575 sub expect_datapath {
 576     my $self = shift;
 577
 578     $self->{'datapath'} = 'none';
 579
 580     # short-circuit this if amrecover doesn't support datapaths
 581     if (!$self->{'their_features'}->has($Amanda::Feature::fe_amidxtaped_datapath)) {
 582         return $self->start_xfer();
 583     }
 584
 585     my $line = $self->getline($self->{'ctl_stream'});
 586     if ($line eq "ABORT\r\n") {
 587         return Amanda::MainLoop::quit();
 588     }
 589     my ($dpspec) = ($line =~ /^AVAIL-DATAPATH (.*)\r\n$/);
 590     die "bad AVAIL-DATAPATH line" unless $dpspec;
 591     my @avail_dps = split / /, $dpspec;
 592
 593     if (grep /^DIRECT-TCP$/, @avail_dps) {
 594         # remote can handle a directtcp transfer .. can we?
 595         if ($self->{'xfer_src_supports_directtcp'}) {
 596             $self->{'datapath'} = 'directtcp';
 597         } else {
 598             $self->{'datapath'} = 'amanda';
 599         }
 600     } else {
 601         # remote can at least handle AMANDA
 602         die "remote cannot handle AMANDA datapath??"
 603             unless grep /^AMANDA$/, @avail_dps;
 604         $self->{'datapath'} = 'amanda';
 605     }
 606
 607     $self->start_xfer();
 608 }
 609
 610 sub start_xfer {
 611     my $self = shift;
 612
 613     # create the appropriate destination based on our datapath
 614     my $xfer_dest;
 615     if ($self->{'datapath'} eq 'directtcp') {
 616         $xfer_dest = Amanda::Xfer::Dest::DirectTCPListen->new();
 617     } else {
 618         $xfer_dest = Amanda::Xfer::Dest::Fd->new(
 619                 $self->wfd($self->{'data_stream'})),
 620     }
 621
 622     if ($self->{'datapath'} eq 'amanda') {
 623         $self->sendctlline("USE-DATAPATH AMANDA\r\n");
 624         my $dpline = $self->getline($self->{'ctl_stream'});
 625         if ($dpline ne "DATAPATH-OK\r\n") {
 626             die "expected DATAPATH-OK";
 627         }
 628     }
 629
 630     # create and start the transfer
 631     $self->{'xfer'} = Amanda::Xfer->new([
 632         $self->{'xfer_src'},
 633         @{$self->{'xfer_filters'}},
 634         $xfer_dest,
 635     ]);
 636     $self->{'xfer'}->start(sub { $self->handle_xmsg(@_); });
 637     debug("started xfer; datapath=$self->{datapath}");
 638
 639     # send the data-path response, if we have a datapath
 640     if ($self->{'datapath'} eq 'directtcp') {
 641         my $addrs = $xfer_dest->get_addrs();
 642         $addrs = [ map { $_->[0] . ":" . $_->[1] } @$addrs ];
 643         $addrs = join(" ", @$addrs);
 644         $self->sendctlline("USE-DATAPATH DIRECT-TCP $addrs\r\n");
 645         my $dpline = $self->getline($self->{'ctl_stream'});
 646         if ($dpline ne "DATAPATH-OK\r\n") {
 647             die "expected DATAPATH-OK";
 648         }
 649     }
 650
 651     # and let the clerk know
 652     $self->{'clerk'}->start_recovery(
 653         xfer => $self->{'xfer'},
 654         recovery_cb => sub { $self->recovery_cb(@_); });
 655 }
 656
 657 sub handle_xmsg {
 658     my $self = shift;
 659     my ($src, $msg, $xfer) = @_;
 660
 661     $self->{'clerk'}->handle_xmsg($src, $msg, $xfer);
 662     if ($msg->{'elt'} != $self->{'xfer_src'}) {
 663         if ($msg->{'type'} == $XMSG_ERROR) {
 664             $self->sendmessage("$msg->{message}");
 665         }
 666     }
 667 }
 668
 669 sub recovery_cb {
 670     my $self = shift;
 671     my %params = @_;
 672
 673     debug("recovery complete");
 674     if (@{$params{'errors'}}) {
 675         for (@{$params{'errors'}}) {
 676             $self->sendmessage("$_");
 677         }
 678         return $self->quit();
 679     }
 680
 681     # note that the amidxtaped protocol has no way to indicate successful
 682     # completion of a transfer
 683     if ($params{'result'} ne 'DONE') {
 684         warning("NOTE: transfer failed, but amrecover does not know that");
 685     }
 686
 687     $self->finish();
 688 }
 689
 690 sub finish {
 691     my $self = shift;
 692
 693     # close the data fd for writing to signal EOF
 694     $self->close($self->{'data_stream'}, 'w');
 695
 696     $self->quit();
 697 }
 698
 699 sub quit {
 700     my $self = shift;
 701
 702     if ($self->{'clerk'}) {
 703         $self->{'clerk'}->quit(finished_cb => sub {
 704             my ($err) = @_;
 705             if ($err) {
 706                 # it's *way* too late to report this to amrecover now!
 707                 warning("while quitting clerk: $err");
 708             }
 709             Amanda::MainLoop::quit();
 710         });
 711     } else {
 712         Amanda::MainLoop::quit();
 713     }
 714 }
 715
 716 ## utilities
 717
 718 sub check_inetd_security {
 719     my $self = shift;
 720     my ($stream) = @_;
 721
 722     my $firstline = $self->getline($stream);
 723     if ($firstline !~ /^SECURITY (.*)\n/) {
 724         warning("did not get security line");
 725         print "ERROR did not get security line\r\n";
 726         return 0;
 727     }
 728
 729     my $errmsg = $self->check_bsd_security($stream, $1);
 730     if ($errmsg) {
 731         print "ERROR $errmsg\r\n";
 732         return 0;
 733     }
 734
 735     return 1;
 736 }
 737
 738 sub get_req {
 739     my $self = shift;
 740
 741     my $req_str = '';
 742     while (1) {
 743         my $buf = Amanda::Util::full_read($self->rfd('main'), 1024);
 744         last unless $buf;
 745         $req_str .= $buf;
 746     }
 747     # we've read main to EOF, so close it
 748     $self->close('main', 'r');
 749
 750     return $self->{'req'} = $self->parse_req($req_str);
 751 }
 752
 753 sub send_rep {
 754     my $self = shift;
 755     my ($streams, $errors) = @_;
 756     my $rep = '';
 757
 758     # first, if there were errors in the REQ, report them
 759     if (@$errors) {
 760         for my $err (@$errors) {
 761             $rep .= "ERROR $err\n";
 762         }
 763     } else {
 764         my $connline = $self->connect_streams(@$streams);
 765         $rep .= "$connline\n";
 766     }
 767     # rep needs a empty-line terminator, I think
 768     $rep .= "\n";
 769
 770     # write the whole rep packet, and close main to signal the end of the packet
 771     $self->senddata('main', $rep);
 772     $self->close('main', 'w');
 773 }
 774
 775 # helper function to get a line, including the trailing '\n', from a stream.  This
 776 # reads a character at a time to ensure that no extra characters are consumed.  This
 777 # could certainly be more efficient! (TODO)
 778 sub getline {
 779     my $self = shift;
 780     my ($stream) = @_;
 781     my $fd = $self->rfd($stream);
 782     my $line = '';
 783
 784     while (1) {
 785         my $c;
 786         POSIX::read($fd, $c, 1)
 787             or last;
 788         $line .= $c;
 789         last if $c eq "\n";
 790     }
 791
 792     my $chopped = $line;
 793     $chopped =~ s/[\r\n]*$//g;
 794     debug("CTL << $chopped");
 795
 796     return $line;
 797 }
 798
 799 # like getline, but async; TODO:
 800 #  - make all uses of getline async
 801 #  - use buffering to read more than one character at a time
 802 sub getline_async {
 803     my $self = shift;
 804     my ($stream, $async_read_cb) = @_;
 805     my $fd = $self->rfd($stream);
 806
 807     my $data_in;
 808     my $buf = '';
 809
 810     $data_in = sub {
 811         my ($err, $data) = @_;
 812
 813         return $async_read_cb->($err, undef) if $err;
 814
 815         $buf .= $data;
 816         if ($buf =~ /\r\n$/) {
 817             my $chopped = $buf;
 818             $chopped =~ s/[\r\n]*$//g;
 819             debug("CTL << $chopped");
 820
 821             $async_read_cb->(undef, $buf);
 822         } else {
 823             Amanda::MainLoop::async_read(fd => $fd, size => 1, async_read_cb => $data_in);
 824         }
 825     };
 826     Amanda::MainLoop::async_read(fd => $fd, size => 1, async_read_cb => $data_in);
 827 }
 828
 829 # helper function to write a data to a stream.  This does not add newline characters.
 830 # If the callback is given, this is async (TODO: all calls should be async)
 831 sub senddata {
 832     my $self = shift;
 833     my ($stream, $data, $async_write_cb) = @_;
 834     my $fd = $self->wfd($stream);
 835
 836     if (defined $async_write_cb) {
 837         return Amanda::MainLoop::async_write(
 838                 fd => $fd,
 839                 data => $data,
 840                 async_write_cb => $async_write_cb);
 841     } else {
 842         Amanda::Util::full_write($fd, $data, length($data))
 843             or die "writing to $stream: $!";
 844     }
 845 }
 846
 847 # send a line on the control stream, or just log it if the ctl stream is gone;
 848 # async callback is just like for senddata
 849 sub sendctlline {
 850     my $self = shift;
 851     my ($msg, $async_write_cb) = @_;
 852
 853     my $chopped = $msg;
 854     $chopped =~ s/[\r\n]*$//g;
 855
 856     if ($self->{'ctl_stream'}) {
 857         debug("CTL >> $chopped");
 858         return $self->senddata($self->{'ctl_stream'}, $msg, $async_write_cb);
 859     } else {
 860         debug("not sending CTL message as CTL is closed >> $chopped");
 861         if (defined $async_write_cb) {
 862             $async_write_cb->(undef, length($msg));
 863         }
 864     }
 865 }
 866
 867 # send a MESSAGE on the CTL stream, but only if the remote has
 868 # fe_amrecover_message
 869 sub sendmessage {
 870     my $self = shift;
 871     my ($msg) = @_;
 872
 873     if ($self->{'their_features'}->has($Amanda::Feature::fe_amrecover_message)) {
 874         $self->sendctlline("MESSAGE $msg\r\n");
 875     } else {
 876         warning("remote does not understand MESSAGE; not sent: MESSAGE $msg");
 877     }
 878 }
 879
 880 # covert a tapespec to a holding filename
 881 sub tapespec_to_holding {
 882     my $self = shift;
 883     my ($tapespec) = @_;
 884
 885     my $filelist = Amanda::Util::unmarshal_tapespec($tapespec);
 886
 887     # $filelist should have the form [ $holding_file => [ 0 ] ]
 888     die "invalid holding tapespec" unless @$filelist == 2;
 889     die "invalid holding tapespec" unless @{$filelist->[1]} == 1;
 890     die "invalid holding tapespec" unless $filelist->[1][0] == 0;
 891
 892     return $filelist->[0];
 893 }
 894
 895 # amrecover didn't give us much to go on, but see if we can find a dump that
 896 # will make it happy.
 897 sub try_to_find_dump {
 898     my $self = shift;
 899     my ($label, $spec) = @_;
 900
 901     # search the catalog; get_dumps cannot search by labels, so we have to use
 902     # get_parts instead
 903     my @parts = Amanda::DB::Catalog::get_parts(
 904         label => $label,
 905         dumpspecs => [ $spec ]);
 906
 907     if (!@parts) {
 908         $self->sendmessage("could not find any matching dumps on volume '$label'");
 909         return undef;
 910     }
 911
 912     # (note that if there is more than one dump in @parts, the planner will
 913     # catch it later)
 914
 915     # sort the parts by their order on each volume.  This sorts the volumes
 916     # lexically by label, but the planner will straighten it out.
 917     @parts = Amanda::DB::Catalog::sort_dumps([ "label", "filenum" ], @parts);
 918
 919     # loop over the parts for the dump and make a filelist.
 920     my $last_label = '';
 921     my $last_filenums = undef;
 922     my $filelist = [];
 923     for my $part (@parts) {
 924         next unless defined $part; # skip part number 0
 925         if ($part->{'label'} ne $last_label) {
 926             $last_label = $part->{'label'};
 927             $last_filenums = [];
 928             push @$filelist, $last_label, $last_filenums;
 929         }
 930         push @$last_filenums, $part->{'filenum'};
 931     }
 932
 933     return $filelist;
 934 }
 935
 936 ##
 937 # main driver
 938
 939 package main;
 940 use Amanda::Debug qw( debug );
 941 use Amanda::Util qw( :constants );
 942 use Amanda::Config qw( :init );
 943
 944 our $exit_status = 0;
 945
 946 sub main {
 947     Amanda::Util::setup_application("amidxtaped", "server", $CONTEXT_DAEMON);
 948     config_init(0, undef);
 949     Amanda::Debug::debug_dup_stderr_to_debug();
 950
 951     my $cs = main::ClientService->new();
 952     Amanda::MainLoop::call_later(sub { $cs->run(); });
 953     Amanda::MainLoop::run();
 954
 955     debug("exiting with $exit_status");
 956     Amanda::Util::finish_application();
 957 }
 958
 959 main();
 960 exit($exit_status);