git.gag.com Git - debian/amanda/blob - perl/Amanda/Changer/compat.pm

   1 # Copyright (c) 2008-2012 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or
   4 # modify it under the terms of the GNU General Public License
   5 # as published by the Free Software Foundation; either version 2
   6 # of the License, or (at your option) any later version.
   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 94085, USA, or: http://www.zmanda.com
  19
  20 package Amanda::Changer::compat;
  21
  22 use strict;
  23 use warnings;
  24 use vars qw( @ISA );
  25 @ISA = qw( Amanda::Changer );
  26
  27 use Carp;
  28 use File::Glob qw( :glob );
  29 use File::Path;
  30 use Amanda::Paths;
  31 use Amanda::MainLoop qw( :GIOCondition );
  32 use Amanda::Config qw( :getconf );
  33 use Amanda::Debug qw( debug );
  34 use Amanda::Device qw( :constants );
  35 use Amanda::Changer;
  36 use Amanda::MainLoop;
  37
  38 =head1 NAME
  39
  40 Amanda::Changer::compat -- run "old" changer scripts
  41
  42 =head1 DESCRIPTION
  43
  44 This package calls through to old Changer API shell scripts using the new API.
  45 If necessary, it writes temporary configurations under C<$AMANDA_TMPDIR> and
  46 invokes the changer there, allowing multiple distinct changers to run within
  47 the same Amanda process.
  48
  49 See the amanda-changers(7) manpage for usage information.
  50
  51 =head2 NOTE
  52
  53 In-process reservations are handled correctly - only one device may be used at
  54 a time.  However, the underlying scripts do not support reservations, so
  55 another application can easily run the script and change the current device.
  56 Caveat emptor.
  57
  58 =cut
  59
  60 # TODO
  61 # Clean out old changer temporary directories on object destruction.
  62
  63 sub new {
  64     my $class = shift;
  65     my ($config, $tpchanger) = @_;
  66     my ($script) = ($tpchanger =~ /chg-compat:(.*)/);
  67
  68     unless (-e $script) {
  69         $script = "$amlibexecdir/$script";
  70     }
  71
  72     if (! -x $script) {
  73         return Amanda::Changer->make_error("fatal", undef,
  74             message => "'$script' is not executable");
  75     }
  76
  77     my $self = {
  78         script => $script,
  79         config => $config,
  80         reserved => 0,
  81         nslots => undef,
  82         backwards => undef,
  83         searchable => undef,
  84         lock => [],
  85         got_info => 0,
  86         info_lock => [],
  87     };
  88     bless ($self, $class);
  89
  90     $self->_make_cfg_dir($config);
  91
  92     debug("$class initialized with script $script, temporary directory $self->{cfg_dir}");
  93
  94     return $self;
  95 }
  96
  97 sub load {
  98     my $self = shift;
  99     my %params = @_;
 100
 101     $self->validate_params('load', \%params);
 102     return if $self->check_error($params{'res_cb'});
 103
 104     if ($self->{'reserved'}) {
 105         return $self->make_error("failed", $params{'res_cb'},
 106             reason => "driveinuse",
 107             message => "Changer is already reserved: '" . $self->{'reserved'}->device_name . "'");
 108     }
 109
 110     my $steps = define_steps
 111         cb_ref => \$params{'res_cb'};
 112
 113     # make sure the info is loaded, and re-call load() if we have to wait
 114     step get_info => sub {
 115         $self->_get_info($steps->{'got_info'});
 116     };
 117
 118     step got_info => sub {
 119         my ($exitval, $message) = @_;
 120         if (defined $exitval) { # error
 121             # this is always fatal - we can't load without info
 122             return $self->make_error("fatal", $params{'res_cb'},
 123                 message => $message);
 124         }
 125
 126         $steps->{'start_load'}->();
 127     };
 128
 129     step start_load => sub {
 130         if (exists $params{'label'}) {
 131             if ($self->{'searchable'}) {
 132                 $self->_run_tpchanger($steps->{'load_run_done'}, "-search", $params{'label'});
 133             } else {
 134                 # not searchable -- run a manual scan
 135                 $self->_manual_scan(%params);
 136             }
 137         } elsif (exists $params{'relative_slot'}) {
 138             # if there is an explicit $slot, then just hope it's the same as the current
 139             # slot, or we're in trouble.  We don't know what the current slot is, so we
 140             # can't verify, but the current slot is set on *every* load, so this works.
 141
 142             # if we've already seen nslots slots, then the next slot is
 143             # certainly one of them, so the iteration should terminate.
 144             # However, not all changers will return nslots distinct slots
 145             # (chg-zd-mtx skips empty slots, for example), so we will need to
 146             # protect against except_slots in other ways, too.
 147             if (exists $params{'except_slots'} and (keys %{$params{'except_slots'}}) == $self->{'nslots'}) {
 148                 return $self->make_error("failed", $params{'res_cb'},
 149                     reason => 'notfound',
 150                     message => "all slots have been loaded");
 151             }
 152
 153             $self->_run_tpchanger($steps->{'load_run_done'}, "-slot", $params{'relative_slot'});
 154         } elsif (exists $params{'slot'}) {
 155             $self->_run_tpchanger($steps->{'load_run_done'}, "-slot", $params{'slot'});
 156         }
 157     };
 158
 159     step load_run_done => sub {
 160         my ($exitval, $slot, $rest) = @_;
 161         if ($exitval == 0) {
 162             if (!$rest) {
 163                 return $self->make_error("fatal", $params{'res_cb'},
 164                     message => "changer script did not provide a device name");
 165             }
 166         } elsif ($exitval >= 2) {
 167                 return $self->make_error("fatal", $params{'res_cb'},
 168                     message => $rest);
 169         } else {
 170             return $self->make_error("failed", $params{'res_cb'},
 171                 reason => "notfound",
 172                 message => $rest);
 173         }
 174
 175         # re-check except_slots, and return 'notfound' if we've loaded a
 176         # forbidden slot.  This will generally happen when scanning, and when
 177         # the underlying changer script has "skipped" some slots and looped
 178         # around earlier than we expected.
 179         if (exists $params{'except_slots'} and exists $params{'except_slots'}{$slot}) {
 180             return $self->make_error("failed", $params{'res_cb'},
 181                 reason => 'notfound',
 182                 message => "all slots have been loaded");
 183         }
 184
 185         return $self->_make_res($params{'res_cb'}, $slot, $rest, undef);
 186     };
 187 }
 188
 189 sub _manual_scan {
 190     my $self = shift;
 191     my %params = @_;
 192     my $nchecked = 0;
 193     my ($get_info, $got_info, $run_cb, $load_next);
 194     my $first_scanned_slot = -1;
 195
 196     my $user_msg_fn = $params{'user_msg_fn'};
 197     $user_msg_fn ||= sub { Amanda::Debug::info("chg-compat: " . $_[0]); };
 198
 199     # search manually, starting with "current" and proceeding through nslots-1
 200     # loads of "next".  This doesn't use the except_slots iteration mechanism as
 201     # that would just add extra layers of complexity with no benefit
 202
 203     $get_info = sub {
 204         $self->_get_info($got_info);
 205     };
 206
 207     $got_info = sub {
 208         $user_msg_fn->("beginning manual scan of $self->{nslots} slots");
 209         $self->_run_tpchanger($run_cb, "-slot", "current");
 210     };
 211     $run_cb = sub {
 212         my ($exitval, $slot, $rest) = @_;
 213
 214         if ($slot == $first_scanned_slot) {
 215             $nchecked = $self->{'nslots'};
 216             return $load_next->();
 217         }
 218
 219         $first_scanned_slot = $slot if $first_scanned_slot == -1;
 220
 221         $user_msg_fn->("updated slot $slot");
 222         if ($exitval == 0) {
 223             # if we're looking for a label, check what we got
 224             if (defined $params{'label'}) {
 225                 my $device = Amanda::Device->new($rest);
 226                 if ($device and $device->configure(1)
 227                             and $device->read_label() == $DEVICE_STATUS_SUCCESS
 228                             and $device->volume_label() eq $params{'label'}) {
 229                     # we found the correct slot
 230                     $self->_make_res($params{'res_cb'}, $slot, $rest, $device);
 231                     return;
 232                 }
 233             }
 234
 235             return $load_next->();
 236         } else {
 237             # don't continue scanning after a fatal error
 238             if ($exitval >= 2) {
 239                 return $self->make_error("fatal", $params{'res_cb'},
 240                     message => $rest);
 241             }
 242
 243             return $load_next->();
 244         }
 245     };
 246
 247     $load_next = sub {
 248         # if we've scanned all nslots, we haven't found the label.
 249         if (++$nchecked >= $self->{'nslots'}) {
 250             if (defined $params{'label'}) {
 251                 return $self->make_error("failed", $params{'res_cb'},
 252                     reason => "notfound",
 253                     message => "Volume '$params{label}' not found");
 254             } else {
 255                 return $params{'res_cb'}->(undef, undef);
 256             }
 257         }
 258
 259         $self->_run_tpchanger($run_cb, "-slot", "next");
 260     };
 261
 262     $get_info->();
 263 }
 264
 265 # takes $res_cb, $slot and $rest; creates and configures the device, and calls
 266 # $res_cb with the results.
 267 sub _make_res {
 268     my $self = shift;
 269     my ($res_cb, $slot, $rest, $device) = @_;
 270     my $res;
 271
 272     if (!defined $device) {
 273         $device = Amanda::Device->new($rest);
 274         if ($device->status != $DEVICE_STATUS_SUCCESS) {
 275             return $self->make_error("failed", $res_cb,
 276                     reason => "device",
 277                     message => "opening '$rest': " . $device->error_or_status());
 278         }
 279     }
 280
 281     if (my $err = $self->{'config'}->configure_device($device)) {
 282         return $self->make_error("failed", $res_cb,
 283                 reason => "device",
 284                 message => $err);
 285     }
 286
 287     $res = Amanda::Changer::compat::Reservation->new($self, $slot, $device);
 288     $device->read_label();
 289
 290     $res_cb->(undef, $res);
 291 }
 292
 293 sub info_setup {
 294     my $self = shift;
 295     my %params = @_;
 296
 297     $self->_get_info(sub {
 298         my ($exitval, $message) = @_;
 299         if (defined $exitval) { # error
 300             if ($exitval >= 2) {
 301                 return $self->make_error("fatal", $params{'finished_cb'},
 302                     message => $message);
 303             } else {
 304                 return $self->make_error("failed", $params{'finished_cb'},
 305                     reason => "notfound",
 306                     message => $message);
 307             }
 308         }
 309
 310         # no error, so we're done with setup
 311         $params{'finished_cb'}->();
 312     });
 313 }
 314
 315 sub info_key {
 316     my $self = shift;
 317     my ($key, %params) = @_;
 318     my %results;
 319
 320     if ($key eq 'num_slots') {
 321         $results{$key} = $self->{'nslots'};
 322     } elsif ($key eq 'fast_search') {
 323         $results{$key} = $self->{'searchable'};
 324     }
 325
 326     $params{'info_cb'}->(undef, %results) if $params{'info_cb'};
 327 }
 328
 329 # run a simple op -- no arguments, no slot returned
 330 sub _simple_op {
 331     my $self = shift;
 332     my $op = shift;
 333     my %params = @_;
 334
 335     my $run_cb = sub {
 336         my ($exitval, $slot, $rest) = @_;
 337         if ($exitval == 0) {
 338             if (exists $params{'finished_cb'}) {
 339                 $params{'finished_cb'}->(undef);
 340             }
 341         } else {
 342             if ($exitval >= 2) {
 343                 return $self->make_error("fatal", $params{'finished_cb'},
 344                     message => $rest);
 345             } else {
 346                 return $self->make_error("failed", $params{'finished_cb'},
 347                     reason => "unknown",
 348                     message => $rest);
 349             }
 350         }
 351     };
 352     $self->_run_tpchanger($run_cb, "-$op");
 353 }
 354
 355 sub reset {
 356     my $self = shift;
 357     my %params = @_;
 358
 359     $self->_simple_op("reset", %params);
 360 }
 361
 362 sub clean {
 363     my $self = shift;
 364     my %params = @_;
 365
 366     # note: parameter 'drive' is ignored
 367     $self->_simple_op("clean", %params);
 368 }
 369
 370 sub eject {
 371     my $self = shift;
 372     my %params = @_;
 373
 374     # note: parameter 'drive' is ignored
 375     $self->_simple_op("eject", %params);
 376 }
 377
 378 sub update {
 379     my $self = shift;
 380     my %params = @_;
 381
 382     if ($params{'changed'}) {
 383         return $self->make_error("failed", $params{'finished_cb'},
 384             reason => 'invalid',
 385             message => 'chg-compat does not support specifying what has changed');
 386     }
 387
 388     my $scan_done_cb = make_cb(scan_done_cb => sub {
 389         my ($err, $res) = @_;
 390         if ($err) {
 391             return $params{'finished_cb'}->($err);
 392         }
 393
 394         # we didn't search for a label, so we don't get a reservation
 395         $params{'finished_cb'}->(undef);
 396     });
 397
 398     # for compat changers, "update" just entails scanning the whole changer
 399     $self->_manual_scan(
 400         res_cb => $scan_done_cb,
 401         label => undef, # search forever
 402         user_msg_fn => $params{'user_msg_fn'},
 403     );
 404 }
 405
 406 # Internal function to call the script's -info and store the results in $self.
 407 # If this returns true, then the info is loaded; otherwise, got_info_cb will be
 408 # called either with no arguments (success) or ($exitval, $message) on error.
 409 sub _get_info {
 410     my ($self, $got_info_cb) = @_;
 411
 412     Amanda::MainLoop::synchronized($self->{'info_lock'}, $got_info_cb, sub {
 413         my ($got_info_cb) = @_;
 414
 415         # if we've already got info, just call back right away
 416         if ($self->{'got_info'}) {
 417             return $got_info_cb->();
 418         }
 419
 420         my $run_cb = sub {
 421             my ($exitval, $slot, $rest) = @_;
 422             if ($exitval == 0) {
 423                 # old, unsearchable changers don't return the third result, so it's
 424                 # optional in the regex
 425                 unless ($rest =~ /(\d+) (\d+) ?(\d+)?/) {
 426                     return $got_info_cb->(2,
 427                             "Malformed response from changer -info: $rest");
 428                 }
 429
 430                 $self->{'nslots'} = $1;
 431                 $self->{'backward'} = $2;
 432                 $self->{'searchable'} = $3? 1:0;
 433
 434                 $self->{'got_info'} = 1;
 435                 return $got_info_cb->(undef, undef);
 436             } else {
 437                 return $got_info_cb->($exitval, $rest);
 438             }
 439         };
 440
 441         $self->_run_tpchanger($run_cb, "-info");
 442     });
 443 }
 444
 445 # Internal function to create a temporary configuration directory, which persists
 446 # for the duration of this changer's lifetime (and beyond, TODO)
 447 sub _make_cfg_dir {
 448     my ($self, $config) = @_;
 449
 450     if ($config->{'is_global'}) {
 451         # for the default changer, we don't need to invent a config..
 452         $self->{'cfg_dir'} = Amanda::Config::get_config_dir();
 453     } else {
 454         my $cfg_name = Amanda::Config::get_config_name();
 455         my $changer_name = $config->{'name'};
 456         my $tapedev = $config->{'tapedev'};
 457         my $tpchanger = $config->{'tpchanger'};
 458         my $changerdev = $config->{'changerdev'};
 459         my $changerfile = $config->{'changerfile'};
 460
 461         my $cfg_dir = "$AMANDA_TMPDIR/Amanda::Changer::compat/$cfg_name-$changer_name";
 462
 463         if (-d $cfg_dir) {
 464             rmtree($cfg_dir)
 465                 or die("Could not delete '$cfg_dir'");
 466         }
 467
 468         mkpath($cfg_dir)
 469             or die("Could not create '$cfg_dir'");
 470
 471         # Write an amanda.conf
 472         open(my $amconf, ">", "$cfg_dir/amanda.conf")
 473             or die ("Could not write '$cfg_dir/amanda.conf'");
 474
 475         print $amconf "# automatically generated by Amanda::Changer::compat\n";
 476         print $amconf 'org "', getconf($CNF_ORG), "\"\n"
 477             if getconf_seen($CNF_ORG);
 478         print $amconf 'mailto "', getconf($CNF_MAILTO), "\"\n"
 479             if getconf_seen($CNF_MAILTO);
 480         print $amconf 'mailer "', getconf($CNF_MAILER), "\"\n"
 481             if getconf_seen($CNF_MAILER);
 482         print $amconf "tapedev \"$tapedev\"\n"
 483             if defined($tapedev);
 484         print $amconf "tpchanger \"$tpchanger\"\n"
 485             if defined($tpchanger);
 486         print $amconf "changerdev \"$changerdev\"\n"
 487             if defined($changerdev);
 488         print $amconf "changerfile \"",
 489                 Amanda::Config::config_dir_relative($changerfile),
 490                 "\"\n"
 491             if defined($changerfile);
 492
 493         # TODO: device_property, tapetype, and the tapetype def
 494
 495         close $amconf;
 496
 497         $self->{'cfg_dir'} = $cfg_dir;
 498     }
 499
 500 }
 501
 502 # Internal-use function to actually invoke a changer script and parse
 503 # its output.
 504 #
 505 # @param $run_cb: called with ($exitval, $slot, $rest)
 506 # @params @args: command-line arguments to follow the name of the changer
 507 sub _run_tpchanger {
 508     my ($self, $run_cb, @args) = @_;
 509
 510     Amanda::MainLoop::synchronized($self->{'lock'}, $run_cb, sub {
 511         my ($run_cb) = @_;
 512         debug("Amanda::Changer::compat: invoking $self->{script} with " . join(" ", @args));
 513
 514         my ($readfd, $writefd) = POSIX::pipe();
 515         if (!defined($writefd)) {
 516             croak("Error creating pipe to run changer script: $!");
 517         }
 518
 519         my $pid = fork();
 520         if (!defined($pid) or $pid < 0) {
 521             croak("Can't fork to run changer script: $!");
 522         }
 523
 524         if (!$pid) {
 525             ## child
 526
 527             # get our file-handle house in order
 528             POSIX::close($readfd);
 529             POSIX::dup2($writefd, 1);
 530             POSIX::close($writefd);
 531
 532             # cd into the config dir
 533             if (!chdir($self->{'cfg_dir'})) {
 534                 print "<error> Could not chdir to '" . $self->{cfg_dir} . "'\n";
 535                 exit(2);
 536             }
 537
 538             %ENV = Amanda::Util::safe_env();
 539
 540             my $script = $self->{'script'};
 541             { exec { $script } $script, @args; } # braces protect against warning
 542
 543             my $err = "<error> Could not exec $script: $!\n";
 544             POSIX::write($writefd, $err, length($err));
 545             exit 2;
 546         }
 547
 548         ## parent
 549
 550         # clean up file descriptors from the fork
 551         POSIX::close($writefd);
 552
 553         # the callbacks that follow share these lexical variables
 554         my $child_eof = 0;
 555         my $child_output = '';
 556         my $child_dead = 0;
 557         my $child_exit_status = 0;
 558         my ($fdsrc, $cwsrc);
 559         my ($maybe_finished, $fd_source_cb, $child_watch_source_cb);
 560
 561         # Perl note: we have to use anonymous subs here, as they are instantiated
 562         # at runtime, rather than at compile time.
 563
 564         $maybe_finished = sub {
 565             return unless $child_eof;
 566             return unless $child_dead;
 567
 568             # everything is finished -- process the results and invoke the callback
 569             chomp $child_output;
 570
 571             # handle unexpected exit status as a fatal error
 572             if (!POSIX::WIFEXITED($child_exit_status) || POSIX::WEXITSTATUS($child_exit_status) > 2) {
 573                 $run_cb->(POSIX::WEXITSTATUS($child_exit_status), undef,
 574                     "Fatal error from changer script: ".$child_output);
 575                 return;
 576             }
 577
 578             # parse the child's output
 579             my @child_output = split '\n', $child_output;
 580             my $exitval = POSIX::WEXITSTATUS($child_exit_status);
 581
 582             debug("Amanda::Changer::compat: Got response '$child_output' with exit status $exitval");
 583             if (@child_output < 1) {
 584                 $run_cb->(2, undef, "Malformed output from changer script -- no output");
 585                 return;
 586             }
 587             my $slotline = shift @child_output;
 588             if ($slotline !~ /\s*([^\s]+)(?:\s+(.+))?/) {
 589                 $run_cb->(2, undef, "Malformed output from changer script: '$slotline'");
 590                 return;
 591             }
 592             my ($slot, $rest) = ($1, $2);
 593
 594             # append any additional lines to $rest
 595             if (@child_output) {
 596                 $rest .= "\n" . join("\n", @child_output);
 597             }
 598
 599             # let the callback take care of any further interpretation
 600             $run_cb->($exitval, $slot, $rest);
 601         };
 602
 603         $fd_source_cb = sub {
 604             my ($fdsrc) = @_;
 605             my ($len, $bytes);
 606             $len = POSIX::read($readfd, $bytes, 1024);
 607
 608             # if we got an EOF, shut things down.
 609             if ($len == 0) {
 610                 $child_eof = 1;
 611                 POSIX::close($readfd);
 612                 $fdsrc->remove();
 613                 $fdsrc = undef; # break a reference loop
 614                 $maybe_finished->();
 615             } else {
 616                 # otherwise, just keep the bytes
 617                 $child_output .= $bytes;
 618             }
 619         };
 620         $fdsrc = Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP);
 621         $fdsrc->set_callback($fd_source_cb);
 622
 623         $child_watch_source_cb = sub {
 624             my ($cwsrc, $got_pid, $got_status) = @_;
 625             $cwsrc->remove();
 626             $cwsrc = undef; # break a reference loop
 627             $child_dead = 1;
 628             $child_exit_status = $got_status;
 629
 630             $maybe_finished->();
 631         };
 632         $cwsrc = Amanda::MainLoop::child_watch_source($pid);
 633         $cwsrc->set_callback($child_watch_source_cb);
 634     });
 635 }
 636
 637 package Amanda::Changer::compat::Reservation;
 638 use vars qw( @ISA );
 639 use Amanda::Debug qw( debug );
 640 @ISA = qw( Amanda::Changer::Reservation );
 641
 642 sub new {
 643     my $class = shift;
 644     my ($chg, $slot, $device) = @_;
 645     my $self = Amanda::Changer::Reservation::new($class);
 646
 647     $self->{'chg'} = $chg;
 648
 649     $self->{'device'} = $device;
 650     $self->{'this_slot'} = $slot;
 651
 652     # mark the changer as reserved
 653     $self->{'chg'}->{'reserved'} = $device;
 654
 655     return $self;
 656 }
 657
 658 sub do_release {
 659     my $self = shift;
 660     my %params = @_;
 661
 662     my $finished = sub {
 663         my ($message) = @_;
 664
 665         $self->{'chg'}->{'reserved'} = 0;
 666
 667         # unref the device, for good measure
 668         $self->{'device'} = undef;
 669
 670         $params{'finished_cb'}->($message) if $params{'finished_cb'};
 671     };
 672
 673     if (exists $params{'eject'} && $params{'eject'}) {
 674         $self->{'chg'}->eject(finished_cb => $finished);
 675     } else {
 676         $finished->(undef);
 677     }
 678 }
 679
 680 sub set_label {
 681     my $self = shift;
 682     my %params = @_;
 683
 684     # non-searchable changers don't get -label, except that chg-zd-mtx needs
 685     # it to maintain its slotinfofile (this is a hack)
 686     if (!$self->{'chg'}->{'searchable'}
 687         && $self->{'chg'}->{'script'} !~ /chg-zd-mtx$/) {
 688         debug("Amanda::Changer::compat - changer script is not searchable, so not invoking -label for set_label");
 689         $params{'finished_cb'}->(undef) if $params{'finished_cb'};
 690         return;
 691     }
 692
 693     if (!defined $params{'label'}) {
 694         $params{'finished_cb'}->(undef) if $params{'finished_cb'};
 695         return;
 696     }
 697
 698     my $run_cb = sub {
 699         my ($exitval, $slot, $rest) = @_;
 700         if ($exitval == 0) {
 701             $params{'finished_cb'}->(undef) if $params{'finished_cb'};
 702         } else {
 703             if ($exitval >= 2) {
 704                 return $self->{'chg'}->make_error("fatal", $params{'finished_cb'},
 705                     message => $rest);
 706             } else {
 707                 return $self->{'chg'}->make_error("failed", $params{'finished_cb'},
 708                     reason => "unknown",
 709                     message => $rest);
 710             }
 711         }
 712     };
 713     $self->{'chg'}->_run_tpchanger(
 714         $run_cb, "-label", $params{'label'});
 715 }
 716
 717 1;