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