src/PVE/HA/Sim/Hardware.pm

   1 package PVE::HA::Sim::Hardware;
   2
   3 # Simulate Hardware resources
   4
   5 # power supply for nodes: on/off
   6 # network connection to nodes: on/off
   7 # watchdog devices for nodes
   8
   9 use strict;
  10 use warnings;
  11 use POSIX qw(strftime EINTR);
  12 use JSON;
  13 use IO::File;
  14 use Fcntl qw(:DEFAULT :flock);
  15 use File::Copy;
  16 use File::Path qw(make_path remove_tree);
  17 use PVE::HA::FenceConfig;
  18 use PVE::HA::Groups;
  19
  20 my $watchdog_timeout = 60;
  21
  22
  23 # Status directory layout
  24 #
  25 # configuration
  26 #
  27 # $testdir/cmdlist                    Command list for simulation
  28 # $testdir/hardware_status            Hardware description (number of nodes, ...)
  29 # $testdir/manager_status             CRM status (start with {})
  30 # $testdir/service_config             Service configuration
  31 # $testdir/groups                     HA groups configuration
  32 # $testdir/service_status_<node>      Service status
  33
  34 #
  35 # runtime status for simulation system
  36 #
  37 # $testdir/status/cluster_locks        Cluster locks
  38 # $testdir/status/hardware_status      Hardware status (power/network on/off)
  39 # $testdir/status/watchdog_status      Watchdog status
  40 #
  41 # runtime status
  42 #
  43 # $testdir/status/lrm_status_<node>           LRM status
  44 # $testdir/status/manager_status              CRM status
  45 # $testdir/status/crm_commands                CRM command queue
  46 # $testdir/status/service_config              Service configuration
  47 # $testdir/status/service_status_<node>       Service status
  48 # $testdir/status/groups                      HA groups configuration
  49
  50 sub read_lrm_status {
  51     my ($self, $node) = @_;
  52
  53     my $filename = "$self->{statusdir}/lrm_status_$node";
  54
  55     return PVE::HA::Tools::read_json_from_file($filename, {});
  56 }
  57
  58 sub write_lrm_status {
  59     my ($self, $node, $status_obj) = @_;
  60
  61     my $filename = "$self->{statusdir}/lrm_status_$node";
  62
  63     PVE::HA::Tools::write_json_to_file($filename, $status_obj);
  64 }
  65
  66 sub read_hardware_status_nolock {
  67     my ($self) = @_;
  68
  69     my $filename = "$self->{statusdir}/hardware_status";
  70
  71     my $raw = PVE::Tools::file_get_contents($filename);
  72     my $cstatus = decode_json($raw);
  73
  74     return $cstatus;
  75 }
  76
  77 sub write_hardware_status_nolock {
  78     my ($self, $cstatus) = @_;
  79
  80     my $filename = "$self->{statusdir}/hardware_status";
  81
  82     PVE::Tools::file_set_contents($filename, encode_json($cstatus));
  83 };
  84
  85 sub read_service_config {
  86     my ($self) = @_;
  87
  88     my $filename = "$self->{statusdir}/service_config";
  89     my $conf = PVE::HA::Tools::read_json_from_file($filename);
  90
  91     foreach my $sid (keys %$conf) {
  92         my $d = $conf->{$sid};
  93
  94         die "service '$sid' without assigned node!" if !$d->{node};
  95
  96         if ($sid =~ m/^(vm|ct|fa):(\d+)$/) {
  97             $d->{type} = $1;
  98             $d->{name} = $2;
  99         } else {
 100             die "implement me";
 101         }
 102         $d->{state} = 'disabled' if !$d->{state};
 103         $d->{state} = 'started' if $d->{state} eq 'enabled'; # backward compatibility
 104         $d->{max_restart} = 1 if !defined($d->{max_restart});
 105         $d->{max_relocate} = 1 if !defined($d->{max_relocate});
 106     }
 107
 108     return $conf;
 109 }
 110
 111 sub write_service_config {
 112     my ($self, $conf) = @_;
 113
 114     $self->{service_config} = $conf;
 115
 116     my $filename = "$self->{statusdir}/service_config";
 117     return PVE::HA::Tools::write_json_to_file($filename, $conf);
 118 }
 119
 120 sub read_fence_config {
 121     my ($self) = @_;
 122
 123     my $raw = undef;
 124
 125     my $filename = "$self->{statusdir}/fence.cfg";
 126     if (-e $filename) {
 127         $raw = PVE::Tools::file_get_contents($filename);
 128     }
 129
 130     return PVE::HA::FenceConfig::parse_config($filename, $raw);
 131 }
 132
 133 sub exec_fence_agent {
 134     my ($self, $agent, $node, @param) = @_;
 135
 136     # let all agent succeed and behave the same for now
 137     $self->sim_hardware_cmd("power $node off", $agent);
 138
 139     return 0; # EXIT_SUCCESS
 140 }
 141
 142 sub set_service_state {
 143     my ($self, $sid, $state) = @_;
 144
 145     my $conf = $self->read_service_config();
 146     die "no such service '$sid'" if !$conf->{$sid};
 147
 148     $conf->{$sid}->{state} = $state;
 149
 150     $self->write_service_config($conf);
 151
 152     return $conf;
 153 }
 154
 155 sub add_service {
 156     my ($self, $sid, $opts) = @_;
 157
 158     my $conf = $self->read_service_config();
 159     die "resource ID '$sid' already defined\n" if $conf->{$sid};
 160
 161     $conf->{$sid} = $opts;
 162
 163     $self->write_service_config($conf);
 164
 165     return $conf;
 166 }
 167
 168 sub delete_service {
 169     my ($self, $sid) = @_;
 170
 171     my $conf = $self->read_service_config();
 172
 173     die "no such service '$sid'" if !$conf->{$sid};
 174
 175     delete $conf->{$sid};
 176
 177     $self->write_service_config($conf);
 178
 179     return $conf;
 180 }
 181
 182 sub change_service_location {
 183     my ($self, $sid, $current_node, $new_node) = @_;
 184
 185     my $conf = $self->read_service_config();
 186
 187     die "no such service '$sid'\n" if !$conf->{$sid};
 188
 189     die "current_node for '$sid' does not match ($current_node != $conf->{$sid}->{node})\n"
 190         if $current_node ne $conf->{$sid}->{node};
 191
 192     $conf->{$sid}->{node} = $new_node;
 193
 194     $self->write_service_config($conf);
 195 }
 196
 197 sub service_has_lock {
 198     my ($self, $sid) = @_;
 199
 200     my $conf = $self->read_service_config();
 201
 202     die "no such service '$sid'\n" if !$conf->{$sid};
 203
 204     return $conf->{$sid}->{lock};
 205 }
 206
 207 sub lock_service {
 208     my ($self, $sid, $lock) = @_;
 209
 210     my $conf = $self->read_service_config();
 211
 212     die "no such service '$sid'\n" if !$conf->{$sid};
 213
 214     $conf->{$sid}->{lock} = $lock || 'backup';
 215
 216     $self->write_service_config($conf);
 217
 218     return $conf;
 219 }
 220
 221 sub unlock_service {
 222     my ($self, $sid, $lock) = @_;
 223
 224     my $conf = $self->read_service_config();
 225
 226     die "no such service '$sid'\n" if !$conf->{$sid};
 227
 228     if (!defined($conf->{$sid}->{lock})) {
 229         return undef;
 230     }
 231
 232     if (defined($lock) && $conf->{$sid}->{lock} ne $lock) {
 233         warn "found lock '$conf->{$sid}->{lock}' trying to remove '$lock' lock\n";
 234         return undef;
 235     }
 236
 237     my $removed_lock = delete $conf->{$sid}->{lock};
 238
 239     $self->write_service_config($conf);
 240
 241     return $removed_lock;
 242 }
 243
 244 sub queue_crm_commands_nolock {
 245     my ($self, $cmd) = @_;
 246
 247     chomp $cmd;
 248
 249     my $data = '';
 250     my $filename = "$self->{statusdir}/crm_commands";
 251     if (-f $filename) {
 252         $data = PVE::Tools::file_get_contents($filename);
 253     }
 254     $data .= "$cmd\n";
 255     PVE::Tools::file_set_contents($filename, $data);
 256
 257     return undef;
 258 }
 259
 260 sub queue_crm_commands {
 261     my ($self, $cmd) = @_;
 262
 263     my $code = sub { $self->queue_crm_commands_nolock($cmd); };
 264
 265     $self->global_lock($code);
 266
 267     return undef;
 268 }
 269
 270 sub read_crm_commands {
 271     my ($self) = @_;
 272
 273     my $code = sub {
 274         my $data = '';
 275
 276         my $filename = "$self->{statusdir}/crm_commands";
 277         if (-f $filename) {
 278             $data = PVE::Tools::file_get_contents($filename);
 279         }
 280         PVE::Tools::file_set_contents($filename, '');
 281
 282         return $data;
 283     };
 284
 285     return $self->global_lock($code);
 286 }
 287
 288 sub read_group_config {
 289     my ($self) = @_;
 290
 291     my $filename = "$self->{statusdir}/groups";
 292     my $raw = '';
 293     $raw = PVE::Tools::file_get_contents($filename) if -f $filename;
 294
 295     return PVE::HA::Groups->parse_config($filename, $raw);
 296 }
 297
 298 sub read_service_status {
 299     my ($self, $node) = @_;
 300
 301     my $filename = "$self->{statusdir}/service_status_$node";
 302     return PVE::HA::Tools::read_json_from_file($filename);
 303 }
 304
 305 sub write_service_status {
 306     my ($self, $node, $data) = @_;
 307
 308     my $filename = "$self->{statusdir}/service_status_$node";
 309     my $res = PVE::HA::Tools::write_json_to_file($filename, $data);
 310
 311     # fixme: add test if a service runs on two nodes!!!
 312
 313     return $res;
 314 }
 315
 316 my $default_group_config = <<__EOD;
 317 group: prefer_node1
 318     nodes node1
 319     nofailback 1
 320
 321 group: prefer_node2
 322     nodes node2
 323     nofailback 1
 324
 325 group: prefer_node3
 326     nodes node3
 327     nofailback 1
 328 __EOD
 329
 330 sub new {
 331     my ($this, $testdir) = @_;
 332
 333     die "missing testdir" if !$testdir;
 334
 335     die "testdir '$testdir' does not exist or is not a directory!\n"
 336         if !-d $testdir;
 337
 338     my $class = ref($this) || $this;
 339
 340     my $self = bless {}, $class;
 341
 342     my $statusdir = $self->{statusdir} = "$testdir/status";
 343
 344     remove_tree($statusdir);
 345     mkdir $statusdir;
 346
 347     # copy initial configuartion
 348     copy("$testdir/manager_status", "$statusdir/manager_status"); # optional
 349
 350     if (-f "$testdir/groups") {
 351         copy("$testdir/groups", "$statusdir/groups");
 352     } else {
 353         PVE::Tools::file_set_contents("$statusdir/groups", $default_group_config);
 354     }
 355
 356     if (-f "$testdir/service_config") {
 357         copy("$testdir/service_config", "$statusdir/service_config");
 358     } else {
 359         my $conf = {
 360             'vm:101' => { node => 'node1', group => 'prefer_node1' },
 361             'vm:102' => { node => 'node2', group => 'prefer_node2' },
 362             'vm:103' => { node => 'node3', group => 'prefer_node3' },
 363             'vm:104' => { node => 'node1', group => 'prefer_node1' },
 364             'vm:105' => { node => 'node2', group => 'prefer_node2' },
 365             'vm:106' => { node => 'node3', group => 'prefer_node3' },
 366         };
 367         $self->write_service_config($conf);
 368     }
 369
 370     if (-f "$testdir/hardware_status") {
 371         copy("$testdir/hardware_status", "$statusdir/hardware_status") ||
 372             die "Copy failed: $!\n";
 373     } else {
 374         my $cstatus = {
 375             node1 => { power => 'off', network => 'off' },
 376             node2 => { power => 'off', network => 'off' },
 377             node3 => { power => 'off', network => 'off' },
 378         };
 379         $self->write_hardware_status_nolock($cstatus);
 380     }
 381
 382     if (-f "$testdir/fence.cfg") {
 383         copy("$testdir/fence.cfg", "$statusdir/fence.cfg");
 384     }
 385
 386     my $cstatus = $self->read_hardware_status_nolock();
 387
 388     foreach my $node (sort keys %$cstatus) {
 389         $self->{nodes}->{$node} = {};
 390
 391         if (-f "$testdir/service_status_$node") {
 392             copy("$testdir/service_status_$node", "$statusdir/service_status_$node");
 393         } else {
 394             $self->write_service_status($node, {});
 395         }
 396     }
 397
 398     $self->{service_config} = $self->read_service_config();
 399
 400     return $self;
 401 }
 402
 403 sub get_time {
 404     my ($self) = @_;
 405
 406     die "implement in subclass";
 407 }
 408
 409 sub log {
 410     my ($self, $level, $msg, $id) = @_;
 411
 412     chomp $msg;
 413
 414     my $time = $self->get_time();
 415
 416     $id = 'hardware' if !$id;
 417
 418     printf("%-5s %5d %12s: $msg\n", $level, $time, $id);
 419 }
 420
 421 sub statusdir {
 422     my ($self, $node) = @_;
 423
 424     return $self->{statusdir};
 425 }
 426
 427 sub global_lock {
 428     my ($self, $code, @param) = @_;
 429
 430     my $lockfile = "$self->{statusdir}/hardware.lck";
 431     my $fh = IO::File->new(">>$lockfile") ||
 432         die "unable to open '$lockfile'\n";
 433
 434     my $success;
 435     for (;;) {
 436         $success = flock($fh, LOCK_EX);
 437         if ($success || ($! != EINTR)) {
 438             last;
 439         }
 440         if (!$success) {
 441             close($fh);
 442             die "can't acquire lock '$lockfile' - $!\n";
 443         }
 444     }
 445
 446     my $res;
 447
 448     eval { $res = &$code($fh, @param) };
 449     my $err = $@;
 450
 451     close($fh);
 452
 453     die $err if $err;
 454
 455     return $res;
 456 }
 457
 458 my $compute_node_info = sub {
 459     my ($self, $cstatus) = @_;
 460
 461     my $node_info = {};
 462
 463     my $node_count = 0;
 464     my $online_count = 0;
 465
 466     foreach my $node (keys %$cstatus) {
 467         my $d = $cstatus->{$node};
 468
 469         my $online = ($d->{power} eq 'on' && $d->{network} eq 'on') ? 1 : 0;
 470         $node_info->{$node}->{online} = $online;
 471
 472         $node_count++;
 473         $online_count++ if $online;
 474     }
 475
 476     my $quorate = ($online_count > int($node_count/2)) ? 1 : 0;
 477
 478     if (!$quorate) {
 479         foreach my $node (keys %$cstatus) {
 480             my $d = $cstatus->{$node};
 481             $node_info->{$node}->{online} = 0;
 482         }
 483     }
 484
 485     return ($node_info, $quorate);
 486 };
 487
 488 sub get_node_info {
 489     my ($self) = @_;
 490
 491     my $cstatus = $self->read_hardware_status_nolock();
 492     my ($node_info, $quorate) = &$compute_node_info($self, $cstatus);
 493
 494     return ($node_info, $quorate);
 495 }
 496
 497 # helper for Sim/ only
 498 sub get_cfs_state {
 499     my ($self, $node, $state) = @_;
 500
 501     # TODO: ensure nolock is OK when adding this to RTSim
 502     my $cstatus = $self->read_hardware_status_nolock();
 503     my $res = $cstatus->{$node}->{cfs}->{$state};
 504
 505     # we assume default true if not defined
 506     return !defined($res) || $res;
 507 }
 508
 509 # simulate hardware commands
 510 # power <node> <on|off>
 511 # network <node> <on|off>
 512 # cfs <node> <rw|update> <work|fail>
 513 # reboot <node>
 514 # shutdown <node>
 515 # restart-lrm <node>
 516 # service <sid> <started|disabled|stopped|ignored>
 517 # service <sid> <migrate|relocate> <target>
 518 # service <sid> lock/unlock [lockname]
 519
 520 sub sim_hardware_cmd {
 521     my ($self, $cmdstr, $logid) = @_;
 522
 523     my $code = sub {
 524         my ($lock_fh) = @_;
 525
 526         my $cstatus = $self->read_hardware_status_nolock();
 527
 528         my ($cmd, $objid, $action, $target) = split(/\s+/, $cmdstr);
 529
 530         die "sim_hardware_cmd: no node or service for command specified"
 531             if !$objid;
 532
 533         my ($node, $sid, $d);
 534
 535         if ($cmd eq 'service') {
 536             $sid = PVE::HA::Tools::pve_verify_ha_resource_id($objid);
 537         } else {
 538             $node = $objid;
 539             $d = $self->{nodes}->{$node} ||
 540                 die "sim_hardware_cmd: no such node '$node'\n";
 541         }
 542
 543         $self->log('info', "execute $cmdstr", $logid);
 544
 545         if ($cmd eq 'power') {
 546             die "sim_hardware_cmd: unknown action '$action'\n"
 547                 if $action !~ m/^(on|off)$/;
 548
 549             if ($cstatus->{$node}->{power} ne $action) {
 550                 if ($action eq 'on') {
 551
 552                     $d->{crm} = $self->crm_control('start', $d, $lock_fh) if !defined($d->{crm});
 553                     $d->{lrm} = $self->lrm_control('start', $d, $lock_fh) if !defined($d->{lrm});
 554                     $d->{lrm_restart} = undef;
 555                     $cstatus->{$node}->{cfs} = {};
 556
 557                 } else {
 558
 559                     if ($d->{crm}) {
 560                         $d->{crm_env}->log('info', "killed by poweroff");
 561                         $self->crm_control('stop', $d, $lock_fh);
 562                         $d->{crm} = undef;
 563                     }
 564                     if ($d->{lrm}) {
 565                         $d->{lrm_env}->log('info', "killed by poweroff");
 566                         $self->lrm_control('stop', $d, $lock_fh);
 567                         $d->{lrm} = undef;
 568                         $d->{lrm_restart} = undef;
 569                     }
 570
 571                     $self->watchdog_reset_nolock($node);
 572                     $self->write_service_status($node, {});
 573                 }
 574             }
 575
 576             $cstatus->{$node}->{power} = $action;
 577             $cstatus->{$node}->{network} = $action;
 578             $cstatus->{$node}->{shutdown} = undef;
 579
 580             $self->write_hardware_status_nolock($cstatus);
 581
 582         } elsif ($cmd eq 'network') {
 583             die "sim_hardware_cmd: unknown network action '$action'"
 584                 if $action !~ m/^(on|off)$/;
 585             $cstatus->{$node}->{network} = $action;
 586
 587             $self->write_hardware_status_nolock($cstatus);
 588
 589         } elsif ($cmd eq 'cfs') {
 590             die "sim_hardware_cmd: unknown cfs action '$action' for node '$node'"
 591                 if $action !~ m/^(rw|update)$/;
 592             die "sim_hardware_cmd: unknown cfs command '$target' for '$action' on node '$node'"
 593                 if $target !~ m/^(work|fail)$/;
 594
 595             $cstatus->{$node}->{cfs}->{$action} = $target eq 'work';
 596             $self->write_hardware_status_nolock($cstatus);
 597
 598         } elsif ($cmd eq 'reboot' || $cmd eq 'shutdown') {
 599             $cstatus->{$node}->{shutdown} = $cmd;
 600
 601             $self->write_hardware_status_nolock($cstatus);
 602
 603             $self->lrm_control('shutdown', $d, $lock_fh) if defined($d->{lrm});
 604         } elsif ($cmd eq 'restart-lrm') {
 605             if ($d->{lrm}) {
 606                 $d->{lrm_restart} = 1;
 607                 $self->lrm_control('shutdown', $d, $lock_fh);
 608             }
 609         } elsif ($cmd eq 'crm') {
 610
 611             if ($action eq 'stop') {
 612                 if ($d->{crm}) {
 613                     $d->{crm_stop} = 1;
 614                     $self->crm_control('shutdown', $d, $lock_fh);
 615                 }
 616             } elsif ($action eq 'start') {
 617                 $d->{crm} = $self->crm_control('start', $d, $lock_fh) if !defined($d->{crm});
 618             } else {
 619                 die "sim_hardware_cmd: unknown action '$action'";
 620             }
 621
 622         } elsif ($cmd eq 'service') {
 623             if ($action eq 'started' || $action eq 'disabled' ||
 624                 $action eq 'stopped' || $action eq 'ignored') {
 625
 626                 $self->set_service_state($sid, $action);
 627
 628             } elsif ($action eq 'migrate' || $action eq 'relocate') {
 629
 630                 die "sim_hardware_cmd: missing target node for '$action' command"
 631                     if !$target;
 632
 633                 $self->queue_crm_commands_nolock("$action $sid $target");
 634
 635             } elsif ($action eq 'add') {
 636
 637                 $self->add_service($sid, {state => 'started', node => $target});
 638
 639             } elsif ($action eq 'delete') {
 640
 641                 $self->delete_service($sid);
 642
 643             } elsif ($action eq 'lock') {
 644
 645                 $self->lock_service($sid, $target);
 646
 647             } elsif ($action eq 'unlock') {
 648
 649                 $self->unlock_service($sid, $target);
 650
 651             } else {
 652                 die "sim_hardware_cmd: unknown service action '$action' " .
 653                     "- not implemented\n"
 654             }
 655         } else {
 656             die "sim_hardware_cmd: unknown command '$cmdstr'\n";
 657         }
 658
 659         return $cstatus;
 660     };
 661
 662     return $self->global_lock($code);
 663 }
 664
 665 # for controlling the resource manager services
 666 sub crm_control {
 667     my ($self, $action, $data, $lock_fh) = @_;
 668
 669     die "implement in subclass";
 670 }
 671
 672 sub lrm_control {
 673     my ($self, $action, $data, $lock_fh) = @_;
 674
 675     die "implement in subclass";
 676 }
 677
 678 sub run {
 679     my ($self) = @_;
 680
 681     die "implement in subclass";
 682 }
 683
 684 my $modify_watchog = sub {
 685     my ($self, $code) = @_;
 686
 687     my $update_cmd = sub {
 688
 689         my $filename = "$self->{statusdir}/watchdog_status";
 690
 691         my ($res, $wdstatus);
 692
 693         if (-f $filename) {
 694             my $raw = PVE::Tools::file_get_contents($filename);
 695             $wdstatus = decode_json($raw);
 696         } else {
 697             $wdstatus = {};
 698         }
 699
 700         ($wdstatus, $res) = &$code($wdstatus);
 701
 702         PVE::Tools::file_set_contents($filename, encode_json($wdstatus));
 703
 704         return $res;
 705     };
 706
 707     return $self->global_lock($update_cmd);
 708 };
 709
 710 sub watchdog_reset_nolock {
 711     my ($self, $node) = @_;
 712
 713     my $filename = "$self->{statusdir}/watchdog_status";
 714
 715     if (-f $filename) {
 716         my $raw = PVE::Tools::file_get_contents($filename);
 717         my $wdstatus = decode_json($raw);
 718
 719         foreach my $id (keys %$wdstatus) {
 720             delete $wdstatus->{$id} if $wdstatus->{$id}->{node} eq $node;
 721         }
 722
 723         PVE::Tools::file_set_contents($filename, encode_json($wdstatus));
 724     }
 725 }
 726
 727 sub watchdog_check {
 728     my ($self, $node) = @_;
 729
 730     my $code = sub {
 731         my ($wdstatus) = @_;
 732
 733         my $res = 1;
 734
 735         foreach my $wfh (keys %$wdstatus) {
 736             my $wd = $wdstatus->{$wfh};
 737             next if $wd->{node} ne $node;
 738
 739             my $ctime = $self->get_time();
 740             my $tdiff = $ctime - $wd->{update_time};
 741
 742             if ($tdiff > $watchdog_timeout) { # expired
 743                 $res = 0;
 744                 delete $wdstatus->{$wfh};
 745             }
 746         }
 747
 748         return ($wdstatus, $res);
 749     };
 750
 751     return &$modify_watchog($self, $code);
 752 }
 753
 754 my $wdcounter = 0;
 755
 756 sub watchdog_open {
 757     my ($self, $node) = @_;
 758
 759     my $code = sub {
 760         my ($wdstatus) = @_;
 761
 762         ++$wdcounter;
 763
 764         my $id = "WD:$node:$$:$wdcounter";
 765
 766         die "internal error" if defined($wdstatus->{$id});
 767
 768         $wdstatus->{$id} = {
 769             node => $node,
 770             update_time => $self->get_time(),
 771         };
 772
 773         return ($wdstatus, $id);
 774     };
 775
 776     return &$modify_watchog($self, $code);
 777 }
 778
 779 sub watchdog_close {
 780     my ($self, $wfh) = @_;
 781
 782     my $code = sub {
 783         my ($wdstatus) = @_;
 784
 785         my $wd = $wdstatus->{$wfh};
 786         die "no such watchdog handle '$wfh'\n" if !defined($wd);
 787
 788         my $tdiff = $self->get_time() - $wd->{update_time};
 789         die "watchdog expired" if $tdiff > $watchdog_timeout;
 790
 791         delete $wdstatus->{$wfh};
 792
 793         return ($wdstatus);
 794     };
 795
 796     return &$modify_watchog($self, $code);
 797 }
 798
 799 sub watchdog_update {
 800     my ($self, $wfh) = @_;
 801
 802     my $code = sub {
 803         my ($wdstatus) = @_;
 804
 805         my $wd = $wdstatus->{$wfh};
 806
 807         die "no such watchdog handle '$wfh'\n" if !defined($wd);
 808
 809         my $ctime = $self->get_time();
 810         my $tdiff = $ctime - $wd->{update_time};
 811
 812         die "watchdog expired" if $tdiff > $watchdog_timeout;
 813
 814         $wd->{update_time} = $ctime;
 815
 816         return ($wdstatus);
 817     };
 818
 819     return &$modify_watchog($self, $code);
 820 }
 821
 822 1;