Project

General

Profile

Download (85 KB) Statistics
| Branch: | Revision:
1
#!/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
use LWP::Simple;
9
use URI::Escape;
10
use POSIX;
11
use Sys::Syslog qw( :DEFAULT setlogsock);
12
use Sys::Virt;
13
use XML::Simple;
14
use Socket;
15
use File::Copy;
16
use Data::Dumper;
17
use Time::HiRes qw (usleep ualarm gettimeofday tv_interval);
18
use ConfigReader::Simple;
19
use Config::Simple;
20
use File::Basename;
21
use Text::ParseWords;
22
use Proc::Daemon;
23
use Error qw(:try);
24
use Proc::Background;
25
use Storable;
26
use sigtrap 'handler' => \&TERMINATE, 'QUIT', 'INT', 'TERM', 'KILL', 'STOP';
27

    
28
#$SIG{TERM} = TERMINATE;
29
#$SIG{KILL} = TERMINATE;
30
#$SIG{STOP} = TERMINATE;
31
#$SIG{__DIE__} = \&dont_die;  # Won't die now
32
#$SIG{__WARN__} = \&dont_die;  # Won't die now
33

    
34
my $cmdline = `cat /proc/cmdline`;
35
$cmdline =~ /identity=(\S*)/;
36
my $identity = $1;
37

    
38
my $cfg = new Config::Simple("/etc/stabile/nodeconfig.cfg");
39
# my $config = ConfigReader::Simple->new("/etc/stabile/nodeconfig.cfg",
40
#     [qw(ADMIN_SERVER_ADDRESS STORAGE_SERVERS_ADDRESS_PATHS STORAGE_SERVERS_LOCAL_PATHS ADMIN_NIC DATA_NIC
41
#         INITIALIZE_LOCAL_DISK
42
#         VM_READ_LIMIT VM_WRITE_LIMIT VM_IOPS_READ_LIMIT VM_IOPS_WRITE_LIMIT
43
#         PISTON_READ_LIMIT PISTON_WRITE_LIMIT PISTON_IOPS_READ_LIMIT PISTON_IOPS_WRITE_LIMIT
44
#         )]);
45
my $mainvalve = $cfg->param('ADMIN_SERVER_ADDRESS');
46
my $mainvalvepwd = $cfg->param('ADMIN_SERVER_HTTP_PWD') ||'sunshine';
47

    
48
my $cgset; # Have cgroup values been set?
49

    
50
my $initdisk = $cfg->param('INITIALIZE_LOCAL_DISK');
51
$identity = $identity || $cfg->param('IDENTITY');
52

    
53
my $adminnic = $cfg->param('ADMIN_NIC'); # This is the internal interface used for nfs-roots and for communcating with admin node on 10.0.0.1
54
my $datanic = $cfg->param('DATA_NIC'); # This is the external interface used for VM vlans
55
$adminnic = $datanic if (!$adminnic && $datanic);
56
$datanic = $adminnic if (!$datanic && $adminnic);
57

    
58
if (!($datanic) || !(`ifconfig | grep flags= | sed -n -e 's/ .*//p'` =~ /^$datanic::/)) { # Make sure device exists
59
    ($adminnic, $datanic) = getNics();
60
}
61

    
62
print "Using $adminnic as admin NIC\n";
63
print "Using $datanic as data NIC\n";
64

    
65
if ($identity eq 'local_kvm') {
66
    `iptables -D INPUT --in-interface $datanic -d 10.0.0.1 -j DROP 2>/dev/null`; # Disallow outside access to virtual internal network
67
    `iptables -A INPUT --in-interface $datanic -d 10.0.0.1 -j DROP`;
68
} else {
69
    # Make kvm listen for vnc connections on all interfaces - only on compute nodes not directly accessible from outside
70
    system("perl -pi -e 's/.*vnc_listen = .+/vnc_listen = \"0.0.0.0\"/' /etc/libvirt/qemu.conf") unless (`grep 'vnc_listen = "0.0.0.0"' /etc/libvirt/qemu.conf`);
71
}
72

    
73
# Make sure data nic is up...
74
print `ifconfig $datanic up`;
75

    
76
my $resolv = `cat /etc/resolv.conf`;
77
if ($resolv =~ /nameserver (\S*)/) {
78
	$mainvalve = scalar(gethostbyaddr(inet_aton($1), AF_INET)) unless $mainvalve;
79
	print "Using admin server $mainvalve ($1)\n";
80
} elsif ($mainvalve) {
81
	print "Adding nameserver $mainvalve\n";
82
	`echo "nameserver $mainvalve" >> /etc/resolv.conf`;
83
}
84

    
85
my $basedir = "/mnt/stabile/node";
86
my %mtimes;
87
my %img_sizes;
88
my %img_realsizes;
89
my %img_virtualsizes;
90
my %oldTimes;
91

    
92
my $tenders = $cfg->param('STORAGE_SERVERS_ADDRESS_PATHS') || "$mainvalve:/mnt/stabile/images";
93
my @tenderlist;
94
if (ref $tenders eq 'ARRAY') {
95
    @tenderlist = @{$tenders};
96
} else {
97
    @tenderlist = split(/,\s*/, $tenders);
98
}
99
my $tenderpaths = $cfg->param('STORAGE_SERVERS_LOCAL_PATHS') || "/mnt/stabile/images";
100
my @tenderpathslist;
101
if (ref $tenderpaths eq 'ARRAY') {
102
    @tenderpathslist = @{$tenderpaths};
103
} else {
104
    @tenderpathslist = split(/,\s*/, $tenderpaths);
105
}
106

    
107
unless ($mainvalve && $adminnic) {
108
    print "ADMIN_SERVER_ADDRESS and ADMIN_NIC in /etc/stabile/nodeconfig.cfg should contain valid values\n";
109
    exit(0);
110
}
111

    
112
$processes = `ps ax | grep \/usr\/local\/sbin\/movepiston | wc -l`;
113
if (!($ARGV[0] =~ /command=(.+)/) && $processes > 3) {
114
    print "Only one movepiston can be running!\n";
115
    logit('info', "Only one movepiston can be running!");
116
    sleep 1;
117
    exit(0);
118
}
119

    
120
my $base_url = "http://$mainvalve/stabile/piston/piston.cgi";
121
my $stats_url = "http://$mainvalve/stabile/piston/pistonstats.cgi";
122

    
123

    
124
my $running = 1;
125
my $dostats = 1;
126
my $status = "shutdown";
127
my $virshemu = 'qemu';
128
my $naptime = 5; # time  in seconds between piston updates
129
my $statsnap = 10; # time in seconds between stats updates - this must be coordinated with values in pistonstats.cgi
130
my $stornap = 5; # How often to update storage and local image info
131
my $laststatstime = 0;
132
my $laststortime = 0;
133
#my $laststorfree = 0;
134
my $sleepafter = 50*60; # default time to sleep after
135
my $drowsiness = 0;
136
my %mortuary;
137

    
138
if ($identity eq "vbox") {$virshemu = 'vbox'};
139

    
140
my @domstates = ("nostate", "running", "blocked", "paused", "shutdown", "shutoff", "crashed");
141

    
142
my $browser = LWP::UserAgent->new;
143
if ($identity eq 'local_kvm') {
144
    $browser->local_address("10.0.0.1");
145
}
146
$browser->agent('movepiston/1.0b');
147
$browser->protocols_allowed( [ 'http','https'] );
148
$browser->credentials(
149
  "$mainvalve:80",
150
  'Services',
151
  'irigo', $mainvalvepwd
152
);
153

    
154
my $ifinfo;
155
if (`ifconfig $adminnic`) {
156
    $ifinfo = `ifconfig $adminnic`;
157
} else {
158
    print "NIC $adminnic is not availaible on this node\n";
159
    die;
160
}
161
my $mac;
162
$mac = $1 if ($ifinfo =~ /HWaddr (\S+)(\s*)\n/);
163
$mac = $1 if ($ifinfo =~ /ether (\S+)(\s*)/);
164
my $nmac = $mac;
165
$nmac =~ tr/://d;
166
print "Using mac $mac as id for this node\n";
167

    
168
if ($identity eq "local_kvm" && $nmac ne $cfg->param('MAC')) {
169
    $identity = '';
170
    print "Network interface change detected - rejoining\n";
171
}
172

    
173

    
174
my $hostname = $mac;
175
$mac = uri_escape($mac);
176
$hostname =~ tr/://d;
177
$hostname = "piston" . $hostname;
178
$ifinfo =~ m/inet (\S+) (.*)\n/i;
179
my $ip = $1;
180
my $glogentry = "--: nodes: $nmac: running: Bringing up $identity piston...";
181
my $command;
182

    
183
# Load IPMI modules
184
`modprobe ipmi_devintf`;
185
my $ipmiip;
186
unless (system("modprobe ipmi_si")) {
187
    my $ipmiinfo = `/usr/bin/ipmitool lan print 1`;
188
    if ($ipmiinfo =~ m/IP Address     .+: (.+)\n/i) {
189
        $ipmiip = $1;
190
    }
191
} else {
192
    print "IPMI is not available on this node\n";
193
}
194

    
195
# Disable offloading to NIC - at least for our mini-ITX boards this prevents crashes
196
print `ethtool -K $adminnic gso off gro off tso off`;
197
print `ethtool -K $datanic gso off gro off tso off` if ($adminnic ne $datanic);
198

    
199
# Prevent VM's using Libvirt's default network to reach each other + infrastructure
200
`modprobe br_netfilter` unless (`lsmod | grep br_netfilter`);
201
`echo 1 > /proc/sys/net/bridge/bridge-nf-call-iptables`;
202
`iptables -D FORWARD --in-interface virbr0 -d 192.168.0.0/16 -j DROP 2>/dev/null`;
203
`iptables -I FORWARD --in-interface virbr0 -d 192.168.0.0/16 -j DROP`;
204
`iptables -D FORWARD --in-interface virbr0 -d 10.0.0.0/8 -j DROP 2>/dev/null`;
205
`iptables -I FORWARD --in-interface virbr0 -d 10.0.0.0/8 -j DROP`;
206

    
207
my $stor;
208
my $test;
209
$debug;
210
$debug = 1 if ($ARGV[0] eq 'debug' || $ARGV[0] eq 'stats' || $ARGV[0] eq 'test' || $ARGV[1] eq 'debug' || $ARGV[1] eq 'stats');
211
$dostats = 0 if ($ARGV[0] eq 'nostats' || $ARGV[1] eq 'nostats');
212

    
213
my $badstrokes = "/tmp/badstrokes"; # Keeping track of bad, crashing tasks
214
my $tombstones = "/tmp/tombstones"; # Keep track of destroyed servers
215

    
216
`rm /tmp/movepiston.out` if (-e "/tmp/movepiston.out");
217
`chmod 666 /dev/zfs` if (-e '/dev/zfs'); # TODO: This should be removed once we upgrade to Bionic and zfs allow is supported
218

    
219
while ($running) {
220
    if ($ARGV[0] eq 'stop') {
221
    	TERMINATE();
222
    } elsif ($ARGV[0] =~ /^command=(.+)/) {
223
        $command = $1;
224
        if ($command =~ /(backup\..+)/ && -e "/tmp/$1") {
225
            my $backuptasks = $1;
226
    #        logit('info', "Performing command $command $ARGV[1] $ARGV[2] $ARGV[3] $ARGV[4] $ARGV[5] $ARGV[6]");
227
            my $lines = `cat /tmp/$backuptasks`;
228
            chomp $lines;
229
            unlink("/tmp/$backuptasks");
230
    		my @clines = split /\n/, $lines;
231
            foreach my $line (@clines) {
232
                logit('info', "Backing up: $line");
233
                my @args = shellwords($line);
234
                backup($args[0], $args[1], $args[2], $args[3], $args[4],$args[5]);
235
            }
236
    #            backup($ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4], $ARGV[5], $ARGV[6]);
237
        }
238
    } elsif ($ARGV[0] eq 'testmove' && $identity) {
239
        my $devs = listCopyDisks($ARGV[1]);
240
        print Dumper($devs);
241
        TERMINATE();
242
    } elsif ($ARGV[0] eq 'test' && $identity) {
243
    	$test = 1;
244
        initializeLocalDisk($initdisk) if ($initdisk && $identity ne 'local_kvm');
245
    	updatePistonInfo();
246
        TERMINATE();
247
    } elsif ($ARGV[0] eq 'stats' && $identity) {
248
    	$test = 1;
249
    	updatePistonStats();
250
        $running = 0;
251
    } elsif ($identity eq "kvm" || $identity eq "local_kvm" || $identity eq "vbox") {
252
        $status = "running";
253
       	$running = 1;
254
        if ($identity ne 'local_kvm') {
255
            if ($initdisk) {
256
                my $res = initializeLocalDisk($initdisk);
257
            }
258
            print `/bin/hostname $hostname`;
259
            print `/bin/echo "127.0.0.1 localhost\n$ip $hostname" > /etc/hosts`;
260

    
261
            my $mounts = `cat /proc/mounts`;
262
            if ($mounts =~ /\mnt\/stabile\/node/) {
263
                if ($mounts =~ /volgroup1-lvol1/) {
264
                    $stor = 'lvm';
265
                } elsif ($mounts =~ /stabile-node/) {
266
                    $stor = 'zfs';
267
                }
268
            }
269
            if ($identity eq 'local_kvm') {
270
                logit('info', "Local kvm - not initializing cgroups");
271
            } elsif (!$cgset) {
272
                setCgroups();
273
                $cgset = 1;
274
            } else {
275
                logit('info', "Unable to initialize cgroups!!");
276
                print "Unable to initialize cgroups!!\n";
277
                $running = 0;
278
            }
279
            # restart rsyslog to pick up new hostname
280
            print `/sbin/restart rsyslog`;
281
            print "Setting clock from $mainvalve\n" unless ($debug);
282
            print `/usr/sbin/ntpdate $mainvalve` unless ($debug);
283
           	print "Known tenders:\n", Dumper(\@tenderlist) if $debug;
284
           	print "Known tender paths:\n", Dumper(\@tenderpathslist) if $debug;
285
            print "Trying to mount " . (scalar @tenderpathslist) . " tenders\n";
286

    
287
            for (my $i=0; $i<(scalar @tenderpathslist); $i++) {
288
               my $path = $tenderpathslist[$i];
289
               my $host = $tenderlist[$i];
290
               if ($mounts =~ m/$path /i) {
291
                   print ("$path already mounted\n") if ($debug);
292
               } elsif ($identity ne 'local_kvm' && $host =~ /10\.0\.0\.1/) {
293
                   print "Mounting $path from $host\n";
294
                   logit('info', "Mounting (1) $path from $host");
295
                   # Directory / mount point must exist
296
                   `mkdir -p "$path"` unless (-e $path);
297
#                   eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
298
                   eval {print `mount -o hard,intr,nolock,noatime,nfsvers=3,tcp,timeo=1200,rsize=1048600,wsize=1048600,bg $host $path`; 1;} or do {print $@;};
299
               }
300
            }
301
            `chmod 777 /mnt/stabile/*`;
302
        }
303
        if ($identity eq "kvm") {
304
            logit('info', "Bringing up KVM piston $nmac");
305
        } elsif ($identity eq "local_kvm") {
306
            logit('info', "Bringing up local KVM piston $nmac");
307
        } elsif ($identity eq "vbox") {
308
            logit('info', "Bringing up Virtual Box piston $nmac");
309
            print `/etc/init.d/vboxdrv start`,"\n";
310
        }
311

    
312

    
313
        my $failedtasks;
314
        if (-e $badstrokes && !(-z $badstrokes)) {
315
            $failedtasks  = `cat $badstrokes`;
316
            logit('info', "A previous attempt at executing tasks failed:\n$failedtasks");
317
            print "Trying to execute again.\n";
318
            updatePistonInfo($failedtasks) if ($failedtasks =~ m/^\S+=(.*)/ig);
319
            unlink($badstrokes);
320
        }
321
        if (-e $tombstones && !(-z $tombstones)) {
322
            my $hashref = retrieve($tombstones);
323
            %mortuary = %{$hashref};
324
            logit('info', "A list of previously destroyed domains was found: " . Dumper(%mortuary));
325
        }
326
    	while ($running) {
327
            try {
328
                $running = updatePistonInfo();
329
                if ($dostats && (time() > $laststatstime + $statsnap)) {
330
            #        `sync; echo 3 > /proc/sys/vm/drop_caches`; # Clean up
331
                    $laststatstime = time();
332
                    updatePistonStats();
333
                }
334
                sleep $naptime;
335
                drowse();
336
            } catch Error with {
337
                my $ex = shift;
338
                print "Internal Error: $ex\n";
339
            } finally {
340
            };
341
    	}
342
    } elsif ($identity eq "rescue") {
343
    	logit('info', "Bringing up rescue piston");
344
    	$status = "running";
345
    	$running = 1;
346
    	while ($running) {
347
    		sleep $naptime;
348
    	}
349
    } else {
350
    	logit('info', "No identity: $identity Joining the engine...");
351
        updateInterfaces();
352
    	$status = "joining";
353
    	my $cpuinfo = `cat /proc/cpuinfo`;
354
    	$cpuinfo =~ m/model name.*:\s*(.*)\n/i;
355
    	my $cpuname = $1;
356
    	$cpuname =~ s/( )+//g;
357
    	$cpuinfo =~ m/cpu family.*:\s*(.*)\n/i;
358
    	my $cpufamily = $1;
359
    	$cpuinfo =~ m/model.*:\s*(.*)\n/i;
360
    	my $cpumodel = $1;
361
    	$cpuinfo =~ m/cpu MHz.*:\s*(.*)\n/i;
362
    	my $cpuspeed = $1;
363
    	my $cpucores = "1";
364
    	if ($cpuinfo =~ m/cpu cores.*:\s*(.+)\n/i) {
365
    		$cpucores = $1;
366
    	} elsif ($cpuinfo =~ m/siblings.*:\s*(.+)\n/i) {
367
    		$cpucores = $1;
368
    	}
369
    	my $cpucount = 0;
370
    	while ($cpuinfo =~ /physical id.*: (.+)\n/gi) {
371
    		if ($1 > $cpucount) {
372
    			$cpucount = $1;
373
    		}
374
    	}
375
    	$cpucount++;
376
    	my $meminfo = `cat /proc/meminfo`;
377
    	$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
378
    	my $memtotal = $1;
379
    	$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
380
    	my $memfree = $1;
381
    	$meminfo =~ m/Cached:\s*(.*) kB\n/i;
382
    	my $memcached = $1;
383
    	$memfree += $memcached; # or `echo 3 > /proc/sys/vm/drop_caches` to free caches
384

    
385
        my $logentry = "--: nodes: $nmac: joining: Trying to join";
386
    	my $url = $base_url . "?mac=$mac&ip=$ip&cpucores=$cpucores&cpucount=$cpucount&cpuspeed=$cpuspeed&cpuname=" .
387
    	 uri_escape("$cpuname") . "&ipmiip=" . uri_escape($ipmiip) .
388
    	 "&cpufamily=$cpufamily&cpumodel=$cpumodel&memtotal=$memtotal&memfree=$memfree&status=joining&logentry=" .
389
    	 $logentry;
390

    
391
    	my $assimilated = 0;
392
    	my $i = 0;
393
    	while ($assimilated == 0) {
394
    		my $content = $browser->get($url)->content();
395
    		logit('info', "Waiting for assimilation...");
396
    		if (defined $content) {
397
    			my $assimilation_status = "";
398
    			if ($content =~ /Assimilation=(\S*)(.*)/i) {
399
    				$assimilation_status = $1;
400
    				$assimilation_reason = $2;
401
    				if ($assimilation_status eq "OK") {
402
    					$assimilated = 1;
403
    				} else {
404
    					logit('info', "Assimilation not accepted: $assimilation_status$assimilation_reason");
405
    					sleep 2;
406
    					if ($i>2) {last} else {$i++};
407
    				}
408
    			} else {
409
    				logit('info', "Assimilation answer not received: $content");
410
    				sleep 2;
411
    				if ($i>2) {last} else {$i++};
412
    			}
413
    		} else {
414
    				logit('info', "Couldn't get $url:");
415
    				sleep 2;
416
    				if ($i>2) {last} else {$i++};
417
    		}
418
    	}
419
    	if ($assimilated == 1) {
420
            if (-e "/etc/stabile/config.cfg") { # We are on valve
421
                $identity = 'local_kvm';
422
            } else {
423
                $identity = 'kvm';
424
            }
425
            $cfg->param("IDENTITY", $identity);
426
            $cfg->param("MAC", $nmac);
427
            $cfg->save();
428
            logit('info', "Assimilation completed...");
429
    	}
430
    }
431
}
432
1;
433

    
434

    
435
sub updatePistonInfo {
436
    my $failedtasks = shift;
437
	logit('info', "Updating piston info...") if ($debug);
438
	$naptime = 5;
439
	my $pid;
440

    
441
	my $cpuload = `cat /proc/loadavg`;
442
	$cpuload =~ m/(\S*) /i;
443
	$cpuload = $1;
444
	my $cpucores = "1";
445
	my $cpuinfo = `cat /proc/cpuinfo`;
446
	if ($cpuinfo =~ m/cpu cores.*:\s*(.+)\n/i) {
447
		$cpucores = $1;
448
	} elsif ($cpuinfo =~ m/siblings.*:\s*(.+)\n/i) {
449
		$cpucores = $1;
450
	}
451
	my $cpucount = 0;
452
	while ($cpuinfo =~ /physical id.*: (.+)\n/gi) {
453
		if ($1 > $cpucount) {
454
			$cpucount = $1;
455
		}
456
	}
457
	$cpucount++;
458
	my $meminfo = `cat /proc/meminfo`;
459
	$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
460
	my $memtotal = $1;
461
	$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
462
	my $memfree = $1;
463
	$meminfo =~ m/Cached:\s*(.*) kB\n/i;
464
	my $memcached = $1;
465
	$memfree += $memcached; # or `echo 3 > /proc/sys/vm/drop_caches` to free caches
466
	$status = "shutdown" unless ($running || $status eq "asleep");
467

    
468
    my $nfsroot;
469
    $nfsroot = uri_escape($1) if ($cmdline =~ m/ nfsroot=(\S+) /);
470
    my $kernel;
471
    $kernel = uri_escape($1) if ($cmdline =~ m/BOOT_IMAGE=(\S+) /);
472

    
473
    # Bring up local interfaces if it has been lost because of S3 sleep
474
    updateInterfaces();
475

    
476
    # piston.cgi gets the ip from the http request
477
    #my $ipline = `ip -br addr show $adminnic`;
478
    #chomp $ipline;
479
    #my $ip;
480
    #$ip = $1 if ($ipline =~ /\d+\.\d+\.\d+\.\d+\/24/);
481

    
482
    #	my $virshlist = `virsh -c $virshemu:///system list`;
483
	logit('info', "Initializing libvirt connection: $virshemu:///system") if ($debug);
484
	my $vmm = Sys::Virt->new(address => "$virshemu:///system");# unless $vmm;
485
	logit('info', "Getting dominfo from: $virshemu:///system") if ($debug);
486

    
487
	# Load domain info into $dinfo
488
	my $dinfo = dominfo($vmm);
489

    
490
    # Put node info into $dinfo
491
    $dinfo->{'status'} = $status;
492
    $dinfo->{'mac'} = $mac;
493
    #$dinfo->{'ip'} = $ip;
494
    $dinfo->{'memtotal'} = $memtotal;
495
    $dinfo->{'memfree'} = $memfree;
496
    $dinfo->{'identity'} = $identity;
497
    $dinfo->{'nfsroot'} = $nfsroot;
498
    $dinfo->{'kernel'} = $kernel;
499
    $dinfo->{'cpuload'} = $cpuload;
500
    $dinfo->{'cpucount'} = $cpucount;
501
    $dinfo->{'cpucores'} = $cpucores;
502
    $dinfo->{'cpucores'} = $cpucores;
503
    $dinfo->{'ipmiip'} = uri_escape($ipmiip);
504

    
505
    # Local storage info
506
    my $stortotal = "0";
507
    my $storfree = "0";
508
    my $esc_path = ($identity eq 'local_kvm')?$tenderpathslist[0]:'/mnt/stabile/node';
509
    my $storinfo = `df -kl $esc_path`;
510
    if (!($storinfo=~/aufs/) && $storinfo =~ m/\s+(\d+)\s+(\d+)\s+(\d+).+\n/si) {
511
        $stortotal = $1;
512
        $storfree = $3;
513
    }
514
    # Load storage info into $dinfo
515
	print "Getting storage info\n" if ($debug);
516
    if (time() > $laststortime + $stornap) {
517
        $laststortime = time();
518

    
519
        # Local image sizes
520
        my @thefiles = recurse($basedir);
521
        my $j = 0;
522
        foreach my $f (@thefiles) {
523
            if ($f =~ /(s\d\d\d\.vmdk$)|(-flat\.vmdk$)/) {
524
                ;
525
            } elsif($f =~ /(\.vmdk$)|(\.img$)|(\.vhd$)|(\.qcow$)|(\.qcow2$)|(\.vdi$)|(\.iso$)/i) {
526
                $j++;
527
                my($fname, $dirpath, $suffix) = fileparse($f, (".vmdk", ".img", ".vhd", ".qcow", ".qcow2", ".vdi", ".iso"));
528
				$dirpath =~ /$basedir\/([^\/]+)/;
529
				my $user = $1;
530
        # Deal with sizes
531
                ($newsize, $newrealsize, $newvirtualsize, $newmtime) = getSizes($f, $mtimes{$f});
532
                if ($newmtime) {
533
                    $mtimes{$f} = $newmtime;
534
                    $img_sizes{$f} = $newsize;
535
                    $img_realsizes{$f} = $newrealsize;
536
                    $img_virtualsizes{$f} = $newvirtualsize;
537
                }
538
                $dinfo->{"img$j"} = uri_escape($f);
539
                $dinfo->{"size$j"} = $img_sizes{$f};
540
                $dinfo->{"realsize$j"} = $img_realsizes{$f};
541
                $dinfo->{"virtualsize$j"} = $img_virtualsizes{$f};
542

    
543
				if (-e "$f.meta" && `grep backingup "$f.meta"` && !(`pgrep "$f.meta"`)) {
544
					unlink "$f.meta";
545
					$mes = "Backup aborted ($fname)";
546
					logit('err', "Backup of $f aborted for user $user");
547
					my $logentry = "$user: images: $f: unused: $mes";
548

    
549
					# Update the client UI
550
					my $url = $base_url . "?mac=$mac&status=updateui&logentry="  . uri_escape($logentry);
551
					print "Updating image registry: $url\n" if ($debug);
552
					my $content = $browser->get($url)->content();
553
					print $content;
554
				}
555

    
556
            }
557
        }
558
        $dinfo->{"stortotal"} = $stortotal;
559
        $dinfo->{"storfree"} = $storfree;
560
        $dinfo->{"stor"} = $stor;
561
    }
562

    
563
    if($failedtasks) {
564
    	logit('info', "Not posting node status - we have failed tasks: " . Dumper($dinfo)) if ($debug);
565
        $content = $failedtasks; # content restored from previous crash was supplied
566
        $glogentry = "--: nodes: $nmac: $status: Brought up piston with failed tasks...";
567
	} else {
568
        $dinfo->{'logentry'} = uri_escape($glogentry) if ($glogentry);
569
    	logit('info', "Posting node status to URL: $base_url: " . Dumper($dinfo)) if ($debug);
570
	    $content = $browser->post($base_url, $dinfo)->content();
571
        $glogentry = '';
572
	}
573

    
574
	if ($test || $debug) {
575
		print pretty_time(), ": ", $content if ($debug);
576
	};
577
#	my $debugline = pretty_time() . ": " . $content;
578
#	open TEMP3, ">>/tmp/movepiston.out";
579
#	print TEMP3 $debugline;
580
#	close TEMP3;
581

    
582
	my $task_1 = '';
583
	my $task_2 = '';
584
	my $task_3 = '';
585

    
586
	if (defined $content) {
587
    	my @receiveuuids;
588
    	my @storreceiveuuids;
589
		my @clines = split /\n/, $content;
590
		my @lines;
591
        foreach my $line (@clines) {
592
            if ($line =~ m/^\S+=SLEEPAFTER (\d+)/ig) {
593
                $sleepafter = int($1);
594
            } elsif ($line =~ m/^\S+=.+/ig) {
595
                push(@lines, $line);
596
            }
597
        }
598
        while (my $line = shift @lines) {
599
			$url = $base_url . "?mac=$mac&identity=$identity";
600

    
601
            my $rcontent = join("\n", @lines);
602
            `echo "$rcontent" > $badstrokes` if (@lines);
603
            $line =~ m/^\S+=(.*)/ig;
604
            @tasks = shellwords($1);
605
            $task_1 = $tasks[0]; #$1;
606
            $task_2 = $tasks[1]; #$2;
607
            $task_3 = $tasks[2]; #$3;
608
            if ($task_1 eq "REBOOT" && $identity ne 'local_kvm') {
609
                $status = "reboot";
610
                my $logentry = "$task_2: nodes: $nmac: $status: Reboot request received - rebooting";
611
                logit('info', $logentry);
612
                $url .= "&status=$status&logentry=" . uri_escape($logentry);
613
                my $newcontent = $browser->get($url)->content();
614
                print `/sbin/reboot`;
615
                chop $@; $logentry .= "\n$@" if $@;
616
                if ($@) {
617
                    chop $@; $logentry .= "\n$@";
618
                    $newcontent = $browser->get($url)->content();
619
                }
620
            }
621
            elsif ($task_1 eq "HALT" && $identity ne 'local_kvm') {
622
                $status = "shutdown";
623
                my $logentry = "$task_2: nodes: $nmac: $status: Halt request received - shutting down";
624
                logit('info', $logentry);
625
                $url .= "&status=$status&logentry=" . uri_escape($logentry);
626
                my $newcontent = $browser->get($url)->content();
627
                sleep 5;
628
                print `systemctl stop movepiston`;
629
                `echo 0 > /proc/sys/kernel/hung_task_timeout_secs`;
630
                print `poweroff`;
631
                if ($@) {
632
                    chop $@; $logentry .= "\n$@";
633
                    $newcontent = $browser->get($url)->content();
634
                }
635
            }
636
            elsif ($task_1 eq "SLEEP" && $identity ne 'local_kvm') {
637
                if ($identity eq "kvm") {
638
                    logit('info', "Taking down KVM piston");
639
                } elsif ($identity eq "vbox") {
640
                    logit('info', "Taking down Virtual Box piston");
641
                }
642
                $status = "asleep";
643
                my $logentry = "$task_2: nodes: $nmac: $status: Sleep request received - putting node to sleep";
644
                logit('info', $logentry);
645
                $running = 0;
646
                $url .= "&status=$status&logentry=" . uri_escape($logentry);
647
                my $newcontent = $browser->get($url)->content();
648
                sleep 5;
649
#					my $meminfo = `cat /proc/acpi/sleep`;
650
#					my $s3sleep = ($meminfo =~ m/S3/);
651

    
652
                my $meminfo = `cat /sys/power/state`;
653
                my $s3sleep = ($meminfo =~ m/mem/);
654

    
655
                if (0 && $s3sleep) {
656
                    print `/etc/init.d/libvirt-bin stop`,"\n" if ($identity eq "vbox");
657
                    #print `/etc/acpi/sleep.sh`;
658
                    print `/bin/echo -n "mem" > /sys/power/state`;
659
                } else {
660
                    print `systemctl stop movepiston`;
661
                    `echo 0 > /proc/sys/kernel/hung_task_timeout_secs`;
662
                    print `poweroff`;
663
#                    print `/sbin/shutdown -P now`;
664
                }
665
            }
666
            elsif ($task_1 eq "WAKE" && $identity ne 'local_kvm') {
667
                $status = "awake";
668
                my $logentry = "$task_2: nodes: $nmac: $status: Wake request received - now awake";
669
                logit('info', $logentry);
670
                $url .= "&status=$status&logentry=" . uri_escape($logentry);
671
                my $newcontent = $browser->get($url)->content();
672
            }
673
            elsif ($task_1 eq "WIPE" && $identity ne 'local_kvm') {
674
                my $logentry = "$task_2: nodes: $nmac: $status: Wipe request received";
675
                logit('info', $logentry);
676
                my $url2 = "$url&status=$status&logentry=" . uri_escape($logentry);
677
                my $newcontent = $browser->get($url2)->content();
678
                my $res = initializeLocalDisk($initdisk, 1);
679
                $logentry = "$task_2: nodes: $nmac: $status: $res";
680
                logit('info', $logentry);
681
                $url2 = "$url&status=$status&logentry=" . uri_escape($logentry);
682
                $newcontent = $browser->get($url2)->content();
683
            }
684
            elsif ($task_1 eq "UNJOIN") {
685
                $status = "unjoin";
686
                my $logentry = "$task_2: nodes: $nmac: $status: Unjoin request received";
687
                logit('info', $logentry);
688
                $url .= "&status=$status&logentry=" . uri_escape($logentry);
689
                my $newcontent = $browser->get($url)->content();
690
                print `/sbin/reboot`;
691
            }
692
            elsif ($task_1 eq "RELOAD") {
693
                $status = "reload";
694
                my $logentry = "$task_2: nodes: $nmac: $status: Reload request received";
695
                logit('info', $logentry);
696
                $url .= "&status=$status&logentry=" . uri_escape($logentry);
697
                my $newcontent = $browser->get($url)->content();
698
                $running = 0;
699
                `/bin/systemctl restart movepiston`;
700
            }
701
            # Reload cgroups
702
            elsif ($task_1 eq "CGLOAD") {
703
                setCgroups();
704
                $cgset = 1;
705
            }
706
            elsif ($task_1 eq "SLEEPAFTER") {
707
                $sleepafter = int($task_2);
708
            }
709
            elsif ($task_1 eq "PERMITOPEN") {
710
                if ($task_2) {
711
                    my $logentry = "$task_2: servers: : : Permitopen request received - updating allowed ssh forwards";
712
                    logit('info', $logentry);
713
                    # Ask piston.cgi to allow port forwards for user
714
                    my $newurl = $url . "&status=permitopen&user=$task_2";
715
                    my $newcontent = $browser->get($newurl)->content();
716
                    # Clear tasks list
717
                    #$newurl = $url ."&status=$status";
718
                    #$newcontent = $browser->get($newurl)->content();
719
                }
720
            }
721
            elsif ($task_1 eq "DESTROY") {
722
            	$naptime = 1; # Temporarily speed up in order to report back promptly
723
                # uuid ~ $task_2, user ~ $task_3
724
                my $logentry = "$task_3: servers: $task_2: destroying: Destroy request received";
725
                logit('info', $logentry);
726
                my $dom;
727
                eval {$dom = $vmm->get_domain_by_uuid($task_2);} or do {print $@;};
728
#                   $dom->destroy();
729
                my $virshcmd = "virsh -c $virshemu:///system destroy $task_2";
730
                # status is set to -- to prevent redundant UI update from piston.cgi
731
                my $nurl = $url . "&status=--&logentry=" . uri_escape($logentry);
732
                my $newcontent = $browser->get($nurl)->content();
733
                $mortuary{$task_2} = 'destroying';
734
                store \%mortuary, $tombstones;
735
                run_in_bg($virshcmd) if ($dom);
736
                # status is set to -- to prevent redundant UI update from piston.cgi
737
                $url .= "&status=--";
738
                my $newcontent = $browser->get($url)->content();
739
            }
740
            elsif ($task_1 eq "SHUTDOWN") {
741
            	$naptime = 1; # Temporarily speed up in order to report back promptly
742
                my $logentry = "$task_3: servers: $task_2: shuttingdown: Shutdown request received";
743
                logit('info', $logentry);
744
                #my $virshcmd = `echo 'qemu-monitor-command --hmp $task_2 "system_powerdown"' | virsh -c $virshemu:///system`;
745
                #print $virshcmd,"\n";
746
                #my $virshcmd = "/usr/bin/sudo -u irigo /usr/bin/ssh localhost virsh -c $virshemu:///system shutdown $task_2";
747
                my $dom;
748
                eval {$dom = $vmm->get_domain_by_uuid($task_2);} or do {print $@;};
749
                #$dom->shutdown();
750
                #sleep 2;
751

    
752
                my $virshcmd = "virsh -c $virshemu:///system shutdown $task_2";
753
                my $nurl = $url . "&status=--&logentry=" . uri_escape($logentry);
754
                my $newcontent = $browser->get($nurl)->content();
755
                $mortuary{$task_2} = 'shuttingdown';
756
                store \%mortuary, $tombstones;
757
                run_in_bg($virshcmd) if ($dom);
758
                $url .= "&status=--";
759
                my $newcontent = $browser->get($url)->content();
760
            }
761
            elsif ($task_1 eq "SUSPEND") {
762
            	$naptime = 1; # Temporarily speed up in order to report back promptly
763
                my $logentry = "$task_3: servers: $task_2: suspending: Suspend request received";
764
                logit('info', $logentry);
765
                my $virshcmd = "virsh -c $virshemu:///system suspend $task_2";
766
                run_in_bg($virshcmd);
767
                $url .= "&status=--&logentry=" . uri_escape($logentry);
768
                my $newcontent = $browser->get($url)->content();
769
            }
770
            elsif ($task_1 eq "RESUME") {
771
            	$naptime = 1; # Temporarily speed up in order to report back promptly
772
                my $logentry = "$task_3: servers: $task_2: resuming: Resume request received";
773
                logit('info', $logentry);
774
                my $virshcmd = "virsh -c $virshemu:///system resume $task_2";
775
                run_in_bg($virshcmd);
776
                $url .= "&status=--&logentry=" . uri_escape($logentry);
777
                my $newcontent = $browser->get($url)->content();
778
            }
779
            elsif ($task_1 eq "MOUNT") {
780
            	$naptime = 1; # Temporarily speed up in order to report back promptly
781
                my $user = $task_3;
782
                my $cdrom = $tasks[3];
783
                my $logentry ="$user: servers: $task_2: mounting: Mount request received - $cdrom" .
784
                ($cdrom eq "--"?" unmounting cdrom":" mounting $cdrom");
785
                logit('info', $logentry);
786
                if ($cdrom eq "--") {
787
                    $pid = fork();
788
                    unless ($pid) {
789
                        eval {
790
                            if ($identity eq "vbox") {
791
                                my $vboxcmd = qq|VBoxManage storageattach $task_2 --storagectl "IDE Controller" --port 1 --device 0 --type dvddrive --medium emptydrive --forceunmount|;
792
                                print `$vboxcmd`,"\n";
793
                                1;
794
                            } else {
795
        #						my $dom = $vmm->get_domain_by_uuid($muuid);
796
        #						$dom->attach_device();
797
                                my $virshcmd = qq|virsh -c $virshemu:///system attach-device $task_2 $tenderpathslist[0]/ejectcdrom.xml|;
798
                                print `$virshcmd`,"\n";
799
                                1;
800
                            }
801
                        } or do {print $@;};
802
                    }
803
                } elsif ($cdrom eq "virtio") {
804
                    $pid = fork();
805
                    unless ($pid) {
806
                        eval {
807
                            my $virshcmd = qq|virsh -c $virshemu:///system detach-device $task_2 $tenderpathslist[0]/mountvirtio.xml|;
808
                            print `$virshcmd`,"\n";
809
                            my $virshcmd = qq|virsh -c $virshemu:///system attach-device $task_2 $tenderpathslist[0]/mountvirtio.xml|;
810
                            print `$virshcmd`,"\n";
811
                            1;
812
                        } or do {print $@;};
813
                    }
814
                } else {
815
                    $pid = fork();
816
                    unless ($pid) {
817
                        eval {
818
                            if ($identity eq "vbox") {
819
                                my $vboxcmd = qq|VBoxManage storageattach $task_2 --storagectl "IDE Controller" --port 1 --device 0 --type dvddrive --medium "$cdrom" --forceunmount|;
820
                                print `$vboxcmd`,"\n";
821
                                1;
822
                            } else {
823
        #						my $dom = $vmm->get_domain_by_uuid($muuid);
824
        #						$dom->attach_disk();
825
                                my $virshcmd = qq{echo 'attach-disk $task_2 "$cdrom" hdd --mode readonly --type cdrom' | virsh -c $virshemu:///system};
826
                                print "$virshcmd\n";
827
                                print `$virshcmd`,"\n";
828
                                1;
829
                            }
830
                        } or do {print $@;};
831
                    }
832
                }
833
                chop $@; $logentry .= "\n$@" if $@;
834
                $url .= "&status=--";
835
                my $newcontent = $browser->get($url)->content();
836
            }
837
            elsif ($task_1 eq "BACKUP") {
838
                my $user = $task_2;
839
                my $uistatus = $task_3;
840
                my $status = $tasks[3];
841
                my $path = $tasks[4];
842
                my $backupdir = $tasks[5];
843
                my $remolder = $tasks[6];
844
                my $targetdir = "$mainvalve\:\:$backupdir";
845
                logit("info", "Backup request received $user $uistatus $status \"$path\" \"$targetdir\" $remolder");
846
                eval {
847
                    #`/usr/local/sbin/movepiston command=backup $user $uistatus $status "$path" "$targetdir" &`;
848

    
849
                    # my $pid = exec(qq{/usr/local/sbin/movepiston command=backup $user $uistatus $status "$path" "$targetdir" &});
850

    
851
                    #my $daemon = Proc::Daemon->new(
852
                    #        child_STDOUT => STDOUT,
853
                    #        child_STDERR => STDERR,
854
                    #        work_dir => '/usr/local/sbin',
855
                    #        exec_command => "/usr/local/sbin/movepiston command=backup $user $uistatus $status \"$path\" \"$targetdir\""
856
                    #    ) or do {logit("info", "ERROR doing backup of $path $@")};
857
                    #my $pid = $daemon->Init() or do {logit("info", "ERROR performing backup of $path $@")};
858

    
859
                    # Line below is the only variant that does not terminate movepiston - not sure why...
860
                    # my $backupcmd = qq{/usr/local/sbin/movepiston command=backup $user $uistatus $status "$path" "$targetdir" $remolder &};
861
                    # my $pid = system($backupcmd);
862
                    my $backupcmd = qq{$user $uistatus $status "$path" "$targetdir" $remolder};
863
                    my $backuptasks = "backup." . time;
864
                    `echo '$backupcmd' >> /tmp/$backuptasks`;
865
                    sleep 1;
866
                    my $pid = system(qq{/usr/local/sbin/movepiston command=$backuptasks &});
867
                    1;
868
                } or do {print "Error! ", $@;};
869
                logit("info", "Backup of \"$path\" running...");
870
            }
871
            elsif ($task_1 eq "ABORT") {
872
                $naptime = 1; # Temporarily speed up in order to report back promptly
873
                my $virshcmd = "virsh -c $virshemu:///system list --uuid  | grep $task_2";
874
                my $cres = `$virshcmd`; chomp $cres;
875
                if ($cres) { # domain is actually still running
876
                    $virshcmd = "virsh -c $virshemu:///system domjobabort $task_2";
877
                    # run_in_bg($virshcmd);
878
                    $cres = `$virshcmd 2>\&1`;
879
                    chomp $cres;
880
                    my $logentry = "$task_3: servers: $task_2: aborting: Aborting server move $cres";
881
                    $url .= "&status=--&logentry=" . uri_escape($logentry);
882
                    my $newcontent = $browser->get($url)->content();
883
                    `echo "Migration of server $task_2 aborted by user" > /tmp/$task_2.bg.out`;
884
                } else {
885
                    my $logentry = "$task_3: servers: $task_2: aborting: Unable to abort server move (server already moved?)";
886
                    $url .= "&status=--&logentry=" . uri_escape($logentry);
887
                    my $newcontent = $browser->get($url)->content();
888
                }
889
            }
890
            elsif ($task_1 eq "MOVE" || $task_1 eq "MOVESTOR") {
891
                my $vm = $task_2;
892
                my $targethost = $task_3;
893
                my $targetmac = $tasks[3];
894
                my $user = $tasks[4];
895
                my $logentry = "$nmac: servers: $task_2: moving: Now moving to $targethost...";
896
                logit('info', $logentry);
897
                my $newurl = $url . "&status=--&logentry=" . uri_escape($logentry);
898
                my $newcontent = $browser->get($newurl)->content();
899

    
900
                if ($identity eq "vbox") {
901
                    changeHosts($targethost, "piston$targetmac") or
902
                        $logentry = "$user: servers: /etc/hosts could not be updated\n".$@."\n"; # probably only needed for KVM but...
903
                    eval {
904
                        my $cmd = "/usr/bin/VBoxManage controlvm $vm teleport --host $targethost --port 6000";
905
                        run_in_bg($cmd);
906
                        1;
907
                    } or do {$logentry = "$user: Servers: " . "\n".$@."\n";};
908
                } else {
909
                    changeHosts($targethost, "piston$targetmac") or
910
                        $logentry = "$user: servers: /etc/hosts could not be updated\n".$@."\n"; # probably only needed for KVM but...
911
                    my $uriport = 15900 + int(rand(200)); # Choose a random port for live migration
912
                    my $copystorage = '';
913
                    my $migratedisks = '';
914
                    if ($task_1 eq "MOVESTOR") { # We're live migrating storage as well
915
                        my $disks = listCopyDisks($vm);
916
                        my $xml;
917
                        my $copycmd = "--copy-storage-all";
918
                        foreach my $dev (keys %$disks) {
919
                            next if ($dev eq 'status' || $dev eq 'xml');
920
                            my $image = $disks->{$dev}->{image};
921
                            # We don't migrate data disks away from shared storage
922
                            unless ($disks->{$dev}->{image} =~ /\/stabile-images\/images\/.*-data\..*\.qcow2/) {
923
                                if ($image =~ /\/stabile-images\/images/ && $identity eq 'local_kvm') { # Moving image from shared storage to node storage
924
                                    $migratedisks .= ($migratedisks =~ /--migrate-disks/)?",$dev":" --migrate-disks $dev";
925
                                    $xml = $xml || $disks->{xml};
926
                                    my $newimage = $image;
927
                                    $newimage =~ s/\/stabile-images\/images/\/mnt\/stabile\/node/;
928
                                    $xml =~ s/$image/$newimage/;
929
                                    $copycmd = "--copy-storage-inc" if ($disks->{$dev}->{master});
930
                                } elsif ($image =~ /\/mnt\/stabile\/node/ && $targethost eq '10.0.0.1') { # Moving image from node storage to shared storage
931
                                    $migratedisks .= ($migratedisks =~ /--migrate-disks/)?",$dev":" --migrate-disks $dev";
932
                                    $xml = $xml || $disks->{xml};
933
                                    my $newimage = $image;
934
                                    $newimage =~ s/\/mnt\/stabile\/node/\/stabile-images\/images/;
935
                                    $xml =~ s/$image/$newimage/;
936
                                    $copycmd = "--copy-storage-inc" if ($disks->{$dev}->{master});
937
                                } elsif ($image =~ /\/mnt\/stabile\/node/ && $targethost ne '10.0.0.1') { # Moving image between nodes
938
                                    $migratedisks .= ($migratedisks =~ /--migrate-disks/)?",$dev":" --migrate-disks $dev";
939
                                    $copycmd = "--copy-storage-inc" if ($disks->{$dev}->{master});
940
                                }
941
                            }
942
                        }
943
                        if ($xml) {
944
                            open( FILE, ">/tmp/$vm.xml" ) or { print "unable to open xml file for writing\n" };
945
                            print FILE $xml;
946
                            close(FILE);
947
                            $copystorage .= " --xml /tmp/$vm.xml";
948
                        }
949
                        $copystorage .= " $copycmd $migratedisks" if ($migratedisks); # only copy storage if any disks to migrate
950
                    }
951
                    my $cmd = "sudo -u irigo virsh -c qemu:///system migrate $copystorage --verbose --migrateuri tcp://$targethost:$uriport --live --unsafe $vm qemu+ssh://$targethost/system";
952
                    logit('info', $cmd);
953
                    `echo "$targethost" > /tmp/$vm.dest`;
954
                    run_in_bg($cmd, $vm);
955
                }
956
                #eval { # We do not want the same domain reported in different states from two different nodes
957
                #    my $dom = $vmm->get_domain_by_uuid($vm);
958
                #    if ($dom) {$dom->undefine()};
959
                #    1;
960
                #} or do {print $@;};
961
            }
962
            elsif ($task_1 eq "RECEIVE" || $task_1 eq "RECEIVESTOR") {
963
                my $uuid = $task_2; my $user = $task_3;
964
                my $logentry = "$user: servers: $task_2: receiving: Receive domain request received";
965
                logit('info', $logentry);
966
                my $mounts = `cat /proc/mounts`;
967
                for (my $i=0; $i<=$#tenderpathslist; $i++
968
                    )
969
                {
970
                    my $path = $tenderpathslist[$i];
971
                    my $host = $tenderlist[$i];
972
                    # Directory / mount point must exist
973
                    unless (-d $path) {
974
                        mkdir "$path" or {print ("Error $path could not be created\n")};
975
                    };
976
                    unless ($mounts =~ m/$path/i || ($identity eq 'local_kvm' && $host =~ /10\.0\.0\.1/)) {
977
                        logit('info', "Mounting (2) $path from $host");
978
                        eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
979
                    }
980
                }
981

    
982
                my $xml = $browser->get($base_url . "?status=listxml&uuid=$uuid&mac=$mac")->content();
983
                if ($xml =~ /<domain /i) {
984
                    if ($task_1 eq "RECEIVESTOR") {
985
                        print "Adding $uuid to storage move list\n" if ($debug);
986
                        push (@storreceiveuuids, $uuid);
987
                    } else {
988
                        print "Adding $uuid to move list\n" if ($debug);
989
                        push (@receiveuuids, $uuid);
990
                    }
991
                    eval { # Undefine domain in case it has been running here before
992
                        my $dom = $vmm->get_domain_by_uuid($task_2);
993
                        if ($dom) {$dom->undefine()};
994
                        1;
995
                    } or do {print $@;};
996
                    logit('info', "Defining $task_2");
997
                    # Add bridge interfaces
998
                    eval {print `modprobe 8021q`; 1;} or do {print $@;};
999
                    eval {print `ifconfig $datanic up`; 1;} or do {print $@;};
1000
                    if ($xml =~ /<interface type=\'bridge\'/i
1001
                        )
1002
                    {
1003
                        my $char = "<source bridge=";
1004
                        my $offset = 0;
1005
                        my $result = index($xml, $char, $offset);
1006
                        while ($result != -1) {
1007
                            my $br = substr($xml, $result+18, 5);
1008
                            if ($br =~ /(\d+)/) {
1009
                                $br = $1;
1010
                                $logentry .= " - bringing up bridge br $br on $datanic";
1011
                                eval {print `vconfig add $datanic $br`; 1;} or do {print $@;};
1012
                                eval {print `brctl addbr br$br`; 1;} or do {print $@;};
1013
                                eval {print `brctl stp br$br on`; 1;} or do {print $@;};
1014
                                eval {print `brctl addif br$br $datanic.$br`; 1;} or do {print $@;};
1015
                                eval {print `ifconfig $datanic.$br up`; 1;} or do {print $@;};
1016
                                eval {print `ifconfig br$br up`; 1;} or do {print $@;};
1017
                            }
1018
                            $offset = $result + 1;
1019
                            $result = index($xml, $char, $offset);
1020
                        }
1021
                    }
1022

    
1023
                    chop $@; $logentry .= "\n$br : $@" if $@;
1024
                    if ($identity eq "vbox") { # vbox domains need to be defined on the receiving end
1025
                        eval {
1026
                            my $dom = $vmm->define_domain($xml);
1027
                            logit ('info', "Defined: " + $dom);
1028
                            1;
1029
                        } or do {print $@;};
1030
                        if ($@) {chop $@; $logentry .= "\n$@";}
1031
                        # $logentry .= $dom;
1032
                        my $res;
1033
                        eval {$res = `/usr/bin/VBoxManage modifyvm $task_2 --teleporter on --teleporterport 6000`; 1;} or
1034
                        do {$logentry .= "\n$user: servers: ".$res."\n".$@;};
1035
                        eval {$res = `/usr/bin/VBoxManage startvm $task_2 --type vrdp`; 1;} or
1036
                        do {$logentry .= "\n$user: servers: ".$res."\n".$@;};
1037
                    } else {
1038
                        ;
1039
                    }
1040
                } else {
1041
                    $logentry .= "\n$user: servers: Invalid domain xml...";
1042
                }
1043
            }
1044
            elsif ($task_1 eq "BCLONE") {
1045
                my $user = $task_3;
1046
                my $image = uri_unescape($task_2);
1047
                my $logentry = "$user: images: $image: cloning: Clone request received";
1048
                logit('info', $logentry);
1049
                my $master = $browser->get($base_url . "?status=listimagemaster&image=$task_2")->content();
1050
                if ($master) {
1051
                    $master = uri_unescape($master);
1052
                    $logentry = "Cloning $image from $master ";
1053
                    $image =~ /(.+)\/.*/;
1054
                    my $dir = $1;
1055
                    unless (-e $dir) {
1056
                        `/bin/mkdir -p "$dir"`;
1057
                        `chmod 777 "$dir"`;
1058
                    }
1059
                    my $cmd = qq|/usr/bin/qemu-img create -f qcow2 -b "$master" "$image"|;
1060
                    $logentry .= `$cmd`;
1061
                    $logentry =~ tr/\n/ /;
1062
                    logit('info', $logentry);
1063
                } else {
1064
                    logit('info', "Master for $image not found $master");
1065
                }
1066
            }
1067
            elsif ($task_1 eq "DROWSE") {
1068
                drowse('', 1);
1069
            }
1070
            elsif ($task_1 eq "REMOVE") {
1071
                my $user = $task_3;
1072
                my $image = uri_unescape($task_2);
1073
                my $logentry = "$user: images: $image: removing: Remove image request received";
1074
                logit('info', $logentry);
1075
                $logengry = "Removed image $image " . unlink($image);
1076
                logit('info', $logentry);
1077
            }
1078
            elsif ($task_1 eq "PREMOVE") { # preserve backup
1079
                my $user = $task_3;
1080
                my $image = uri_unescape($task_2);
1081
                my $logentry = "$user: images: $image: removing: Premove image request received";
1082
                logit('info', $logentry);
1083
                $logengry = "Removed image $image (preserved) " . `mv "$image" "$image.bak"`;
1084
                logit('info', $logentry);
1085
            }
1086
            elsif ($task_1 eq "START") {
1087
            	$naptime = 1; # Temporarily speed up in order to report back promptly
1088
                my $user = $task_3;
1089
                my $logentry = "$user: servers: $task_2: starting: Start request received";
1090
                logit('info', $logentry);
1091

    
1092
                my $mounts = `cat /proc/mounts`;
1093
                for (my $i=0; $i<=$#tenderpathslist; $i++
1094
                    )
1095
                {
1096
                    my $path = $tenderpathslist[$i];
1097
                    my $host = $tenderlist[$i];
1098
                    # Directory / mount point must exist
1099
                    unless (-d $path) {
1100
                        mkdir "$path" or {print ("Error $path could not be created\n")};
1101
                    };
1102
                    if ($mounts =~ m/$path /i || ($identity eq 'local_kvm' && $host =~ /10\.0\.0\.1/)) {
1103
                        print ("$path already mounted\n") if ($debug);
1104
                    } else {
1105
                        logit('info', "Mounting (3) $path from $host");
1106
                        eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
1107
                    }
1108
                }
1109
                my $xml = $browser->get($base_url . "?status=listxml&uuid=$task_2&mac=$mac")->content();
1110
                if ($xml =~ /<domain /i) {
1111
                    logit('info', "Creating $task_2");
1112
                    unless ($identity eq "local_kvm") {
1113
                        # Add bridge interfaces
1114
                        eval {print `modprobe 8021q`; 1;} or do {print $@;};
1115
                        eval {print `ifconfig $datanic up`; 1;} or do {print $@;};
1116
                        if ($xml =~ /<interface type=\'bridge\'/i) {
1117
                            my $char = "<source bridge=";
1118
                            my $offset = 0;
1119
                            my $result = index($xml, $char, $offset);
1120
                            while ($result != -1) {
1121
                                my $br = substr($xml, $result+18, 5);
1122
                                if ($br =~ /(\d+)/) {
1123
                                    $br = $1;
1124
                                    $logentry .= " - bringing up bridge br$br on $datanic ";
1125
                                    eval {print `vconfig add $datanic $br`; 1;} or do {print $@;};
1126
                                    eval {print `brctl addbr br$br`; 1;} or do {print $@;};
1127
                                    eval {print `brctl stp br$br on`; 1;} or do {print $@;};
1128
                                    eval {print `brctl addif br$br $datanic.$br`; 1;} or do {print $@;};
1129
                                    eval {print `ifconfig $datanic.$br up`; 1;} or do {print $@;};
1130
                                    eval {print `ifconfig br$br up`; 1;} or do {print $@;};
1131
                                }
1132
                                print $logentry if ($debug);
1133
                                $offset = $result + 1;
1134
                                $result = index($xml, $char, $offset);
1135
                            }
1136
                        }
1137
                        chop $@; $logentry .= " -- $br : $@" if $@;
1138
                    }
1139

    
1140
                    eval {
1141
                        my $domid = `virsh -c $virshemu:///system domid $task_2`;
1142
                        my $virshcmd = "virsh -c $virshemu:///system undefine $domid 2>/dev/null";
1143
                        print  `$virshcmd` if ($domid);
1144
                        1;
1145
                    } or do {
1146
                      ;#  print $@;
1147
                    };
1148

    
1149
                    if ($xml=~/<source file=\'(.+)\'/i
1150
                        && -s $1)
1151
                    {
1152
                        eval {
1153
							if ($xml =~ /<hostdev /i) {
1154
#								`modprobe pci_stub`;
1155
#								`echo "10de 1b81" > /sys/bus/pci/drivers/pci-stub/new_id`;
1156
#								`echo "0000:01:00.0" > /sys/bus/pci/devices/0000:01:00.0/driver/unbind; echo "0000:01:00.0" > /sys/bus/pci/drivers/pci-stub/bind`;
1157
#								`echo "0000:02:00.0" > /sys/bus/pci/devices/0000:02:00.0/driver/unbind; echo "0000:02:00.0" > /sys/bus/pci/drivers/pci-stub/bind`;
1158
#								`echo 1 > /sys/bus/pci/devices/0000:01:00.1/remove`;
1159
#								`echo 1 > /sys/bus/pci/devices/0000:02:00.1/remove`;
1160

    
1161
							#	`echo "0000:01:00.1" > /sys/bus/pci/devices/0000:01:00.1/driver/unbind; echo "0000:01:00.1" > /sys/bus/pci/drivers/pci-stub/bind`;
1162
							#	`echo "0000:02:00.1" > /sys/bus/pci/devices/0000:02:00.1/driver/unbind; echo "0000:02:00.1" > /sys/bus/pci/drivers/pci-stub/bind`;
1163
							}
1164
							print "Defining domain from:\n$xml\n" if ($debug);
1165
                            print `echo "$xml" > /tmp/$task_2.xml`;
1166
                            my $virshcmd = "virsh -c $virshemu:///system create /tmp/$task_2.xml";
1167
                            run_in_bg( $virshcmd );
1168
                            logit ('info', "Created: $task_2");
1169
                            $logentry .= " - Created: $task_2" ;
1170
                            1;
1171
                        } or do {print "Error: " . $@;};
1172
                        if ($@) {
1173
                            chop $@; $logentry .= "\n$@";
1174
                            # $returntasks = uri_escape("START $task_2 $user"); # START did not succeed - return it to try again
1175
                        }
1176
                    } else {
1177
                        logit ('info', "Image $1 not found creating: $task_2");
1178
                        $logentry .= " - Image $1 not found creating: $task_2" ;
1179
                    }
1180
                } else {
1181
                    $logentry .= " - $user: servers: Invalid domain xml...";
1182
                }
1183
                my $rtasks = $returntasks?"returntasks=$returntasks":'';
1184
                my $newurl = $url . "&status=--&logentry=". uri_escape($logentry) . $rtasks;
1185
                my $newcontent = $browser->get($newurl)->content();
1186
            } elsif ($task_1 ne "OK") {
1187
                my $logentry = "--: --: Info not accepted: $task_1 - $task_2 - $task_3";
1188
                logit('debug', $logentry);
1189
            }
1190
		}
1191
        if (@receiveuuids) {
1192
            $url .= "&receive=" . uri_escape(join(',', @receiveuuids)) . "&status=--";
1193
            logit('info', "Asking to send me: " . join(',', @receiveuuids) . " $url ") if ($debug);
1194
            my $newcontent = $browser->get($url)->content();
1195
        }
1196
        if (@storreceiveuuids) {
1197
            $url .= "&receivestor=" . uri_escape(join(',', @storreceiveuuids)) . "&status=--";
1198
            logit('info', "Asking to storage send me: " . join(',', @storreceiveuuids) . " $url ") if ($debug);
1199
            my $newcontent = $browser->get($url)->content();
1200
        }
1201
	} else {
1202
        logit('info', "Couldn't get: $url");
1203
	}
1204
	if ($pid) {return "";}
1205
	else {return $running;}
1206
}
1207

    
1208
sub logit {
1209
	my ($priority, $msg) = @_;
1210
	if ($priority =~ /info|err/ || $debug) {print pretty_time(), ": ", $priority, ": ", $msg, "\n"};
1211

    
1212
	setlogsock('unix');
1213
	# Log the PID and to CONSole if there's a problem.  Use facility 'user'.
1214
    openlog(basename($0), 'pid,cons', 'user');
1215
    syslog($priority, "$nmac: $msg");
1216
    closelog();
1217
}
1218

    
1219
sub dominfo {
1220
    my $vmm = shift;
1221
	my $domreq = ();
1222
	$domreq->{'dominfo'} = 1;
1223
	my @domains = $vmm->list_domains();
1224
	my %activedoms;
1225
	my $i = 0;
1226
    if (!$cgset) {
1227
        setCgroups();
1228
        $cgset = 1;
1229
    }
1230

    
1231
    print "Looking at " . scalar @domains . " domains\n" if ($debug);
1232
	foreach my $dom (@domains) {
1233
	    eval {
1234
            my $xml = $dom->get_xml_description();
1235
            my $domxml = XMLin($xml);
1236
            my $display = $domxml->{devices}->{graphics}->{type};
1237
            my $port = $domxml->{devices}->{graphics}->{port};
1238
            my $domstate = $domstates[$dom->get_info->{ 'state' }];
1239
            my $domuuid = $dom->get_uuid_string;
1240
            if (-e "/tmp/$domuuid.bg.out") { # A domain is migrating away
1241
                my $pss = `pgrep -c -f "system migrate .* $domuuid"`;
1242
                chomp $pss;
1243
                if ($pss >1) { # migration is ongoing
1244
                    my $percentage = `grep -Po '\\d+ %' /tmp/$domuuid.bg.out | tail -n1`;
1245
                    chomp $percentage;
1246
                    if ($percentage) { # report percentage
1247
                        $percentage =~ s/ //;
1248
                        $domstate = "moving-$percentage";
1249
                    }
1250
                }
1251
            }
1252
            $i++;
1253
            $activedoms{$domuuid} = $domstate;
1254
        #    $dominfo .= "&dom$i=$domuuid&domstate$i=$domstate&domdisplay$i=" . $display . "&domport$i=" . $port;
1255
            $domreq->{"dom$i"} = $domuuid;
1256
            $domreq->{"domstate$i"} = $domstate;
1257
            $domreq->{"domdisplay$i"} = $display;
1258
            $domreq->{"domport$i"} = $port;
1259

    
1260
            if (-e "/tmp/$domuuid.xml") {
1261
                unlink "/tmp/$domuuid.xml";
1262
            }
1263

    
1264
            # If cgroups are enabled, put in values
1265
            # We put in values in /mnt/cgroup/libvirt/qemu/ instead of for individual domains
1266
    #        if (-d '/mnt/' && -e '/proc/cgroups') {
1267
    #            if ($xml=~/<name>(.+)<\/name>/) {
1268
    #                my $domname = $1;
1269
    #                if (-e "/tmp/$domuuid.xml" && -d "/mnt/cgroup/libvirt/qemu/$domname/") {
1270
    #                    logit('info', "Setting cgroups limits $readlimit/$writelimit, $iopsreadlimit/$iopswritelimit for $domuuid ($domname)");
1271
    #                    `echo "8:0 $readlimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.read_bps_device"`;
1272
    #                    `echo "8:0 $writelimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.write_bps_device"`;
1273
    #                    `echo "8:0 $iopsreadlimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.read_iops_device"`;
1274
    #                    `echo "8:0 $iopswritelimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.write_iops_device"`;
1275
    #                    unlink "/tmp/$domuuid.xml";
1276
    #                }
1277
    #            } else {
1278
    #                logit('info', "Not setting cgroup limits for " . $dom->get_name() ) if ($debug);
1279
    #            }
1280
    #        }
1281
            1;
1282
	    } or do {print $@;};
1283

    
1284
	}
1285
	@domains = $vmm->list_defined_domains();
1286
	print "Looking at " . scalar @domains . " defined domains\n" if ($debug);
1287
	foreach my $dom (@domains) {
1288
	    eval {
1289
            my $domstate = $domstates[$dom->get_info->{ 'state' }];
1290
            my $domuuid = $dom->get_uuid_string;
1291
            if ($domstate ne "running") {
1292
                $i++;
1293
                $activedoms{$domuuid} = $domstate;
1294
                $domreq->{"dom$i"} = $domuuid;
1295
                $domreq->{"domstate$i"} = $domstate;
1296
            }
1297
            eval {
1298
                if ($domstate eq "shutoff") {$dom->undefine()};
1299
                1;
1300
            } or do {print $@;};
1301
	    } or do {print $@;};
1302
	}
1303
	foreach my $domuuid (keys %mortuary) {
1304
	    unless ($activedoms{$domuuid}) {
1305
            $i++;
1306
            $domreq->{"dom$i"} = $domuuid;
1307
            $domreq->{"domstate$i"} = 'shutoff';
1308
			delete $mortuary{$domuuid};
1309
	    }
1310
    }
1311
    if (%mortuary) {
1312
        store \%mortuary, $tombstones;
1313
    } else {
1314
        `> $tombstones` if (-e $tombstones && !(-z $tombstones));
1315
    }
1316

    
1317
    # Check if a domain has been moved and report and remove file from /tmp if so
1318
    my @thefiles = recurse("/tmp");
1319
    foreach my $f (@thefiles) {
1320
        if ($f =~ /\/tmp\/(.*)\.bg\.out$/) {
1321
            my $domuuid = $1;
1322
            my $mes = '';
1323
            my $error = '';
1324
            print "Found migration $domuuid\n" if ($debug);
1325
            my $pss = `pgrep -c -f "system migrate .* $domuuid"`;
1326
            chomp $pss;
1327
            if ($pss >1) { # migration is ongoing
1328
                print "Migration of $domuuid $pss ongoing\n" if ($debug);
1329
            } else {
1330
#                my $mes = `cat "/tmp/$domuuid.bg.out" | tail -n1`;
1331
                my $percentage = `grep -Po '\\d+ %' /tmp/$domuuid.bg.out | tail -n1`;
1332
                if ($percentage) {
1333
                    $mes = "Domain $domuuid was moved";
1334
                    unlink "/tmp/$domuuid.bg.out";
1335
                } else {
1336
                    $error = `cat /tmp/$domuuid.bg.out | tail -n1`;
1337
                    chomp $error;
1338
                    if (!$error) {
1339
                        $error = `cat /tmp/$domuuid.bg.out | tail -n2`;
1340
                        chomp $error; chomp $error;
1341
                    }
1342
                    $mes = "The domain $domuuid was not moved";
1343
                    $mes =~ s/:/ /;
1344
                    `mv /tmp/$domuuid.bg.out "/tmp/$domuuid.bg.error"`; # leave the file for inspection
1345
                }
1346
                # Update the client UI
1347
                my $logentry = "--: servers: $domuuid: $status: $mes";
1348
                # Update the client UI
1349
                my $url = $base_url . "?mac=$mac&status=updateui&logentry="  . uri_escape($logentry);
1350
                my $content = $browser->get($url);
1351
                print "$mes\n" if ($debug);
1352
                print $content if ($debug);
1353
            }
1354
        }
1355
    }
1356
	return $domreq;
1357
}
1358

    
1359
sub drowse {
1360
    my $vmm = shift;
1361
    $vmm = Sys::Virt->new(address => "$virshemu:///system") unless $vmm;
1362
    my $drowsenow = shift;
1363

    
1364
	my @domains = $vmm->list_domains();
1365
	my $i = 0;
1366
	foreach my $dom (@domains) {
1367
		if ($domstates[$dom->get_info->{ 'state' }] eq "running" || $domstates[$dom->get_info->{ 'state' }] eq "paused") {
1368
			$i++;
1369
			last;
1370
		}
1371
	}
1372
	if ($i==0) {$drowsiness += $naptime} else {$drowsiness = 0};
1373
	if (($sleepafter > 0 && $drowsiness > $sleepafter) || $drowsenow) {
1374
        if ($identity eq "vbox") {
1375
            logit('info', "Taking down Virtual Box piston");
1376
            print `/etc/init.d/vboxdrv stop`,"\n";
1377
        } else {
1378
            logit('info', "Taking down KVM piston");
1379
            print `/etc/init.d/kvm stop`,"\n";
1380
        }
1381
        $status = "drowsing";
1382
        my $logentry = "--: nodes: $mac: $status: Feeling drowsy ($drowsiness >  $sleepafter) - putting node to sleep";
1383
        logit('info', $logentry);
1384
        $running = 0;
1385

    
1386
		my $meminfo = `cat /proc/meminfo`;
1387
		$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
1388
		my $memtotal = $1;
1389
		$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
1390
		my $memfree = $1;
1391

    
1392
		my $url = $base_url . "?mac=" . uri_escape($mac);
1393
		$url .= "&status=$status&logentry=" . uri_escape($logentry) ."&memtotal=$memtotal&memfree=$memfree&identity=$identity";
1394
		`umount -a`;
1395
		my $newcontent = $browser->get($url)->content();
1396
		my @clines = split /\n/, $newcontent;
1397
        foreach my $line (@clines) {
1398
            if ($line =~ m/^\S+=SWEETDREAMS/ig) {
1399
        		print "Awating power off...\n";
1400
                return;
1401
            }
1402
        }
1403

    
1404
        $meminfo = `cat /proc/acpi/sleep`;
1405
        my $s3sleep = ($meminfo =~ m/S3/);
1406
        if ($s3sleep) {
1407
            print `/etc/init.d/libvirt-bin stop`,"\n" if ($identity eq "vbox");
1408
            print `/etc/acpi/sleep.sh`;
1409
        } else {
1410
            print `systemctl stop movepiston`;
1411
           `echo 0 > /proc/sys/kernel/hung_task_timeout_secs`;
1412
            print `poweroff`;
1413
#            print `/sbin/shutdown -P +1`;
1414
        }
1415
	};
1416
}
1417

    
1418
sub listCopyDisks {
1419
    my $suuid = shift;
1420
    eval {
1421
        my $vmm = Sys::Virt->new(address => "$virshemu:///system");
1422
        my $dom = $vmm->get_domain_by_uuid($suuid);
1423
        if ($dom) {
1424
            my $xml = $dom->get_xml_description();
1425
            my $xs = XML::Simple->new(ForceArray => ['disk']);  # ForceArray makes sure 'disk' is always an array
1426
            my $data = $xs->XMLin($xml);
1427
            my $disks = $data->{devices}->{disk};
1428
            my %devs = ("status", "OK");
1429
            foreach my $disk (@$disks) {
1430
                # Only consider disks of device type "disk"
1431
                next unless $disk->{device} && $disk->{device} eq 'disk';
1432
                my $dev  = $disk->{target}->{dev}  // 'unknown';
1433
                my $file = $disk->{source}->{file} // undef;
1434
                my $master = $disk->{backingStore}->{source}->{file} // undef;
1435
                $devs{$dev} = {
1436
                    image  => $file,
1437
                    master => $master
1438
                }
1439
            }
1440
            $devs{xml} = $xml;
1441
            return \%devs;
1442
        } else {
1443
            return {message=>"Domain $suuid not found", status => "Error"}
1444
        }
1445

    
1446
    } or do {print $@;};
1447

    
1448
}
1449

    
1450
sub changeHosts {
1451
    my $hosts = "/etc/hosts";
1452
	my $targetip = $_[0];
1453
	my $targetname = $_[1];
1454
	return 0 unless ($targetip && $targetname);
1455
	copy($hosts, "$hosts.bak") or return 0;
1456

    
1457
	my $newfile = "";
1458
	my $match;
1459
	open (FILE, $hosts);
1460
	while (<FILE>) {
1461
		chomp;
1462
		my $line = $_;
1463
		$newfile .= "$line\n" unless ($line =~ /^$targetip/);
1464
	}
1465
   	$newfile .= "$targetip $targetname";
1466
	close (FILE);
1467
	open( FILE, ">$hosts" ) or return 0;
1468
	print FILE $newfile;
1469
	close(FILE);
1470
	return "$hosts updated\n";
1471
}
1472

    
1473
sub pretty_time {
1474
	my $current_time = time;
1475
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($current_time);
1476
	my $pretty_time = sprintf "%4d-%02d-%02d@%02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec;
1477
	return $pretty_time;
1478
}
1479

    
1480
sub recurse {
1481
	my($path) = shift; # @_;
1482
	my @files;
1483
	## append a trailing / if it's not there
1484
	$path .= '/' if($path !~ /\/$/);
1485
	## loop through the files contained in the directory
1486
	for my $eachFile (glob($path.'*')) {
1487
		## if the file is a directory
1488
		if( -d $eachFile) {
1489
			## pass the directory to the routine ( recursion )
1490
			push(@files,recurse($eachFile));
1491
		} else {
1492
			push(@files,$eachFile);
1493
		}
1494
	}
1495
	return @files;
1496
}
1497

    
1498
sub getSizes {
1499
    my $f = shift;
1500
    my $lmtime = shift;
1501

    
1502
    #print "$f :";
1503
    my @stat = stat($f);
1504
    my $size = $stat[7];
1505
    my $realsize = $stat[12] * 512;
1506
    my $virtualsize = $size;
1507
    my $mtime = $stat[9];
1508
# Only fire up qemu-img etc. if image has been modified
1509
    #print " $lmtime : $mtime\n";
1510
    if ($mtime ne $lmtime) {
1511
        my($fname, $dirpath, $suffix) = fileparse($f, (".vmdk", ".img", ".vhd", ".qcow", ".qcow2", ".vdi", ".iso"));
1512
# Special handling of vmdk's
1513
        if ($suffix eq ".vmdk") {
1514
            my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
1515
            $qinfo =~ /virtual size:.*\((.+) bytes\)/g;
1516
            $virtualsize = int($1);
1517
            if ( -s ($dirpath . $fname . "-flat" . $suffix)) {
1518
                my @fstatus = stat($dirpath . $fname . "-flat" . $suffix);
1519
                my $fsize = $fstatus[7];
1520
                my $frealsize = $fstatus[12] * 512;
1521
                $size += $fsize;
1522
                $virtualsize += $fsize;
1523
                $realsize += $frealsize;
1524
            }
1525
            my $i = 1;
1526
            while (@fstatus = stat($dirpath . $fname . "-s00$i" . $suffix)) {
1527
                $fsize = $fstatus[7];
1528
                $frealsize = $fstatus[12] * 512;
1529
                $size += $fsize;
1530
                $virtualsize += $fsize;
1531
                $realsize += $frealsize;
1532
                $i++;
1533
            }
1534
# Get virtual size of qcow2 auto-grow volumes
1535
        } elsif ($suffix eq ".qcow2") {
1536
            my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
1537
            $qinfo =~ /virtual size:.*\((.+) bytes\)/g;
1538
            $virtualsize = int($1);
1539
# Get virtual size of vdi auto-grow volumes
1540
        } elsif ($suffix eq ".vdi") {
1541
            my $qinfo = `/usr/bin/VBoxManage showhdinfo "$f"`;
1542
            $qinfo =~ /Logical size:\s*(\d+) MBytes/g;
1543
            $virtualsize = int($1) * 1024 * 1024;
1544
        }
1545
# Actual used blocks times block size on disk, i.e. $realsize may be bigger than the
1546
# logical size of the image file $virtualsize and the logical provisioned size of the disk $virtualsize
1547
# in order to minimize confusion, we set $realsize to $size if this is the case
1548
        $realsize = $size if ($realsize > $size);
1549
        return ($size, $realsize, $virtualsize, $mtime);
1550
    } else {
1551
        return 0;
1552
    }
1553

    
1554
}
1555

    
1556
sub updatePistonStats {
1557
    my $vmm = shift;
1558
	logit('info', "Updating domain statistics...") if $debug == 1;
1559

    
1560
	# Connect to libvirt...
1561
	$vmm = Sys::Virt->new(address => "$virshemu:///system") unless $vmm;
1562
	my @domains = $vmm->list_domains();
1563
	my $postreq = ();
1564
	my $i = 0;
1565
	# Loop through all local domains...
1566
	foreach my $dom (@domains) {
1567
		$i++;
1568
		print "\tProcessing '",$dom->get_name(),"' [",$dom->get_uuid_string(),"]...\n" if $debug;
1569
#		my ($timestamp_seconds, $timestamp_microseconds_decimals) = gettimeofday();
1570
        my $timestamp_useconds = Time::HiRes::time();
1571
        my $timestamp_seconds = floor($timestamp_useconds);
1572
        my $uuid = $dom->get_uuid_string();
1573
		$postreq->{"$i.uuid"} = $uuid;
1574
#		$postreq->{"$i.timestamp"} = sprintf("%.0f%06.0f", $timestamp_seconds, $timestamp_microseconds_decimals);
1575
		$postreq->{"$i.timestamp"} = $timestamp_seconds;
1576

    
1577
		# Fetch basic node/domain information (cpu, memory, cputime etc)...
1578
		my $dom_info = $dom->get_info();
1579
		while (my($key, $value) = each(%$dom_info)) {
1580
			$postreq->{"$i.domain.$key"} = $value;
1581
		};
1582

    
1583
        my $t2 = $timestamp_useconds;
1584
        my $t1 =  $oldTimes{$uuid}->{timestamp_useconds};
1585
        my $c2 = $dom_info->{cpuTime};
1586
        my $c1 = $oldTimes{$uuid}->{cpuTime};
1587
        my $delta = $t2-$t1;
1588

    
1589
        if ($t1 && $c2>$c1) { # Work across reboots
1590
            $postreq->{"$i.domain.cpuLoad"} = sprintf("%.4f",  (($c2 - $c1)/1000000000) / $delta );
1591
            $postreq->{"$i.delta"} = floor($delta);
1592
        }
1593
        $oldTimes{$uuid}->{cpuTime} = $dom_info->{cpuTime};
1594
        $oldTimes{$uuid}->{timestamp_useconds} = $timestamp_useconds;
1595
        $oldTimes{$uuid}->{timestamp} = $timestamp_seconds;
1596
		# Fetch the xml description of the specific domain...
1597
		my $domxml = XMLin($dom->get_xml_description());
1598

    
1599
		# Process block devices...
1600
		my @devices;
1601
		# Collect statistics for several block devices...
1602
		if (ref($domxml->{devices}->{disk}) eq 'ARRAY') {@devices = @{$domxml->{devices}->{disk}};}
1603
		# Collect statistics for a single block device...
1604
		else {push @devices, $domxml->{devices}->{disk};}
1605

    
1606
        my $wr2;
1607
        my $wr1 = $oldTimes{$uuid}->{"wr_kbytes_s"};
1608
        my $rd2;
1609
        my $rd1 = $oldTimes{$uuid}->{"rd_kbytes_s"};
1610
        foreach my $device (@devices) {
1611
            if ($device->{device} eq 'disk') {
1612
                my $blockdev = $device->{target}->{dev};
1613
                eval {
1614
                    my $blockstats = $dom->block_stats($blockdev);
1615
                    while (my($key, $value) = each(%$blockstats)) {
1616
                        $postreq->{"$i.blk.$blockdev.$key"} = $value;
1617
                    #    $postreq->{"$i.blk.hd.$key"} += $value; # We report collected traffic under hd
1618
                        $wr2 += $value if ($key eq 'wr_bytes');
1619
                        $rd2 += $value if ($key eq 'rd_bytes');
1620
                    }
1621
                };
1622

    
1623
                print("\tFailed while requesting block device statistics for $blockdev, skipping...") if $@;
1624
            }
1625
        }
1626
        $postreq->{"$i.blk.hd.wr_bytes"} = $wr2;
1627
        $postreq->{"$i.blk.hd.rd_bytes"} = $rd2;
1628
        if ($t1 && $c2>$c1) {
1629
            $postreq->{"$i.blk.hd.wr_kbytes_s"} = sprintf("%.2f",  (($wr2 - $wr1)/1024) / $delta );
1630
            $postreq->{"$i.blk.hd.rd_kbytes_s"} = sprintf("%.2f",  (($rd2 - $rd1)/1024) / $delta );
1631
            $postreq->{"$i.blk.hd.wr_kbytes_s"} = 0 if ($postreq->{"$i.blk.hd.wr_kbytes_s"} eq '0.00');
1632
            $postreq->{"$i.blk.hd.rd_kbytes_s"} = 0 if ($postreq->{"$i.blk.hd.rd_kbytes_s"} eq '0.00');
1633
        }
1634
        $oldTimes{$uuid}->{wr_kbytes_s} = $wr2;
1635
        $oldTimes{$uuid}->{rd_kbytes_s} = $rd2;
1636

    
1637
		# Collect statistics for network interfaces...
1638
		my @netdevices;
1639
		if (ref($domxml->{devices}->{interface}) eq 'ARRAY') {@netdevices = @{$domxml->{devices}->{interface}};}
1640
		else {push @netdevices, $domxml->{devices}->{interface};}
1641

    
1642
        my $rx2;
1643
        my $rx1 = $oldTimes{$uuid}->{"rx_kbytes_s"};
1644
        my $tx2;
1645
        my $tx1 = $oldTimes{$uuid}->{"tx_kbytes_s"};
1646
        foreach my $device (@netdevices) {
1647
            my $interface = $device->{target}->{dev};
1648
            if ($interface) {
1649
                eval {
1650
                    my $ifstats = $dom->interface_stats($interface);
1651
                    while (my($key, $value) = each(%$ifstats)) {
1652
    					$postreq->{"$i.if.$interface.$key"} = $value;
1653
                        $postreq->{"$i.if.vnet.$key"} += $value; # We report collected traffic under vnet
1654
                        $rx2 += $value if ($key eq 'rx_bytes');
1655
                        $tx2 += $value if ($key eq 'tx_bytes');
1656
                    }
1657
                };
1658
                print("\tFailed while requesting interface statistics ('"+$@+"'), skipping...") if $@;
1659
            }
1660
		}
1661
        if ($t1 && $c2>$c1) {
1662
            $postreq->{"$i.if.vnet.rx_kbytes_s"} = sprintf("%.2f",  (($rx2 - $rx1)/1024) / $delta );
1663
            $postreq->{"$i.if.vnet.tx_kbytes_s"} = sprintf("%.2f",  (($tx2 - $tx1)/1024) / $delta );
1664
            $postreq->{"$i.if.vnet.rx_kbytes_s"} = 0 if ($postreq->{"$i.if.vnet.rx_kbytes_s"} eq '0.00');
1665
            $postreq->{"$i.if.vnet.tx_kbytes_s"} = 0 if ($postreq->{"$i.if.vnet.tx_kbytes_s"} eq '0.00');
1666
        }
1667
        $oldTimes{$uuid}->{rx_kbytes_s} = $rx2;
1668
        $oldTimes{$uuid}->{tx_kbytes_s} = $tx2;
1669
	}
1670
    if ($postreq) {
1671
        # POST request to admin server...
1672
       	logit('info', "Posting stats to: $stats_url") if $debug;
1673
       	print("POSTREQ:\n".Dumper($postreq)) if $debug;
1674
       	$content = $browser->post($stats_url, $postreq)->content();
1675
        print "$content\n" if $debug;
1676
    }
1677
}
1678

    
1679
sub backup {
1680
	my $user = $_[0];
1681
    my $uistatus =  $_[1];
1682
    my $status =$_[2];
1683
    my $path = $_[3];
1684
	my $targetdir = $_[4];
1685
	my $remolder = $_[5];
1686
	my $pool = "/mnt/stabile/node";
1687
    my $image;
1688
    my $subdir; # 1 level of subdirs supported
1689
    my $res;
1690
	return 0 unless ($path && $targetdir && $user);
1691
    # $image is the image to back up (including potential subdir), $pool the source dir (storage pool) and $targetdir the target dir (general backup dir)
1692

    
1693
    #mkdir "$targetdir/$user" unless -d "$targetdir/$user"; # Create the target dirs which will contain the backup
1694
    $path =~ /\/$user\/(.+)/;
1695
    my $imagepath = $1;
1696
    if ($path =~ /\/$user\/(.+)\/(.+)/) {
1697
        $subdir = $1;
1698
        $image = $2;
1699
    } else {
1700
        $path =~ /\/$user\/(.+)/;
1701
        $image = $1;
1702
    }
1703
    if ($subdir) { # Creation of $targetdir/$user is done when user logs in
1704
        #mkdir "$targetdir/$user/$subdir" unless -d "$targetdir/$user/$subdir";
1705
        #mkdir "$targetdir/$user/$subdir/$image" unless -d "$targetdir/$user/$subdir/$image";
1706
        my $dironly = $1 if ($targetdir =~ /.+::(.+)/);
1707
        eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/ssh $mainvalve mkdir "$dironly/$user/$subdir"`; 1;}
1708
    } else { # Image subdir is created by rdiff-backup
1709
        #mkdir "$targetdir/$user/$image" unless -d "$targetdir/$user/$image";
1710
    }
1711
    $res .= `/bin/echo $status > "$pool/$user/$imagepath.meta"`;
1712

    
1713
    if (-d "/mnt/$user-$image") {
1714
        $res .= "Image is already being backed up";
1715
    } else {
1716
        my $snapname;
1717
        my $snappath;
1718
        my $snapsrcdir;
1719
        if ($status eq "lbackingup") { # Do a local lvm snapshot before backing up
1720
            $res .= `/sbin/modprobe dm-snapshot`; # Make sure we can make lvm snapshots
1721
            $snapname = "$user-$image";
1722
            $snapname =~ tr/ /-/; #No spaces allowed in snapshot names...
1723
            $snapname =~ tr/@/+/; #No spaces allowed in snapshot names...
1724
            $snappath = "/mnt/$snapname"; # The path to mount our snapshot on
1725
            mkdir $snappath;
1726

    
1727
            my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
1728
            $q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
1729
            my $lvolgroup = $1;
1730
            my $lvol = $2;
1731

    
1732
            $res .= `/sbin/lvcreate -L1024M -s -n $snapname /dev/$lvolgroup/$lvol`; # Take a snapshot
1733
            $res .= changeFstab($snapname, $pool); # Change fstab to allow mount
1734
            $res .= `/bin/mount "$snappath"`; # Mount the snapshot
1735
            $snapsrcdir = "$snappath/$user"; # Change source dir to our new snapshot
1736
        } else {
1737
            $snapsrcdir = "$pool/$user";
1738
        }
1739

    
1740
        # Do the backup
1741
        eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --include "$snapsrcdir/$imagepath" --exclude '**' "$snapsrcdir" "$targetdir/$user/$imagepath"`; 1;}
1742
        or do {$res .= "Problem executing backup";};
1743
        if ($remolder) {
1744
            eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --force --remove-older-than $remolder "$targetdir/$user/$imagepath"`; 1;}
1745
            or do {$res .= "Problem cleaning up old backups";};
1746
        }
1747
        $res .= qq{/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --include "$snapsrcdir/$imagepath" --exclude '**' "$snapsrcdir" "$targetdir/$user/$imagepath"};
1748
        # Clean up
1749
        if ($status eq "lbackingup") {
1750
            $res .= `/bin/umount "$snappath"`;
1751
            $res .= changeFstab($snapname, $pool, 1);
1752
            $res .= `/bin/rm -r "$snappath"` unless (-d "$snappath/$user");
1753
            $res .= `/sbin/lvremove -f /dev/$lvolgroup/$snapname`;
1754
        }
1755
        logit("info", "Backed up $snapsrcdir/$imagepath to $targetdir/$user/$imagepath");
1756
    }
1757
	unlink "$pool/$user/$imagepath.meta";
1758
    print "$res\n" if ($debug);
1759

    
1760

    
1761
    my $mes = "";
1762
    if ($res =~ /TotalDestinationSizeChange (\d+)(.+\))/) {
1763
        if ($1 eq "0") {
1764
            $mes = "No changes to back up ($imagepath)";
1765
        } else {
1766
            $mes = "Backed up $1$2 ($imagepath)";
1767
        }
1768
    } elsif ($res =~ /(Image is already being backed up)/) {
1769
        $mes = "$1 ($imagepath)";
1770
    } else {
1771
        my $hres = $res;
1772
        $hres =~ s/\n/<br>/g;
1773
        $hres =~ s/\"/\\"/g;
1774
        $mes = "Backup failed ($imagepath)";
1775
        logit('err', "Backup of $imagepath failed - $hres");
1776
    }
1777
    my $logentry = "$user: images: $path: $status: $mes";
1778

    
1779
    # Update the client UI
1780
    my $url = $base_url . "?mac=$mac&status=updateui&logentry="  . uri_escape($logentry);
1781
    $content = $browser->get($url);
1782
}
1783

    
1784
sub changeFstab {
1785
	my $image = $_[0];
1786
	my $pool = $_[1];
1787
	my $remove = 1 if $_[2];
1788
	return 0 unless ($image);
1789
	return 0 unless (index($image, " ")==-1);
1790
	copy($fstab, "$fstab.steam.bak") or return 0;
1791

    
1792
	my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
1793
    $q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
1794
    my $lvolgroup = $1;
1795
    my $lvol = $2;
1796

    
1797
	my $newfile = "";
1798
	my $match;
1799
	open (FILE, $fstab);
1800
	while (<FILE>) {
1801
		chomp;
1802
		my $line = $_;
1803
		if ($line =~ /^\/dev\/$lvolgroup\/$image/) {
1804
			$newfile .= "$line\n" unless ($remove);
1805
			$match = 1;
1806
		} else {
1807
			$newfile .= "$line\n";
1808
		}
1809
	}
1810
	$newfile .= "/dev/$lvolgroup/$image /mnt/$image ext3 users,ro 0 0\n" unless ($match || $remove);
1811
	close (FILE);
1812
	open( FILE, ">$fstab" );
1813
	print FILE $newfile;
1814
	close(FILE);
1815
	return "fstab updated $remove\n";
1816
}
1817

    
1818
sub initializeLocalDisk {
1819
    my $initld = shift;
1820
    my $force = shift;
1821
    my $res;
1822
    if ((-e "/dev/sda" || -e "/dev/vda" || -e "/dev/nvme0n1") && -e '/sbin/sfdisk') {
1823
        my $dev = "sda";
1824
        $dev = "vda" if (-e "/dev/vda");
1825
        my $part = $dev . "1";
1826
        if (-e "/dev/nvme0n1") {
1827
            $dev = "nvme0n1";
1828
            $part = $dev . "p1";
1829
        }
1830

    
1831
        `chmod 666 /dev/zfs` if (-e '/dev/zfs'); # TODO: This should be removed once we upgrade to Bionic and zfs allow is supported
1832
        my $partinfo = `/sbin/sfdisk -q -d /dev/$dev`;
1833
        my $zlist = `zpool list`;
1834

    
1835
        if (!$force) {
1836
            my $mounts = `/bin/cat /proc/mounts`;
1837
            if ($mounts =~ /volgroup1-lvol1/ || $mounts =~ /\mnt\/stabile\/node/) {
1838
                $res = "Local disk is already mounted.";
1839
                print "$res\n";
1840
                return $res;
1841
            } else {
1842
                if (( $partinfo =~ /\/dev\/$part.+size=.*(\d+),/i && $1>0 ) || $zlist =~ /stabile-node/) {
1843
                    $res = "Local disk is already partitioned. Trying to mount.";
1844
                    if ($initld eq 'zfs') {
1845
                        $res .= " ZFS specified.";
1846
                        `zpool import stabile-node`;
1847
                        `zfs mount stabile-node/node`;
1848
                    } else {
1849
                        $res .= " LVM specified.";
1850
                        `/bin/mount /dev/volgroup1/lvol1 /mnt/stabile/node`;
1851
                    }
1852
                    print "$res\n";
1853
                }
1854
                `/bin/chmod 777 /mnt/stabile/node`;
1855
                return $res;
1856
            }
1857
        }
1858

    
1859
        if ($force) {
1860
            if (`ls -l /mnt/stabile/node/*/*.qcow2`) {
1861
                $res = "Node storage dir not empty";
1862
                print "$res\n";
1863
                return $res;
1864
            }
1865
            print `umount /mnt/stabile/node`;
1866
            print `umount /stabile-node`;
1867
            my $mounts = `cat /proc/mounts`;
1868
            if ($mounts =~ /stabile-node/ || $mounts =~ /\/mnt\/stabile\/node/) {
1869
                $res = "Unable to unmount node storage\n";
1870
                print "$res\n";
1871
                return $res;
1872
            }
1873
            print `zpool destroy stabile-node`;
1874
            print `vgremove -f volgroup1`;
1875
        }
1876
        if ($initld eq 'zfs') { # ZFS was specified
1877
            $res = "Initializing local disk with ZFS...";
1878
            print "$res\n";
1879
            print `rmdir /mnt/stabile/node` if (-e "/mnt/stabile/node" && !(`ls /mnt/stabile/node`));
1880
            print `parted -s /dev/$dev mklabel GPT`;
1881
            print `zpool create stabile-node /dev/$dev`;
1882
            print `zfs create stabile-node/node`;
1883
            print `zfs set mountpoint=/mnt/stabile/node stabile-node/node`;
1884
            print `zfs set atime=off stabile-node/node`;
1885
        } else { # Assume LVM
1886
            $res = "Initializing local disk with LVM...";
1887
            print "$res\n";
1888
            `/sbin/sfdisk -d /dev/$dev > /root/$dev-partition-sectors.save`;
1889
            `sfdisk /dev/$dev << EOF\n;\nEOF`;
1890
            `/sbin/vgcreate -f volgroup1 /dev/$part`;
1891
            `/sbin/vgchange -a y volgroup1`;
1892
            my $totalpe =`/sbin/vgdisplay volgroup1 | grep "Total PE"`;
1893
            $totalpe =~ /Total PE\s+(\d+)/;
1894
            my $size = $1 -2000;
1895
            `/sbin/lvcreate -l $size volgroup1 -n lvol1`;
1896
            `/sbin/mkfs.ext3 /dev/volgroup1/lvol1`;
1897
            `/bin/mount /dev/volgroup1/lvol1 /mnt/stabile/node`;
1898
        }
1899
        `/bin/chmod 777 /mnt/stabile/node`;
1900
        my $lsistatus = `/usr/local/bin/lsi.sh status`;
1901
        if ($lsistatus =~ /Adapter 0/) {
1902
            #unless (-e "/etc/cron.hourly/lsicheck.sh") {
1903
            print "Adding hourly cron check of LSI raid\n";
1904
            my $alertemail = `cat /etc/stabile/nodeconfig.cfg | grep ALERT_EMAIL | cut -f2 -d "="`;
1905
            `/bin/echo "#!/bin/bash\n\n/usr/local/bin/lsi.sh checkNemail $alertemail" > /etc/cron.hourly/lsicheck.sh`;
1906
            $res .= "Adding hourly cron check of LSI raid";
1907
            print "$res\n";
1908
            `/bin/echo "#!/bin/bash\n\n/usr/local/bin/lsi.sh status | mail -s \\"$hostname LSI status\\" $alertemail" > /etc/cron.weekly/lsistatus.sh`;
1909
            #}
1910
        }
1911
    } else {
1912
        $res = "No local disk";
1913
        print "$res\n";
1914
    }
1915
    return $res;
1916
}
1917

    
1918
sub dont_die {
1919
    print "We trudge along\n";
1920
}
1921

    
1922
sub run_in_bg {
1923
    my ($cmd, $uuid) = @_;
1924
    if ($uuid) {
1925
        my $proc1 = Proc::Background->new("$cmd 2>&1 | /usr/bin/tee /tmp/$uuid.bg.out"); # We're moving a domain
1926
    } else {
1927
        my $proc1 = Proc::Background->new($cmd);
1928
    }
1929
}
1930

    
1931
sub setCgroups {
1932
    if (-d "/sys/fs/cgroup") {
1933
        print `cgconfigparser -l /etc/stabile/cgconfig.conf`;
1934
    } else {
1935
        print "cgroups are not enabled!!\n";
1936
    }
1937
}
1938

    
1939
sub updateInterfaces {
1940
    if ($identity eq 'local_kvm' || -e "/etc/stabile/config.cfg") {
1941
        unless (`ifconfig | grep "inet 10\.0\.0\.1"`) {
1942
#            print "Adding 10.0.0.1 as to $datanic\n";
1943
#            `ifconfig $datanic:1 10.0.0.1/24 up`;
1944
            print "Adding 10.0.0.1 as to $adminnic\n";
1945
            `ifconfig $adminnic:1 10.0.0.1/24 up`;
1946
            `steamExec post-wake`;
1947
        }
1948
    }
1949
}
1950

    
1951
# Enumerate and return network interfaces
1952
sub getNics {
1953
    my $droute = `ip route show default`;
1954
    my $internalnic = $1 if ($droute =~ /default via .+ dev (.+) proto/); # On the node, default route is on the internal network
1955
    # First get all nics and activate link on ethers - for some reason Ubuntu puts them down if they are not configured with an IP
1956
    my $niclist = `ifconfig -a | grep flags= | sed -n -e 's/: .*//p'`;
1957
    foreach my $line (split("\n", $niclist)) {
1958
        my $nic = $1 if ($line =~ /(\S+)/);
1959
        if ($nic=~/^en/) {
1960
            `ifconfig $nic up`;
1961
        }
1962
    }
1963
    sleep 1;
1964
    # Then list those that are up i.e. have link
1965
    my $niclist = `ifconfig | grep flags= | sed -n -e 's/: .*//p'`;
1966
    # my $niclist = `netstat -in`;
1967
    my @nics = ();
1968
    push @nics, $internalnic if ($internalnic);
1969
    foreach my $line (split("\n", $niclist)) {
1970
        my $nic = $1 if ($line =~ /(\S+)/);
1971
        if ($nic ne 'lo' && $nic ne $internalnic && !($nic=~/^virbr/) && !($nic=~/^docker/) && !($nic=~/^br/) && !($nic=~/^vnet/) && !($nic=~/^Name/) && !($nic=~/^Kernel/) && !($nic=~/^Iface/) && !($nic=~/(\.|\:)/)) {
1972
            push @nics, $1;
1973
        }
1974
    }
1975
    $internalnic = $nics[0] unless ($internalnic);
1976
    my $externalnic = $internalnic;
1977
    $externalnic = $nics[1] if (scalar @nics > 1);
1978
    if ($identity eq 'local_kvm') { # local_kvm uses external NIC for vlans and internal NIC for 10.0.0.1
1979
        return ($externalnic, $internalnic);
1980
    } else {
1981
        return ($internalnic, $externalnic);
1982
    }
1983
}
1984

    
1985
sub TERMINATE {
1986
	$running = 0;
1987
	$status = "shutdown" unless ($status eq "asleep");
1988
    $glogentry = "--: nodes: $nmac: $status: Shutting down $identity piston...";
1989
	updatePistonInfo();
1990
	logit("debug", "Shutting down");
1991
	if ($identity eq "vbox") {
1992
        logit('info', "Shutting down Virtual Box piston");
1993
        print `/etc/init.d/vboxdrv stop`,"\n";
1994
	} else {
1995
        logit('info', "Shutting down KVM piston");
1996
        print `/etc/init.d/kvm stop`,"\n";
1997
	}
1998
	##logit("debug", `killall movepiston`);
1999
	##exit(0);
2000
}
2001

    
2002
##
(11-11/27)