Project

General

Profile

Download (76.2 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 'test' && $identity) {
239
    	$test = 1;
240
        initializeLocalDisk($initdisk) if ($initdisk && $identity ne 'local_kvm');
241
    	updatePistonInfo();
242
        TERMINATE();
243
    } elsif ($ARGV[0] eq 'stats' && $identity) {
244
    	$test = 1;
245
    	updatePistonStats();
246
        $running = 0;
247
    } elsif ($identity eq "kvm" || $identity eq "local_kvm" || $identity eq "vbox") {
248
        $status = "running";
249
       	$running = 1;
250
        if ($identity ne 'local_kvm') {
251
            if ($initdisk) {
252
                my $res = initializeLocalDisk($initdisk);
253
            }
254
            print `/bin/hostname $hostname`;
255
            print `/bin/echo "127.0.0.1 localhost\n$ip $hostname" > /etc/hosts`;
256

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

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

    
308

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

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

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

    
430

    
431
sub updatePistonInfo {
432
    my $failedtasks = shift;
433
	logit('info', "Updating piston info...") if ($debug);
434
	$naptime = 5;
435
	my $pid;
436

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

    
464
    my $nfsroot;
465
    $nfsroot = uri_escape($1) if ($cmdline =~ m/ nfsroot=(\S+) /);
466
    my $kernel;
467
    $kernel = uri_escape($1) if ($cmdline =~ m/BOOT_IMAGE=(\S+) /);
468

    
469
    # Bring up local interfaces if it has been lost because of S3 sleep
470
    updateInterfaces();
471

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

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

    
483
	# Load domain info into $dinfo
484
	my $dinfo = dominfo($vmm);
485

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

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

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

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

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

    
552
            }
553
        }
554
        $dinfo->{"stortotal"} = $stortotal;
555
        $dinfo->{"storfree"} = $storfree;
556
        $dinfo->{"stor"} = $stor;
557
    }
558

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

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

    
578
	my $task_1 = '';
579
	my $task_2 = '';
580
	my $task_3 = '';
581

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

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

    
647
                my $meminfo = `cat /sys/power/state`;
648
                my $s3sleep = ($meminfo =~ m/mem/);
649

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

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

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

    
843
                    #my $daemon = Proc::Daemon->new(
844
                    #        child_STDOUT => STDOUT,
845
                    #        child_STDERR => STDERR,
846
                    #        work_dir => '/usr/local/sbin',
847
                    #        exec_command => "/usr/local/sbin/movepiston command=backup $user $uistatus $status \"$path\" \"$targetdir\""
848
                    #    ) or do {logit("info", "ERROR doing backup of $path $@")};
849
                    #my $pid = $daemon->Init() or do {logit("info", "ERROR performing backup of $path $@")};
850

    
851
                    # Line below is the only variant that does not terminate movepiston - not sure why...
852
                    # my $backupcmd = qq{/usr/local/sbin/movepiston command=backup $user $uistatus $status "$path" "$targetdir" $remolder &};
853
                    # my $pid = system($backupcmd);
854
                    my $backupcmd = qq{$user $uistatus $status "$path" "$targetdir" $remolder};
855
                    my $backuptasks = "backup." . time;
856
                    `echo '$backupcmd' >> /tmp/$backuptasks`;
857
                    sleep 1;
858
                    my $pid = system(qq{/usr/local/sbin/movepiston command=$backuptasks &});
859
                    1;
860
                } or do {print "Error! ", $@;};
861
                logit("info", "Backup of \"$path\" running...");
862
            }
863
            elsif ($task_1 eq "MOVE") {
864
                my $vm = $task_2;
865
                my $targethost = $task_3;
866
                my $targetmac = $tasks[3];
867
                my $user = $tasks[4];
868
                my $logentry = "$nmac: servers: $task_2: moving: Now moving to $targethost...";
869
                logit('info', $logentry);
870
                my $newurl = $url . "&status=--&logentry=" . uri_escape($logentry);
871
                my $newcontent = $browser->get($newurl)->content();
872

    
873
                if ($identity eq "vbox") {
874
                    changeHosts($targethost, "piston$targetmac") or
875
                        $logentry = "$user: servers: /etc/hosts could not be updated\n".$@."\n"; # probably only needed for KVM but...
876
                    eval {
877
                        my $cmd = "/usr/bin/VBoxManage controlvm $vm teleport --host $targethost --port 6000";
878
                        run_in_bg($cmd);
879
                        1;
880
                    } or do {$logentry = "$user: Servers: " . "\n".$@."\n";};
881
                } else {
882
                    changeHosts($targethost, "piston$targetmac") or
883
                        $logentry = "$user: servers: /etc/hosts could not be updated\n".$@."\n"; # probably only needed for KVM but...
884
                    my $uriport = 15900 + int(rand(200)); # Choose a random port for live migration
885
                    my $cmd = "sudo -u irigo virsh -c qemu:///system migrate --migrateuri tcp://$targethost:$uriport --live --unsafe $vm qemu+ssh://$targethost/system";
886
                    logit('info', $cmd);
887
                    run_in_bg($cmd);
888
                }
889
                #eval { # We do not want the same domain reported in different states from two different nodes
890
                #    my $dom = $vmm->get_domain_by_uuid($vm);
891
                #    if ($dom) {$dom->undefine()};
892
                #    1;
893
                #} or do {print $@;};
894
            }
895
            elsif ($task_1 eq "RECEIVE") {
896
                my $uuid = $task_2; my $user = $task_3;
897
                my $logentry = "$user: servers: $task_2: receiving: Receive domain request received";
898
                logit('info', $logentry);
899
                my $mounts = `cat /proc/mounts`;
900
                for (my $i=0; $i<=$#tenderpathslist; $i++
901
                    )
902
                {
903
                    my $path = $tenderpathslist[$i];
904
                    my $host = $tenderlist[$i];
905
                    # Directory / mount point must exist
906
                    unless (-d $path) {
907
                        mkdir "$path" or {print ("Error $path could not be created\n")};
908
                    };
909
                    unless ($mounts =~ m/$path/i || ($identity eq 'local_kvm' && $host =~ /10\.0\.0\.1/)) {
910
                        logit('info', "Mounting (2) $path from $host");
911
                        eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
912
                    }
913
                }
914

    
915
                my $xml = $browser->get($base_url . "?status=listxml&uuid=$uuid&mac=$mac")->content();
916
                if ($xml =~ /<domain /i) {
917
                    print "Adding $uuid to move list\n" if ($debug);
918
                    push (@receiveuuids, $uuid);
919
                    eval { # Undefine domain in case it has been running here before
920
                        my $dom = $vmm->get_domain_by_uuid($task_2);
921
                        if ($dom) {$dom->undefine()};
922
                        1;
923
                    } or do {print $@;};
924
                    logit('info', "Defining $task_2");
925
                    # print $xml if ($debug);
926

    
927
                    # Add bridge interfaces
928
                    eval {print `modprobe 8021q`; 1;} or do {print $@;};
929
                    eval {print `ifconfig $datanic up`; 1;} or do {print $@;};
930
                    if ($xml =~ /<interface type=\'bridge\'/i
931
                        )
932
                    {
933
                        my $char = "<source bridge=";
934
                        my $offset = 0;
935
                        my $result = index($xml, $char, $offset);
936
                        while ($result != -1) {
937
                            my $br = substr($xml, $result+18, 5);
938
                            if ($br =~ /(\d+)/) {
939
                                $br = $1;
940
                                $logentry .= " - bringing up bridge br $br on $datanic";
941
                                eval {print `vconfig add $datanic $br`; 1;} or do {print $@;};
942
                                eval {print `brctl addbr br$br`; 1;} or do {print $@;};
943
                                eval {print `brctl stp br$br on`; 1;} or do {print $@;};
944
                                eval {print `brctl addif br$br $datanic.$br`; 1;} or do {print $@;};
945
                                eval {print `ifconfig $datanic.$br up`; 1;} or do {print $@;};
946
                                eval {print `ifconfig br$br up`; 1;} or do {print $@;};
947
                            }
948
                            $offset = $result + 1;
949
                            $result = index($xml, $char, $offset);
950
                        }
951
                    }
952

    
953
                    chop $@; $logentry .= "\n$br : $@" if $@;
954
                    if ($identity eq "vbox") { # vbox domains need to be defined on the receiving end
955
                        eval {
956
                            my $dom = $vmm->define_domain($xml);
957
                            logit ('info', "Defined: " + $dom);
958
                            1;
959
                        } or do {print $@;};
960
                        if ($@) {chop $@; $logentry .= "\n$@";}
961
                        # $logentry .= $dom;
962
                        my $res;
963
                        eval {$res = `/usr/bin/VBoxManage modifyvm $task_2 --teleporter on --teleporterport 6000`; 1;} or
964
                        do {$logentry .= "\n$user: servers: ".$res."\n".$@;};
965
                        eval {$res = `/usr/bin/VBoxManage startvm $task_2 --type vrdp`; 1;} or
966
                        do {$logentry .= "\n$user: servers: ".$res."\n".$@;};
967
                    } else {
968
                        ;
969
                    }
970
                } else {
971
                    $logentry .= "\n$user: servers: Invalid domain xml...";
972
                }
973
            }
974
            elsif ($task_1 eq "BCLONE") {
975
                my $user = $task_3;
976
                my $image = uri_unescape($task_2);
977
                my $logentry = "$user: images: $image: cloning: Clone request received";
978
                logit('info', $logentry);
979
                my $master = $browser->get($base_url . "?status=listimagemaster&image=$task_2")->content();
980
                if ($master) {
981
                    $master = uri_unescape($master);
982
                    $logentry = "Cloning $image from $master ";
983
                    $image =~ /(.+)\/.*/;
984
                    my $dir = $1;
985
                    unless (-e $dir) {
986
                        `/bin/mkdir -p "$dir"`;
987
                        `chmod 777 "$dir"`;
988
                    }
989
                    my $cmd = qq|/usr/bin/qemu-img create -f qcow2 -b "$master" "$image"|;
990
                    $logentry .= `$cmd`;
991
                    $logentry =~ tr/\n/ /;
992
                    logit('info', $logentry);
993
                } else {
994
                    logit('info', "Master for $image not found $master");
995
                }
996
            }
997
            elsif ($task_1 eq "DROWSE") {
998
                drowse('', 1);
999
            }
1000
            elsif ($task_1 eq "REMOVE") {
1001
                my $user = $task_3;
1002
                my $image = uri_unescape($task_2);
1003
                my $logentry = "$user: images: $image: removing: Remove image request received";
1004
                logit('info', $logentry);
1005
                $logengry = "Removed image $image " . unlink($image);
1006
                logit('info', $logentry);
1007
            }
1008
            elsif ($task_1 eq "PREMOVE") { # preserve backup
1009
                my $user = $task_3;
1010
                my $image = uri_unescape($task_2);
1011
                my $logentry = "$user: images: $image: removing: Premove image request received";
1012
                logit('info', $logentry);
1013
                $logengry = "Removed image $image (preserved) " . `mv "$image" "$image.bak"`;
1014
                logit('info', $logentry);
1015
            }
1016
            elsif ($task_1 eq "START") {
1017
            	$naptime = 1; # Temporarily speed up in order to report back promptly
1018
                my $user = $task_3;
1019
                my $logentry = "$user: servers: $task_2: starting: Start request received";
1020
                logit('info', $logentry);
1021

    
1022
                my $mounts = `cat /proc/mounts`;
1023
                for (my $i=0; $i<=$#tenderpathslist; $i++
1024
                    )
1025
                {
1026
                    my $path = $tenderpathslist[$i];
1027
                    my $host = $tenderlist[$i];
1028
                    # Directory / mount point must exist
1029
                    unless (-d $path) {
1030
                        mkdir "$path" or {print ("Error $path could not be created\n")};
1031
                    };
1032
                    if ($mounts =~ m/$path /i || ($identity eq 'local_kvm' && $host =~ /10\.0\.0\.1/)) {
1033
                        print ("$path already mounted\n") if ($debug);
1034
                    } else {
1035
                        logit('info', "Mounting (3) $path from $host");
1036
                        eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
1037
                    }
1038
                }
1039
                my $xml = $browser->get($base_url . "?status=listxml&uuid=$task_2&mac=$mac")->content();
1040
                if ($xml =~ /<domain /i) {
1041
                    logit('info', "Creating $task_2");
1042
                    unless ($identity eq "local_kvm") {
1043
                        # Add bridge interfaces
1044
                        eval {print `modprobe 8021q`; 1;} or do {print $@;};
1045
                        eval {print `ifconfig $datanic up`; 1;} or do {print $@;};
1046
                        if ($xml =~ /<interface type=\'bridge\'/i) {
1047
                            my $char = "<source bridge=";
1048
                            my $offset = 0;
1049
                            my $result = index($xml, $char, $offset);
1050
                            while ($result != -1) {
1051
                                my $br = substr($xml, $result+18, 5);
1052
                                if ($br =~ /(\d+)/) {
1053
                                    $br = $1;
1054
                                    $logentry .= " - bringing up bridge br$br on $datanic ";
1055
                                    eval {print `vconfig add $datanic $br`; 1;} or do {print $@;};
1056
                                    eval {print `brctl addbr br$br`; 1;} or do {print $@;};
1057
                                    eval {print `brctl stp br$br on`; 1;} or do {print $@;};
1058
                                    eval {print `brctl addif br$br $datanic.$br`; 1;} or do {print $@;};
1059
                                    eval {print `ifconfig $datanic.$br up`; 1;} or do {print $@;};
1060
                                    eval {print `ifconfig br$br up`; 1;} or do {print $@;};
1061
                                }
1062
                                print $logentry if ($debug);
1063
                                $offset = $result + 1;
1064
                                $result = index($xml, $char, $offset);
1065
                            }
1066
                        }
1067
                        chop $@; $logentry .= " -- $br : $@" if $@;
1068
                    }
1069

    
1070
                    eval {
1071
                        my $domid = `virsh -c $virshemu:///system domid $task_2`;
1072
                        my $virshcmd = "virsh -c $virshemu:///system undefine $domid";
1073
                        print  `$virshcmd` if ($domid);
1074
                        1;
1075
                    } or do {
1076
                      ;#  print $@;
1077
                    };
1078

    
1079
                    if ($xml=~/<source file=\'(.+)\'/i
1080
                        && -s $1)
1081
                    {
1082
                        eval {
1083
							if ($xml =~ /<hostdev /i) {
1084
#								`modprobe pci_stub`;
1085
#								`echo "10de 1b81" > /sys/bus/pci/drivers/pci-stub/new_id`;
1086
#								`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`;
1087
#								`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`;
1088
#								`echo 1 > /sys/bus/pci/devices/0000:01:00.1/remove`;
1089
#								`echo 1 > /sys/bus/pci/devices/0000:02:00.1/remove`;
1090

    
1091
							#	`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`;
1092
							#	`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`;
1093
							}
1094
							print "Defining domain from:\n$xml\n" if ($debug);
1095
                            print `echo "$xml" > /tmp/$task_2.xml`;
1096
                            my $virshcmd = "virsh -c $virshemu:///system create /tmp/$task_2.xml";
1097
                            run_in_bg( $virshcmd );
1098
                            logit ('info', "Created: $task_2");
1099
                            $logentry .= " - Created: $task_2" ;
1100
                            1;
1101
                        } or do {print "Error: " . $@;};
1102
                        if ($@) {
1103
                            chop $@; $logentry .= "\n$@";
1104
                            # $returntasks = uri_escape("START $task_2 $user"); # START did not succeed - return it to try again
1105
                        }
1106
                    } else {
1107
                        logit ('info', "Image $1 not found creating: $task_2");
1108
                        $logentry .= " - Image $1 not found creating: $task_2" ;
1109
                    }
1110
                } else {
1111
                    $logentry .= " - $user: servers: Invalid domain xml...";
1112
                }
1113
                my $rtasks = $returntasks?"returntasks=$returntasks":'';
1114
                my $newurl = $url . "&status=--&logentry=". uri_escape($logentry) . $rtasks;
1115
                my $newcontent = $browser->get($newurl)->content();
1116
            } elsif ($task_1 ne "OK") {
1117
                my $logentry = "--: --: Info not accepted: $task_1 - $task_2 - $task_3";
1118
                logit('debug', $logentry);
1119
            }
1120
		}
1121
        if (@receiveuuids) {
1122
            $url .= "&receive=" . uri_escape(join(',', @receiveuuids)) . "&status=--";
1123
            logit('info', "Asking to send me: " . join(',', @receiveuuids) . " $url ") if ($debug);
1124
            my $newcontent = $browser->get($url)->content();
1125
        }
1126
	} else {
1127
        logit('info', "Couldn't get: $url");
1128
	}
1129
	if ($pid) {return "";}
1130
	else {return $running;}
1131
}
1132

    
1133
sub logit {
1134
	my ($priority, $msg) = @_;
1135
	if ($priority =~ /info|err/ || $debug) {print pretty_time(), ": ", $priority, ": ", $msg, "\n"};
1136

    
1137
	setlogsock('unix');
1138
	# Log the PID and to CONSole if there's a problem.  Use facility 'user'.
1139
    openlog(basename($0), 'pid,cons', 'user');
1140
    syslog($priority, "$nmac: $msg");
1141
    closelog();
1142
}
1143

    
1144
sub dominfo {
1145
    my $vmm = shift;
1146
	my $domreq = ();
1147
	$domreq->{'dominfo'} = 1;
1148
	my @domains = $vmm->list_domains();
1149
	my %activedoms;
1150
	my $i = 0;
1151
    if (!$cgset) {
1152
        setCgroups();
1153
        $cgset = 1;
1154
    }
1155

    
1156
    print "Looking at " . scalar @domains . " domains\n" if ($debug);
1157
	foreach my $dom (@domains) {
1158
	    eval {
1159
            my $xml = $dom->get_xml_description();
1160
            my $domxml = XMLin($xml);
1161
            my $display = $domxml->{devices}->{graphics}->{type};
1162
            my $port = $domxml->{devices}->{graphics}->{port};
1163
            my $domstate = $domstates[$dom->get_info->{ 'state' }];
1164
            my $domuuid = $dom->get_uuid_string;
1165
            $i++;
1166
            $activedoms{$domuuid} = $domstate;
1167
        #    $dominfo .= "&dom$i=$domuuid&domstate$i=$domstate&domdisplay$i=" . $display . "&domport$i=" . $port;
1168
            $domreq->{"dom$i"} = $domuuid;
1169
            $domreq->{"domstate$i"} = $domstate;
1170
            $domreq->{"domdisplay$i"} = $display;
1171
            $domreq->{"domport$i"} = $port;
1172

    
1173
            if (-e "/tmp/$domuuid.xml") {
1174
                unlink "/tmp/$domuuid.xml";
1175
            }
1176

    
1177
            # If cgroups are enabled, put in values
1178
            # We put in values in /mnt/cgroup/libvirt/qemu/ instead of for individual domains
1179
    #        if (-d '/mnt/' && -e '/proc/cgroups') {
1180
    #            if ($xml=~/<name>(.+)<\/name>/) {
1181
    #                my $domname = $1;
1182
    #                if (-e "/tmp/$domuuid.xml" && -d "/mnt/cgroup/libvirt/qemu/$domname/") {
1183
    #                    logit('info', "Setting cgroups limits $readlimit/$writelimit, $iopsreadlimit/$iopswritelimit for $domuuid ($domname)");
1184
    #                    `echo "8:0 $readlimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.read_bps_device"`;
1185
    #                    `echo "8:0 $writelimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.write_bps_device"`;
1186
    #                    `echo "8:0 $iopsreadlimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.read_iops_device"`;
1187
    #                    `echo "8:0 $iopswritelimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.write_iops_device"`;
1188
    #                    unlink "/tmp/$domuuid.xml";
1189
    #                }
1190
    #            } else {
1191
    #                logit('info', "Not setting cgroup limits for " . $dom->get_name() ) if ($debug);
1192
    #            }
1193
    #        }
1194
            1;
1195
	    } or do {print $@;};
1196

    
1197
	}
1198
	@domains = $vmm->list_defined_domains();
1199
	print "Looking at " . scalar @domains . " defined domains\n" if ($debug);
1200
	foreach my $dom (@domains) {
1201
	    eval {
1202
            my $domstate = $domstates[$dom->get_info->{ 'state' }];
1203
            my $domuuid = $dom->get_uuid_string;
1204
            if ($domstate ne "running") {
1205
                $i++;
1206
                $activedoms{$domuuid} = $domstate;
1207
                $domreq->{"dom$i"} = $domuuid;
1208
                $domreq->{"domstate$i"} = $domstate;
1209
            }
1210
            eval {
1211
                if ($domstate eq "shutoff") {$dom->undefine()};
1212
                1;
1213
            } or do {print $@;};
1214
	    } or do {print $@;};
1215
	}
1216
	foreach my $domuuid (keys %mortuary) {
1217
	    unless ($activedoms{$domuuid}) {
1218
            $i++;
1219
            $domreq->{"dom$i"} = $domuuid;
1220
            $domreq->{"domstate$i"} = 'shutoff';
1221
			delete $mortuary{$domuuid};
1222
	    }
1223
    }
1224
    if (%mortuary) {
1225
        store \%mortuary, $tombstones;
1226
    } else {
1227
        `> $tombstones` if (-e $tombstones && !(-z $tombstones));
1228
    }
1229
	return $domreq;
1230
}
1231

    
1232
sub drowse {
1233
    my $vmm = shift;
1234
    $vmm = Sys::Virt->new(address => "$virshemu:///system") unless $vmm;
1235
    my $drowsenow = shift;
1236

    
1237
	my @domains = $vmm->list_domains();
1238
	my $i = 0;
1239
	foreach my $dom (@domains) {
1240
		if ($domstates[$dom->get_info->{ 'state' }] eq "running" || $domstates[$dom->get_info->{ 'state' }] eq "paused") {
1241
			$i++;
1242
			last;
1243
		}
1244
	}
1245
	if ($i==0) {$drowsiness += $naptime} else {$drowsiness = 0};
1246
	if (($sleepafter > 0 && $drowsiness > $sleepafter) || $drowsenow) {
1247
        if ($identity eq "vbox") {
1248
            logit('info', "Taking down Virtual Box piston");
1249
            print `/etc/init.d/vboxdrv stop`,"\n";
1250
        } else {
1251
            logit('info', "Taking down KVM piston");
1252
            print `/etc/init.d/kvm stop`,"\n";
1253
        }
1254
        $status = "drowsing";
1255
        my $logentry = "--: nodes: $mac: $status: Feeling drowsy ($drowsiness >  $sleepafter) - putting node to sleep";
1256
        logit('info', $logentry);
1257
        $running = 0;
1258

    
1259
		my $meminfo = `cat /proc/meminfo`;
1260
		$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
1261
		my $memtotal = $1;
1262
		$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
1263
		my $memfree = $1;
1264

    
1265
		my $url = $base_url . "?mac=" . uri_escape($mac);
1266
		$url .= "&status=$status&logentry=" . uri_escape($logentry) ."&memtotal=$memtotal&memfree=$memfree&identity=$identity";
1267
		`umount -a`;
1268
		my $newcontent = $browser->get($url)->content();
1269
		my @clines = split /\n/, $newcontent;
1270
        foreach my $line (@clines) {
1271
            if ($line =~ m/^\S+=SWEETDREAMS/ig) {
1272
        		print "Awating power off...\n";
1273
                return;
1274
            }
1275
        }
1276

    
1277
        $meminfo = `cat /proc/acpi/sleep`;
1278
        my $s3sleep = ($meminfo =~ m/S3/);
1279
        if ($s3sleep) {
1280
            print `/etc/init.d/libvirt-bin stop`,"\n" if ($identity eq "vbox");
1281
            print `/etc/acpi/sleep.sh`;
1282
        } else {
1283
            print `systemctl stop movepiston`;
1284
           `echo 0 > /proc/sys/kernel/hung_task_timeout_secs`;
1285
            print `poweroff`;
1286
#            print `/sbin/shutdown -P +1`;
1287
        }
1288
	};
1289
}
1290

    
1291
sub changeHosts {
1292
    my $hosts = "/etc/hosts";
1293
	my $targetip = $_[0];
1294
	my $targetname = $_[1];
1295
	return 0 unless ($targetip && $targetname);
1296
	copy($hosts, "$hosts.bak") or return 0;
1297

    
1298
	my $newfile = "";
1299
	my $match;
1300
	open (FILE, $hosts);
1301
	while (<FILE>) {
1302
		chomp;
1303
		my $line = $_;
1304
		$newfile .= "$line\n" unless ($line =~ /^$targetip/);
1305
	}
1306
   	$newfile .= "$targetip $targetname";
1307
	close (FILE);
1308
	open( FILE, ">$hosts" ) or return 0;
1309
	print FILE $newfile;
1310
	close(FILE);
1311
	return "$hosts updated\n";
1312
}
1313

    
1314
sub pretty_time {
1315
	my $current_time = time;
1316
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($current_time);
1317
	my $pretty_time = sprintf "%4d-%02d-%02d@%02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec;
1318
	return $pretty_time;
1319
}
1320

    
1321
sub recurse {
1322
	my($path) = shift; # @_;
1323
	my @files;
1324
	## append a trailing / if it's not there
1325
	$path .= '/' if($path !~ /\/$/);
1326
	## loop through the files contained in the directory
1327
	for my $eachFile (glob($path.'*')) {
1328
		## if the file is a directory
1329
		if( -d $eachFile) {
1330
			## pass the directory to the routine ( recursion )
1331
			push(@files,recurse($eachFile));
1332
		} else {
1333
			push(@files,$eachFile);
1334
		}
1335
	}
1336
	return @files;
1337
}
1338

    
1339
sub getSizes {
1340
    my $f = shift;
1341
    my $lmtime = shift;
1342

    
1343
    #print "$f :";
1344
    my @stat = stat($f);
1345
    my $size = $stat[7];
1346
    my $realsize = $stat[12] * 512;
1347
    my $virtualsize = $size;
1348
    my $mtime = $stat[9];
1349
# Only fire up qemu-img etc. if image has been modified
1350
    #print " $lmtime : $mtime\n";
1351
    if ($mtime ne $lmtime) {
1352
        my($fname, $dirpath, $suffix) = fileparse($f, (".vmdk", ".img", ".vhd", ".qcow", ".qcow2", ".vdi", ".iso"));
1353
# Special handling of vmdk's
1354
        if ($suffix eq ".vmdk") {
1355
            my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
1356
            $qinfo =~ /virtual size:.*\((.+) bytes\)/g;
1357
            $virtualsize = int($1);
1358
            if ( -s ($dirpath . $fname . "-flat" . $suffix)) {
1359
                my @fstatus = stat($dirpath . $fname . "-flat" . $suffix);
1360
                my $fsize = $fstatus[7];
1361
                my $frealsize = $fstatus[12] * 512;
1362
                $size += $fsize;
1363
                $virtualsize += $fsize;
1364
                $realsize += $frealsize;
1365
            }
1366
            my $i = 1;
1367
            while (@fstatus = stat($dirpath . $fname . "-s00$i" . $suffix)) {
1368
                $fsize = $fstatus[7];
1369
                $frealsize = $fstatus[12] * 512;
1370
                $size += $fsize;
1371
                $virtualsize += $fsize;
1372
                $realsize += $frealsize;
1373
                $i++;
1374
            }
1375
# Get virtual size of qcow2 auto-grow volumes
1376
        } elsif ($suffix eq ".qcow2") {
1377
            my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
1378
            $qinfo =~ /virtual size:.*\((.+) bytes\)/g;
1379
            $virtualsize = int($1);
1380
# Get virtual size of vdi auto-grow volumes
1381
        } elsif ($suffix eq ".vdi") {
1382
            my $qinfo = `/usr/bin/VBoxManage showhdinfo "$f"`;
1383
            $qinfo =~ /Logical size:\s*(\d+) MBytes/g;
1384
            $virtualsize = int($1) * 1024 * 1024;
1385
        }
1386
# Actual used blocks times block size on disk, i.e. $realsize may be bigger than the
1387
# logical size of the image file $virtualsize and the logical provisioned size of the disk $virtualsize
1388
# in order to minimize confusion, we set $realsize to $size if this is the case
1389
        $realsize = $size if ($realsize > $size);
1390
        return ($size, $realsize, $virtualsize, $mtime);
1391
    } else {
1392
        return 0;
1393
    }
1394

    
1395
}
1396

    
1397
sub updatePistonStats {
1398
    my $vmm = shift;
1399
	logit('info', "Updating domain statistics...") if $debug == 1;
1400

    
1401
	# Connect to libvirt...
1402
	$vmm = Sys::Virt->new(address => "$virshemu:///system") unless $vmm;
1403
	my @domains = $vmm->list_domains();
1404
	my $postreq = ();
1405
	my $i = 0;
1406
	# Loop through all local domains...
1407
	foreach my $dom (@domains) {
1408
		$i++;
1409
		print "\tProcessing '",$dom->get_name(),"' [",$dom->get_uuid_string(),"]...\n" if $debug;
1410
#		my ($timestamp_seconds, $timestamp_microseconds_decimals) = gettimeofday();
1411
        my $timestamp_useconds = Time::HiRes::time();
1412
        my $timestamp_seconds = floor($timestamp_useconds);
1413
        my $uuid = $dom->get_uuid_string();
1414
		$postreq->{"$i.uuid"} = $uuid;
1415
#		$postreq->{"$i.timestamp"} = sprintf("%.0f%06.0f", $timestamp_seconds, $timestamp_microseconds_decimals);
1416
		$postreq->{"$i.timestamp"} = $timestamp_seconds;
1417

    
1418
		# Fetch basic node/domain information (cpu, memory, cputime etc)...
1419
		my $dom_info = $dom->get_info();
1420
		while (my($key, $value) = each(%$dom_info)) {
1421
			$postreq->{"$i.domain.$key"} = $value;
1422
		};
1423

    
1424
        my $t2 = $timestamp_useconds;
1425
        my $t1 =  $oldTimes{$uuid}->{timestamp_useconds};
1426
        my $c2 = $dom_info->{cpuTime};
1427
        my $c1 = $oldTimes{$uuid}->{cpuTime};
1428
        my $delta = $t2-$t1;
1429

    
1430
        if ($t1 && $c2>$c1) { # Work across reboots
1431
            $postreq->{"$i.domain.cpuLoad"} = sprintf("%.4f",  (($c2 - $c1)/1000000000) / $delta );
1432
            $postreq->{"$i.delta"} = floor($delta);
1433
        }
1434
        $oldTimes{$uuid}->{cpuTime} = $dom_info->{cpuTime};
1435
        $oldTimes{$uuid}->{timestamp_useconds} = $timestamp_useconds;
1436
        $oldTimes{$uuid}->{timestamp} = $timestamp_seconds;
1437
		# Fetch the xml description of the specific domain...
1438
		my $domxml = XMLin($dom->get_xml_description());
1439

    
1440
		# Process block devices...
1441
		my @devices;
1442
		# Collect statistics for several block devices...
1443
		if (ref($domxml->{devices}->{disk}) eq 'ARRAY') {@devices = @{$domxml->{devices}->{disk}};}
1444
		# Collect statistics for a single block device...
1445
		else {push @devices, $domxml->{devices}->{disk};}
1446

    
1447
        my $wr2;
1448
        my $wr1 = $oldTimes{$uuid}->{"wr_kbytes_s"};
1449
        my $rd2;
1450
        my $rd1 = $oldTimes{$uuid}->{"rd_kbytes_s"};
1451
        foreach my $device (@devices) {
1452
            if ($device->{device} eq 'disk') {
1453
                my $blockdev = $device->{target}->{dev};
1454
                eval {
1455
                    my $blockstats = $dom->block_stats($blockdev);
1456
                    while (my($key, $value) = each(%$blockstats)) {
1457
                        $postreq->{"$i.blk.$blockdev.$key"} = $value;
1458
                    #    $postreq->{"$i.blk.hd.$key"} += $value; # We report collected traffic under hd
1459
                        $wr2 += $value if ($key eq 'wr_bytes');
1460
                        $rd2 += $value if ($key eq 'rd_bytes');
1461
                    }
1462
                };
1463

    
1464
                print("\tFailed while requesting block device statistics for $blockdev, skipping...") if $@;
1465
            }
1466
        }
1467
        $postreq->{"$i.blk.hd.wr_bytes"} = $wr2;
1468
        $postreq->{"$i.blk.hd.rd_bytes"} = $rd2;
1469
        if ($t1 && $c2>$c1) {
1470
            $postreq->{"$i.blk.hd.wr_kbytes_s"} = sprintf("%.2f",  (($wr2 - $wr1)/1024) / $delta );
1471
            $postreq->{"$i.blk.hd.rd_kbytes_s"} = sprintf("%.2f",  (($rd2 - $rd1)/1024) / $delta );
1472
            $postreq->{"$i.blk.hd.wr_kbytes_s"} = 0 if ($postreq->{"$i.blk.hd.wr_kbytes_s"} eq '0.00');
1473
            $postreq->{"$i.blk.hd.rd_kbytes_s"} = 0 if ($postreq->{"$i.blk.hd.rd_kbytes_s"} eq '0.00');
1474
        }
1475
        $oldTimes{$uuid}->{wr_kbytes_s} = $wr2;
1476
        $oldTimes{$uuid}->{rd_kbytes_s} = $rd2;
1477

    
1478
		# Collect statistics for network interfaces...
1479
		my @netdevices;
1480
		if (ref($domxml->{devices}->{interface}) eq 'ARRAY') {@netdevices = @{$domxml->{devices}->{interface}};}
1481
		else {push @netdevices, $domxml->{devices}->{interface};}
1482

    
1483
        my $rx2;
1484
        my $rx1 = $oldTimes{$uuid}->{"rx_kbytes_s"};
1485
        my $tx2;
1486
        my $tx1 = $oldTimes{$uuid}->{"tx_kbytes_s"};
1487
        foreach my $device (@netdevices) {
1488
            my $interface = $device->{target}->{dev};
1489
            if ($interface) {
1490
                eval {
1491
                    my $ifstats = $dom->interface_stats($interface);
1492
                    while (my($key, $value) = each(%$ifstats)) {
1493
    					$postreq->{"$i.if.$interface.$key"} = $value;
1494
                        $postreq->{"$i.if.vnet.$key"} += $value; # We report collected traffic under vnet
1495
                        $rx2 += $value if ($key eq 'rx_bytes');
1496
                        $tx2 += $value if ($key eq 'tx_bytes');
1497
                    }
1498
                };
1499
                print("\tFailed while requesting interface statistics ('"+$@+"'), skipping...") if $@;
1500
            }
1501
		}
1502
        if ($t1 && $c2>$c1) {
1503
            $postreq->{"$i.if.vnet.rx_kbytes_s"} = sprintf("%.2f",  (($rx2 - $rx1)/1024) / $delta );
1504
            $postreq->{"$i.if.vnet.tx_kbytes_s"} = sprintf("%.2f",  (($tx2 - $tx1)/1024) / $delta );
1505
            $postreq->{"$i.if.vnet.rx_kbytes_s"} = 0 if ($postreq->{"$i.if.vnet.rx_kbytes_s"} eq '0.00');
1506
            $postreq->{"$i.if.vnet.tx_kbytes_s"} = 0 if ($postreq->{"$i.if.vnet.tx_kbytes_s"} eq '0.00');
1507
        }
1508
        $oldTimes{$uuid}->{rx_kbytes_s} = $rx2;
1509
        $oldTimes{$uuid}->{tx_kbytes_s} = $tx2;
1510
	}
1511
    if ($postreq) {
1512
        # POST request to admin server...
1513
       	logit('info', "Posting stats to: $stats_url") if $debug;
1514
       	print("POSTREQ:\n".Dumper($postreq)) if $debug;
1515
       	$content = $browser->post($stats_url, $postreq)->content();
1516
        print "$content\n" if $debug;
1517
    }
1518
}
1519

    
1520
sub backup {
1521
	my $user = $_[0];
1522
    my $uistatus =  $_[1];
1523
    my $status =$_[2];
1524
    my $path = $_[3];
1525
	my $targetdir = $_[4];
1526
	my $remolder = $_[5];
1527
	my $pool = "/mnt/stabile/node";
1528
    my $image;
1529
    my $subdir; # 1 level of subdirs supported
1530
    my $res;
1531
	return 0 unless ($path && $targetdir && $user);
1532
    # $image is the image to back up (including potential subdir), $pool the source dir (storage pool) and $targetdir the target dir (general backup dir)
1533

    
1534
    #mkdir "$targetdir/$user" unless -d "$targetdir/$user"; # Create the target dirs which will contain the backup
1535
    $path =~ /\/$user\/(.+)/;
1536
    my $imagepath = $1;
1537
    if ($path =~ /\/$user\/(.+)\/(.+)/) {
1538
        $subdir = $1;
1539
        $image = $2;
1540
    } else {
1541
        $path =~ /\/$user\/(.+)/;
1542
        $image = $1;
1543
    }
1544
    if ($subdir) { # Creation of $targetdir/$user is done when user logs in
1545
        #mkdir "$targetdir/$user/$subdir" unless -d "$targetdir/$user/$subdir";
1546
        #mkdir "$targetdir/$user/$subdir/$image" unless -d "$targetdir/$user/$subdir/$image";
1547
        my $dironly = $1 if ($targetdir =~ /.+::(.+)/);
1548
        eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/ssh $mainvalve mkdir "$dironly/$user/$subdir"`; 1;}
1549
    } else { # Image subdir is created by rdiff-backup
1550
        #mkdir "$targetdir/$user/$image" unless -d "$targetdir/$user/$image";
1551
    }
1552
    $res .= `/bin/echo $status > "$pool/$user/$imagepath.meta"`;
1553

    
1554
    if (-d "/mnt/$user-$image") {
1555
        $res .= "Image is already being backed up";
1556
    } else {
1557
        my $snapname;
1558
        my $snappath;
1559
        my $snapsrcdir;
1560
        if ($status eq "lbackingup") { # Do a local lvm snapshot before backing up
1561
            $res .= `/sbin/modprobe dm-snapshot`; # Make sure we can make lvm snapshots
1562
            $snapname = "$user-$image";
1563
            $snapname =~ tr/ /-/; #No spaces allowed in snapshot names...
1564
            $snapname =~ tr/@/+/; #No spaces allowed in snapshot names...
1565
            $snappath = "/mnt/$snapname"; # The path to mount our snapshot on
1566
            mkdir $snappath;
1567

    
1568
            my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
1569
            $q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
1570
            my $lvolgroup = $1;
1571
            my $lvol = $2;
1572

    
1573
            $res .= `/sbin/lvcreate -L1024M -s -n $snapname /dev/$lvolgroup/$lvol`; # Take a snapshot
1574
            $res .= changeFstab($snapname, $pool); # Change fstab to allow mount
1575
            $res .= `/bin/mount "$snappath"`; # Mount the snapshot
1576
            $snapsrcdir = "$snappath/$user"; # Change source dir to our new snapshot
1577
        } else {
1578
            $snapsrcdir = "$pool/$user";
1579
        }
1580

    
1581
        # Do the backup
1582
        eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --include "$snapsrcdir/$imagepath" --exclude '**' "$snapsrcdir" "$targetdir/$user/$imagepath"`; 1;}
1583
        or do {$res .= "Problem executing backup";};
1584
        if ($remolder) {
1585
            eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --force --remove-older-than $remolder "$targetdir/$user/$imagepath"`; 1;}
1586
            or do {$res .= "Problem cleaning up old backups";};
1587
        }
1588
        $res .= qq{/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --include "$snapsrcdir/$imagepath" --exclude '**' "$snapsrcdir" "$targetdir/$user/$imagepath"};
1589
        # Clean up
1590
        if ($status eq "lbackingup") {
1591
            $res .= `/bin/umount "$snappath"`;
1592
            $res .= changeFstab($snapname, $pool, 1);
1593
            $res .= `/bin/rm -r "$snappath"` unless (-d "$snappath/$user");
1594
            $res .= `/sbin/lvremove -f /dev/$lvolgroup/$snapname`;
1595
        }
1596
        logit("info", "Backed up $snapsrcdir/$imagepath to $targetdir/$user/$imagepath");
1597
    }
1598
	unlink "$pool/$user/$imagepath.meta";
1599
    print "$res\n" if ($debug);
1600

    
1601

    
1602
    my $mes = "";
1603
    if ($res =~ /TotalDestinationSizeChange (\d+)(.+\))/) {
1604
        if ($1 eq "0") {
1605
            $mes = "No changes to back up ($imagepath)";
1606
        } else {
1607
            $mes = "Backed up $1$2 ($imagepath)";
1608
        }
1609
    } elsif ($res =~ /(Image is already being backed up)/) {
1610
        $mes = "$1 ($imagepath)";
1611
    } else {
1612
        my $hres = $res;
1613
        $hres =~ s/\n/<br>/g;
1614
        $hres =~ s/\"/\\"/g;
1615
        $mes = "Backup failed ($imagepath)";
1616
        logit('err', "Backup of $imagepath failed - $hres");
1617
    }
1618
    my $logentry = "$user: images: $path: $status: $mes";
1619

    
1620
    # Update the client UI
1621
    my $url = $base_url . "?mac=$mac&status=updateui&logentry="  . uri_escape($logentry);
1622
    $content = $browser->get($url);
1623
}
1624

    
1625
sub changeFstab {
1626
	my $image = $_[0];
1627
	my $pool = $_[1];
1628
	my $remove = 1 if $_[2];
1629
	return 0 unless ($image);
1630
	return 0 unless (index($image, " ")==-1);
1631
	copy($fstab, "$fstab.steam.bak") or return 0;
1632

    
1633
	my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
1634
    $q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
1635
    my $lvolgroup = $1;
1636
    my $lvol = $2;
1637

    
1638
	my $newfile = "";
1639
	my $match;
1640
	open (FILE, $fstab);
1641
	while (<FILE>) {
1642
		chomp;
1643
		my $line = $_;
1644
		if ($line =~ /^\/dev\/$lvolgroup\/$image/) {
1645
			$newfile .= "$line\n" unless ($remove);
1646
			$match = 1;
1647
		} else {
1648
			$newfile .= "$line\n";
1649
		}
1650
	}
1651
	$newfile .= "/dev/$lvolgroup/$image /mnt/$image ext3 users,ro 0 0\n" unless ($match || $remove);
1652
	close (FILE);
1653
	open( FILE, ">$fstab" );
1654
	print FILE $newfile;
1655
	close(FILE);
1656
	return "fstab updated $remove\n";
1657
}
1658

    
1659
sub initializeLocalDisk {
1660
    my $initld = shift;
1661
    my $force = shift;
1662
    my $res;
1663
    if ((-e "/dev/sda" || -e "/dev/vda" || -e "/dev/nvme0n1") && -e '/sbin/sfdisk') {
1664
        my $dev = "sda";
1665
        $dev = "vda" if (-e "/dev/vda");
1666
        my $part = $dev . "1";
1667
        if (-e "/dev/nvme0n1") {
1668
            $dev = "nvme0n1";
1669
            $part = $dev . "p1";
1670
        }
1671

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

    
1676
        if (!$force) {
1677
            my $mounts = `/bin/cat /proc/mounts`;
1678
            if ($mounts =~ /volgroup1-lvol1/ || $mounts =~ /\mnt\/stabile\/node/) {
1679
                $res = "Local disk is already mounted.";
1680
                print "$res\n";
1681
                return $res;
1682
            } else {
1683
                if (( $partinfo =~ /\/dev\/$part.+size=.*(\d+),/i && $1>0 ) || $zlist =~ /stabile-node/) {
1684
                    $res = "Local disk is already partitioned. Trying to mount.";
1685
                    if ($initld eq 'zfs') {
1686
                        $res .= " ZFS specified.";
1687
                        `zpool import stabile-node`;
1688
                        `zfs mount stabile-node/node`;
1689
                    } else {
1690
                        $res .= " LVM specified.";
1691
                        `/bin/mount /dev/volgroup1/lvol1 /mnt/stabile/node`;
1692
                    }
1693
                    print "$res\n";
1694
                }
1695
                `/bin/chmod 777 /mnt/stabile/node`;
1696
                return $res;
1697
            }
1698
        }
1699

    
1700
        if ($force) {
1701
            if (`ls -l /mnt/stabile/node/*/*.qcow2`) {
1702
                $res = "Node storage dir not empty";
1703
                print "$res\n";
1704
                return $res;
1705
            }
1706
            print `umount /mnt/stabile/node`;
1707
            print `umount /stabile-node`;
1708
            my $mounts = `cat /proc/mounts`;
1709
            if ($mounts =~ /stabile-node/ || $mounts =~ /\/mnt\/stabile\/node/) {
1710
                $res = "Unable to unmount node storage\n";
1711
                print "$res\n";
1712
                return $res;
1713
            }
1714
            print `zpool destroy stabile-node`;
1715
            print `vgremove -f volgroup1`;
1716
        }
1717
        if ($initld eq 'zfs') { # ZFS was specified
1718
            $res = "Initializing local disk with ZFS...";
1719
            print "$res\n";
1720
            print `rmdir /mnt/stabile/node` if (-e "/mnt/stabile/node" && !(`ls /mnt/stabile/node`));
1721
            print `parted -s /dev/$dev mklabel GPT`;
1722
            print `zpool create stabile-node /dev/$dev`;
1723
            print `zfs create stabile-node/node`;
1724
            print `zfs set mountpoint=/mnt/stabile/node stabile-node/node`;
1725
            print `zfs set atime=off stabile-node/node`;
1726
        } else { # Assume LVM
1727
            $res = "Initializing local disk with LVM...";
1728
            print "$res\n";
1729
            `/sbin/sfdisk -d /dev/$dev > /root/$dev-partition-sectors.save`;
1730
            `sfdisk /dev/$dev << EOF\n;\nEOF`;
1731
            `/sbin/vgcreate -f volgroup1 /dev/$part`;
1732
            `/sbin/vgchange -a y volgroup1`;
1733
            my $totalpe =`/sbin/vgdisplay volgroup1 | grep "Total PE"`;
1734
            $totalpe =~ /Total PE\s+(\d+)/;
1735
            my $size = $1 -2000;
1736
            `/sbin/lvcreate -l $size volgroup1 -n lvol1`;
1737
            `/sbin/mkfs.ext3 /dev/volgroup1/lvol1`;
1738
            `/bin/mount /dev/volgroup1/lvol1 /mnt/stabile/node`;
1739
        }
1740
        `/bin/chmod 777 /mnt/stabile/node`;
1741
        my $lsistatus = `/usr/local/bin/lsi.sh status`;
1742
        if ($lsistatus =~ /Adapter 0/) {
1743
            #unless (-e "/etc/cron.hourly/lsicheck.sh") {
1744
            print "Adding hourly cron check of LSI raid\n";
1745
            my $alertemail = `cat /etc/stabile/nodeconfig.cfg | grep ALERT_EMAIL | cut -f2 -d "="`;
1746
            `/bin/echo "#!/bin/bash\n\n/usr/local/bin/lsi.sh checkNemail $alertemail" > /etc/cron.hourly/lsicheck.sh`;
1747
            $res .= "Adding hourly cron check of LSI raid";
1748
            print "$res\n";
1749
            `/bin/echo "#!/bin/bash\n\n/usr/local/bin/lsi.sh status | mail -s \\"$hostname LSI status\\" $alertemail" > /etc/cron.weekly/lsistatus.sh`;
1750
            #}
1751
        }
1752
    } else {
1753
        $res = "No local disk";
1754
        print "$res\n";
1755
    }
1756
    return $res;
1757
}
1758

    
1759
sub dont_die {
1760
    print "We trudge along\n";
1761
}
1762

    
1763
sub run_in_bg {
1764
    my ($cmd) = @_;
1765
    my $proc1 = Proc::Background->new($cmd);
1766
}
1767

    
1768
sub setCgroups {
1769
    if (-d "/sys/fs/cgroup") {
1770
        print `cgconfigparser -l /etc/stabile/cgconfig.conf`;
1771
    } else {
1772
        print "cgroups are not enabled!!\n";
1773
    }
1774
}
1775

    
1776
sub updateInterfaces {
1777
    if ($identity eq 'local_kvm' || -e "/etc/stabile/config.cfg") {
1778
        unless (`ifconfig | grep "inet 10\.0\.0\.1"`) {
1779
#            print "Adding 10.0.0.1 as to $datanic\n";
1780
#            `ifconfig $datanic:1 10.0.0.1/24 up`;
1781
            print "Adding 10.0.0.1 as to $adminnic\n";
1782
            `ifconfig $adminnic:1 10.0.0.1/24 up`;
1783
            `steamExec post-wake`;
1784
        }
1785
    }
1786
}
1787

    
1788
# Enumerate and return network interfaces
1789
sub getNics {
1790
    my $droute = `ip route show default`;
1791
    my $internalnic = $1 if ($droute =~ /default via .+ dev (.+) proto/); # On the node, default route is on the internal network
1792
    # First get all nics and activate link on ethers - for some reason Ubuntu puts them down if they are not configured with an IP
1793
    my $niclist = `ifconfig -a | grep flags= | sed -n -e 's/: .*//p'`;
1794
    foreach my $line (split("\n", $niclist)) {
1795
        my $nic = $1 if ($line =~ /(\S+)/);
1796
        if ($nic=~/^en/) {
1797
            `ifconfig $nic up`;
1798
        }
1799
    }
1800
    sleep 1;
1801
    # Then list those that are up i.e. have link
1802
    my $niclist = `ifconfig | grep flags= | sed -n -e 's/: .*//p'`;
1803
    # my $niclist = `netstat -in`;
1804
    my @nics = ();
1805
    push @nics, $internalnic if ($internalnic);
1806
    foreach my $line (split("\n", $niclist)) {
1807
        my $nic = $1 if ($line =~ /(\S+)/);
1808
        if ($nic ne 'lo' && $nic ne $internalnic && !($nic=~/^virbr/) && !($nic=~/^docker/) && !($nic=~/^br/) && !($nic=~/^vnet/) && !($nic=~/^Name/) && !($nic=~/^Kernel/) && !($nic=~/^Iface/) && !($nic=~/(\.|\:)/)) {
1809
            push @nics, $1;
1810
        }
1811
    }
1812
    $internalnic = $nics[0] unless ($internalnic);
1813
    my $externalnic = $internalnic;
1814
    $externalnic = $nics[1] if (scalar @nics > 1);
1815
    if ($identity eq 'local_kvm') { # local_kvm uses external NIC for vlans and internal NIC for 10.0.0.1
1816
        return ($externalnic, $internalnic);
1817
    } else {
1818
        return ($internalnic, $externalnic);
1819
    }
1820
}
1821

    
1822
sub TERMINATE {
1823
	$running = 0;
1824
	$status = "shutdown" unless ($status eq "asleep");
1825
    $glogentry = "--: nodes: $nmac: $status: Shutting down $identity piston...";
1826
	updatePistonInfo();
1827
	logit("debug", "Shutting down");
1828
	if ($identity eq "vbox") {
1829
        logit('info', "Shutting down Virtual Box piston");
1830
        print `/etc/init.d/vboxdrv stop`,"\n";
1831
	} else {
1832
        logit('info', "Shutting down KVM piston");
1833
        print `/etc/init.d/kvm stop`,"\n";
1834
	}
1835
	##logit("debug", `killall movepiston`);
1836
	##exit(0);
1837
}
1838

    
1839
##
(11-11/27)