+
+# a very simply parser ...
+sub parse_corosync_conf {
+ my ($filename, $raw) = @_;
+
+ return {} if !$raw;
+
+ my $digest = Digest::SHA::sha1_hex(defined($raw) ? $raw : '');
+
+ $raw =~ s/#.*$//mg;
+ $raw =~ s/\r?\n/ /g;
+ $raw =~ s/\s+/ /g;
+ $raw =~ s/^\s+//;
+ $raw =~ s/\s*$//;
+
+ my @tokens = split(/\s/, $raw);
+
+ my $conf = { section => 'main', children => [] };
+
+ my $stack = [];
+ my $section = $conf;
+
+ while (defined(my $token = shift @tokens)) {
+ my $nexttok = $tokens[0];
+
+ if ($nexttok && ($nexttok eq '{')) {
+ shift @tokens; # skip '{'
+ my $new_section = {
+ section => $token,
+ children => [],
+ };
+ push @{$section->{children}}, $new_section;
+ push @$stack, $section;
+ $section = $new_section;
+ next;
+ }
+
+ if ($token eq '}') {
+ $section = pop @$stack;
+ die "parse error - uncexpected '}'\n" if !$section;
+ next;
+ }
+
+ my $key = $token;
+ die "missing ':' after key '$key'\n" if ! ($key =~ s/:$//);
+
+ die "parse error - no value for '$key'\n" if !defined($nexttok);
+ my $value = shift @tokens;
+
+ push @{$section->{children}}, { key => $key, value => $value };
+ }
+
+ $conf->{digest} = $digest;
+
+ return $conf;
+}
+
+my $dump_corosync_section;
+$dump_corosync_section = sub {
+ my ($section, $prefix) = @_;
+
+ my $raw = $prefix . $section->{section} . " {\n";
+
+ my @list = grep { defined($_->{key}) } @{$section->{children}};
+ foreach my $child (sort {$a->{key} cmp $b->{key}} @list) {
+ $raw .= $prefix . " $child->{key}: $child->{value}\n";
+ }
+
+ @list = grep { defined($_->{section}) } @{$section->{children}};
+ foreach my $child (sort {$a->{section} cmp $b->{section}} @list) {
+ $raw .= &$dump_corosync_section($child, "$prefix ");
+ }
+
+ $raw .= $prefix . "}\n\n";
+
+ return $raw;
+
+};
+
+sub write_corosync_conf {
+ my ($filename, $conf) = @_;
+
+ my $raw = '';
+
+ my $prefix = '';
+
+ die "no main section" if $conf->{section} ne 'main';
+
+ my @list = grep { defined($_->{key}) } @{$conf->{children}};
+ foreach my $child (sort {$a->{key} cmp $b->{key}} @list) {
+ $raw .= "$child->{key}: $child->{value}\n";
+ }
+
+ @list = grep { defined($_->{section}) } @{$conf->{children}};
+ foreach my $child (sort {$a->{section} cmp $b->{section}} @list) {
+ $raw .= &$dump_corosync_section($child, $prefix);
+ }
+
+ return $raw;
+}
+
+sub corosync_conf_version {
+ my ($conf, $noerr, $new_value) = @_;
+
+ foreach my $child (@{$conf->{children}}) {
+ next if !defined($child->{section});
+ if ($child->{section} eq 'totem') {
+ foreach my $e (@{$child->{children}}) {
+ next if !defined($e->{key});
+ if ($e->{key} eq 'config_version') {
+ if ($new_value) {
+ $e->{value} = $new_value;
+ return $new_value;
+ } elsif (my $version = int($e->{value})) {
+ return $version;
+ }
+ last;
+ }
+ }
+ }
+ }
+
+ return undef if $noerr;
+
+ die "invalid corosync config - unable to read version\n";
+}
+
+# read only - use "rename corosync.conf.new corosync.conf" to write
+PVE::Cluster::cfs_register_file('corosync.conf', \&parse_corosync_conf);
+# this is read/write
+PVE::Cluster::cfs_register_file('corosync.conf.new', \&parse_corosync_conf,
+ \&write_corosync_conf);
+
+sub check_corosync_conf_exists {
+ my ($silent) = @_;
+
+ $silent = $silent // 0;
+
+ my $exists = -f "$basedir/corosync.conf";
+
+ warn "Corosync config '$basedir/corosync.conf' does not exist - is this node part of a cluster?\n"
+ if !$silent && !$exists;
+
+ return $exists;
+}
+
+sub corosync_update_nodelist {
+ my ($conf, $nodelist) = @_;
+
+ delete $conf->{digest};
+
+ my $version = corosync_conf_version($conf);
+ corosync_conf_version($conf, undef, $version + 1);
+
+ my $children = [];
+ foreach my $v (values %$nodelist) {
+ next if !($v->{ring0_addr} || $v->{name});
+ my $kv = [];
+ foreach my $k (keys %$v) {
+ push @$kv, { key => $k, value => $v->{$k} };
+ }
+ my $ns = { section => 'node', children => $kv };
+ push @$children, $ns;
+ }
+
+ foreach my $main (@{$conf->{children}}) {
+ next if !defined($main->{section});
+ if ($main->{section} eq 'nodelist') {
+ $main->{children} = $children;
+ last;
+ }
+ }
+
+
+ cfs_write_file("corosync.conf.new", $conf);
+
+ rename("/etc/pve/corosync.conf.new", "/etc/pve/corosync.conf")
+ || die "activate corosync.conf.new failed - $!\n";
+}
+
+sub corosync_nodelist {
+ my ($conf) = @_;
+
+ my $nodelist = {};
+
+ foreach my $main (@{$conf->{children}}) {
+ next if !defined($main->{section});
+ if ($main->{section} eq 'nodelist') {
+ foreach my $ne (@{$main->{children}}) {
+ next if !defined($ne->{section}) || ($ne->{section} ne 'node');
+ my $node = { quorum_votes => 1 };
+ my $name;
+ foreach my $child (@{$ne->{children}}) {
+ next if !defined($child->{key});
+ $node->{$child->{key}} = $child->{value};
+ # use 'name' over 'ring0_addr' if set
+ if ($child->{key} eq 'name') {
+ delete $nodelist->{$name} if $name;
+ $name = $child->{value};
+ $nodelist->{$name} = $node;
+ } elsif(!$name && $child->{key} eq 'ring0_addr') {
+ $name = $child->{value};
+ $nodelist->{$name} = $node;
+ }
+ }
+ }
+ }
+ }
+
+ return $nodelist;
+}
+
+# get a hash representation of the corosync config totem section
+sub corosync_totem_config {
+ my ($conf) = @_;
+
+ my $res = {};
+
+ foreach my $main (@{$conf->{children}}) {
+ next if !defined($main->{section}) ||
+ $main->{section} ne 'totem';
+
+ foreach my $e (@{$main->{children}}) {
+
+ if ($e->{section} && $e->{section} eq 'interface') {
+ my $entry = {};
+
+ $res->{interface} = {};
+
+ foreach my $child (@{$e->{children}}) {
+ next if !defined($child->{key});
+ $entry->{$child->{key}} = $child->{value};
+ if($child->{key} eq 'ringnumber') {
+ $res->{interface}->{$child->{value}} = $entry;
+ }
+ }
+
+ } elsif ($e->{key}) {
+ $res->{$e->{key}} = $e->{value};
+ }
+ }
+ }
+
+ return $res;
+}
+
+# X509 Certificate cache helper
+
+my $cert_cache_nodes = {};
+my $cert_cache_timestamp = time();
+my $cert_cache_fingerprints = {};
+
+sub update_cert_cache {
+ my ($update_node, $clear) = @_;
+
+ syslog('info', "Clearing outdated entries from certificate cache")
+ if $clear;
+
+ $cert_cache_timestamp = time() if !defined($update_node);
+
+ my $node_list = defined($update_node) ?
+ [ $update_node ] : [ keys %$cert_cache_nodes ];
+
+ foreach my $node (@$node_list) {
+ my $clear_old = sub {
+ if (my $old_fp = $cert_cache_nodes->{$node}) {
+ # distrust old fingerprint
+ delete $cert_cache_fingerprints->{$old_fp};
+ # ensure reload on next proxied request
+ delete $cert_cache_nodes->{$node};
+ }
+ };
+
+ my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem";
+ my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem";
+
+ $cert_path = $custom_cert_path if -f $custom_cert_path;
+
+ my $cert;
+ eval {
+ my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r');
+ $cert = Net::SSLeay::PEM_read_bio_X509($bio);
+ Net::SSLeay::BIO_free($bio);
+ };
+ my $err = $@;
+ if ($err || !defined($cert)) {
+ &$clear_old() if $clear;
+ next;
+ }
+
+ my $fp;
+ eval {
+ $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
+ };
+ $err = $@;
+ if ($err || !defined($fp) || $fp eq '') {
+ &$clear_old() if $clear;
+ next;
+ }
+
+ my $old_fp = $cert_cache_nodes->{$node};
+ $cert_cache_fingerprints->{$fp} = 1;
+ $cert_cache_nodes->{$node} = $fp;
+
+ if (defined($old_fp) && $fp ne $old_fp) {
+ delete $cert_cache_fingerprints->{$old_fp};
+ }
+ }
+}
+
+# load and cache cert fingerprint once
+sub initialize_cert_cache {
+ my ($node) = @_;
+
+ update_cert_cache($node)
+ if defined($node) && !defined($cert_cache_nodes->{$node});
+}
+
+sub check_cert_fingerprint {
+ my ($cert) = @_;
+
+ # clear cache every 30 minutes at least
+ update_cert_cache(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
+
+ # get fingerprint of server certificate
+ my $fp;
+ eval {
+ $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
+ };
+ return 0 if $@ || !defined($fp) || $fp eq ''; # error
+
+ my $check = sub {
+ for my $expected (keys %$cert_cache_fingerprints) {
+ return 1 if $fp eq $expected;
+ }
+ return 0;
+ };
+
+ return 1 if &$check();
+
+ # clear cache and retry at most once every minute
+ if (time() - $cert_cache_timestamp >= 60) {
+ syslog ('info', "Could not verify remote node certificate '$fp' with list of pinned certificates, refreshing cache");
+ update_cert_cache();
+ return &$check();
+ }
+
+ return 0;
+}
+
+# bash completion helpers
+
+sub complete_next_vmid {
+
+ my $vmlist = get_vmlist() || {};
+ my $idlist = $vmlist->{ids} || {};
+
+ for (my $i = 100; $i < 10000; $i++) {
+ return [$i] if !defined($idlist->{$i});
+ }
+
+ return [];
+}
+
+sub complete_vmid {
+
+ my $vmlist = get_vmlist();
+ my $ids = $vmlist->{ids} || {};
+
+ return [ keys %$ids ];
+}
+
+sub complete_local_vmid {
+
+ my $vmlist = get_vmlist();
+ my $ids = $vmlist->{ids} || {};
+
+ my $nodename = PVE::INotify::nodename();
+
+ my $res = [];
+ foreach my $vmid (keys %$ids) {
+ my $d = $ids->{$vmid};
+ next if !$d->{node} || $d->{node} ne $nodename;
+ push @$res, $vmid;
+ }
+
+ return $res;
+}
+
+sub complete_migration_target {
+
+ my $res = [];
+
+ my $nodename = PVE::INotify::nodename();
+
+ my $nodelist = get_nodelist();
+ foreach my $node (@$nodelist) {
+ next if $node eq $nodename;
+ push @$res, $node;
+ }
+
+ return $res;
+}
+
+1;