Project

General

Profile

Download (85.4 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
                                # Adding VLANs on wifi NICs does not seem to work. Disabling for now until we figure out what is going on.
1015
                                unless ($datanic =~ /^wl/) {
1016
                                    eval {print `brctl addif br$br $datanic.$br`; 1;} or do {print $@;};
1017
                                }
1018
                                eval {print `ifconfig $datanic.$br up`; 1;} or do {print $@;};
1019
                                eval {print `ifconfig br$br up`; 1;} or do {print $@;};
1020
                            }
1021
                            $offset = $result + 1;
1022
                            $result = index($xml, $char, $offset);
1023
                        }
1024
                    }
1025

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

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

    
1146
                    eval {
1147
                        my $domid = `virsh -c $virshemu:///system domid $task_2`;
1148
                        my $virshcmd = "virsh -c $virshemu:///system undefine $domid 2>/dev/null";
1149
                        print  `$virshcmd` if ($domid);
1150
                        1;
1151
                    } or do {
1152
                      ;#  print $@;
1153
                    };
1154

    
1155
                    if ($xml=~/<source file=\'(.+)\'/i
1156
                        && -s $1)
1157
                    {
1158
                        eval {
1159
							if ($xml =~ /<hostdev /i) {
1160
#								`modprobe pci_stub`;
1161
#								`echo "10de 1b81" > /sys/bus/pci/drivers/pci-stub/new_id`;
1162
#								`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`;
1163
#								`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`;
1164
#								`echo 1 > /sys/bus/pci/devices/0000:01:00.1/remove`;
1165
#								`echo 1 > /sys/bus/pci/devices/0000:02:00.1/remove`;
1166

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

    
1214
sub logit {
1215
	my ($priority, $msg) = @_;
1216
	if ($priority =~ /info|err/ || $debug) {print pretty_time(), ": ", $priority, ": ", $msg, "\n"};
1217

    
1218
	setlogsock('unix');
1219
	# Log the PID and to CONSole if there's a problem.  Use facility 'user'.
1220
    openlog(basename($0), 'pid,cons', 'user');
1221
    syslog($priority, "$nmac: $msg");
1222
    closelog();
1223
}
1224

    
1225
sub dominfo {
1226
    my $vmm = shift;
1227
	my $domreq = ();
1228
	$domreq->{'dominfo'} = 1;
1229
	my @domains = $vmm->list_domains();
1230
	my %activedoms;
1231
	my $i = 0;
1232
    if (!$cgset) {
1233
        setCgroups();
1234
        $cgset = 1;
1235
    }
1236

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

    
1266
            if (-e "/tmp/$domuuid.xml") {
1267
                unlink "/tmp/$domuuid.xml";
1268
            }
1269

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

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

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

    
1365
sub drowse {
1366
    my $vmm = shift;
1367
    $vmm = Sys::Virt->new(address => "$virshemu:///system") unless $vmm;
1368
    my $drowsenow = shift;
1369

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

    
1392
		my $meminfo = `cat /proc/meminfo`;
1393
		$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
1394
		my $memtotal = $1;
1395
		$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
1396
		my $memfree = $1;
1397

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

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

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

    
1452
    } or do {print $@;};
1453

    
1454
}
1455

    
1456
sub changeHosts {
1457
    my $hosts = "/etc/hosts";
1458
	my $targetip = $_[0];
1459
	my $targetname = $_[1];
1460
	return 0 unless ($targetip && $targetname);
1461
	copy($hosts, "$hosts.bak") or return 0;
1462

    
1463
	my $newfile = "";
1464
	my $match;
1465
	open (FILE, $hosts);
1466
	while (<FILE>) {
1467
		chomp;
1468
		my $line = $_;
1469
		$newfile .= "$line\n" unless ($line =~ /^$targetip/);
1470
	}
1471
   	$newfile .= "$targetip $targetname";
1472
	close (FILE);
1473
	open( FILE, ">$hosts" ) or return 0;
1474
	print FILE $newfile;
1475
	close(FILE);
1476
	return "$hosts updated\n";
1477
}
1478

    
1479
sub pretty_time {
1480
	my $current_time = time;
1481
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($current_time);
1482
	my $pretty_time = sprintf "%4d-%02d-%02d@%02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec;
1483
	return $pretty_time;
1484
}
1485

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

    
1504
sub getSizes {
1505
    my $f = shift;
1506
    my $lmtime = shift;
1507

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

    
1560
}
1561

    
1562
sub updatePistonStats {
1563
    my $vmm = shift;
1564
	logit('info', "Updating domain statistics...") if $debug == 1;
1565

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

    
1583
		# Fetch basic node/domain information (cpu, memory, cputime etc)...
1584
		my $dom_info = $dom->get_info();
1585
		while (my($key, $value) = each(%$dom_info)) {
1586
			$postreq->{"$i.domain.$key"} = $value;
1587
		};
1588

    
1589
        my $t2 = $timestamp_useconds;
1590
        my $t1 =  $oldTimes{$uuid}->{timestamp_useconds};
1591
        my $c2 = $dom_info->{cpuTime};
1592
        my $c1 = $oldTimes{$uuid}->{cpuTime};
1593
        my $delta = $t2-$t1;
1594

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

    
1605
		# Process block devices...
1606
		my @devices;
1607
		# Collect statistics for several block devices...
1608
		if (ref($domxml->{devices}->{disk}) eq 'ARRAY') {@devices = @{$domxml->{devices}->{disk}};}
1609
		# Collect statistics for a single block device...
1610
		else {push @devices, $domxml->{devices}->{disk};}
1611

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

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

    
1643
		# Collect statistics for network interfaces...
1644
		my @netdevices;
1645
		if (ref($domxml->{devices}->{interface}) eq 'ARRAY') {@netdevices = @{$domxml->{devices}->{interface}};}
1646
		else {push @netdevices, $domxml->{devices}->{interface};}
1647

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

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

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

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

    
1733
            my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
1734
            $q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
1735
            my $lvolgroup = $1;
1736
            my $lvol = $2;
1737

    
1738
            $res .= `/sbin/lvcreate -L1024M -s -n $snapname /dev/$lvolgroup/$lvol`; # Take a snapshot
1739
            $res .= changeFstab($snapname, $pool); # Change fstab to allow mount
1740
            $res .= `/bin/mount "$snappath"`; # Mount the snapshot
1741
            $snapsrcdir = "$snappath/$user"; # Change source dir to our new snapshot
1742
        } else {
1743
            $snapsrcdir = "$pool/$user";
1744
        }
1745

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

    
1766

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

    
1785
    # Update the client UI
1786
    my $url = $base_url . "?mac=$mac&status=updateui&logentry="  . uri_escape($logentry);
1787
    $content = $browser->get($url);
1788
}
1789

    
1790
sub changeFstab {
1791
	my $image = $_[0];
1792
	my $pool = $_[1];
1793
	my $remove = 1 if $_[2];
1794
	return 0 unless ($image);
1795
	return 0 unless (index($image, " ")==-1);
1796
	copy($fstab, "$fstab.steam.bak") or return 0;
1797

    
1798
	my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
1799
    $q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
1800
    my $lvolgroup = $1;
1801
    my $lvol = $2;
1802

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

    
1824
sub initializeLocalDisk {
1825
    my $initld = shift;
1826
    my $force = shift;
1827
    my $res;
1828
    if ((-e "/dev/sda" || -e "/dev/vda" || -e "/dev/nvme0n1") && -e '/sbin/sfdisk') {
1829
        my $dev = "sda";
1830
        $dev = "vda" if (-e "/dev/vda");
1831
        my $part = $dev . "1";
1832
        if (-e "/dev/nvme0n1") {
1833
            $dev = "nvme0n1";
1834
            $part = $dev . "p1";
1835
        }
1836

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

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

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

    
1924
sub dont_die {
1925
    print "We trudge along\n";
1926
}
1927

    
1928
sub run_in_bg {
1929
    my ($cmd, $uuid) = @_;
1930
    if ($uuid) {
1931
        my $proc1 = Proc::Background->new("$cmd 2>&1 | /usr/bin/tee /tmp/$uuid.bg.out"); # We're moving a domain
1932
    } else {
1933
        my $proc1 = Proc::Background->new($cmd);
1934
    }
1935
}
1936

    
1937
sub setCgroups {
1938
    if (-d "/sys/fs/cgroup/blkio") {
1939
        print `cgconfigparser -l /etc/stabile/cgconfig.conf`;
1940
    } else {
1941
        print "cgroups are not enabled!!\n";
1942
    }
1943
}
1944

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

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

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

    
2007
##
(12-12/30)