src/PVE/HA/Sim/Env.pm

   1 package PVE::HA::Sim::Env;
   2
   3 use strict;
   4 use warnings;
   5 use POSIX qw(strftime EINTR);
   6 use Data::Dumper;
   7 use JSON;
   8 use IO::File;
   9 use Fcntl qw(:DEFAULT :flock);
  10
  11 use PVE::HA::Tools;
  12 use PVE::HA::Env;
  13 use PVE::HA::Resources;
  14 use PVE::HA::Sim::Resources::VirtVM;
  15 use PVE::HA::Sim::Resources::VirtCT;
  16
  17 PVE::HA::Sim::Resources::VirtVM->register();
  18 PVE::HA::Sim::Resources::VirtCT->register();
  19
  20 PVE::HA::Resources->init();
  21
  22 sub new {
  23     my ($this, $nodename, $hardware, $log_id) = @_;
  24
  25     die "missing nodename" if !$nodename;
  26     die "missing log_id" if !$log_id;
  27
  28     my $class = ref($this) || $this;
  29
  30     my $self = bless {}, $class;
  31
  32     $self->{statusdir} = $hardware->statusdir();
  33     $self->{nodename} = $nodename;
  34
  35     $self->{hardware} = $hardware;
  36     $self->{lock_timeout} = 120;
  37
  38     $self->{log_id} = $log_id;
  39
  40     return $self;
  41 }
  42
  43 sub nodename {
  44     my ($self) = @_;
  45
  46     return $self->{nodename};
  47 }
  48
  49 sub hardware {
  50     my ($self) = @_;
  51
  52     return $self->{hardware};
  53 }
  54
  55 sub sim_get_lock {
  56     my ($self, $lock_name, $unlock) = @_;
  57
  58     return 0 if !$self->quorate();
  59
  60     my $filename = "$self->{statusdir}/cluster_locks";
  61
  62     my $code = sub {
  63
  64         my $data = PVE::HA::Tools::read_json_from_file($filename, {});
  65
  66         my $res;
  67
  68         my $nodename = $self->nodename();
  69         my $ctime = $self->get_time();
  70
  71         if ($unlock) {
  72
  73             if (my $d = $data->{$lock_name}) {
  74                 my $tdiff = $ctime - $d->{time};
  75
  76                 if ($tdiff > $self->{lock_timeout}) {
  77                     $res = 1;
  78                 } elsif (($tdiff <= $self->{lock_timeout}) && ($d->{node} eq $nodename)) {
  79                     delete $data->{$lock_name};
  80                     $res = 1;
  81                 } else {
  82                     $res = 0;
  83                 }
  84             }
  85
  86         } else {
  87
  88             if (my $d = $data->{$lock_name}) {
  89
  90                 my $tdiff = $ctime - $d->{time};
  91
  92                 if ($tdiff <= $self->{lock_timeout}) {
  93                     if ($d->{node} eq $nodename) {
  94                         $d->{time} = $ctime;
  95                         $res = 1;
  96                     } else {
  97                         $res = 0;
  98                     }
  99                 } else {
 100                     $self->log('info', "got lock '$lock_name'");
 101                     $d->{node} = $nodename;
 102                     $d->{time} = $ctime;
 103                     $res = 1;
 104                 }
 105
 106             } else {
 107                 $data->{$lock_name} = {
 108                     time => $ctime,
 109                     node => $nodename,
 110                 };
 111                 $self->log('info', "got lock '$lock_name'");
 112                 $res = 1;
 113             }
 114         }
 115
 116         PVE::HA::Tools::write_json_to_file($filename, $data);
 117
 118         return $res;
 119     };
 120
 121     return $self->{hardware}->global_lock($code);
 122 }
 123
 124 sub read_manager_status {
 125     my ($self) = @_;
 126
 127     my $filename = "$self->{statusdir}/manager_status";
 128
 129     return PVE::HA::Tools::read_json_from_file($filename, {});
 130 }
 131
 132 sub write_manager_status {
 133     my ($self, $status_obj) = @_;
 134
 135     my $filename = "$self->{statusdir}/manager_status";
 136
 137     PVE::HA::Tools::write_json_to_file($filename, $status_obj);
 138 }
 139
 140 sub read_lrm_status {
 141     my ($self, $node) = @_;
 142
 143     $node = $self->{nodename} if !defined($node);
 144
 145     return $self->{hardware}->read_lrm_status($node);
 146 }
 147
 148 sub write_lrm_status {
 149     my ($self, $status_obj) = @_;
 150
 151     my $node = $self->{nodename};
 152
 153     return $self->{hardware}->write_lrm_status($node, $status_obj);
 154 }
 155
 156 sub is_node_shutdown {
 157     my ($self) = @_;
 158
 159     return 0; # default to freezing services if not overwritten by subclass
 160 }
 161
 162 sub service_config_exists {
 163     my ($self) = @_;
 164
 165     return 1;
 166 }
 167
 168 sub read_service_config {
 169     my ($self) = @_;
 170
 171     return $self->{hardware}->read_service_config();
 172 }
 173
 174 sub read_group_config {
 175     my ($self) = @_;
 176
 177     return $self->{hardware}->read_group_config();
 178 }
 179
 180 sub change_service_location {
 181     my ($self, $sid, $current_node, $new_node) = @_;
 182
 183     return $self->{hardware}->change_service_location($sid, $current_node, $new_node);
 184 }
 185
 186 sub queue_crm_commands {
 187     my ($self, $cmd) = @_;
 188
 189     return $self->{hardware}->queue_crm_commands($cmd);
 190 }
 191
 192 sub read_crm_commands {
 193     my ($self) = @_;
 194
 195     return $self->{hardware}->read_crm_commands();
 196 }
 197
 198 sub log {
 199     my ($self, $level, $msg) = @_;
 200
 201     chomp $msg;
 202
 203     my $time = $self->get_time();
 204
 205     printf("%-5s %5d %12s: $msg\n", $level, $time, "$self->{nodename}/$self->{log_id}");
 206 }
 207
 208 sub get_time {
 209     my ($self) = @_;
 210
 211     die "implement in subclass";
 212 }
 213
 214 sub sleep {
 215    my ($self, $delay) = @_;
 216
 217    die "implement in subclass";
 218 }
 219
 220 sub sleep_until {
 221    my ($self, $end_time) = @_;
 222
 223    die "implement in subclass";
 224 }
 225
 226 sub get_ha_manager_lock {
 227     my ($self) = @_;
 228
 229     return $self->sim_get_lock('ha_manager_lock');
 230 }
 231
 232 # release the cluster wide manager lock.
 233 # when released another CRM may step up and get the lock, thus this should only
 234 # get called when shutting down/deactivating the current master
 235 sub release_ha_manager_lock {
 236     my ($self) = @_;
 237
 238     return $self->sim_get_lock('ha_manager_lock', 1);
 239 }
 240
 241 sub get_ha_agent_lock_name {
 242     my ($self, $node) = @_;
 243
 244     $node = $self->nodename() if !$node;
 245
 246     return "ha_agent_${node}_lock";
 247 }
 248
 249 sub get_ha_agent_lock {
 250     my ($self, $node) = @_;
 251
 252     my $lck = $self->get_ha_agent_lock_name($node);
 253     return $self->sim_get_lock($lck);
 254 }
 255
 256
 257 # release the respective node agent lock.
 258 # this should only get called if the nodes LRM gracefully shuts down with
 259 # all services already cleanly stopped!
 260 sub release_ha_agent_lock {
 261     my ($self) = @_;
 262
 263     my $node = $self->nodename();
 264
 265     my $lock = $self->get_ha_agent_lock_name($node);
 266     return $self->sim_get_lock($lock, 1);
 267 }
 268
 269 # return true when cluster is quorate
 270 sub quorate {
 271     my ($self) = @_;
 272
 273     my ($node_info, $quorate) = $self->{hardware}->get_node_info();
 274     my $node = $self->nodename();
 275     return 0 if !$node_info->{$node}->{online};
 276     return $quorate;
 277 }
 278
 279 sub get_node_info {
 280     my ($self) = @_;
 281
 282     return $self->{hardware}->get_node_info();
 283 }
 284
 285 sub loop_start_hook {
 286     my ($self, $starttime) = @_;
 287
 288     # do nothing, overwrite in subclass
 289 }
 290
 291 sub loop_end_hook {
 292     my ($self) = @_;
 293
 294     # do nothing, overwrite in subclass
 295 }
 296
 297 sub watchdog_open {
 298     my ($self) = @_;
 299
 300     my $node = $self->nodename();
 301
 302     return $self->{hardware}->watchdog_open($node);
 303 }
 304
 305 sub watchdog_update {
 306     my ($self, $wfh) = @_;
 307
 308     return $self->{hardware}->watchdog_update($wfh);
 309 }
 310
 311 sub watchdog_close {
 312     my ($self, $wfh) = @_;
 313
 314     return $self->{hardware}->watchdog_close($wfh);
 315 }
 316
 317 sub can_fork {
 318     my ($self) = @_;
 319
 320     return 1;
 321 }
 322
 323 sub after_fork {
 324     my ($self) = @_;
 325
 326     # nothing to clean up in the simulation environment
 327 }
 328
 329 1;