| 1 |
95b003ff
|
Origo
|
#!/usr/bin/perl
|
| 2 |
|
|
|
| 3 |
|
|
# All rights reserved and Copyright (c) 2020 Origo Systems ApS.
|
| 4 |
|
|
# This file is provided with no warranty, and is subject to the terms and conditions defined in the license file LICENSE.md.
|
| 5 |
|
|
# The license file is part of this source code package and its content is also available at:
|
| 6 |
|
|
# https://www.origo.io/info/stabiledocs/licensing/stabile-open-source-license
|
| 7 |
|
|
|
| 8 |
|
|
package Stabile::Servers;
|
| 9 |
|
|
|
| 10 |
|
|
use Error qw(:try);
|
| 11 |
|
|
use Data::UUID;
|
| 12 |
|
|
use Proc::Daemon;
|
| 13 |
|
|
use File::Basename;
|
| 14 |
|
|
use lib dirname (__FILE__);
|
| 15 |
|
|
use File::Basename;
|
| 16 |
|
|
use lib dirname (__FILE__);
|
| 17 |
|
|
use Stabile;
|
| 18 |
|
|
#use Encode::Escape;
|
| 19 |
|
|
|
| 20 |
|
|
$\ = ''; # Some of the above seems to set this to \n, resulting in every print appending a line feed
|
| 21 |
|
|
|
| 22 |
|
|
$cpuovercommision = $Stabile::config->get('CPU_OVERCOMMISION') || 1;
|
| 23 |
|
|
$dpolicy = $Stabile::config->get('DISTRIBUTION_POLICY') || 'disperse'; #"disperse" or "pack"
|
| 24 |
|
|
$amtpasswd = $Stabile::config->get('AMT_PASSWD') || "";
|
| 25 |
|
|
$brutalsleep = $Stabile::config->get('BRUTAL_SLEEP') || "";
|
| 26 |
|
|
$sshcmd = $sshcmd || $Stabile::sshcmd;
|
| 27 |
|
|
|
| 28 |
|
|
my %ahash; # A hash of accounts and associated privileges current user has access to
|
| 29 |
|
|
|
| 30 |
|
|
#my %options=();
|
| 31 |
|
|
#Getopt::Std::getopts("a:hfu:m:k:", \%options); # -a action -h help -f full-list (all users) -u uuid -m match pattern -k keywords
|
| 32 |
|
|
|
| 33 |
|
|
try {
|
| 34 |
|
|
Init(); # Perform various initalization tasks
|
| 35 |
|
|
process() if ($package);
|
| 36 |
|
|
|
| 37 |
|
|
if ($action || %params) {
|
| 38 |
|
|
untie %register;
|
| 39 |
|
|
untie %networkreg;
|
| 40 |
|
|
untie %nodereg;
|
| 41 |
|
|
untie %xmlreg;
|
| 42 |
|
|
}
|
| 43 |
|
|
|
| 44 |
|
|
} catch Error with {
|
| 45 |
|
|
my $ex = shift;
|
| 46 |
|
|
print $Stabile::q->header('text/html', '500 Internal Server Error') unless ($console);
|
| 47 |
|
|
if ($ex->{-text}) {
|
| 48 |
|
|
print "Got error: ", $ex->{-text}, " on line ", $ex->{-line}, "\n";
|
| 49 |
|
|
} else {
|
| 50 |
|
|
print "Status=ERROR\n";
|
| 51 |
|
|
}
|
| 52 |
|
|
} finally {
|
| 53 |
|
|
};
|
| 54 |
|
|
|
| 55 |
|
|
1;
|
| 56 |
|
|
|
| 57 |
|
|
sub getObj {
|
| 58 |
|
|
my %h = %{@_[0]};
|
| 59 |
|
|
$console = 1 if $h{"console"};
|
| 60 |
|
|
$api = 1 if $h{"api"};
|
| 61 |
|
|
my $uuid = $h{"uuid"};
|
| 62 |
|
|
$uuid = $curuuid if ($uuid eq 'this');
|
| 63 |
|
|
my $obj;
|
| 64 |
c899e439
|
Origo
|
$action = $action || $h{'action'};
|
| 65 |
|
|
|
| 66 |
6372a66e
|
hq
|
if ($h{'action'} eq 'destroy' || $action eq 'destroy' || $action eq 'destroyuserservers' || $action eq 'attach' || $action eq 'detach' || $action =~ /changepassword|sshaccess/) {
|
| 67 |
95b003ff
|
Origo
|
$obj = \%h;
|
| 68 |
|
|
return $obj;
|
| 69 |
|
|
}
|
| 70 |
|
|
|
| 71 |
|
|
# Allow specifying nicmac1 instead of uuid if known
|
| 72 |
|
|
if (!$uuid) {
|
| 73 |
|
|
$uuid = nicmac1ToUuid($h{"nicmac1"});
|
| 74 |
|
|
}
|
| 75 |
|
|
my $status = 'new';
|
| 76 |
|
|
$status = $register{$uuid}->{'status'} if ($register{$uuid});
|
| 77 |
|
|
|
| 78 |
|
|
my $objaction = lc $h{"action"};
|
| 79 |
|
|
$objaction = "" if ($status eq "new");
|
| 80 |
|
|
|
| 81 |
|
|
if ((!$uuid) && $status eq 'new') {
|
| 82 |
|
|
my $ug = new Data::UUID;
|
| 83 |
|
|
$uuid = $ug->create_str();
|
| 84 |
|
|
if ($uripath =~ /servers(\.cgi)?\/(.+)/) {
|
| 85 |
|
|
my $huuid = $2;
|
| 86 |
|
|
if ($ug->to_string($ug->from_string($huuid)) eq $huuid) { # Check for valid uuid
|
| 87 |
|
|
$uuid = $huuid;
|
| 88 |
|
|
}
|
| 89 |
|
|
}
|
| 90 |
|
|
};
|
| 91 |
|
|
unless ($uuid && length $uuid == 36) {
|
| 92 |
|
|
$posterror .= "Status=Error Invalid uuid.\n";
|
| 93 |
|
|
return;
|
| 94 |
|
|
}
|
| 95 |
|
|
|
| 96 |
|
|
my $dbobj = $register{$uuid} || {};
|
| 97 |
|
|
|
| 98 |
|
|
my $name = $h{"name"} || $dbobj->{'name'};
|
| 99 |
|
|
utf8::decode($name);
|
| 100 |
|
|
my $memory = $h{"memory"} || $dbobj->{'memory'};
|
| 101 |
|
|
my $vcpu = $h{"vcpu"} || $dbobj->{'vcpu'};
|
| 102 |
|
|
my $boot = $h{"boot"} || $dbobj->{'boot'};
|
| 103 |
04c16f26
|
hq
|
my $loader = $h{"loader"} || $dbobj->{'loader'};
|
| 104 |
95b003ff
|
Origo
|
my $image = $h{"image"} || $dbobj->{'image'};
|
| 105 |
|
|
my $imagename = $h{"imagename"} || $dbobj->{'imagename'};
|
| 106 |
|
|
if ($image && $image ne '--' && !($image =~ /^\//)) { # Image is registered by uuid - we find the path
|
| 107 |
|
|
unless ( tie(%imagereg2,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {$posterror = "Unable to access image uuid register"; return;};
|
| 108 |
|
|
$image = $imagereg2{$image}->{'path'};
|
| 109 |
|
|
$imagename = $imagereg2{$image}->{'name'};
|
| 110 |
|
|
untie %imagereg2;
|
| 111 |
|
|
return unless ($image);
|
| 112 |
|
|
}
|
| 113 |
|
|
my $image2 = $h{"image2"} || $dbobj->{'image2'};
|
| 114 |
|
|
my $image3 = $h{"image3"} || $dbobj->{'image3'};
|
| 115 |
|
|
my $image4 = $h{"image4"} || $dbobj->{'image4'};
|
| 116 |
|
|
my $image2name = $h{"image2name"} || $dbobj->{'image2name'};
|
| 117 |
|
|
my $image3name = $h{"image3name"} || $dbobj->{'image3name'};
|
| 118 |
|
|
my $image4name = $h{"image4name"} || $dbobj->{'image4name'};
|
| 119 |
|
|
if ($image2 && $image2 ne '--' && !($image2 =~ /^\//)) { # Image2 is registered by uuid - we find the path
|
| 120 |
|
|
unless ( tie(%imagereg2,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {$postreply = "Unable to access image uuid register"; return $postreply;};
|
| 121 |
|
|
$image2 = $imagereg2{$image2}->{'path'};
|
| 122 |
|
|
$image2name = $imagereg2{$image2}->{'name'};
|
| 123 |
|
|
untie %imagereg2;
|
| 124 |
|
|
}
|
| 125 |
|
|
my $diskbus = $h{"diskbus"} || $dbobj->{'diskbus'};
|
| 126 |
|
|
my $diskdev = "vda";
|
| 127 |
|
|
my $diskdev2 = "vdb";
|
| 128 |
|
|
my $diskdev3 = "vdc";
|
| 129 |
|
|
my $diskdev4 = "vdd";
|
| 130 |
|
|
if ($diskbus eq "ide") {$diskdev = "hda"; $diskdev2 = "hdb"; $diskdev3 = "hdc"; $diskdev4 = "hdd"};
|
| 131 |
|
|
my $cdrom = $h{"cdrom"} || $dbobj->{'cdrom'};
|
| 132 |
04c16f26
|
hq
|
if ($cdrom && $cdrom ne '--' && !($cdrom =~ /^\//) && $cdrom ne 'virtio') {
|
| 133 |
95b003ff
|
Origo
|
unless ( tie(%imagereg2,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {$postreply = "Unable to access image uuid register"; return $postreply;};
|
| 134 |
|
|
$cdrom = $imagereg2{$cdrom}->{'path'};
|
| 135 |
|
|
untie %imagereg2;
|
| 136 |
|
|
}
|
| 137 |
|
|
|
| 138 |
|
|
my $networkuuid1 = $h{"networkuuid1"} || $dbobj->{'networkuuid1'};
|
| 139 |
|
|
if ($h{"networkuuid1"} eq "0") {$networkuuid1 = "0"}; #Stupid perl... :-)
|
| 140 |
|
|
my $networkid1 = $h{"networkid1"} || $dbobj->{'networkid1'};
|
| 141 |
|
|
my $networkname1 = $h{"networkname1"} || $dbobj->{'networkname1'};
|
| 142 |
|
|
my $nicmodel1 = $h{"nicmodel1"} || $dbobj->{'nicmodel1'};
|
| 143 |
|
|
my $nicmac1 = $h{"nicmac1"} || $dbobj->{'nicmac1'};
|
| 144 |
|
|
if (!$nicmac1 || $nicmac1 eq "--") {$nicmac1 = randomMac();}
|
| 145 |
|
|
|
| 146 |
|
|
my $networkuuid2 = $h{"networkuuid2"} || $dbobj->{'networkuuid2'};
|
| 147 |
|
|
if ($h{"networkuuid2"} eq "0") {$networkuuid2 = "0"};
|
| 148 |
|
|
my $networkid2 = $h{"networkid2"} || $dbobj->{'networkid2'};
|
| 149 |
|
|
my $networkname2 = $h{"networkname2"} || $dbobj->{'networkname2'};
|
| 150 |
|
|
my $nicmac2 = $h{"nicmac2"} || $dbobj->{'nicmac2'};
|
| 151 |
|
|
if (!$nicmac2 || $nicmac2 eq "--") {$nicmac2 = randomMac();}
|
| 152 |
|
|
|
| 153 |
|
|
my $networkuuid3 = $h{"networkuuid3"} || $dbobj->{'networkuuid3'};
|
| 154 |
|
|
if ($h{"networkuuid3"} eq "0") {$networkuuid3 = "0"};
|
| 155 |
|
|
my $networkid3 = $h{"networkid3"} || $dbobj->{'networkid3'};
|
| 156 |
|
|
my $networkname3 = $h{"networkname3"} || $dbobj->{'networkname3'};
|
| 157 |
|
|
my $nicmac3 = $h{"nicmac3"} || $dbobj->{'nicmac3'};
|
| 158 |
|
|
if (!$nicmac3 || $nicmac3 eq "--") {$nicmac3 = randomMac();}
|
| 159 |
|
|
|
| 160 |
|
|
my $action = $h{"action"};
|
| 161 |
|
|
my $notes = $h{"notes"};
|
| 162 |
|
|
$notes = $dbobj->{'notes'} if (!$notes || $notes eq '--');
|
| 163 |
|
|
my $reguser = $dbobj->{'user'};
|
| 164 |
|
|
my $autostart = ($h{"autostart"} ."") || $dbobj->{'autostart'};
|
| 165 |
|
|
if ($autostart && $autostart ne "false") {$autostart = "true";}
|
| 166 |
|
|
my $locktonode = ($h{"locktonode"} ."") || $dbobj->{'locktonode'};
|
| 167 |
|
|
if ($locktonode && $locktonode ne "false") {$locktonode = "true";}
|
| 168 |
|
|
my $mac;
|
| 169 |
|
|
$mac = $dbobj->{'mac'} unless ($objaction eq 'start');
|
| 170 |
|
|
# $mac = $h{"mac"} if ($isadmin && $locktonode eq 'true' && $h{"mac"});
|
| 171 |
|
|
$mac = $h{"mac"} if ($isadmin && $h{"mac"});
|
| 172 |
|
|
my $domuser = $h{"user"} || $user; # Set if user is trying to move server to another account
|
| 173 |
|
|
|
| 174 |
|
|
# Sanity checks
|
| 175 |
|
|
if (
|
| 176 |
|
|
($name && length $name > 255)
|
| 177 |
|
|
|| ($networkuuid1<0)
|
| 178 |
|
|
|| ($networkuuid2<0)
|
| 179 |
|
|
|| ($networkuuid3<0)
|
| 180 |
|
|
|| ($networkuuid1>1 && length $networkuuid1 != 36)
|
| 181 |
|
|
|| ($networkuuid2>1 && length $networkuuid2 != 36)
|
| 182 |
|
|
|| ($networkuuid3>1 && length $networkuuid3 != 36)
|
| 183 |
|
|
|| ($image && length $image > 255)
|
| 184 |
|
|
|| ($imagename && length $imagename > 255)
|
| 185 |
|
|
|| ($image2 && length $image2 > 255)
|
| 186 |
|
|
|| ($image3 && length $image3 > 255)
|
| 187 |
|
|
|| ($image4 && length $image4 > 255)
|
| 188 |
|
|
|| ($image2name && length $image2name > 255)
|
| 189 |
|
|
|| ($image3name && length $image3name > 255)
|
| 190 |
|
|
|| ($image4name && length $image4name > 255)
|
| 191 |
|
|
|| ($cdrom && length $cdrom > 255)
|
| 192 |
a439a9c4
|
hq
|
|| ($memory && ($memory<64 || $memory >1024*64))
|
| 193 |
95b003ff
|
Origo
|
) {
|
| 194 |
a439a9c4
|
hq
|
$postreply .= "Status=ERROR Invalid server data: $name\n";
|
| 195 |
95b003ff
|
Origo
|
return 0;
|
| 196 |
|
|
}
|
| 197 |
|
|
|
| 198 |
|
|
# Security check
|
| 199 |
2a63870a
|
Christian Orellana
|
if ($status eq 'new' && (($action && $action ne '--' && $action ne 'save') || !$image || $image eq '--')) {
|
| 200 |
|
|
$postreply .= "Status=ERROR Bad server data: $name\n";
|
| 201 |
|
|
$postmsg = "Bad server data";
|
| 202 |
95b003ff
|
Origo
|
return 0;
|
| 203 |
|
|
}
|
| 204 |
|
|
if (!$reguser && $status ne 'new'
|
| 205 |
|
|
&& !($name && $memory && $vcpu && $boot && $image && $diskbus && $networkuuid1 && $nicmodel1)) {
|
| 206 |
|
|
$posterror .= "Status=ERROR Insufficient data: $name\n";
|
| 207 |
|
|
return 0;
|
| 208 |
|
|
}
|
| 209 |
|
|
if (!$isadmin) {
|
| 210 |
|
|
if (($networkuuid1>1 && $networkreg{$networkuuid1}->{'user'} ne $user)
|
| 211 |
|
|
|| ($networkuuid2>1 && $networkreg{$networkuuid2}->{'user'} ne $user)
|
| 212 |
|
|
|| ($networkuuid3>1 && $networkreg{$networkuuid3}->{'user'} ne $user)
|
| 213 |
|
|
)
|
| 214 |
|
|
{
|
| 215 |
|
|
$postreply .= "Status=ERROR No privileges: $networkname1 $networkname2\n";
|
| 216 |
|
|
return 0;
|
| 217 |
|
|
}
|
| 218 |
91a21c75
|
hq
|
if ( ($reguser && ($user ne $reguser) && $action ) || ($reguser && $status eq "new"))
|
| 219 |
95b003ff
|
Origo
|
{
|
| 220 |
|
|
$postreply .= "Status=ERROR No privileges: $name\n";
|
| 221 |
|
|
return 0;
|
| 222 |
|
|
}
|
| 223 |
|
|
if (!($image =~ /\/$user\//)
|
| 224 |
|
|
|| ($image2 && $image2 ne "--" && !($image2 =~ /\/$user\//))
|
| 225 |
|
|
|| ($image3 && $image3 ne "--" && !($image3 =~ /\/$user\//))
|
| 226 |
|
|
|| ($image4 && $image4 ne "--" && !($image4 =~ /\/$user\//))
|
| 227 |
|
|
)
|
| 228 |
|
|
{
|
| 229 |
|
|
$postreply .= "Status=ERROR No image privileges: $name\n";
|
| 230 |
|
|
return 0;
|
| 231 |
|
|
}
|
| 232 |
|
|
}
|
| 233 |
|
|
|
| 234 |
|
|
# No action - regular save of domain properties
|
| 235 |
04c16f26
|
hq
|
$cdrom = '--' if ($cdrom eq 'virtio' && $action ne 'mountcd');
|
| 236 |
95b003ff
|
Origo
|
|
| 237 |
|
|
$obj = {
|
| 238 |
|
|
uuid => $uuid,
|
| 239 |
|
|
status => $status,
|
| 240 |
|
|
name => $name,
|
| 241 |
|
|
memory => $memory,
|
| 242 |
|
|
vcpu => $vcpu,
|
| 243 |
|
|
image => $image,
|
| 244 |
|
|
imagename => $imagename,
|
| 245 |
|
|
image2 => $image2,
|
| 246 |
|
|
image2name => $image2name,
|
| 247 |
|
|
image3 => $image3,
|
| 248 |
|
|
image3name => $image3name,
|
| 249 |
|
|
image4 => $image4,
|
| 250 |
|
|
image4name => $image4name,
|
| 251 |
|
|
diskbus => $diskbus,
|
| 252 |
|
|
cdrom => $cdrom,
|
| 253 |
|
|
boot => $boot,
|
| 254 |
04c16f26
|
hq
|
loader=> $loader,
|
| 255 |
95b003ff
|
Origo
|
networkuuid1 => $networkuuid1,
|
| 256 |
|
|
networkid1 => $networkid1,
|
| 257 |
|
|
networkname1 => $networkname1,
|
| 258 |
|
|
nicmodel1 => $nicmodel1,
|
| 259 |
|
|
nicmac1 => $nicmac1,
|
| 260 |
|
|
networkuuid2 => $networkuuid2,
|
| 261 |
|
|
networkid2 => $networkid2,
|
| 262 |
|
|
networkname2 => $networkname2,
|
| 263 |
|
|
nicmac2 => $nicmac2,
|
| 264 |
|
|
networkuuid3 => $networkuuid3,
|
| 265 |
|
|
networkid3 => $networkid3,
|
| 266 |
|
|
networkname3 => $networkname3,
|
| 267 |
|
|
nicmac3 => $nicmac3,
|
| 268 |
|
|
notes => $notes,
|
| 269 |
|
|
autostart => $autostart,
|
| 270 |
|
|
locktonode => $locktonode,
|
| 271 |
|
|
mac => $mac,
|
| 272 |
|
|
user => $domuser
|
| 273 |
|
|
};
|
| 274 |
|
|
return $obj;
|
| 275 |
|
|
}
|
| 276 |
|
|
|
| 277 |
|
|
sub Init {
|
| 278 |
|
|
# Tie database tables to hashes
|
| 279 |
|
|
unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access image register"};
|
| 280 |
|
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access network register"};
|
| 281 |
|
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac'}, $Stabile::dbopts)) ) {return "Unable to access nodes register"};
|
| 282 |
|
|
unless ( tie(%xmlreg,'Tie::DBI', Hash::Merge::merge({table=>'domainxml'}, $Stabile::dbopts)) ) {return "Unable to access domainxml register"};
|
| 283 |
|
|
|
| 284 |
|
|
# simplify globals initialized in Stabile.pm
|
| 285 |
|
|
$tktuser = $tktuser || $Stabile::tktuser;
|
| 286 |
|
|
$user = $user || $Stabile::user;
|
| 287 |
|
|
$isadmin = $isadmin || $Stabile::isadmin;
|
| 288 |
|
|
$privileges = $privileges || $Stabile::privileges;
|
| 289 |
|
|
|
| 290 |
|
|
# Create aliases of functions
|
| 291 |
|
|
*header = \&CGI::header;
|
| 292 |
|
|
*to_json = \&JSON::to_json;
|
| 293 |
|
|
|
| 294 |
|
|
*Showautostart = \&Autostartall;
|
| 295 |
|
|
|
| 296 |
|
|
*do_save = \&Save;
|
| 297 |
|
|
*do_tablelist = \&do_list;
|
| 298 |
|
|
*do_jsonlist = \&do_list;
|
| 299 |
|
|
*do_showautostart = \&action;
|
| 300 |
|
|
*do_autostartall = \&privileged_action;
|
| 301 |
|
|
*do_help = \&action;
|
| 302 |
|
|
|
| 303 |
|
|
*do_start = \&privileged_action;
|
| 304 |
|
|
*do_destroy = \&action;
|
| 305 |
|
|
*do_shutdown = \&action;
|
| 306 |
|
|
*do_suspend = \&action;
|
| 307 |
|
|
*do_resume = \&action;
|
| 308 |
|
|
*do_remove = \&privileged_action;
|
| 309 |
|
|
*do_move = \&action;
|
| 310 |
|
|
*do_mountcd = \&action;
|
| 311 |
c899e439
|
Origo
|
*do_changepassword = \&privileged_action;
|
| 312 |
|
|
*do_sshaccess = \&privileged_action;
|
| 313 |
95b003ff
|
Origo
|
|
| 314 |
|
|
*do_gear_start = \&do_gear_action;
|
| 315 |
|
|
*do_gear_autostart = \&do_gear_action;
|
| 316 |
|
|
*do_gear_showautostart = \&do_gear_action;
|
| 317 |
|
|
*do_gear_autostartall = \&do_gear_action;
|
| 318 |
|
|
*do_gear_remove = \&do_gear_action;
|
| 319 |
c899e439
|
Origo
|
*do_gear_changepassword = \&do_gear_action;
|
| 320 |
|
|
*do_gear_sshaccess = \&do_gear_action;
|
| 321 |
95b003ff
|
Origo
|
|
| 322 |
|
|
}
|
| 323 |
|
|
|
| 324 |
|
|
sub do_list {
|
| 325 |
|
|
my ($uuid, $action) = @_;
|
| 326 |
|
|
if ($help) {
|
| 327 |
|
|
return <<END
|
| 328 |
|
|
GET:uuid:
|
| 329 |
|
|
List servers current user has access to.
|
| 330 |
|
|
END
|
| 331 |
|
|
}
|
| 332 |
|
|
|
| 333 |
|
|
my $res;
|
| 334 |
|
|
my $filter;
|
| 335 |
|
|
my $statusfilter;
|
| 336 |
|
|
my $uuidfilter;
|
| 337 |
|
|
my $curserv = $register{$curuuid};
|
| 338 |
|
|
if ($curuuid && ($isadmin || $curserv->{'user'} eq $user) && $uripath =~ /servers(\.cgi)?\/(\?|)(this)/) {
|
| 339 |
|
|
$uuidfilter = $curuuid;
|
| 340 |
|
|
} elsif ($uripath =~ /servers(\.cgi)?\/(\?|)(name|status)/) {
|
| 341 |
|
|
$filter = $3 if ($uripath =~ /servers(\.cgi)?\/\??name(:|=)(.+)/);
|
| 342 |
|
|
$filter = $1 if ($filter =~ /(.*)\*$/);
|
| 343 |
|
|
$statusfilter = $4 if ($uripath =~ /servers(\.cgi)?\/\??(.+ AND )?status(:|=)(\w+)/);
|
| 344 |
|
|
} elsif ($uripath =~ /servers(\.cgi)?\/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/) {
|
| 345 |
|
|
$uuidfilter = $2;
|
| 346 |
|
|
}
|
| 347 |
|
|
$filter = $1 if ($filter =~ /(.*)\*/);
|
| 348 |
|
|
|
| 349 |
|
|
my $sysuuid;
|
| 350 |
|
|
if ($params{'system'}) {
|
| 351 |
|
|
$sysuuid = $params{'system'};
|
| 352 |
|
|
$sysuuid = $cursysuuid || $curuuid if ($params{'system'} eq 'this');
|
| 353 |
|
|
}
|
| 354 |
|
|
my @curregvalues;
|
| 355 |
|
|
my @regkeys;
|
| 356 |
|
|
if ($fulllist && $isadmin) {
|
| 357 |
|
|
@regkeys = keys %register;
|
| 358 |
|
|
} elsif ($uuidfilter && $isadmin) {
|
| 359 |
|
|
@regkeys = (tied %register)->select_where("uuid = '$uuidfilter'");
|
| 360 |
|
|
} elsif ($sysuuid) {
|
| 361 |
|
|
@regkeys = (tied %register)->select_where("system = '$sysuuid' OR uuid = '$sysuuid'");
|
| 362 |
|
|
} else {
|
| 363 |
|
|
@regkeys = (tied %register)->select_where("user = '$user'");
|
| 364 |
|
|
}
|
| 365 |
|
|
|
| 366 |
|
|
unless (tie(%sysreg,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access systems register"}|; return $res;};
|
| 367 |
|
|
unless (tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access images register"}|; return $res;};
|
| 368 |
|
|
|
| 369 |
|
|
foreach my $k (@regkeys) {
|
| 370 |
|
|
$valref = $register{$k};
|
| 371 |
|
|
# Only include VM's belonging to current user (or all users if specified and user is admin)
|
| 372 |
|
|
if ($user eq $valref->{'user'} || $fulllist || ($uuidfilter && $isadmin)) {
|
| 373 |
|
|
next unless (!$sysuuid || $valref->{'system'} eq $sysuuid || $valref->{'uuid'} eq $sysuuid);
|
| 374 |
|
|
|
| 375 |
|
|
my $validatedref = validateItem($valref);
|
| 376 |
|
|
my %val = %{$validatedref}; # Deference and assign to new ass array, effectively cloning object
|
| 377 |
|
|
$val{'memory'} += 0;
|
| 378 |
|
|
$val{'vcpu'} += 0;
|
| 379 |
|
|
$val{'nodetype'} = 'parent';
|
| 380 |
|
|
$val{'internalip'} = $networkreg{$val{'networkuuid1'}}->{'internalip'};
|
| 381 |
|
|
$val{'self'} = 1 if ($curuuid && $curuuid eq $val{'uuid'});
|
| 382 |
|
|
if ($action eq 'treelist') {
|
| 383 |
|
|
if ($val{'system'} && $val{'system'} ne '') {
|
| 384 |
|
|
my $sysuuid = $val{'system'};
|
| 385 |
|
|
my $sysname = $sysreg{$sysuuid}->{'name'};
|
| 386 |
|
|
if (!$sysname) {
|
| 387 |
|
|
$sysname = $1 if ($sysname =~ /(.+)\..*/);
|
| 388 |
|
|
$sysname = $val{'name'};
|
| 389 |
|
|
$sysname =~ s/server/System/i;
|
| 390 |
|
|
}
|
| 391 |
|
|
$sysreg{$sysuuid} = {
|
| 392 |
|
|
uuid => $sysuuid,
|
| 393 |
|
|
name => $sysname,
|
| 394 |
|
|
user => 'irigo'
|
| 395 |
|
|
};
|
| 396 |
|
|
|
| 397 |
|
|
my %pval = %{$sysreg{$sysuuid}};
|
| 398 |
|
|
$pval{'nodetype'} = 'parent';
|
| 399 |
|
|
$pval{'status'} = '--';
|
| 400 |
|
|
$val{'nodetype'} = 'child';
|
| 401 |
|
|
|
| 402 |
|
|
my @children;
|
| 403 |
|
|
push @children,\%val;
|
| 404 |
|
|
$pval{'children'} = \@children;
|
| 405 |
|
|
push @curregvalues,\%pval;
|
| 406 |
|
|
} else {
|
| 407 |
|
|
push @curregvalues,\%val;
|
| 408 |
|
|
}
|
| 409 |
|
|
} elsif ($filter || $statusfilter || $uuidfilter) { # List filtered servers
|
| 410 |
|
|
my $fmatch;
|
| 411 |
|
|
my $smatch;
|
| 412 |
|
|
my $umatch;
|
| 413 |
|
|
$fmatch = 1 if (!$filter || $val{'name'}=~/$filter/i);
|
| 414 |
|
|
$smatch = 1 if (!$statusfilter || $statusfilter eq 'all'
|
| 415 |
|
|
|| $statusfilter eq $val{'status'}
|
| 416 |
|
|
);
|
| 417 |
|
|
$umatch = 1 if ($val{'uuid'} eq $uuidfilter);
|
| 418 |
|
|
if ($fmatch && $smatch && !$uuidfilter) {
|
| 419 |
|
|
push @curregvalues,\%val;
|
| 420 |
|
|
} elsif ($umatch) {
|
| 421 |
|
|
push @curregvalues,\%val;
|
| 422 |
|
|
last;
|
| 423 |
|
|
}
|
| 424 |
|
|
} else {
|
| 425 |
|
|
push @curregvalues,\%val;
|
| 426 |
|
|
}
|
| 427 |
|
|
}
|
| 428 |
|
|
}
|
| 429 |
|
|
tied(%sysreg)->commit;
|
| 430 |
|
|
untie(%sysreg);
|
| 431 |
|
|
untie %imagereg;
|
| 432 |
|
|
@curregvalues = (sort {$a->{'status'} cmp $b->{'status'}} @curregvalues); # Sort by status
|
| 433 |
|
|
|
| 434 |
|
|
# Sort @curregvalues
|
| 435 |
2a63870a
|
Christian Orellana
|
@curregvalues = (sort {$b->{'name'} <=> $a->{'name'}} @curregvalues); # Always sort by name first
|
| 436 |
95b003ff
|
Origo
|
my $sort = 'status';
|
| 437 |
|
|
$sort = $2 if ($uripath =~ /sort\((\+|\-)(\S+)\)/);
|
| 438 |
|
|
my $reverse;
|
| 439 |
|
|
$reverse = 1 if ($1 eq '-');
|
| 440 |
|
|
if ($reverse) { # sort reverse
|
| 441 |
|
|
if ($sort =~ /memory|vcpu/) {
|
| 442 |
|
|
@curregvalues = (sort {$b->{$sort} <=> $a->{$sort}} @curregvalues); # Sort as number
|
| 443 |
|
|
} else {
|
| 444 |
|
|
@curregvalues = (sort {$b->{$sort} cmp $a->{$sort}} @curregvalues); # Sort as string
|
| 445 |
|
|
}
|
| 446 |
|
|
} else {
|
| 447 |
|
|
if ($sort =~ /memory|vcpu/) {
|
| 448 |
|
|
@curregvalues = (sort {$a->{$sort} <=> $b->{$sort}} @curregvalues); # Sort as number
|
| 449 |
|
|
} else {
|
| 450 |
|
|
@curregvalues = (sort {$a->{$sort} cmp $b->{$sort}} @curregvalues); # Sort as string
|
| 451 |
|
|
}
|
| 452 |
|
|
}
|
| 453 |
|
|
|
| 454 |
|
|
if ($action eq 'tablelist') {
|
| 455 |
|
|
my $t2;
|
| 456 |
|
|
|
| 457 |
|
|
if ($isadmin) {
|
| 458 |
|
|
$t2 = Text::SimpleTable->new(36,20,20,10,10,12,7);
|
| 459 |
|
|
$t2->row('uuid', 'name', 'imagename', 'memory', 'user', 'mac', 'status');
|
| 460 |
|
|
} else {
|
| 461 |
|
|
$t2 = Text::SimpleTable->new(36,20,20,10,10,7);
|
| 462 |
|
|
$t2->row('uuid', 'name', 'imagename', 'memory', 'user', 'status');
|
| 463 |
|
|
}
|
| 464 |
|
|
$t2->hr;
|
| 465 |
|
|
my $pattern = $options{m};
|
| 466 |
|
|
foreach $rowref (@curregvalues){
|
| 467 |
|
|
if ($pattern) {
|
| 468 |
|
|
my $rowtext = $rowref->{'uuid'} . " " . $rowref->{'name'} . " " . $rowref->{'imagename'} . " " . $rowref->{'memory'}
|
| 469 |
|
|
. " " . $rowref->{'user'} . " " . $rowref->{'status'};
|
| 470 |
|
|
$rowtext .= " " . $rowref->{'mac'} if ($isadmin);
|
| 471 |
|
|
next unless ($rowtext =~ /$pattern/i);
|
| 472 |
|
|
}
|
| 473 |
|
|
if ($isadmin) {
|
| 474 |
|
|
$t2->row($rowref->{'uuid'}, $rowref->{'name'}, $rowref->{'imagename'}, $rowref->{'memory'},
|
| 475 |
|
|
$rowref->{'user'}, $rowref->{'mac'}, $rowref->{'status'});
|
| 476 |
|
|
} else {
|
| 477 |
|
|
$t2->row($rowref->{'uuid'}, $rowref->{'name'}, $rowref->{'imagename'}, $rowref->{'memory'},
|
| 478 |
|
|
$rowref->{'user'}, $rowref->{'status'});
|
| 479 |
|
|
}
|
| 480 |
|
|
}
|
| 481 |
|
|
$res .= $t2->draw;
|
| 482 |
|
|
} elsif ($console) {
|
| 483 |
|
|
$res .= Dumper(\@curregvalues);
|
| 484 |
|
|
} else {
|
| 485 |
|
|
my $json_text;
|
| 486 |
|
|
if ($uuidfilter && @curregvalues) {
|
| 487 |
|
|
$json_text = to_json($curregvalues[0], {pretty => 1});
|
| 488 |
|
|
} else {
|
| 489 |
|
|
$json_text = to_json(\@curregvalues, {pretty => 1});
|
| 490 |
|
|
}
|
| 491 |
|
|
|
| 492 |
|
|
$json_text =~ s/\x/ /g;
|
| 493 |
|
|
$json_text =~ s/\"\"/"--"/g;
|
| 494 |
c899e439
|
Origo
|
$json_text =~ s/null/"--"/g;
|
| 495 |
04c16f26
|
hq
|
$json_text =~ s/"autostart"\s?:\s?"true"/"autostart": true/g;
|
| 496 |
|
|
$json_text =~ s/"autostart"\s?:\s?"--"/"autostart": false/g;
|
| 497 |
|
|
$json_text =~ s/"locktonode"\s?:\s?"true"/"locktonode": true/g;
|
| 498 |
|
|
$json_text =~ s/"locktonode"\s?:\s?"--"/"locktonode": false/g;
|
| 499 |
|
|
$json_text =~ s/"loader"\s?:\s?"--"/"loader": "bios"/g;
|
| 500 |
95b003ff
|
Origo
|
if ($action eq 'jsonlist' || $action eq 'list' || !$action) {
|
| 501 |
|
|
$res .= $json_text;
|
| 502 |
|
|
} else {
|
| 503 |
|
|
$res .= qq|{"action": "$action", "identifier": "uuid", "label": "uuid", "items" : $json_text}|;
|
| 504 |
|
|
}
|
| 505 |
|
|
}
|
| 506 |
|
|
return $res;
|
| 507 |
|
|
}
|
| 508 |
|
|
|
| 509 |
|
|
sub do_uuidshow {
|
| 510 |
|
|
my ($uuid, $action) = @_;
|
| 511 |
|
|
if ($help) {
|
| 512 |
|
|
return <<END
|
| 513 |
|
|
GET:uuid:
|
| 514 |
|
|
Simple action for showing a single server.
|
| 515 |
|
|
END
|
| 516 |
|
|
}
|
| 517 |
|
|
my $res;
|
| 518 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 519 |
|
|
my $u = $uuid || $options{u};
|
| 520 |
|
|
if ($u || $u eq '0') {
|
| 521 |
|
|
foreach my $uuid (keys %register) {
|
| 522 |
|
|
if (($register{$uuid}->{'user'} eq $user || $register{$uuid}->{'user'} eq 'common' || $isadmin)
|
| 523 |
|
|
&& $uuid =~ /^$u/) {
|
| 524 |
|
|
my %hash = %{$register{$uuid}};
|
| 525 |
|
|
delete $hash{'action'};
|
| 526 |
|
|
my $dump = Dumper(\%hash);
|
| 527 |
|
|
$dump =~ s/undef/"--"/g;
|
| 528 |
|
|
$res .= $dump;
|
| 529 |
|
|
last;
|
| 530 |
|
|
}
|
| 531 |
|
|
}
|
| 532 |
|
|
}
|
| 533 |
|
|
return $res;
|
| 534 |
|
|
}
|
| 535 |
|
|
|
| 536 |
|
|
sub do_uuidlookup {
|
| 537 |
|
|
if ($help) {
|
| 538 |
|
|
return <<END
|
| 539 |
|
|
GET:uuid:
|
| 540 |
|
|
Simple action for looking up a uuid or part of a uuid and returning the complete uuid.
|
| 541 |
|
|
END
|
| 542 |
|
|
}
|
| 543 |
|
|
my $res;
|
| 544 |
|
|
$res .= header('text/plain') unless $console;
|
| 545 |
|
|
my $u = $options{u};
|
| 546 |
|
|
$u = $curuuid unless ($u || $u eq '0');
|
| 547 |
|
|
my $ruuid;
|
| 548 |
|
|
if ($u || $u eq '0') {
|
| 549 |
|
|
my $match;
|
| 550 |
|
|
foreach my $uuid (keys %register) {
|
| 551 |
|
|
if ($uuid =~ /^$u/) {
|
| 552 |
|
|
$ruuid = $uuid if ($register{$uuid}->{'user'} eq $user || index($privileges,"a")!=-1);
|
| 553 |
|
|
$match = 1;
|
| 554 |
|
|
last;
|
| 555 |
|
|
}
|
| 556 |
|
|
}
|
| 557 |
|
|
if (!$match && $isadmin) { # If no match and user is admin, do comprehensive lookup
|
| 558 |
|
|
foreach my $uuid (keys %register) {
|
| 559 |
|
|
if ($uuid =~ /^$u/ || $register{$uuid}->{'name'} =~ /^$u/) {
|
| 560 |
|
|
$ruuid = $uuid;
|
| 561 |
|
|
last;
|
| 562 |
|
|
}
|
| 563 |
|
|
}
|
| 564 |
|
|
}
|
| 565 |
|
|
}
|
| 566 |
|
|
$res .= "$ruuid\n" if ($ruuid);
|
| 567 |
|
|
return $res;
|
| 568 |
|
|
}
|
| 569 |
|
|
|
| 570 |
|
|
sub do_destroyuserservers {
|
| 571 |
6372a66e
|
hq
|
my ($uuid, $action, $obj) = @_;
|
| 572 |
95b003ff
|
Origo
|
if ($help) {
|
| 573 |
|
|
return <<END
|
| 574 |
6372a66e
|
hq
|
GET:username:
|
| 575 |
95b003ff
|
Origo
|
Simple action for destroying all servers belonging to a user
|
| 576 |
|
|
END
|
| 577 |
|
|
}
|
| 578 |
6372a66e
|
hq
|
$username = $obj->{username};
|
| 579 |
95b003ff
|
Origo
|
my $res;
|
| 580 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 581 |
6372a66e
|
hq
|
|
| 582 |
|
|
destroyUserServers($username);
|
| 583 |
95b003ff
|
Origo
|
$res .= $postreply;
|
| 584 |
|
|
return $res;
|
| 585 |
|
|
}
|
| 586 |
|
|
|
| 587 |
|
|
sub do_removeuserservers {
|
| 588 |
|
|
if ($help) {
|
| 589 |
|
|
return <<END
|
| 590 |
|
|
GET::
|
| 591 |
|
|
Simple action for removing all servers belonging to a user
|
| 592 |
|
|
END
|
| 593 |
|
|
}
|
| 594 |
|
|
my $res;
|
| 595 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 596 |
|
|
removeUserServers($user);
|
| 597 |
|
|
$res .= $postreply;
|
| 598 |
|
|
return $res;
|
| 599 |
|
|
}
|
| 600 |
|
|
|
| 601 |
|
|
sub do_getappid {
|
| 602 |
|
|
my ($uuid, $action) = @_;
|
| 603 |
|
|
if ($help) {
|
| 604 |
|
|
return <<END
|
| 605 |
|
|
GET:uuid:
|
| 606 |
|
|
Simple action for getting the app id
|
| 607 |
|
|
END
|
| 608 |
|
|
}
|
| 609 |
|
|
my $res;
|
| 610 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 611 |
|
|
$uuid = $uuid || $options{u};
|
| 612 |
|
|
$uuid = $curuuid unless ($uuid);
|
| 613 |
|
|
if ($uuid && $register{$uuid}) {
|
| 614 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access image register"};
|
| 615 |
|
|
$res .= "appid: ". $imagereg{$register{$uuid}->{image}}->{appid}, "\n";
|
| 616 |
|
|
untie %imagereg;
|
| 617 |
|
|
}
|
| 618 |
|
|
return $res;
|
| 619 |
|
|
}
|
| 620 |
|
|
|
| 621 |
|
|
sub do_setrunning {
|
| 622 |
|
|
my ($uuid, $action) = @_;
|
| 623 |
|
|
if ($help) {
|
| 624 |
|
|
return <<END
|
| 625 |
|
|
GET:uuid:
|
| 626 |
|
|
Simple action for setting status back to running after e.g. an upgrade
|
| 627 |
|
|
END
|
| 628 |
|
|
}
|
| 629 |
|
|
my $res;
|
| 630 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 631 |
|
|
$uuid = $uuid || $options{u};
|
| 632 |
|
|
$uuid = $curuuid unless ($uuid);
|
| 633 |
|
|
if ($uuid && $register{$uuid}) {
|
| 634 |
|
|
$register{$uuid}->{'status'} = 'running';
|
| 635 |
|
|
$main::updateUI->({ tab => 'servers',
|
| 636 |
|
|
user => $user,
|
| 637 |
|
|
uuid => $uuid,
|
| 638 |
|
|
status => 'running' })
|
| 639 |
|
|
|
| 640 |
|
|
};
|
| 641 |
|
|
$res .= "Status=OK Set status of $register{$uuid}->{'name'} to running\n";
|
| 642 |
|
|
return $res;
|
| 643 |
|
|
}
|
| 644 |
|
|
|
| 645 |
|
|
sub do_getappinfo {
|
| 646 |
|
|
my ($uuid, $action) = @_;
|
| 647 |
|
|
if ($help) {
|
| 648 |
|
|
return <<END
|
| 649 |
|
|
GET:uuid:
|
| 650 |
|
|
Simple action for getting the apps basic info
|
| 651 |
|
|
END
|
| 652 |
|
|
}
|
| 653 |
|
|
my $res;
|
| 654 |
|
|
$res .= $Stabile::q->header('application/json') unless $console;
|
| 655 |
|
|
$uuid = $uuid || $options{u};
|
| 656 |
|
|
$uuid = $curuuid unless ($uuid);
|
| 657 |
|
|
my %appinfo;
|
| 658 |
|
|
if ($uuid && $register{$uuid}) {
|
| 659 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access image register"};
|
| 660 |
|
|
$appinfo{'appid'} = $imagereg{$register{$uuid}->{image}}->{appid} || '';
|
| 661 |
|
|
$appinfo{'managementlink'} = $imagereg{$register{$uuid}->{image}}->{managementlink} || '';
|
| 662 |
|
|
$appinfo{'managementlink'} =~ s/{uuid}/$register{$uuid}->{networkuuid1}/;
|
| 663 |
|
|
|
| 664 |
|
|
my $termlink = $imagereg{$register{$uuid}->{image}}->{terminallink} || '';
|
| 665 |
|
|
$termlink =~ s/{uuid}/$register{$uuid}->{networkuuid1}/;
|
| 666 |
|
|
my $burl = $baseurl;
|
| 667 |
|
|
$burl = $1 if ($termlink =~ /\/stabile/ && $baseurl =~ /(.+)\/stabile/); # Unpretty, but works for now
|
| 668 |
6fdc8676
|
hq
|
# $termlink = $1 if ($termlink =~ /\/(.+)/);
|
| 669 |
|
|
# $termlink = "$burl/$termlink" unless ($termlink =~ /^http/ || !$termlink); # || $termlink =~ /^\//
|
| 670 |
95b003ff
|
Origo
|
$appinfo{'terminallink'} = $termlink;
|
| 671 |
|
|
|
| 672 |
|
|
$appinfo{'upgradelink'} = $imagereg{$register{$uuid}->{image}}->{upgradelink} || '';
|
| 673 |
|
|
$appinfo{'upgradelink'} =~ s/{uuid}/$register{$uuid}->{networkuuid1}/;
|
| 674 |
|
|
$appinfo{'version'} = $imagereg{$register{$uuid}->{image}}->{version} || '';
|
| 675 |
|
|
$appinfo{'status'} = $register{$uuid}->{status} || '';
|
| 676 |
|
|
$appinfo{'name'} = $register{$uuid}->{name} || '';
|
| 677 |
d3d1a2d4
|
Origo
|
$appinfo{'system'} = $register{$uuid}->{system} || '';
|
| 678 |
|
|
|
| 679 |
|
|
if ($appinfo{'system'}) {
|
| 680 |
|
|
unless (tie(%sysreg,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access systems register"}|; return $res;};
|
| 681 |
|
|
$appinfo{'systemname'} = $sysreg{$appinfo{'system'}}->{name} || '';
|
| 682 |
|
|
untie(%sysreg);
|
| 683 |
|
|
} else {
|
| 684 |
|
|
$appinfo{'systemname'} = $appinfo{'name'};
|
| 685 |
|
|
}
|
| 686 |
|
|
|
| 687 |
95b003ff
|
Origo
|
|
| 688 |
|
|
if ($appinfo{'appid'}) {
|
| 689 |
|
|
my @regkeys = (tied %imagereg)->select_where("appid = '$appinfo{appid}'");
|
| 690 |
|
|
foreach my $k (@regkeys) {
|
| 691 |
|
|
my $imgref = $imagereg{$k};
|
| 692 |
|
|
if ($imgref->{'path'} =~ /\.master\.qcow2$/ && $imgref->{'appid'} eq $appinfo{'appid'}
|
| 693 |
|
|
&& $imgref->{'installable'} && $imgref->{'installable'} ne 'false'
|
| 694 |
|
|
) {
|
| 695 |
|
|
if ($imgref->{'version'} > $appinfo{'currentversion'}) {
|
| 696 |
|
|
$appinfo{'currentversion'} = $imgref->{'version'};
|
| 697 |
|
|
$appinfo{'appname'} = $imgref->{'name'};
|
| 698 |
|
|
}
|
| 699 |
|
|
}
|
| 700 |
|
|
}
|
| 701 |
|
|
}
|
| 702 |
|
|
|
| 703 |
|
|
untie %imagereg;
|
| 704 |
|
|
}
|
| 705 |
|
|
$appinfo{'appstoreurl'} = $appstoreurl;
|
| 706 |
|
|
$appinfo{'dnsdomain'} = ($enginelinked)?$dnsdomain:'';
|
| 707 |
6fdc8676
|
hq
|
$appinfo{'dnssubdomain'} = ($enginelinked)?substr($engineid, 0, 8):'';
|
| 708 |
95b003ff
|
Origo
|
$appinfo{'uuid'} = $uuid;
|
| 709 |
|
|
$appinfo{'user'} = $user;
|
| 710 |
|
|
$appinfo{'remoteip'} = $remoteip;
|
| 711 |
|
|
$res .= to_json(\%appinfo, { pretty => 1 });
|
| 712 |
|
|
return $res;
|
| 713 |
|
|
}
|
| 714 |
|
|
|
| 715 |
|
|
sub do_removeserver {
|
| 716 |
|
|
if ($help) {
|
| 717 |
|
|
return <<END
|
| 718 |
|
|
GET:uuid:
|
| 719 |
|
|
Simple action for destroying and removing a single server
|
| 720 |
|
|
END
|
| 721 |
|
|
}
|
| 722 |
|
|
my $res;
|
| 723 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 724 |
|
|
if ($curuuid) {
|
| 725 |
|
|
removeUserServers($user, $curuuid, 1);
|
| 726 |
|
|
}
|
| 727 |
|
|
else {
|
| 728 |
|
|
$postreply .= "Status=Error Unable to uninstall\n";
|
| 729 |
|
|
}
|
| 730 |
|
|
$res .= $postreply;
|
| 731 |
|
|
return $res;
|
| 732 |
|
|
}
|
| 733 |
|
|
|
| 734 |
|
|
sub do_updateregister {
|
| 735 |
|
|
if ($help) {
|
| 736 |
|
|
return <<END
|
| 737 |
|
|
GET::
|
| 738 |
|
|
Update server register
|
| 739 |
|
|
END
|
| 740 |
|
|
}
|
| 741 |
|
|
my $res;
|
| 742 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 743 |
|
|
return unless $isadmin;
|
| 744 |
|
|
updateRegister();
|
| 745 |
|
|
$res .= "Status=OK Updated server registry for all users\n";
|
| 746 |
|
|
return $res;
|
| 747 |
|
|
}
|
| 748 |
|
|
|
| 749 |
|
|
sub Autostartall {
|
| 750 |
|
|
my ($uuid, $action) = @_;
|
| 751 |
|
|
if ($help) {
|
| 752 |
|
|
return <<END
|
| 753 |
|
|
GET::
|
| 754 |
|
|
Start all servers marked for autostart. When called as showautostart only shows which would be started.
|
| 755 |
|
|
END
|
| 756 |
|
|
}
|
| 757 |
|
|
my $res;
|
| 758 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 759 |
|
|
my $mes;
|
| 760 |
|
|
return $res if ($isreadonly);
|
| 761 |
|
|
|
| 762 |
|
|
# Wait for all pistons to be online
|
| 763 |
|
|
my $nodedown;
|
| 764 |
|
|
my $nodecount;
|
| 765 |
|
|
for (my $i = 0; $i < 10; $i++) {
|
| 766 |
|
|
$nodedown = 0;
|
| 767 |
|
|
foreach my $node (values %nodereg) {
|
| 768 |
|
|
if ($node->{'status'} ne 'running' && $node->{'status'} ne 'maintenance') {
|
| 769 |
|
|
$nodedown = 1;
|
| 770 |
|
|
}
|
| 771 |
|
|
else {
|
| 772 |
|
|
$nodecount++ unless ($node->{'status'} eq 'maintenance');
|
| 773 |
|
|
}
|
| 774 |
|
|
}
|
| 775 |
|
|
if ($nodedown) {
|
| 776 |
|
|
# Wait and see if nodes come online
|
| 777 |
|
|
$mes = "Waiting for nodes...(" . (10 - $i) . ")\n";
|
| 778 |
|
|
print $mes if ($console);
|
| 779 |
|
|
$res .= $mes;
|
| 780 |
|
|
sleep 5;
|
| 781 |
|
|
}
|
| 782 |
|
|
else {
|
| 783 |
|
|
last;
|
| 784 |
|
|
}
|
| 785 |
|
|
}
|
| 786 |
|
|
|
| 787 |
|
|
if (!%nodereg || $nodedown || !$nodecount) {
|
| 788 |
|
|
$mes = "Not autostarting servers - not all nodes ready!\n";
|
| 789 |
|
|
print $mes if ($console);
|
| 790 |
|
|
$res .= $mes;
|
| 791 |
|
|
}
|
| 792 |
|
|
else {
|
| 793 |
|
|
$mes = "$nodecount nodes ready - autostarting servers...\n";
|
| 794 |
|
|
print $mes if ($console);
|
| 795 |
|
|
$res .= $mes;
|
| 796 |
|
|
if ($action eq "showautostart") {
|
| 797 |
|
|
$mes = "Only showing which servers would be starting!\n";
|
| 798 |
|
|
print $mes if ($console);
|
| 799 |
|
|
$res .= $mes;
|
| 800 |
|
|
}
|
| 801 |
|
|
|
| 802 |
|
|
$Stabile::Networks::user = $user;
|
| 803 |
|
|
require "$Stabile::basedir/cgi/networks.cgi";
|
| 804 |
|
|
$Stabile::Networks::console = 1;
|
| 805 |
|
|
|
| 806 |
|
|
foreach my $dom (values %register) {
|
| 807 |
2a63870a
|
Christian Orellana
|
if ($dom->{'autostart'} eq '1' || $dom->{'autostart'} eq 'true') {
|
| 808 |
|
|
$res .= "Checking if $dom->{'name'} ($dom->{'user'}, $dom->{'uuid'}) should be started\n";
|
| 809 |
95b003ff
|
Origo
|
my $networkstatus1 = $networkreg{$dom->{'networkuuid1'}}->{status};
|
| 810 |
|
|
my $networkstatus2 = ($networkreg{$dom->{'networkuuid2'}})?$networkreg{$dom->{'networkuuid2'}}->{status}:'';
|
| 811 |
|
|
my $networkstatus3 = ($networkreg{$dom->{'networkuuid3'}})?$networkreg{$dom->{'networkuuid3'}}->{status}:'';
|
| 812 |
|
|
my @dnets;
|
| 813 |
|
|
push @dnets, $dom->{'networkuuid1'} if ($dom->{'networkuuid1'} && $dom->{'networkuuid1'} ne '--' && $networkstatus1 ne 'up');
|
| 814 |
|
|
push @dnets, $dom->{'networkuuid2'} if ($dom->{'networkuuid2'} && $dom->{'networkuuid2'} ne '--' && $networkstatus2 ne 'up');
|
| 815 |
|
|
push @dnets, $dom->{'networkuuid3'} if ($dom->{'networkuuid3'} && $dom->{'networkuuid3'} ne '--' && $networkstatus3 ne 'up');
|
| 816 |
|
|
my $i;
|
| 817 |
|
|
for ($i=0; $i<5; $i++) { # wait for status newer than 10 secs
|
| 818 |
|
|
validateItem($dom);
|
| 819 |
|
|
last if (time() - $dom->{timestamp} < 10);
|
| 820 |
2a63870a
|
Christian Orellana
|
$mes = "Waiting for newer timestamp, current is " . (time() - $dom->{timestamp}) . " old\n";
|
| 821 |
95b003ff
|
Origo
|
print $mes if ($console);
|
| 822 |
|
|
$res .= $mes;
|
| 823 |
|
|
sleep 2;
|
| 824 |
|
|
}
|
| 825 |
|
|
if (
|
| 826 |
|
|
$dom->{'status'} eq 'shutoff' || $dom->{'status'} eq 'inactive'
|
| 827 |
|
|
) {
|
| 828 |
|
|
if ($action eq "showautostart") { # Dry run
|
| 829 |
|
|
$mes = "Starting $dom->{'name'} ($dom->{'user'}, $dom->{'uuid'})\n";
|
| 830 |
|
|
print $mes if ($console);
|
| 831 |
|
|
$res .= $mes;
|
| 832 |
|
|
}
|
| 833 |
|
|
else {
|
| 834 |
|
|
$mes = "Starting $dom->{'name'} ($dom->{'user'}, $dom->{'uuid'})\n";
|
| 835 |
|
|
print $mes if ($console);
|
| 836 |
|
|
$res .= $mes;
|
| 837 |
|
|
$postreply = Start($dom->{'uuid'});
|
| 838 |
|
|
print $postreply if ($console);
|
| 839 |
|
|
$res .= $postreply;
|
| 840 |
48fcda6b
|
Origo
|
# $mes = `REMOTE_USER=$dom->{'user'} $base/cgi/servers.cgi -a start -u $dom->{'uuid'}`;
|
| 841 |
|
|
print $mes if ($console);
|
| 842 |
|
|
$res .= $mes;
|
| 843 |
95b003ff
|
Origo
|
sleep 1;
|
| 844 |
|
|
}
|
| 845 |
|
|
}
|
| 846 |
|
|
elsif (@dnets) {
|
| 847 |
|
|
if ($action eq "showautostart") { # Dry run
|
| 848 |
|
|
foreach my $networkuuid (@dnets) {
|
| 849 |
|
|
$mes = "Would bring network $networkreg{$networkuuid}->{name} up for $dom->{'name'} ($dom->{'user'}, $dom->{'uuid'})\n";
|
| 850 |
|
|
print $mes if ($console);
|
| 851 |
|
|
$res .= $mes;
|
| 852 |
|
|
}
|
| 853 |
|
|
}
|
| 854 |
|
|
else {
|
| 855 |
|
|
foreach my $networkuuid (@dnets) {
|
| 856 |
|
|
$mes = "Bringing network $networkreg{$networkuuid}->{name} up for $dom->{'name'} ($dom->{'user'}, $dom->{'uuid'})\n";
|
| 857 |
|
|
print $mes if ($console);
|
| 858 |
|
|
$res .= $mes;
|
| 859 |
|
|
$mes = Stabile::Networks::Activate($networkuuid, 'activate');
|
| 860 |
|
|
print $mes if ($console);
|
| 861 |
|
|
$res .= $mes;
|
| 862 |
|
|
sleep 1;
|
| 863 |
|
|
}
|
| 864 |
|
|
}
|
| 865 |
|
|
}
|
| 866 |
2a63870a
|
Christian Orellana
|
} else {
|
| 867 |
|
|
$res .= "Not marked for autostart $dom->{'name'} ($dom->{'user'}, $dom->{'uuid'})\n";
|
| 868 |
95b003ff
|
Origo
|
}
|
| 869 |
|
|
}
|
| 870 |
|
|
}
|
| 871 |
|
|
return $res;
|
| 872 |
|
|
}
|
| 873 |
|
|
|
| 874 |
|
|
sub do_listnodeavailability {
|
| 875 |
|
|
if ($help) {
|
| 876 |
|
|
return <<END
|
| 877 |
|
|
GET::
|
| 878 |
|
|
Utility call - only informational. Shows availability of nodes for starting servers.
|
| 879 |
|
|
END
|
| 880 |
|
|
}
|
| 881 |
|
|
my $res;
|
| 882 |
|
|
$res .= $Stabile::q->header('application/json') unless ($console);
|
| 883 |
|
|
my ($temp1, $temp2, $temp3, $temp4, $ahashref) = locateTargetNode();
|
| 884 |
|
|
my @avalues = values %$ahashref;
|
| 885 |
|
|
my @sorted_values = (sort {$b->{'index'} <=> $a->{'index'}} @avalues);
|
| 886 |
|
|
$res .= to_json(\@sorted_values, { pretty => 1 });
|
| 887 |
|
|
return $res;
|
| 888 |
|
|
}
|
| 889 |
|
|
|
| 890 |
|
|
sub do_listbillingdata {
|
| 891 |
|
|
if ($help) {
|
| 892 |
|
|
return <<END
|
| 893 |
|
|
GET::
|
| 894 |
|
|
List current billing data.
|
| 895 |
|
|
END
|
| 896 |
|
|
}
|
| 897 |
|
|
my $res;
|
| 898 |
|
|
$res .= $Stabile::q->header('application/json') unless ($console);
|
| 899 |
|
|
my $buser = URI::Escape::uri_unescape($params{'user'}) || $user;
|
| 900 |
|
|
my %b;
|
| 901 |
|
|
my @bmonths;
|
| 902 |
|
|
if ($isadmin || $buser eq $user) {
|
| 903 |
|
|
my $bmonth = URI::Escape::uri_unescape($params{'month'}) || $month;
|
| 904 |
|
|
my $byear = URI::Escape::uri_unescape($params{'year'}) || $year;
|
| 905 |
|
|
if ($bmonth eq "all") {
|
| 906 |
|
|
@bmonths = ("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12");
|
| 907 |
|
|
}
|
| 908 |
|
|
else {
|
| 909 |
|
|
@bmonths = ($bmonth);
|
| 910 |
|
|
}
|
| 911 |
|
|
|
| 912 |
|
|
unless ( tie(%billingreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_domains', key=>'usernodetime'}, $Stabile::dbopts)) ) {return "Unable to access billing register"};
|
| 913 |
|
|
|
| 914 |
|
|
my @nkeys = keys %nodereg;
|
| 915 |
|
|
foreach my $bm (@bmonths) {
|
| 916 |
|
|
my $vcpuavg = 0;
|
| 917 |
|
|
my $memoryavg = 0;
|
| 918 |
|
|
foreach my $nmac (@nkeys) {
|
| 919 |
|
|
$vcpuavg += $billingreg{"$buser-$nmac-$byear-$bm"}->{'vcpuavg'};
|
| 920 |
|
|
$memoryavg += $billingreg{"$buser-$nmac-$byear-$bm"}->{'memoryavg'};
|
| 921 |
|
|
}
|
| 922 |
|
|
$b{"$buser-$byear-$bm"} = {
|
| 923 |
|
|
id => "$buser-$byear-$bm",
|
| 924 |
|
|
vcpuavg => $vcpuavg,
|
| 925 |
|
|
memoryavg => $memoryavg,
|
| 926 |
|
|
month => $bm + 0,
|
| 927 |
|
|
year => $byear + 0
|
| 928 |
|
|
}
|
| 929 |
|
|
}
|
| 930 |
|
|
untie %billingreg;
|
| 931 |
|
|
}
|
| 932 |
|
|
my @bvalues = values %b;
|
| 933 |
|
|
$res .= "{\"identifier\": \"id\", \"label\": \"id\", \"items\":" . to_json(\@bvalues) . "}";
|
| 934 |
|
|
return $res;
|
| 935 |
|
|
}
|
| 936 |
|
|
|
| 937 |
|
|
# Print list of available actions on objects
|
| 938 |
|
|
sub do_plainhelp {
|
| 939 |
|
|
my $res;
|
| 940 |
|
|
$res .= $Stabile::q->header('text/plain') unless $console;
|
| 941 |
|
|
$res .= <<END
|
| 942 |
|
|
new [name="name"]
|
| 943 |
|
|
* start: Starts a server
|
| 944 |
|
|
* destroy: Destroys a server, i.e. terminates the VM, equivalent of turning the power off a physical computer
|
| 945 |
|
|
* shutdown: Asks the operating system of a server to shut down via ACPI
|
| 946 |
|
|
* suspend: Suspends the VM, effectively putting the server to sleep
|
| 947 |
|
|
* resume: Resumes a suspended VM, effectively waking the server from sleep
|
| 948 |
|
|
* move [mac="mac"]: Moves a server to specified node. If no node is specified, moves to other node with highest availability
|
| 949 |
|
|
index
|
| 950 |
|
|
* delete: Deletes a server. Image and network are not deleted, only information about the server. Server cannot be
|
| 951 |
|
|
runing
|
| 952 |
|
|
* mountcd [cdrom="path"]: Mounts a cd rom
|
| 953 |
|
|
END
|
| 954 |
|
|
;
|
| 955 |
|
|
return $res;
|
| 956 |
|
|
}
|
| 957 |
|
|
|
| 958 |
|
|
# Helper function
|
| 959 |
|
|
sub recurse($) {
|
| 960 |
|
|
my($path) = @_;
|
| 961 |
|
|
my @files;
|
| 962 |
|
|
## append a trailing / if it's not there
|
| 963 |
|
|
$path .= '/' if($path !~ /\/$/);
|
| 964 |
|
|
## loop through the files contained in the directory
|
| 965 |
|
|
for my $eachFile (glob($path.'*')) {
|
| 966 |
|
|
## if the file is a directory
|
| 967 |
|
|
if( -d $eachFile) {
|
| 968 |
|
|
## pass the directory to the routine ( recursion )
|
| 969 |
|
|
push(@files,recurse($eachFile));
|
| 970 |
|
|
} else {
|
| 971 |
|
|
push(@files,$eachFile);
|
| 972 |
|
|
}
|
| 973 |
|
|
}
|
| 974 |
|
|
return @files;
|
| 975 |
|
|
}
|
| 976 |
|
|
|
| 977 |
|
|
sub Start {
|
| 978 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 979 |
|
|
$dmac = $obj->{mac};
|
| 980 |
|
|
$buildsystem = $obj->{buildsystem};
|
| 981 |
|
|
$uistatus = $obj->{uistatus};
|
| 982 |
|
|
if ($help) {
|
| 983 |
|
|
return <<END
|
| 984 |
|
|
GET:uuid,mac:
|
| 985 |
|
|
Start a server. Supply mac for starting on specific node.
|
| 986 |
|
|
END
|
| 987 |
|
|
}
|
| 988 |
|
|
$dmac = $dmac || $params{'mac'};
|
| 989 |
|
|
return "Status=ERROR No uuid\n" unless ($register{$uuid});
|
| 990 |
|
|
my $serv = $register{$uuid};
|
| 991 |
|
|
$postreply = '' if ($buildsystem);
|
| 992 |
|
|
|
| 993 |
|
|
my $name = $serv->{'name'};
|
| 994 |
|
|
utf8::decode($name);
|
| 995 |
|
|
my $image = $serv->{'image'};
|
| 996 |
|
|
my $image2 = $serv->{'image2'};
|
| 997 |
|
|
my $image3 = $serv->{'image3'};
|
| 998 |
|
|
my $image4 = $serv->{'image4'};
|
| 999 |
|
|
my $memory = $serv->{'memory'};
|
| 1000 |
|
|
my $vcpu = $serv->{'vcpu'};
|
| 1001 |
|
|
my $vgpu = $serv->{'vgpu'};
|
| 1002 |
|
|
my $dbstatus = $serv->{'status'};
|
| 1003 |
|
|
my $mac = $serv->{'mac'};
|
| 1004 |
|
|
my $macname = $serv->{'macname'};
|
| 1005 |
|
|
my $networkuuid1 = $serv->{'networkuuid1'};
|
| 1006 |
|
|
my $networkuuid2 = $serv->{'networkuuid2'};
|
| 1007 |
|
|
my $networkuuid3 = $serv->{'networkuuid3'};
|
| 1008 |
|
|
my $nicmodel1 = $serv->{'nicmodel1'};
|
| 1009 |
|
|
my $nicmac1 = $serv->{'nicmac1'};
|
| 1010 |
|
|
my $nicmac2 = $serv->{'nicmac2'};
|
| 1011 |
|
|
my $nicmac3 = $serv->{'nicmac3'};
|
| 1012 |
|
|
my $boot = $serv->{'boot'};
|
| 1013 |
04c16f26
|
hq
|
my $loader = $serv->{'loader'};
|
| 1014 |
95b003ff
|
Origo
|
my $diskbus = $serv->{'diskbus'};
|
| 1015 |
|
|
my $cdrom = $serv->{'cdrom'};
|
| 1016 |
|
|
my $diskdev = "vda";
|
| 1017 |
|
|
my $diskdev2 = "vdb";
|
| 1018 |
|
|
my $diskdev3 = "vdc";
|
| 1019 |
|
|
my $diskdev4 = "vdd";
|
| 1020 |
|
|
if ($diskbus eq "ide") {$diskdev = "hda"; $diskdev2 = "hdb"; $diskdev3 = "hdc"; $diskdev4 = "hdd"};
|
| 1021 |
|
|
|
| 1022 |
|
|
my $mem = $memory * 1024;
|
| 1023 |
|
|
|
| 1024 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access image register"};
|
| 1025 |
|
|
|
| 1026 |
|
|
my $img = $imagereg{$image};
|
| 1027 |
|
|
my $imagename = $img->{'name'};
|
| 1028 |
|
|
my $imagestatus = $img->{'status'};
|
| 1029 |
|
|
my $img2 = $imagereg{$image2};
|
| 1030 |
|
|
my $image2status = $img2->{'status'};
|
| 1031 |
|
|
my $img3 = $imagereg{$image3};
|
| 1032 |
|
|
my $image3status = $img3->{'status'};
|
| 1033 |
|
|
my $img4 = $imagereg{$image4};
|
| 1034 |
|
|
my $image4status = $img4->{'status'};
|
| 1035 |
|
|
|
| 1036 |
|
|
if (!$imagereg{$image}) {
|
| 1037 |
|
|
$postreply .= "Status=Error Image $image not found - please select a new image for your server, not starting $name\n";
|
| 1038 |
|
|
untie %imagereg;
|
| 1039 |
|
|
return $postreply;
|
| 1040 |
|
|
}
|
| 1041 |
|
|
untie %imagereg;
|
| 1042 |
|
|
|
| 1043 |
|
|
if ($imagestatus ne "used" && $imagestatus ne "cloning") {
|
| 1044 |
|
|
$postreply .= "Status=ERROR Image $imagename $image is $imagestatus, not starting $name\n";
|
| 1045 |
|
|
} elsif ($image2 && $image2 ne '--' && $image2status ne "used" && $image2status ne "cloning") {
|
| 1046 |
|
|
$postreply .= "Status=ERROR Image2 is $image2status, not starting $name\n";
|
| 1047 |
|
|
} elsif ($image3 && $image3 ne '--' && $image3status ne "used" && $image3status ne "cloning") {
|
| 1048 |
|
|
$postreply .= "Status=ERROR Image3 is $image3status, not starting $name\n";
|
| 1049 |
|
|
} elsif ($image4 && $image4 ne '--' && $image4status ne "used" && $image4status ne "cloning") {
|
| 1050 |
|
|
$postreply .= "Status=ERROR Image4 is $image4status, not starting $name\n";
|
| 1051 |
|
|
} elsif (overQuotas($memory,$vcpu)) {
|
| 1052 |
|
|
$main::syslogit->($user, "info", "Over quota starting a $dbstatus domain: $uuid");
|
| 1053 |
|
|
$postreply .= "Status=ERROR Over quota - not starting $name\n";
|
| 1054 |
|
|
# Status inactive is typically caused by a movepiston having problems. We should not start inactive servers since
|
| 1055 |
|
|
# they could possibly be running even if movepiston is down. Movepiston on the node should be brought up to update
|
| 1056 |
|
|
# the status, or the node should be removed from the stabile.
|
| 1057 |
|
|
# We now allow to force start of inactive server when dmac is specified
|
| 1058 |
|
|
} elsif ((!$dmac || $dmac eq $mac) && $dbstatus eq 'inactive' && $nodereg{$mac} && ($nodereg{$mac}->{'status'} eq 'inactive' || $nodereg{$mac}->{'status'} eq 'shutdown')) {
|
| 1059 |
|
|
$main::syslogit->($user, "info", "Not starting inactive domain: $uuid (last seen on $mac)");
|
| 1060 |
|
|
$postreply .= "Status=ERROR Not starting $name - Please bring up node $macname\n";
|
| 1061 |
|
|
} elsif ($dbstatus eq 'inactive' || $dbstatus eq 'shutdown' || $dbstatus eq 'shutoff' || $dbstatus eq 'new') {
|
| 1062 |
|
|
unless ($dmac && $isadmin) {
|
| 1063 |
|
|
$dmac = $mac if ($dbstatus eq 'inactive'); # If movepiston crashed while shutting down, allow server to start on same node
|
| 1064 |
|
|
}
|
| 1065 |
|
|
$uistatus = "starting" unless ($uistatus);
|
| 1066 |
|
|
my $hypervisor = getHypervisor($image);
|
| 1067 |
|
|
my ($targetmac, $targetname, $targetip, $port) = locateTargetNode($uuid, $dmac, $mem, $vcpu, $image, $image2 ,$image3, $image4, $hypervisor);
|
| 1068 |
|
|
|
| 1069 |
|
|
# Build XML for starting domain
|
| 1070 |
|
|
my $graphics = "vnc";
|
| 1071 |
|
|
$graphics = "rdp" if ($hypervisor eq "vbox");
|
| 1072 |
|
|
my $net1 = $networkreg{$networkuuid1};
|
| 1073 |
|
|
my $networkid1 = $net1->{'id'}; # Get the current vlan id of the network
|
| 1074 |
|
|
my $net2 = $networkreg{$networkuuid2};
|
| 1075 |
|
|
my $networkid2 = $net2->{'id'}; # Get the current vlan id of the network
|
| 1076 |
|
|
my $net3 = $networkreg{$networkuuid2};
|
| 1077 |
|
|
my $networkid3 = $net3->{'id'}; # Get the current vlan id of the network
|
| 1078 |
|
|
my $networkid1ip = $net1->{'internalip'};
|
| 1079 |
|
|
$networkid1ip = $net1->{'externalip'} if ($net1->{'type'} eq 'externalip');
|
| 1080 |
|
|
|
| 1081 |
|
|
my $uname = $name . substr($uuid,0,8); # We don't enforce unique names, so we make them
|
| 1082 |
|
|
$uname =~ s/[^[:ascii:]]/_/g; # Get rid of funny chars - they mess up Guacamole
|
| 1083 |
|
|
$uname =~ s/\W/_/g;
|
| 1084 |
|
|
|
| 1085 |
|
|
my $driver1;
|
| 1086 |
|
|
my $driver2;
|
| 1087 |
|
|
if ($hypervisor eq 'kvm') {
|
| 1088 |
|
|
my $fmt1 = ($image =~ /\.qcow2$/)?'qcow2':'raw';
|
| 1089 |
|
|
my $fmt2 = ($image2 =~ /\.qcow2$/)?'qcow2':'raw';
|
| 1090 |
|
|
my $fmt3 = ($image3 =~ /\.qcow2$/)?'qcow2':'raw';
|
| 1091 |
|
|
my $fmt4 = ($image4 =~ /\.qcow2$/)?'qcow2':'raw';
|
| 1092 |
2a63870a
|
Christian Orellana
|
my $cache1 = ($image =~ /\/node\//)?'default':'writeback';
|
| 1093 |
|
|
my $cache2 = ($image2 =~ /\/node\//)?'default':'writeback';
|
| 1094 |
|
|
my $cache3 = ($image3 =~ /\/node\//)?'default':'writeback';
|
| 1095 |
|
|
my $cache4 = ($image4 =~ /\/node\//)?'default':'writeback';
|
| 1096 |
|
|
$driver1 = "\n <driver name='qemu' type='$fmt1' cache='$cache1'/>";
|
| 1097 |
|
|
$driver2 = "\n <driver name='qemu' type='$fmt2' cache='$cache2'/>";
|
| 1098 |
|
|
$driver3 = "\n <driver name='qemu' type='$fmt3' cache='$cache3'/>";
|
| 1099 |
|
|
$driver4 = "\n <driver name='qemu' type='$fmt4' cache='$cache4'/>";
|
| 1100 |
95b003ff
|
Origo
|
}
|
| 1101 |
|
|
|
| 1102 |
|
|
my $networktype1 = "user";
|
| 1103 |
|
|
my $networksource1 = "default";
|
| 1104 |
|
|
my $networkforward1 = "bridge";
|
| 1105 |
|
|
my $networkisolated1 = "no";
|
| 1106 |
|
|
$networksource1 = "vboxnet0" if ($hypervisor eq "vbox");
|
| 1107 |
|
|
if ($networkid1 eq '0') {
|
| 1108 |
|
|
$networktype1 = "user";
|
| 1109 |
|
|
$networkforward1 = "nat";
|
| 1110 |
|
|
$networkisolated1 = "yes"
|
| 1111 |
|
|
} elsif ($networkid1 == 1) {
|
| 1112 |
|
|
$networktype1 = "network" ;
|
| 1113 |
|
|
$networkforward1 = "nat";
|
| 1114 |
|
|
$networkisolated1 = "yes"
|
| 1115 |
|
|
} elsif ($networkid1 > 1) {
|
| 1116 |
|
|
$networktype1 = "bridge";
|
| 1117 |
|
|
$networksource1 = "br$networkid1";
|
| 1118 |
|
|
}
|
| 1119 |
|
|
my $networktype2 = "user";
|
| 1120 |
|
|
my $networksource2 = "default";
|
| 1121 |
|
|
my $networkforward2 = "bridge";
|
| 1122 |
|
|
my $networkisolated2 = "no";
|
| 1123 |
|
|
$networksource2 = "vboxnet0" if ($hypervisor eq "vbox");
|
| 1124 |
|
|
if ($networkid2 eq '0') {
|
| 1125 |
|
|
$networktype2 = "user";
|
| 1126 |
|
|
$networkforward2 = "nat";
|
| 1127 |
|
|
$networkisolated2 = "yes"
|
| 1128 |
|
|
} elsif ($networkid2 == 1) {
|
| 1129 |
|
|
$networktype2 = "network" ;
|
| 1130 |
|
|
$networkforward2 = "nat";
|
| 1131 |
|
|
$networkisolated2 = "yes"
|
| 1132 |
|
|
} elsif ($networkid2 > 1) {
|
| 1133 |
|
|
$networktype2 = "bridge";
|
| 1134 |
|
|
$networksource2 = "br$networkid2";
|
| 1135 |
|
|
}
|
| 1136 |
|
|
my $networktype3 = "user";
|
| 1137 |
|
|
my $networksource3 = "default";
|
| 1138 |
|
|
my $networkforward3 = "bridge";
|
| 1139 |
|
|
my $networkisolated3 = "no";
|
| 1140 |
|
|
$networksource3 = "vboxnet0" if ($hypervisor eq "vbox");
|
| 1141 |
|
|
if ($networkid3 eq '0') {
|
| 1142 |
|
|
$networktype3 = "user";
|
| 1143 |
|
|
$networkforward3 = "nat";
|
| 1144 |
|
|
$networkisolated3 = "yes"
|
| 1145 |
|
|
} elsif ($networkid3 == 1) {
|
| 1146 |
|
|
$networktype3 = "network" ;
|
| 1147 |
|
|
$networkforward3 = "nat";
|
| 1148 |
|
|
$networkisolated3 = "yes"
|
| 1149 |
|
|
} elsif ($networkid3 > 1) {
|
| 1150 |
|
|
$networktype3 = "bridge";
|
| 1151 |
|
|
$networksource3 = "br$networkid3";
|
| 1152 |
|
|
}
|
| 1153 |
|
|
|
| 1154 |
|
|
my $xml = "<domain type='$hypervisor' xmlns:qemu='http://libvirt.org/schemas/domain/qemu/1.0'>\n";
|
| 1155 |
|
|
# if ($vgpu && $vgpu ne "--") {
|
| 1156 |
|
|
# $xml .= <<ENDXML2
|
| 1157 |
|
|
# <qemu:commandline>
|
| 1158 |
|
|
# <qemu:arg value='-device'/>
|
| 1159 |
|
|
# <qemu:arg value='vfio-pci,host=01:00.0,x-vga=on'/>
|
| 1160 |
|
|
# <qemu:arg value='-device'/>
|
| 1161 |
|
|
# <qemu:arg value='vfio-pci,host=02:00.0,x-vga=on'/>
|
| 1162 |
|
|
# </qemu:commandline>
|
| 1163 |
|
|
#ENDXML2
|
| 1164 |
|
|
# ;
|
| 1165 |
|
|
# }
|
| 1166 |
|
|
|
| 1167 |
|
|
# <qemu:arg value='-set'/>
|
| 1168 |
|
|
# <qemu:arg value='device.hostdev1.x-vga=on'/>
|
| 1169 |
|
|
# <qemu:arg value='-cpu'/>
|
| 1170 |
|
|
# <qemu:arg value='host,kvm=off'/>
|
| 1171 |
|
|
# <qemu:arg value='-device'/>
|
| 1172 |
|
|
# <qemu:arg value='pci-assign,host=01:00.0,id=hostdev0,configfd=20,bus=pci.0,addr=0x6,x-pci-vendor-id=0x10DE,x-pci-device-id=0x11BA,x-pci-sub-vendor-id=0x10DE,x-pci-sub-device-id=0x0965'/>
|
| 1173 |
|
|
|
| 1174 |
|
|
# <cpu mode='host-model'>
|
| 1175 |
|
|
# <vendor>Intel</vendor>
|
| 1176 |
|
|
# <model>core2duo</model>
|
| 1177 |
|
|
# </cpu>
|
| 1178 |
|
|
|
| 1179 |
|
|
# <loader readonly='yes' type='pflash'>/usr/share/OVMF/OVMF_CODE.fd</loader>
|
| 1180 |
|
|
# <nvram template='/usr/share/OVMF/OVMF_VARS.fd'/>
|
| 1181 |
04c16f26
|
hq
|
my $loader_xml = <<ENDXML
|
| 1182 |
|
|
<bootmenu enable='yes' timeout='200'/>
|
| 1183 |
|
|
<smbios mode='sysinfo'/>
|
| 1184 |
|
|
ENDXML
|
| 1185 |
|
|
;
|
| 1186 |
|
|
if ($loader eq 'uefi') {
|
| 1187 |
|
|
$loader_xml = <<ENDXML
|
| 1188 |
|
|
<loader readonly='yes' secure='no' type='pflash'>/usr/share/ovmf/OVMF.fd</loader>
|
| 1189 |
|
|
<nvram template='/usr/share/OVMF/OVMF_VARS.fd'>/tmp/guest_VARS.fd</nvram>
|
| 1190 |
|
|
ENDXML
|
| 1191 |
|
|
;
|
| 1192 |
|
|
}
|
| 1193 |
95b003ff
|
Origo
|
|
| 1194 |
705b5366
|
hq
|
if ($vgpu && $vgpu ne "--") {
|
| 1195 |
|
|
$xml .= <<ENDXML
|
| 1196 |
95b003ff
|
Origo
|
<cpu mode='host-passthrough'>
|
| 1197 |
|
|
<feature policy='disable' name='hypervisor'/>
|
| 1198 |
|
|
</cpu>
|
| 1199 |
|
|
ENDXML
|
| 1200 |
|
|
;
|
| 1201 |
705b5366
|
hq
|
} else {
|
| 1202 |
|
|
$xml .= <<ENDXML
|
| 1203 |
|
|
<cpu mode='host-model'>
|
| 1204 |
|
|
</cpu>
|
| 1205 |
|
|
ENDXML
|
| 1206 |
|
|
;
|
| 1207 |
95b003ff
|
Origo
|
}
|
| 1208 |
|
|
$xml .= <<ENDXML
|
| 1209 |
|
|
<name>$uname</name>
|
| 1210 |
|
|
<uuid>$uuid</uuid>
|
| 1211 |
|
|
<memory>$mem</memory>
|
| 1212 |
|
|
<vcpu>$vcpu</vcpu>
|
| 1213 |
|
|
<os>
|
| 1214 |
|
|
<type arch='x86_64' machine='pc'>hvm</type>
|
| 1215 |
|
|
<boot dev='$boot'/>
|
| 1216 |
04c16f26
|
hq
|
$loader_xml
|
| 1217 |
95b003ff
|
Origo
|
</os>
|
| 1218 |
|
|
<sysinfo type='smbios'>
|
| 1219 |
|
|
<bios>
|
| 1220 |
|
|
<entry name='vendor'>Origo</entry>
|
| 1221 |
|
|
</bios>
|
| 1222 |
|
|
<system>
|
| 1223 |
|
|
<entry name='manufacturer'>Origo</entry>
|
| 1224 |
|
|
<entry name='sku'>$networkid1ip</entry>
|
| 1225 |
|
|
</system>
|
| 1226 |
|
|
</sysinfo>
|
| 1227 |
|
|
<features>
|
| 1228 |
|
|
ENDXML
|
| 1229 |
|
|
;
|
| 1230 |
|
|
if ($vgpu && $vgpu ne "--") { $xml .= <<ENDXML
|
| 1231 |
|
|
<kvm>
|
| 1232 |
|
|
<hidden state='on'/>
|
| 1233 |
|
|
</kvm>
|
| 1234 |
|
|
ENDXML
|
| 1235 |
|
|
;
|
| 1236 |
|
|
}
|
| 1237 |
|
|
$xml .= <<ENDXML
|
| 1238 |
|
|
<pae/>
|
| 1239 |
|
|
<acpi/>
|
| 1240 |
|
|
<apic/>
|
| 1241 |
|
|
</features>
|
| 1242 |
|
|
<clock offset='localtime'>
|
| 1243 |
|
|
<timer name='rtc' tickpolicy='catchup' track='guest'/>
|
| 1244 |
|
|
<timer name='pit' tickpolicy='delay'/>
|
| 1245 |
|
|
<timer name='hpet' present='no'/>
|
| 1246 |
|
|
</clock>
|
| 1247 |
|
|
<on_poweroff>destroy</on_poweroff>
|
| 1248 |
04c16f26
|
hq
|
<on_reboot>restart</on_reboot>½
|
| 1249 |
95b003ff
|
Origo
|
<on_crash>restart</on_crash>
|
| 1250 |
|
|
<devices>
|
| 1251 |
e837d785
|
hq
|
<sound model='ich6'/>
|
| 1252 |
95b003ff
|
Origo
|
ENDXML
|
| 1253 |
|
|
;
|
| 1254 |
|
|
# if ($vgpu && $vgpu ne "--") {
|
| 1255 |
|
|
# $xml .= <<ENDXML2
|
| 1256 |
|
|
# <hostdev mode='subsystem' type='pci' managed='yes'>
|
| 1257 |
|
|
# <source>
|
| 1258 |
|
|
# <address domain='0x0000' bus='0x01' slot='0x00' function='0x0' multifunction='on'/>
|
| 1259 |
|
|
# </source>
|
| 1260 |
|
|
# </hostdev>
|
| 1261 |
|
|
# <hostdev mode='subsystem' type='pci' managed='yes'>
|
| 1262 |
|
|
# <source>
|
| 1263 |
|
|
# <address domain='0x0000' bus='0x02' slot='0x00' function='0x0' multifunction='on'/>
|
| 1264 |
|
|
# </source>
|
| 1265 |
|
|
# </hostdev>
|
| 1266 |
|
|
#ENDXML2
|
| 1267 |
|
|
#;
|
| 1268 |
|
|
# }
|
| 1269 |
|
|
if ($image && $image ne "" && $image ne "--") {
|
| 1270 |
|
|
$xml .= <<ENDXML2
|
| 1271 |
|
|
<disk type='file' device='disk'>
|
| 1272 |
|
|
<source file='$image'/>$driver1
|
| 1273 |
|
|
<target dev='$diskdev' bus='$diskbus'/>
|
| 1274 |
|
|
</disk>
|
| 1275 |
|
|
ENDXML2
|
| 1276 |
|
|
;
|
| 1277 |
|
|
};
|
| 1278 |
|
|
|
| 1279 |
|
|
if ($image2 && $image2 ne "" && $image2 ne "--") {
|
| 1280 |
|
|
$xml .= <<ENDXML2
|
| 1281 |
|
|
<disk type='file' device='disk'>$driver2
|
| 1282 |
|
|
<source file='$image2'/>
|
| 1283 |
|
|
<target dev='$diskdev2' bus='$diskbus'/>
|
| 1284 |
|
|
</disk>
|
| 1285 |
|
|
ENDXML2
|
| 1286 |
|
|
;
|
| 1287 |
|
|
};
|
| 1288 |
|
|
if ($image3 && $image3 ne "" && $image3 ne "--") {
|
| 1289 |
|
|
$xml .= <<ENDXML2
|
| 1290 |
|
|
<disk type='file' device='disk'>$driver3
|
| 1291 |
|
|
<source file='$image3'/>
|
| 1292 |
|
|
<target dev='$diskdev3' bus='$diskbus'/>
|
| 1293 |
|
|
</disk>
|
| 1294 |
|
|
ENDXML2
|
| 1295 |
|
|
;
|
| 1296 |
|
|
};
|
| 1297 |
|
|
if ($image4 && $image4 ne "" && $image4 ne "--") {
|
| 1298 |
|
|
$xml .= <<ENDXML2
|
| 1299 |
|
|
<disk type='file' device='disk'>$driver4
|
| 1300 |
|
|
<source file='$image4'/>
|
| 1301 |
|
|
<target dev='$diskdev4' bus='$diskbus'/>
|
| 1302 |
|
|
</disk>
|
| 1303 |
|
|
ENDXML2
|
| 1304 |
|
|
;
|
| 1305 |
|
|
};
|
| 1306 |
|
|
|
| 1307 |
|
|
unless ($image4 && $image4 ne '--' && $diskbus eq 'ide') {
|
| 1308 |
|
|
if ($cdrom && $cdrom ne "" && $cdrom ne "--") {
|
| 1309 |
|
|
$xml .= <<ENDXML3
|
| 1310 |
|
|
<disk type='file' device='cdrom'>
|
| 1311 |
|
|
<source file='$cdrom'/>
|
| 1312 |
|
|
<target dev='hdd' bus='ide'/>
|
| 1313 |
|
|
<readonly/>
|
| 1314 |
|
|
</disk>
|
| 1315 |
|
|
ENDXML3
|
| 1316 |
|
|
;
|
| 1317 |
|
|
} elsif ($hypervisor ne "vbox") {
|
| 1318 |
|
|
$xml .= <<ENDXML3
|
| 1319 |
|
|
<disk type='file' device='cdrom'>
|
| 1320 |
|
|
<target dev='hdd' bus='ide'/>
|
| 1321 |
|
|
<readonly/>
|
| 1322 |
|
|
</disk>
|
| 1323 |
|
|
ENDXML3
|
| 1324 |
|
|
;
|
| 1325 |
|
|
}
|
| 1326 |
|
|
}
|
| 1327 |
|
|
|
| 1328 |
|
|
$xml .= <<ENDXML4
|
| 1329 |
|
|
<interface type='$networktype1'>
|
| 1330 |
|
|
<source $networktype1='$networksource1'/>
|
| 1331 |
|
|
<forward mode='$networkforward1'/>
|
| 1332 |
|
|
<port isolated='$networkisolated1'/>
|
| 1333 |
|
|
<model type='$nicmodel1'/>
|
| 1334 |
|
|
<mac address='$nicmac1'/>
|
| 1335 |
|
|
</interface>
|
| 1336 |
|
|
ENDXML4
|
| 1337 |
|
|
;
|
| 1338 |
|
|
|
| 1339 |
|
|
if (($networkuuid2 && $networkuuid2 ne '--') || $networkuuid2 eq '0') {
|
| 1340 |
|
|
$xml .= <<ENDXML5
|
| 1341 |
|
|
<interface type='$networktype2'>
|
| 1342 |
|
|
<source $networktype2='$networksource2'/>
|
| 1343 |
|
|
<forward mode='$networkforward2'/>
|
| 1344 |
|
|
<port isolated='$networkisolated2'/>
|
| 1345 |
|
|
<model type='$nicmodel1'/>
|
| 1346 |
|
|
<mac address='$nicmac2'/>
|
| 1347 |
|
|
</interface>
|
| 1348 |
|
|
ENDXML5
|
| 1349 |
|
|
;
|
| 1350 |
|
|
}
|
| 1351 |
|
|
if (($networkuuid3 && $networkuuid3 ne '--') || $networkuuid3 eq '0') {
|
| 1352 |
|
|
$xml .= <<ENDXML5
|
| 1353 |
|
|
<interface type='$networktype3'>
|
| 1354 |
|
|
<source $networktype3='$networksource3'/>
|
| 1355 |
|
|
<forward mode='$networkforward3'/>
|
| 1356 |
|
|
<port isolated='$networkisolated3'/>
|
| 1357 |
|
|
<model type='$nicmodel1'/>
|
| 1358 |
|
|
<mac address='$nicmac3'/>
|
| 1359 |
|
|
</interface>
|
| 1360 |
|
|
ENDXML5
|
| 1361 |
|
|
;
|
| 1362 |
|
|
}
|
| 1363 |
|
|
$xml .= <<ENDXML6
|
| 1364 |
|
|
<serial type='pty'>
|
| 1365 |
|
|
<source path='/dev/pts/0'/>
|
| 1366 |
|
|
<target port='0'/>
|
| 1367 |
|
|
</serial>
|
| 1368 |
|
|
<input type='tablet' bus='usb'/>
|
| 1369 |
|
|
<graphics type='$graphics' port='$port'/>
|
| 1370 |
|
|
</devices>
|
| 1371 |
|
|
</domain>
|
| 1372 |
|
|
ENDXML6
|
| 1373 |
|
|
;
|
| 1374 |
|
|
|
| 1375 |
|
|
|
| 1376 |
|
|
# <graphics type='$graphics' port='$port' keymap='en-us'/>
|
| 1377 |
|
|
# <console type='pty' tty='/dev/pts/0'>
|
| 1378 |
|
|
# <source path='/dev/pts/0'/>
|
| 1379 |
|
|
# <target port='0'/>
|
| 1380 |
|
|
# </console>
|
| 1381 |
|
|
# <graphics type='$graphics' port='-1' autoport='yes'/>
|
| 1382 |
|
|
|
| 1383 |
|
|
$xmlreg{$uuid} = {
|
| 1384 |
|
|
xml=>URI::Escape::uri_escape($xml)
|
| 1385 |
|
|
};
|
| 1386 |
|
|
|
| 1387 |
|
|
# Actually ask node to start domain
|
| 1388 |
|
|
if ($targetmac) {
|
| 1389 |
|
|
$register{$uuid}->{'mac'} = $targetmac;
|
| 1390 |
|
|
$register{$uuid}->{'macname'} = $targetname;
|
| 1391 |
|
|
$register{$uuid}->{'macip'} = $targetip;
|
| 1392 |
|
|
|
| 1393 |
|
|
my $tasks = $nodereg{$targetmac}->{'tasks'};
|
| 1394 |
|
|
$tasks .= "START $uuid $user\n";
|
| 1395 |
|
|
# Also update allowed port forwards - obsolete
|
| 1396 |
|
|
# $tasks .= "PERMITOPEN $user\n";
|
| 1397 |
|
|
$nodereg{$targetmac}->{'tasks'} = $tasks;
|
| 1398 |
|
|
tied(%nodereg)->commit;
|
| 1399 |
|
|
$uiuuid = $uuid;
|
| 1400 |
|
|
$uidisplayip = $targetip;
|
| 1401 |
|
|
$uidisplayport = $port;
|
| 1402 |
|
|
$register{$uuid}->{'status'} = $uistatus;
|
| 1403 |
|
|
$register{$uuid}->{'statustime'} = $current_time;
|
| 1404 |
|
|
tied(%register)->commit;
|
| 1405 |
|
|
|
| 1406 |
|
|
# Activate networks
|
| 1407 |
|
|
require "$Stabile::basedir/cgi/networks.cgi";
|
| 1408 |
|
|
Stabile::Networks::Activate($networkuuid1, 'activate');
|
| 1409 |
|
|
Stabile::Networks::Activate($networkuuid2, 'activate') if ($networkuuid2 && $networkuuid2 ne '--');
|
| 1410 |
|
|
Stabile::Networks::Activate($networkuuid3, 'activate') if ($networkuuid3 && $networkuuid3 ne '--');
|
| 1411 |
|
|
|
| 1412 |
|
|
$main::syslogit->($user, "info", "Marked $name ($uuid) for ". $serv->{'status'} . " on $targetname ($targetmac)");
|
| 1413 |
|
|
$postreply .= "Status=starting OK $uistatus ". $serv->{'name'} . "\n";
|
| 1414 |
|
|
} else {
|
| 1415 |
|
|
$main::syslogit->($user, "info", "Could not find $hypervisor target for creating $uuid ($image)");
|
| 1416 |
|
|
$postreply .= "Status=ERROR problem $uistatus ". $serv->{'name'} . " (unable to locate target node)\n";
|
| 1417 |
|
|
};
|
| 1418 |
|
|
} else {
|
| 1419 |
|
|
$main::syslogit->($user, "info", "Problem $uistatus a $dbstatus domain: $uuid");
|
| 1420 |
|
|
$postreply .= "Status=ERROR problem $uistatus ". $serv->{'name'} . "\n";
|
| 1421 |
|
|
}
|
| 1422 |
|
|
#return ($uiuuid, $uidisplayip, $uidisplayport, $postreply, $targetmac);
|
| 1423 |
|
|
return $postreply;
|
| 1424 |
|
|
}
|
| 1425 |
|
|
|
| 1426 |
|
|
sub do_attach {
|
| 1427 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1428 |
|
|
if ($help) {
|
| 1429 |
|
|
return <<END
|
| 1430 |
|
|
GET:uuid,image:
|
| 1431 |
|
|
Attaches an image to a server as a disk device. Image must not be in use.
|
| 1432 |
|
|
END
|
| 1433 |
|
|
}
|
| 1434 |
|
|
my $dev = '';
|
| 1435 |
|
|
my $imagenum = 0;
|
| 1436 |
|
|
my $serv = $register{$uuid};
|
| 1437 |
|
|
|
| 1438 |
|
|
if (!$serv->{'uuid'} || ($serv->{'status'} ne 'running' && $serv->{'status'} ne 'paused')) {
|
| 1439 |
|
|
return "Status=Error Server must exist and be running\n";
|
| 1440 |
|
|
}
|
| 1441 |
|
|
my $macip = $serv->{macip};
|
| 1442 |
|
|
my $image = $obj->{image} || $obj->{path};
|
| 1443 |
|
|
if ($image && !($image =~ /^\//)) { # We have a uuid
|
| 1444 |
|
|
unless ( tie(%imagereg2,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Status=Error Unable to access images register\n"};
|
| 1445 |
|
|
$image = $imagereg2{$image}->{'path'} if ($imagereg2{$image});
|
| 1446 |
|
|
untie %imagereg2;
|
| 1447 |
|
|
}
|
| 1448 |
|
|
unless (tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$postreply .= "Status=Error Unable to access images register\n"; return $postreply;};
|
| 1449 |
|
|
unless ($macip && $imagereg{$image} && $imagereg{$image}->{'user'} eq $user && $serv->{'user'} eq $user) {$postreply .= "Status=Error Invalid image or server\n"; return $postreply;};
|
| 1450 |
|
|
if ($imagereg{$image}->{'status'} ne 'unused') {return "Status=Error Image $image is already in use ($imagereg{$image}->{'status'})\n"};
|
| 1451 |
|
|
|
| 1452 |
|
|
my $cmd = qq|$sshcmd $macip "LIBVIRT_DEFAULT_URI=qemu:///system virsh domblklist $uuid"|;
|
| 1453 |
|
|
my $res = `$cmd`;
|
| 1454 |
|
|
unless ($res =~ /vdb\s+.+/) {$dev = 'vdb'; $imagenum = 2};
|
| 1455 |
|
|
unless ($dev || $res =~ /vdc\s+.+/) {$dev = 'vdc'; $imagenum = 3};
|
| 1456 |
|
|
unless ($dev || $res =~ /vdd\s+.+/) {$dev = 'vdd'; $imagenum = 4};
|
| 1457 |
|
|
if (!$dev) {
|
| 1458 |
|
|
$postreply = "Status=Error No more images can be attached\n";
|
| 1459 |
|
|
} else {
|
| 1460 |
|
|
my $xml = <<END
|
| 1461 |
|
|
<disk type='file' device='disk'>
|
| 1462 |
|
|
<driver type='qcow2' name='qemu' cache='default'/>
|
| 1463 |
|
|
<source file='$image'/>
|
| 1464 |
|
|
<target dev='$dev' bus='virtio'/>
|
| 1465 |
|
|
</disk>
|
| 1466 |
|
|
END
|
| 1467 |
|
|
;
|
| 1468 |
|
|
$cmd = qq|$sshcmd $macip "echo \\"$xml\\" > /tmp/attach-device-$uuid.xml"|;
|
| 1469 |
|
|
$res = `$cmd`;
|
| 1470 |
|
|
$res .= `$sshcmd $macip LIBVIRT_DEFAULT_URI=qemu:///system virsh attach-device $uuid /tmp/attach-device-$uuid.xml`;
|
| 1471 |
|
|
chomp $res;
|
| 1472 |
|
|
if ($res =~ /successfully/) {
|
| 1473 |
|
|
$postreply .= "Status=OK Attaching $image to $dev\n";
|
| 1474 |
|
|
$imagereg{$image}->{'status'} = 'active';
|
| 1475 |
|
|
$imagereg{$image}->{'domains'} = $uuid;
|
| 1476 |
|
|
$imagereg{$image}->{'domainnames'} = $serv->{'name'};
|
| 1477 |
|
|
$serv->{"image$imagenum"} = $image;
|
| 1478 |
|
|
$serv->{"image$imagenum"."name"} = $imagereg{$image}->{'name'};
|
| 1479 |
|
|
$serv->{"image$imagenum"."type"} = 'qcow2';
|
| 1480 |
|
|
} else {
|
| 1481 |
|
|
$postreply .= "Status=Error Unable to attach image $image to $dev ($res)\n";
|
| 1482 |
|
|
}
|
| 1483 |
|
|
}
|
| 1484 |
|
|
untie %imagereg;
|
| 1485 |
|
|
return $postreply;
|
| 1486 |
|
|
}
|
| 1487 |
|
|
|
| 1488 |
|
|
sub do_detach {
|
| 1489 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1490 |
|
|
if ($help) {
|
| 1491 |
|
|
return <<END
|
| 1492 |
|
|
GET:uuid,image:
|
| 1493 |
|
|
Detaches a disk device and the associated image from a running server. All associated file-systems within the server should be unmounted before detaching, otherwise data loss i very probable. Use with care.
|
| 1494 |
|
|
END
|
| 1495 |
|
|
}
|
| 1496 |
|
|
my $dev = '';
|
| 1497 |
|
|
my $serv = $register{$uuid};
|
| 1498 |
|
|
|
| 1499 |
|
|
if (!$serv->{'uuid'} || ($serv->{'status'} ne 'running' && $serv->{'status'} ne 'paused')) {
|
| 1500 |
|
|
return "Status=Error Server must exist and be running\n";
|
| 1501 |
|
|
}
|
| 1502 |
|
|
my $macip = $serv->{macip};
|
| 1503 |
|
|
|
| 1504 |
|
|
my $image = $obj->{image} || $obj->{path} || $serv->{'image2'};
|
| 1505 |
|
|
if ($image && !($image =~ /^\//)) { # We have a uuid
|
| 1506 |
|
|
unless ( tie(%imagereg2,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 1507 |
|
|
$image = $imagereg2{$image}->{'path'} if ($imagereg2{$image});
|
| 1508 |
|
|
untie %imagereg2;
|
| 1509 |
|
|
}
|
| 1510 |
|
|
unless (tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$postreply .= "Status=Error Unable to access images register\n"; return $postreply;};
|
| 1511 |
|
|
unless ($macip && $imagereg{$image} && $imagereg{$image}->{'user'} eq $user && $serv->{'user'} eq $user) {$postreply .= "Status=Error Invalid image or server. Server must have a secondary image attached.\n"; return $postreply;};
|
| 1512 |
|
|
|
| 1513 |
|
|
my $cmd = qq|$sshcmd $macip "LIBVIRT_DEFAULT_URI=qemu:///system virsh domblklist $uuid"|;
|
| 1514 |
|
|
my $res = `$cmd`;
|
| 1515 |
|
|
$dev = $1 if ($res =~ /(vd.)\s+.+$image/);
|
| 1516 |
|
|
if (!$dev) {
|
| 1517 |
|
|
$postreply = qq|Status=Error Image $image, $cmd, is not currently attached\n|;
|
| 1518 |
|
|
} elsif ($dev eq 'vda') {
|
| 1519 |
|
|
$postreply = "Status=Error You cannot detach the primary image\n";
|
| 1520 |
|
|
} else {
|
| 1521 |
|
|
$res = `$sshcmd $macip LIBVIRT_DEFAULT_URI=qemu:///system virsh detach-disk $uuid $dev`;
|
| 1522 |
|
|
chomp $res;
|
| 1523 |
|
|
if ($res =~ /successfully/) {
|
| 1524 |
|
|
$postreply .= "Status=OK Detaching image $image, $imagereg{$image}->{'uuid'} from $dev\n";
|
| 1525 |
|
|
my $imagenum;
|
| 1526 |
|
|
$imagenum = 2 if ($serv->{'image2'} eq $image);
|
| 1527 |
|
|
$imagenum = 3 if ($serv->{'image3'} eq $image);
|
| 1528 |
|
|
$imagenum = 4 if ($serv->{'image4'} eq $image);
|
| 1529 |
|
|
$imagereg{$image}->{'status'} = 'unused';
|
| 1530 |
|
|
$imagereg{$image}->{'domains'} = '';
|
| 1531 |
|
|
$imagereg{$image}->{'domainnames'} = '';
|
| 1532 |
|
|
if ($imagenum) {
|
| 1533 |
|
|
$serv->{"image$imagenum"} = '';
|
| 1534 |
|
|
$serv->{"image$imagenum"."name"} = '';
|
| 1535 |
|
|
$serv->{"image$imagenum"."type"} = '';
|
| 1536 |
|
|
}
|
| 1537 |
|
|
} else {
|
| 1538 |
|
|
$postreply .= "Status=Error Unable to attach image $image to $dev ($res)\n";
|
| 1539 |
|
|
}
|
| 1540 |
|
|
}
|
| 1541 |
|
|
untie %imagereg;
|
| 1542 |
|
|
return $postreply;
|
| 1543 |
|
|
}
|
| 1544 |
|
|
|
| 1545 |
|
|
sub Destroy {
|
| 1546 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1547 |
|
|
if ($help) {
|
| 1548 |
|
|
return <<END
|
| 1549 |
|
|
GET:uuid,wait:
|
| 1550 |
|
|
Marks a server for halt, i.e. pull the plug if regular shutdown does not work or is not desired. Server and storage is preserved.
|
| 1551 |
|
|
END
|
| 1552 |
|
|
}
|
| 1553 |
|
|
my $uistatus = 'destroying';
|
| 1554 |
|
|
my $name = $register{$uuid}->{'name'};
|
| 1555 |
|
|
my $mac = $register{$uuid}->{'mac'};
|
| 1556 |
|
|
my $macname = $register{$uuid}->{'macname'};
|
| 1557 |
|
|
my $dbstatus = $register{$uuid}->{'status'};
|
| 1558 |
|
|
my $wait = $obj->{'wait'};
|
| 1559 |
|
|
if ($dbstatus eq 'running' or $dbstatus eq 'paused'
|
| 1560 |
|
|
or $dbstatus eq 'shuttingdown' or $dbstatus eq 'starting'
|
| 1561 |
|
|
or $dbstatus eq 'destroying' or $dbstatus eq 'upgrading'
|
| 1562 |
|
|
or $dbstatus eq 'suspending' or $dbstatus eq 'resuming') {
|
| 1563 |
|
|
if ($wait) {
|
| 1564 |
6372a66e
|
hq
|
my $username = $register{$uuid}->{'user'} || $user;
|
| 1565 |
|
|
$username = $user unless ($isadmin);
|
| 1566 |
|
|
$postreply = destroyUserServers($username, 1, $uuid);
|
| 1567 |
95b003ff
|
Origo
|
} else {
|
| 1568 |
6372a66e
|
hq
|
my $node = $nodereg{$mac};
|
| 1569 |
|
|
my $tasks = $node->{'tasks'};
|
| 1570 |
|
|
$node->{'tasks'} = $tasks . "DESTROY $uuid $user\n";
|
| 1571 |
95b003ff
|
Origo
|
tied(%nodereg)->commit;
|
| 1572 |
|
|
$register{$uuid}->{'status'} = $uistatus;
|
| 1573 |
|
|
$register{$uuid}->{'statustime'} = $current_time;
|
| 1574 |
|
|
$uiuuid = $uuid;
|
| 1575 |
|
|
$main::syslogit->($user, "info", "Marked $name ($uuid) for $uistatus on $macname ($mac)");
|
| 1576 |
|
|
$postreply .= "Status=destroying $uistatus ". $register{$uuid}->{'name'} . "\n";
|
| 1577 |
|
|
}
|
| 1578 |
|
|
} else {
|
| 1579 |
|
|
$main::syslogit->($user, "info", "Problem $uistatus a $dbstatus domain: $name ($uuid)");
|
| 1580 |
|
|
$postreply .= "Status=ERROR problem $uistatus $name\n";
|
| 1581 |
|
|
}
|
| 1582 |
|
|
return $postreply;
|
| 1583 |
|
|
}
|
| 1584 |
|
|
|
| 1585 |
|
|
sub getHypervisor {
|
| 1586 |
|
|
my $image = shift;
|
| 1587 |
|
|
# Produce a mapping of image file suffixes to hypervisors
|
| 1588 |
|
|
my %idreg;
|
| 1589 |
|
|
unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities', key=>'identity'}, $Stabile::dbopts)) ) {return "Unable to access nodeidentities register"};
|
| 1590 |
|
|
my @idvalues = values %idreg;
|
| 1591 |
|
|
my %formats;
|
| 1592 |
|
|
foreach my $val (@idvalues) {
|
| 1593 |
|
|
my %h = %$val;
|
| 1594 |
|
|
foreach (split(/,/,$h{'formats'})) {
|
| 1595 |
|
|
$formats{lc $_} = $h{'hypervisor'}
|
| 1596 |
|
|
}
|
| 1597 |
|
|
}
|
| 1598 |
|
|
untie %idreg;
|
| 1599 |
|
|
|
| 1600 |
|
|
# and then determine the hypervisor in question
|
| 1601 |
|
|
my $hypervisor = "vbox";
|
| 1602 |
|
|
my ($pathname, $path, $suffix) = fileparse($image, '\.[^\.]*');
|
| 1603 |
|
|
$suffix = substr $suffix, 1;
|
| 1604 |
|
|
my $hypervisor = $formats{lc $suffix};
|
| 1605 |
|
|
return $hypervisor;
|
| 1606 |
|
|
}
|
| 1607 |
|
|
|
| 1608 |
|
|
sub nicmac1ToUuid {
|
| 1609 |
|
|
my $nicmac1 = shift;
|
| 1610 |
|
|
my $uuid;
|
| 1611 |
|
|
return $uuid unless $nicmac1;
|
| 1612 |
|
|
my @regkeys = (tied %register)->select_where("user = '$user' AND nicmac1 = '$nicmac1");
|
| 1613 |
|
|
foreach my $k (@regkeys) {
|
| 1614 |
|
|
my $val = $register{$k};
|
| 1615 |
|
|
my %h = %$val;
|
| 1616 |
|
|
if (lc $h{'nicmac1'} eq lc $nicmac1 && $user eq $h{'user'}) {
|
| 1617 |
|
|
$uuid = $h{'uuid'};
|
| 1618 |
|
|
last;
|
| 1619 |
|
|
}
|
| 1620 |
|
|
}
|
| 1621 |
|
|
return $uuid;
|
| 1622 |
|
|
}
|
| 1623 |
|
|
|
| 1624 |
|
|
sub randomMac {
|
| 1625 |
|
|
my ( %vendor, $lladdr, $i );
|
| 1626 |
|
|
# $lladdr = '00';
|
| 1627 |
|
|
$lladdr = '52:54:00';# KVM vendor string
|
| 1628 |
|
|
while ( ++$i )
|
| 1629 |
|
|
# { last if $i > 10;
|
| 1630 |
|
|
{ last if $i > 6;
|
| 1631 |
|
|
$lladdr .= ':' if $i % 2;
|
| 1632 |
|
|
$lladdr .= sprintf "%" . ( qw (X x) [int ( rand ( 2 ) ) ] ), int ( rand ( 16 ) );
|
| 1633 |
|
|
}
|
| 1634 |
|
|
return $lladdr;
|
| 1635 |
|
|
}
|
| 1636 |
|
|
|
| 1637 |
|
|
sub overQuotas {
|
| 1638 |
|
|
my $meminc = shift;
|
| 1639 |
|
|
my $vcpuinc = shift;
|
| 1640 |
|
|
my $usedmemory = 0;
|
| 1641 |
|
|
my $usedvcpus = 0;
|
| 1642 |
|
|
my $overquota = 0;
|
| 1643 |
|
|
return $overquota if ($isadmin || $Stabile::userprivileges =~ /a/); # Don't enforce quotas for admins
|
| 1644 |
|
|
|
| 1645 |
|
|
my $memoryquota = $usermemoryquota;
|
| 1646 |
|
|
my $vcpuquota = $uservcpuquota;
|
| 1647 |
|
|
|
| 1648 |
|
|
if (!$memoryquota || !$vcpuquota) { # 0 or empty quota means use defaults
|
| 1649 |
|
|
$memoryquota = $memoryquota || $Stabile::config->get('MEMORY_QUOTA');
|
| 1650 |
|
|
$vcpuquota = $vcpuquota || $Stabile::config->get('VCPU_QUOTA');
|
| 1651 |
|
|
}
|
| 1652 |
|
|
|
| 1653 |
|
|
my @regkeys = (tied %register)->select_where("user = '$user'");
|
| 1654 |
|
|
foreach my $k (@regkeys) {
|
| 1655 |
|
|
my $val = $register{$k};
|
| 1656 |
|
|
if ($val->{'user'} eq $user && $val->{'status'} ne "shutoff" &&
|
| 1657 |
|
|
$val->{'status'} ne "inactive" && $val->{'status'} ne "shutdown" ) {
|
| 1658 |
|
|
|
| 1659 |
|
|
$usedmemory += $val->{'memory'};
|
| 1660 |
|
|
$usedvcpus += $val->{'vcpu'};
|
| 1661 |
|
|
}
|
| 1662 |
|
|
}
|
| 1663 |
|
|
$overquota = $usedmemory+$meminc if ($memoryquota!=-1 && $usedmemory+$meminc > $memoryquota); # -1 means no quota
|
| 1664 |
|
|
$overquota = $usedvcpus+$vcpuinc if ($vcpuquota!=-1 && $usedvcpus+$vcpuinc > $vcpuquota);
|
| 1665 |
|
|
return $overquota;
|
| 1666 |
|
|
}
|
| 1667 |
|
|
|
| 1668 |
|
|
sub validateItem {
|
| 1669 |
|
|
my $valref = shift;
|
| 1670 |
|
|
my $img = $imagereg{$valref->{'image'}};
|
| 1671 |
|
|
my $imagename = $img->{'name'};
|
| 1672 |
|
|
$valref->{'imagename'} = $imagename if ($imagename);
|
| 1673 |
|
|
my $imagetype = $img->{'type'};
|
| 1674 |
|
|
$valref->{'imagetype'} = $imagetype if ($imagetype);
|
| 1675 |
|
|
|
| 1676 |
|
|
# imagex may be registered by uuid instead of path - find the path
|
| 1677 |
|
|
# We now support up to 4 images
|
| 1678 |
|
|
for (my $i=2; $i<=4; $i++) {
|
| 1679 |
|
|
if ($valref->{"image$i"} && $valref->{"image$i"} ne '--' && !($valref->{"image$i"} =~ /^\//)) {
|
| 1680 |
|
|
unless ( tie(%imagereg2,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 1681 |
|
|
$valref->{"image$i"} = $imagereg2{$valref->{"image$i"}}->{'path'};
|
| 1682 |
|
|
untie %imagereg2;
|
| 1683 |
|
|
}
|
| 1684 |
|
|
|
| 1685 |
|
|
my $imgi = $imagereg{$valref->{"image$i"}};
|
| 1686 |
|
|
$valref->{"image$i" . 'name'} = $imgi->{'name'} || $valref->{"image$i" . 'name'};
|
| 1687 |
|
|
$valref->{"image$i" . 'type'} = $imgi->{'type'} || $valref->{"image$i" . 'type'};
|
| 1688 |
|
|
}
|
| 1689 |
|
|
|
| 1690 |
|
|
my $net1 = $networkreg{$valref->{'networkuuid1'}};
|
| 1691 |
|
|
my $networkname1 = $net1->{'name'};
|
| 1692 |
|
|
$valref->{'networkname1'} = $networkname1 if ($networkname1);
|
| 1693 |
|
|
my $net2 = $networkreg{$valref->{'networkuuid2'}};
|
| 1694 |
|
|
my $networkname2 = $net2->{'name'};
|
| 1695 |
|
|
$valref->{'networkname2'} = $networkname2 if ($networkname2);
|
| 1696 |
|
|
my $name = $valref->{'name'};
|
| 1697 |
|
|
$valref->{'name'} = $imagename unless $name;
|
| 1698 |
|
|
|
| 1699 |
|
|
if ($valref->{'status'} eq "shutoff" || $valref->{'status'} eq "inactive") {
|
| 1700 |
|
|
my $node = $nodereg{$valref->{'mac'}};
|
| 1701 |
|
|
if ($valref->{'image'} =~ /\/mnt\/stabile\/node\//) {
|
| 1702 |
|
|
$valref->{'mac'} = $img->{'mac'};
|
| 1703 |
|
|
$valref->{'macname'} = $node->{'name'};
|
| 1704 |
|
|
$valref->{'macip'} = $node->{'ip'};
|
| 1705 |
|
|
} elsif ($valref->{'image2'} =~ /\/mnt\/stabile\/node\//) {
|
| 1706 |
|
|
$valref->{'mac'} = $imagereg{$valref->{'image2'}}->{'mac'};
|
| 1707 |
|
|
$valref->{'macname'} = $node->{'name'};
|
| 1708 |
|
|
$valref->{'macip'} = $node->{'ip'};
|
| 1709 |
|
|
} elsif ($valref->{'image3'} =~ /\/mnt\/stabile\/node\//) {
|
| 1710 |
|
|
$valref->{'mac'} = $imagereg{$valref->{'image3'}}->{'mac'};
|
| 1711 |
|
|
$valref->{'macname'} = $node->{'name'};
|
| 1712 |
|
|
$valref->{'macip'} = $node->{'ip'};
|
| 1713 |
|
|
} elsif ($valref->{'image4'} =~ /\/mnt\/stabile\/node\//) {
|
| 1714 |
|
|
$valref->{'mac'} = $imagereg{$valref->{'image4'}}->{'mac'};
|
| 1715 |
|
|
$valref->{'macname'} = $node->{'name'};
|
| 1716 |
|
|
$valref->{'macip'} = $node->{'ip'};
|
| 1717 |
|
|
}
|
| 1718 |
|
|
}
|
| 1719 |
|
|
# Mark domains we have heard from in the last 20 secs as inactive
|
| 1720 |
|
|
my $dbtimestamp = 0;
|
| 1721 |
|
|
$dbtimestamp = $register{$valref->{'uuid'}}->{'timestamp'} if ($register{$valref->{'uuid'}});
|
| 1722 |
|
|
my $timediff = $current_time - $dbtimestamp;
|
| 1723 |
|
|
if ($timediff >= 20) {
|
| 1724 |
|
|
if (! ($valref->{'status'} eq "shutoff"
|
| 1725 |
|
|
|| $valref->{'status'} eq "starting"
|
| 1726 |
|
|
# || $valref->{'status'} eq "shuttingdown"
|
| 1727 |
|
|
# || $valref->{'status'} eq "destroying"
|
| 1728 |
|
|
|| ($valref->{'status'} eq "moving" && $timediff<40)
|
| 1729 |
|
|
)) { # Move has probably failed
|
| 1730 |
|
|
$valref->{'status'} = "inactive";
|
| 1731 |
|
|
$imagereg{$valref->{'image'}}->{'status'} = "used" if ($valref->{'image'} && $imagereg{$valref->{'image'}});
|
| 1732 |
|
|
$imagereg{$valref->{'image2'}}->{'status'} = "used" if ($valref->{'image2'} && $imagereg{$valref->{'imag2'}});
|
| 1733 |
|
|
$imagereg{$valref->{'image3'}}->{'status'} = "used" if ($valref->{'image3'} && $imagereg{$valref->{'image3'}});
|
| 1734 |
|
|
$imagereg{$valref->{'image4'}}->{'status'} = "used" if ($valref->{'image4'} && $imagereg{$valref->{'image4'}});
|
| 1735 |
|
|
}
|
| 1736 |
|
|
};
|
| 1737 |
|
|
return $valref;
|
| 1738 |
|
|
}
|
| 1739 |
|
|
|
| 1740 |
|
|
# Run through all domains and mark domains we have heard from in the last 20 secs as inactive
|
| 1741 |
|
|
sub updateRegister {
|
| 1742 |
|
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Unable to access user register"};
|
| 1743 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 1744 |
|
|
|
| 1745 |
|
|
my @regkeys = (tied %register)->select_where("user = '$user'");
|
| 1746 |
|
|
|
| 1747 |
|
|
foreach my $k (@regkeys) {
|
| 1748 |
|
|
my $valref = $register{$k};
|
| 1749 |
|
|
next unless ($userreg{$valref->{'user'}});
|
| 1750 |
|
|
my $dbtimestamp = $valref->{'timestamp'};
|
| 1751 |
|
|
my $dbstatus = $valref->{'status'};
|
| 1752 |
|
|
my $timediff = $current_time - $dbtimestamp;
|
| 1753 |
|
|
my $imgstatus;
|
| 1754 |
|
|
my $domstatus;
|
| 1755 |
|
|
if ($timediff >= 20) {
|
| 1756 |
|
|
if ( $valref->{'status'} eq "shutoff" ) {
|
| 1757 |
|
|
$imgstatus = 'used';
|
| 1758 |
|
|
} elsif (( $valref->{'status'} eq "starting"
|
| 1759 |
|
|
|| $valref->{'status'} eq "shuttingdown"
|
| 1760 |
|
|
) && $timediff>50) {
|
| 1761 |
|
|
$imgstatus = 'used';
|
| 1762 |
|
|
$domstatus = 'inactive';
|
| 1763 |
|
|
} elsif ($valref->{'status'} eq "destroying" || $valref->{'status'} eq "moving") {
|
| 1764 |
|
|
;
|
| 1765 |
|
|
} else {
|
| 1766 |
|
|
$domstatus = 'inactive';
|
| 1767 |
|
|
$imgstatus = 'used';
|
| 1768 |
|
|
}
|
| 1769 |
|
|
$valref->{'status'} = $domstatus if ($domstatus);
|
| 1770 |
|
|
my $image = $valref->{'image'};
|
| 1771 |
|
|
my $image2 = $valref->{'image2'};
|
| 1772 |
|
|
my $image3 = $valref->{'image3'};
|
| 1773 |
|
|
my $image4 = $valref->{'image4'};
|
| 1774 |
|
|
$imagereg{$image}->{'status'} = $imgstatus if ($imgstatus);
|
| 1775 |
|
|
$imagereg{$image2}->{'status'} = $imgstatus if ($image2 && $imgstatus);
|
| 1776 |
|
|
$imagereg{$image3}->{'status'} = $imgstatus if ($image3 && $imgstatus);
|
| 1777 |
|
|
$imagereg{$image4}->{'status'} = $imgstatus if ($image4 && $imgstatus);
|
| 1778 |
|
|
if ($domstatus eq 'inactive ' && $dbstatus ne 'inactive') {
|
| 1779 |
|
|
$main::updateUI->({ tab=>'servers',
|
| 1780 |
|
|
user=>$valref->{'user'},
|
| 1781 |
|
|
uuid=>$valref->{'uuid'},
|
| 1782 |
|
|
sender=>'updateRegister',
|
| 1783 |
|
|
status=>'inactive'})
|
| 1784 |
|
|
}
|
| 1785 |
|
|
};
|
| 1786 |
|
|
|
| 1787 |
|
|
}
|
| 1788 |
|
|
untie %userreg;
|
| 1789 |
|
|
untie %imagereg;
|
| 1790 |
|
|
}
|
| 1791 |
|
|
|
| 1792 |
|
|
|
| 1793 |
|
|
sub locateTargetNode {
|
| 1794 |
|
|
my ($uuid, $dmac, $mem, $vcpu, $image, $image2, $image3, $image4, $hypervisor, $smac)= @_;
|
| 1795 |
|
|
my $targetname;
|
| 1796 |
|
|
my $targetip;
|
| 1797 |
|
|
my $port;
|
| 1798 |
|
|
my $targetnode;
|
| 1799 |
|
|
my $targetindex; # Availability index of located target node
|
| 1800 |
|
|
my %avhash;
|
| 1801 |
|
|
|
| 1802 |
|
|
my $mnode = $register{$uuid};
|
| 1803 |
|
|
$dmac = $mnode->{'mac'}
|
| 1804 |
|
|
if (!$dmac
|
| 1805 |
|
|
&& $mnode->{'locktonode'} eq 'true'
|
| 1806 |
|
|
&& $mnode->{'mac'}
|
| 1807 |
|
|
&& $mnode->{'mac'} ne '--'
|
| 1808 |
|
|
);
|
| 1809 |
|
|
|
| 1810 |
|
|
$dmac = '' unless ($isadmin); # Only allow admins to select specific node
|
| 1811 |
|
|
if ($dmac && !$nodereg{$dmac}) {
|
| 1812 |
|
|
$main::syslogit->($user, "info", "The target node $dmac no longer exists, starting $uuid on another node if possible");
|
| 1813 |
|
|
$dmac = '';
|
| 1814 |
|
|
}
|
| 1815 |
|
|
|
| 1816 |
|
|
my $imageonnode = ($image =~ /\/mnt\/stabile\/node\//
|
| 1817 |
|
|
|| $image2 =~ /\/mnt\/stabile\/node\//
|
| 1818 |
|
|
|| $image3 =~ /\/mnt\/stabile\/node\//
|
| 1819 |
|
|
|| $image4 =~ /\/mnt\/stabile\/node\//
|
| 1820 |
|
|
);
|
| 1821 |
|
|
|
| 1822 |
|
|
foreach $node (values %nodereg) {
|
| 1823 |
|
|
my $nstatus = $node->{'status'};
|
| 1824 |
|
|
my $maintenance = $node->{'maintenance'};
|
| 1825 |
|
|
my $nmac = $node->{'mac'};
|
| 1826 |
|
|
|
| 1827 |
|
|
if (($nstatus eq 'running' || $nstatus eq 'asleep' || $nstatus eq 'maintenance' || $nstatus eq 'waking')
|
| 1828 |
|
|
&& $smac ne $nmac
|
| 1829 |
|
|
&& (( ($node->{'memfree'} > $mem+512*1024)
|
| 1830 |
|
|
&& (($node->{'vmvcpus'} + $vcpu) <= ($cpuovercommision * $node->{'cpucores'} * $node->{'cpucount'})) ) || $action eq 'listnodeavailability')
|
| 1831 |
|
|
) {
|
| 1832 |
|
|
# Determine how available this node is
|
| 1833 |
|
|
# Available memory
|
| 1834 |
|
|
my $memweight = 0.2; # memory weighing factor
|
| 1835 |
|
|
my $memindex = $avhash{$nmac}->{'memindex'} = int(100* $memweight* $node->{'memfree'} / (1024*1024) )/100;
|
| 1836 |
|
|
# Free cores
|
| 1837 |
|
|
my $cpuindex = $avhash{$nmac}->{'cpuindex'} = int(100*($cpuovercommision * $node->{'cpucores'} * $node->{'cpucount'} - $node->{'vmvcpus'} - $node->{'reservedvcpus'}))/100;
|
| 1838 |
|
|
# Asleep - not asleep gives a +3
|
| 1839 |
|
|
my $sleepindex = $avhash{$nmac}->{'sleepindex'} = ($node->{'status'} eq 'asleep' || $node->{'status'} eq 'waking')?'0':'3';
|
| 1840 |
|
|
$avhash{$nmac}->{'vmvcpus'} = $node->{'vmvcpus'};
|
| 1841 |
|
|
# $avhash{$nmac}->{'cpucommision'} = $cpuovercommision * $node->{'cpucores'} * $node->{'cpucount'};
|
| 1842 |
|
|
# $avhash{$nmac}->{'cpureservation'} = $node->{'vmvcpus'} + $node->{'reservedvcpus'};
|
| 1843 |
|
|
|
| 1844 |
|
|
$avhash{$nmac}->{'name'} = $node->{'name'};
|
| 1845 |
|
|
$avhash{$nmac}->{'mac'} = $node->{'mac'};
|
| 1846 |
|
|
|
| 1847 |
|
|
my $aindex = $memindex + $cpuindex + $sleepindex;
|
| 1848 |
|
|
# Don't use nodes that are out of memory of cores
|
| 1849 |
|
|
$aindex = 0 if ($memindex <= 0 || $cpuindex <= 0);
|
| 1850 |
|
|
$avhash{$nmac}->{'index'} = $aindex;
|
| 1851 |
|
|
|
| 1852 |
|
|
$avhash{$nmac}->{'storfree'} = $node->{'storfree'};
|
| 1853 |
c899e439
|
Origo
|
$avhash{$nmac}->{'memfree'} = $node->{'memfree'};
|
| 1854 |
95b003ff
|
Origo
|
$avhash{$nmac}->{'ip'} = $node->{'ip'};
|
| 1855 |
|
|
$avhash{$nmac}->{'identity'} = $node->{'identity'};
|
| 1856 |
|
|
$avhash{$nmac}->{'status'} = $node->{'status'};
|
| 1857 |
|
|
$avhash{$nmac}->{'maintenance'} = $maintenance;
|
| 1858 |
|
|
$avhash{$nmac}->{'reservedvcpus'} = $node->{'reservedvcpus'};
|
| 1859 |
|
|
my $nodeidentity = $node->{'identity'};
|
| 1860 |
|
|
$nodeidentity = 'kvm' if ($nodeidentity eq 'local_kvm');
|
| 1861 |
|
|
|
| 1862 |
|
|
if ($hypervisor eq $nodeidentity) {
|
| 1863 |
|
|
# If image is on node, we must start on same node - registered when moving image
|
| 1864 |
|
|
if ($imageonnode) {
|
| 1865 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 1866 |
|
|
$dmac = $imagereg{$image}->{'mac'};
|
| 1867 |
|
|
$dmac = $imagereg{$image2}->{'mac'} unless ($dmac);
|
| 1868 |
|
|
$dmac = $imagereg{$image3}->{'mac'} unless ($dmac);
|
| 1869 |
|
|
$dmac = $imagereg{$image4}->{'mac'} unless ($dmac);
|
| 1870 |
|
|
|
| 1871 |
|
|
untie %imagereg;
|
| 1872 |
|
|
if (!$dmac) {
|
| 1873 |
|
|
$postreply .= "Status=ERROR Image node not found\n";
|
| 1874 |
|
|
last;
|
| 1875 |
|
|
}
|
| 1876 |
|
|
}
|
| 1877 |
|
|
$dmac = "" if ($dmac eq "--");
|
| 1878 |
a439a9c4
|
hq
|
# If a specific node is asked for, match mac addresses
|
| 1879 |
95b003ff
|
Origo
|
if ($dmac eq $nmac) {
|
| 1880 |
|
|
$targetnode = $node;
|
| 1881 |
|
|
last;
|
| 1882 |
|
|
} elsif (!$dmac && $nstatus ne "maintenance" && !$maintenance) {
|
| 1883 |
|
|
# pack or disperse
|
| 1884 |
|
|
if (!$targetindex) {
|
| 1885 |
|
|
$targetindex = $aindex;
|
| 1886 |
|
|
$targetnode = $node;
|
| 1887 |
|
|
} elsif ($dpolicy eq 'pack') {
|
| 1888 |
|
|
if ($aindex < $targetindex) {
|
| 1889 |
|
|
$targetnode = $node;
|
| 1890 |
|
|
$targetindex = $aindex;
|
| 1891 |
|
|
}
|
| 1892 |
|
|
} else {
|
| 1893 |
|
|
if ($aindex > $targetindex) {
|
| 1894 |
|
|
$targetnode = $node;
|
| 1895 |
|
|
$targetindex = $aindex;
|
| 1896 |
|
|
}
|
| 1897 |
|
|
}
|
| 1898 |
|
|
}
|
| 1899 |
|
|
}
|
| 1900 |
|
|
}
|
| 1901 |
|
|
}
|
| 1902 |
|
|
|
| 1903 |
|
|
if ($targetnode && $uuid) {
|
| 1904 |
|
|
if ($targetnode->{'status'} eq 'asleep') {
|
| 1905 |
|
|
my $nmac = $targetnode->{'mac'};
|
| 1906 |
|
|
my $realmac = substr($nmac,0,2).":".substr($nmac,2,2).":".substr($nmac,4,2).":".substr($nmac,6,2).":".substr($nmac,8,2).":".substr($nmac,10,2);
|
| 1907 |
|
|
my $nlogmsg = "Node $nmac marked for wake ";
|
| 1908 |
|
|
if ($brutalsleep && (
|
| 1909 |
|
|
($targetnode->{'amtip'} && $targetnode->{'amtip'} ne '--')
|
| 1910 |
|
|
|| ($targetnode->{'ipmiip'} && $targetnode->{'ipmiip'} ne '--')
|
| 1911 |
|
|
)) {
|
| 1912 |
|
|
my $wakecmd;
|
| 1913 |
|
|
if ($targetnode->{'amtip'} && $targetnode->{'amtip'} ne '--') {
|
| 1914 |
|
|
$wakecmd = "echo 'y' | AMT_PASSWORD='$amtpasswd' /usr/bin/amttool $targetnode->{'amtip'} powerup pxe";
|
| 1915 |
|
|
} else {
|
| 1916 |
|
|
$wakecmd = "ipmitool -I lanplus -H $targetnode->{'ipmiip'} -U ADMIN -P ADMIN power on";
|
| 1917 |
|
|
}
|
| 1918 |
|
|
$nlogmsg .= `$wakecmd`;
|
| 1919 |
|
|
} else {
|
| 1920 |
|
|
my $broadcastip = $targetnode->{'ip'};
|
| 1921 |
|
|
$broadcastip =~ s/\.\d{1,3}$/.255/;
|
| 1922 |
|
|
$nlogmsg .= 'on lan ' . `/usr/bin/wakeonlan -i $broadcastip $realmac`;
|
| 1923 |
|
|
}
|
| 1924 |
|
|
$targetnode->{'status'} = "waking";
|
| 1925 |
|
|
$nlogmsg =~ s/\n/ /g;
|
| 1926 |
|
|
$main::syslogit->($user, "info", $nlogmsg);
|
| 1927 |
|
|
$postreply .= "Status=OK waking $targetnode->{'name'}\n";
|
| 1928 |
|
|
}
|
| 1929 |
|
|
$targetname = $targetnode->{'name'};
|
| 1930 |
|
|
$targetmac = $targetnode->{'mac'};
|
| 1931 |
|
|
$targetip = $targetnode->{'ip'};
|
| 1932 |
|
|
$targetip = $targetnode->{'ip'};
|
| 1933 |
|
|
my $porttaken = 1;
|
| 1934 |
|
|
while ($porttaken) {
|
| 1935 |
|
|
$porttaken = 0;
|
| 1936 |
|
|
$port = $targetnode->{'vms'} + (($hypervisor eq "vbox")?3389:5900);
|
| 1937 |
|
|
$port += int(rand(200));
|
| 1938 |
|
|
my @regkeys = (tied %register)->select_where("port = '$port' AND macip = '$targetip'");
|
| 1939 |
|
|
foreach my $k (@regkeys) {
|
| 1940 |
|
|
$r = $register{$k};
|
| 1941 |
|
|
if ($r->{'port'} eq $port && $r->{'macip'} eq $targetip) {
|
| 1942 |
|
|
$porttaken = 1;
|
| 1943 |
|
|
}
|
| 1944 |
|
|
}
|
| 1945 |
|
|
}
|
| 1946 |
|
|
$targetnode->{'vms'}++;
|
| 1947 |
|
|
$targetnode->{'vmvcpus'} += $vcpu;
|
| 1948 |
|
|
$register{$uuid}->{'port'} = $port;
|
| 1949 |
|
|
# $register{$uuid}->{'mac'} = $targetmac;
|
| 1950 |
|
|
# $register{$uuid}->{'macname'} = $targetname;
|
| 1951 |
|
|
# $register{$uuid}->{'macip'} = $targetip;
|
| 1952 |
|
|
$register{$uuid}->{'display'} = (($hypervisor eq "vbox")?'rdp':'vnc');
|
| 1953 |
|
|
} else {
|
| 1954 |
|
|
my $macstatus;
|
| 1955 |
|
|
$macstatus = $nodereg{$dmac}->{status} if ($nodereg{$dmac});
|
| 1956 |
|
|
$main::syslogit->($user, "info", "Could not find target for $uuid, $dmac, $mem, $vcpu, $image, $image2,$image3,$image4, $hypervisor, $smac, dmac-status: $macstatus") if ($uuid);
|
| 1957 |
|
|
}
|
| 1958 |
|
|
return ($targetmac, $targetname, $targetip, $port, \%avhash);
|
| 1959 |
|
|
}
|
| 1960 |
|
|
|
| 1961 |
|
|
sub destroyUserServers {
|
| 1962 |
|
|
my $username = shift;
|
| 1963 |
|
|
my $wait = shift; # Should we wait for servers do die
|
| 1964 |
|
|
my $duuid = shift;
|
| 1965 |
6372a66e
|
hq
|
return unless ($username && ($isadmin || $user eq $username));
|
| 1966 |
95b003ff
|
Origo
|
my @updateList;
|
| 1967 |
|
|
|
| 1968 |
|
|
my @regkeys = (tied %register)->select_where("user = '$username'");
|
| 1969 |
|
|
foreach my $uuid (@regkeys) {
|
| 1970 |
|
|
if ($register{$uuid}->{'user'} eq $username
|
| 1971 |
|
|
&& $register{$uuid}->{'status'} ne 'shutoff'
|
| 1972 |
|
|
&& (!$duuid || $duuid eq $uuid)
|
| 1973 |
|
|
) {
|
| 1974 |
|
|
$postreply .= "Destroying $username server $register{$uuid}->{'name'}, $uuid\n";
|
| 1975 |
|
|
Destroy($uuid);
|
| 1976 |
|
|
push (@updateList,{ tab=>'servers',
|
| 1977 |
|
|
user=>$user,
|
| 1978 |
|
|
uuid=>$duuid,
|
| 1979 |
|
|
status=>'destroying'});
|
| 1980 |
|
|
}
|
| 1981 |
|
|
}
|
| 1982 |
|
|
$main::updateUI->(@updateList) if (@updateList);
|
| 1983 |
|
|
if ($wait) {
|
| 1984 |
|
|
my @regkeys = (tied %register)->select_where("user = '$username'");
|
| 1985 |
|
|
my $activeservers = 1;
|
| 1986 |
|
|
my $i = 0;
|
| 1987 |
6372a66e
|
hq
|
while ($activeservers && $i<30) {
|
| 1988 |
95b003ff
|
Origo
|
$activeservers = 0;
|
| 1989 |
|
|
foreach my $k (@regkeys) {
|
| 1990 |
|
|
my $valref = $register{$k};
|
| 1991 |
|
|
if ($username eq $valref->{'user'}
|
| 1992 |
|
|
&& ($valref->{'status'} ne 'shutoff'
|
| 1993 |
|
|
&& $valref->{'status'} ne 'inactive')
|
| 1994 |
|
|
&& (!$duuid || $duuid eq $valref->{'uuid'})
|
| 1995 |
|
|
) {
|
| 1996 |
|
|
$activeservers = $valref->{'uuid'};
|
| 1997 |
|
|
}
|
| 1998 |
|
|
}
|
| 1999 |
|
|
$i++;
|
| 2000 |
|
|
if ($activeservers) {
|
| 2001 |
|
|
my $res .= "Status=OK Waiting $i for server $register{$activeservers}->{'name'}, $register{$activeservers}->{'status'} to die...\n";
|
| 2002 |
9de5a3f1
|
hq
|
# print $res if ($console);
|
| 2003 |
95b003ff
|
Origo
|
$postreply .= $res;
|
| 2004 |
|
|
sleep 2;
|
| 2005 |
|
|
}
|
| 2006 |
|
|
}
|
| 2007 |
|
|
$postreply .= "Status=OK Servers halted for $username\n" unless ($activeservers);
|
| 2008 |
|
|
}
|
| 2009 |
|
|
return $postreply;
|
| 2010 |
|
|
}
|
| 2011 |
|
|
|
| 2012 |
|
|
sub removeUserServers {
|
| 2013 |
|
|
my $username = shift;
|
| 2014 |
|
|
my $uuid = shift;
|
| 2015 |
|
|
my $destroy = shift; # Should running servers be destroyed before removing
|
| 2016 |
|
|
return unless (($isadmin || $user eq $username) && !$isreadonly);
|
| 2017 |
|
|
$user = $username;
|
| 2018 |
|
|
my @regkeys = (tied %register)->select_where("user = '$username'");
|
| 2019 |
|
|
foreach my $ruuid (@regkeys) {
|
| 2020 |
|
|
next if ($uuid && $ruuid ne $uuid);
|
| 2021 |
|
|
if ($destroy && $register{$ruuid}->{'user'} eq $username && ($register{$ruuid}->{'status'} ne 'shutoff' && $register{$ruuid}->{'status'} ne 'inactive')) {
|
| 2022 |
|
|
destroyUserServers($username, 1, $ruuid);
|
| 2023 |
|
|
}
|
| 2024 |
|
|
|
| 2025 |
|
|
if ($register{$ruuid}->{'user'} eq $username && ($register{$ruuid}->{'status'} eq 'shutoff' || $register{$ruuid}->{'status'} eq 'inactive')) {
|
| 2026 |
|
|
$postreply .= "Removing $username server $register{$ruuid}->{'name'}, $ruuid" . ($console?'':'<br>') . "\n";
|
| 2027 |
|
|
Remove($ruuid);
|
| 2028 |
|
|
}
|
| 2029 |
|
|
}
|
| 2030 |
|
|
}
|
| 2031 |
|
|
|
| 2032 |
|
|
sub Remove {
|
| 2033 |
|
|
my ($uuid, $action) = @_;
|
| 2034 |
|
|
if ($help) {
|
| 2035 |
|
|
return <<END
|
| 2036 |
|
|
DELETE:uuid:
|
| 2037 |
|
|
Removes a server. Server must be shutoff. Does not remove associated images or networks.
|
| 2038 |
|
|
END
|
| 2039 |
|
|
}
|
| 2040 |
|
|
my $reguser = $register{$uuid}->{'user'};
|
| 2041 |
|
|
my $dbstatus = $register{$uuid}->{'status'};
|
| 2042 |
|
|
my $image = $register{$uuid}->{'image'};
|
| 2043 |
|
|
my $image2 = $register{$uuid}->{'image2'};
|
| 2044 |
|
|
my $image3 = $register{$uuid}->{'image3'};
|
| 2045 |
|
|
my $image4 = $register{$uuid}->{'image4'};
|
| 2046 |
|
|
my $name = $register{$uuid}->{'name'};
|
| 2047 |
|
|
$image2 = '' if ($image2 eq '--');
|
| 2048 |
|
|
$image3 = '' if ($image3 eq '--');
|
| 2049 |
|
|
$image4 = '' if ($image4 eq '--');
|
| 2050 |
|
|
|
| 2051 |
|
|
if ($reguser ne $user) {
|
| 2052 |
|
|
$postreply .= "Status=ERROR You cannot delete a vm you don't own\n";
|
| 2053 |
|
|
} elsif ($dbstatus eq 'inactive' || $dbstatus eq 'shutdown' || $dbstatus eq 'shutoff') {
|
| 2054 |
|
|
|
| 2055 |
|
|
# Delete software packages and monitors from register
|
| 2056 |
|
|
$postmsg .= deletePackages($uuid);
|
| 2057 |
|
|
my $sname = $register{$uuid}->{'name'};
|
| 2058 |
|
|
utf8::decode($sname);
|
| 2059 |
48fcda6b
|
Origo
|
$postmsg .= deleteMonitors($uuid)?" deleted monitors for $sname ":'';
|
| 2060 |
95b003ff
|
Origo
|
|
| 2061 |
|
|
delete $register{$uuid};
|
| 2062 |
|
|
delete $xmlreg{$uuid};
|
| 2063 |
|
|
|
| 2064 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 2065 |
|
|
$imagereg{$image}->{'status'} = "unused" if ($imagereg{$image});
|
| 2066 |
|
|
$imagereg{$image2}->{'status'} = "unused" if ($image2 && $imagereg{$image2});
|
| 2067 |
|
|
$imagereg{$image3}->{'status'} = "unused" if ($image3 && $imagereg{$image3});
|
| 2068 |
|
|
$imagereg{$image4}->{'status'} = "unused" if ($image4 && $imagereg{$image4});
|
| 2069 |
|
|
untie %imagereg;
|
| 2070 |
|
|
|
| 2071 |
|
|
# Delete metrics
|
| 2072 |
|
|
my $metricsdir = "/var/lib/graphite/whisper/domains/$uuid";
|
| 2073 |
|
|
`rm -r $metricsdir` if (-e $metricsdir);
|
| 2074 |
|
|
my $rrdfile = "/var/cache/rrdtool/".$uuid."_highres.rrd";
|
| 2075 |
|
|
`rm $rrdfile` if (-e $rrdfile);
|
| 2076 |
|
|
|
| 2077 |
|
|
$main::syslogit->($user, "info", "Deleted domain $uuid from db");
|
| 2078 |
|
|
utf8::decode($name);
|
| 2079 |
48fcda6b
|
Origo
|
$postmsg .= " deleted server $name";
|
| 2080 |
95b003ff
|
Origo
|
$postreply = "[]";
|
| 2081 |
|
|
sleep 1;
|
| 2082 |
|
|
} else {
|
| 2083 |
|
|
$postreply .= "Status=ERROR Cannot delete a $dbstatus server\n";
|
| 2084 |
|
|
}
|
| 2085 |
|
|
return $postreply;
|
| 2086 |
|
|
}
|
| 2087 |
|
|
|
| 2088 |
|
|
# Delete all monitors belonging to a server
|
| 2089 |
|
|
sub deleteMonitors {
|
| 2090 |
|
|
my ($serveruuid) = @_;
|
| 2091 |
|
|
my $match;
|
| 2092 |
|
|
if ($serveruuid) {
|
| 2093 |
|
|
if ($register{$serveruuid}->{'user'} eq $user || $isadmin) {
|
| 2094 |
|
|
local($^I, @ARGV) = ('.bak', "/etc/mon/mon.cf");
|
| 2095 |
|
|
# undef $/; # This makes <> read in the entire file in one go
|
| 2096 |
|
|
my $uuidmatch;
|
| 2097 |
|
|
while (<>) {
|
| 2098 |
|
|
if (/^watch (\S+)/) {
|
| 2099 |
|
|
if ($1 eq $serveruuid) {$uuidmatch = $serveruuid}
|
| 2100 |
|
|
else {$uuidmatch = ''};
|
| 2101 |
|
|
};
|
| 2102 |
|
|
if ($uuidmatch) {
|
| 2103 |
|
|
$match = 1;
|
| 2104 |
|
|
} else {
|
| 2105 |
|
|
#chomp;
|
| 2106 |
|
|
print unless (/^hostgroup $serveruuid/);
|
| 2107 |
|
|
}
|
| 2108 |
|
|
close ARGV if eof;
|
| 2109 |
|
|
}
|
| 2110 |
|
|
#$/ = "\n";
|
| 2111 |
|
|
}
|
| 2112 |
|
|
unlink glob "/var/log/stabile/*:$serveruuid:*";
|
| 2113 |
|
|
}
|
| 2114 |
|
|
`/usr/bin/moncmd reset keepstate` if ($match);
|
| 2115 |
|
|
return $match;
|
| 2116 |
|
|
}
|
| 2117 |
|
|
|
| 2118 |
|
|
sub deletePackages {
|
| 2119 |
|
|
my ($uuid, $issystem, %packreg) = @_;
|
| 2120 |
|
|
unless ( tie(%packreg,'Tie::DBI', Hash::Merge::merge({table=>'packages', key=>'id'}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 2121 |
|
|
|
| 2122 |
|
|
my @domains;
|
| 2123 |
|
|
if ($issystem) {
|
| 2124 |
|
|
foreach my $valref (values %register) {
|
| 2125 |
|
|
if (($valref->{'system'} eq $uuid || $uuid eq '*')
|
| 2126 |
|
|
&& ($valref->{'user'} eq $user || $fulllist)) {
|
| 2127 |
|
|
push(@domains, $valref->{'uuid'});
|
| 2128 |
|
|
}
|
| 2129 |
|
|
}
|
| 2130 |
|
|
} else { # Allow if domain no longer exists or belongs to user
|
| 2131 |
|
|
push(@domains, $uuid) if (!$register{$uuid} || $register{$uuid}->{'user'} eq $user || $fulllist);
|
| 2132 |
|
|
}
|
| 2133 |
|
|
|
| 2134 |
|
|
foreach my $domuuid (@domains) {
|
| 2135 |
|
|
foreach my $packref (values %packreg) {
|
| 2136 |
|
|
my $id = $packref->{'id'};
|
| 2137 |
|
|
if (substr($id, 0,36) eq $domuuid || ($uuid eq '*' && $packref->{'user'} eq $user)) {
|
| 2138 |
|
|
delete $packreg{$id};
|
| 2139 |
|
|
}
|
| 2140 |
|
|
}
|
| 2141 |
|
|
}
|
| 2142 |
|
|
tied(%packreg)->commit;# if (%packreg);
|
| 2143 |
|
|
if ($issystem) {
|
| 2144 |
|
|
my $sname = $register{$uuid}->{'name'};
|
| 2145 |
|
|
utf8::decode($sname);
|
| 2146 |
|
|
return "Status=OK Cleared packages for $sname\n";
|
| 2147 |
|
|
} elsif ($register{$uuid}) {
|
| 2148 |
|
|
my $sname = $register{$uuid}->{'name'};
|
| 2149 |
|
|
utf8::decode($sname);
|
| 2150 |
|
|
return "Status=OK Cleared packages for $sname\n";
|
| 2151 |
|
|
} else {
|
| 2152 |
|
|
return "Status=OK Cleared packages. System not registered\n";
|
| 2153 |
|
|
}
|
| 2154 |
|
|
}
|
| 2155 |
|
|
|
| 2156 |
|
|
sub Save {
|
| 2157 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2158 |
|
|
if ($help) {
|
| 2159 |
|
|
return <<END
|
| 2160 |
04c16f26
|
hq
|
POST:uuid, name, user, system, autostart, locktonode, mac, memory, vcpu, boot, loader, diskbus, nicmodel1, vgpu, cdrom, image, image2, image3, image4, networkuuid2, networkuuid3, networkuuid1, nicmac1, nicmac2, nicmac3:
|
| 2161 |
95b003ff
|
Origo
|
To save a servers of networks you either PUT or POST a JSON array to the main endpoint with objects representing the servers with the changes you want.
|
| 2162 |
|
|
Depending on your privileges not all changes are permitted. If you save without specifying a uuid, a new server is created.
|
| 2163 |
|
|
If you pass [user] parameter it is assumed you want to move server to this user's account.
|
| 2164 |
|
|
Supported parameters:
|
| 2165 |
|
|
|
| 2166 |
|
|
uuid: UUID
|
| 2167 |
|
|
name: string
|
| 2168 |
|
|
user: string
|
| 2169 |
48fcda6b
|
Origo
|
system: UUID of stack this server belongs to
|
| 2170 |
95b003ff
|
Origo
|
autostart: true|false
|
| 2171 |
|
|
locktonode: true|false
|
| 2172 |
|
|
mac: MAC address of target node
|
| 2173 |
|
|
|
| 2174 |
|
|
memory: int bytes
|
| 2175 |
|
|
vcpu: int
|
| 2176 |
|
|
boot: hd|cdrom|network
|
| 2177 |
04c16f26
|
hq
|
loader: bios|uefi
|
| 2178 |
95b003ff
|
Origo
|
diskbus: virtio|ide|scsi
|
| 2179 |
|
|
nicmodel1: virtio|rtl8139|ne2k_pci|e1000|i82551|i82557b|i82559er|pcnet
|
| 2180 |
|
|
vgpu: int
|
| 2181 |
|
|
|
| 2182 |
|
|
cdrom: string path
|
| 2183 |
|
|
image: string path
|
| 2184 |
|
|
image2: string path
|
| 2185 |
|
|
image3: string path
|
| 2186 |
|
|
image4: string path
|
| 2187 |
|
|
|
| 2188 |
|
|
networkuuid1: UUID of network connection
|
| 2189 |
|
|
networkuuid2: UUID of network connection
|
| 2190 |
|
|
networkuuid3: UUID of network connection
|
| 2191 |
|
|
|
| 2192 |
|
|
END
|
| 2193 |
|
|
}
|
| 2194 |
|
|
|
| 2195 |
|
|
# notes, opemail, opfullname, opphone, email, fullname, phone, services, recovery, alertemail
|
| 2196 |
|
|
# notes: string
|
| 2197 |
|
|
# opemail: string
|
| 2198 |
|
|
# opfullname: string
|
| 2199 |
|
|
# opphone: string
|
| 2200 |
|
|
# email: string
|
| 2201 |
|
|
# fullname: string
|
| 2202 |
|
|
# phone: string
|
| 2203 |
|
|
# services: string
|
| 2204 |
|
|
# recovery: string
|
| 2205 |
|
|
# alertemail: string
|
| 2206 |
|
|
|
| 2207 |
|
|
my $system = $obj->{system};
|
| 2208 |
|
|
my $newsystem = $obj->{newsystem};
|
| 2209 |
|
|
my $buildsystem = $obj->{buildsystem};
|
| 2210 |
|
|
my $nicmac1 = $obj->{nicmac1};
|
| 2211 |
|
|
$console = $console || $obj->{console};
|
| 2212 |
|
|
|
| 2213 |
|
|
$postmsg = '' if ($buildsystem);
|
| 2214 |
|
|
if (!$uuid && $nicmac1) {
|
| 2215 |
|
|
$uuid = nicmac1ToUuid($nicmac1); # If no uuid try to locate based on mac
|
| 2216 |
|
|
}
|
| 2217 |
|
|
if (!$uuid && $uripath =~ /servers(\.cgi)?\/(.+)/) { # Try to parse uuid out of URI
|
| 2218 |
|
|
my $huuid = $2;
|
| 2219 |
|
|
if ($ug->to_string($ug->from_string($huuid)) eq $huuid) { # Check for valid uuid
|
| 2220 |
|
|
$uuid = $huuid;
|
| 2221 |
|
|
}
|
| 2222 |
|
|
}
|
| 2223 |
|
|
my $regserv = $register{$uuid};
|
| 2224 |
|
|
my $status = $regserv->{'status'} || 'new';
|
| 2225 |
|
|
if ((!$uuid) && $status eq 'new') {
|
| 2226 |
|
|
my $ug = new Data::UUID;
|
| 2227 |
|
|
$uuid = $ug->create_str();
|
| 2228 |
|
|
};
|
| 2229 |
|
|
unless ($uuid && length $uuid == 36){
|
| 2230 |
48fcda6b
|
Origo
|
$postmsg = "Status=Error No valid uuid ($uuid), $obj->{image}";
|
| 2231 |
95b003ff
|
Origo
|
return $postmsg;
|
| 2232 |
|
|
}
|
| 2233 |
|
|
$nicmac1 = $nicmac1 || $regserv->{'nicmac1'};
|
| 2234 |
|
|
my $name = $obj->{name} || $regserv->{'name'};
|
| 2235 |
|
|
my $memory = $obj->{memory} || $regserv->{'memory'};
|
| 2236 |
|
|
my $vcpu = $obj->{vcpu} || $regserv->{'vcpu'};
|
| 2237 |
|
|
my $image = $obj->{image} || $regserv->{'image'};
|
| 2238 |
|
|
my $imagename = $obj->{imagename} || $regserv->{'imagename'};
|
| 2239 |
|
|
my $image2 = $obj->{image2} || $regserv->{'image2'};
|
| 2240 |
|
|
my $image2name = $obj->{image2name} || $regserv->{'image2name'};
|
| 2241 |
|
|
my $image3 = $obj->{image3} || $regserv->{'image3'};
|
| 2242 |
|
|
my $image3name = $obj->{image3name} || $regserv->{'image3name'};
|
| 2243 |
|
|
my $image4 = $obj->{image4} || $regserv->{'image4'};
|
| 2244 |
|
|
my $image4name = $obj->{image4name} || $regserv->{'image4name'};
|
| 2245 |
|
|
my $diskbus = $obj->{diskbus} || $regserv->{'diskbus'};
|
| 2246 |
|
|
my $cdrom = $obj->{cdrom} || $regserv->{'cdrom'};
|
| 2247 |
|
|
my $boot = $obj->{boot} || $regserv->{'boot'};
|
| 2248 |
04c16f26
|
hq
|
my $loader = $obj->{loader} || $regserv->{'loader'};
|
| 2249 |
95b003ff
|
Origo
|
my $networkuuid1 = ($obj->{networkuuid1} || $obj->{networkuuid1} eq '0')?$obj->{networkuuid1}:$regserv->{'networkuuid1'};
|
| 2250 |
|
|
my $networkid1 = $obj->{networkid1} || $regserv->{'networkid1'};
|
| 2251 |
|
|
my $networkname1 = $obj->{networkname1} || $regserv->{'networkname1'};
|
| 2252 |
|
|
my $nicmodel1 = $obj->{nicmodel1} || $regserv->{'nicmodel1'};
|
| 2253 |
|
|
my $networkuuid2 = ($obj->{networkuuid2} || $obj->{networkuuid2} eq '0')?$obj->{networkuuid2}:$regserv->{'networkuuid2'};
|
| 2254 |
|
|
my $networkid2 = $obj->{networkid2} || $regserv->{'networkid2'};
|
| 2255 |
|
|
my $networkname2 = $obj->{networkname2} || $regserv->{'networkname2'};
|
| 2256 |
|
|
my $nicmac2 = $obj->{nicmac2} || $regserv->{'nicmac2'};
|
| 2257 |
|
|
my $networkuuid3 = ($obj->{networkuuid3} || $obj->{networkuuid3} eq '0')?$obj->{networkuuid3}:$regserv->{'networkuuid3'};
|
| 2258 |
|
|
my $networkid3 = $obj->{networkid3} || $regserv->{'networkid3'};
|
| 2259 |
|
|
my $networkname3 = $obj->{networkname3} || $regserv->{'networkname3'};
|
| 2260 |
|
|
my $nicmac3 = $obj->{nicmac3} || $regserv->{'nicmac3'};
|
| 2261 |
|
|
my $notes = $obj->{notes} || $regserv->{'notes'};
|
| 2262 |
|
|
my $autostart = $obj->{autostart} || $regserv->{'autostart'};
|
| 2263 |
|
|
my $locktonode = $obj->{locktonode} || $regserv->{'locktonode'};
|
| 2264 |
|
|
my $mac = $obj->{mac} || $regserv->{'mac'};
|
| 2265 |
|
|
my $created = $regserv->{'created'} || time;
|
| 2266 |
|
|
# Sanity checks
|
| 2267 |
|
|
my $tenderpaths = $Stabile::config->get('STORAGE_POOLS_LOCAL_PATHS') || "/mnt/stabile/images";
|
| 2268 |
|
|
my @tenderpathslist = split(/,\s*/, $tenderpaths);
|
| 2269 |
|
|
|
| 2270 |
|
|
$networkid1 = $networkreg{$networkuuid1}->{'id'};
|
| 2271 |
|
|
my $networktype1 = $networkreg{$networkuuid1}->{'type'};
|
| 2272 |
|
|
my $networktype2;
|
| 2273 |
|
|
if (!$nicmac1 || $nicmac1 eq "--") {$nicmac1 = randomMac();}
|
| 2274 |
|
|
if ($networkuuid2 && $networkuuid2 ne "--") {
|
| 2275 |
|
|
$networkid2 = $networkreg{$networkuuid2}->{'id'};
|
| 2276 |
|
|
$nicmac2 = randomMac() if (!$nicmac2 || $nicmac2 eq "--");
|
| 2277 |
|
|
$networktype2 = $networkreg{$networkuuid2}->{'type'};
|
| 2278 |
|
|
}
|
| 2279 |
|
|
if ($networkuuid3 && $networkuuid3 ne "--") {
|
| 2280 |
|
|
$networkid3 = $networkreg{$networkuuid3}->{'id'};
|
| 2281 |
|
|
$networkname3 = $networkreg{$networkuuid3}->{'name'};
|
| 2282 |
|
|
$nicmac3 = randomMac() if (!$nicmac3 || $nicmac3 eq "--");
|
| 2283 |
|
|
$networktype3 = $networkreg{$networkuuid3}->{'type'};
|
| 2284 |
|
|
}
|
| 2285 |
|
|
|
| 2286 |
|
|
my $imgdup;
|
| 2287 |
|
|
my $netdup;
|
| 2288 |
|
|
my $json_text; # returned if all goes well
|
| 2289 |
|
|
|
| 2290 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 2291 |
|
|
|
| 2292 |
|
|
if ($networkid1 > 1 && $networkid2 > 1 && $networktype1 ne 'gateway' && $networktype2 ne 'gateway'
|
| 2293 |
|
|
&& $networkuuid1 eq $networkuuid2) {
|
| 2294 |
|
|
$netdup = 1;
|
| 2295 |
|
|
}
|
| 2296 |
|
|
if ($networkid1 > 1 && $networkid3 > 1 && $networktype1 ne 'gateway' && $networktype3 ne 'gateway'
|
| 2297 |
|
|
&& $networkuuid1 eq $networkuuid3) {
|
| 2298 |
|
|
$netdup = 11;
|
| 2299 |
|
|
}
|
| 2300 |
|
|
|
| 2301 |
|
|
if ($image eq $image2
|
| 2302 |
|
|
|| $image eq $image3
|
| 2303 |
|
|
|| $image eq $image4
|
| 2304 |
|
|
|| $image2 && $image2 ne '--' && $image2 eq $image3
|
| 2305 |
|
|
|| $image2 && $image2 ne '--' && $image2 eq $image4
|
| 2306 |
|
|
|| $image3 && $image3 ne '--' && $image3 eq $image4
|
| 2307 |
|
|
) {
|
| 2308 |
|
|
$imgdup = 1;
|
| 2309 |
|
|
} elsif ($image =~ m/\.master\.qcow2/
|
| 2310 |
|
|
|| $image2 =~ m/\.master\.qcow2/
|
| 2311 |
|
|
|| $image3 =~ m/\.master\.qcow2/
|
| 2312 |
|
|
|| $image4 =~ m/\.master\.qcow2/
|
| 2313 |
|
|
) {
|
| 2314 |
|
|
$imgdup = 2;
|
| 2315 |
|
|
} else {
|
| 2316 |
|
|
# Check if another server is using image
|
| 2317 |
|
|
my @regkeys = (tied %register)->select_where("user = '$user' OR user = 'common'");
|
| 2318 |
|
|
foreach my $k (@regkeys) {
|
| 2319 |
|
|
my $val = $register{$k};
|
| 2320 |
|
|
my %h = %$val;
|
| 2321 |
|
|
if ($h{'uuid'} ne $uuid) {
|
| 2322 |
|
|
if (
|
| 2323 |
|
|
$image eq $h{'image'} || $image eq $h{'image2'}|| $image eq $h{'image3'}|| $image eq $h{'image4'}
|
| 2324 |
|
|
) {
|
| 2325 |
|
|
$imgdup = 51;
|
| 2326 |
|
|
} elsif ($image2 && $image2 ne "--" &&
|
| 2327 |
|
|
($image2 eq $h{'image'} || $image2 eq $h{'image2'} || $image2 eq $h{'image3'} || $image2 eq $h{'image4'})
|
| 2328 |
|
|
) {
|
| 2329 |
|
|
$imgdup = 52;
|
| 2330 |
|
|
} elsif ($image3 && $image3 ne "--" &&
|
| 2331 |
|
|
($image3 eq $h{'image'} || $image3 eq $h{'image2'} || $image3 eq $h{'image3'} || $image3 eq $h{'image4'})
|
| 2332 |
|
|
) {
|
| 2333 |
|
|
$imgdup = 53;
|
| 2334 |
|
|
} elsif ($image4 && $image4 ne "--" &&
|
| 2335 |
|
|
($image4 eq $h{'image'} || $image4 eq $h{'image2'} || $image4 eq $h{'image3'} || $image4 eq $h{'image4'})
|
| 2336 |
|
|
) {
|
| 2337 |
|
|
$imgdup = 54;
|
| 2338 |
|
|
}
|
| 2339 |
|
|
|
| 2340 |
|
|
if ($networkid1>1) {
|
| 2341 |
|
|
if ($networktype1 ne 'gateway' &&
|
| 2342 |
|
|
($networkuuid1 eq $h{'networkuuid1'} || $networkuuid1 eq $h{'networkuuid2'})
|
| 2343 |
|
|
) {
|
| 2344 |
|
|
$netdup = 51;
|
| 2345 |
|
|
}
|
| 2346 |
|
|
}
|
| 2347 |
|
|
if ($networkid2>1) {
|
| 2348 |
|
|
if ($networktype2 ne 'gateway' && $networkuuid2 && $networkuuid2 ne "--" &&
|
| 2349 |
|
|
($networkuuid2 eq $h{'networkuuid1'} || $networkuuid2 eq $h{'networkuuid2'})
|
| 2350 |
|
|
) {
|
| 2351 |
|
|
$netdup = 52;
|
| 2352 |
|
|
}
|
| 2353 |
|
|
}
|
| 2354 |
|
|
}
|
| 2355 |
|
|
}
|
| 2356 |
|
|
my $legalpath;
|
| 2357 |
|
|
if ($image =~ m/\/mnt\/stabile\/node\/$user/) {
|
| 2358 |
|
|
$legalpath = 1;
|
| 2359 |
|
|
} else {
|
| 2360 |
|
|
foreach my $path (@tenderpathslist) {
|
| 2361 |
|
|
if ($image =~ m/$path\/$user/) {
|
| 2362 |
|
|
$legalpath = 1;
|
| 2363 |
|
|
last;
|
| 2364 |
|
|
}
|
| 2365 |
|
|
}
|
| 2366 |
|
|
}
|
| 2367 |
|
|
$imgdup = 6 unless $legalpath;
|
| 2368 |
|
|
if ($image2 && $image2 ne "--") { # TODO: We should probably check for conflicting nodes for image3 and image 4 too
|
| 2369 |
|
|
if ($image2 =~ m/\/mnt\/stabile\/node\/$user/) {
|
| 2370 |
|
|
if ($image =~ m/\/mnt\/stabile\/node\/$user/) {
|
| 2371 |
|
|
if ($imagereg{$image}->{'mac'} eq $imagereg{$image2}->{'mac'}) {
|
| 2372 |
|
|
$legalpath = 1;
|
| 2373 |
|
|
} else {
|
| 2374 |
|
|
$legalpath = 0; # Images are on two different nodes
|
| 2375 |
|
|
}
|
| 2376 |
|
|
} else {
|
| 2377 |
|
|
$legalpath = 1;
|
| 2378 |
|
|
}
|
| 2379 |
|
|
} else {
|
| 2380 |
|
|
$legalpath = 0;
|
| 2381 |
|
|
foreach my $path (@tenderpathslist) {
|
| 2382 |
|
|
if ($image2 =~ m/$path\/$user/) {
|
| 2383 |
|
|
$legalpath = 1;
|
| 2384 |
|
|
last;
|
| 2385 |
|
|
}
|
| 2386 |
|
|
}
|
| 2387 |
|
|
}
|
| 2388 |
|
|
$imgdup = 7 unless $legalpath;
|
| 2389 |
|
|
}
|
| 2390 |
|
|
}
|
| 2391 |
|
|
|
| 2392 |
|
|
if (!$imgdup && !$netdup) {
|
| 2393 |
|
|
if ($status eq "new") {
|
| 2394 |
|
|
$status = "shutoff";
|
| 2395 |
|
|
$name = $name || 'New Server';
|
| 2396 |
|
|
$memory = $memory || 1024;
|
| 2397 |
|
|
$vcpu = $vcpu || 1;
|
| 2398 |
|
|
$imagename = $imagename || '--';
|
| 2399 |
|
|
$image2 = $image2 || '--';
|
| 2400 |
|
|
$image2name = $image2name || '--';
|
| 2401 |
|
|
$image3 = $image3 || '--';
|
| 2402 |
|
|
$image3name = $image3name || '--';
|
| 2403 |
|
|
$image4 = $image4 || '--';
|
| 2404 |
|
|
$image4name = $image4name || '--';
|
| 2405 |
|
|
$diskbus = $diskbus || 'ide';
|
| 2406 |
|
|
$cdrom = $cdrom || '--';
|
| 2407 |
|
|
$boot = $boot || 'hd';
|
| 2408 |
04c16f26
|
hq
|
$loader = $loader || 'bios';
|
| 2409 |
95b003ff
|
Origo
|
$networkuuid1 = $networkuuid1 || 1;
|
| 2410 |
|
|
$networkid1 = $networkid1 || 1;
|
| 2411 |
|
|
$networkname1 = $networkname1 || '--';
|
| 2412 |
|
|
$nicmodel1 = $nicmodel1 || 'rtl8139';
|
| 2413 |
|
|
$nicmac1 = $nicmac1 || randomMac();
|
| 2414 |
|
|
$networkuuid2 = $networkuuid2 || '--';
|
| 2415 |
|
|
$networkid2 = $networkid2 || '--';
|
| 2416 |
|
|
$networkname2 = $networkname2 || '--';
|
| 2417 |
|
|
$nicmac2 = $nicmac2 || randomMac();
|
| 2418 |
|
|
$networkuuid3 = $networkuuid3 || '--';
|
| 2419 |
|
|
$networkid3 = $networkid3 || '--';
|
| 2420 |
|
|
$networkname3 = $networkname3 || '--';
|
| 2421 |
|
|
$nicmac3 = $nicmac3 || randomMac();
|
| 2422 |
|
|
# $uiuuid = $uuid; # No need to update ui for new server with jsonreststore
|
| 2423 |
8d7785ff
|
Origo
|
$postmsg .= "OK Created new server: $name";
|
| 2424 |
3657de20
|
Origo
|
$postmsg .= ", uuid: $uuid " if ($console);
|
| 2425 |
95b003ff
|
Origo
|
}
|
| 2426 |
|
|
# Update status of images
|
| 2427 |
|
|
my @imgs = ($image, $image2, $image3, $image4);
|
| 2428 |
|
|
my @imgkeys = ('image', 'image2', 'image3', 'image4');
|
| 2429 |
|
|
for (my $i=0; $i<4; $i++) {
|
| 2430 |
|
|
my $img = $imgs[$i];
|
| 2431 |
|
|
my $k = $imgkeys[$i];
|
| 2432 |
|
|
my $regimg = $imagereg{$img};
|
| 2433 |
|
|
# if ($img && $img ne '--' && ($status eq 'new' || $img ne $regserv->{$k})) { # Servers image changed - update image status
|
| 2434 |
|
|
if ($img && $img ne '--') { # Always update image status
|
| 2435 |
|
|
$regimg->{'status'} = 'used' if (
|
| 2436 |
|
|
$regimg->{'status'} eq 'unused'
|
| 2437 |
|
|
# Image cannot be active if server is shutoff
|
| 2438 |
|
|
|| ($regimg->{'status'} eq 'active' && $status eq 'shutoff')
|
| 2439 |
|
|
);
|
| 2440 |
|
|
$regimg->{'domains'} = $uuid;
|
| 2441 |
|
|
$regimg->{'domainnames'} = $name;
|
| 2442 |
|
|
}
|
| 2443 |
|
|
# If image has changed, release the old image
|
| 2444 |
|
|
if ($status ne 'new' && $img ne $regserv->{$k} && $imagereg{$regserv->{$k}}) {
|
| 2445 |
|
|
$imagereg{$regserv->{$k}}->{'status'} = 'unused';
|
| 2446 |
|
|
delete $imagereg{$regserv->{$k}}->{'domains'};
|
| 2447 |
|
|
delete $imagereg{$regserv->{$k}}->{'domainnames'};
|
| 2448 |
|
|
}
|
| 2449 |
|
|
}
|
| 2450 |
|
|
|
| 2451 |
|
|
my $valref = {
|
| 2452 |
|
|
uuid=>$uuid,
|
| 2453 |
|
|
user=>$user,
|
| 2454 |
|
|
name=>$name,
|
| 2455 |
|
|
memory=>$memory,
|
| 2456 |
|
|
vcpu=>$vcpu,
|
| 2457 |
|
|
image=>$image,
|
| 2458 |
|
|
imagename=>$imagename,
|
| 2459 |
|
|
image2=>$image2,
|
| 2460 |
|
|
image2name=>$image2name,
|
| 2461 |
|
|
image3=>$image3,
|
| 2462 |
|
|
image3name=>$image3name,
|
| 2463 |
|
|
image4=>$image4,
|
| 2464 |
|
|
image4name=>$image4name,
|
| 2465 |
|
|
diskbus=>$diskbus,
|
| 2466 |
|
|
cdrom=>$cdrom,
|
| 2467 |
|
|
boot=>$boot,
|
| 2468 |
04c16f26
|
hq
|
loader=>$loader,
|
| 2469 |
95b003ff
|
Origo
|
networkuuid1=>$networkuuid1,
|
| 2470 |
|
|
networkid1=>$networkid1,
|
| 2471 |
|
|
networkname1=>$networkname1,
|
| 2472 |
|
|
nicmodel1=>$nicmodel1,
|
| 2473 |
|
|
nicmac1=>$nicmac1,
|
| 2474 |
|
|
networkuuid2=>$networkuuid2,
|
| 2475 |
|
|
networkid2=>$networkid2,
|
| 2476 |
|
|
networkname2=>$networkname2,
|
| 2477 |
|
|
nicmac2=>$nicmac2,
|
| 2478 |
|
|
networkuuid3=>$networkuuid3,
|
| 2479 |
|
|
networkid3=>$networkid3,
|
| 2480 |
|
|
networkname3=>$networkname3,
|
| 2481 |
|
|
nicmac3=>$nicmac3,
|
| 2482 |
|
|
status=>$status,
|
| 2483 |
|
|
notes=>$notes,
|
| 2484 |
|
|
autostart=>$autostart,
|
| 2485 |
|
|
locktonode=>$locktonode,
|
| 2486 |
|
|
action=>"",
|
| 2487 |
|
|
created=>$created
|
| 2488 |
|
|
};
|
| 2489 |
|
|
$valref->{'system'} = $system if ($system);
|
| 2490 |
|
|
if ($mac && $locktonode eq 'true') {
|
| 2491 |
|
|
$valref->{'mac'} = $mac;
|
| 2492 |
|
|
$valref->{'macip'} = $nodereg{$mac}->{'ip'};
|
| 2493 |
|
|
$valref->{'macname'} = $nodereg{$mac}->{'name'};
|
| 2494 |
|
|
}
|
| 2495 |
|
|
if ($newsystem) {
|
| 2496 |
|
|
my $ug = new Data::UUID;
|
| 2497 |
|
|
$sysuuid = $ug->create_str();
|
| 2498 |
|
|
$valref->{'system'} = $sysuuid;
|
| 2499 |
3657de20
|
Origo
|
$postmsg .= "OK sysuuid: $sysuuid " if ($console);
|
| 2500 |
95b003ff
|
Origo
|
}
|
| 2501 |
|
|
|
| 2502 |
|
|
# Remove domain uuid from old networks. Leave gateways alone - they get updated on next listing
|
| 2503 |
|
|
my $oldnetworkuuid1 = $regserv->{'networkuuid1'};
|
| 2504 |
|
|
if ($oldnetworkuuid1 ne $networkuuid1 && $networkreg{$oldnetworkuuid1}) {
|
| 2505 |
|
|
$networkreg{$oldnetworkuuid1}->{'domains'} =~ s/($uuid)(,?)( ?)//;
|
| 2506 |
|
|
}
|
| 2507 |
|
|
|
| 2508 |
|
|
$register{$uuid} = validateItem($valref);
|
| 2509 |
|
|
|
| 2510 |
|
|
if ($networkreg{$networkuuid1}->{'type'} eq 'gateway') {
|
| 2511 |
04c16f26
|
hq
|
# We now remove before adding to support API calls that dont necessarily list afterwards
|
| 2512 |
|
|
$networkreg{$networkuuid1}->{'domains'} =~ s/($uuid)(,?)( ?)//;
|
| 2513 |
95b003ff
|
Origo
|
my $domains = $networkreg{$networkuuid1}->{'domains'};
|
| 2514 |
|
|
$networkreg{$networkuuid1}->{'domains'} = ($domains?"$domains, ":"") . $uuid;
|
| 2515 |
04c16f26
|
hq
|
|
| 2516 |
|
|
$networkreg{$networkuuid1}->{'domainnames'} =~ s/($name)(,?)( ?)//;
|
| 2517 |
95b003ff
|
Origo
|
my $domainnames = $networkreg{$networkuuid1}->{'domainnames'};
|
| 2518 |
|
|
$networkreg{$networkuuid1}->{'domainnames'} = ($domainnames?"$domainnames, ":"") . $name;
|
| 2519 |
|
|
} else {
|
| 2520 |
|
|
$networkreg{$networkuuid1}->{'domains'} = $uuid;
|
| 2521 |
|
|
$networkreg{$networkuuid1}->{'domainnames'} = $name;
|
| 2522 |
|
|
}
|
| 2523 |
|
|
|
| 2524 |
|
|
if ($networkuuid2 && $networkuuid2 ne '--') {
|
| 2525 |
|
|
if ($networkreg{$networkuuid2}->{'type'} eq 'gateway') {
|
| 2526 |
04c16f26
|
hq
|
$networkreg{$networkuuid2}->{'domains'} =~ s/($uuid)(,?)( ?)//;
|
| 2527 |
95b003ff
|
Origo
|
my $domains = $networkreg{$networkuuid2}->{'domains'};
|
| 2528 |
|
|
$networkreg{$networkuuid2}->{'domains'} = ($domains?"$domains, ":"") . $uuid;
|
| 2529 |
04c16f26
|
hq
|
|
| 2530 |
|
|
$networkreg{$networkuuid2}->{'domainnames'} =~ s/($name)(,?)( ?)//;
|
| 2531 |
95b003ff
|
Origo
|
my $domainnames = $networkreg{$networkuuid2}->{'domainnames'};
|
| 2532 |
|
|
$networkreg{$networkuuid2}->{'domainnames'} = ($domainnames?"$domainnames, ":"") . $name;
|
| 2533 |
|
|
} else {
|
| 2534 |
|
|
$networkreg{$networkuuid2}->{'domains'} = $uuid;
|
| 2535 |
|
|
$networkreg{$networkuuid2}->{'domainnames'} = $name;
|
| 2536 |
|
|
}
|
| 2537 |
|
|
}
|
| 2538 |
|
|
|
| 2539 |
|
|
if ($networkuuid3 && $networkuuid3 ne '--') {
|
| 2540 |
|
|
if ($networkreg{$networkuuid3}->{'type'} eq 'gateway') {
|
| 2541 |
|
|
my $domains = $networkreg{$networkuuid3}->{'domains'};
|
| 2542 |
|
|
$networkreg{$networkuuid3}->{'domains'} = ($domains?"$domains, ":"") . $uuid;
|
| 2543 |
|
|
my $domainnames = $networkreg{$networkuuid3}->{'domainnames'};
|
| 2544 |
|
|
$networkreg{$networkuuid3}->{'domainnames'} = ($domainnames?"$domainnames, ":"") . $name;
|
| 2545 |
|
|
} else {
|
| 2546 |
|
|
$networkreg{$networkuuid3}->{'domains'} = $uuid;
|
| 2547 |
|
|
$networkreg{$networkuuid3}->{'domainnames'} = $name;
|
| 2548 |
|
|
}
|
| 2549 |
|
|
}
|
| 2550 |
|
|
my %jitem = %{$register{$uuid}};
|
| 2551 |
|
|
$json_text = to_json(\%jitem, {pretty=>1});
|
| 2552 |
|
|
$json_text =~ s/null/"--"/g;
|
| 2553 |
|
|
$uiuuid = $uuid;
|
| 2554 |
|
|
$uiname = $name;
|
| 2555 |
|
|
|
| 2556 |
|
|
tied(%register)->commit;
|
| 2557 |
|
|
tied(%imagereg)->commit;
|
| 2558 |
|
|
tied(%networkreg)->commit;
|
| 2559 |
|
|
|
| 2560 |
|
|
} else {
|
| 2561 |
48fcda6b
|
Origo
|
$postmsg .= "ERROR This image ($image) cannot be used ($imgdup) " if ($imgdup);
|
| 2562 |
|
|
$postmsg .= "ERROR This network ($networkname1) cannot be used ($netdup)" if ($netdup);
|
| 2563 |
95b003ff
|
Origo
|
}
|
| 2564 |
|
|
|
| 2565 |
|
|
my $domuser = $obj->{'user'};
|
| 2566 |
|
|
# We were asked to move server to another account
|
| 2567 |
|
|
if ($domuser && $domuser ne '--' && $domuser ne $user) {
|
| 2568 |
|
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>0}, $Stabile::dbopts)) ) {throw Error::Simple("Stroke=Error User register could not be accessed")};
|
| 2569 |
|
|
if ($status eq 'shutoff' || $status eq 'inactive') {
|
| 2570 |
|
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {$posterror = "Unable to access user register"; return 0;};
|
| 2571 |
|
|
my @accounts = split(/,\s*/, $userreg{$tktuser}->{'accounts'});
|
| 2572 |
|
|
my @accountsprivs = split(/,\s*/, $userreg{$tktuser}->{'accountsprivileges'});
|
| 2573 |
|
|
%ahash = ($tktuser, $userreg{$tktuser}->{'privileges'}); # Include tktuser in accounts hash
|
| 2574 |
|
|
for my $i (0 .. scalar @accounts)
|
| 2575 |
|
|
{
|
| 2576 |
|
|
next unless $accounts[$i];
|
| 2577 |
|
|
$ahash{$accounts[$i]} = $accountsprivs[$i] || 'r';
|
| 2578 |
|
|
}
|
| 2579 |
|
|
untie %userreg;
|
| 2580 |
|
|
|
| 2581 |
|
|
if (!$isreadonly && $ahash{$domuser} && !($ahash{$domuser} =~ /r/)) { # Check if user is allow to access account
|
| 2582 |
|
|
my $imgdone;
|
| 2583 |
|
|
my $netdone;
|
| 2584 |
|
|
# First move main image
|
| 2585 |
|
|
$Stabile::Images::user = $user;
|
| 2586 |
|
|
require "$Stabile::basedir/cgi/images.cgi";
|
| 2587 |
|
|
$Stabile::Images::console = 1;
|
| 2588 |
|
|
$main::updateUI->({tab=>"servers", user=>$user, message=>"Moving image $imagename to account: $domuser"});
|
| 2589 |
|
|
my $nimage = Stabile::Images::Move($image, $domuser);
|
| 2590 |
48fcda6b
|
Origo
|
chomp $nimage;
|
| 2591 |
95b003ff
|
Origo
|
if ($nimage) {
|
| 2592 |
|
|
$main::syslogit->($user, "info", "Moving $nimage to account: $domuser");
|
| 2593 |
|
|
$register{$uuid}->{'image'} = $nimage;
|
| 2594 |
|
|
$imgdone = 1;
|
| 2595 |
|
|
} else {
|
| 2596 |
|
|
$main::syslogit->($user, "info", "Unable to move image $imagename to account: $domuser");
|
| 2597 |
|
|
}
|
| 2598 |
|
|
# Move other attached images
|
| 2599 |
|
|
my @images = ($image2, $image3, $image4);
|
| 2600 |
|
|
my @imagenames = ($image2name, $image3name, $image4name);
|
| 2601 |
|
|
my @imagekeys = ('image2', 'image3', 'image4');
|
| 2602 |
|
|
for (my $i=0; $i<3; $i++) {
|
| 2603 |
|
|
my $img = $images[$i];
|
| 2604 |
|
|
my $imgname = $imagenames[$i];
|
| 2605 |
|
|
my $imgkey = $imagekeys[$i];
|
| 2606 |
|
|
if ($img && $img ne '--') {
|
| 2607 |
|
|
$main::updateUI->({tab=>"servers", user=>$user, message=>"Moving $imgkey $imgname to account: $domuser"});
|
| 2608 |
|
|
$nimage = Stabile::Images::Move($img, $domuser);
|
| 2609 |
48fcda6b
|
Origo
|
chomp $nimage;
|
| 2610 |
95b003ff
|
Origo
|
if ($nimage) {
|
| 2611 |
|
|
$main::syslogit->($user, "info", "Moving $nimage to account: $domuser");
|
| 2612 |
|
|
$register{$uuid}->{$imgkey} = $nimage;
|
| 2613 |
|
|
} else {
|
| 2614 |
|
|
$main::syslogit->($user, "info", "Unable to move $imagekeys[$i] $img to account: $domuser");
|
| 2615 |
|
|
}
|
| 2616 |
|
|
}
|
| 2617 |
|
|
}
|
| 2618 |
6fdc8676
|
hq
|
# Then move network(s)
|
| 2619 |
95b003ff
|
Origo
|
if ($imgdone) {
|
| 2620 |
|
|
$Stabile::Networks::user = $user;
|
| 2621 |
|
|
require "$Stabile::basedir/cgi/networks.cgi";
|
| 2622 |
|
|
$Stabile::Networks::console = 1;
|
| 2623 |
|
|
my @networks = ($networkuuid1, $networkuuid2, $networkuuid3);
|
| 2624 |
|
|
my @netkeys = ('networkuuid1', 'networkuuid2', 'networkuuid3');
|
| 2625 |
|
|
my @netnamekeys = ('networkname1', 'networkname2', 'networkname3');
|
| 2626 |
|
|
for (my $i=0; $i<scalar @networks; $i++) {
|
| 2627 |
|
|
my $net = $networks[$i];
|
| 2628 |
|
|
my $netkey = $netkeys[$i];
|
| 2629 |
|
|
my $netnamekey = $netnamekeys[$i];
|
| 2630 |
48fcda6b
|
Origo
|
my $regnet = $networkreg{$net};
|
| 2631 |
|
|
my $oldid = $regnet->{'id'};
|
| 2632 |
95b003ff
|
Origo
|
next if ($net eq '' || $net eq '--');
|
| 2633 |
48fcda6b
|
Origo
|
if ($regnet->{'type'} eq 'gateway') {
|
| 2634 |
95b003ff
|
Origo
|
if ($oldid > 1) { # Private gateway
|
| 2635 |
|
|
foreach my $networkvalref (values %networkreg) { # use gateway with same id if it exists
|
| 2636 |
|
|
if ($networkvalref->{'user'} eq $domuser
|
| 2637 |
|
|
&& $networkvalref->{'type'} eq 'gateway'
|
| 2638 |
|
|
&& $networkvalref->{'id'} == $oldid) {
|
| 2639 |
|
|
# We found an existing gateway with same id - use it
|
| 2640 |
|
|
$register{$uuid}->{$netkey} = $networkvalref->{'uuid'};
|
| 2641 |
|
|
$register{$uuid}->{$netnamekey} = $networkvalref->{'name'};
|
| 2642 |
|
|
$netdone = 1;
|
| 2643 |
|
|
$main::updateUI->({tab=>"networks", user=>$user, message=>"Using network $networkvalref->{'name'} from account: $domuser"});
|
| 2644 |
|
|
last;
|
| 2645 |
|
|
}
|
| 2646 |
|
|
}
|
| 2647 |
|
|
if (!($netdone)) {
|
| 2648 |
|
|
# Make a new gateway
|
| 2649 |
|
|
my $ug = new Data::UUID;
|
| 2650 |
|
|
my $newuuid = $ug->create_str();
|
| 2651 |
48fcda6b
|
Origo
|
Stabile::Networks::save($oldid, $newuuid, $regnet->{'name'}, 'new', 'gateway', '', '', $regnet->{'ports'}, 0, $domuser);
|
| 2652 |
95b003ff
|
Origo
|
$register{$uuid}->{$netkey} = $newuuid;
|
| 2653 |
48fcda6b
|
Origo
|
$register{$uuid}->{$netnamekey} = $regnet->{'name'};
|
| 2654 |
95b003ff
|
Origo
|
$netdone = 1;
|
| 2655 |
48fcda6b
|
Origo
|
$main::updateUI->({tab=>"networks", user=>$user, message=>"Created gateway $regnet->{'name'} for account: $domuser"});
|
| 2656 |
|
|
$main::syslogit->($user, "info", "Created gateway $regnet->{'name'} for account: $domuser");
|
| 2657 |
95b003ff
|
Origo
|
}
|
| 2658 |
|
|
} elsif ($oldid==0 || $oldid==1) {
|
| 2659 |
|
|
$netdone = 1; # Use common gateway
|
| 2660 |
48fcda6b
|
Origo
|
$main::updateUI->({tab=>"networks", user=>$user, message=>"Reused network $regnet->{'name'} for account: $domuser"});
|
| 2661 |
95b003ff
|
Origo
|
}
|
| 2662 |
|
|
} else {
|
| 2663 |
|
|
my $newid = Stabile::Networks::getNextId('', $domuser);
|
| 2664 |
|
|
$networkreg{$net}->{'id'} = $newid;
|
| 2665 |
|
|
$networkreg{$net}->{'user'} = $domuser;
|
| 2666 |
6fdc8676
|
hq
|
# if ($regnet->{'type'} eq 'internalip' || $regnet->{'type'} eq 'ipmapping') {
|
| 2667 |
95b003ff
|
Origo
|
# Deactivate network and assign new internal ip
|
| 2668 |
48fcda6b
|
Origo
|
Stabile::Networks::Deactivate($regnet->{'uuid'});
|
| 2669 |
95b003ff
|
Origo
|
$networkreg{$net}->{'internalip'} =
|
| 2670 |
48fcda6b
|
Origo
|
Stabile::Networks::getNextInternalIP('',$regnet->{'uuid'}, $newid, $domuser);
|
| 2671 |
6fdc8676
|
hq
|
# }
|
| 2672 |
95b003ff
|
Origo
|
$netdone = 1;
|
| 2673 |
48fcda6b
|
Origo
|
$main::updateUI->({tab=>"networks", user=>$user, message=>"Moved network $regnet->{'name'} to account: $domuser"});
|
| 2674 |
|
|
$main::syslogit->($user, "info", "Moved network $regnet->{'name'} to account: $domuser");
|
| 2675 |
95b003ff
|
Origo
|
}
|
| 2676 |
|
|
}
|
| 2677 |
|
|
if ($netdone) {
|
| 2678 |
|
|
# Finally move the server
|
| 2679 |
|
|
$register{$uuid}->{'user'} = $domuser;
|
| 2680 |
48fcda6b
|
Origo
|
$postmsg .= "OK Moved server $name to account: $domuser";
|
| 2681 |
95b003ff
|
Origo
|
$main::syslogit->($user, "info", "Moved server $name ($uuid) to account: $domuser");
|
| 2682 |
48fcda6b
|
Origo
|
$main::updateUI->({tab=>"servers", user=>$user, type=>"update"});
|
| 2683 |
95b003ff
|
Origo
|
} else {
|
| 2684 |
48fcda6b
|
Origo
|
$postmsg .= "ERROR Unable to move network to account: $domuser";
|
| 2685 |
95b003ff
|
Origo
|
$main::updateUI->({tab=>"image", user=>$user, message=>"Unable to move network to account: $domuser"});
|
| 2686 |
|
|
}
|
| 2687 |
|
|
} else {
|
| 2688 |
|
|
$main::updateUI->({tab=>"image", user=>$user, message=>"Could not move image to account: $domuser"});
|
| 2689 |
|
|
}
|
| 2690 |
|
|
} else {
|
| 2691 |
48fcda6b
|
Origo
|
$postmsg .= "ERROR No access to move server";
|
| 2692 |
95b003ff
|
Origo
|
}
|
| 2693 |
|
|
} else {
|
| 2694 |
48fcda6b
|
Origo
|
$postmsg .= "Error Unable to move $status server";
|
| 2695 |
95b003ff
|
Origo
|
$main::updateUI->({tab=>"servers", user=>$user, message=>"Please shut down before moving server"});
|
| 2696 |
|
|
}
|
| 2697 |
|
|
untie %userreg;
|
| 2698 |
|
|
}
|
| 2699 |
|
|
|
| 2700 |
|
|
if ($console) {
|
| 2701 |
|
|
$postreply = $postmsg;
|
| 2702 |
|
|
} else {
|
| 2703 |
|
|
$postreply = $json_text || $postmsg;
|
| 2704 |
|
|
}
|
| 2705 |
|
|
return $postreply;
|
| 2706 |
|
|
untie %imagereg;
|
| 2707 |
|
|
}
|
| 2708 |
|
|
|
| 2709 |
|
|
|
| 2710 |
|
|
sub Shutdown {
|
| 2711 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2712 |
|
|
if ($help) {
|
| 2713 |
|
|
return <<END
|
| 2714 |
|
|
GET:uuid:
|
| 2715 |
|
|
Marks a server for shutdown, i.e. send and ACPI shutdown event to the server. If OS supports ACPI, it begins a shutdown.
|
| 2716 |
|
|
END
|
| 2717 |
|
|
}
|
| 2718 |
|
|
$uistatus = "shuttingdown";
|
| 2719 |
|
|
my $dbstatus = $obj->{status};
|
| 2720 |
|
|
my $mac = $obj->{mac};
|
| 2721 |
|
|
my $macname = $obj->{macname};
|
| 2722 |
|
|
my $name = $obj->{name};
|
| 2723 |
|
|
if ($dbstatus eq 'running') {
|
| 2724 |
|
|
my $tasks;
|
| 2725 |
|
|
$tasks = $nodereg{$mac}->{'tasks'} if ($nodereg{$mac});
|
| 2726 |
|
|
$nodereg{$mac}->{'tasks'} = $tasks . "SHUTDOWN $uuid $user\n";
|
| 2727 |
|
|
tied(%nodereg)->commit;
|
| 2728 |
|
|
$register{$uuid}->{'status'} = $uistatus;
|
| 2729 |
|
|
$register{$uuid}->{'statustime'} = $current_time;
|
| 2730 |
|
|
$uiuuid = $uuid;
|
| 2731 |
|
|
$main::syslogit->($user, "info", "Marked $name ($uuid) for $uistatus by $macname ($mac)");
|
| 2732 |
|
|
$postreply .= "Status=$uistatus OK $uistatus $name\n";
|
| 2733 |
|
|
} else {
|
| 2734 |
|
|
$main::syslogit->($user, "info", "Problem $uistatus a $dbstatus domain: $uuid");
|
| 2735 |
|
|
$postreply .= "Status=ERROR problem $uistatus $name...\n";
|
| 2736 |
|
|
}
|
| 2737 |
|
|
return $postreply;
|
| 2738 |
|
|
}
|
| 2739 |
|
|
|
| 2740 |
|
|
sub Suspend {
|
| 2741 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2742 |
|
|
if ($help) {
|
| 2743 |
|
|
return <<END
|
| 2744 |
|
|
GET:uuid:
|
| 2745 |
|
|
Marks a server for suspend, i.e. pauses the server. Server must be running
|
| 2746 |
|
|
END
|
| 2747 |
|
|
}
|
| 2748 |
|
|
$uistatus = "suspending";
|
| 2749 |
|
|
my $dbstatus = $obj->{status};
|
| 2750 |
|
|
my $mac = $obj->{mac};
|
| 2751 |
|
|
my $macname = $obj->{macname};
|
| 2752 |
|
|
my $name = $obj->{name};
|
| 2753 |
|
|
if ($dbstatus eq 'running') {
|
| 2754 |
|
|
my $tasks = $nodereg{$mac}->{'tasks'};
|
| 2755 |
|
|
$nodereg{$mac}->{'tasks'} = $tasks . "SUSPEND $uuid $user\n";
|
| 2756 |
|
|
tied(%nodereg)->commit;
|
| 2757 |
|
|
$register{$uuid}->{'status'} = $uistatus;
|
| 2758 |
|
|
$register{$uuid}->{'statustime'} = $current_time;
|
| 2759 |
|
|
$uiuuid = $uuid;
|
| 2760 |
|
|
$main::syslogit->($user, "info", "Marked $name ($uuid) for $uistatus by $macname ($mac)");
|
| 2761 |
|
|
$postreply .= "Status=$uistatus OK $uistatus $name.\n";
|
| 2762 |
|
|
} else {
|
| 2763 |
|
|
$main::syslogit->($user, "info", "Problem $uistatus a $dbstatus domain: $uuid");
|
| 2764 |
|
|
$postreply .= "Status=ERROR problem $uistatus $name.\n";
|
| 2765 |
|
|
}
|
| 2766 |
|
|
return $postreply;
|
| 2767 |
|
|
}
|
| 2768 |
|
|
|
| 2769 |
|
|
sub Resume {
|
| 2770 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2771 |
|
|
if ($help) {
|
| 2772 |
|
|
return <<END
|
| 2773 |
|
|
GET:uuid:
|
| 2774 |
|
|
Marks a server for resume running. Server must be paused.
|
| 2775 |
|
|
END
|
| 2776 |
|
|
}
|
| 2777 |
|
|
my $dbstatus = $obj->{status};
|
| 2778 |
|
|
my $mac = $obj->{mac};
|
| 2779 |
|
|
my $macname = $obj->{macname};
|
| 2780 |
|
|
my $name = $obj->{name};
|
| 2781 |
|
|
my $image = $obj->{image};
|
| 2782 |
|
|
my $image2 = $obj->{image2};
|
| 2783 |
|
|
my $image3 = $obj->{image3};
|
| 2784 |
|
|
my $image4 = $obj->{image4};
|
| 2785 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$posterror = "Unable to access image register"; return;};
|
| 2786 |
|
|
if ($imagereg{$image}->{'status'} ne "paused"
|
| 2787 |
|
|
|| ($image2 && $image2 ne '--' && $imagereg{$image}->{'status'} ne "paused")
|
| 2788 |
|
|
|| ($image3 && $image3 ne '--' && $imagereg{$image3}->{'status'} ne "paused")
|
| 2789 |
|
|
|| ($image4 && $image4 ne '--' && $imagereg{$image4}->{'status'} ne "paused")
|
| 2790 |
|
|
) {
|
| 2791 |
|
|
$postreply .= "Status=ERROR Image $uuid busy ($imagereg{$image}->{'status'}), please wait 30 sec.\n";
|
| 2792 |
|
|
untie %imagereg;
|
| 2793 |
|
|
return $postreply ;
|
| 2794 |
|
|
} else {
|
| 2795 |
|
|
untie %imagereg;
|
| 2796 |
|
|
}
|
| 2797 |
|
|
$uistatus = "resuming";
|
| 2798 |
|
|
if ($dbstatus eq 'paused') {
|
| 2799 |
|
|
my $tasks = $nodereg{$mac}->{'tasks'};
|
| 2800 |
|
|
$nodereg{$mac}->{'tasks'} = $tasks . "RESUME $uuid $user\n";
|
| 2801 |
|
|
tied(%nodereg)->commit;
|
| 2802 |
|
|
$register{$uuid}->{'status'} = $uistatus;
|
| 2803 |
|
|
$register{$uuid}->{'statustime'} = $current_time;
|
| 2804 |
|
|
$uiuuid = $uuid;
|
| 2805 |
|
|
$main::syslogit->($user, "info", "Marked $name ($uuid) for $uistatus by $macname ($mac)");
|
| 2806 |
|
|
$postreply .= "Status=$uistatus OK $uistatus ". $register{$uuid}->{'name'} . "\n";
|
| 2807 |
|
|
} else {
|
| 2808 |
|
|
$main::syslogit->($user, "info", "Problem $uistatus a $dbstatus domain: $uuid");
|
| 2809 |
|
|
$postreply .= "Status=ERROR problem $uistatus ". $register{$uuid}->{'name'} . "\n";
|
| 2810 |
|
|
}
|
| 2811 |
|
|
return $postreply;
|
| 2812 |
|
|
}
|
| 2813 |
|
|
|
| 2814 |
|
|
sub Move {
|
| 2815 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2816 |
|
|
if ($help) {
|
| 2817 |
|
|
return <<END
|
| 2818 |
|
|
GET:uuid,mac:
|
| 2819 |
48fcda6b
|
Origo
|
Moves a server to a different node (Qemu live migration). Server must be running
|
| 2820 |
95b003ff
|
Origo
|
END
|
| 2821 |
|
|
}
|
| 2822 |
|
|
my $dbstatus = $obj->{status};
|
| 2823 |
|
|
my $dmac = $obj->{mac};
|
| 2824 |
|
|
my $name = $obj->{name};
|
| 2825 |
|
|
my $mem = $obj->{memory};
|
| 2826 |
|
|
my $vcpu = $obj->{vcpu};
|
| 2827 |
|
|
my $image = $obj->{image};
|
| 2828 |
|
|
my $image2 = $obj->{image2};
|
| 2829 |
|
|
my $image3 = $obj->{image3};
|
| 2830 |
|
|
my $image4 = $obj->{image4};
|
| 2831 |
|
|
$uistatus = "moving";
|
| 2832 |
|
|
if ($dbstatus eq 'running' && $isadmin) {
|
| 2833 |
|
|
my $hypervisor = getHypervisor($image);
|
| 2834 |
|
|
my $mac = $register{$uuid}->{'mac'};
|
| 2835 |
|
|
$dmac = "" if ($dmac eq "--");
|
| 2836 |
|
|
$mac = "" if ($mac eq "--");
|
| 2837 |
|
|
|
| 2838 |
|
|
if ($image =~ /\/mnt\/stabile\/node\//
|
| 2839 |
|
|
|| $image2 =~ /\/mnt\/stabile\/node\//
|
| 2840 |
|
|
|| $image3 =~ /\/mnt\/stabile\/node\//
|
| 2841 |
|
|
|| $image4 =~ /\/mnt\/stabile\/node\//
|
| 2842 |
|
|
) {
|
| 2843 |
|
|
# We do not support moving locally stored VM's yet...
|
| 2844 |
|
|
$postreply = qq|{"error": 1, "message": "Moving servers with local storage not supported"}|;
|
| 2845 |
|
|
} else {
|
| 2846 |
|
|
my ($targetmac, $targetname, $targetip, $port) =
|
| 2847 |
|
|
locateTargetNode($uuid, $dmac, $mem, $vcpu, $image, $image2, $image3, $image4, $hypervisor, $mac);
|
| 2848 |
|
|
if ($targetmac) {
|
| 2849 |
|
|
my $tasks = $nodereg{$targetmac}->{'tasks'};
|
| 2850 |
|
|
$tasks = $tasks . "RECEIVE $uuid $user\n";
|
| 2851 |
|
|
# Also update allowed port forwards
|
| 2852 |
|
|
$nodereg{$targetmac}->{'tasks'} = $tasks . "PERMITOPEN $user\n";
|
| 2853 |
|
|
$register{$uuid}->{'status'} = "moving";
|
| 2854 |
|
|
$register{$uuid}->{'statustime'} = $current_time;
|
| 2855 |
|
|
$uiuuid = $uuid;
|
| 2856 |
|
|
$uidisplayip = $targetip;
|
| 2857 |
|
|
$uidisplayport = $port;
|
| 2858 |
|
|
$main::syslogit->($user, "info", "Marked $name ($uuid) for $uistatus to $targetname ($targetmac)");
|
| 2859 |
|
|
$postreply .= "Status=OK $uistatus ". $register{$uuid}->{'name'} . "\n";
|
| 2860 |
|
|
|
| 2861 |
|
|
if ($params{'PUTDATA'}) {
|
| 2862 |
|
|
my %jitem = %{$register{$uuid}};
|
| 2863 |
|
|
my $json_text = to_json(\%jitem);
|
| 2864 |
|
|
$json_text =~ s/null/"--"/g;
|
| 2865 |
|
|
$postreply = $json_text;
|
| 2866 |
|
|
}
|
| 2867 |
|
|
$main::updateUI->({tab=>"servers", user=>$user, status=>'moving', uuid=>$uuid, type=>'update', message=>"Moving $register{$uuid}->{name} to $targetmac"});
|
| 2868 |
|
|
} else {
|
| 2869 |
|
|
$main::syslogit->($user, "info", "Could not find $hypervisor target for $uistatus $uuid ($image)");
|
| 2870 |
|
|
$postreply = qq|{"error": 1, "message": "Could not find target for $uistatus $register{$uuid}->{'name'}"}|;
|
| 2871 |
|
|
}
|
| 2872 |
|
|
}
|
| 2873 |
|
|
} else {
|
| 2874 |
|
|
$main::syslogit->($user, "info", "Problem moving a $dbstatus domain: $uuid");
|
| 2875 |
|
|
$postreply .= qq|{"error": 1, "message": "ERROR problem moving $register{$uuid}->{'name'} ($dbstatus)"}|;
|
| 2876 |
|
|
}
|
| 2877 |
|
|
return $postreply;
|
| 2878 |
|
|
}
|
| 2879 |
|
|
|
| 2880 |
c899e439
|
Origo
|
sub Changepassword {
|
| 2881 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2882 |
|
|
if ($help) {
|
| 2883 |
|
|
return <<END
|
| 2884 |
|
|
POST:uuid,username,password:
|
| 2885 |
|
|
Attempts to set password for [username] to [password] using guestfish. If no username is specified, user 'stabile' is assumed.
|
| 2886 |
|
|
END
|
| 2887 |
|
|
}
|
| 2888 |
|
|
my $img = $register{$uuid}->{'image'};
|
| 2889 |
|
|
my $username = $obj->{'username'} || 'stabile';
|
| 2890 |
|
|
my $password = $obj->{'password'};
|
| 2891 |
|
|
return "Status=Error Please supply a password\n" unless ($password);
|
| 2892 |
|
|
return "Status=Error Please shut down the server before changing password\n" unless ($register{$uuid} && $register{$uuid}->{'status'} eq 'shutoff');
|
| 2893 |
|
|
return "Status=Error Not allowed\n" unless ($isadmin || $register{$uuid}->{'user'} eq $user);
|
| 2894 |
|
|
|
| 2895 |
|
|
unless (tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access images register"}|; return $res;};
|
| 2896 |
|
|
my $cmd = qq/guestfish --rw -a $img -i command "bash -c 'echo $username:$password | chpasswd'" 2>\&1/;
|
| 2897 |
|
|
if ($imagereg{$img} && $imagereg{$img}->{'mac'}) {
|
| 2898 |
|
|
my $mac = $imagereg{$img}->{'mac'};
|
| 2899 |
|
|
my $macip = $nodereg{$mac}->{'ip'};
|
| 2900 |
|
|
$cmd = "$sshcmd $macip $cmd";
|
| 2901 |
|
|
}
|
| 2902 |
|
|
my $res = `$cmd`;
|
| 2903 |
|
|
$res = $1 if ($res =~ /guestfish: (.*)/);
|
| 2904 |
|
|
chomp $res;
|
| 2905 |
|
|
return "Status=OK Ran chpasswd for user $username in server $register{$uuid}->{'name'}: $res\n";
|
| 2906 |
|
|
}
|
| 2907 |
|
|
|
| 2908 |
|
|
sub Sshaccess {
|
| 2909 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2910 |
|
|
if ($help) {
|
| 2911 |
|
|
return <<END
|
| 2912 |
|
|
POST:uuid,address:
|
| 2913 |
|
|
Attempts to change the ip addresses you can access the server over SSH (port 22) from, by adding [address] to /etc/hosts.allow.
|
| 2914 |
|
|
[address] should either be an IP address or a range in CIDR notation. Please note that no validation of [address] is performed.
|
| 2915 |
|
|
END
|
| 2916 |
|
|
}
|
| 2917 |
|
|
my $img = $register{$uuid}->{'image'};
|
| 2918 |
|
|
my $address = $obj->{'address'};
|
| 2919 |
|
|
return "Status=Error Please supply an aaddress\n" unless ($address);
|
| 2920 |
|
|
return "Status=Error Please shut down the server before changing SSH access\n" unless ($register{$uuid} && $register{$uuid}->{'status'} eq 'shutoff');
|
| 2921 |
|
|
return "Status=Error Not allowed\n" unless ($isadmin || $register{$uuid}->{'user'} eq $user);
|
| 2922 |
|
|
|
| 2923 |
|
|
unless (tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access images register"}|; return $res;};
|
| 2924 |
|
|
|
| 2925 |
|
|
my $isshcmd = '';
|
| 2926 |
|
|
my $cmd = qq[guestfish --rw -a $img -i command "sed -i -re 's|(sshd: .*)#stabile|\\1 $address #stabile|' /etc/hosts.allow"];
|
| 2927 |
|
|
# my $cmd = qq[guestfish --rw -a $img -i command "bash -c 'echo sshd: $address >> /etc/hosts.allow'"];
|
| 2928 |
|
|
if ($imagereg{$img} && $imagereg{$img}->{'mac'}) {
|
| 2929 |
|
|
my $mac = $imagereg{$img}->{'mac'};
|
| 2930 |
|
|
my $macip = $nodereg{$mac}->{'ip'};
|
| 2931 |
|
|
$isshcmd = "$sshcmd $macip ";
|
| 2932 |
|
|
}
|
| 2933 |
|
|
my $res = `$isshcmd$cmd`;
|
| 2934 |
|
|
chomp $res;
|
| 2935 |
|
|
#$cmd = qq[guestfish --rw -a $img -i command "bash -c 'cat /etc/hosts.allow'"];
|
| 2936 |
|
|
#$res .= `$isshcmd$cmd`;
|
| 2937 |
|
|
#chomp $res;
|
| 2938 |
|
|
return "Status=OK Tried to add sshd: $address to /etc/hosts.allow in server $register{$uuid}->{'name'}\n";
|
| 2939 |
|
|
}
|
| 2940 |
|
|
|
| 2941 |
95b003ff
|
Origo
|
sub Mountcd {
|
| 2942 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 2943 |
|
|
if ($help) {
|
| 2944 |
|
|
return <<END
|
| 2945 |
|
|
GET:uuid,cdrom:
|
| 2946 |
|
|
Mounts a cdrom on a server. Server must be running. Mounting the special cdrom named '--' unomunts any currently mounted cdrom.
|
| 2947 |
|
|
END
|
| 2948 |
|
|
}
|
| 2949 |
|
|
my $dbstatus = $obj->{status};
|
| 2950 |
|
|
my $mac = $obj->{mac};
|
| 2951 |
|
|
my $cdrom = $obj->{cdrom};
|
| 2952 |
|
|
unless ($cdrom && $dbstatus eq 'running') {
|
| 2953 |
|
|
$main::updateUI->({tab=>"servers", user=>$user, uuid=>$uuid, type=>'update', message=>"Unable to mount cdrom"});
|
| 2954 |
|
|
$postreply = qq|{"Error": 1, "message": "Problem mounting cdrom on $obj->{name}"}|;
|
| 2955 |
|
|
return;
|
| 2956 |
|
|
}
|
| 2957 |
|
|
my $tasks = $nodereg{$mac}->{'tasks'};
|
| 2958 |
|
|
# $user is in the middle here, because $cdrom may contain spaces...
|
| 2959 |
|
|
$nodereg{$mac}->{'tasks'} = $tasks . "MOUNT $uuid $user \"$cdrom\"\n";
|
| 2960 |
|
|
tied(%nodereg)->commit;
|
| 2961 |
|
|
if ($cdrom eq "--") {
|
| 2962 |
|
|
$postreply = qq|{"OK": 1, "message": "OK unmounting cdrom from $obj->{name}"}|;
|
| 2963 |
|
|
} else {
|
| 2964 |
|
|
$postreply = qq|{"OK": 1, "message": "OK mounting cdrom $cdrom on $obj->{name}"}|;
|
| 2965 |
|
|
}
|
| 2966 |
|
|
$register{$uuid}->{'cdrom'} = $cdrom unless ($cdrom eq 'virtio');
|
| 2967 |
|
|
return $postreply;
|
| 2968 |
|
|
} |