]>
Commit | Line | Data |
---|---|---|
1 | package PVE::Cluster; | |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use Encode; | |
7 | use File::stat qw(); | |
8 | use File::Path qw(make_path); | |
9 | use JSON; | |
10 | use Net::SSLeay; | |
11 | use POSIX qw(ENOENT); | |
12 | use Socket; | |
13 | use Storable qw(dclone); | |
14 | ||
15 | use PVE::Certificate; | |
16 | use PVE::INotify; | |
17 | use PVE::IPCC; | |
18 | use PVE::JSONSchema; | |
19 | use PVE::Network; | |
20 | use PVE::SafeSyslog; | |
21 | use PVE::Tools qw(run_command); | |
22 | ||
23 | use PVE::Cluster::IPCConst; | |
24 | ||
25 | use base 'Exporter'; | |
26 | ||
27 | our @EXPORT_OK = qw( | |
28 | cfs_read_file | |
29 | cfs_write_file | |
30 | cfs_register_file | |
31 | cfs_lock_file); | |
32 | ||
33 | # x509 certificate utils | |
34 | ||
35 | my $basedir = "/etc/pve"; | |
36 | my $authdir = "$basedir/priv"; | |
37 | my $lockdir = "/etc/pve/priv/lock"; | |
38 | ||
39 | # cfs and corosync files | |
40 | my $dbfile = "/var/lib/pve-cluster/config.db"; | |
41 | my $dbbackupdir = "/var/lib/pve-cluster/backup"; | |
42 | ||
43 | # this is just a readonly copy, the relevant one is in status.c from pmxcfs | |
44 | # observed files are the one we can get directly through IPCC, they are cached | |
45 | # using a computed version and only those can be used by the cfs_*_file methods | |
46 | my $observed = { | |
47 | 'vzdump.cron' => 1, | |
48 | 'vzdump.conf' => 1, | |
49 | 'jobs.cfg' => 1, | |
50 | 'storage.cfg' => 1, | |
51 | 'datacenter.cfg' => 1, | |
52 | 'replication.cfg' => 1, | |
53 | 'corosync.conf' => 1, | |
54 | 'corosync.conf.new' => 1, | |
55 | 'firewall/cluster.fw' => 1, | |
56 | 'user.cfg' => 1, | |
57 | 'domains.cfg' => 1, | |
58 | 'priv/shadow.cfg' => 1, | |
59 | 'priv/tfa.cfg' => 1, | |
60 | 'priv/token.cfg' => 1, | |
61 | 'priv/acme/plugins.cfg' => 1, | |
62 | 'priv/ipam.db' => 1, | |
63 | '/qemu-server/' => 1, | |
64 | '/openvz/' => 1, | |
65 | '/lxc/' => 1, | |
66 | 'ha/crm_commands' => 1, | |
67 | 'ha/manager_status' => 1, | |
68 | 'ha/resources.cfg' => 1, | |
69 | 'ha/groups.cfg' => 1, | |
70 | 'ha/fence.cfg' => 1, | |
71 | 'status.cfg' => 1, | |
72 | 'ceph.conf' => 1, | |
73 | 'sdn/vnets.cfg' => 1, | |
74 | 'sdn/zones.cfg' => 1, | |
75 | 'sdn/controllers.cfg' => 1, | |
76 | 'sdn/subnets.cfg' => 1, | |
77 | 'sdn/ipams.cfg' => 1, | |
78 | 'sdn/dns.cfg' => 1, | |
79 | 'sdn/.running-config' => 1, | |
80 | 'virtual-guest/cpu-models.conf' => 1, | |
81 | }; | |
82 | ||
83 | sub prepare_observed_file_basedirs { | |
84 | ||
85 | if (!check_cfs_is_mounted(1)) { | |
86 | warn "pmxcfs isn't mounted (/etc/pve), chickening out..\n"; | |
87 | return; | |
88 | } | |
89 | ||
90 | for my $f (sort keys %$observed) { | |
91 | next if $f !~ m!^(.*)/[^/]+$!; | |
92 | my $dir = "$basedir/$1"; | |
93 | next if -e $dir; # can also be a link, so just use -e xist check | |
94 | print "creating directory '$dir' for observerd files\n"; | |
95 | make_path($dir); | |
96 | } | |
97 | } | |
98 | ||
99 | sub base_dir { | |
100 | return $basedir; | |
101 | } | |
102 | ||
103 | sub auth_dir { | |
104 | return $authdir; | |
105 | } | |
106 | ||
107 | sub check_cfs_quorum { | |
108 | my ($noerr) = @_; | |
109 | ||
110 | # note: -w filename always return 1 for root, so wee need | |
111 | # to use File::lstat here | |
112 | my $st = File::stat::lstat("$basedir/local"); | |
113 | my $quorate = ($st && (($st->mode & 0200) != 0)); | |
114 | ||
115 | die "cluster not ready - no quorum?\n" if !$quorate && !$noerr; | |
116 | ||
117 | return $quorate; | |
118 | } | |
119 | ||
120 | sub check_cfs_is_mounted { | |
121 | my ($noerr) = @_; | |
122 | ||
123 | my $res = -l "$basedir/local"; | |
124 | ||
125 | die "pve configuration filesystem (pmxcfs) not mounted\n" if !$res && !$noerr; | |
126 | ||
127 | return $res; | |
128 | } | |
129 | ||
130 | my $versions = {}; | |
131 | my $vmlist = {}; | |
132 | my $clinfo = {}; | |
133 | ||
134 | my $ipcc_send_rec = sub { | |
135 | my ($msgid, $data) = @_; | |
136 | ||
137 | my $res = PVE::IPCC::ipcc_send_rec($msgid, $data); | |
138 | ||
139 | die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0); | |
140 | ||
141 | return $res; | |
142 | }; | |
143 | ||
144 | my $ipcc_send_rec_json = sub { | |
145 | my ($msgid, $data) = @_; | |
146 | ||
147 | my $res = PVE::IPCC::ipcc_send_rec($msgid, $data); | |
148 | ||
149 | die "ipcc_send_rec[$msgid] failed: $!\n" if !defined($res) && ($! != 0); | |
150 | ||
151 | return decode_json($res); | |
152 | }; | |
153 | ||
154 | my $ipcc_get_config = sub { | |
155 | my ($path) = @_; | |
156 | ||
157 | my $bindata = pack "Z*", $path; | |
158 | my $res = PVE::IPCC::ipcc_send_rec(CFS_IPC_GET_CONFIG, $bindata); | |
159 | if (!defined($res)) { | |
160 | if ($! != 0) { | |
161 | return undef if $! == ENOENT; | |
162 | die "$!\n"; | |
163 | } | |
164 | return ''; | |
165 | } | |
166 | ||
167 | return $res; | |
168 | }; | |
169 | ||
170 | my $ipcc_get_status = sub { | |
171 | my ($name, $nodename) = @_; | |
172 | ||
173 | my $bindata = pack "Z[256]Z[256]", $name, ($nodename || ""); | |
174 | return PVE::IPCC::ipcc_send_rec(CFS_IPC_GET_STATUS, $bindata); | |
175 | }; | |
176 | ||
177 | my $ipcc_remove_status = sub { | |
178 | my ($name) = @_; | |
179 | # we just omit the data payload, pmxcfs takes this as hint and removes this | |
180 | # key from the status hashtable | |
181 | my $bindata = pack "Z[256]", $name; | |
182 | return &$ipcc_send_rec(CFS_IPC_SET_STATUS, $bindata); | |
183 | }; | |
184 | ||
185 | my $ipcc_update_status = sub { | |
186 | my ($name, $data) = @_; | |
187 | ||
188 | my $raw = ref($data) ? encode_json($data) : $data; | |
189 | # update status | |
190 | my $bindata = pack "Z[256]Z*", $name, $raw; | |
191 | ||
192 | return &$ipcc_send_rec(CFS_IPC_SET_STATUS, $bindata); | |
193 | }; | |
194 | ||
195 | my $ipcc_log = sub { | |
196 | my ($priority, $ident, $tag, $msg) = @_; | |
197 | ||
198 | my $bindata = pack "CCCZ*Z*Z*", $priority, bytes::length($ident) + 1, | |
199 | bytes::length($tag) + 1, $ident, $tag, $msg; | |
200 | ||
201 | return &$ipcc_send_rec(CFS_IPC_LOG_CLUSTER_MSG, $bindata); | |
202 | }; | |
203 | ||
204 | my $ipcc_get_cluster_log = sub { | |
205 | my ($user, $max) = @_; | |
206 | ||
207 | $max = 0 if !defined($max); | |
208 | ||
209 | my $bindata = pack "VVVVZ*", $max, 0, 0, 0, ($user || ""); | |
210 | return &$ipcc_send_rec(CFS_IPC_GET_CLUSTER_LOG, $bindata); | |
211 | }; | |
212 | ||
213 | my $ipcc_verify_token = sub { | |
214 | my ($full_token) = @_; | |
215 | ||
216 | my $bindata = pack "Z*", $full_token; | |
217 | my $res = PVE::IPCC::ipcc_send_rec(CFS_IPC_VERIFY_TOKEN, $bindata); | |
218 | ||
219 | return 1 if $! == 0; | |
220 | return 0 if $! == ENOENT; | |
221 | ||
222 | die "$!\n"; | |
223 | }; | |
224 | ||
225 | my $ccache = {}; | |
226 | ||
227 | sub cfs_update { | |
228 | my ($fail) = @_; | |
229 | eval { | |
230 | my $res = &$ipcc_send_rec_json(CFS_IPC_GET_FS_VERSION); | |
231 | die "no starttime\n" if !$res->{starttime}; | |
232 | ||
233 | if (!$res->{starttime} || !$versions->{starttime} || | |
234 | $res->{starttime} != $versions->{starttime}) { | |
235 | #print "detected changed starttime\n"; | |
236 | $vmlist = {}; | |
237 | $clinfo = {}; | |
238 | $ccache = {}; | |
239 | } | |
240 | ||
241 | $versions = $res; | |
242 | }; | |
243 | my $err = $@; | |
244 | if ($err) { | |
245 | $versions = {}; | |
246 | $vmlist = {}; | |
247 | $clinfo = {}; | |
248 | $ccache = {}; | |
249 | die $err if $fail; | |
250 | warn $err; | |
251 | } | |
252 | ||
253 | eval { | |
254 | if (!$clinfo->{version} || $clinfo->{version} != $versions->{clinfo}) { | |
255 | #warn "detected new clinfo\n"; | |
256 | $clinfo = &$ipcc_send_rec_json(CFS_IPC_GET_CLUSTER_INFO); | |
257 | } | |
258 | }; | |
259 | $err = $@; | |
260 | if ($err) { | |
261 | $clinfo = {}; | |
262 | die $err if $fail; | |
263 | warn $err; | |
264 | } | |
265 | ||
266 | eval { | |
267 | if (!$vmlist->{version} || $vmlist->{version} != $versions->{vmlist}) { | |
268 | #warn "detected new vmlist1\n"; | |
269 | $vmlist = &$ipcc_send_rec_json(CFS_IPC_GET_GUEST_LIST); | |
270 | } | |
271 | }; | |
272 | $err = $@; | |
273 | if ($err) { | |
274 | $vmlist = {}; | |
275 | die $err if $fail; | |
276 | warn $err; | |
277 | } | |
278 | } | |
279 | ||
280 | sub get_vmlist { | |
281 | return $vmlist; | |
282 | } | |
283 | ||
284 | sub get_clinfo { | |
285 | return $clinfo; | |
286 | } | |
287 | ||
288 | sub get_members { | |
289 | return $clinfo->{nodelist}; | |
290 | } | |
291 | ||
292 | sub get_nodelist { | |
293 | my $nodelist = $clinfo->{nodelist}; | |
294 | ||
295 | my $nodename = PVE::INotify::nodename(); | |
296 | ||
297 | if (!$nodelist || !$nodelist->{$nodename}) { | |
298 | return [ $nodename ]; | |
299 | } | |
300 | ||
301 | return [ keys %$nodelist ]; | |
302 | } | |
303 | ||
304 | # only stored in a in-memory hashtable inside pmxcfs, local data is gone after | |
305 | # a restart (of pmxcfs or the node), peer data is still available then | |
306 | # best used for status data, like running (ceph) services, package versions, ... | |
307 | sub broadcast_node_kv { | |
308 | my ($key, $data) = @_; | |
309 | ||
310 | if (!defined($data)) { | |
311 | eval { $ipcc_remove_status->("kv/$key") }; | |
312 | } else { | |
313 | die "cannot send a reference\n" if ref($data); | |
314 | my $size = length($data); | |
315 | die "data for '$key' too big\n" if $size >= (32 * 1024); # limit from pmxfs | |
316 | ||
317 | eval { $ipcc_update_status->("kv/$key", $data) }; | |
318 | } | |
319 | warn $@ if $@; | |
320 | } | |
321 | ||
322 | # nodename is optional | |
323 | sub get_node_kv { | |
324 | my ($key, $nodename) = @_; | |
325 | ||
326 | my $res = {}; | |
327 | my $get_node_data = sub { | |
328 | my ($node) = @_; | |
329 | my $raw = $ipcc_get_status->("kv/$key", $node); | |
330 | $res->{$node} = unpack("Z*", $raw) if $raw; | |
331 | }; | |
332 | ||
333 | if ($nodename) { | |
334 | $get_node_data->($nodename); | |
335 | } else { | |
336 | for my $node (get_nodelist()->@*) { | |
337 | $get_node_data->($node); | |
338 | } | |
339 | } | |
340 | ||
341 | return $res; | |
342 | } | |
343 | ||
344 | # properties: an array-ref of config properties you want to get, e.g., this | |
345 | # is perfect to get multiple properties of a guest _fast_ | |
346 | # (>100 faster than manual parsing here) | |
347 | # vmid: optional, if a valid is passed we only check that one, else return all | |
348 | # NOTE: does *not* searches snapshot and PENDING entries sections! | |
349 | # NOTE: returns the guest config lines (excluding trailing whitespace) as is, | |
350 | # so for non-trivial properties, checking the validity must be done | |
351 | # NOTE: no permission check is done, that is the responsibilty of the caller | |
352 | sub get_guest_config_properties { | |
353 | my ($properties, $vmid) = @_; | |
354 | ||
355 | die "properties required" if !defined($properties); | |
356 | ||
357 | my $num_props = scalar(@$properties); | |
358 | die "only up to 255 properties supported" if $num_props > 255; | |
359 | my $bindata = pack "VC", $vmid // 0, $num_props; | |
360 | for my $property (@$properties) { | |
361 | $bindata .= pack "Z*", $property; | |
362 | } | |
363 | my $res = $ipcc_send_rec_json->(CFS_IPC_GET_GUEST_CONFIG_PROPERTIES, $bindata); | |
364 | ||
365 | return $res; | |
366 | } | |
367 | ||
368 | # property: a config property you want to get, e.g., this is perfect to get | |
369 | # the 'lock' entry of a guest _fast_ (>100 faster than manual parsing here) | |
370 | # vmid: optional, if a valid is passed we only check that one, else return all | |
371 | # NOTE: does *not* searches snapshot and PENDING entries sections! | |
372 | # NOTE: returns the guest config lines (excluding trailing whitespace) as is, | |
373 | # so for non-trivial properties, checking the validity must be done | |
374 | # NOTE: no permission check is done, that is the responsibilty of the caller | |
375 | sub get_guest_config_property { | |
376 | my ($property, $vmid) = @_; | |
377 | ||
378 | die "property is required" if !defined($property); | |
379 | ||
380 | my $bindata = pack "VZ*", $vmid // 0, $property; | |
381 | my $res = $ipcc_send_rec_json->(CFS_IPC_GET_GUEST_CONFIG_PROPERTY, $bindata); | |
382 | ||
383 | return $res; | |
384 | } | |
385 | ||
386 | # $data must be a chronological descending ordered array of tasks | |
387 | sub broadcast_tasklist { | |
388 | my ($data) = @_; | |
389 | ||
390 | # the serialized list may not get bigger than 128 KiB (CFS_MAX_STATUS_SIZE from pmxcfs) | |
391 | # drop older items until we satisfy this constraint | |
392 | my $size = length(encode_json($data)); | |
393 | while ($size >= (32 * 1024)) { # TODO: update to 128 KiB in PVE 8.x | |
394 | pop @$data; | |
395 | $size = length(encode_json($data)); | |
396 | } | |
397 | ||
398 | eval { $ipcc_update_status->("tasklist", $data) }; | |
399 | warn $@ if $@; | |
400 | } | |
401 | ||
402 | my $tasklistcache = {}; | |
403 | ||
404 | sub get_tasklist { | |
405 | my ($nodename) = @_; | |
406 | ||
407 | my $kvstore = $versions->{kvstore} || {}; | |
408 | ||
409 | my $nodelist = get_nodelist(); | |
410 | ||
411 | my $res = []; | |
412 | foreach my $node (@$nodelist) { | |
413 | next if $nodename && ($nodename ne $node); | |
414 | eval { | |
415 | my $ver = exists $kvstore->{$node} ? $kvstore->{$node}->{tasklist} : undef; | |
416 | my $cache = $tasklistcache->{$node}; | |
417 | if (!$cache || !$ver || !$cache->{version} || ($cache->{version} != $ver)) { | |
418 | my $tasks = []; | |
419 | if (my $raw = $ipcc_get_status->("tasklist", $node)) { | |
420 | my $json_str = unpack("Z*", $raw); | |
421 | $tasks = decode_json($json_str); | |
422 | } | |
423 | push @$res, @$tasks; | |
424 | $tasklistcache->{$node} = { | |
425 | data => $tasks, | |
426 | version => $ver, | |
427 | }; | |
428 | } elsif ($cache && $cache->{data}) { | |
429 | push @$res, $cache->{data}->@*; | |
430 | } | |
431 | }; | |
432 | my $err = $@; | |
433 | syslog('err', $err) if $err; | |
434 | } | |
435 | ||
436 | return $res; | |
437 | } | |
438 | ||
439 | sub broadcast_rrd { | |
440 | my ($rrdid, $data) = @_; | |
441 | ||
442 | eval { | |
443 | &$ipcc_update_status("rrd/$rrdid", $data); | |
444 | }; | |
445 | my $err = $@; | |
446 | ||
447 | warn $err if $err; | |
448 | } | |
449 | ||
450 | my $last_rrd_dump = 0; | |
451 | my $last_rrd_data = ""; | |
452 | ||
453 | sub rrd_dump { | |
454 | ||
455 | my $ctime = time(); | |
456 | ||
457 | my $diff = $ctime - $last_rrd_dump; | |
458 | if ($diff < 2) { | |
459 | return $last_rrd_data; | |
460 | } | |
461 | ||
462 | my $raw; | |
463 | eval { | |
464 | $raw = &$ipcc_send_rec(CFS_IPC_GET_RRD_DUMP); | |
465 | }; | |
466 | my $err = $@; | |
467 | ||
468 | if ($err) { | |
469 | warn $err; | |
470 | return {}; | |
471 | } | |
472 | ||
473 | my $res = {}; | |
474 | ||
475 | if ($raw) { | |
476 | while ($raw =~ s/^(.*)\n//) { | |
477 | my ($key, @ela) = split(/:/, $1); | |
478 | next if !$key; | |
479 | next if !(scalar(@ela) > 1); | |
480 | $res->{$key} = [ map { $_ eq 'U' ? undef : $_ } @ela ]; | |
481 | } | |
482 | } | |
483 | ||
484 | $last_rrd_dump = $ctime; | |
485 | $last_rrd_data = $res; | |
486 | ||
487 | return $res; | |
488 | } | |
489 | ||
490 | ||
491 | # a fast way to read files (avoid fuse overhead) | |
492 | sub get_config { | |
493 | my ($path) = @_; | |
494 | ||
495 | return &$ipcc_get_config($path); | |
496 | } | |
497 | ||
498 | sub get_cluster_log { | |
499 | my ($user, $max) = @_; | |
500 | ||
501 | return &$ipcc_get_cluster_log($user, $max); | |
502 | } | |
503 | ||
504 | sub verify_token { | |
505 | my ($userid, $token) = @_; | |
506 | ||
507 | return &$ipcc_verify_token("$userid $token"); | |
508 | } | |
509 | ||
510 | my $file_info = {}; | |
511 | ||
512 | sub cfs_register_file { | |
513 | my ($filename, $parser, $writer) = @_; | |
514 | ||
515 | $observed->{$filename} || die "unknown file '$filename'"; | |
516 | ||
517 | die "file '$filename' already registered" if $file_info->{$filename}; | |
518 | ||
519 | $file_info->{$filename} = { | |
520 | parser => $parser, | |
521 | writer => $writer, | |
522 | }; | |
523 | } | |
524 | ||
525 | my $ccache_read = sub { | |
526 | my ($filename, $parser, $version) = @_; | |
527 | ||
528 | $ccache->{$filename} = {} if !$ccache->{$filename}; | |
529 | ||
530 | my $ci = $ccache->{$filename}; | |
531 | ||
532 | if (!$ci->{version} || !$version || $ci->{version} != $version) { | |
533 | # we always call the parser, even when the file does not exist | |
534 | # (in that case $data is undef) | |
535 | my $data = get_config($filename); | |
536 | $ci->{data} = &$parser("/etc/pve/$filename", $data); | |
537 | $ci->{version} = $version; | |
538 | } | |
539 | ||
540 | my $res = ref($ci->{data}) ? dclone($ci->{data}) : $ci->{data}; | |
541 | ||
542 | return $res; | |
543 | }; | |
544 | ||
545 | sub cfs_file_version { | |
546 | my ($filename) = @_; | |
547 | ||
548 | my $version; | |
549 | my $infotag; | |
550 | if ($filename =~ m!^nodes/[^/]+/(openvz|lxc|qemu-server)/(\d+)\.conf$!) { | |
551 | my ($type, $vmid) = ($1, $2); | |
552 | if ($vmlist && $vmlist->{ids} && $vmlist->{ids}->{$vmid}) { | |
553 | $version = $vmlist->{ids}->{$vmid}->{version}; | |
554 | } | |
555 | $infotag = "/$type/"; | |
556 | } else { | |
557 | $infotag = $filename; | |
558 | $version = $versions->{$filename}; | |
559 | } | |
560 | ||
561 | my $info = $file_info->{$infotag} || | |
562 | die "unknown file type '$filename'\n"; | |
563 | ||
564 | return wantarray ? ($version, $info) : $version; | |
565 | } | |
566 | ||
567 | sub cfs_read_file { | |
568 | my ($filename) = @_; | |
569 | ||
570 | my ($version, $info) = cfs_file_version($filename); | |
571 | my $parser = $info->{parser}; | |
572 | ||
573 | return &$ccache_read($filename, $parser, $version); | |
574 | } | |
575 | ||
576 | sub cfs_write_file { | |
577 | my ($filename, $data) = @_; | |
578 | ||
579 | my ($version, $info) = cfs_file_version($filename); | |
580 | ||
581 | my $writer = $info->{writer} || die "no writer defined"; | |
582 | ||
583 | my $fsname = "/etc/pve/$filename"; | |
584 | ||
585 | my $raw = &$writer($fsname, $data); | |
586 | ||
587 | if (my $ci = $ccache->{$filename}) { | |
588 | $ci->{version} = undef; | |
589 | } | |
590 | ||
591 | PVE::Tools::file_set_contents($fsname, $raw); | |
592 | } | |
593 | ||
594 | my $cfs_lock = sub { | |
595 | my ($lockid, $timeout, $code, @param) = @_; | |
596 | ||
597 | my $prev_alarm = alarm(0); # suspend outer alarm early | |
598 | ||
599 | my $res; | |
600 | my $got_lock = 0; | |
601 | ||
602 | # this timeout is for acquire the lock | |
603 | $timeout = 10 if !$timeout; | |
604 | ||
605 | my $filename = "$lockdir/$lockid"; | |
606 | ||
607 | my $is_code_err = 0; | |
608 | eval { | |
609 | ||
610 | mkdir $lockdir; | |
611 | ||
612 | if (! -d $lockdir) { | |
613 | die "pve cluster filesystem not online.\n"; | |
614 | } | |
615 | ||
616 | my $timeout_err = sub { die "got lock request timeout\n"; }; | |
617 | local $SIG{ALRM} = $timeout_err; | |
618 | ||
619 | while (1) { | |
620 | alarm ($timeout); | |
621 | $got_lock = mkdir($filename); | |
622 | $timeout = alarm(0) - 1; # we'll sleep for 1s, see down below | |
623 | ||
624 | last if $got_lock; | |
625 | ||
626 | $timeout_err->() if $timeout <= 0; | |
627 | ||
628 | print STDERR "trying to acquire cfs lock '$lockid' ...\n"; | |
629 | utime (0, 0, $filename); # cfs unlock request | |
630 | sleep(1); | |
631 | } | |
632 | ||
633 | # fixed command timeout: cfs locks have a timeout of 120 | |
634 | # using 60 gives us another 60 seconds to abort the task | |
635 | local $SIG{ALRM} = sub { die "'$lockid'-locked command timed out - aborting\n"; }; | |
636 | alarm(60); | |
637 | ||
638 | cfs_update(); # make sure we read latest versions inside code() | |
639 | ||
640 | $is_code_err = 1; # allows to differ between locking and actual-work errors | |
641 | ||
642 | $res = &$code(@param); | |
643 | ||
644 | alarm(0); | |
645 | }; | |
646 | ||
647 | my $err = $@; | |
648 | ||
649 | $err = "no quorum!\n" if !$got_lock && !check_cfs_quorum(1); | |
650 | ||
651 | rmdir $filename if $got_lock; # if we held the lock always unlock again | |
652 | ||
653 | alarm($prev_alarm); | |
654 | ||
655 | if ($err) { | |
656 | if (ref($err) eq 'PVE::Exception' || $is_code_err) { | |
657 | # re-raise defined exceptions | |
658 | $@ = $err; | |
659 | } else { | |
660 | # add lock info for plain errors comming from the locking itself | |
661 | $@ = "cfs-lock '$lockid' error: $err"; | |
662 | } | |
663 | return undef; | |
664 | } | |
665 | ||
666 | $@ = undef; | |
667 | ||
668 | return $res; | |
669 | }; | |
670 | ||
671 | sub cfs_lock_file { | |
672 | my ($filename, $timeout, $code, @param) = @_; | |
673 | ||
674 | my $info = $observed->{$filename} || die "unknown file '$filename'"; | |
675 | ||
676 | my $lockid = "file-$filename"; | |
677 | $lockid =~ s/[.\/]/_/g; | |
678 | ||
679 | &$cfs_lock($lockid, $timeout, $code, @param); | |
680 | } | |
681 | ||
682 | sub cfs_lock_storage { | |
683 | my ($storeid, $timeout, $code, @param) = @_; | |
684 | ||
685 | my $lockid = "storage-$storeid"; | |
686 | ||
687 | &$cfs_lock($lockid, $timeout, $code, @param); | |
688 | } | |
689 | ||
690 | sub cfs_lock_domain { | |
691 | my ($domainname, $timeout, $code, @param) = @_; | |
692 | ||
693 | my $lockid = "domain-$domainname"; | |
694 | ||
695 | &$cfs_lock($lockid, $timeout, $code, @param); | |
696 | } | |
697 | ||
698 | sub cfs_lock_acme { | |
699 | my ($account, $timeout, $code, @param) = @_; | |
700 | ||
701 | my $lockid = "acme-$account"; | |
702 | ||
703 | &$cfs_lock($lockid, $timeout, $code, @param); | |
704 | } | |
705 | ||
706 | sub cfs_lock_authkey { | |
707 | my ($timeout, $code, @param) = @_; | |
708 | ||
709 | $cfs_lock->('authkey', $timeout, $code, @param); | |
710 | } | |
711 | ||
712 | sub cfs_lock_firewall { | |
713 | my ($scope, $timeout, $code, @param) = @_; | |
714 | ||
715 | my $lockid = "firewall-$scope"; | |
716 | ||
717 | $cfs_lock->($lockid, $timeout, $code, @param); | |
718 | } | |
719 | ||
720 | my $log_levels = { | |
721 | "emerg" => 0, | |
722 | "alert" => 1, | |
723 | "crit" => 2, | |
724 | "critical" => 2, | |
725 | "err" => 3, | |
726 | "error" => 3, | |
727 | "warn" => 4, | |
728 | "warning" => 4, | |
729 | "notice" => 5, | |
730 | "info" => 6, | |
731 | "debug" => 7, | |
732 | }; | |
733 | ||
734 | sub log_msg { | |
735 | my ($priority, $ident, $msg) = @_; | |
736 | ||
737 | if (my $tmp = $log_levels->{$priority}) { | |
738 | $priority = $tmp; | |
739 | } | |
740 | ||
741 | die "need numeric log priority" if $priority !~ /^\d+$/; | |
742 | ||
743 | my $tag = PVE::SafeSyslog::tag(); | |
744 | ||
745 | $msg = "empty message" if !$msg; | |
746 | ||
747 | $ident = "" if !$ident; | |
748 | $ident = encode("ascii", $ident, | |
749 | sub { sprintf "\\u%04x", shift }); | |
750 | ||
751 | my $ascii = encode("ascii", $msg, sub { sprintf "\\u%04x", shift }); | |
752 | ||
753 | if ($ident) { | |
754 | syslog($priority, "<%s> %s", $ident, $ascii); | |
755 | } else { | |
756 | syslog($priority, "%s", $ascii); | |
757 | } | |
758 | ||
759 | eval { &$ipcc_log($priority, $ident, $tag, $ascii); }; | |
760 | ||
761 | syslog("err", "writing cluster log failed: $@") if $@; | |
762 | } | |
763 | ||
764 | sub check_vmid_unused { | |
765 | my ($vmid, $noerr) = @_; | |
766 | ||
767 | my $vmlist = get_vmlist(); | |
768 | ||
769 | my $d = $vmlist->{ids}->{$vmid}; | |
770 | return 1 if !defined($d); | |
771 | ||
772 | return undef if $noerr; | |
773 | ||
774 | my $vmtypestr = $d->{type} eq 'qemu' ? 'VM' : 'CT'; | |
775 | die "$vmtypestr $vmid already exists on node '$d->{node}'\n"; | |
776 | } | |
777 | ||
778 | sub check_node_exists { | |
779 | my ($nodename, $noerr) = @_; | |
780 | ||
781 | my $nodelist = $clinfo->{nodelist}; | |
782 | return 1 if $nodelist && $nodelist->{$nodename}; | |
783 | ||
784 | return undef if $noerr; | |
785 | ||
786 | die "no such cluster node '$nodename'\n"; | |
787 | } | |
788 | ||
789 | # this is also used to get the IP of the local node | |
790 | sub remote_node_ip { | |
791 | my ($nodename, $noerr) = @_; | |
792 | ||
793 | my $nodelist = $clinfo->{nodelist}; | |
794 | if ($nodelist && $nodelist->{$nodename}) { | |
795 | if (my $ip = $nodelist->{$nodename}->{ip}) { | |
796 | return $ip if !wantarray; | |
797 | my $family = $nodelist->{$nodename}->{address_family}; | |
798 | if (!$family) { | |
799 | $nodelist->{$nodename}->{address_family} = | |
800 | $family = | |
801 | PVE::Tools::get_host_address_family($ip); | |
802 | } | |
803 | return wantarray ? ($ip, $family) : $ip; | |
804 | } | |
805 | } | |
806 | ||
807 | # fallback: try to get IP by other means | |
808 | return PVE::Network::get_ip_from_hostname($nodename, $noerr); | |
809 | } | |
810 | ||
811 | sub get_node_fingerprint { | |
812 | my ($node) = @_; | |
813 | ||
814 | my $cert_path = "/etc/pve/nodes/$node/pve-ssl.pem"; | |
815 | my $custom_cert_path = "/etc/pve/nodes/$node/pveproxy-ssl.pem"; | |
816 | ||
817 | $cert_path = $custom_cert_path if -f $custom_cert_path; | |
818 | ||
819 | return PVE::Certificate::get_certificate_fingerprint($cert_path); | |
820 | } | |
821 | ||
822 | # bash completion helpers | |
823 | ||
824 | sub complete_next_vmid { | |
825 | ||
826 | my $vmlist = get_vmlist() || {}; | |
827 | my $idlist = $vmlist->{ids} || {}; | |
828 | ||
829 | for (my $i = 100; $i < 10000; $i++) { | |
830 | return [$i] if !defined($idlist->{$i}); | |
831 | } | |
832 | ||
833 | return []; | |
834 | } | |
835 | ||
836 | sub complete_vmid { | |
837 | ||
838 | my $vmlist = get_vmlist(); | |
839 | my $ids = $vmlist->{ids} || {}; | |
840 | ||
841 | return [ keys %$ids ]; | |
842 | } | |
843 | ||
844 | sub complete_local_vmid { | |
845 | ||
846 | my $vmlist = get_vmlist(); | |
847 | my $ids = $vmlist->{ids} || {}; | |
848 | ||
849 | my $nodename = PVE::INotify::nodename(); | |
850 | ||
851 | my $res = []; | |
852 | foreach my $vmid (keys %$ids) { | |
853 | my $d = $ids->{$vmid}; | |
854 | next if !$d->{node} || $d->{node} ne $nodename; | |
855 | push @$res, $vmid; | |
856 | } | |
857 | ||
858 | return $res; | |
859 | } | |
860 | ||
861 | sub complete_migration_target { | |
862 | ||
863 | my $res = []; | |
864 | ||
865 | my $nodename = PVE::INotify::nodename(); | |
866 | ||
867 | my $nodelist = get_nodelist(); | |
868 | foreach my $node (@$nodelist) { | |
869 | next if $node eq $nodename; | |
870 | push @$res, $node; | |
871 | } | |
872 | ||
873 | return $res; | |
874 | } | |
875 | ||
876 | ||
877 | # NOTE: filesystem must be offline here, no DB changes allowed | |
878 | sub cfs_backup_database { | |
879 | mkdir $dbbackupdir; | |
880 | ||
881 | my $ctime = time(); | |
882 | my $backup_fn = "$dbbackupdir/config-$ctime.sql.gz"; | |
883 | ||
884 | print "backup old database to '$backup_fn'\n"; | |
885 | ||
886 | my $cmd = [ ['sqlite3', $dbfile, '.dump'], ['gzip', '-', \ ">${backup_fn}"] ]; | |
887 | run_command($cmd, 'errmsg' => "cannot backup old database\n"); | |
888 | ||
889 | my $maxfiles = 10; # purge older backup | |
890 | my $backups = [ sort { $b cmp $a } <$dbbackupdir/config-*.sql.gz> ]; | |
891 | ||
892 | if ((my $count = scalar(@$backups)) > $maxfiles) { | |
893 | foreach my $f (@$backups[$maxfiles..$count-1]) { | |
894 | next if $f !~ m/^(\S+)$/; # untaint | |
895 | print "delete old backup '$1'\n"; | |
896 | unlink $1; | |
897 | } | |
898 | } | |
899 | ||
900 | return $dbfile; | |
901 | } | |
902 | ||
903 | 1; |