[lml] 2 new revisions pushed by schl...@schapiro.org on 2011-12-27 15:54 GMT
l...@googlecode.com
Revision: d1cd6d6b3c33
Author: Schlomo Schapiro <l...@schlomo.schapiro.org>
Date: Tue Dec 27 07:45:01 2011
Log: * add new NETWORKING tree in VM data to represent network
configuratio...
http://code.google.com/p/lml/source/detail?r=d1cd6d6b3c33
Revision: 24bfbfa8d868
Author: Schlomo Schapiro <l...@schlomo.schapiro.org>
Date: Tue Dec 27 07:49:05 2011
Log: * new pxelinux.pl script that reads only the data for a single
VM. As ...
http://code.google.com/p/lml/source/detail?r=24bfbfa8d868
==============================================================================
Revision: d1cd6d6b3c33
Author: Schlomo Schapiro <l...@schlomo.schapiro.org>
Date: Tue Dec 27 07:45:01 2011
Log: * add new NETWORKING tree in VM data to represent network
configuration of VM.
This looks like this:
"42130272-a509-8010-6e85-4e01cb1b7284" => {
"NETWORKING" => [
{
"MAC"
=> "00:50:56:93:00:15",
"NETWORK"
=> "arc.int"
}
],
...
},
The purpose is to represent the order of network cards in the VM
* moved old pxelinux.pl to be the new maintenance script to be called by a
cron job
* add timestamps to vm.conf and lab.conf
* new VMware subroutine get_vm_data that reads only the data for a single
VM specified by UUID
The purpose is to optimize the execution time by readiny only the data
for the VM in question
and not the data for all VMs. As a result we cannot do
maintenance "on-the-fly" but need
a separate maintenance script.
http://code.google.com/p/lml/source/detail?r=d1cd6d6b3c33
Added:
/web/www/boot/lml/lml-maintenance.pl
Deleted:
/web/www/boot/lml/pxelinux.pl
Modified:
/web/www/boot/lml/README.TXT
/web/www/boot/lml/lib/LML/Common.pm
/web/www/boot/lml/lib/LML/VMware.pm
=======================================
--- /dev/null
+++ /web/www/boot/lml/lml-maintenance.pl Tue Dec 27 07:45:01 2011
@@ -0,0 +1,355 @@
+#!/usr/bin/perl
+#
+#
+# pxelinux.pl Lab Manager Lite pxelinux interface
+#
+# Authors:
+# GSS Schlomo Schapiro <l...@schlomo.schapiro.org>
+#
+# Copyright: Schlomo Schapiro, Immobilien Scout GmbH
+# License: GNU General Public License, see
http://www.gnu.org/licenses/gpl.txt for full text
+#
+#
+
+use strict;
+use warnings;
+
+
+# place DLLs and PMs with the required subdirectory structure into lib/
next to this script
+use FindBin;
+use lib "$FindBin::RealBin/lib";
+
+use CGI ':standard';
+use LML::Common;
+use LML::Subversion;
+use LML::VMware;
+
+# connect to vSphere
+connect_vi();
+
+# input parameter, UUID of a VM
+my $search_uuid=param('uuid')?param('uuid'):lc($ARGV[0]);
+
+# our URL base from REQUEST_URI
+my $base_url = url();
+$base_url =~ s/\/[^\/]+$//; # cheap basename()
+my $tftp_url = $base_url;
+$tftp_url =~ s/\/pxelinux.cfg.*$//; # strip trailing pxelinux.cfg
+
+my $vm_name="";
+my @error=();
+
+# get a complete dump from vSphere - this is expensive and takes some time
+my %VM = search_vm();
+
+# $LAB describes our internal view of the lab that lml manages
+# used mainly to react to renamed VMs or VMs with changed MAC adresses
+my $LAB={};
+if (-r "$CONFIG{lml}{datadir}/lab.conf") {
+ local $/=undef;
+ open(LAB_CONF,"<$CONFIG{lml}{datadir}/lab.conf") || die "Could not open
$CONFIG{lml}{datadir}/lab.conf";
+ flock(LAB_CONF, 1) || die;
+ binmode LAB_CONF;
+ eval <LAB_CONF> || die "Could not parse $CONFIG{lml}{datadir}/lab.conf";
+ close(LAB_CONF);
+} else {
+ # set up empty structure if our data file is missing
+ $LAB->{HOSTS} = {};
+}
+die '$LAB is empty' unless (scalar(%{$LAB}));
+
+# prepare some configuration variables
+#
+my @vsphere_networks=();
+if (exists($CONFIG{vsphere}{networks}) and $CONFIG{vsphere}{networks}) {
+ if (ref($CONFIG{vsphere}{networks})) {
+ @vsphere_networks=@{$CONFIG{vsphere}{networks}};
+ } else {
+ @vsphere_networks=($CONFIG{vsphere}{networks});
+ }
+}
+
+my $hosts_changed=0;
+
+# if there are VMs and if we find the VM we are looking for:
+if (scalar(keys(%VM)) and exists($VM{$search_uuid})) {
+ $vm_name=$VM{$search_uuid}{NAME};
+
+
+ # check if we should handle this VM
+ my @vm_lab_macs=();
+ if (@vsphere_networks and exists($VM{$search_uuid}{NETWORKING}) and
@{$VM{$search_uuid}{NETWORKING}}) {
+ # check for each MAC of the VM if the network name is in the list
+ for my $vm_network (@{$VM{$search_uuid}{NETWORKING}}) {
+ if (grep {$_ eq $vm_network->{NETWORK}} @vsphere_networks) {
+ push(@vm_lab_macs,$vm_network->{MAC});
+ }
+ }
+ if (! @vm_lab_macs) {
+ print header(-status=>"404 VM does not match LML networks and is out of
scope",-type=>'text/plain');
+ exit 0
+ }
+ }
+
+ # modify VM if configured and current setting not as it should be
(because the reconfigure VM task takes time)
+ if (exists($CONFIG{MODIFYVM}{FORCENETBOOT}) and
$CONFIG{MODIFYVM}{FORCENETBOOT} and
+ ( # either the setting is not set at all or it is set but not equal
to "allow:net"
+ not exists($VM{$search_uuid}{EXTRAOPTIONS}{'bios.bootDeviceClasses'}) or
+ not "$VM{$search_uuid}{EXTRAOPTIONS}{'bios.bootDeviceClasses'}"
eq "allow:net"
+ )
+ ) {
+
setVmExtraOptsM($VM{$search_uuid}{MO_REF},"bios.bootDeviceClasses","allow:net");
+ }
+ # check for FQDN in VM name
+ if ($vm_name =~ m/\./) {
+ push(@error,"FQDN not allowed in VM name");
+ }
+ if ($vm_name =~ m/ /) {
+ push(@error,"Spaces not allowed in VM name");
+ }
+ if ($vm_name ne lc($vm_name)) {
+ push(@error,"UpperCase letters not allowed in VM name");
+ }
+ # check VM name against pattern of allowed names
+ if (exists ($CONFIG{HOSTRULES}{PATTERN}) and $vm_name !~
$CONFIG{HOSTRULES}{PATTERN}) {
+ my $displaypattern=$CONFIG{HOSTRULES}{PATTERN};
+ $displaypattern =~ s/\^/^^/g;
+ push(@error,"VM name does not match '$displaypattern' pattern");
+ }
+ # check VM against forbidden DNS zones
+ if (exists ($CONFIG{HOSTRULES}{DNSCHECKZONES}) and
scalar(@{$CONFIG{HOSTRULES}{DNSCHECKZONES}})) {
+ for my $z (@{$CONFIG{HOSTRULES}{DNSCHECKZONES}}) {
+ if (scalar(gethostbyname($vm_name.".$z."))) {
+ push(@error,"Name conflict with '$vm_name.$z.'");
+ }
+ }
+ }
+ # check that contact ID is set to a valid UNIX user
+ if (exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}}) {
+ my
@pwnaminfo=getpwnam($VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}});
+ unless (@pwnaminfo and scalar(@pwnaminfo) and $pwnaminfo[2] >
$CONFIG{vsphere}{contactuserid_minuid}) {
+
push(@error,"$CONFIG{vsphere}{contactuserid_field} '".$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}}."'
does not exist");
+ }
+ } else {
+ push(@error,"Must set $CONFIG{vsphere}{contactuserid_field} to valid
username");
+ }
+ # check that expiry date is set and valid
+ if (exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}}) {
+ my $expires;
+ eval {
+
$expires=DateTime::Format::Flexible->parse_datetime($VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}} ,
+ european => ($CONFIG{vsphere}{expires_european}?1:0)
+ )
+ };
+ if ($@) {
+ push(@error,"Cannot parse $CONFIG{vsphere}{expires_field}
date '".$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}}."'");
+ } elsif (DateTime->compare(DateTime->now(),$expires) > 0 ) {
+ push(@error,"VM expired on ".$expires);
+ }
+ # implicit logic: If we got here without errors then the date is
parsable and in the future
+ } else {
+ push(@error,"Must set $CONFIG{vsphere}{expires_field} to valid date or
date/time");
+ }
+
+ # TODO: The following test fails to notice name conflicts against offline
machines that do not have a DNS records at the moment
+ # you might want to increase your lease time to counter this effect or
add some code to compare the new name against
+ # the list of known hostnames in $LAB
+ #
+ # if the host changed the name make sure that it does not conflict with
an existing name in our domain
+ if (exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME})) {
+ if (not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} and
+ scalar(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."))) {
+ #print STDERR
Dumper(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."));
+ push(@error,"Renamed VM name exists already
in '$CONFIG{DHCP}{APPENDDOMAIN}'");
+ }
+ } elsif (exists($CONFIG{HOSTRULES}{DNSCHECKNEW}) and
$CONFIG{HOSTRULES}{DNSCHECKNEW} and
+ scalar(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."))) {
+ # if this is a brand-new machine (e.g. we have no history of it) and new
VM checking is enabled
+ push(@error,"New VM name exists already
in '$CONFIG{DHCP}{APPENDDOMAIN}'");
+ }
+
+ # up till here we have only checks that verify the VM.
+ # in case of errors stop processing so that we do not create host records
anywhere as long
+ # as some conditions are unmet.
+
+ if (not scalar(@error)) {
+ # we only modify something if there are no errors
+
+ # check host-name directory existance in SVN if configured
+ if (exists($CONFIG{SUBVERSION}{HOSTDIRS}) and
$CONFIG{SUBVERSION}{HOSTDIRS}) {
+ # check if the host dir exists
+ my $newhostdir=$CONFIG{SUBVERSION}{HOSTDIRS}."/".$vm_name;
+ my $havehostdir=svnCheckPath($newhostdir);
+
+ # if CREATEHOSTDIRS is set, create missing host dirs
+ if (exists($CONFIG{SUBVERSION}{CREATEHOSTDIRS}) and
$CONFIG{SUBVERSION}{CREATEHOSTDIRS}) {
+ if ($havehostdir) {
+ # do nothing, be happy
+ } else {
+
+ # hostdir is missing, should we rename it from old
+ # putting all the conditions for a move into the same if saves us the
trouble
+ # of having several branches of logic leading to a copy :-(
+ if ( exists($CONFIG{SUBVERSION}{RENAMEHOSTDIRS}) and
$CONFIG{SUBVERSION}{RENAMEHOSTDIRS} and
+ exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
+ (not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
+
svnCheckPath($CONFIG{SUBVERSION}{HOSTDIRS}."/".$LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}))
{
+ if (not
svnMovePath($CONFIG{SUBVERSION}{HOSTDIRS}."/".$LAB->{HOSTS}->{$search_uuid}->{HOSTNAME},
+ $newhostdir)) {
+ push(@error,"Could not move old hostdir to new hostdir in SVN");
+ }
+ } else {
+ if (not svnCopyPath($CONFIG{SUBVERSION}{HOSTSKEL},$newhostdir)) {
+ push(@error,"Could not create hostdir in SVN");
+ }
+ }
+
+ }
+ } else {
+ # if we should not create the hostdirs, at least warn about missing
host dir
+ push(@error,"SVN hostdir '$newhostdir' missing");
+ }
+ } # hostdirs is set
+
+ # create HOSTS record for DHCP if it has changed (name or networking)
+ # ~~ compares array since perl 5.10!!
+ #
+ # NOTE: This should be after all other pieces of code that compare with
the old host name !!!
+ if (not (exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
exists($LAB->{HOSTS}->{$search_uuid}->{MACS})) or
+ not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} or
+ not @vm_lab_macs ~~ @{$LAB->{HOSTS}->{$search_uuid}->{MACS}} ) {
+ $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} = $vm_name;
+ $LAB->{HOSTS}->{$search_uuid}->{MACS} = \@vm_lab_macs;
+ $hosts_changed=1;
+ }
+ } # no errors in @error
+
+} # if have $VM{$search_uuid}
+
+# disconnect from VI
+Util::disconnect;
+
+# housekeeping
+# for each host in $LAB check that is exists in %VM and remove it if not
found.
+# this helps us to get rid of old entries after the VM has been removed.
+for my $uuid (keys(%{$LAB->{HOSTS}})) {
+ if (not exists($VM{$uuid})) {
+ delete $LAB->{HOSTS}->{$uuid};
+ # force creation of DHCP config
+ $hosts_changed++;
+ }
+}
+
+# dump %VM to file
+open(VM_CONF, ">$CONFIG{lml}{datadir}/vm.conf") || die "Could not
open '$CONFIG{lml}{datadir}/vm.conf' for writing";
+flock(VM_CONF, 2) || die;
+print VM_CONF "# ".POSIX::strftime("%Y-%m-%d %H:%M:%S\n",
localtime())."\n";
+print VM_CONF Data::Dumper->Dump([\%VM],[qw(VM)]);
+close(VM_CONF);
+
+# write dhcp-hosts.conf if it is configured and if we have host entries to
write
+if (exists($CONFIG{DHCP}{hostsfile}) and $CONFIG{DHCP}{hostsfile} and
$hosts_changed) {
+ my $dhcp_hosts="";
+ for my $u (keys(%{$LAB->{HOSTS}})) {
+ my $count=0;
+ # FIXME: Apparently sometimes we get a VM that has no MACS defined :-(
+ if (exists($LAB->{HOSTS}->{$u}->{MACS})) {
+ for my $m (sort(@{$LAB->{HOSTS}->{$u}->{MACS}})) {
+ $dhcp_hosts .= "host $u".($count>0?"-$count":"")." { \n";
+ $dhcp_hosts .= "\thardware ethernet $m;\n";
+ my $hostname = $LAB->{HOSTS}->{$u}->{HOSTNAME}.($count>0?"-$count":"");
+ $dhcp_hosts .= "\toption host-name
\"$hostname".(exists($CONFIG{dhcp}{appenddomain})?".".$CONFIG{dhcp}{appenddomain}:"")."\";\n";
+ # the following forces the dhcpd to update the DNS records even if the
client did NOT send a hostname!!!
+ # took me full day to figure that out :-(
+ $dhcp_hosts .= "\tddns-hostname \"$hostname\";\n";
+ $dhcp_hosts .= "\tfixed-address $LAB->{HOSTS}->{$u}->{IP};\n" if
(exists($LAB->{HOSTS}->{$u}->{IP}));
+ $dhcp_hosts .= $LAB->{HOSTS}->{$u}->{EXTRAOPTS}."\n" if
(exists($LAB->{HOSTS}->{$u}->{EXTRAOPTS}));
+ $dhcp_hosts .= "}\n\n";
+ $count++;
+ }
+ } else {
+ warn "No MACs found for VM ".$LAB->{HOSTS}->{$u}->{HOSTNAME}." ($u)\n";
+ warn
Data::Dumper->Dump([$LAB->{HOSTS}->{$u},$VM{$search_uuid}],[qw(LAB_HOSTS_uuid
VM_uuid)]);
+ }
+ }
+ open(DHCP_HOSTS,">$CONFIG{DHCP}{hostsfile}") || die "Could not
open '$CONFIG{DHCP}{hostsfile}' for writing";
+ flock(DHCP_HOSTS,2) || die;
+ print DHCP_HOSTS $dhcp_hosts;
+ close(DHCP_HOSTS);
+ # reload dhcp server
+ my $result = qx($CONFIG{DHCP}{TRIGGERCOMMAND} 2>&1);
+ if ($? > 0) {
+ warn "trigger command '$CONFIG{DHCP}{TRIGGERCOMMAND}' failed:\n$result";
+ push(@error,"Could not reload DHCP server, please call for help");
+ # FIXME: Rollback last change or something
+ }
+}
+
+
+if (scalar(@error)) {
+ # have some errors
+ print header('text/plain');
+ print join("\n",@{$CONFIG{pxelinux}{error_main}})."\n"; # multiline
values come as array
+ print "menu title ".$CONFIG{pxelinux}{error_title}." ".$vm_name."\n";
+ my $c=1;
+ foreach my $e (@error) {
+ print <<EOF;
+label l$c
+ menu label $c. $e
+EOF
+ print join("\n",@{$CONFIG{pxelinux}{error_item}})."\n";
+ $c++;
+ }
+} elsif ($vm_name) {
+ # if the VM is found and all is fine then redirect to default PXE
configuration
+
+ # dump $LAB to file only if all is fine. This makes sure that LML stays
with the old view of the lab for some kind of
+ # hard to catch errors.
+ open(LAB_CONF,">$CONFIG{lml}{datadir}/lab.conf") || die "Could not
open '$CONFIG{lml}{datadir}/lab.conf' for writing";
+ flock(LAB_CONF, 2) || die;
+ print LAB_CONF "# ".POSIX::strftime("%Y-%m-%d %H:%M:%S\n",
localtime())."\n";
+ print LAB_CONF Data::Dumper->Dump([$LAB],[qw(LAB)]);
+ close(LAB_CONF);
+
+ my $pxelinux_config_url;
+ my $bootinfo;
+ if ($CONFIG{pxelinux}{pxelinuxcfg_path} and
$CONFIG{vsphere}{forceboot_field} and
+ exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}} and
+ $VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}}
+ ) {
+ my
$forceboot=$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}};
+ # little exploit protection, could be done more professional :-)
+ $forceboot =~ s/\.{2,}//g; # remove any .. or ...
+ $forceboot =~ tr[:/A-Za-z0-9._-][]dc; # normalize to contain only valid
path characters
+ # if forceboot contains a path relative to the pxelinux TFTP prefix
+ if (-r $CONFIG{pxelinux}{pxelinuxcfg_path}."/".$forceboot) {
+ $pxelinux_config_url="$tftp_url/$forceboot";
+ $bootinfo="force boot from VM config (file)";
+ } elsif ($CONFIG{forceboot}{$forceboot}) {
+ $pxelinux_config_url=($CONFIG{forceboot}{$forceboot} =~
m(://)?"":$tftp_url."/").$CONFIG{forceboot}{$forceboot};
+ $bootinfo="force boot from LML config";
+ } elsif ($forceboot =~ m(://)) {
+ $pxelinux_config_url=$forceboot;
+ $bootinfo="force boot from VM config (URL)";
+ }
+ else {
+ warn("Invalid/Unknown force boot target '$forceboot' ignored");
+ }
+ }
+ $pxelinux_config_url=$base_url."/default" unless ($pxelinux_config_url);
+ $bootinfo="all is fine" unless ($bootinfo);
+ print header(-status=>"302 VM is $vm_name and
$bootinfo".($hosts_changed?", some hosts
changed":""),-type=>'text/plain',-location=>$pxelinux_config_url);
+} else {
+ # if the VM is not found then also give some error text
+ if (exists($CONFIG{PXELINUX}{REDIRECT_UNKNOWN_TO_DEFAULT}) and
$CONFIG{PXELINUX}{REDIRECT_UNKNOWN_TO_DEFAULT}) {
+ print header(-status=>'302 VM not
found',-type=>'text/plain',-location=>$base_url."/default");
+ } else {
+ print header(-status=>404,-type=>'text/plain');
+ }
+ print "Give UUID address as query parameter 'uuid' or as command line
parameter\n";
+ if ($search_uuid) {
+ print "No VM found for '$search_uuid'\n";
+ }
+}
+
+#print Data::Dumper->Dump([\%CONFIG,\%VM,$LAB],[qw(CONFIG VM LAB)]);
=======================================
--- /web/www/boot/lml/pxelinux.pl Mon Sep 26 09:21:09 2011
+++ /dev/null
@@ -1,350 +0,0 @@
-#!/usr/bin/perl
-#
-#
-# pxelinux.pl Lab Manager Lite pxelinux interface
-#
-# Authors:
-# GSS Schlomo Schapiro <l...@schlomo.schapiro.org>
-#
-# Copyright: Schlomo Schapiro, Immobilien Scout GmbH
-# License: GNU General Public License, see
http://www.gnu.org/licenses/gpl.txt for full text
-#
-#
-
-use strict;
-use warnings;
-
-
-# place DLLs and PMs with the required subdirectory structure into lib/
next to this script
-use FindBin;
-use lib "$FindBin::RealBin/lib";
-
-use CGI ':standard';
-use LML::Common;
-use LML::Subversion;
-use LML::VMware;
-
-# connect to vSphere
-connect_vi();
-
-# input parameter, UUID of a VM
-my $search_uuid=param('uuid')?param('uuid'):lc($ARGV[0]);
-
-# our URL base from REQUEST_URI
-my $base_url = url();
-$base_url =~ s/\/[^\/]+$//; # cheap basename()
-my $tftp_url = $base_url;
-$tftp_url =~ s/\/pxelinux.cfg.*$//; # strip trailing pxelinux.cfg
-
-my $vm_name="";
-my @error=();
-
-# get a complete dump from vSphere - this is expensive and takes some time
-my %VM = search_vm();
-
-# $LAB describes our internal view of the lab that lml manages
-# used mainly to react to renamed VMs or VMs with changed MAC adresses
-my $LAB={};
-if (-r "$CONFIG{lml}{datadir}/lab.conf") {
- local $/=undef;
- open(LAB_CONF,"<$CONFIG{lml}{datadir}/lab.conf") || die "Could not open
$CONFIG{lml}{datadir}/lab.conf";
- flock(LAB_CONF, 1) || die;
- binmode LAB_CONF;
- eval <LAB_CONF> || die "Could not parse $CONFIG{lml}{datadir}/lab.conf";
- close(LAB_CONF);
-} else {
- # set up empty structure if our data file is missing
- $LAB->{HOSTS} = {};
-}
-die '$LAB is empty' unless (scalar(%{$LAB}));
-
-my $hosts_changed=0;
-
-# if there are VMs and if we find the VM we are looking for:
-if (scalar(keys(%VM)) and exists($VM{$search_uuid})) {
- $vm_name=$VM{$search_uuid}{NAME};
-
- # check if we should handle this VM
- if (exists($CONFIG{vsphere}{networks}) and $CONFIG{vsphere}{networks}) {
- # check for each MAC of the VM if the network name is in the list
- my $match_network=0;
- my @vsphere_networks;
- if (ref($CONFIG{vsphere}{networks})) {
- @vsphere_networks=@{$CONFIG{vsphere}{networks}};
- } else {
- @vsphere_networks=($CONFIG{vsphere}{networks});
- }
- for my $network (values(%{$VM{$search_uuid}{MAC}})) {
- $match_network=$match_network || grep {$_ eq $network}
@vsphere_networks;
- }
- if (! $match_network) {
- print header(-status=>"404 VM does not match LML networks and is out of
scope",-type=>'text/plain');
- exit 0
- }
- }
-
- # check if the VM has more than one NIC on the managed network. This is
because we manage the network via DHCP
- # and there can be only one DHCP-assigned IP so far. ISC dhcpd also fails
if a host entry has more than one hardware address field.
- # TODO: decide and implement
-
- # modify VM if configured and current setting not as it should be
(because the reconfigure VM task takes time)
- if (exists($CONFIG{MODIFYVM}{FORCENETBOOT}) and
$CONFIG{MODIFYVM}{FORCENETBOOT} and
- ( # either the setting is not set at all or it is set but not equal
to "allow:net"
- not exists($VM{$search_uuid}{EXTRAOPTIONS}{'bios.bootDeviceClasses'}) or
- not "$VM{$search_uuid}{EXTRAOPTIONS}{'bios.bootDeviceClasses'}"
eq "allow:net"
- )
- ) {
-
setVmExtraOptsM($VM{$search_uuid}{MO_REF},"bios.bootDeviceClasses","allow:net");
- }
- # check for FQDN in VM name
- if ($vm_name =~ m/\./) {
- push(@error,"FQDN not allowed in VM name");
- }
- if ($vm_name =~ m/ /) {
- push(@error,"Spaces not allowed in VM name");
- }
- if ($vm_name ne lc($vm_name)) {
- push(@error,"UpperCase letters not allowed in VM name");
- }
- # check VM name against pattern of allowed names
- if (exists ($CONFIG{HOSTRULES}{PATTERN}) and $vm_name !~
$CONFIG{HOSTRULES}{PATTERN}) {
- my $displaypattern=$CONFIG{HOSTRULES}{PATTERN};
- $displaypattern =~ s/\^/^^/g;
- push(@error,"VM name does not match '$displaypattern' pattern");
- }
- # check VM against forbidden DNS zones
- if (exists ($CONFIG{HOSTRULES}{DNSCHECKZONES}) and
scalar(@{$CONFIG{HOSTRULES}{DNSCHECKZONES}})) {
- for my $z (@{$CONFIG{HOSTRULES}{DNSCHECKZONES}}) {
- if (scalar(gethostbyname($vm_name.".$z."))) {
- push(@error,"Name conflict with '$vm_name.$z.'");
- }
- }
- }
- # check that contact ID is set to a valid UNIX user
- if (exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}}) {
- my
@pwnaminfo=getpwnam($VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}});
- unless (@pwnaminfo and scalar(@pwnaminfo) and $pwnaminfo[2] >
$CONFIG{vsphere}{contactuserid_minuid}) {
-
push(@error,"$CONFIG{vsphere}{contactuserid_field} '".$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}}."'
does not exist");
- }
- } else {
- push(@error,"Must set $CONFIG{vsphere}{contactuserid_field} to valid
username");
- }
- # check that expiry date is set and valid
- if (exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}}) {
- my $expires;
- eval {
-
$expires=DateTime::Format::Flexible->parse_datetime($VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}} ,
- european => ($CONFIG{vsphere}{expires_european}?1:0)
- )
- };
- if ($@) {
- push(@error,"Cannot parse $CONFIG{vsphere}{expires_field}
date '".$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}}."'");
- } elsif (DateTime->compare(DateTime->now(),$expires) > 0 ) {
- push(@error,"VM expired on ".$expires);
- }
- # implicit logic: If we got here without errors then the date is
parsable and in the future
- } else {
- push(@error,"Must set $CONFIG{vsphere}{expires_field} to valid date or
date/time");
- }
-
- # TODO: The following test fails to notice name conflicts against offline
machines that do not have a DNS records at the moment
- # you might want to increase your lease time to counter this effect or
add some code to compare the new name against
- # the list of known hostnames in $LAB
- #
- # if the host changed the name make sure that it does not conflict with
an existing name in our domain
- if (exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME})) {
- if (not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} and
- scalar(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."))) {
- #print STDERR
Dumper(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."));
- push(@error,"Renamed VM name exists already
in '$CONFIG{DHCP}{APPENDDOMAIN}'");
- }
- } elsif (exists($CONFIG{HOSTRULES}{DNSCHECKNEW}) and
$CONFIG{HOSTRULES}{DNSCHECKNEW} and
- scalar(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."))) {
- # if this is a brand-new machine (e.g. we have no history of it) and new
VM checking is enabled
- push(@error,"New VM name exists already
in '$CONFIG{DHCP}{APPENDDOMAIN}'");
- }
-
- # up till here we have only checks that verify the VM.
- # in case of errors stop processing so that we do not create host records
anywhere as long
- # as some conditions are unmet.
-
- if (not scalar(@error)) {
- # we only modify something if there are no errors
-
- # check host-name directory existance in SVN if configured
- if (exists($CONFIG{SUBVERSION}{HOSTDIRS}) and
$CONFIG{SUBVERSION}{HOSTDIRS}) {
- # check if the host dir exists
- my $newhostdir=$CONFIG{SUBVERSION}{HOSTDIRS}."/".$vm_name;
- my $havehostdir=svnCheckPath($newhostdir);
-
- # if CREATEHOSTDIRS is set, create missing host dirs
- if (exists($CONFIG{SUBVERSION}{CREATEHOSTDIRS}) and
$CONFIG{SUBVERSION}{CREATEHOSTDIRS}) {
- if ($havehostdir) {
- # do nothing, be happy
- } else {
-
- # hostdir is missing, should we rename it from old
- # putting all the conditions for a move into the same if saves us the
trouble
- # of having several branches of logic leading to a copy :-(
- if ( exists($CONFIG{SUBVERSION}{RENAMEHOSTDIRS}) and
$CONFIG{SUBVERSION}{RENAMEHOSTDIRS} and
- exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
- (not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
-
svnCheckPath($CONFIG{SUBVERSION}{HOSTDIRS}."/".$LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}))
{
- if (not
svnMovePath($CONFIG{SUBVERSION}{HOSTDIRS}."/".$LAB->{HOSTS}->{$search_uuid}->{HOSTNAME},
- $newhostdir)) {
- push(@error,"Could not move old hostdir to new hostdir in SVN");
- }
- } else {
- if (not svnCopyPath($CONFIG{SUBVERSION}{HOSTSKEL},$newhostdir)) {
- push(@error,"Could not create hostdir in SVN");
- }
- }
-
- }
- } else {
- # if we should not create the hostdirs, at least warn about missing
host dir
- push(@error,"SVN hostdir '$newhostdir' missing");
- }
- } # hostdirs is set
-
- # create HOSTS record for DHCP if it has changed
- # ~~ compares array since perl 5.10!!
- #
- # NOTE: This should be after all other pieces of code that compare with
the old host name !!!
- my @macs=keys(%{$VM{$search_uuid}{MAC}});
- if (not (exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
exists($LAB->{HOSTS}->{$search_uuid}->{MACS})) or
- not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} or
- not @macs ~~ @{$LAB->{HOSTS}->{$search_uuid}->{MACS}} ) {
- $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} = $vm_name;
- $LAB->{HOSTS}->{$search_uuid}->{MACS} = [ @macs ];
- $hosts_changed=1;
- }
- } # no errors in @error
-
-} # if have $VM{$search_uuid}
-
-# disconnect from VI
-Util::disconnect;
-
-# housekeeping
-# for each host in $LAB check that is exists in %VM and remove it if not
found.
-# this helps us to get rid of old entries after the VM has been removed.
-for my $uuid (keys(%{$LAB->{HOSTS}})) {
- if (not exists($VM{$uuid})) {
- delete $LAB->{HOSTS}->{$uuid};
- # force creation of DHCP config
- $hosts_changed++;
- }
-}
-
-# dump %VM to file
-open(VM_CONF, ">$CONFIG{lml}{datadir}/vm.conf") || die "Could not
open '$CONFIG{lml}{datadir}/vm.conf' for writing";
-flock(VM_CONF, 2) || die;
-print VM_CONF Data::Dumper->Dump([\%VM],[qw(VM)]);
-close(VM_CONF);
-
-# write dhcp-hosts.conf if it is configured and if we have host entries to
write
-if (exists($CONFIG{DHCP}{hostsfile}) and $CONFIG{DHCP}{hostsfile} and
$hosts_changed) {
- my $dhcp_hosts="";
- for my $u (keys(%{$LAB->{HOSTS}})) {
- my $count=0;
- # FIXME: Apparently sometimes we get a VM that has no MACS defined :-(
- if (exists($LAB->{HOSTS}->{$u}->{MACS})) {
- for my $m (sort(@{$LAB->{HOSTS}->{$u}->{MACS}})) {
- $dhcp_hosts .= "host $u".($count>0?"-$count":"")." { \n";
- $dhcp_hosts .= "\thardware ethernet $m;\n";
- my $hostname = $LAB->{HOSTS}->{$u}->{HOSTNAME}.($count>0?"-$count":"");
- $dhcp_hosts .= "\toption host-name
\"$hostname".(exists($CONFIG{dhcp}{appenddomain})?".".$CONFIG{dhcp}{appenddomain}:"")."\";\n";
- # the following forces the dhcpd to update the DNS records even if the
client did NOT send a hostname!!!
- # took me full day to figure that out :-(
- $dhcp_hosts .= "\tddns-hostname \"$hostname\";\n";
- $dhcp_hosts .= "\tfixed-address $LAB->{HOSTS}->{$u}->{IP};\n" if
(exists($LAB->{HOSTS}->{$u}->{IP}));
- $dhcp_hosts .= $LAB->{HOSTS}->{$u}->{EXTRAOPTS}."\n" if
(exists($LAB->{HOSTS}->{$u}->{EXTRAOPTS}));
- $dhcp_hosts .= "}\n\n";
- $count++;
- }
- } else {
- warn "No MACs found for VM $LAB->{HOSTS}->{$u}->{HOSTNAME} ($u)\n";
- warn
Data::Dumper->Dump([$LAB->{HOSTS}->{$u},$VM{$search_uuid}],[qw(LAB_HOSTS_uuid
VM_uuid)]);
- }
- }
- open(DHCP_HOSTS,">$CONFIG{DHCP}{hostsfile}") || die "Could not
open '$CONFIG{DHCP}{hostsfile}' for writing";
- flock(DHCP_HOSTS,2) || die;
- print DHCP_HOSTS $dhcp_hosts;
- close(DHCP_HOSTS);
- # reload dhcp server
- my $result = qx($CONFIG{DHCP}{TRIGGERCOMMAND} 2>&1);
- if ($? > 0) {
- warn "trigger command '$CONFIG{DHCP}{TRIGGERCOMMAND}' failed:\n$result";
- push(@error,"Could not reload DHCP server, please call for help");
- # FIXME: Rollback last change or something
- }
-}
-
-
-if (scalar(@error)) {
- # have some errors
- print header('text/plain');
- print join("\n",@{$CONFIG{pxelinux}{error_main}})."\n"; # multiline
values come as array
- print "menu title ".$CONFIG{pxelinux}{error_title}." ".$vm_name."\n";
- my $c=1;
- foreach my $e (@error) {
- print <<EOF;
-label l$c
- menu label $c. $e
-EOF
- print join("\n",@{$CONFIG{pxelinux}{error_item}})."\n";
- $c++;
- }
-} elsif ($vm_name) {
- # if the VM is found and all is fine then redirect to default PXE
configuration
-
- # dump $LAB to file only if all is fine. This makes sure that LML stays
with the old view of the lab for some kind of
- # hard to catch errors.
- open(LAB_CONF,">$CONFIG{lml}{datadir}/lab.conf") || die "Could not
open '$CONFIG{lml}{datadir}/lab.conf' for writing";
- flock(LAB_CONF, 2) || die;
- print LAB_CONF Data::Dumper->Dump([$LAB],[qw(LAB)]);
- close(LAB_CONF);
-
- my $pxelinux_config_url;
- my $bootinfo;
- if ($CONFIG{pxelinux}{pxelinuxcfg_path} and
$CONFIG{vsphere}{forceboot_field} and
- exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}} and
- $VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}}
- ) {
- my
$forceboot=$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}};
- # little exploit protection, could be done more professional :-)
- $forceboot =~ s/\.{2,}//g; # remove any .. or ...
- $forceboot =~ tr[:/A-Za-z0-9._-][]dc; # normalize to contain only valid
path characters
- # if forceboot contains a path relative to the pxelinux TFTP prefix
- if (-r $CONFIG{pxelinux}{pxelinuxcfg_path}."/".$forceboot) {
- $pxelinux_config_url="$tftp_url/$forceboot";
- $bootinfo="force boot from VM config (file)";
- } elsif ($CONFIG{forceboot}{$forceboot}) {
- $pxelinux_config_url=($CONFIG{forceboot}{$forceboot} =~
m(://)?"":$tftp_url."/").$CONFIG{forceboot}{$forceboot};
- $bootinfo="force boot from LML config";
- } elsif ($forceboot =~ m(://)) {
- $pxelinux_config_url=$forceboot;
- $bootinfo="force boot from VM config (URL)";
- }
- else {
- warn("Invalid/Unknown force boot target '$forceboot' ignored");
- }
- }
- $pxelinux_config_url=$base_url."/default" unless ($pxelinux_config_url);
- $bootinfo="all is fine" unless ($bootinfo);
- print header(-status=>"302 VM is $vm_name and
$bootinfo".($hosts_changed?", some hosts
changed":""),-type=>'text/plain',-location=>$pxelinux_config_url);
-} else {
- # if the VM is not found then also give some error text
- if (exists($CONFIG{PXELINUX}{REDIRECT_UNKNOWN_TO_DEFAULT}) and
$CONFIG{PXELINUX}{REDIRECT_UNKNOWN_TO_DEFAULT}) {
- print header(-status=>'302 VM not
found',-type=>'text/plain',-location=>$base_url."/default");
- } else {
- print header(-status=>404,-type=>'text/plain');
- }
- print "Give UUID address as query parameter 'uuid' or as command line
parameter\n";
- if ($search_uuid) {
- print "No VM found for '$search_uuid'\n";
- }
-}
-
-#print Data::Dumper->Dump([\%CONFIG,\%VM,$LAB],[qw(CONFIG VM LAB)]);
=======================================
--- /web/www/boot/lml/README.TXT Wed May 4 06:36:09 2011
+++ /web/www/boot/lml/README.TXT Tue Dec 27 07:45:01 2011
@@ -1,7 +1,7 @@
Lab Manager Light (LML)
-----------------------------------------------
Author: Schlomo Schapiro <l...@schlomo.schapiro.org>
-Copyright 2010,2011 by Schlomo Schapiro, Immobilien Scout GmbH
+Copyright 2010-2012 by Schlomo Schapiro, Immobilien Scout GmbH
Licensed under the GNU General Public License, see accompanying LICENSE.TXT
and also the current version at http://www.gnu.org/licenses/gpl.txt.
=======================================
--- /web/www/boot/lml/lib/LML/Common.pm Tue Jul 12 02:42:50 2011
+++ /web/www/boot/lml/lib/LML/Common.pm Tue Dec 27 07:45:01 2011
@@ -38,6 +38,8 @@
use Config::IniFiles;
+use POSIX;
+
# open main config file case-insensitive
our %CONFIG;
tie %CONFIG, 'Config::IniFiles', (-file=>"/etc/lml.conf",-nocase=>1) or
die "Could not open '/etc/lml.conf'";
=======================================
--- /web/www/boot/lml/lib/LML/VMware.pm Tue Jul 12 02:42:50 2011
+++ /web/www/boot/lml/lib/LML/VMware.pm Tue Dec 27 07:45:01 2011
@@ -13,7 +13,7 @@
);
our $VERSION = 1.00;
our @ISA = qw(Exporter);
-our @EXPORT = qw(connect_vi search_vm custom_fields setVmExtraOptsU
setVmExtraOptsM);
+our @EXPORT = qw(connect_vi get_vm_data search_vm custom_fields
setVmExtraOptsU setVmExtraOptsM);
use VMware::VIRuntime;
@@ -96,10 +96,12 @@
"UUID" => $uuid,
# "DEVICES" => $vm->config->hardware,
};
+ my @vm_macs=();
foreach my $vm_dev (@{$vm->config->hardware->device}) {
if ($vm_dev->can("macAddress") and defined($vm_dev->macAddress)) {
if ($vm_dev->backing->can("deviceName")) {
- $VM{$uuid}{"MAC"}{$vm_dev->macAddress} = $vm_dev->backing->deviceName;
+
$VM{$uuid}{"MAC"}{$vm_dev->macAddress}=$vm_dev->backing->deviceName;
+ push(@vm_macs,{"MAC" => $vm_dev->macAddress, "NETWORK" =>
$vm_dev->backing->deviceName});
# print "MAC: ".$vm_dev->macAddress."\n";
} else {
# TODO: deal with Distributed Virtual Switch:
@@ -132,10 +134,15 @@
=cut
my $switchuuid=$vm_dev->backing->port->switchUuid;
my $portgroupkey=$vm_dev->backing->port->portgroupKey;
- $VM{$uuid}{"MAC"}{$vm_dev->macAddress} = Vim::get_view(mo_ref => new
ManagedObjectReference(type=>"DistributedVirtualPortgroup",value=>$portgroupkey))->config->name;
+ my $dv_name = Vim::get_view(mo_ref => new
ManagedObjectReference(type=>"DistributedVirtualPortgroup",value=>$portgroupkey))->config->name;
+ $VM{$uuid}{"MAC"}{$vm_dev->macAddress} = $dv_name;
+ push(@vm_macs,{"MAC" => $vm_dev->macAddress, "NETWORK" => $dv_name });
}
}
}
+ if (@vm_macs) {
+ $VM{$uuid}{"NETWORKING"}=\@vm_macs;
+ }
if ($vm->customValue) {
foreach my $value (@{$vm->customValue}) {
$VM{$uuid}{"CUSTOMFIELDS"}{$CUSTOMFIELDIDS{$value->key}}=$value->value;
@@ -285,7 +292,35 @@
return(%VM);
}
-
+################################ sub #################
+##
+## get_vm_data (<uuid>)
+##
+##
+##
+
+sub get_vm_data {
+ my $search_uuid = shift;
+ my $object = Vim::find_entity_view(view_type
=> 'VirtualMachine',filter => {'config.uuid' => $search_uuid});
+ # if this is an VM, handle it
+ if ($object and defined($object->config) and $object->can("config") ) {
+ if ($object->config->can("uuid")) {
+ # this seems to be a VM
+ handle_vm($object);
+ }
+ }
+ # print results
+ if ($Util::tracelevel > 1) {
+ foreach my $uuid (keys(%VM)) {
+ print("VM=$uuid\n");
+ foreach my $key (keys(%{ $VM{$uuid} } )) {
+ print("\t$key = $VM{$uuid}{$key}\n");
+ }
+ }
+ }
+
+ return(%VM);
+}
############################### sub #################
##
## setVmExtraOptsU (<uuid of VM>,<option key>,<option value>)
@@ -297,7 +332,7 @@
my $value = shift;
eval {
my $vm_view = Vim::find_entity_view(view_type => 'VirtualMachine',
- filter => {uuid =>
$uuid});
+ filter => {"config.uuid"
=> $uuid});
if($vm_view) {
my $vm_config_spec = VirtualMachineConfigSpec->new(
extraConfig =>
[OptionValue->new( key => $key, value => $value ),] );
==============================================================================
Revision: 24bfbfa8d868
Author: Schlomo Schapiro <l...@schlomo.schapiro.org>
Date: Tue Dec 27 07:49:05 2011
Log: * new pxelinux.pl script that reads only the data for a single
VM. As a result the VM boot
time remains constant regardless of the amount of VMs.
Addendum to the previous commit:
* lab.conf will now only receive MAC addresses that are actually connected
to the lab network
and not all MACs as previously. This fixes the bug where a host with
multiple NICs could get
a <hostname>-1 host name in the lab network even though it has only a
single NIC attached to
the lab network.
* The order of MAC addresses should be preserved so that the <hostname>,
<hostname>-1, <hostname>-2 ...
naming scheme should be in the same order as the NICs in the VM.
http://code.google.com/p/lml/source/detail?r=24bfbfa8d868
Added:
/web/www/boot/lml/pxelinux.pl
=======================================
--- /dev/null
+++ /web/www/boot/lml/pxelinux.pl Tue Dec 27 07:49:05 2011
@@ -0,0 +1,341 @@
+#!/usr/bin/perl
+#
+#
+# pxelinux.pl Lab Manager Lite pxelinux interface
+#
+# Authors:
+# GSS Schlomo Schapiro <l...@schlomo.schapiro.org>
+#
+# Copyright: Schlomo Schapiro, Immobilien Scout GmbH
+# License: GNU General Public License, see
http://www.gnu.org/licenses/gpl.txt for full text
+#
+#
+
+use strict;
+use warnings;
+
+
+# place DLLs and PMs with the required subdirectory structure into lib/
next to this script
+use FindBin;
+use lib "$FindBin::RealBin/lib";
+
+use CGI ':standard';
+use LML::Common;
+use LML::Subversion;
+use LML::VMware;
+
+# connect to vSphere
+connect_vi();
+
+# input parameter, UUID of a VM
+my $search_uuid=param('uuid')?param('uuid'):lc($ARGV[0]);
+
+# our URL base from REQUEST_URI
+my $base_url = url();
+$base_url =~ s/\/[^\/]+$//; # cheap basename()
+my $tftp_url = $base_url;
+$tftp_url =~ s/\/pxelinux.cfg.*$//; # strip trailing pxelinux.cfg
+
+my $vm_name="";
+my @error=();
+
+# get dump of single VM from vSphere
+my %VM = get_vm_data($search_uuid);
+#
+
+# $LAB describes our internal view of the lab that lml manages
+# used mainly to react to renamed VMs or VMs with changed MAC adresses
+my $LAB={};
+if (-r "$CONFIG{lml}{datadir}/lab.conf") {
+ local $/=undef;
+ open(LAB_CONF,"<$CONFIG{lml}{datadir}/lab.conf") || die "Could not open
$CONFIG{lml}{datadir}/lab.conf";
+ flock(LAB_CONF, 1) || die;
+ binmode LAB_CONF;
+ eval <LAB_CONF> || die "Could not parse $CONFIG{lml}{datadir}/lab.conf";
+ close(LAB_CONF);
+} else {
+ # set up empty structure if our data file is missing
+ $LAB->{HOSTS} = {};
+}
+die '$LAB is empty' unless (scalar(%{$LAB}));
+
+# prepare some configuration variables
+#
+my @vsphere_networks=();
+if (exists($CONFIG{vsphere}{networks}) and $CONFIG{vsphere}{networks}) {
+ if (ref($CONFIG{vsphere}{networks})) {
+ @vsphere_networks=@{$CONFIG{vsphere}{networks}};
+ } else {
+ @vsphere_networks=($CONFIG{vsphere}{networks});
+ }
+}
+
+my $hosts_changed=0;
+
+# if there are VMs and if we find the VM we are looking for:
+if (scalar(keys(%VM)) and exists($VM{$search_uuid})) {
+ $vm_name=$VM{$search_uuid}{NAME};
+
+
+ # check if we should handle this VM
+ my @vm_lab_macs=();
+ if (@vsphere_networks and exists($VM{$search_uuid}{NETWORKING}) and
@{$VM{$search_uuid}{NETWORKING}}) {
+ # check for each MAC of the VM if the network name is in the list
+ for my $vm_network (@{$VM{$search_uuid}{NETWORKING}}) {
+ if (grep {$_ eq $vm_network->{NETWORK}} @vsphere_networks) {
+ push(@vm_lab_macs,$vm_network->{MAC});
+ }
+ }
+ if (! @vm_lab_macs) {
+ print header(-status=>"404 VM does not match LML networks and is out of
scope",-type=>'text/plain');
+ Util::disconnect;
+ exit 0
+ }
+ }
+
+ # modify VM if configured and current setting not as it should be
(because the reconfigure VM task takes time)
+ if (exists($CONFIG{MODIFYVM}{FORCENETBOOT}) and
$CONFIG{MODIFYVM}{FORCENETBOOT} and
+ ( # either the setting is not set at all or it is set but not equal
to "allow:net"
+ not exists($VM{$search_uuid}{EXTRAOPTIONS}{'bios.bootDeviceClasses'}) or
+ not "$VM{$search_uuid}{EXTRAOPTIONS}{'bios.bootDeviceClasses'}"
eq "allow:net"
+ )
+ ) {
+
setVmExtraOptsM($VM{$search_uuid}{MO_REF},"bios.bootDeviceClasses","allow:net");
+ }
+ # check for FQDN in VM name
+ if ($vm_name =~ m/\./) {
+ push(@error,"FQDN not allowed in VM name");
+ }
+ if ($vm_name =~ m/ /) {
+ push(@error,"Spaces not allowed in VM name");
+ }
+ if ($vm_name ne lc($vm_name)) {
+ push(@error,"UpperCase letters not allowed in VM name");
+ }
+ # check VM name against pattern of allowed names
+ if (exists ($CONFIG{HOSTRULES}{PATTERN}) and $vm_name !~
$CONFIG{HOSTRULES}{PATTERN}) {
+ my $displaypattern=$CONFIG{HOSTRULES}{PATTERN};
+ $displaypattern =~ s/\^/^^/g;
+ push(@error,"VM name does not match '$displaypattern' pattern");
+ }
+ # check VM against forbidden DNS zones
+ if (exists ($CONFIG{HOSTRULES}{DNSCHECKZONES}) and
scalar(@{$CONFIG{HOSTRULES}{DNSCHECKZONES}})) {
+ for my $z (@{$CONFIG{HOSTRULES}{DNSCHECKZONES}}) {
+ if (scalar(gethostbyname($vm_name.".$z."))) {
+ push(@error,"Name conflict with '$vm_name.$z.'");
+ }
+ }
+ }
+ # check that contact ID is set to a valid UNIX user
+ if (exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}}) {
+ my
@pwnaminfo=getpwnam($VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}});
+ unless (@pwnaminfo and scalar(@pwnaminfo) and $pwnaminfo[2] >
$CONFIG{vsphere}{contactuserid_minuid}) {
+
push(@error,"$CONFIG{vsphere}{contactuserid_field} '".$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{contactuserid_field}}."'
does not exist");
+ }
+ } else {
+ push(@error,"Must set $CONFIG{vsphere}{contactuserid_field} to valid
username");
+ }
+ # check that expiry date is set and valid
+ if (exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}}) {
+ my $expires;
+ eval {
+
$expires=DateTime::Format::Flexible->parse_datetime($VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}} ,
+ european => ($CONFIG{vsphere}{expires_european}?1:0)
+ )
+ };
+ if ($@) {
+ push(@error,"Cannot parse $CONFIG{vsphere}{expires_field}
date '".$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{expires_field}}."'");
+ } elsif (DateTime->compare(DateTime->now(),$expires) > 0 ) {
+ push(@error,"VM expired on ".$expires);
+ }
+ # implicit logic: If we got here without errors then the date is
parsable and in the future
+ } else {
+ push(@error,"Must set $CONFIG{vsphere}{expires_field} to valid date or
date/time");
+ }
+
+ # TODO: The following test fails to notice name conflicts against offline
machines that do not have a DNS records at the moment
+ # you might want to increase your lease time to counter this effect or
add some code to compare the new name against
+ # the list of known hostnames in $LAB
+ #
+ # if the host changed the name make sure that it does not conflict with
an existing name in our domain
+ if (exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME})) {
+ if (not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} and
+ scalar(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."))) {
+ #print STDERR
Dumper(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."));
+ push(@error,"Renamed VM name exists already
in '$CONFIG{DHCP}{APPENDDOMAIN}'");
+ }
+ } elsif (exists($CONFIG{HOSTRULES}{DNSCHECKNEW}) and
$CONFIG{HOSTRULES}{DNSCHECKNEW} and
+ scalar(gethostbyname($vm_name.".".$CONFIG{DHCP}{APPENDDOMAIN}."."))) {
+ # if this is a brand-new machine (e.g. we have no history of it) and new
VM checking is enabled
+ push(@error,"New VM name exists already
in '$CONFIG{DHCP}{APPENDDOMAIN}'");
+ }
+
+ # up till here we have only checks that verify the VM.
+ # in case of errors stop processing so that we do not create host records
anywhere as long
+ # as some conditions are unmet.
+
+ if (not scalar(@error)) {
+ # we only modify something if there are no errors
+
+ # check host-name directory existance in SVN if configured
+ if (exists($CONFIG{SUBVERSION}{HOSTDIRS}) and
$CONFIG{SUBVERSION}{HOSTDIRS}) {
+ # check if the host dir exists
+ my $newhostdir=$CONFIG{SUBVERSION}{HOSTDIRS}."/".$vm_name;
+ my $havehostdir=svnCheckPath($newhostdir);
+
+ # if CREATEHOSTDIRS is set, create missing host dirs
+ if (exists($CONFIG{SUBVERSION}{CREATEHOSTDIRS}) and
$CONFIG{SUBVERSION}{CREATEHOSTDIRS}) {
+ if ($havehostdir) {
+ # do nothing, be happy
+ } else {
+
+ # hostdir is missing, should we rename it from old
+ # putting all the conditions for a move into the same if saves us the
trouble
+ # of having several branches of logic leading to a copy :-(
+ if ( exists($CONFIG{SUBVERSION}{RENAMEHOSTDIRS}) and
$CONFIG{SUBVERSION}{RENAMEHOSTDIRS} and
+ exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
+ (not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
+
svnCheckPath($CONFIG{SUBVERSION}{HOSTDIRS}."/".$LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}))
{
+ if (not
svnMovePath($CONFIG{SUBVERSION}{HOSTDIRS}."/".$LAB->{HOSTS}->{$search_uuid}->{HOSTNAME},
+ $newhostdir)) {
+ push(@error,"Could not move old hostdir to new hostdir in SVN");
+ }
+ } else {
+ if (not svnCopyPath($CONFIG{SUBVERSION}{HOSTSKEL},$newhostdir)) {
+ push(@error,"Could not create hostdir in SVN");
+ }
+ }
+
+ }
+ } else {
+ # if we should not create the hostdirs, at least warn about missing
host dir
+ push(@error,"SVN hostdir '$newhostdir' missing");
+ }
+ } # hostdirs is set
+
+ # create HOSTS record for DHCP if it has changed (name or networking)
+ # ~~ compares array since perl 5.10!!
+ #
+ # NOTE: This should be after all other pieces of code that compare with
the old host name !!!
+ if (not (exists($LAB->{HOSTS}->{$search_uuid}->{HOSTNAME}) and
exists($LAB->{HOSTS}->{$search_uuid}->{MACS})) or
+ not $vm_name eq $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} or
+ not @vm_lab_macs ~~ @{$LAB->{HOSTS}->{$search_uuid}->{MACS}} ) {
+ $LAB->{HOSTS}->{$search_uuid}->{HOSTNAME} = $vm_name;
+ $LAB->{HOSTS}->{$search_uuid}->{MACS} = \@vm_lab_macs;
+ $hosts_changed=1;
+ }
+ } # no errors in @error
+
+} # if have $VM{$search_uuid}
+
+# disconnect from VI
+Util::disconnect;
+
+# housekeeping needs to be in own script. This script has only the scope
of a single VM.
+
+# write dhcp-hosts.conf if it is configured and if we have host entries to
write
+if (exists($CONFIG{DHCP}{hostsfile}) and $CONFIG{DHCP}{hostsfile} and
$hosts_changed) {
+ my $dhcp_hosts="";
+ for my $u (keys(%{$LAB->{HOSTS}})) {
+ my $count=0;
+ # FIXME: Apparently sometimes we get a VM that has no MACS defined :-(
+ if (exists($LAB->{HOSTS}->{$u}->{MACS})) {
+ for my $m (sort(@{$LAB->{HOSTS}->{$u}->{MACS}})) {
+ $dhcp_hosts .= "host $u".($count>0?"-$count":"")." { \n";
+ $dhcp_hosts .= "\thardware ethernet $m;\n";
+ my $hostname = $LAB->{HOSTS}->{$u}->{HOSTNAME}.($count>0?"-$count":"");
+ $dhcp_hosts .= "\toption host-name
\"$hostname".(exists($CONFIG{dhcp}{appenddomain})?".".$CONFIG{dhcp}{appenddomain}:"")."\";\n";
+ # the following forces the dhcpd to update the DNS records even if the
client did NOT send a hostname!!!
+ # took me full day to figure that out :-(
+ $dhcp_hosts .= "\tddns-hostname \"$hostname\";\n";
+ $dhcp_hosts .= "\tfixed-address $LAB->{HOSTS}->{$u}->{IP};\n" if
(exists($LAB->{HOSTS}->{$u}->{IP}));
+ $dhcp_hosts .= $LAB->{HOSTS}->{$u}->{EXTRAOPTS}."\n" if
(exists($LAB->{HOSTS}->{$u}->{EXTRAOPTS}));
+ $dhcp_hosts .= "}\n\n";
+ $count++;
+ }
+ } else {
+ warn "No MACs found for VM ".$LAB->{HOSTS}->{$u}->{HOSTNAME}." ($u)\n";
+ warn
Data::Dumper->Dump([$LAB->{HOSTS}->{$u},$VM{$search_uuid}],[qw(LAB_HOSTS_uuid
VM_uuid)]);
+ }
+ }
+ open(DHCP_HOSTS,">$CONFIG{DHCP}{hostsfile}") || die "Could not
open '$CONFIG{DHCP}{hostsfile}' for writing";
+ flock(DHCP_HOSTS,2) || die;
+ print DHCP_HOSTS $dhcp_hosts;
+ close(DHCP_HOSTS);
+ # reload dhcp server
+ my $result = qx($CONFIG{DHCP}{TRIGGERCOMMAND} 2>&1);
+ if ($? > 0) {
+ warn "trigger command '$CONFIG{DHCP}{TRIGGERCOMMAND}' failed:\n$result";
+ push(@error,"Could not reload DHCP server, please call for help");
+ # FIXME: Rollback last change or something
+ }
+}
+
+
+if (scalar(@error)) {
+ # have some errors
+ print header('text/plain');
+ print join("\n",@{$CONFIG{pxelinux}{error_main}})."\n"; # multiline
values come as array
+ print "menu title ".$CONFIG{pxelinux}{error_title}." ".$vm_name."\n";
+ my $c=1;
+ foreach my $e (@error) {
+ print <<EOF;
+label l$c
+ menu label $c. $e
+EOF
+ print join("\n",@{$CONFIG{pxelinux}{error_item}})."\n";
+ $c++;
+ }
+} elsif ($vm_name) {
+ # if the VM is found and all is fine then redirect to default PXE
configuration
+
+ # dump $LAB to file only if all is fine. This makes sure that LML stays
with the old view of the lab for some kind of
+ # hard to catch errors.
+ open(LAB_CONF,">$CONFIG{lml}{datadir}/lab.conf") || die "Could not
open '$CONFIG{lml}{datadir}/lab.conf' for writing";
+ flock(LAB_CONF, 2) || die;
+ print LAB_CONF "# ".POSIX::strftime("%Y-%m-%d %H:%M:%S\n",
localtime())."\n";
+ print LAB_CONF Data::Dumper->Dump([$LAB],[qw(LAB)]);
+ close(LAB_CONF);
+
+ my $pxelinux_config_url;
+ my $bootinfo;
+ if ($CONFIG{pxelinux}{pxelinuxcfg_path} and
$CONFIG{vsphere}{forceboot_field} and
+ exists
$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}} and
+ $VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}}
+ ) {
+ my
$forceboot=$VM{$search_uuid}{CUSTOMFIELDS}{$CONFIG{vsphere}{forceboot_field}};
+ # little exploit protection, could be done more professional :-)
+ $forceboot =~ s/\.{2,}//g; # remove any .. or ...
+ $forceboot =~ tr[:/A-Za-z0-9._-][]dc; # normalize to contain only valid
path characters
+ # if forceboot contains a path relative to the pxelinux TFTP prefix
+ if (-r $CONFIG{pxelinux}{pxelinuxcfg_path}."/".$forceboot) {
+ $pxelinux_config_url="$tftp_url/$forceboot";
+ $bootinfo="force boot from VM config (file)";
+ } elsif ($CONFIG{forceboot}{$forceboot}) {
+ $pxelinux_config_url=($CONFIG{forceboot}{$forceboot} =~
m(://)?"":$tftp_url."/").$CONFIG{forceboot}{$forceboot};
+ $bootinfo="force boot from LML config";
+ } elsif ($forceboot =~ m(://)) {
+ $pxelinux_config_url=$forceboot;
+ $bootinfo="force boot from VM config (URL)";
+ }
+ else {
+ warn("Invalid/Unknown force boot target '$forceboot' ignored");
+ }
+ }
+ $pxelinux_config_url=$base_url."/default" unless ($pxelinux_config_url);
+ $bootinfo="all is fine" unless ($bootinfo);
+ print header(-status=>"302 VM is $vm_name and
$bootinfo".($hosts_changed?", some hosts
changed":""),-type=>'text/plain',-location=>$pxelinux_config_url);
+} else {
+ # if the VM is not found then also give some error text
+ if (exists($CONFIG{PXELINUX}{REDIRECT_UNKNOWN_TO_DEFAULT}) and
$CONFIG{PXELINUX}{REDIRECT_UNKNOWN_TO_DEFAULT}) {
+ print header(-status=>'302 VM not
found',-type=>'text/plain',-location=>$base_url."/default");
+ } else {
+ print header(-status=>404,-type=>'text/plain');
+ }
+ print "Give UUID address as query parameter 'uuid' or as command line
parameter\n";
+ if ($search_uuid) {
+ print "No VM found for '$search_uuid'\n";
+ }
+}
+
+#print Data::Dumper->Dump([\%CONFIG,\%VM,$LAB],[qw(CONFIG VM LAB)]);