]>
git.proxmox.com Git - pve-cluster.git/blob - data/PVE/Cluster.pm
8 use Storable
qw(dclone) ;
13 use Digest
:: HMAC_SHA1
;
30 use Data
:: Dumper
; # fixme: remove
32 # x509 certificate utils
34 my $basedir = "/etc/pve" ;
35 my $authdir = " $basedir/priv " ;
36 my $lockdir = "/etc/pve/priv/lock" ;
38 my $authprivkeyfn = " $authdir/authkey .key" ;
39 my $authpubkeyfn = " $basedir/authkey .pub" ;
40 my $pveca_key_fn = " $authdir/pve -root-ca.key" ;
41 my $pveca_srl_fn = " $authdir/pve -root-ca.srl" ;
42 my $pveca_cert_fn = " $basedir/pve -root-ca.pem" ;
43 # this is just a secret accessable by the web browser
44 # and is used for CSRF prevention
45 my $pvewww_key_fn = " $basedir/pve -www.key" ;
48 my $ssh_rsa_id_priv = "/root/.ssh/id_rsa" ;
49 my $ssh_rsa_id = "/root/.ssh/id_rsa.pub" ;
50 my $ssh_host_rsa_id = "/etc/ssh/ssh_host_rsa_key.pub" ;
51 my $sshglobalknownhosts = "/etc/ssh/ssh_known_hosts" ;
52 my $sshknownhosts = "/etc/pve/priv/known_hosts" ;
53 my $sshauthkeys = "/etc/pve/priv/authorized_keys" ;
54 my $rootsshauthkeys = "/root/.ssh/authorized_keys" ;
55 my $rootsshauthkeysbackup = "${rootsshauthkeys}.org" ;
56 my $rootsshconfig = "/root/.ssh/config" ;
61 'datacenter.cfg' => 1 ,
63 'corosync.conf.new' => 1 ,
66 'priv/shadow.cfg' => 1 ,
70 'ha/crm_commands' => 1 ,
71 'ha/manager_status' => 1 ,
72 'ha/resources.cfg' => 1 ,
76 # only write output if something fails
82 my $record_output = sub {
88 PVE
:: Tools
:: run_command
( $cmd, outfunc
=> $record_output,
89 errfunc
=> $record_output );
100 sub check_cfs_quorum
{
103 # note: -w filename always return 1 for root, so wee need
104 # to use File::lstat here
105 my $st = File
:: stat :: lstat ( " $basedir/local " );
106 my $quorate = ( $st && (( $st -> mode & 0200 ) != 0 ));
108 die "cluster not ready - no quorum? \n " if ! $quorate && ! $noerr ;
113 sub check_cfs_is_mounted
{
116 my $res = - l
" $basedir/local " ;
118 die "pve configuration filesystem not mounted \n "
127 check_cfs_is_mounted
();
129 my @required_dirs = (
132 " $basedir/nodes/$nodename " ,
133 " $basedir/nodes/$nodename/lxc " ,
134 " $basedir/nodes/$nodename/qemu -server" ,
135 " $basedir/nodes/$nodename/openvz " ,
136 " $basedir/nodes/$nodename/priv " );
138 foreach my $dir ( @required_dirs ) {
140 mkdir ( $dir ) || $! == EEXIST
|| die "unable to create directory ' $dir ' - $!\n " ;
147 return if - f
" $authprivkeyfn " ;
149 check_cfs_is_mounted
();
151 mkdir $authdir || $! == EEXIST
|| die "unable to create dir ' $authdir ' - $!\n " ;
153 my $cmd = "openssl genrsa -out ' $authprivkeyfn ' 2048" ;
154 run_silent_cmd
( $cmd );
156 $cmd = "openssl rsa -in ' $authprivkeyfn ' -pubout -out ' $authpubkeyfn '" ;
162 return if - f
$pveca_key_fn ;
165 run_silent_cmd
([ 'openssl' , 'genrsa' , '-out' , $pveca_key_fn, '2048' ]);
168 die "unable to generate pve ca key: \n $@ " if $@ ;
173 if (- f
$pveca_key_fn && - f
$pveca_cert_fn ) {
179 # we try to generate an unique 'subject' to avoid browser problems
180 # (reused serial numbers, ..)
181 my $nid = ( split ( /\s/ , `md5sum ' $pveca_key_fn '` ))[ 0 ] || time ();
184 run_silent_cmd
([ 'openssl' , 'req' , '-batch' , '-days' , '3650' , '-new' ,
185 '-x509' , '-nodes' , '-key' ,
186 $pveca_key_fn, '-out' , $pveca_cert_fn, '-subj' ,
187 "/CN=Proxmox Virtual Environment/OU= $nid/O =PVE Cluster Manager CA/" ]);
190 die "generating pve root certificate failed: \n $@ " if $@ ;
195 sub gen_pve_ssl_key
{
198 die "no node name specified" if ! $nodename ;
200 my $pvessl_key_fn = " $basedir/nodes/$nodename/pve -ssl.key" ;
202 return if - f
$pvessl_key_fn ;
205 run_silent_cmd
([ 'openssl' , 'genrsa' , '-out' , $pvessl_key_fn, '2048' ]);
208 die "unable to generate pve ssl key for node ' $nodename ': \n $@ " if $@ ;
211 sub gen_pve_www_key
{
213 return if - f
$pvewww_key_fn ;
216 run_silent_cmd
([ 'openssl' , 'genrsa' , '-out' , $pvewww_key_fn, '2048' ]);
219 die "unable to generate pve www key: \n $@ " if $@ ;
225 PVE
:: Tools
:: file_set_contents
( $pveca_srl_fn, $serial );
228 sub gen_pve_ssl_cert
{
229 my ( $force, $nodename, $ip ) = @_ ;
231 die "no node name specified" if ! $nodename ;
232 die "no IP specified" if ! $ip ;
234 my $pvessl_cert_fn = " $basedir/nodes/$nodename/pve -ssl.pem" ;
236 return if ! $force && - f
$pvessl_cert_fn ;
238 my $names = "IP:127.0.0.1,DNS:localhost" ;
240 my $rc = PVE
:: INotify
:: read_file
( 'resolvconf' );
244 my $fqdn = $nodename ;
246 $names .= ",DNS: $nodename " ;
248 if ( $rc && $rc ->{ search
}) {
249 $fqdn = $nodename . "." . $rc ->{ search
};
250 $names .= ",DNS: $fqdn " ;
253 my $sslconf = <<__EOD;
254 RANDFILE = /root/.rnd
259 distinguished_name = req_distinguished_name
260 req_extensions = v3_req
262 string_mask = nombstr
264 [ req_distinguished_name ]
265 organizationalUnitName = PVE Cluster Node
266 organizationName = Proxmox Virtual Environment
270 basicConstraints = CA:FALSE
272 keyUsage = nonRepudiation, digitalSignature, keyEncipherment
273 subjectAltName = $names
276 my $cfgfn = "/tmp/pvesslconf- $$ .tmp" ;
277 my $fh = IO
:: File-
> new ( $cfgfn, "w" );
281 my $reqfn = "/tmp/pvecertreq- $$ .tmp" ;
284 my $pvessl_key_fn = " $basedir/nodes/$nodename/pve -ssl.key" ;
286 run_silent_cmd
([ 'openssl' , 'req' , '-batch' , '-new' , '-config' , $cfgfn,
287 '-key' , $pvessl_key_fn, '-out' , $reqfn ]);
293 die "unable to generate pve certificate request: \n $err " ;
296 update_serial
( "0000000000000000" ) if ! - f
$pveca_srl_fn ;
299 run_silent_cmd
([ 'openssl' , 'x509' , '-req' , '-in' , $reqfn, '-days' , '3650' ,
300 '-out' , $pvessl_cert_fn, '-CAkey' , $pveca_key_fn,
301 '-CA' , $pveca_cert_fn, '-CAserial' , $pveca_srl_fn,
302 '-extfile' , $cfgfn ]);
308 die "unable to generate pve ssl certificate: \n $err " ;
315 sub gen_pve_node_files
{
316 my ( $nodename, $ip, $opt_force ) = @_ ;
318 gen_local_dirs
( $nodename );
322 # make sure we have a (cluster wide) secret
323 # for CSRFR prevention
326 # make sure we have a (per node) private key
327 gen_pve_ssl_key
( $nodename );
329 # make sure we have a CA
330 my $force = gen_pveca_cert
();
332 $force = 1 if $opt_force ;
334 gen_pve_ssl_cert
( $force, $nodename, $ip );
337 my $vzdump_cron_dummy = <<__EOD;
338 # cluster wide vzdump cron schedule
339 # Atomatically generated file - do not edit
341 PATH="/usr/sbin:/usr/bin:/sbin:/bin"
345 sub gen_pve_vzdump_symlink
{
347 my $filename = "/etc/pve/vzdump.cron" ;
349 my $link_fn = "/etc/cron.d/vzdump" ;
351 if ((- f
$filename ) && (! - l
$link_fn )) {
352 rename ( $link_fn, "/root/etc_cron_vzdump.org" ); # make backup if file exists
353 symlink ( $filename, $link_fn );
357 sub gen_pve_vzdump_files
{
359 my $filename = "/etc/pve/vzdump.cron" ;
361 PVE
:: Tools
:: file_set_contents
( $filename, $vzdump_cron_dummy )
364 gen_pve_vzdump_symlink
();
371 my $ipcc_send_rec = sub {
372 my ( $msgid, $data ) = @_ ;
374 my $res = PVE
:: IPCC
:: ipcc_send_rec
( $msgid, $data );
376 die "ipcc_send_rec failed: $!\n " if ! defined ( $res ) && ( $! != 0 );
381 my $ipcc_send_rec_json = sub {
382 my ( $msgid, $data ) = @_ ;
384 my $res = PVE
:: IPCC
:: ipcc_send_rec
( $msgid, $data );
386 die "ipcc_send_rec failed: $!\n " if ! defined ( $res ) && ( $! != 0 );
388 return decode_json
( $res );
391 my $ipcc_get_config = sub {
394 my $bindata = pack "Z*" , $path ;
395 my $res = PVE
:: IPCC
:: ipcc_send_rec
( 6 , $bindata );
396 if (! defined ( $res )) {
397 return undef if ( $! != 0 );
404 my $ipcc_get_status = sub {
405 my ( $name, $nodename ) = @_ ;
407 my $bindata = pack "Z[256]Z[256]" , $name, ( $nodename || "" );
408 return PVE
:: IPCC
:: ipcc_send_rec
( 5 , $bindata );
411 my $ipcc_update_status = sub {
412 my ( $name, $data ) = @_ ;
414 my $raw = ref ( $data ) ? encode_json
( $data ) : $data ;
416 my $bindata = pack "Z[256]Z*" , $name, $raw ;
418 return & $ipcc_send_rec ( 4 , $bindata );
422 my ( $priority, $ident, $tag, $msg ) = @_ ;
424 my $bindata = pack "CCCZ*Z*Z*" , $priority, bytes
:: length ( $ident ) + 1 ,
425 bytes
:: length ( $tag ) + 1 , $ident, $tag, $msg ;
427 return & $ipcc_send_rec ( 7 , $bindata );
430 my $ipcc_get_cluster_log = sub {
431 my ( $user, $max ) = @_ ;
433 $max = 0 if ! defined ( $max );
435 my $bindata = pack "VVVVZ*" , $max, 0 , 0 , 0 , ( $user || "" );
436 return & $ipcc_send_rec ( 8 , $bindata );
443 my $res = & $ipcc_send_rec_json ( 1 );
444 #warn "GOT1: " . Dumper($res);
445 die "no starttime \n " if ! $res ->{ starttime
};
447 if (! $res ->{ starttime
} || ! $versions ->{ starttime
} ||
448 $res ->{ starttime
} != $versions ->{ starttime
}) {
449 #print "detected changed starttime\n";
467 if (! $clinfo ->{ version
} || $clinfo ->{ version
} != $versions ->{ clinfo
}) {
468 #warn "detected new clinfo\n";
469 $clinfo = & $ipcc_send_rec_json ( 2 );
479 if (! $vmlist ->{ version
} || $vmlist ->{ version
} != $versions ->{ vmlist
}) {
480 #warn "detected new vmlist1\n";
481 $vmlist = & $ipcc_send_rec_json ( 3 );
500 return $clinfo ->{ nodelist
};
505 my $nodelist = $clinfo ->{ nodelist
};
509 my $nodename = PVE
:: INotify
:: nodename
();
511 if (! $nodelist || ! $nodelist ->{ $nodename }) {
512 return [ $nodename ];
515 return [ keys %$nodelist ];
518 sub broadcast_tasklist
{
522 & $ipcc_update_status ( "tasklist" , $data );
528 my $tasklistcache = {};
533 my $kvstore = $versions ->{ kvstore
} || {};
535 my $nodelist = get_nodelist
();
538 foreach my $node ( @$nodelist ) {
539 next if $nodename && ( $nodename ne $node );
541 my $ver = $kvstore ->{ $node }->{ tasklist
} if $kvstore ->{ $node };
542 my $cd = $tasklistcache ->{ $node };
543 if (! $cd || ! $ver || ! $cd ->{ version
} ||
544 ( $cd ->{ version
} != $ver )) {
545 my $raw = & $ipcc_get_status ( "tasklist" , $node ) || '[]' ;
546 my $data = decode_json
( $raw );
548 $cd = $tasklistcache ->{ $node } = {
552 } elsif ( $cd && $cd ->{ data
}) {
553 push @$res, @{ $cd ->{ data
}};
557 syslog
( 'err' , $err ) if $err ;
564 my ( $rrdid, $data ) = @_ ;
567 & $ipcc_update_status ( "rrd/ $rrdid " , $data );
574 my $last_rrd_dump = 0 ;
575 my $last_rrd_data = "" ;
581 my $diff = $ctime - $last_rrd_dump ;
583 return $last_rrd_data ;
588 $raw = & $ipcc_send_rec ( 10 );
600 while ( $raw =~ s/^(.*)\n// ) {
601 my ( $key, @ela ) = split ( /:/ , $1 );
603 next if !( scalar ( @ela ) > 1 );
604 $res ->{ $key } = \
@ela ;
608 $last_rrd_dump = $ctime ;
609 $last_rrd_data = $res ;
614 sub create_rrd_data
{
615 my ( $rrdname, $timeframe, $cf ) = @_ ;
617 my $rrddir = "/var/lib/rrdcached/db" ;
619 my $rrd = " $rrddir/$rrdname " ;
623 day
=> [ 60 * 30 , 70 ],
624 week
=> [ 60 * 180 , 70 ],
625 month
=> [ 60 * 720 , 70 ],
626 year
=> [ 60 * 10080 , 70 ],
629 my ( $reso, $count ) = @{ $setup ->{ $timeframe }};
630 my $ctime = $reso*int ( time ()/ $reso );
631 my $req_start = $ctime - $reso*$count ;
633 $cf = "AVERAGE" if ! $cf ;
641 my $socket = "/var/run/rrdcached.sock" ;
642 push @args, "--daemon" => "unix: $socket " if - S
$socket ;
644 my ( $start, $step, $names, $data ) = RRDs
:: fetch
( $rrd, $cf, @args );
646 my $err = RRDs
:: error
;
647 die "RRD error: $err\n " if $err ;
649 die "got wrong time resolution ( $step != $reso ) \n "
653 my $fields = scalar ( @$names );
654 for my $line ( @$data ) {
655 my $entry = { 'time' => $start };
658 for ( my $i = 0 ; $i < $fields ; $i++ ) {
659 my $name = $names ->[ $i ];
660 if ( defined ( my $val = $line ->[ $i ])) {
661 $entry ->{ $name } = $val ;
663 # we only add entryies with all data defined
664 # extjs chart has problems with undefined values
668 push @$res, $entry if ! $found_undefs ;
674 sub create_rrd_graph
{
675 my ( $rrdname, $timeframe, $ds, $cf ) = @_ ;
677 # Using RRD graph is clumsy - maybe it
678 # is better to simply fetch the data, and do all display
679 # related things with javascript (new extjs html5 graph library).
681 my $rrddir = "/var/lib/rrdcached/db" ;
683 my $rrd = " $rrddir/$rrdname " ;
685 my @ids = PVE
:: Tools
:: split_list
( $ds );
687 my $ds_txt = join ( '_' , @ids );
689 my $filename = "${rrd}_${ds_txt}.png" ;
693 day
=> [ 60 * 30 , 70 ],
694 week
=> [ 60 * 180 , 70 ],
695 month
=> [ 60 * 720 , 70 ],
696 year
=> [ 60 * 10080 , 70 ],
699 my ( $reso, $count ) = @{ $setup ->{ $timeframe }};
702 "--imgformat" => "PNG" ,
706 "--start" => - $reso*$count,
710 my $socket = "/var/run/rrdcached.sock" ;
711 push @args, "--daemon" => "unix: $socket " if - S
$socket ;
713 my @coldef = ( '#00ddff' , '#ff0000' );
715 $cf = "AVERAGE" if ! $cf ;
718 foreach my $id ( @ids ) {
719 my $col = $coldef [ $i++ ] || die "fixme: no color definition" ;
720 push @args, "DEF:${id}= $rrd :${id}: $cf " ;
722 if ( $id eq 'cpu' || $id eq 'iowait' ) {
723 push @args, "CDEF:${id}_per=${id},100,*" ;
724 $dataid = "${id}_per" ;
726 push @args, "LINE2:${dataid}${col}:${id}" ;
729 push @args, '--full-size-mode' ;
731 # we do not really store data into the file
732 my $res = RRDs
:: graphv
( '' , @args );
734 my $err = RRDs
:: error
;
735 die "RRD error: $err\n " if $err ;
737 return { filename
=> $filename, image
=> $res ->{ image
} };
740 # a fast way to read files (avoid fuse overhead)
744 return & $ipcc_get_config ( $path );
747 sub get_cluster_log
{
748 my ( $user, $max ) = @_ ;
750 return & $ipcc_get_cluster_log ( $user, $max );
755 sub cfs_register_file
{
756 my ( $filename, $parser, $writer ) = @_ ;
758 $observed ->{ $filename } || die "unknown file ' $filename '" ;
760 die "file ' $filename ' already registered" if $file_info ->{ $filename };
762 $file_info ->{ $filename } = {
768 my $ccache_read = sub {
769 my ( $filename, $parser, $version ) = @_ ;
771 $ccache ->{ $filename } = {} if ! $ccache ->{ $filename };
773 my $ci = $ccache ->{ $filename };
775 if (! $ci ->{ version
} || ! $version || $ci ->{ version
} != $version ) {
776 # we always call the parser, even when the file does not exists
777 # (in that case $data is undef)
778 my $data = get_config
( $filename );
779 $ci ->{ data
} = & $parser ( "/etc/pve/ $filename " , $data );
780 $ci ->{ version
} = $version ;
783 my $res = ref ( $ci ->{ data
}) ? dclone
( $ci ->{ data
}) : $ci ->{ data
};
788 sub cfs_file_version
{
793 if ( $filename =~ m!^nodes/[^/]+/(openvz|qemu-server)/(\d+)\.conf$! ) {
794 my ( $type, $vmid ) = ( $1, $2 );
795 if ( $vmlist && $vmlist ->{ ids
} && $vmlist ->{ ids
}->{ $vmid }) {
796 $version = $vmlist ->{ ids
}->{ $vmid }->{ version
};
798 $infotag = "/ $type/ " ;
799 } elsif ( $filename =~ m!^nodes/[^/]+/lxc/(\d+)/config$! ) {
801 if ( $vmlist && $vmlist ->{ ids
} && $vmlist ->{ ids
}->{ $vmid }) {
802 $version = $vmlist ->{ ids
}->{ $vmid }->{ version
};
806 $infotag = $filename ;
807 $version = $versions ->{ $filename };
810 my $info = $file_info ->{ $infotag } ||
811 die "unknown file type ' $filename ' \n " ;
813 return wantarray ?
( $version, $info ) : $version ;
819 my ( $version, $info ) = cfs_file_version
( $filename );
820 my $parser = $info ->{ parser
};
822 return & $ccache_read ( $filename, $parser, $version );
826 my ( $filename, $data ) = @_ ;
828 my ( $version, $info ) = cfs_file_version
( $filename );
830 my $writer = $info ->{ writer
} || die "no writer defined" ;
832 my $fsname = "/etc/pve/ $filename " ;
834 my $raw = & $writer ( $fsname, $data );
836 if ( my $ci = $ccache ->{ $filename }) {
837 $ci ->{ version
} = undef ;
840 PVE
:: Tools
:: file_set_contents
( $fsname, $raw );
844 my ( $lockid, $timeout, $code, @param ) = @_ ;
848 # this timeout is for aquire the lock
849 $timeout = 10 if ! $timeout ;
851 my $filename = " $lockdir/$lockid " ;
853 my $msg = "can't aquire cfs lock ' $lockid '" ;
860 die " $msg : pve cluster filesystem not online. \n " ;
863 local $SIG { ALRM
} = sub { die "got lock request timeout \n " ; };
867 if (!( mkdir $filename )) {
868 print STDERR
"trying to aquire cfs lock ' $lockid ' ..." ;
870 if (!( mkdir $filename )) {
871 ( utime 0 , 0 , $filename ); # cfs unlock request
873 print STDERR
" OK \n " ;
880 # fixed command timeout: cfs locks have a timeout of 120
881 # using 60 gives us another 60 seconds to abort the task
883 local $SIG { ALRM
} = sub { die "got lock timeout - aborting command \n " ; };
885 cfs_update
(); # make sure we read latest versions inside code()
887 $res = & $code ( @param );
896 if ( $err && ( $err eq "got lock request timeout \n " ) &&
897 ! check_cfs_quorum
()){
898 $err = " $msg : no quorum! \n " ;
901 if (! $err || $err !~ /^got lock timeout -/ ) {
902 rmdir $filename ; # cfs unlock
916 my ( $filename, $timeout, $code, @param ) = @_ ;
918 my $info = $observed ->{ $filename } || die "unknown file ' $filename '" ;
920 my $lockid = "file- $filename " ;
921 $lockid =~ s/[.\/]/ _
/ g
;
923 & $cfs_lock ( $lockid, $timeout, $code, @param );
926 sub cfs_lock_storage
{
927 my ( $storeid, $timeout, $code, @param ) = @_ ;
929 my $lockid = "storage- $storeid " ;
931 & $cfs_lock ( $lockid, $timeout, $code, @param );
949 my ( $priority, $ident, $msg ) = @_ ;
951 if ( my $tmp = $log_levels ->{ $priority }) {
955 die "need numeric log priority" if $priority !~ /^\d+$/ ;
957 my $tag = PVE
:: SafeSyslog
:: tag
();
959 $msg = "empty message" if ! $msg ;
961 $ident = "" if ! $ident ;
962 $ident = encode
( "ascii" , decode_utf8
( $ident ),
963 sub { sprintf " \\ u %04x " , shift });
965 my $utf8 = decode_utf8
( $msg );
967 my $ascii = encode
( "ascii" , $utf8, sub { sprintf " \\ u %04x " , shift });
970 syslog
( $priority, "< %s > %s " , $ident, $ascii );
972 syslog
( $priority, " %s " , $ascii );
975 eval { & $ipcc_log ( $priority, $ident, $tag, $ascii ); };
977 syslog
( "err" , "writing cluster log failed: $@ " ) if $@ ;
980 sub check_vmid_unused
{
981 my ( $vmid, $noerr ) = @_ ;
983 my $vmlist = get_vmlist
();
985 my $d = $vmlist ->{ ids
}->{ $vmid };
986 return 1 if ! defined ( $d );
988 return undef if $noerr ;
990 die "VM $vmid already exists \n " if $d ->{ type
} eq 'qemu' ;
992 die "CT $vmid already exists \n " ;
995 sub check_node_exists
{
996 my ( $nodename, $noerr ) = @_ ;
998 my $nodelist = $clinfo ->{ nodelist
};
999 return 1 if $nodelist && $nodelist ->{ $nodename };
1001 return undef if $noerr ;
1003 die "no such cluster node ' $nodename ' \n " ;
1006 # this is also used to get the IP of the local node
1007 sub remote_node_ip
{
1008 my ( $nodename, $noerr ) = @_ ;
1010 my $nodelist = $clinfo ->{ nodelist
};
1011 if ( $nodelist && $nodelist ->{ $nodename }) {
1012 if ( my $ip = $nodelist ->{ $nodename }->{ ip
}) {
1013 return wantarray ?
( $ip, PVE
:: Tools
:: get_host_address_family
( $ip ))
1018 # fallback: try to get IP by other means
1019 my ( $family, $packed_ip );
1022 my @res = PVE
:: Tools
:: getaddrinfo_all
( $nodename );
1023 $family = $res [ 0 ]->{ family
};
1024 $packed_ip = ( PVE
:: Tools
:: unpack_sockaddr_in46
( $res [ 0 ]->{ addr
}))[ 2 ];
1028 die "hostname lookup failed: \n $@ " if ! $noerr ;
1032 my $ip = Socket
:: inet_ntop
( $family, $packed_ip );
1033 if ( $ip =~ m/^127\.|^::1$/ ) {
1034 die "hostname lookup failed - got local IP address ( $nodename = $ip ) \n " if ! $noerr ;
1038 return wantarray ?
( $ip, $family ) : $ip ;
1041 # ssh related utility functions
1043 sub ssh_merge_keys
{
1044 # remove duplicate keys in $sshauthkeys
1045 # ssh-copy-id simply add keys, so the file can grow to large
1048 if (- f
$sshauthkeys ) {
1049 $data = PVE
:: Tools
:: file_get_contents
( $sshauthkeys, 128 * 1024 );
1054 if (- f
$rootsshauthkeysbackup ) {
1056 $data .= PVE
:: Tools
:: file_get_contents
( $rootsshauthkeysbackup, 128 * 1024 );
1061 # always add ourself
1062 if (- f
$ssh_rsa_id ) {
1063 my $pub = PVE
:: Tools
:: file_get_contents
( $ssh_rsa_id );
1065 $data .= " \n $pub\n " ;
1070 my @lines = split ( /\n/ , $data );
1071 foreach my $line ( @lines ) {
1072 if ( $line !~ /^#/ && $line =~ m/(^|\s)ssh-(rsa|dsa)\s+(\S+)\s+\S+$/ ) {
1073 next if $vhash ->{ $3 }++;
1075 $newdata .= " $line\n " ;
1078 PVE
:: Tools
:: file_set_contents
( $sshauthkeys, $newdata, 0600 );
1080 if ( $found_backup && - l
$rootsshauthkeys ) {
1081 # everything went well, so we can remove the backup
1082 unlink $rootsshauthkeysbackup ;
1086 sub setup_rootsshconfig
{
1088 # create ssh key if it does not exist
1089 if (! - f
$ssh_rsa_id ) {
1090 mkdir '/root/.ssh/' ;
1091 system ( "echo|ssh-keygen -t rsa -N '' -b 2048 -f ${ssh_rsa_id_priv}" );
1094 # create ssh config if it does not exist
1095 if (! - f
$rootsshconfig ) {
1097 if ( my $fh = IO
:: File-
> new ( $rootsshconfig, O_CREAT
| O_WRONLY
| O_EXCL
, 0640 )) {
1098 # this is the default ciphers list from debian openssl0.9.8 except blowfish is added as prefered
1099 print $fh "Ciphers blowfish-cbc,aes128-ctr,aes192-ctr,aes256-ctr,arcfour256,arcfour128,aes128-cbc,3des-cbc \n " ;
1105 sub setup_ssh_keys
{
1111 if (! - f
$sshauthkeys ) {
1113 if (- f
$rootsshauthkeys ) {
1114 $old = PVE
:: Tools
:: file_get_contents
( $rootsshauthkeys, 128 * 1024 );
1116 if ( my $fh = IO
:: File-
> new ( $sshauthkeys, O_CREAT
| O_WRONLY
| O_EXCL
, 0400 )) {
1117 PVE
:: Tools
:: safe_print
( $sshauthkeys, $fh, $old ) if $old ;
1123 warn "can't create shared ssh key database ' $sshauthkeys ' \n "
1124 if ! - f
$sshauthkeys ;
1126 if (- f
$rootsshauthkeys && ! - l
$rootsshauthkeys ) {
1127 if (! rename ( $rootsshauthkeys , $rootsshauthkeysbackup )) {
1128 warn "rename $rootsshauthkeys failed - $!\n " ;
1132 if (! - l
$rootsshauthkeys ) {
1133 symlink $sshauthkeys, $rootsshauthkeys ;
1136 if (! - l
$rootsshauthkeys ) {
1137 warn "can't create symlink for ssh keys ' $rootsshauthkeys ' -> ' $sshauthkeys ' \n " ;
1139 unlink $rootsshauthkeysbackup if $import_ok ;
1143 sub ssh_unmerge_known_hosts
{
1144 return if ! - l
$sshglobalknownhosts ;
1147 $old = PVE
:: Tools
:: file_get_contents
( $sshknownhosts, 128 * 1024 )
1148 if - f
$sshknownhosts ;
1150 PVE
:: Tools
:: file_set_contents
( $sshglobalknownhosts, $old );
1153 sub ssh_merge_known_hosts
{
1154 my ( $nodename, $ip_address, $createLink ) = @_ ;
1156 die "no node name specified" if ! $nodename ;
1157 die "no ip address specified" if ! $ip_address ;
1161 if (! - f
$sshknownhosts ) {
1162 if ( my $fh = IO
:: File-
> new ( $sshknownhosts, O_CREAT
| O_WRONLY
| O_EXCL
, 0600 )) {
1167 my $old = PVE
:: Tools
:: file_get_contents
( $sshknownhosts, 128 * 1024 );
1171 if ((! - l
$sshglobalknownhosts ) && (- f
$sshglobalknownhosts )) {
1172 $new = PVE
:: Tools
:: file_get_contents
( $sshglobalknownhosts, 128 * 1024 );
1175 my $hostkey = PVE
:: Tools
:: file_get_contents
( $ssh_host_rsa_id );
1176 die "can't parse $ssh_rsa_id " if $hostkey !~ m/^(ssh-rsa\s\S+)(\s.*)?$/ ;
1185 my $merge_line = sub {
1186 my ( $line, $all ) = @_ ;
1188 if ( $line =~ m/^(\S+)\s(ssh-rsa\s\S+)(\s.*)?$/ ) {
1191 if (! $vhash ->{ $key }) {
1193 if ( $key =~ m/\|1\|([^\|\s]+)\|([^\|\s]+)$/ ) {
1194 my $salt = decode_base64
( $1 );
1196 my $hmac = Digest
:: HMAC_SHA1-
> new ( $salt );
1197 $hmac -> add ( $nodename );
1198 my $hd = $hmac -> b64digest . '=' ;
1199 if ( $digest eq $hd ) {
1200 if ( $rsakey eq $hostkey ) {
1201 $found_nodename = 1 ;
1206 $hmac = Digest
:: HMAC_SHA1-
> new ( $salt );
1207 $hmac -> add ( $ip_address );
1208 $hd = $hmac -> b64digest . '=' ;
1209 if ( $digest eq $hd ) {
1210 if ( $rsakey eq $hostkey ) {
1211 $found_local_ip = 1 ;
1224 while ( $old && $old =~ s/^((.*?)(\n|$))// ) {
1226 next if $line =~ m/^\s*$/ ; # skip empty lines
1227 next if $line =~ m/^#/ ; # skip comments
1228 & $merge_line ( $line, 1 );
1231 while ( $new && $new =~ s/^((.*?)(\n|$))// ) {
1233 next if $line =~ m/^\s*$/ ; # skip empty lines
1234 next if $line =~ m/^#/ ; # skip comments
1235 & $merge_line ( $line );
1239 my $add_known_hosts_entry = sub {
1240 my ( $name, $hostkey ) = @_ ;
1242 my $hmac = Digest
:: HMAC_SHA1-
> new ( " $addIndex " . time ());
1243 my $b64salt = $hmac -> b64digest . '=' ;
1244 $hmac = Digest
:: HMAC_SHA1-
> new ( decode_base64
( $b64salt ));
1246 my $digest = $hmac -> b64digest . '=' ;
1247 $data .= "|1| $b64salt | $digest $hostkey\n " ;
1250 if (! $found_nodename || ! $found_local_ip ) {
1251 & $add_known_hosts_entry ( $nodename, $hostkey ) if ! $found_nodename ;
1252 & $add_known_hosts_entry ( $ip_address, $hostkey ) if ! $found_local_ip ;
1255 PVE
:: Tools
:: file_set_contents
( $sshknownhosts, $data );
1257 return if ! $createLink ;
1259 unlink $sshglobalknownhosts ;
1260 symlink $sshknownhosts, $sshglobalknownhosts ;
1262 warn "can't create symlink for ssh known hosts ' $sshglobalknownhosts ' -> ' $sshknownhosts ' \n "
1263 if ! - l
$sshglobalknownhosts ;
1267 my $datacenter_schema = {
1269 additionalProperties
=> 0 ,
1274 description
=> "Default keybord layout for vnc server." ,
1275 enum
=> PVE
:: Tools
:: kvmkeymaplist
(),
1280 description
=> "Default GUI language." ,
1281 enum
=> [ 'en' , 'de' ],
1286 description
=> "Specify external http proxy which is used for downloads (example: 'http://username:password\ @host :port/')" ,
1287 pattern
=> "http://.*" ,
1289 migration_unsecure
=> {
1292 description
=> "Migration is secure using SSH tunnel by default. For secure private networks you can disable it to speed up migration." ,
1297 description
=> "Select the default Console viewer. You can either use the builtin java applet (VNC), an external virt-viewer comtatible application (SPICE), or an HTML5 based viewer (noVNC)." ,
1298 enum
=> [ 'applet' , 'vv' , 'html5' ],
1303 format
=> 'email-opt' ,
1304 description
=> "Specify email address to send notification from (default is root @\$hostname )" ,
1309 # make schema accessible from outside (for documentation)
1310 sub get_datacenter_schema
{ return $datacenter_schema };
1312 sub parse_datacenter_config
{
1313 my ( $filename, $raw ) = @_ ;
1315 return PVE
:: JSONSchema
:: parse_config
( $datacenter_schema, $filename, $raw );
1318 sub write_datacenter_config
{
1319 my ( $filename, $cfg ) = @_ ;
1321 return PVE
:: JSONSchema
:: dump_config
( $datacenter_schema, $filename, $cfg );
1324 cfs_register_file
( 'datacenter.cfg' ,
1325 \
& parse_datacenter_config
,
1326 \
& write_datacenter_config
);
1328 # a very simply parser ...
1329 sub parse_corosync_conf
{
1330 my ( $filename, $raw ) = @_ ;
1334 my $digest = Digest
:: SHA
:: sha1_hex
( defined ( $raw ) ?
$raw : '' );
1337 $raw =~ s/\r?\n/ /g ;
1342 my @tokens = split ( /\s/ , $raw );
1344 my $conf = { section
=> 'main' , children
=> [] };
1347 my $section = $conf ;
1349 while ( defined ( my $token = shift @tokens )) {
1350 my $nexttok = $tokens [ 0 ];
1352 if ( $nexttok && ( $nexttok eq '{' )) {
1353 shift @tokens ; # skip '{'
1358 push @{ $section ->{ children
}}, $new_section ;
1359 push @$stack, $section ;
1360 $section = $new_section ;
1364 if ( $token eq '}' ) {
1365 $section = pop @$stack ;
1366 die "parse error - uncexpected '}' \n " if ! $section ;
1371 die "missing ':' after key ' $key ' \n " if ! ( $key =~ s/:$// );
1373 die "parse error - no value for ' $key ' \n " if ! defined ( $nexttok );
1374 my $value = shift @tokens ;
1376 push @{ $section ->{ children
}}, { key
=> $key, value
=> $value };
1379 $conf ->{ digest
} = $digest ;
1384 my $dump_corosync_section ;
1385 $dump_corosync_section = sub {
1386 my ( $section, $prefix ) = @_ ;
1388 my $raw = $prefix . $section ->{ section
} . " { \n " ;
1390 my @list = grep { defined ( $_ ->{ key
}) } @{ $section ->{ children
}};
1391 foreach my $child ( sort { $a ->{ key
} cmp $b ->{ key
}} @list ) {
1392 $raw .= $prefix . " $child ->{key}: $child ->{value} \n " ;
1395 @list = grep { defined ( $_ ->{ section
}) } @{ $section ->{ children
}};
1396 foreach my $child ( sort { $a ->{ section
} cmp $b ->{ section
}} @list ) {
1397 $raw .= & $dump_corosync_section ( $child, " $prefix " );
1400 $raw .= $prefix . "} \n\n " ;
1406 sub write_corosync_conf
{
1407 my ( $filename, $conf ) = @_ ;
1413 die "no main section" if $conf ->{ section
} ne 'main' ;
1415 my @list = grep { defined ( $_ ->{ key
}) } @{ $conf ->{ children
}};
1416 foreach my $child ( sort { $a ->{ key
} cmp $b ->{ key
}} @list ) {
1417 $raw .= " $child ->{key}: $child ->{value} \n " ;
1420 @list = grep { defined ( $_ ->{ section
}) } @{ $conf ->{ children
}};
1421 foreach my $child ( sort { $a ->{ section
} cmp $b ->{ section
}} @list ) {
1422 $raw .= & $dump_corosync_section ( $child, $prefix );
1428 sub corosync_conf_version
{
1429 my ( $conf, $noerr, $new_value ) = @_ ;
1431 foreach my $child (@{ $conf ->{ children
}}) {
1432 next if ! defined ( $child ->{ section
});
1433 if ( $child ->{ section
} eq 'totem' ) {
1434 foreach my $e (@{ $child ->{ children
}}) {
1435 next if ! defined ( $e ->{ key
});
1436 if ( $e ->{ key
} eq 'config_version' ) {
1438 $e ->{ value
} = $new_value ;
1440 } elsif ( my $version = int ( $e ->{ value
})) {
1449 return undef if $noerr ;
1451 die "invalid corosync config - unable to read version \n " ;
1454 # read only - use "rename corosync.conf.new corosync.conf" to write
1455 PVE
:: Cluster
:: cfs_register_file
( 'corosync.conf' , \
& parse_corosync_conf
);
1456 # this is read/write
1457 PVE
:: Cluster
:: cfs_register_file
( 'corosync.conf.new' , \
& parse_corosync_conf
,
1458 \
& write_corosync_conf
);