Project

General

Profile

Download (56.9 KB) Statistics
| Branch: | Revision:
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
BEGIN {
9
    open STDERR, '>>', '/dev/null' or die "Couldn't redirect STDERR: $!";
10
}
11
12
package Stabile::Piston;
13
14
use Error qw(:try);
15
use Socket;
16
use Data::UUID;
17
use File::Basename;
18
use Time::Local;
19
use Time::HiRes qw( time );
20
use LWP::Simple;
21
use lib dirname (__FILE__) . "/../cgi";
22
use Stabile;
23
24
$q = new CGI;
25
%params = $q->Vars;
26
27
my $servername = $ENV{'SERVER_NAME'};
28
$servername = "localhost" unless $servername;
29
my $serverip = scalar(inet_ntoa(inet_aton($servername)));
30
31 8d7785ff Origo
$backupdir = $Stabile::config->get('STORAGE_BACKUPDIR') || "/mnt/stabile/backups";
32 95b003ff Origo
my $engineid = $Stabile::config->get('ENGINEID') || "";
33
#my $enginelinked = $Stabile::config->get('ENGINE_LINKED') || "";
34
$brutalsleep = $Stabile::config->get('BRUTAL_SLEEP') || "";
35
$amtpasswd = $Stabile::config->get('AMT_PASSWD') || "";
36
37
try {
38
	my $logentry = "";
39
	my @keys = keys %params;
40
	my @values = values %params;
41
	while ($#keys >= 0)
42
	{
43
		$key = pop(@keys); $value = pop(@values);
44
		$logentry .= "$key: $value; ";
45
	}
46
	$logentry .= "REMOTE_ADDR: $ENV{'REMOTE_ADDR'}; Time: $current_time";
47
	# $main::syslogit->('--', 'debug', $logentry);
48
49
	my $status = $params{'status'};
50
	my ($user, $uitab, $uiuuid, $uistatus, $plogentry) = split(/: /, uri_unescape($params{'logentry'}));
51
	my $uipath;
52
53
# We got a request for clearing the local log file
54
	if ($status eq "clearlog") {
55
		unlink $logfile;
56
		print "\nStatus=OK Log cleared\n";
57
		print end_html(), "\n";
58
		return;
59
	}
60
61
    my $mac = uri_unescape($params{'mac'});
62
	$mac =~ tr/[A-Z]/[a-z]/;
63
	$mac =~ s/:/-/g;	
64
	unless ($status eq 'permitopen' || $status eq 'listimagemaster' || $mac =~ /^(\S{2}-\S{2}-\S{2}-\S{2}-\S{2}-\S{2})$/) {throw Error::Simple ("Status=Error invalid mac address: $mac for $id $ENV{'REMOTE_ADDR'}")};
65
	my $filename = $1; # $filename now untainted
66
	my $file = "/mnt/stabile/tftp/pxelinux.cfg/01-$filename";
67
	$mac =~ s/-//g;
68
69
	my $ipmiip;
70
	$ipmiip = uri_unescape($params{'ipmiip'}) if ($params{'ipmiip'});
71
	
72
	unless (tie %register,'Tie::DBI', {
73
		db=>'mysql:steamregister',
74
		table=>'nodes',
75
		key=>'mac',
76
		autocommit=>0,
77
		CLOBBER=>3,
78
		user=>$dbiuser,
79
		password=>$dbipasswd}) {throw Error::Simple("Status=Error Register could not be accessed")};
80
81
	unless (tie %domreg,'Tie::DBI', {
82
		db=>'mysql:steamregister',
83
		table=>'domains',
84
		key=>'uuid',
85
		autocommit=>0,
86
		CLOBBER=>3,
87
		user=>$dbiuser,
88
		password=>$dbipasswd}) {throw Error::Simple("Status=Error Register could not be accessed")};
89
90
    unless (tie %imagereg,'Tie::DBI', {
91
        db=>'mysql:steamregister',
92
        table=>'images',
93
        key=>'path',
94
        autocommit=>0,
95
        CLOBBER=>3,
96
        user=>$dbiuser,
97
        password=>$dbipasswd}) {throw Error::Simple("Status=Image register could not be accessed")};
98
99
	unless (tie %idreg,'Tie::DBI', {
100
		db=>'mysql:steamregister',
101
		table=>'nodeidentities',
102
		key=>'identity',
103
		autocommit=>0,
104
		CLOBBER=>3,
105
		user=>$dbiuser,
106
		password=>$dbipasswd}) {throw Error::Simple("Status=Error Register could not be accessed")};
107
108
	if ($uiuuid) {
109
        if ($uitab eq 'images' && $imagereg{$uiuuid}) { # We got a path
110
            $uipath = $uiuuid;
111
            $uiuuid = $imagereg{$uipath}->{'uuid'};
112
        } else {
113
            $uiuuid =~ tr/[A-Z]/[a-z]/;
114
            $uiuuid =~ s/\%3a//g;
115
        }
116
	} else {
117
        $uiuuid = $mac;
118
	}
119
120
121
	if ($status eq "joining" && $mac) {
122
		print header(),
123 e9af6c24 Origo
		     start_html('Updating Stabile node...'),
124 95b003ff Origo
		     h1('Examining piston request...'),
125
		     hr;
126
		# A new node is trying to join
127
		# First find out which kind of nodes are needed
128
129
		my $id = $idreg{'default'}->{'hypervisor'};
130
		my $dist = $idreg{'default'}->{'dist'};
131
		my $path = $idreg{'default'}->{'path'};
132
		my $kernel = $idreg{'default'}->{'kernel'};
133 e9af6c24 Origo
        $kernel = "-$kernel" if ($kernel);
134 95b003ff Origo
#		untie %idreg;
135
		my $bootentry;
136
		
137
		unless ($dist) {$dist = "lucid"};
138
139
		unless (open(TEMP2, ">$file")) {throw Error::Simple("Status=Error boot file \"$file\" could not be created")};
140
		if ($dist eq 'lucid') {
141
			$bootentry = <<ENDBOOT;
142
prompt 0
143 e9af6c24 Origo
default Stabile Node
144
label Stabile Node
145
kernel vmlinuz$kernel
146 95b003ff Origo
ipappend 2
147 e9af6c24 Origo
append initrd=initrd.img$kernel ro nomodeset root=/dev/nfs nfsroot=$serverip:$path netboot=nfs union=aufs boot=live ip=dhcp identity=$id acpi=force console=ttyS4,115200n81 console=ttyS1,115200n81 console=tty0 ipv6.disable=1 intel_iommu=on
148 95b003ff Origo
ENDBOOT
149
150
    		print TEMP2 $bootentry . "\n";
151
	    	close(TEMP2);
152
		} elsif ($dist) {
153
			$bootentry = <<ENDBOOT;
154
prompt 0
155 e9af6c24 Origo
default Stabile Node
156
label Stabile Node
157
kernel vmlinuz$kernel
158 95b003ff Origo
ipappend 2
159 e9af6c24 Origo
append initrd=initrd.img$kernel ro nomodeset root=/dev/nfs nfsroot=$serverip:$path netboot=nfs union=aufs boot=casper ip=dhcp identity=$id acpi=force console=ttyS4,115200n81 console=ttyS1,115200n81 console=tty0 ipv6.disable=1 intel_iommu=on disable_mtrr_cleanup
160 95b003ff Origo
ENDBOOT
161
162
			print TEMP2 $bootentry . "\n";
163
			close(TEMP2);
164
		} else {throw Error::Simple("Status=Error no default node identity")};
165
166 d24d9a01 hq
		my $macname = $mac;
167
        $macname = $register{$mac}->{'name'} if ($register{$mac});
168
        $register{$mac} = {
169 95b003ff Origo
            identity=>$id,
170
            timestamp=>$current_time,
171
            ip=>$ENV{'REMOTE_ADDR'},
172 d24d9a01 hq
            name=>$macname,
173 95b003ff Origo
            cpucores=>$params{'cpucores'},
174
            cpucount=>$params{'cpucount'},
175
            cpuspeed=>$params{'cpuspeed'},
176
            cpuname=>uri_unescape($params{'cpuname'}),
177
            cpufamily=>$params{'cpufamily'},
178
            cpumodel=>$params{'cpumodel'},
179
            memtotal=>$params{'memtotal'},
180
            memfree=>$params{'memfree'},
181 a93267ad hq
            gpucount=>$params{'gpucount'},
182
            gpusfree=>$params{'gpusfree'},
183 95b003ff Origo
            stortotal=>$params{'stortotal'},
184
            storfree=>$params{'storfree'},
185
            status=>$status,
186
            ipmiip=>$ipmiip
187
		};
188
		tied(%register)->commit;
189
		print "\nAssimilation=OK $mac\n";
190
		print end_html(), "\n";
191
192
# We got a request for updating a user's UI
193
	} elsif ($status eq "updateui") {
194
		print header();
195
		if ($user && $uitab eq "images" && $uiuuid && !($uistatus =~ /backingup/)) {
196
            $imagereg{$uipath}->{'status'} = $uistatus;
197
            tied(%imagereg)->commit();
198
            if ($plogentry =~ /Backed up/) { # An image was backed up from the node
199
                $imagereg{$uipath}->{'btime'} = $current_time;
200 8d7785ff Origo
                my $imguser = $imagereg{$uipath}->{'user'};
201 95b003ff Origo
                my($fname, $dirpath, $suffix) = fileparse($uipath, (".vmdk", ".img", ".vhd", ".qcow", ".qcow2", ".vdi", ".iso"));
202
                my $subdir = "";
203
                if ($dirpath =~ /\/$user(\/.+)\//) {
204
                    $subdir = $1;
205
                }
206 8d7785ff Origo
                my $backupsize = getBackupSize($subdir, "$fname$suffix", $imguser);
207 95b003ff Origo
                updateImageBilling($user, $uipath, "backed up", $backupsize);
208
            }
209
            if ($plogentry) {
210
				if ($plogentry =~ /Backup aborted/) {
211
					# A backup has been aborted - possibly a node was rebooted - update image status
212
					$Stabile::Images::user = $user;
213
					$Stabile::Images::console = 1;
214
					require "$Stabile::basedir/cgi/images.cgi";
215
					my $res = Stabile::Images::Updateregister($uipath, 'updateregister');
216
					$main::syslogit->($user, 'info', "Updated image status - $user, $uipath, $res");
217
					$uistatus = $res if ($res);
218
				}
219
				my $upd = {user=>$user, uuid=>$uiuuid, status=>$uistatus, message=>$plogentry, type=>'update', tab=>'images'};
220
				$upd->{'backup'} = $uipath if ($plogentry =~ /Backed up/);
221
				$main::updateUI->($upd);
222
                $main::syslogit->($user, 'info', "$plogentry $uiuuid ($uitab, $uistatus)");
223
                $plogentry = "";
224
            }
225 d3805c61 hq
        } elsif ($uitab eq "servers" && $uiuuid) {
226
            if ($domreg{$uiuuid}) {
227
                $user = $domreg{$uiuuid}->{user};
228
                my $error = 0;
229
                if ($plogentry =~ /error/i || $plogentry =~ /not moved/i) { # There was an error moving the server
230
                    $domreg{$uiuuid}->{status} = 'inactive';
231
                    $error = 1;
232
                }
233
                my $sshcmd = $Stabile::sshcmd;
234
                my $cmd;
235
                my $dmacip = '';
236
                my $macip = $register{$mac}->{ip};
237
                if ($macip eq '10.0.0.1') {
238
                    $dmacip = `cat /tmp/$uiuuid.dest`;
239
                } else {
240
                    $dmacip = `$sshcmd $macip cat /tmp/$uiuuid.dest`;
241
                }
242
                chomp $dmacip;
243
244
                # Find the images left behind after move
245
                my @regkeys = (tied %imagereg)->select_where("domains = '$uiuuid'");
246
                if ($error) {
247
                    # Clean up - restore connection with images that failed to be moved to the new node
248
                    # We are using ssh even on local node because piston does not have privileged access
249
                    $cmd = qq[$sshcmd $macip "LIBVIRT_DEFAULT_URI=qemu:///system virsh list --uuid" | grep $uiuuid];
250
                    # Check that moved vm is actually running on destination node
251
                    my $running_on_old_node = `$cmd`;
252
                    unless ($running_on_old_node) { # Try again
253
                        sleep 5;
254
                        $running_on_old_node = `$cmd`;
255
                    }
256
                    chomp $running_on_old_node;
257
                    my $domimg = $domreg{$uiuuid}->{image};
258
                    my $domimg2 = $domreg{$uiuuid}->{image2};
259
                    my $domimg3 = $domreg{$uiuuid}->{image3};
260
                    my $domimg4 = $domreg{$uiuuid}->{image4};
261
                    foreach my $image (@regkeys) {
262
                        if ($imagereg{$image}->{status} =~ /moving/) { # Only deal with images that were being moved
263
                            if ($image eq $domimg || $image eq $domimg2 || $image eq $domimg3 || $image eq $domimg4
264
                            ) {
265
                                $imagereg{$image}->{status} = 'unused'; # This is an image that failed to be moved
266
                                if ($running_on_old_node) {
267
                                    my $imguuid = $imagereg{$image}->{uuid};
268
                                    my $res = `$sshcmd 10.0.0.1 "echo images/$imguuid/remove | /usr/local/bin/stash"`;
269
                                    $main::syslogit->($user, 'info', "Removing $image from node $mac");
270
                                } else {
271
                                    $main::syslogit->($user, 'info', "Not removing $image from node $mac, $domreg{$uiuuid}->{status}, $cmd");
272
                                }
273
                            } else {
274
                                $imagereg{$image}->{status} = 'used'; # This is an image that originally belonged to the server
275
                                my $imgname = $1 if ($image =~ /.+\/(.+\.qcow2)$/);
276
                                # Restore connection to image
277
                                if ($domimg =~ /$imgname/) {
278
                                    $domreg{$uiuuid}->{image} = $image;
279
                                } elsif ($domimg2 =~ /$imgname/) {
280
                                    $domreg{$uiuuid}->{image2} = $image;
281
                                } elsif ($domimg3 =~ /$imgname/) {
282
                                    $domreg{$uiuuid}->{image3} = $image;
283
                                } elsif ($domimg4 =~ /$imgname/) {
284
                                    $domreg{$uiuuid}->{image4} = $image;
285
                                }
286
                            }
287
                        }
288
                    }
289
290
                } else {
291
                    # Mark images left behind that no longer belongs to the server as unused and remove them if domain is running on the new node
292
                    # We are using ssh even on local node because piston does not have privileged access
293
                    $cmd = qq[$sshcmd $dmacip "LIBVIRT_DEFAULT_URI=qemu:///system virsh list --uuid" | grep $uiuuid];
294
                    # Check that moved vm is actually running on destination node
295
                    my $running_on_new_node = `$cmd`;
296
                    unless ($running_on_new_node) { # Try again
297
                        sleep 5;
298
                        $running_on_new_node = `$cmd`;
299
                    }
300
                    chomp $running_on_new_node;
301
                    if ($domreg{$uiuuid}->{mac} ne $mac && $running_on_new_node) { # We do not use domain status from DB since it takes a while to update
302
                        $running_on_new_node = 1;
303
                        $Stabile::Images::user = $user;
304
                        $Stabile::Images::console = 1;
305
                        require "$Stabile::basedir/cgi/images.cgi";
306
                    }
307
                    foreach my $image (@regkeys) {
308
                        if ($image ne $domreg{$uiuuid}->{image}
309
                            && $image ne $domreg{$uiuuid}->{image2}
310
                            && $image ne $domreg{$uiuuid}->{image3}
311
                            && $image ne $domreg{$uiuuid}->{image4}
312
                        ) {
313
                            $imagereg{$image}->{status} = 'unused';
314
                            if ($running_on_new_node) {
315
                                my $imguuid = $imagereg{$image}->{uuid};
316
                                my $res = `$sshcmd 10.0.0.1 "echo images/$imguuid/remove | /usr/local/bin/stash"`;
317
                                $main::syslogit->($user, 'info', "Removing $image from node $mac");
318
                            } else {
319
                                $main::syslogit->($user, 'info', "Not removing $image from node $mac, $domreg{$uiuuid}->{status}, $cmd");
320
                            }
321
                        } else {
322
                            $imagereg{$image}->{status} = 'used';
323
                        }
324
                    }
325
                }
326
                my $upd = {user=>$user, uuid=>$uiuuid, message=>$plogentry, type=>'update', tab=>'servers'};
327
                $main::updateUI->($upd);
328
                $main::syslogit->($user, 'info', "$plogentry $uiuuid ($uitab, $uistatus)");
329
                $plogentry = "";
330
            }
331 95b003ff Origo
        }
332
# List the master associated with an image if any
333
	} elsif ($status eq "listimagemaster") {
334
		print header('text/xml');
335
		my $path = $params{'image'};
336
		$path = uri_unescape($path);
337
		my $master = $imagereg{$path}->{'master'};
338
		$master = uri_escape($master);
339
        print $master;
340
# We got a request for listing a domains xml description
341
	} elsif ($status eq "listxml") {
342
		print header('text/xml');
343
		my %xmlreg;
344
		unless (tie %xmlreg,'Tie::DBI', {
345
			db=>'mysql:steamregister',
346
			table=>'domainxml',
347
			key=>'uuid',
348
			autocommit=>0,
349
			CLOBBER=>3,
350
			user=>$dbiuser,
351
			password=>$dbipasswd}) {throw Error::Simple("Status=Error Register could not be accessed")};
352
353
		my $uuid = $params{'uuid'};
354
		unless ((defined $uuid) && ($uuid =~ /^(\S{8}-\S{4}-\S{4}-\S{4}-\S{12})$/)) {throw Error::Simple ("Status=Error invalid uuid: $uuid")};
355
		my $xml = $xmlreg{$uuid}->{'xml'};
356
		print uri_unescape($xml);
357
		untie %xmlreg;
358
359
# Update sshd_config to allow ssh port forwarding to consoles of a users vm's
360
	} elsif ($status eq "permitopen") {
361
		print header;
362
		my $user = $params{'user'};
363
        $user =~ /(.+)/; $user = $1; #untaint
364
		print start_html('Opening ports...');
365
		permitOpen($user);
366
		print end_html();
367
368
# A node is updating it's status
369
	} else {
370
		print header(),
371 e9af6c24 Origo
		     start_html('Updating Stabile node...'),
372 95b003ff Origo
		     h1('Examining piston request...'),
373
		     hr;
374
		# Look for action requests (from users)
375
		$action = $register{$mac}->{'action'};
376
377
        # Look for node tasks, only post requests, get requests generally only update this side
378
        if ($ENV{'REQUEST_METHOD'} eq 'POST') {
379
            $tasks = $register{$mac}->{'tasks'};
380
            $register{$mac}->{'tasks'} = '';
381
            tied(%register)->commit;
382
        }
383
384
		$maintenance = $register{$mac}->{'maintenance'};
385
		# If the node is shutting down or joining, don't reboot it
386
		if ($status eq "shutdown" || $status eq "joining") {
387
			$action = "";
388
		}
389
		my $dbstatus = $register{$mac}->{'status'};
390
		my $macname = $register{$mac}->{'name'};
391
		my $nodestatus = $status;
392
        $nodestatus = 'maintenance' if ($status eq 'running' && $maintenance);
393
		if (($dbstatus eq "maintenance" && $status ne "drowsing") || $dbstatus eq "sleeping" || $dbstatus eq "shuttingdown" || !$status || $status eq '--') {
394
            $nodestatus = $dbstatus;
395
		} elsif ( $status eq 'drowsing' && ($dbstatus eq 'running' || $dbstatus eq 'maintenance')) {
396
            if ($brutalsleep && (
397
                    ($register{$mac}->{'amtip'} && $register{$mac}->{'amtip'} ne '--')
398
                || ($register{$mac}->{'ipmiip'} && $register{$mac}->{'ipmiip'} ne '--')
399
                )) {
400
                my $sleepcmd;
401
                $uistatus = "asleep";
402
                print  "\nStatus=SWEETDREAMS";
403
                sleep 2;
404
                if ($register{$mac}->{'amtip'} && $register{$mac}->{'amtip'} ne '--') {
405
                    $sleepcmd = "echo 'y' | AMT_PASSWORD='$amtpasswd' /usr/bin/amttool $register{$mac}->{'amtip'} powerdown";
406
                } else {
407
                    $sleepcmd = "ipmitool -I lanplus -H $register{$mac}->{'ipmiip'} -U ADMIN -P ADMIN power off";
408
                }
409
                my $logmsg = "Node $mac marked for drowse ";
410
                $logmsg .= `$sleepcmd`;
411
                $logmsg =~ s/\n/ /g;
412
                $main::syslogit->('--', "info", $logmsg);
413
            }
414
            $nodestatus = 'asleep';
415
		}
416
417
        my %billing;
418
419
	# Look for info on whether if this node is waiting to receive vm's and activate the sender
420
        my $receive = uri_unescape($params{'receive'});
421
        if ($receive) {
422
            @uuids = split(/, */,$receive);
423
            foreach my $uuid (@uuids) {
424
                # Sender is the current node/mac running the vm
425
                my $sendmac = $domreg{$uuid}->{'mac'};
426
                my $rip = $register{$mac}->{'ip'};
427
                my $sendtasks = "MOVE $uuid $rip $mac $user\n". $register{$sendmac}->{'tasks'};
428
                chop $sendtasks;
429
                $register{$sendmac}->{'tasks'} .= $sendtasks;
430
            }
431
        }
432 d3805c61 hq
433
        my $receivestor = uri_unescape($params{'receivestor'});
434
        if ($receivestor) {
435
            @uuids = split(/, */,$receivestor);
436
            foreach my $uuid (@uuids) {
437
                # Sender is the current node/mac running the vm
438
                my $sendmac = $domreg{$uuid}->{'mac'};
439
                my $rip = $register{$mac}->{'ip'};
440
                my $sendtasks = "MOVESTOR $uuid $rip $mac $user\n". $register{$sendmac}->{'tasks'};
441
                chop $sendtasks;
442
                $register{$sendmac}->{'tasks'} .= $sendtasks;
443
            }
444
        }
445
446 95b003ff Origo
        my $returntasks = uri_unescape($params{'returntasks'});
447
        if ($returntasks && $returntasks ne "--") {
448
            $register{$mac}->{'tasks'} .= $returntasks; # Some tasks have failed, try again
449
        }
450
451
        # Don't update anything for node feedbacks from actions
452
        if ($status ne '--'
453
            && $status ne 'asleep'
454
            && $status ne 'awake'
455
            && $status ne 'shutdown'
456
            && $status ne 'reboot'
457
            && $status ne 'unjoin'
458
            && $status ne 'permitopen'
459
            && $status ne 'reload'
460
        ) {
461
    # Update basic parameters
462
            my $memfree = $params{'memfree'} || $register{$mac}->{'memfree'};
463
            my $memtotal = $params{'memtotal'} || $register{$mac}->{'memtotal'};
464
            my $cpuload = $params{'cpuload'} || $register{$mac}->{'cpuload'};
465
            my $cpucount = $params{'cpucount'} || $register{$mac}->{'cpucount'};
466
            my $cpucores = $params{'cpucores'} || $register{$mac}->{'cpucores'};
467 a93267ad hq
            my $gpucount= $register{$mac}->{'gpucount'};
468
            $gpucount = $params{'gpucount'} if (defined $params{'gpucount'});
469
            my $gpusfree= $register{$mac}->{'gpusfree'};
470
            $gpusfree = $params{'gpusfree'} if (defined $params{'gpusfree'});
471
            my $vmem = $register{$mac}->{'vmem'};
472
            if ($params{'vmem'} || (defined $params{'vmem'} && !$gpucount)) { # if 0 is reported (because busy) and there are gpus keep the db value
473
                $vmem = $params{'vmem'};
474
            }
475 95b003ff Origo
            my $nfsroot = uri_unescape($params{'nfsroot'}) || $register{$mac}->{'nfsroot'};
476
            my $kernel = uri_unescape($params{'kernel'}) || $register{$mac}->{'kernel'};
477
            my $reservedvcpus = 0;
478
479
            $register{$mac} = {
480
                timestamp=>$current_time,
481
                identity=>$params{'identity'},
482
                ip=>$ENV{'REMOTE_ADDR'},
483
                status=>$nodestatus,
484
                memfree=>$memfree,
485
                memtotal=>$memtotal,
486
                cpuload=>$cpuload,
487
                cpucount=>$cpucount,
488
                cpucores=>$cpucores,
489 a93267ad hq
                gpucount=>$gpucount,
490
                gpusfree=>$gpusfree,
491
                vmem=>$vmem,
492 95b003ff Origo
    #            reservedvcpus=>0,
493
                nfsroot=>$nfsroot,
494
                kernel=>$kernel,
495
                action=>""
496
            };
497
498
            if ($ipmiip) {
499
                $register{$mac}->{'ipmiip'} = $ipmiip;
500
            }
501
            if ($params{'stortotal'} || $params{'stortotal'} eq "0") {
502
                $register{$mac}->{'stortotal'} = $params{'stortotal'};
503
                $register{$mac}->{'storfree'} = $params{'storfree'};
504
                $register{$mac}->{'stor'} = $params{'stor'};
505
            }
506
            tied(%register)->commit;
507
508
    # Look for supplied info on domains running on this node, and locally stored images, and update db
509
            my @keys = keys %params;
510
            my @values = values %params;
511
            my $vmvcpus = 0;
512 a93267ad hq
            my $vmvgpus = 0;
513 95b003ff Origo
            my $vms = 0;
514
            my $vmuuids;
515
            my $vmnames;
516
            my $vmusers;
517
            my %reportedimgs;
518
            my $ug = new Data::UUID;
519
            my %nodedomains;
520
            while ($#keys >= 0)
521
            {
522
                $key = pop(@keys); $value = pop(@values);
523
                if ($key =~ m/dom(\d+)/) {
524
                    my $i = $1;
525
                    my $domstatus = $params{"domstate$i"};
526
                    $domreg{$value}->{'statustime'} = $current_time unless ($domreg{$value}->{'statustime'});
527
                    my $statedelta = $current_time - $domreg{$value}->{'statustime'}; # The number of seconds domain has been in same state
528
                    my $domdisplay = $params{"domdisplay$i"};
529
                    my $domport = $params{"domport$i"};
530
                    my $dbdomstatus = $domreg{$value}->{'status'};
531
                    my $dbdommac = $domreg{$value}->{'mac'};
532
                    my $dommac = $mac;
533
                    my $duser = $domreg{$value}->{'user'};
534
                    $nodedomains{$value} = 1;
535
                    $vms++;
536
                    $vmuuids .= "$value, ";
537
                    $vmnames .= "$domreg{$value}->{'name'}, ";
538
                    $vmusers .= "$domreg{$value}->{'user'}, ";
539
                    # Domain status has changed, evaluate if it warrants a ui update
540 d3805c61 hq
                    if ($dbdomstatus =~ /moving/) {
541 95b003ff Origo
    #				    $main::syslogit->($user, 'info', "MOVING: $domstatus/$dommac, $dbdomstatus/$dbdommac");
542
                    }
543
                    if ($dbdomstatus && $domstatus && ($dbdomstatus ne $domstatus)) {
544
                        # Transitional states like shuttingdown are not reported by hypervisor
545
                        # we only update db with permanent states when exiting a transitional hypervisor state or
546
                        # too much time has passed
547
                        if (($dbdomstatus eq "shuttingdown" && $domstatus eq "running" && $statedelta<120)
548
                            || ($dbdomstatus eq "starting" && $domstatus eq "inactive" && $statedelta<30)
549
                            || ($dbdomstatus eq "starting" && $domstatus eq "shutdown" && $statedelta<30)
550
                            || ($dbdomstatus eq "starting" && $domstatus eq "shutoff" && $statedelta<30)
551
                            || ($dbdomstatus eq "suspending" && $domstatus eq "running" && $statedelta<30)
552
                            || ($dbdomstatus eq "resuming" && $domstatus eq "paused" && $statedelta<30)
553
                        # When moving $dbdommac is the originating mac, wait 5 min for moves
554 d3805c61 hq
                            || ($dbdomstatus =~ /moving/ && ($domstatus eq "running" || $domstatus eq "paused" || $domstatus eq "shutoff") && $dbdommac eq $mac && $statedelta<300)
555
                        # We only accept "running" as status from receiving mac
556
                            || ($dbdomstatus =~ /moving/ && ($domstatus ne "running") && $dbdommac ne $mac && $statedelta<300)
557 95b003ff Origo
                            || ($domstatus eq "nostate")
558
                            || ($dbdomstatus eq "destroying" && $domstatus eq "running" && $statedelta<30)
559
                            || ($dbdomstatus eq "destroying" && $domstatus eq "paused" && $statedelta<30)
560
                            || ($dbdomstatus eq "upgrading" && $statedelta<600)
561
                        ) {
562 d3805c61 hq
                            $domstatus = $dbdomstatus; # Keep the database status as status
563
                            $dommac = $dbdommac; # Keep originating mac as authoritative
564 95b003ff Origo
                        } else {
565
                        # We have exited from a transition, update the UI
566
                            $domreg{$value}->{'statustime'} = $current_time;
567
                            $billing{$duser}->{'event'} .= "$domstatus $value\n";
568
                            $main::updateUI->({tab=>"servers", user=>"$duser", uuid=>$value, status=>$domstatus,
569
                                                mac=>$mac, macname=>$macname});
570
                            if ($enginelinked && $engineid) {
571
                                my $sysuuid = $domreg{$value}->{'uuid'};
572
                                my $sysstatus = $domstatus;
573
                                if ($domreg{$value}->{'system'} && $domreg{$value}->{'system'} ne '--') { # This is a system
574
                                    $sysuuid = $domreg{$value}->{'system'};
575
                                    unless (tie %sysreg,'Tie::DBI', {
576
                                        db=>'mysql:steamregister',
577
                                        table=>'systems',
578
                                        key=>'uuid',
579
                                        autocommit=>0,
580
                                        CLOBBER=>3,
581
                                        user=>$dbiuser,
582
                                        password=>$dbipasswd}) {throw Error::Simple("Status=ERROR System register could not be accessed")};
583
                                    # Check if we are dealing with the admin server
584
                                    if ($domreg{$value}->{'image'} ne $sysreg{$sysuuid}->{'image'}) {
585
                                        $sysuuid = '';
586
                                    }
587
588
                                    untie %sysreg;
589
                                }
590
                                if ($sysuuid) {
591
                                my $json_text = <<END
592
{"uuid": "$sysuuid" , "status": "$sysstatus"}
593
END
594
;
595
                                    print "\n" . $main::postAsyncToOrigo->($engineid, 'updateapps', "[$json_text]") . "\n";
596
                                }
597
                            }
598
                        }
599
                    }
600
601
                    # If a domain is shutoff or state is undetermined, dont't count it in billing
602
                    # if ($domstatus eq "shutoff" || $domstatus eq "inactive" ) {
603
                    if ($domstatus eq "shutoff" || $domstatus eq "inactive" ) {
604
                        $billing{$duser}->{'vcpu'} += 0;
605
                        $billing{$duser}->{'memory'} += 0;
606 a93267ad hq
                        $billing{$duser}->{'vgpu'} += 0;
607
                        $billing{$duser}->{'vmemory'} += 0;
608 95b003ff Origo
                    # All other states count
609
                    } else {
610
                        $billing{$duser}->{'vcpu'} += $domreg{$value}->{'vcpu'};
611
                        $billing{$duser}->{'memory'} += $domreg{$value}->{'memory'};
612 a93267ad hq
                        $billing{$duser}->{'vgpu'} += $domreg{$value}->{'vgpu'};
613
                        $billing{$duser}->{'vmemory'} += $domreg{$value}->{'vmemory'};
614 95b003ff Origo
                    }
615
                    # We don't update timestamp for moving domains, so if move fails, eventually they will be marked as inactive
616
                    my $timestamp = $current_time;
617 d3805c61 hq
                    $timestamp = $domreg{$value}->{'timestamp'} if ($domstatus =~ /moving/);
618 95b003ff Origo
                    $domreg{$value} = {
619
                        status=>$domstatus,
620
                        mac=>$dommac,
621
                        macname=>$register{$dommac}->{'name'},
622
                        macip=>$register{$dommac}->{'ip'},
623
                        maccpucores=>$register{$dommac}->{'cpucores'},
624 a93267ad hq
                        macgpus=>$register{$dommac}->{'gpucount'},
625 95b003ff Origo
                        timestamp=>$timestamp
626
                    };
627 d3805c61 hq
                    $domreg{$value}->{'mac'} = $dommac unless ($domstatus =~ /moving/);
628 95b003ff Origo
                    $domreg{$value}->{'display'} = $domdisplay if $domdisplay;
629
                    $domreg{$value}->{'port'} = $domport if $domport;
630
                    if ($params{"domstate$i"} eq 'running') {$vmvcpus += $domreg{$value}->{'vcpu'}};
631 a93267ad hq
                    if ($params{"domstate$i"} eq 'running' || $params{"domstate$i"} eq 'paused') {$vmvgpus += $domreg{$value}->{'vgpu'}};
632 95b003ff Origo
                # If a domain was moved, update permitted ports
633 d3805c61 hq
                    if (($dbdomstatus =~ /moving/ && $domstatus eq "running" && $dbdommac ne $mac)) {
634 95b003ff Origo
                        $main::syslogit->($duser, 'info', "Moved $domreg{$value}->{'name'} ($value) to $register{$dommac}->{'name'}");
635
                        permitOpen($duser);
636
                    }
637
                # Update status of server's images
638
                    my $image = $domreg{$value}->{'image'};
639
                    my $image2 = $domreg{$value}->{'image2'};
640
                    my $image3 = $domreg{$value}->{'image3'};
641
                    my $image4 = $domreg{$value}->{'image4'};
642
                    my $imgstatus = 'active'; # if server is running, moving, etc.
643
                    if ($domstatus eq 'paused') {
644
                        $imgstatus = 'paused'
645
                    } elsif ($domstatus eq "shutoff" || $domstatus eq "inactive")  {
646
                        $imgstatus = 'used'
647
                    }
648 64c667ea hq
                    print "$image for $domreg{$value}->{name} not in DB" unless ($imagereg{$image});
649 d3805c61 hq
                    $imagereg{$image}->{'status'} = $imgstatus if ($imagereg{$image} && $imagereg{$image}->{'status'} !~ /backingup/ && $imagereg{$image}->{'status'} !~ /moving/);
650
                    $imagereg{$image2}->{'status'} = $imgstatus if ($image2 && $imagereg{$image2} && $image2 ne '--' && $imagereg{$image2}->{'status'} !~ /backingup/ && $imagereg{$image}->{'status'} !~ /moving/);
651
                    $imagereg{$image3}->{'status'} = $imgstatus if ($image3 && $imagereg{$image3} && $image3 ne '--' && $imagereg{$image3}->{'status'} !~ /backingup/ && $imagereg{$image}->{'status'} !~ /moving/);
652
                    $imagereg{$image4}->{'status'} = $imgstatus if ($image4 && $imagereg{$image4} && $image4 ne '--' && $imagereg{$image4}->{'status'} !~ /backingup/ && $imagereg{$image}->{'status'} !~ /moving/);
653 95b003ff Origo
654
                } elsif ($key =~ m/img(\d+)/) {
655
            # The node is reporting about a locally stored image
656
                    my $f = uri_unescape($value);
657
                    my $size = $params{"size$1"};
658
                    my $realsize = $params{"realsize$1"};
659
                    my $virtualsize = $params{"virtualsize$1"};
660
                    my($fname, $dirpath, $suffix) = fileparse($f, (".vmdk", ".img", ".vhd", ".qcow", ".qcow2", ".vdi", ".iso"));
661
                    my $regimg = $imagereg{$f};
662
                    my $uuid = $regimg->{'uuid'};
663
664
                    my $storagepool = -1;
665
                    $f =~ m/\/mnt\/stabile\/node\/(.+?)\/.+/; # ungready matching
666
                    my $imguser = $1;
667
668
            # Create a new uuid if we are dealing with a new file in the file-system
669
                    if (!$uuid) {
670
                        $uuid = $ug->create_str() unless ($uuid);
671
                        $main::syslogit->($imguser, 'info', "Assigned new uuid $uuid to $f belonging to $imguser");
672
                    }
673
674
                    my $mtime = $newmtime || $regimg->{'mtime'};
675
                    my $name = $regimg->{'name'} || $fname;
676
677
                    my $subdir = "";
678
                    if ($dirpath =~ /\/$imguser(\/.+)\//) {
679
                        $subdir = $1;
680
                    }
681
                    my $bdu;
682
                    my $backupsize = 0;
683 8d7785ff Origo
                    my $imgpath = "$fname$suffix";
684
                    $imgpath = $1 if $cmdpath =~ /(.+)/; # untaint
685
                    $backupsize = getBackupSize($subdir, $imgpath, $imguser);
686 95b003ff Origo
            # If image on node is attached to a domain, reserve vcpus for starting domain on node
687
                    my $imgdom = $regimg->{'domains'};
688
                    if ($imgdom && $domreg{$imgdom}) {
689
                        my $imgvcpus = $domreg{$imgdom}->{'vcpu'};
690
                        my $imgdomstatus = $domreg{$imgdom}->{'status'};
691
                        $reservedvcpus += $imgvcpus if ($imgdomstatus eq 'shutoff' || $imgdomstatus eq 'inactive');
692
                    }
693
694
                    $reportedimgs{$f} = 1;
695 d3805c61 hq
                    if (($regimg->{'virtualsize'} == 0 && $virtualsize) || $regimg->{'status'} =~ /moving/) {
696 95b003ff Origo
                        $reportedimgs{$f} = 2; # Mark that we should update the UI - this is a recently transferred image
697
                    }
698
                    if ($f && $imguser) {
699
                        my $imgstatus = $regimg->{'status'};
700
                        # This only happens first time after an image has been transferred manually to a node
701
                        if (!$imgstatus || $imgstatus eq '--' || $imgstatus eq 'cloning') {
702
                            $imgstatus = "unused";
703
                            my $imgdomains = $regimg->{'domains'};
704
                            my $imgdomainnames = $regimg->{'domainnames'};
705
                            (tied %domreg)->select_where("user = '$imguser' or user = 'common'") unless ($fulllist);
706 8d7785ff Origo
                            foreach my $dom (values %domreg) {
707 95b003ff Origo
                                my $img = $dom->{'image'};
708
                                my $img2 = $dom->{'image2'};
709
                                my $img3 = $dom->{'image3'};
710
                                my $img4 = $dom->{'image4'};
711
                                if ($f eq $img || $f eq $img2 || $f eq $img3 || $f eq $img4) {
712
                                    $imgstatus = "active";
713
                                    my $domstatus = $dom->{'status'};
714
                                    if ($domstatus eq "shutoff" || $domstatus eq "inactive") {$imgstatus = "used";}
715
                                    elsif ($domstatus eq "paused") {$imgstatus = "paused";}
716
                                    $imgdomains = $dom->{'uuid'};
717
                                    $imgdomainnames = $dom->{'name'};
718
                                };
719
                            }
720
                            $imagereg{$f} = {
721
                                user=>$imguser,
722
                                type=>substr($suffix,1),
723
                                size=>$size,
724
                                realsize=>$realsize,
725
                                virtualsize=>$virtualsize,
726
                                backupsize=>$backupsize,
727
                                name=>$name,
728
                                uuid=>$uuid,
729
                                storagepool=>$storagepool,
730
                                mac=>$mac,
731
                                mtime=>$mtime,
732
                                status=>$imgstatus,
733
                                domains=>$imgdomains,
734
                                domainnames=>$imgdomainnames
735
                            }
736
                        } else {
737
                            $imagereg{$f} = {
738
                                user=>$imguser,
739
                                type=>substr($suffix,1),
740
                                size=>$size,
741
                                realsize=>$realsize,
742
                                virtualsize=>$virtualsize,
743
                                backupsize=>$backupsize,
744
                                name=>$name,
745
                                uuid=>$uuid,
746
                                storagepool=>$storagepool,
747
                                mac=>$mac,
748
                                mtime=>$mtime
749
                            }
750
                        }
751
                    }
752
753
                }
754
            }
755
756
            if ($params{'dominfo'} || $params{'dom1'}) {
757
                $register{$mac}->{'vms'} = $vms;
758
                $register{$mac}->{'vmvcpus'} = $vmvcpus;
759 a93267ad hq
                $register{$mac}->{'vmvgpus'} = $vmvgpus;
760 95b003ff Origo
                $register{$mac}->{'vmuuids'} = substr($vmuuids,0,-2);
761
                $register{$mac}->{'vmnames'} = substr($vmnames,0,-2);
762
                $register{$mac}->{'vmusers'} = substr($vmusers,0,-2);
763
            }
764
            if ($params{'stortotal'}) {
765
                $register{$mac}->{'reservedvcpus'} = $reservedvcpus;
766
            }
767
768
    # Clean up image db - remove images that are no longer on the node
769
            if ($params{'stortotal'} || $params{'stortotal'} eq "0") {
770
                my @regkeys = (tied %imagereg)->select_where("mac = '$mac'");
771
                foreach my $k (@regkeys) {
772
                    my $valref = $imagereg{$k};
773 d3805c61 hq
                    if ( ($valref->{'storagepool'} == -1) && ($valref->{'mac'} eq $mac) && !($valref->{'status'} =~ /moving/) && !($valref->{'status'} =~ /cloning/) ) {
774 95b003ff Origo
                        if ($reportedimgs{$valref->{'path'}} == 1) {
775
                        } elsif ($reportedimgs{$valref->{'path'}} == 2){
776
                            updateImageBilling($valref->{'user'}, $valref->{'path'}, "new image");
777
                        } else {
778
                            $main::updateUI->({tab=>"images", user=>$valref->{'user'}});
779
                            $main::syslogit->($valref->{'user'}, 'info', "Deleting image from db $valref->{'user'} - $reportedimgs{$valref->{'path'}} - $valref->{'path'} - $valref->{'status'} - $valref->{'mac'}");
780
                            delete $imagereg{$valref->{'path'}};
781
                            updateImageBilling($valref->{'user'}, $valref->{'path'}, "no image");
782
                        }
783
                    } elsif ($valref->{'storagepool'} == -1) {
784
                        ;
785
                    }
786
                }
787
            }
788
789
    # Clean up domain status, mark domains which are inactive or shuttingdown and not present on this node as shutoff
790
            my @regkeys = (tied %domreg)->select_where("mac = '$mac'");
791
            foreach my $domkey (@regkeys) {
792
                my $domref = $domreg{$domkey};
793
                if ($domref->{'mac'} eq $mac) {
794
                    if ($domref->{'status'} eq 'inactive' ||
795
                        ($domref->{'status'} eq 'shuttingdown' && $params{'memfree'} && !($nodedomains{$domref->{'uuid'}})) # domain has shut down, checking for param 'memfree' to make sure it's not just a status update from node
796
                    ) {
797
                        $domref->{'status'} = 'shutoff';
798
    #                    $main::updateUI->({tab=>"servers", user=>$domref->{'user'}, uuid=>$domref->{'uuid'}, status=>'shutoff',
799
    #                        message=>"shutoff ".$vmuuids."::".$domref->{'uuid'}});
800
                    }
801
                }
802
            }
803
804
805
    # Update billing
806
            my %billingreg;
807
            $monthtimestamp = timelocal(0,0,0,1,$mon,$year); #$sec,$min,$hour,$mday,$mon,$year
808
            # $monthtimestamp = timelocal(0,0,$hour,$mday,$mon,$year); #$sec,$min,$hour,$mday,$mon,$year
809
            unless (tie %userreg,'Tie::DBI', {
810
                db=>'mysql:steamregister',
811
                table=>'users',
812
                key=>'username',
813
                autocommit=>0,
814
                CLOBBER=>1,
815
                user=>$dbiuser,
816
                password=>$dbipasswd}) {return 0};
817
            my @pusers = keys %userreg;
818
            untie %userreg;
819
            unless (tie %billingreg,'Tie::DBI', {
820
                db=>'mysql:steamregister',
821
                table=>'billing_domains',
822
                key=>'usernodetime',
823
                autocommit=>0,
824
                CLOBBER=>3,
825
                user=>$dbiuser,
826
                password=>$dbipasswd}) {throw Error::Simple("Status=Error Billing register could not be accessed")};
827
828
            foreach my $puser (@pusers) {
829
                my $b = $billing{$puser};
830
                my $vcpu = $b->{'vcpu'};
831
                my $memory = $b->{'memory'};
832
                my $startvcpuavg = 0;
833
                my $startmemoryavg = 0;
834
                my $vcpuavg = 0;
835
                my $memoryavg = 0;
836 a93267ad hq
837
                my $vgpu = $b->{'vgpu'};
838
                my $vmemory = $b->{'vmemory'};
839
                my $startvgpuavg = 0;
840
                my $startvmemoryavg = 0;
841
                my $vgpuavg = 0;
842
                my $vmemoryavg = 0;
843
844 95b003ff Origo
                my $starttimestamp = $current_time;
845
846
            # Are we just starting a new month
847
                if ($current_time - $monthtimestamp < 4*3600) {
848
                    $starttimestamp = $monthtimestamp;
849
                    $vcpuavg = $vcpu;
850
                    $startvcpuavg = $vcpu;
851
                    $memoryavg = $memory;
852
                    $startmemoryavg = $memory;
853 a93267ad hq
854
                    $vgpuavg = $vgpu;
855
                    $startvgpuavg = $vgpu;
856
                    $vmemoryavg = $vmemory;
857
                    $startvmemoryavg = $vmemory;
858 95b003ff Origo
                }
859
860
                if ($billingreg{"$puser-$mac-$year-$month"}) {
861
                # Update timestamp and averages
862 a93267ad hq
                    $starttimestamp = $billingreg{"$puser-$mac-$year-$month"}->{'starttimestamp'};
863
                    $billingreg{"$puser-$mac-$year-$month"}->{'timestamp'} = $current_time;
864
                # vCPUs and memory
865 95b003ff Origo
                    $startvcpuavg = $billingreg{"$puser-$mac-$year-$month"}->{'startvcpuavg'};
866
                    $startmemoryavg = $billingreg{"$puser-$mac-$year-$month"}->{'startmemoryavg'};
867
                    $vcpuavg = ($startvcpuavg*($starttimestamp - $monthtimestamp) + $vcpu*($current_time - $starttimestamp)) /
868
                                    ($current_time - $monthtimestamp);
869
                    $memoryavg = ($startmemoryavg*($starttimestamp - $monthtimestamp) + $memory*($current_time - $starttimestamp)) /
870
                                    ($current_time - $monthtimestamp);
871
                    $billingreg{"$puser-$mac-$year-$month"}->{'vcpuavg'} = $vcpuavg;
872
                    $billingreg{"$puser-$mac-$year-$month"}->{'memoryavg'} = $memoryavg;
873
                    $billingreg{"$puser-$mac-$year-$month"}->{'timestamp'} = $current_time;
874 a93267ad hq
                # vGPUs and vmemory
875
                    $startvgpuavg = $billingreg{"$puser-$mac-$year-$month"}->{'startvgpuavg'};
876
                    $startvmemoryavg = $billingreg{"$puser-$mac-$year-$month"}->{'startvmemoryavg'};
877
                    $vgpuavg = ($startvgpuavg*($starttimestamp - $monthtimestamp) + $vgpu*($current_time - $starttimestamp)) /
878
                        ($current_time - $monthtimestamp);
879
                    $vmemoryavg = ($startvmemoryavg*($starttimestamp - $monthtimestamp) + $vmemory*($current_time - $starttimestamp)) /
880
                        ($current_time - $monthtimestamp);
881
                    $billingreg{"$puser-$mac-$year-$month"}->{'vgpuavg'} = $vgpuavg;
882
                    $billingreg{"$puser-$mac-$year-$month"}->{'vmemoryavg'} = $vmemoryavg;
883 95b003ff Origo
                }
884
885
                # No row found or something happened which justifies writing a new row
886
                if (!$billingreg{"$puser-$mac-$year-$month"}
887
                || ($vcpu != $billingreg{"$puser-$mac-$year-$month"}->{'vcpu'})
888
                || ($memory != $billingreg{"$puser-$mac-$year-$month"}->{'memory'})
889 a93267ad hq
                || ($vgpu != $billingreg{"$puser-$mac-$year-$month"}->{'vgpu'})
890
                || ($vmemory != $billingreg{"$puser-$mac-$year-$month"}->{'vmemory'})
891 95b003ff Origo
                ) {
892
                    my $inc = 0;
893
                    if ($billingreg{"$puser-$mac-$year-$month"}) {
894
                        $startvcpuavg = $vcpuavg;
895
                        $startmemoryavg = $memoryavg;
896 a93267ad hq
                        $startvgpuavg = $vgpuavg;
897
                        $startvmemoryavg = $vmemoryavg;
898 95b003ff Origo
                        $starttimestamp = $current_time;
899
                        $inc = $billingreg{"$puser-$mac-$year-$month"}->{'inc'};
900
                    }
901
                    # Write a new row
902
                    $billingreg{"$puser-$mac-$year-$month"} = {
903
                        vcpu=>$vcpu,
904
                        memory=>$memory,
905
                        vcpuavg=>$vcpuavg,
906
                        memoryavg=>$memoryavg,
907
                        startvcpuavg=>$startvcpuavg,
908
                        startmemoryavg=>$startmemoryavg,
909 a93267ad hq
910
                        vgpu=>$vgpu,
911
                        vmemory=>$vmemory,
912
                        vgpuavg=>$vgpuavg,
913
                        vmemoryavg=>$vmemoryavg,
914
                        startvgpuavg=>$startvgpuavg,
915
                        startvmemoryavg=>$startvmemoryavg,
916
917 95b003ff Origo
                        timestamp=>$current_time,
918
                        starttimestamp=>$starttimestamp,
919
                        event=>$b->{'event'},
920
                        inc=>$inc+1,
921
                    };
922
                }
923
            }
924
            untie %billingreg;
925
926
            tied(%domreg)->commit;
927
928
		}
929
# Check if this node has tasks, and send them to the node them if any
930
931
		if ($tasks) {
932
    		my $sendtasks = '';
933
			@tasklist = split(/\n/,$tasks);
934
			$sendtasks .= "\n";
935
			foreach $thetask (@tasklist) {
936
			    my ($task,$user) = split(/ /, $tasks);
937
				if ($task eq 'reboot') {
938
					$sendtasks .= "\nStatus=REBOOT $user\n";
939
				} elsif ($task eq 'shutdown' || $task eq 'halt') {
940
					$sendtasks .= "\nStatus=HALT $user\n";
941
				} elsif ($task eq 'unjoin') {
942
					unlink $file;
943
					$sendtasks .= "\nStatus=UNJOIN $user\n";
944
				} elsif ($task eq 'reload') {
945
					$sendtasks .= "\nStatus=RELOAD $user\n";
946
				} elsif ($task eq 'wipe') {
947
					$sendtasks .= "\nStatus=WIPE $user\n";
948
				} elsif ($task eq 'sleep') {
949
					$sendtasks .= "\nStatus=SLEEP $user\n";
950
				} elsif ($task eq 'wake') {
951
					$sendtasks .= "\nStatus=WAKE $user\n";
952
				} else {
953
				     if ($task) {
954
                        $sendtasks .= "Status=$thetask\n";
955
                    }
956
				};
957
			}
958 04c16f26 hq
            if ($sendtasks) {
959
                print  "\nStatus=OK $mac";
960
                print "$sendtasks";
961
                `echo "SENDING TASKS to $mac: $sendtasks" >> /var/log/stabile/steamExec.out`;
962
            }
963 95b003ff Origo
		} else {
964
			print  "\nStatus=OK $mac\n";
965
			my $sleepafter = $idreg{'default'}->{'sleepafter'};
966
			$sleepafter = 60 * $sleepafter;
967
			print "Status=SLEEPAFTER ". $sleepafter . "\n";
968
		}
969
		print end_html(), "\n";
970
	}
971
	untie %register;
972
	untie %domreg;
973
	untie %imagereg;
974
	untie %idreg;
975
976
    if ($plogentry && $plogentry ne '' && $uistatus) {
977
        $uistatus = 'maintenance' if ($uistatus eq 'running' && $maintenance);
978
        $main::updateUI->({tab=>$uitab, user=>$user, uuid=>$uiuuid, status=>$uistatus, mac=>$mac, macname=>$macname}) unless ($status eq '--');
979
        $main::syslogit->($user, 'info', "$plogentry $uiuuid ($uitab, $uistatus)");
980
    }
981
982
} catch Error with {
983
	my $ex = shift;
984
	print "\n", "$ex->{-text} (line: $ex->{-line})", "\n";
985
} finally {
986
};
987
988
sub permitOpen {
989
    my ($user) = @_;
990
    my $permit;
991
992
    unless (tie %userreg,'Tie::DBI', {
993
        db=>'mysql:steamregister',
994
        table=>'users',
995
        key=>'username',
996
        autocommit=>0,
997
        CLOBBER=>1,
998
        user=>$dbiuser,
999
        password=>$dbipasswd}) {return 0};
1000
1001
    my $privileges = $userreg{$user}->{'privileges'};
1002
    my $allowfrom = $userreg{$user}->{'allowfrom'};
1003
    untie %userreg;
1004
1005
    my @allows = split(/,\s*/, $allowfrom);
1006
1007
    if ($privileges && (index($privileges,"r")!=-1 || index($privileges,"d")!=-1)) {
1008
        ; # User is disabled or has only readonly access
1009
    } elsif ($user) {
1010
        my @regkeys = (tied %domreg)->select_where("user = '$user'");
1011
        foreach my $k (@regkeys) {
1012
            my $val = $domreg{$k};
1013
        # Only include VM's belonging to current user
1014
            if ($user eq $val->{'user'}) {
1015
                # Only include drivers we have heard from in the last 20 secs
1016
                #if ($current_time - ($val->{'timestamp'}) < 20) {
1017
                    my $targetmac = $val->{'mac'};
1018
                    my $targetip = $register{$targetmac}->{'ip'};
1019
                    my $targetport = $val->{'port'};
1020
                    if ($targetip && $targetport) {$permit .= " $targetip:$targetport";};
1021
                #} else {
1022
                #};
1023
            }
1024
        }
1025
        $permit = " 192.168.0.254:8000" unless $permit;
1026
    #    $main::syslogit->($user, 'info', "Allowed portforwarding for $user: $permit");
1027
1028
        open(TEMP1, "</etc/ssh/sshd_config") || (die "Problem reading sshd_config");
1029
        open(TEMP2, ">/etc/ssh/sshd_config.new") || (die "Problem writing sshd_config");
1030
        print TEMP2 "# Timestamp: $pretty_time\n";
1031
        my $umatch = 0;
1032
        my $allowusers;
1033
        my $auser = $user;
1034
        $auser =~ s/\@/\?/; # sshd_config does not support @'s in AllowUsers usernames
1035
        if ($allowfrom) { # Only allow login from certain ip's
1036
            $allowusers = "AllowUsers";
1037
            foreach my $ip (@allows) {
1038
                $ip = "$1*" if ($ip =~ /(\d+\.)0\.0\.0/);
1039
                $ip = "$1*" if ($ip =~ /(\d+\.\d+\.)0\.0/);
1040
                $ip = "$1*" if ($ip =~ /(\d+\.\d+\.\d+\.)0/);
1041
                $allowusers .= " irigo-$auser\@$ip ";
1042
            }
1043
            $allowusers .= "\n";
1044
        } else {
1045
            $allowusers = "AllowUsers irigo-$auser\n"; # Allow from anywhere
1046
        }
1047
1048
        my $matchuser = "irigo-$auser";
1049
        $matchuser =~ tr/\?/./; # question marks don't work in regexp match
1050
        while (<TEMP1>) {
1051
            my $line = $_;
1052
1053
            if ($user && $line =~ m/Match User $matchuser/) {$umatch = 1;}
1054
            elsif ($umatch && $line =~ m/Match User/) {$umatch = 0;}
1055
1056
            if ($line =~ m/AllowUsers irigo\@localhost/) {
1057
                print TEMP2 $line;
1058
                print TEMP2 "$allowusers";
1059
                next;
1060
            }
1061
            if (!$umatch && !($line =~ /^AllowUsers $matchuser/) && !($line =~ m/^# Timestamp/)) {
1062
                print TEMP2 $line;
1063
            }
1064
        }
1065
1066
        print TEMP2 <<END1;
1067
Match User irigo-$user
1068
ForceCommand /usr/local/bin/permitOpen $user 1
1069
PermitOpen$permit
1070
END1
1071
1072
;
1073
    #ForceCommand /usr/bin/perl -e '\$|=1;while (1) { print scalar localtime() . "\\n";sleep 30}'
1074
        close(TEMP1);
1075
        close(TEMP2);
1076
        rename("/etc/ssh/sshd_config", "/etc/ssh/sshd_config.old") || print "Status=ERROR Don't have permission to rename sshd_config";
1077
        rename("/etc/ssh/sshd_config.new", "/etc/ssh/sshd_config") || print "Status=ERROR Don't have permission to rename sshd_config";
1078
        eval {$output = `/etc/init.d/ssh restart`; 1;}  or do {print "Status=ERROR $@";};
1079
    }
1080
}
1081
1082
sub trim{
1083
   my $string = shift;
1084
   $string =~ s/^\s+|\s+$//g;
1085
   return $string;
1086
}
1087
1088
sub updateImageBilling {
1089
    my ($user, $bpath, $status, $backupsize) = @_; # Update billing for specific image storage pool with either virtualsize and backupsize
1090
1091
    if ($backupsize) {
1092
        $imagereg{$bpath}->{'backupsize'} = $backupsize;
1093
    }
1094 8d7785ff Origo
    return "No user" unless ($user);
1095 95b003ff Origo
    my $tenders = $Stabile::config->get('STORAGE_POOLS_ADDRESS_PATHS');
1096
    my @tenderlist = split(/,\s*/, $tenders);
1097
    my $tenderpaths = $Stabile::config->get('STORAGE_POOLS_LOCAL_PATHS') || "/mnt/stabile/images";
1098
    my @tenderpathslist = split(/,\s*/, $tenderpaths);
1099
    my $tendernames = $Stabile::config->get('STORAGE_POOLS_NAMES') || "Standard storage";
1100
    my @tendernameslist = split(/,\s*/, $tendernames);
1101
    my $storagepools = $Stabile::config->get('STORAGE_POOLS_DEFAULTS') || "0";
1102
    my $storagepool = 0;
1103
    if ($bpath =~ /\/mnt\/stabile\/node\//) {
1104
        $storagepool = -1;
1105
    } else {
1106
        my @spl = split(/,\s*/, $storagepools);
1107
        foreach my $p (@spl) {
1108
            if ($tenderlist[$p] && $tenderpathslist[$p] && $tendernameslist[$p]) {
1109
                my %pool = ("hostpath", $tenderlist[$p],
1110
                            "path", $tenderpathslist[$p],
1111
                            "name", $tendernameslist[$p],
1112
                            "rdiffenabled", $rdiffenabledlist[$p],
1113
                            "id", $p);
1114
                $spools[$p] = \%pool;
1115
                $storagepool = $p if ($bpath =~ /$tenderpathslist[$p]/)
1116
            }
1117
        }
1118
    }
1119
1120
    my %billing;
1121
1122
    my @regkeys = (tied %imagereg)->select_where("user = '$user' AND storagepool = '$storagepool'");
1123
    foreach my $k (@regkeys) {
1124
        my $valref = $imagereg{$k};
1125
        my %val = %{$valref}; # Deference and assign to new array, effectively cloning object
1126
        $val{'virtualsize'} += 0;
1127
        $val{'realsize'} += 0;
1128
        $val{'backupsize'} += 0;
1129
1130
        if ($val{'user'} eq $user && $val{'storagepool'} == $storagepool) {
1131
            $billing{$val{'storagepool'}}->{'virtualsize'} += $val{'virtualsize'};
1132
            $billing{$val{'storagepool'}}->{'realsize'} += $val{'realsize'};
1133
            $billing{$val{'storagepool'}}->{'backupsize'} += $val{'backupsize'};
1134
        }
1135
    }
1136
1137
    my %billingreg;
1138
    my $monthtimestamp = timelocal(0,0,0,1,$mon,$year); #$sec,$min,$hour,$mday,$mon,$year
1139
1140
    unless (tie %billingreg,'Tie::DBI', {
1141
        db=>'mysql:steamregister',
1142
        table=>'billing_images',
1143
        key=>'userstoragepooltime',
1144
        autocommit=>0,
1145
        CLOBBER=>3,
1146
        user=>$dbiuser,
1147
        password=>$dbipasswd}) {$main::syslogit->($user, 'info', "Status=Error Billing register could not be accessed")};
1148
1149
    my $b = $billing{$storagepool};
1150
    my $virtualsize = $b->{'virtualsize'};
1151
    my $realsize = $b->{'realsize'};
1152
    my $backupsize = $b->{'backupsize'};
1153
    my $startvirtualsizeavg = 0;
1154
    my $startrealsizeavg = 0;
1155
    my $startbackupsizeavg = 0;
1156
    my $starttimestamp = $current_time;
1157
    # No row found or something happened which justifies writing a new row
1158
    if ($b->{'event'} || !$billingreg{"$user-$storagepool-$year-$month"}
1159
    || ($b->{'virtualsize'} != $billingreg{"$user-$storagepool-$year-$month"}->{'virtualsize'})
1160
    || ($b->{'realsize'} != $billingreg{"$user-$storagepool-$year-$month"}->{'realsize'})
1161
    || ($b->{'backupsize'} != $billingreg{"$user-$storagepool-$year-$month"}->{'backupsize'})
1162
    ) {
1163
        my $inc = 0;
1164
        if ($billingreg{"$user-$storagepool-$year-$month"}) {
1165
            $startvirtualsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'virtualsizeavg'};
1166
            $startrealsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'realsizeavg'};
1167
            $startbackupsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'backupsizeavg'};
1168
            $starttimestamp = $billingreg{"$user-$storagepool-$year-$month"}->{'timestamp'};
1169
            $inc = $billingreg{"$user-$storagepool-$year-$month"}->{'inc'};
1170
        # Copy the old row for archival purposes
1171
#            my %bill = %{$billingreg{"$user-$storagepool-$year-$month"}};
1172
#            $billingreg{"$user-$storagepool-$year-$month-$current_time"} = \%bill;
1173
        }
1174
        # Write a new row
1175
        $billingreg{"$user-$storagepool-$year-$month"} = {
1176
            virtualsize=>$virtualsize+0,
1177
            realsize=>$realsize+0,
1178
            backupsize=>$backupsize+0,
1179
            virtualsizeavg=>$startvirtualsizeavg,
1180
            realsizeavg=>$startrealsizeavg,
1181
            backupsizeavg=>$startbackupsizeavg,
1182
            timestamp=>$current_time,
1183
            startvirtualsizeavg=>$startvirtualsizeavg,
1184
            startrealsizeavg=>$startrealsizeavg,
1185
            startbackupsizeavg=>$startbackupsizeavg,
1186
            starttimestamp=>$starttimestamp,
1187
            event=>"$status $bpath",
1188
            inc=>$inc+1,
1189
        };
1190
    } else {
1191
    # Update timestamp and averages
1192
        $startvirtualsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'startvirtualsizeavg'};
1193
        $startrealsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'startrealsizeavg'};
1194
        $startbackupsizeavg = $billingreg{"$user-$storagepool-$year-$month"}->{'startbackupsizeavg'};
1195
        $starttimestamp = $billingreg{"$user-$storagepool-$year-$month"}->{'starttimestamp'};
1196
        my $virtualsizeavg = ($startvirtualsizeavg*($starttimestamp - $monthtimestamp) + $virtualsize*($current_time - $starttimestamp)) /
1197
                        ($current_time - $monthtimestamp);
1198
        my $realsizeavg = ($startrealsizeavg*($starttimestamp - $monthtimestamp) + $realsize*($current_time - $starttimestamp)) /
1199
                        ($current_time - $monthtimestamp);
1200
        my $backupsizeavg = ($startbackupsizeavg*($starttimestamp - $monthtimestamp) + $backupsize*($current_time - $starttimestamp)) /
1201
                        ($current_time - $monthtimestamp);
1202
1203
        $billingreg{"$user-$storagepool-$year-$month"}->{'virtualsizeavg'} = $virtualsizeavg;
1204
        $billingreg{"$user-$storagepool-$year-$month"}->{'realsizeavg'} = $realsizeavg;
1205
        $billingreg{"$user-$storagepool-$year-$month"}->{'backupsizeavg'} = $backupsizeavg;
1206
        $billingreg{"$user-$storagepool-$year-$month"}->{'timestamp'} = $current_time;
1207
    }
1208
    untie %billingreg;
1209
}