[pmg-api.git] / PMG / Cluster.pm

package PMG::Cluster;

use strict;
use warnings;

use Socket;
use PVE::Tools;
use PVE::INotify;

# this is also used to get the IP of the local node
sub lookup_node_ip {
    my ($nodename, $noerr) = @_;

    my ($family, $packed_ip);

    eval {
	my @res = PVE::Tools::getaddrinfo_all($nodename);
	$family = $res[0]->{family};
	$packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
    };

    if ($@) {
	die "hostname lookup failed:\n$@" if !$noerr;
	return undef;
    }

    my $ip = Socket::inet_ntop($family, $packed_ip);
    if ($ip =~ m/^127\.|^::1$/) {
	die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
	return undef;
    }

    return wantarray ? ($ip, $family) : $ip;
}

sub remote_node_ip {
    my ($nodename, $noerr) = @_;

    my $cinfo = PVE::INotify::read_file("cluster.conf");

    foreach my $entry (@{$cinfo->{nodes}}) {
	if ($entry->{name} eq $nodename) {
	    my $ip = $entry->{ip};
	    return $ip if !wantarray;
	    my $family = PVE::Tools::get_host_address_family($ip);
	    return ($ip, $family);
	}
    }

    # fallback: try to get IP by other means
    return lookup_node_ip($nodename, $noerr);
}

# 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 ];

    my $clear_node = sub {
	my ($node) = @_;
	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 $nodename = PVE::INotify::nodename();

    foreach my $node (@$node_list) {

	if ($node ne $nodename) {
	    &$clear_node($node) if $clear;
	    next;
	}

	my $cert_path = "/etc/proxmox/pmg-api.pem";

	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_node($node) if $clear;
	    next;
	}

	my $fp;
	eval {
	    $fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
	};
	$err = $@;
	if ($err || !defined($fp) || $fp eq '') {
	    &$clear_node($node) 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;
}

sub read_cluster_conf {
    my ($filename, $fh) = @_;

    my $localname = PVE::INotify::nodename();
    my $localip = lookup_node_ip($localname);

    my $level = 0;
    my $maxcid = 0;

    my $cinfo;

    $cinfo->{nodes} = [];
    $cinfo->{remnodes} = [];

    $cinfo->{local} = {
	role => '-',
	cid => 0,
	ip => $localip,
	name => $localname,
	configport => 83,
	dbport => 5432,
    };

    # fixme: add test is local node is part of node list
    if (defined($fh)) {

	$cinfo->{exists} = 1; # cluster configuratin file exists and is readable

	while (defined(my $line = <$fh>)) {
	    chomp $line;

	    next if $line =~ m/^\s*$/; # skip empty lines

	    if ($line =~ m/^maxcid\s+(\d+)\s*$/i) {
		$maxcid = $1 > $maxcid ? $1 : $maxcid;
		next;
	    }

	    if ($line =~ m/^(master|node)\s+(\d+)\s+\{\s*$/i) {
		$level++;
		my ($t, $cid) = (lc($1), $2);

		$maxcid = $cid > $maxcid ? $cid : $maxcid;

		my $res = {
		    role => $t eq 'master' ? 'M' : 'N',
		    cid => $cid
		};

		while (defined($line = <$fh>)) {
		    chomp $line;
		    next if $line =~ m/^\s*$/; # skip empty lines
		    if ($line =~ m/^\}\s*$/) {
			$level--;
			last;
		    }

		    if ($line =~ m/^\s*(\S+)\s*:\s*(\S+)\s*$/) {
			my ($n, $v) = (lc $1, $2);

			# fixme: do syntax checks
			if ($n eq 'ip') {
			    $res->{$n} = $v;
			} elsif ($n eq 'name') {
			    $res->{$n} = $v;
			} elsif ($n eq 'hostrsapubkey') {
			    $res->{$n} = $v;
			} elsif ($n eq 'rootrsapubkey') {
			    $res->{$n} = $v;
			} else {
			    die "syntax error in configuration file\n";
			}
		    } else {
			die "syntax error in configuration file\n";
		    }
		}

		die "missing ip address for node '$cid'\n" if !$res->{ip};
		die "missing name for node '$cid'\n" if !$res->{name};
		#die "missing host RSA key for node '$cid'\n" if !$res->{hostrsapubkey};
		#die "missing user RSA key for node '$cid'\n" if !$res->{rootrsapubkey};

		push @{$cinfo->{nodes}}, $res;

		if ($res->{role} eq 'M') {
		    $cinfo->{master} = $res;
		}

		if ($res->{ip} eq $localname) {
		    $cinfo->{local} = $res;
		}
	    } else {
		die "syntax error in configuration file\n";
	    }
	}
    }

    die "syntax error in configuration file\n" if $level;

    $cinfo->{maxcid} = $maxcid;

    my @cidlist = ();
    foreach my $ni (@{$cinfo->{nodes}}) {
	next if $cinfo->{local}->{cid} == $ni->{cid}; # skip local CID
	push @cidlist, $ni->{cid};
    }

    my $ind = 0;
    my $portid = {};
    foreach my $cid (sort @cidlist) {
	$portid->{$cid} = $ind;
	$ind++;
    }

    foreach my $ni (@{$cinfo->{nodes}}) {
	# fixme: do we still need those ports?
	$ni->{configport} = $ni->{cid} == $cinfo->{local}->{cid} ? 83 : 50000 + $portid->{$ni->{cid}};
	$ni->{dbport} = $ni->{cid} == $cinfo->{local}->{cid} ? 5432 : 50100 + $portid->{$ni->{cid}};
    }

    foreach my $ni (@{$cinfo->{nodes}}) {
	next if $ni->{cid} == $cinfo->{local}->{cid};
	push @{$cinfo->{remnodes}}, $ni->{cid};
    }

    return $cinfo;
}

sub write_cluster_conf {
    my ($filename, $fh, $cinfo) = @_;

    my $raw = "maxcid $cinfo->{maxcid}\n\n";

    foreach my $ni (@{$cinfo->{nodes}}) {

	if ($ni->{role} eq 'M') {
	    $raw .= "master $ni->{cid} {\n";
	    $raw .= " IP: $ni->{ip}\n";
	    $raw .= " NAME: $ni->{name}\n";
	    $raw .= " HOSTRSAPUBKEY: $ni->{hostrsapubkey}\n";
	    $raw .= " ROOTRSAPUBKEY: $ni->{rootrsapubkey}\n";
	    $raw .= "}\n\n";
	} elsif ($ni->{role} eq 'N') {
	    $raw .= "node $ni->{cid} {\n";
	    $raw .= " IP: $ni->{ip}\n";
	    $raw .= " NAME: $ni->{name}\n";
	    $raw .= " HOSTRSAPUBKEY: $ni->{hostrsapubkey}\n";
	    $raw .= " ROOTRSAPUBKEY: $ni->{rootrsapubkey}\n";
	    $raw .= "}\n\n";
	}
    }

    PVE::Tools::safe_print($filename, $fh, $raw);
}

PVE::INotify::register_file('cluster.conf', "/etc/proxmox/cluster.conf",
			    \&read_cluster_conf,
			    \&write_cluster_conf,
			    undef,
			    always_call_parser => 1);

1;
Commit	Line	Data
0854fb22 DM	1	package PMG::Cluster;
	2
	3	use strict;
	4	use warnings;
	5
	6	use Socket;
	7	use PVE::Tools;
	8	use PVE::INotify;
	9
	10	# this is also used to get the IP of the local node
8737f93a	11	sub lookup_node_ip {
0854fb22 DM	12	my ($nodename, $noerr) = @_;
0854fb22 DM	13
0854fb22 DM	14	my ($family, $packed_ip);
	15
	16	eval {
	17	my @res = PVE::Tools::getaddrinfo_all($nodename);
	18	$family = $res[0]->{family};
	19	$packed_ip = (PVE::Tools::unpack_sockaddr_in46($res[0]->{addr}))[2];
	20	};
	21
	22	if ($@) {
	23	die "hostname lookup failed:\n$@" if !$noerr;
	24	return undef;
	25	}
	26
	27	my $ip = Socket::inet_ntop($family, $packed_ip);
	28	if ($ip =~ m/^127\.\|^::1$/) {
	29	die "hostname lookup failed - got local IP address ($nodename = $ip)\n" if !$noerr;
	30	return undef;
	31	}
	32
	33	return wantarray ? ($ip, $family) : $ip;
	34	}
	35
8737f93a DM	36	sub remote_node_ip {
	37	my ($nodename, $noerr) = @_;
	38
	39	my $cinfo = PVE::INotify::read_file("cluster.conf");
	40
	41	foreach my $entry (@{$cinfo->{nodes}}) {
	42	if ($entry->{name} eq $nodename) {
	43	my $ip = $entry->{ip};
	44	return $ip if !wantarray;
	45	my $family = PVE::Tools::get_host_address_family($ip);
	46	return ($ip, $family);
	47	}
	48	}
	49
	50	# fallback: try to get IP by other means
	51	return lookup_node_ip($nodename, $noerr);
	52	}
	53
0854fb22 DM	54	# X509 Certificate cache helper
	55
	56	my $cert_cache_nodes = {};
	57	my $cert_cache_timestamp = time();
	58	my $cert_cache_fingerprints = {};
	59
	60	sub update_cert_cache {
	61	my ($update_node, $clear) = @_;
	62
	63	syslog('info', "Clearing outdated entries from certificate cache")
	64	if $clear;
	65
	66	$cert_cache_timestamp = time() if !defined($update_node);
	67
	68	my $node_list = defined($update_node) ?
	69	[ $update_node ] : [ keys %$cert_cache_nodes ];
	70
	71	my $clear_node = sub {
	72	my ($node) = @_;
	73	if (my $old_fp = $cert_cache_nodes->{$node}) {
	74	# distrust old fingerprint
	75	delete $cert_cache_fingerprints->{$old_fp};
	76	# ensure reload on next proxied request
	77	delete $cert_cache_nodes->{$node};
	78	}
	79	};
	80
	81	my $nodename = PVE::INotify::nodename();
	82
	83	foreach my $node (@$node_list) {
	84
	85	if ($node ne $nodename) {
	86	&$clear_node($node) if $clear;
	87	next;
	88	}
	89
	90	my $cert_path = "/etc/proxmox/pmg-api.pem";
	91
	92	my $cert;
	93	eval {
	94	my $bio = Net::SSLeay::BIO_new_file($cert_path, 'r');
	95	$cert = Net::SSLeay::PEM_read_bio_X509($bio);
	96	Net::SSLeay::BIO_free($bio);
	97	};
	98	my $err = $@;
	99	if ($err \|\| !defined($cert)) {
	100	&$clear_node($node) if $clear;
	101	next;
	102	}
	103
	104	my $fp;
	105	eval {
	106	$fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
	107	};
	108	$err = $@;
	109	if ($err \|\| !defined($fp) \|\| $fp eq '') {
	110	&$clear_node($node) if $clear;
	111	next;
	112	}
	113
	114	my $old_fp = $cert_cache_nodes->{$node};
	115	$cert_cache_fingerprints->{$fp} = 1;
	116	$cert_cache_nodes->{$node} = $fp;
	117
118	if (defined($old_fp) && $fp ne $old_fp) {
119	delete $cert_cache_fingerprints->{$old_fp};
120	}
121	}
122	}
123
124	# load and cache cert fingerprint once
125	sub initialize_cert_cache {
126	my ($node) = @_;
127
128	update_cert_cache($node)
129	if defined($node) && !defined($cert_cache_nodes->{$node});
130	}
131
132	sub check_cert_fingerprint {
133	my ($cert) = @_;
134
135	# clear cache every 30 minutes at least
136	update_cert_cache(undef, 1) if time() - $cert_cache_timestamp >= 60*30;
137
138	# get fingerprint of server certificate
139	my $fp;
140	eval {
141	$fp = Net::SSLeay::X509_get_fingerprint($cert, 'sha256');
142	};
143	return 0 if $@ \|\| !defined($fp) \|\| $fp eq ''; # error
144
145	my $check = sub {
146	for my $expected (keys %$cert_cache_fingerprints) {
147	return 1 if $fp eq $expected;
148	}
149	return 0;
150	};
151
152	return 1 if &$check();
153
154	# clear cache and retry at most once every minute
155	if (time() - $cert_cache_timestamp >= 60) {
156	syslog ('info', "Could not verify remote node certificate '$fp' with list of pinned certificates, refreshing cache");
157	update_cert_cache();
158	return &$check();
159	}
160
161	return 0;
162	}
163
539271ed DM	164	sub read_cluster_conf {
	165	my ($filename, $fh) = @_;
	166
	167	my $localname = PVE::INotify::nodename();
8737f93a	168	my $localip = lookup_node_ip($localname);
539271ed DM	169
	170	my $level = 0;
	171	my $maxcid = 0;
	172
	173	my $cinfo;
	174
	175	$cinfo->{nodes} = [];
	176	$cinfo->{remnodes} = [];
	177
	178	$cinfo->{local} = {
	179	role => '-',
	180	cid => 0,
	181	ip => $localip,
	182	name => $localname,
	183	configport => 83,
	184	dbport => 5432,
	185	};
	186
8737f93a	187	# fixme: add test is local node is part of node list
539271ed DM	188	if (defined($fh)) {
	189
	190	$cinfo->{exists} = 1; # cluster configuratin file exists and is readable
	191
	192	while (defined(my $line = <$fh>)) {
	193	chomp $line;
	194
	195	next if $line =~ m/^\s*$/; # skip empty lines
	196
	197	if ($line =~ m/^maxcid\s+(\d+)\s*$/i) {
	198	$maxcid = $1 > $maxcid ? $1 : $maxcid;
	199	next;
	200	}
	201
	202	if ($line =~ m/^(master\|node)\s+(\d+)\s+\{\s*$/i) {
	203	$level++;
	204	my ($t, $cid) = (lc($1), $2);
	205
	206	$maxcid = $cid > $maxcid ? $cid : $maxcid;
	207
	208	my $res = {
	209	role => $t eq 'master' ? 'M' : 'N',
	210	cid => $cid
	211	};
	212
	213	while (defined($line = <$fh>)) {
	214	chomp $line;
	215	next if $line =~ m/^\s*$/; # skip empty lines
	216	if ($line =~ m/^\}\s*$/) {
	217	$level--;
	218	last;
	219	}
	220
	221	if ($line =~ m/^\s(\S+)\s:\s(\S+)\s$/) {
	222	my ($n, $v) = (lc $1, $2);
	223
	224	# fixme: do syntax checks
	225	if ($n eq 'ip') {
	226	$res->{$n} = $v;
	227	} elsif ($n eq 'name') {
	228	$res->{$n} = $v;
	229	} elsif ($n eq 'hostrsapubkey') {
	230	$res->{$n} = $v;
	231	} elsif ($n eq 'rootrsapubkey') {
	232	$res->{$n} = $v;
	233	} else {
	234	die "syntax error in configuration file\n";
	235	}
	236	} else {
	237	die "syntax error in configuration file\n";
	238	}
	239	}
	240
	241	die "missing ip address for node '$cid'\n" if !$res->{ip};
	242	die "missing name for node '$cid'\n" if !$res->{name};
	243	#die "missing host RSA key for node '$cid'\n" if !$res->{hostrsapubkey};
	244	#die "missing user RSA key for node '$cid'\n" if !$res->{rootrsapubkey};
	245
	246	push @{$cinfo->{nodes}}, $res;
	247
	248	if ($res->{role} eq 'M') {
	249	$cinfo->{master} = $res;
	250	}
	251
8737f93a	252	if ($res->{ip} eq $localname) {
539271ed DM	253	$cinfo->{local} = $res;
	254	}
	255	} else {
	256	die "syntax error in configuration file\n";
	257	}
	258	}
	259	}
	260
	261	die "syntax error in configuration file\n" if $level;
	262
	263	$cinfo->{maxcid} = $maxcid;
	264
	265	my @cidlist = ();
	266	foreach my $ni (@{$cinfo->{nodes}}) {
	267	next if $cinfo->{local}->{cid} == $ni->{cid}; # skip local CID
	268	push @cidlist, $ni->{cid};
	269	}
	270
	271	my $ind = 0;
	272	my $portid = {};
	273	foreach my $cid (sort @cidlist) {
	274	$portid->{$cid} = $ind;
	275	$ind++;
	276	}
	277
	278	foreach my $ni (@{$cinfo->{nodes}}) {
	279	# fixme: do we still need those ports?
	280	$ni->{configport} = $ni->{cid} == $cinfo->{local}->{cid} ? 83 : 50000 + $portid->{$ni->{cid}};
	281	$ni->{dbport} = $ni->{cid} == $cinfo->{local}->{cid} ? 5432 : 50100 + $portid->{$ni->{cid}};
	282	}
	283
	284	foreach my $ni (@{$cinfo->{nodes}}) {
	285	next if $ni->{cid} == $cinfo->{local}->{cid};
	286	push @{$cinfo->{remnodes}}, $ni->{cid};
	287	}
	288
	289	return $cinfo;
	290	}
	291
	292	sub write_cluster_conf {
	293	my ($filename, $fh, $cinfo) = @_;
	294
	295	my $raw = "maxcid $cinfo->{maxcid}\n\n";
	296
	297	foreach my $ni (@{$cinfo->{nodes}}) {
	298
	299	if ($ni->{role} eq 'M') {
	300	$raw .= "master $ni->{cid} {\n";
	301	$raw .= " IP: $ni->{ip}\n";
	302	$raw .= " NAME: $ni->{name}\n";
	303	$raw .= " HOSTRSAPUBKEY: $ni->{hostrsapubkey}\n";
	304	$raw .= " ROOTRSAPUBKEY: $ni->{rootrsapubkey}\n";
	305	$raw .= "}\n\n";
	306	} elsif ($ni->{role} eq 'N') {
	307	$raw .= "node $ni->{cid} {\n";
	308	$raw .= " IP: $ni->{ip}\n";
	309	$raw .= " NAME: $ni->{name}\n";
	310	$raw .= " HOSTRSAPUBKEY: $ni->{hostrsapubkey}\n";
	311	$raw .= " ROOTRSAPUBKEY: $ni->{rootrsapubkey}\n";
	312	$raw .= "}\n\n";
	313	}
	314	}
	315
	316	PVE::Tools::safe_print($filename, $fh, $raw);
317	}
318
319	PVE::INotify::register_file('cluster.conf', "/etc/proxmox/cluster.conf",
320	\&read_cluster_conf,
321	\&write_cluster_conf,
322	undef,
323	always_call_parser => 1);
324
0854fb22	325	1;