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