|
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
|
my $running = 1;
|
|
124
|
my $dostats = 1;
|
|
125
|
my $dogpus = 0;
|
|
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
|
my $gpucount = 0;
|
|
138
|
my $gpusfree = 0;
|
|
139
|
my $vmemory = 0;
|
|
140
|
my @gpus; # Keep track of GPUs
|
|
141
|
|
|
142
|
if ($identity eq "vbox") {$virshemu = 'vbox'};
|
|
143
|
|
|
144
|
my @domstates = ("nostate", "running", "blocked", "paused", "shutdown", "shutoff", "crashed");
|
|
145
|
|
|
146
|
my $browser = LWP::UserAgent->new;
|
|
147
|
if ($identity eq 'local_kvm') {
|
|
148
|
$browser->local_address("10.0.0.1");
|
|
149
|
}
|
|
150
|
$browser->agent('movepiston/1.0b');
|
|
151
|
$browser->protocols_allowed( [ 'http','https'] );
|
|
152
|
$browser->credentials(
|
|
153
|
"$mainvalve:80",
|
|
154
|
'Services',
|
|
155
|
'irigo', $mainvalvepwd
|
|
156
|
);
|
|
157
|
|
|
158
|
my $ifinfo;
|
|
159
|
if (`ifconfig $adminnic`) {
|
|
160
|
$ifinfo = `ifconfig $adminnic`;
|
|
161
|
} else {
|
|
162
|
print "NIC $adminnic is not availaible on this node\n";
|
|
163
|
die;
|
|
164
|
}
|
|
165
|
my $mac;
|
|
166
|
$mac = $1 if ($ifinfo =~ /HWaddr (\S+)(\s*)\n/);
|
|
167
|
$mac = $1 if ($ifinfo =~ /ether (\S+)(\s*)/);
|
|
168
|
my $nmac = $mac;
|
|
169
|
$nmac =~ tr/://d;
|
|
170
|
print "Using mac $mac as id for this node\n";
|
|
171
|
|
|
172
|
if ($identity eq "local_kvm" && $nmac ne $cfg->param('MAC')) {
|
|
173
|
$identity = '';
|
|
174
|
print "Network interface change detected - rejoining\n";
|
|
175
|
}
|
|
176
|
|
|
177
|
|
|
178
|
my $hostname = $mac;
|
|
179
|
$mac = uri_escape($mac);
|
|
180
|
$hostname =~ tr/://d;
|
|
181
|
$hostname = "piston" . $hostname;
|
|
182
|
$ifinfo =~ m/inet (\S+) (.*)\n/i;
|
|
183
|
my $ip = $1;
|
|
184
|
my $glogentry = "--: nodes: $nmac: running: Bringing up $identity piston...";
|
|
185
|
my $command;
|
|
186
|
|
|
187
|
# Load IPMI modules
|
|
188
|
`modprobe ipmi_devintf`;
|
|
189
|
my $ipmiip;
|
|
190
|
unless (system("modprobe ipmi_si")) {
|
|
191
|
my $ipmiinfo = `/usr/bin/ipmitool lan print 1`;
|
|
192
|
if ($ipmiinfo =~ m/IP Address .+: (.+)\n/i) {
|
|
193
|
$ipmiip = $1;
|
|
194
|
}
|
|
195
|
} else {
|
|
196
|
print "IPMI is not available on this node\n";
|
|
197
|
}
|
|
198
|
|
|
199
|
# Disable offloading to NIC - at least for our mini-ITX boards this prevents crashes
|
|
200
|
print `ethtool -K $adminnic gso off gro off tso off`;
|
|
201
|
print `ethtool -K $datanic gso off gro off tso off` if ($adminnic ne $datanic);
|
|
202
|
|
|
203
|
# Prevent VM's using Libvirt's default network to reach each other + infrastructure
|
|
204
|
`modprobe br_netfilter` unless (`lsmod | grep br_netfilter`);
|
|
205
|
`echo 1 > /proc/sys/net/bridge/bridge-nf-call-iptables`;
|
|
206
|
`iptables -D FORWARD --in-interface virbr0 -d 192.168.0.0/16 -j DROP 2>/dev/null`;
|
|
207
|
`iptables -I FORWARD --in-interface virbr0 -d 192.168.0.0/16 -j DROP`;
|
|
208
|
`iptables -D FORWARD --in-interface virbr0 -d 10.0.0.0/8 -j DROP 2>/dev/null`;
|
|
209
|
`iptables -I FORWARD --in-interface virbr0 -d 10.0.0.0/8 -j DROP`;
|
|
210
|
|
|
211
|
my $stor;
|
|
212
|
my $test;
|
|
213
|
$debug;
|
|
214
|
$debug = 1 if ($ARGV[0] eq 'debug' || $ARGV[0] eq 'stats' || $ARGV[0] eq 'test' || $ARGV[1] eq 'debug' || $ARGV[1] eq 'stats');
|
|
215
|
$dostats = 0 if ($ARGV[0] eq 'nostats' || $ARGV[1] eq 'nostats');
|
|
216
|
|
|
217
|
my $badstrokes = "/tmp/badstrokes"; # Keeping track of bad, crashing tasks
|
|
218
|
my $tombstones = "/tmp/tombstones"; # Keep track of destroyed servers
|
|
219
|
|
|
220
|
`rm /tmp/movepiston.out` if (-e "/tmp/movepiston.out");
|
|
221
|
`chmod 666 /dev/zfs` if (-e '/dev/zfs'); # TODO: This should be removed once we upgrade to Bionic and zfs allow is supported
|
|
222
|
|
|
223
|
while ($running) {
|
|
224
|
if ($ARGV[0] eq 'stop') {
|
|
225
|
TERMINATE();
|
|
226
|
} elsif ($ARGV[0] =~ /^command=(.+)/) {
|
|
227
|
$command = $1;
|
|
228
|
if ($command =~ /(backup\..+)/ && -e "/tmp/$1") {
|
|
229
|
my $backuptasks = $1;
|
|
230
|
# logit('info', "Performing command $command $ARGV[1] $ARGV[2] $ARGV[3] $ARGV[4] $ARGV[5] $ARGV[6]");
|
|
231
|
my $lines = `cat /tmp/$backuptasks`;
|
|
232
|
chomp $lines;
|
|
233
|
unlink("/tmp/$backuptasks");
|
|
234
|
my @clines = split /\n/, $lines;
|
|
235
|
foreach my $line (@clines) {
|
|
236
|
logit('info', "Backing up: $line");
|
|
237
|
my @args = shellwords($line);
|
|
238
|
backup($args[0], $args[1], $args[2], $args[3], $args[4],$args[5]);
|
|
239
|
}
|
|
240
|
# backup($ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4], $ARGV[5], $ARGV[6]);
|
|
241
|
}
|
|
242
|
} elsif ($ARGV[0] eq 'testmove' && $identity) {
|
|
243
|
my $devs = listCopyDisks($ARGV[1]);
|
|
244
|
print Dumper($devs);
|
|
245
|
TERMINATE();
|
|
246
|
} elsif ($ARGV[0] eq 'test' && $identity) {
|
|
247
|
$test = 1;
|
|
248
|
initializeLocalDisk($initdisk) if ($initdisk && $identity ne 'local_kvm');
|
|
249
|
updatePistonInfo();
|
|
250
|
TERMINATE();
|
|
251
|
} elsif ($ARGV[0] eq 'stats' && $identity) {
|
|
252
|
$test = 1;
|
|
253
|
updatePistonStats();
|
|
254
|
$running = 0;
|
|
255
|
} elsif ($identity eq "kvm" || $identity eq "local_kvm" || $identity eq "vbox") {
|
|
256
|
$status = "running";
|
|
257
|
$running = 1;
|
|
258
|
if ($identity ne 'local_kvm') {
|
|
259
|
if ($initdisk) {
|
|
260
|
my $res = initializeLocalDisk($initdisk);
|
|
261
|
}
|
|
262
|
print `/bin/hostname $hostname`;
|
|
263
|
print `/bin/echo "127.0.0.1 localhost\n$ip $hostname" > /etc/hosts`;
|
|
264
|
|
|
265
|
my $mounts = `cat /proc/mounts`;
|
|
266
|
if ($mounts =~ /\mnt\/stabile\/node/) {
|
|
267
|
if ($mounts =~ /volgroup1-lvol1/) {
|
|
268
|
$stor = 'lvm';
|
|
269
|
} elsif ($mounts =~ /stabile-node/) {
|
|
270
|
$stor = 'zfs';
|
|
271
|
}
|
|
272
|
}
|
|
273
|
if ($identity eq 'local_kvm') {
|
|
274
|
logit('info', "Local kvm - not initializing cgroups");
|
|
275
|
} elsif (!$cgset) {
|
|
276
|
setCgroups();
|
|
277
|
$cgset = 1;
|
|
278
|
} else {
|
|
279
|
logit('info', "Unable to initialize cgroups!!");
|
|
280
|
print "Unable to initialize cgroups!!\n";
|
|
281
|
$running = 0;
|
|
282
|
}
|
|
283
|
# restart rsyslog to pick up new hostname
|
|
284
|
print `/sbin/restart rsyslog`;
|
|
285
|
print "Setting clock from $mainvalve\n" unless ($debug);
|
|
286
|
print `/usr/sbin/ntpdate $mainvalve` unless ($debug);
|
|
287
|
print "Known tenders:\n", Dumper(\@tenderlist) if $debug;
|
|
288
|
print "Known tender paths:\n", Dumper(\@tenderpathslist) if $debug;
|
|
289
|
print "Trying to mount " . (scalar @tenderpathslist) . " tenders\n";
|
|
290
|
|
|
291
|
for (my $i=0; $i<(scalar @tenderpathslist); $i++) {
|
|
292
|
my $path = $tenderpathslist[$i];
|
|
293
|
my $host = $tenderlist[$i];
|
|
294
|
if ($mounts =~ m/$path /i) {
|
|
295
|
print ("$path already mounted\n") if ($debug);
|
|
296
|
} elsif ($identity ne 'local_kvm' && $host =~ /10\.0\.0\.1/) {
|
|
297
|
print "Mounting $path from $host\n";
|
|
298
|
logit('info', "Mounting (1) $path from $host");
|
|
299
|
# Directory / mount point must exist
|
|
300
|
`mkdir -p "$path"` unless (-e $path);
|
|
301
|
# eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
|
|
302
|
eval {print `mount -o hard,intr,nolock,noatime,nfsvers=3,tcp,timeo=1200,rsize=1048600,wsize=1048600,bg $host $path`; 1;} or do {print $@;};
|
|
303
|
}
|
|
304
|
}
|
|
305
|
`chmod 777 /mnt/stabile/*`;
|
|
306
|
}
|
|
307
|
if ($identity eq "kvm") {
|
|
308
|
logit('info', "Bringing up KVM piston $nmac");
|
|
309
|
} elsif ($identity eq "local_kvm") {
|
|
310
|
logit('info', "Bringing up local KVM piston $nmac");
|
|
311
|
} elsif ($identity eq "vbox") {
|
|
312
|
logit('info', "Bringing up Virtual Box piston $nmac");
|
|
313
|
print `/etc/init.d/vboxdrv start`,"\n";
|
|
314
|
}
|
|
315
|
$vmemory = `cat /tmp/vmemory` if (-e "/tmp/vmemory");
|
|
316
|
chomp $vmemory;
|
|
317
|
@gpus = listGpus(1, (($vmemory)?0:1));
|
|
318
|
foreach my $gpu (@gpus) {
|
|
319
|
$gpucount++ unless ($gpu->{error});
|
|
320
|
# $gpusfree is counted in listGpus
|
|
321
|
# $gpusfree++ if (!$gpu->{error} && $gpu->{detached} && $gpu->{available});
|
|
322
|
$vmemory = $gpu->{vram} if (!$gpu->{error} && $gpu->{vram} && ($vmemory==0 || $gpu->{vram}<=$vmemory)); # report the vram of the card with least
|
|
323
|
}
|
|
324
|
print "Found $gpucount total GPUs, $gpusfree available";
|
|
325
|
if ($vmemory) {
|
|
326
|
print ", with a minimum of " . ($vmemory) . " MB each";
|
|
327
|
`echo $vmemory > /tmp/vmemory`;
|
|
328
|
}
|
|
329
|
print "\n";
|
|
330
|
|
|
331
|
my $failedtasks;
|
|
332
|
if (-e $badstrokes && !(-z $badstrokes)) {
|
|
333
|
$failedtasks = `cat $badstrokes`;
|
|
334
|
logit('info', "A previous attempt at executing tasks failed:\n$failedtasks");
|
|
335
|
print "Trying to execute again.\n";
|
|
336
|
updatePistonInfo($failedtasks) if ($failedtasks =~ m/^\S+=(.*)/ig);
|
|
337
|
unlink($badstrokes);
|
|
338
|
}
|
|
339
|
if (-e $tombstones && !(-z $tombstones)) {
|
|
340
|
my $hashref = retrieve($tombstones);
|
|
341
|
%mortuary = %{$hashref};
|
|
342
|
logit('info', "A list of previously destroyed domains was found: " . Dumper(%mortuary));
|
|
343
|
}
|
|
344
|
while ($running) {
|
|
345
|
try {
|
|
346
|
$running = updatePistonInfo();
|
|
347
|
if ($dogpus) {
|
|
348
|
$dogpus++;
|
|
349
|
my $tgpusfree = $gpusfree;
|
|
350
|
@gpus = listGpus(1, (($vmemory)?0:1));
|
|
351
|
$dogpus = 0 if ($tgpusfree != $gpusfree || $dogpus>20); # We're expecting a change
|
|
352
|
}
|
|
353
|
if ($dostats && (time() > $laststatstime + $statsnap)) {
|
|
354
|
# `sync; echo 3 > /proc/sys/vm/drop_caches`; # Clean up
|
|
355
|
$laststatstime = time();
|
|
356
|
updatePistonStats();
|
|
357
|
@gpus = listGpus(1, (($vmemory)?0:1));
|
|
358
|
}
|
|
359
|
sleep $naptime;
|
|
360
|
drowse();
|
|
361
|
} catch Error with {
|
|
362
|
my $ex = shift;
|
|
363
|
print "Internal Error: $ex\n";
|
|
364
|
} finally {
|
|
365
|
};
|
|
366
|
}
|
|
367
|
} elsif ($identity eq "rescue") {
|
|
368
|
logit('info', "Bringing up rescue piston");
|
|
369
|
$status = "running";
|
|
370
|
$running = 1;
|
|
371
|
while ($running) {
|
|
372
|
sleep $naptime;
|
|
373
|
}
|
|
374
|
} else {
|
|
375
|
logit('info', "No identity: $identity Joining the engine...");
|
|
376
|
updateInterfaces();
|
|
377
|
$status = "joining";
|
|
378
|
my $cpuinfo = `cat /proc/cpuinfo`;
|
|
379
|
$cpuinfo =~ m/model name.*:\s*(.*)\n/i;
|
|
380
|
my $cpuname = $1;
|
|
381
|
$cpuname =~ s/( )+//g;
|
|
382
|
$cpuinfo =~ m/cpu family.*:\s*(.*)\n/i;
|
|
383
|
my $cpufamily = $1;
|
|
384
|
$cpuinfo =~ m/model.*:\s*(.*)\n/i;
|
|
385
|
my $cpumodel = $1;
|
|
386
|
$cpuinfo =~ m/cpu MHz.*:\s*(.*)\n/i;
|
|
387
|
my $cpuspeed = $1;
|
|
388
|
my $cpucores = "1";
|
|
389
|
if ($cpuinfo =~ m/cpu cores.*:\s*(.+)\n/i) {
|
|
390
|
$cpucores = $1;
|
|
391
|
} elsif ($cpuinfo =~ m/siblings.*:\s*(.+)\n/i) {
|
|
392
|
$cpucores = $1;
|
|
393
|
}
|
|
394
|
my $cpucount = 0;
|
|
395
|
while ($cpuinfo =~ /physical id.*: (.+)\n/gi) {
|
|
396
|
if ($1 > $cpucount) {
|
|
397
|
$cpucount = $1;
|
|
398
|
}
|
|
399
|
}
|
|
400
|
$cpucount++;
|
|
401
|
my $meminfo = `cat /proc/meminfo`;
|
|
402
|
$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
|
|
403
|
my $memtotal = $1;
|
|
404
|
$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
|
|
405
|
my $memfree = $1;
|
|
406
|
$meminfo =~ m/Cached:\s*(.*) kB\n/i;
|
|
407
|
my $memcached = $1;
|
|
408
|
$memfree += $memcached; # or `echo 3 > /proc/sys/vm/drop_caches` to free caches
|
|
409
|
|
|
410
|
my $logentry = "--: nodes: $nmac: joining: Trying to join";
|
|
411
|
my $url = $base_url . "?mac=$mac&ip=$ip&cpucores=$cpucores&cpucount=$cpucount&gpucount=$gpucount&gpusfree=$gpusfree&cpuspeed=$cpuspeed&cpuname=" .
|
|
412
|
uri_escape("$cpuname") . "&ipmiip=" . uri_escape($ipmiip) .
|
|
413
|
"&cpufamily=$cpufamily&cpumodel=$cpumodel&memtotal=$memtotal&memfree=$memfree&vmem=$vmemory&status=joining&logentry=" .
|
|
414
|
$logentry;
|
|
415
|
|
|
416
|
my $assimilated = 0;
|
|
417
|
my $i = 0;
|
|
418
|
while ($assimilated == 0) {
|
|
419
|
my $content = $browser->get($url)->content();
|
|
420
|
logit('info', "Waiting for assimilation...");
|
|
421
|
if (defined $content) {
|
|
422
|
my $assimilation_status = "";
|
|
423
|
if ($content =~ /Assimilation=(\S*)(.*)/i) {
|
|
424
|
$assimilation_status = $1;
|
|
425
|
$assimilation_reason = $2;
|
|
426
|
if ($assimilation_status eq "OK") {
|
|
427
|
$assimilated = 1;
|
|
428
|
} else {
|
|
429
|
logit('info', "Assimilation not accepted: $assimilation_status$assimilation_reason");
|
|
430
|
sleep 2;
|
|
431
|
if ($i>2) {last} else {$i++};
|
|
432
|
}
|
|
433
|
} else {
|
|
434
|
logit('info', "Assimilation answer not received: $content");
|
|
435
|
sleep 2;
|
|
436
|
if ($i>2) {last} else {$i++};
|
|
437
|
}
|
|
438
|
} else {
|
|
439
|
logit('info', "Couldn't get $url:");
|
|
440
|
sleep 2;
|
|
441
|
if ($i>2) {last} else {$i++};
|
|
442
|
}
|
|
443
|
}
|
|
444
|
if ($assimilated == 1) {
|
|
445
|
if (-e "/etc/stabile/config.cfg") { # We are on valve
|
|
446
|
$identity = 'local_kvm';
|
|
447
|
} else {
|
|
448
|
$identity = 'kvm';
|
|
449
|
}
|
|
450
|
$cfg->param("IDENTITY", $identity);
|
|
451
|
$cfg->param("MAC", $nmac);
|
|
452
|
$cfg->save();
|
|
453
|
logit('info', "Assimilation completed...");
|
|
454
|
}
|
|
455
|
}
|
|
456
|
}
|
|
457
|
1;
|
|
458
|
|
|
459
|
|
|
460
|
sub updatePistonInfo {
|
|
461
|
my $failedtasks = shift;
|
|
462
|
logit('info', "Updating piston info...") if ($debug);
|
|
463
|
$naptime = 5;
|
|
464
|
my $pid;
|
|
465
|
|
|
466
|
my $cpuload = `cat /proc/loadavg`;
|
|
467
|
$cpuload =~ m/(\S*) /i;
|
|
468
|
$cpuload = $1;
|
|
469
|
my $cpucores = "1";
|
|
470
|
my $cpuinfo = `cat /proc/cpuinfo`;
|
|
471
|
if ($cpuinfo =~ m/cpu cores.*:\s*(.+)\n/i) {
|
|
472
|
$cpucores = $1;
|
|
473
|
} elsif ($cpuinfo =~ m/siblings.*:\s*(.+)\n/i) {
|
|
474
|
$cpucores = $1;
|
|
475
|
}
|
|
476
|
my $cpucount = 0;
|
|
477
|
while ($cpuinfo =~ /physical id.*: (.+)\n/gi) {
|
|
478
|
if ($1 > $cpucount) {
|
|
479
|
$cpucount = $1;
|
|
480
|
}
|
|
481
|
}
|
|
482
|
$cpucount++;
|
|
483
|
my $meminfo = `cat /proc/meminfo`;
|
|
484
|
$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
|
|
485
|
my $memtotal = $1;
|
|
486
|
$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
|
|
487
|
my $memfree = $1;
|
|
488
|
$meminfo =~ m/Cached:\s*(.*) kB\n/i;
|
|
489
|
my $memcached = $1;
|
|
490
|
$memfree += $memcached; # or `echo 3 > /proc/sys/vm/drop_caches` to free caches
|
|
491
|
$status = "shutdown" unless ($running || $status eq "asleep");
|
|
492
|
|
|
493
|
my $nfsroot;
|
|
494
|
$nfsroot = uri_escape($1) if ($cmdline =~ m/ nfsroot=(\S+) /);
|
|
495
|
my $kernel;
|
|
496
|
$kernel = uri_escape($1) if ($cmdline =~ m/BOOT_IMAGE=(\S+) /);
|
|
497
|
|
|
498
|
# Bring up local interfaces if it has been lost because of S3 sleep
|
|
499
|
updateInterfaces();
|
|
500
|
|
|
501
|
# piston.cgi gets the ip from the http request
|
|
502
|
#my $ipline = `ip -br addr show $adminnic`;
|
|
503
|
#chomp $ipline;
|
|
504
|
#my $ip;
|
|
505
|
#$ip = $1 if ($ipline =~ /\d+\.\d+\.\d+\.\d+\/24/);
|
|
506
|
|
|
507
|
# my $virshlist = `virsh -c $virshemu:///system list`;
|
|
508
|
logit('info', "Initializing libvirt connection: $virshemu:///system") if ($debug);
|
|
509
|
my $vmm = Sys::Virt->new(address => "$virshemu:///system");# unless $vmm;
|
|
510
|
logit('info', "Getting dominfo from: $virshemu:///system") if ($debug);
|
|
511
|
|
|
512
|
# Load domain info into $dinfo
|
|
513
|
my $dinfo = dominfo($vmm);
|
|
514
|
|
|
515
|
# Put node info into $dinfo
|
|
516
|
$dinfo->{'status'} = $status;
|
|
517
|
$dinfo->{'mac'} = $mac;
|
|
518
|
#$dinfo->{'ip'} = $ip;
|
|
519
|
$dinfo->{'memtotal'} = $memtotal;
|
|
520
|
$dinfo->{'memfree'} = $memfree;
|
|
521
|
$dinfo->{'identity'} = $identity;
|
|
522
|
$dinfo->{'nfsroot'} = $nfsroot;
|
|
523
|
$dinfo->{'kernel'} = $kernel;
|
|
524
|
$dinfo->{'cpuload'} = $cpuload;
|
|
525
|
$dinfo->{'cpucount'} = $cpucount;
|
|
526
|
$dinfo->{'cpucores'} = $cpucores;
|
|
527
|
$dinfo->{'gpucount'} = $gpucount+0;
|
|
528
|
$dinfo->{'gpusfree'} = $gpusfree+0;
|
|
529
|
$dinfo->{'vmem'} = $vmemory+0; # the nvram of the card with the least nvram
|
|
530
|
$dinfo->{'ipmiip'} = uri_escape($ipmiip);
|
|
531
|
|
|
532
|
# Local storage info
|
|
533
|
my $stortotal = "0";
|
|
534
|
my $storfree = "0";
|
|
535
|
my $esc_path = ($identity eq 'local_kvm')?$tenderpathslist[0]:'/mnt/stabile/node';
|
|
536
|
my $storinfo = `df -kl $esc_path`;
|
|
537
|
if (!($storinfo=~/aufs/) && $storinfo =~ m/\s+(\d+)\s+(\d+)\s+(\d+).+\n/si) {
|
|
538
|
$stortotal = $1;
|
|
539
|
$storfree = $3;
|
|
540
|
}
|
|
541
|
# Load storage info into $dinfo
|
|
542
|
print "Getting storage info\n" if ($debug);
|
|
543
|
if (time() > $laststortime + $stornap) {
|
|
544
|
$laststortime = time();
|
|
545
|
|
|
546
|
# Local image sizes
|
|
547
|
my @thefiles = recurse($basedir);
|
|
548
|
my $j = 0;
|
|
549
|
foreach my $f (@thefiles) {
|
|
550
|
if ($f =~ /(s\d\d\d\.vmdk$)|(-flat\.vmdk$)/) {
|
|
551
|
;
|
|
552
|
} elsif($f =~ /(\.vmdk$)|(\.img$)|(\.vhd$)|(\.qcow$)|(\.qcow2$)|(\.vdi$)|(\.iso$)/i) {
|
|
553
|
$j++;
|
|
554
|
my($fname, $dirpath, $suffix) = fileparse($f, (".vmdk", ".img", ".vhd", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
555
|
$dirpath =~ /$basedir\/([^\/]+)/;
|
|
556
|
my $user = $1;
|
|
557
|
# Deal with sizes
|
|
558
|
($newsize, $newrealsize, $newvirtualsize, $newmtime) = getSizes($f, $mtimes{$f});
|
|
559
|
if ($newmtime) {
|
|
560
|
$mtimes{$f} = $newmtime;
|
|
561
|
$img_sizes{$f} = $newsize;
|
|
562
|
$img_realsizes{$f} = $newrealsize;
|
|
563
|
$img_virtualsizes{$f} = $newvirtualsize;
|
|
564
|
}
|
|
565
|
$dinfo->{"img$j"} = uri_escape($f);
|
|
566
|
$dinfo->{"size$j"} = $img_sizes{$f};
|
|
567
|
$dinfo->{"realsize$j"} = $img_realsizes{$f};
|
|
568
|
$dinfo->{"virtualsize$j"} = $img_virtualsizes{$f};
|
|
569
|
|
|
570
|
if (-e "$f.meta" && `grep backingup "$f.meta"` && !(`pgrep "$f.meta"`)) {
|
|
571
|
unlink "$f.meta";
|
|
572
|
$mes = "Backup aborted ($fname)";
|
|
573
|
logit('err', "Backup of $f aborted for user $user");
|
|
574
|
my $logentry = "$user: images: $f: unused: $mes";
|
|
575
|
|
|
576
|
# Update the client UI
|
|
577
|
my $url = $base_url . "?mac=$mac&status=updateui&logentry=" . uri_escape($logentry);
|
|
578
|
print "Updating image registry: $url\n" if ($debug);
|
|
579
|
my $content = $browser->get($url)->content();
|
|
580
|
print $content;
|
|
581
|
}
|
|
582
|
|
|
583
|
}
|
|
584
|
}
|
|
585
|
$dinfo->{"stortotal"} = $stortotal;
|
|
586
|
$dinfo->{"storfree"} = $storfree;
|
|
587
|
$dinfo->{"stor"} = $stor;
|
|
588
|
}
|
|
589
|
|
|
590
|
if($failedtasks) {
|
|
591
|
logit('info', "Not posting node status - we have failed tasks: " . Dumper($dinfo)) if ($debug);
|
|
592
|
$content = $failedtasks; # content restored from previous crash was supplied
|
|
593
|
$glogentry = "--: nodes: $nmac: $status: Brought up piston with failed tasks...";
|
|
594
|
} else {
|
|
595
|
$dinfo->{'logentry'} = uri_escape($glogentry) if ($glogentry);
|
|
596
|
logit('info', "Posting node status to URL: $base_url: " . Dumper($dinfo)) if ($debug);
|
|
597
|
$content = $browser->post($base_url, $dinfo)->content();
|
|
598
|
$glogentry = '';
|
|
599
|
}
|
|
600
|
|
|
601
|
if ($test || $debug) {
|
|
602
|
print pretty_time(), ": ", $content if ($debug);
|
|
603
|
};
|
|
604
|
# my $debugline = pretty_time() . ": " . $content;
|
|
605
|
# open TEMP3, ">>/tmp/movepiston.out";
|
|
606
|
# print TEMP3 $debugline;
|
|
607
|
# close TEMP3;
|
|
608
|
|
|
609
|
my $task_1 = '';
|
|
610
|
my $task_2 = '';
|
|
611
|
my $task_3 = '';
|
|
612
|
|
|
613
|
if (defined $content) {
|
|
614
|
my @receiveuuids;
|
|
615
|
my @storreceiveuuids;
|
|
616
|
my @clines = split /\n/, $content;
|
|
617
|
my @lines;
|
|
618
|
foreach my $line (@clines) {
|
|
619
|
if ($line =~ m/^\S+=SLEEPAFTER (\d+)/ig) {
|
|
620
|
$sleepafter = int($1);
|
|
621
|
} elsif ($line =~ m/^\S+=.+/ig) {
|
|
622
|
push(@lines, $line);
|
|
623
|
}
|
|
624
|
}
|
|
625
|
while (my $line = shift @lines) {
|
|
626
|
$url = $base_url . "?mac=$mac&identity=$identity";
|
|
627
|
|
|
628
|
my $rcontent = join("\n", @lines);
|
|
629
|
`echo "$rcontent" > $badstrokes` if (@lines);
|
|
630
|
$line =~ m/^\S+=(.*)/ig;
|
|
631
|
@tasks = shellwords($1);
|
|
632
|
$task_1 = $tasks[0]; #$1;
|
|
633
|
$task_2 = $tasks[1]; #$2;
|
|
634
|
$task_3 = $tasks[2]; #$3;
|
|
635
|
if ($task_1 eq "REBOOT" && $identity ne 'local_kvm') {
|
|
636
|
$status = "reboot";
|
|
637
|
my $logentry = "$task_2: nodes: $nmac: $status: Reboot request received - rebooting";
|
|
638
|
logit('info', $logentry);
|
|
639
|
$url .= "&status=$status&logentry=" . uri_escape($logentry);
|
|
640
|
my $newcontent = $browser->get($url)->content();
|
|
641
|
print `/sbin/reboot`;
|
|
642
|
chop $@; $logentry .= "\n$@" if $@;
|
|
643
|
if ($@) {
|
|
644
|
chop $@; $logentry .= "\n$@";
|
|
645
|
$newcontent = $browser->get($url)->content();
|
|
646
|
}
|
|
647
|
}
|
|
648
|
elsif ($task_1 eq "HALT" && $identity ne 'local_kvm') {
|
|
649
|
$status = "shutdown";
|
|
650
|
my $logentry = "$task_2: nodes: $nmac: $status: Halt request received - shutting down";
|
|
651
|
logit('info', $logentry);
|
|
652
|
$url .= "&status=$status&logentry=" . uri_escape($logentry);
|
|
653
|
my $newcontent = $browser->get($url)->content();
|
|
654
|
sleep 5;
|
|
655
|
print `systemctl stop movepiston`;
|
|
656
|
`echo 0 > /proc/sys/kernel/hung_task_timeout_secs`;
|
|
657
|
print `poweroff`;
|
|
658
|
if ($@) {
|
|
659
|
chop $@; $logentry .= "\n$@";
|
|
660
|
$newcontent = $browser->get($url)->content();
|
|
661
|
}
|
|
662
|
}
|
|
663
|
elsif ($task_1 eq "SLEEP" && $identity ne 'local_kvm') {
|
|
664
|
if ($identity eq "kvm") {
|
|
665
|
logit('info', "Taking down KVM piston");
|
|
666
|
} elsif ($identity eq "vbox") {
|
|
667
|
logit('info', "Taking down Virtual Box piston");
|
|
668
|
}
|
|
669
|
$status = "asleep";
|
|
670
|
my $logentry = "$task_2: nodes: $nmac: $status: Sleep request received - putting node to sleep";
|
|
671
|
logit('info', $logentry);
|
|
672
|
$running = 0;
|
|
673
|
$url .= "&status=$status&logentry=" . uri_escape($logentry);
|
|
674
|
my $newcontent = $browser->get($url)->content();
|
|
675
|
sleep 5;
|
|
676
|
# my $meminfo = `cat /proc/acpi/sleep`;
|
|
677
|
# my $s3sleep = ($meminfo =~ m/S3/);
|
|
678
|
|
|
679
|
my $meminfo = `cat /sys/power/state`;
|
|
680
|
my $s3sleep = ($meminfo =~ m/mem/);
|
|
681
|
|
|
682
|
if (0 && $s3sleep) {
|
|
683
|
print `/etc/init.d/libvirt-bin stop`,"\n" if ($identity eq "vbox");
|
|
684
|
#print `/etc/acpi/sleep.sh`;
|
|
685
|
print `/bin/echo -n "mem" > /sys/power/state`;
|
|
686
|
} else {
|
|
687
|
print `systemctl stop movepiston`;
|
|
688
|
`echo 0 > /proc/sys/kernel/hung_task_timeout_secs`;
|
|
689
|
print `poweroff`;
|
|
690
|
# print `/sbin/shutdown -P now`;
|
|
691
|
}
|
|
692
|
}
|
|
693
|
elsif ($task_1 eq "WAKE" && $identity ne 'local_kvm') {
|
|
694
|
$status = "awake";
|
|
695
|
my $logentry = "$task_2: nodes: $nmac: $status: Wake request received - now awake";
|
|
696
|
logit('info', $logentry);
|
|
697
|
$url .= "&status=$status&logentry=" . uri_escape($logentry);
|
|
698
|
my $newcontent = $browser->get($url)->content();
|
|
699
|
}
|
|
700
|
elsif ($task_1 eq "WIPE" && $identity ne 'local_kvm') {
|
|
701
|
my $logentry = "$task_2: nodes: $nmac: $status: Wipe request received";
|
|
702
|
logit('info', $logentry);
|
|
703
|
my $url2 = "$url&status=$status&logentry=" . uri_escape($logentry);
|
|
704
|
my $newcontent = $browser->get($url2)->content();
|
|
705
|
my $res = initializeLocalDisk($initdisk, 1);
|
|
706
|
$logentry = "$task_2: nodes: $nmac: $status: $res";
|
|
707
|
logit('info', $logentry);
|
|
708
|
$url2 = "$url&status=$status&logentry=" . uri_escape($logentry);
|
|
709
|
$newcontent = $browser->get($url2)->content();
|
|
710
|
}
|
|
711
|
elsif ($task_1 eq "UNJOIN") {
|
|
712
|
$status = "unjoin";
|
|
713
|
my $logentry = "$task_2: nodes: $nmac: $status: Unjoin request received";
|
|
714
|
logit('info', $logentry);
|
|
715
|
$url .= "&status=$status&logentry=" . uri_escape($logentry);
|
|
716
|
my $newcontent = $browser->get($url)->content();
|
|
717
|
print `/sbin/reboot`;
|
|
718
|
}
|
|
719
|
elsif ($task_1 eq "RELOAD") {
|
|
720
|
$status = "reload";
|
|
721
|
my $logentry = "$task_2: nodes: $nmac: $status: Reload request received";
|
|
722
|
logit('info', $logentry);
|
|
723
|
$url .= "&status=$status&logentry=" . uri_escape($logentry);
|
|
724
|
my $newcontent = $browser->get($url)->content();
|
|
725
|
$running = 0;
|
|
726
|
`/bin/systemctl restart movepiston`;
|
|
727
|
}
|
|
728
|
# Reload cgroups
|
|
729
|
elsif ($task_1 eq "CGLOAD") {
|
|
730
|
setCgroups();
|
|
731
|
$cgset = 1;
|
|
732
|
}
|
|
733
|
elsif ($task_1 eq "SLEEPAFTER") {
|
|
734
|
$sleepafter = int($task_2);
|
|
735
|
}
|
|
736
|
elsif ($task_1 eq "PERMITOPEN") {
|
|
737
|
if ($task_2) {
|
|
738
|
my $logentry = "$task_2: servers: : : Permitopen request received - updating allowed ssh forwards";
|
|
739
|
logit('info', $logentry);
|
|
740
|
# Ask piston.cgi to allow port forwards for user
|
|
741
|
my $newurl = $url . "&status=permitopen&user=$task_2";
|
|
742
|
my $newcontent = $browser->get($newurl)->content();
|
|
743
|
# Clear tasks list
|
|
744
|
#$newurl = $url ."&status=$status";
|
|
745
|
#$newcontent = $browser->get($newurl)->content();
|
|
746
|
}
|
|
747
|
}
|
|
748
|
elsif ($task_1 eq "DESTROY") {
|
|
749
|
$naptime = 1; # Temporarily speed up in order to report back promptly
|
|
750
|
# uuid ~ $task_2, user ~ $task_3
|
|
751
|
my $logentry = "$task_3: servers: $task_2: destroying: Destroy request received";
|
|
752
|
logit('info', $logentry);
|
|
753
|
my $dom;
|
|
754
|
eval {$dom = $vmm->get_domain_by_uuid($task_2);} or do {print $@;};
|
|
755
|
# $dom->destroy();
|
|
756
|
my $virshcmd = "virsh -c $virshemu:///system destroy $task_2";
|
|
757
|
# status is set to -- to prevent redundant UI update from piston.cgi
|
|
758
|
my $nurl = $url . "&status=--&logentry=" . uri_escape($logentry);
|
|
759
|
my $newcontent = $browser->get($nurl)->content();
|
|
760
|
$mortuary{$task_2} = 'destroying';
|
|
761
|
store \%mortuary, $tombstones;
|
|
762
|
run_in_bg($virshcmd) if ($dom);
|
|
763
|
# status is set to -- to prevent redundant UI update from piston.cgi
|
|
764
|
$url .= "&status=--";
|
|
765
|
my $newcontent = $browser->get($url)->content();
|
|
766
|
$dogpus = 1;
|
|
767
|
}
|
|
768
|
elsif ($task_1 eq "SHUTDOWN") {
|
|
769
|
$naptime = 1; # Temporarily speed up in order to report back promptly
|
|
770
|
my $logentry = "$task_3: servers: $task_2: shuttingdown: Shutdown request received";
|
|
771
|
logit('info', $logentry);
|
|
772
|
#my $virshcmd = `echo 'qemu-monitor-command --hmp $task_2 "system_powerdown"' | virsh -c $virshemu:///system`;
|
|
773
|
#print $virshcmd,"\n";
|
|
774
|
#my $virshcmd = "/usr/bin/sudo -u irigo /usr/bin/ssh localhost virsh -c $virshemu:///system shutdown $task_2";
|
|
775
|
my $dom;
|
|
776
|
eval {$dom = $vmm->get_domain_by_uuid($task_2);} or do {print $@;};
|
|
777
|
#$dom->shutdown();
|
|
778
|
#sleep 2;
|
|
779
|
|
|
780
|
my $virshcmd = "virsh -c $virshemu:///system shutdown $task_2";
|
|
781
|
my $nurl = $url . "&status=--&logentry=" . uri_escape($logentry);
|
|
782
|
my $newcontent = $browser->get($nurl)->content();
|
|
783
|
$mortuary{$task_2} = 'shuttingdown';
|
|
784
|
store \%mortuary, $tombstones;
|
|
785
|
run_in_bg($virshcmd) if ($dom);
|
|
786
|
$url .= "&status=--";
|
|
787
|
my $newcontent = $browser->get($url)->content();
|
|
788
|
}
|
|
789
|
elsif ($task_1 eq "SUSPEND") {
|
|
790
|
$naptime = 1; # Temporarily speed up in order to report back promptly
|
|
791
|
my $logentry = "$task_3: servers: $task_2: suspending: Suspend request received";
|
|
792
|
logit('info', $logentry);
|
|
793
|
my $virshcmd = "virsh -c $virshemu:///system suspend $task_2";
|
|
794
|
run_in_bg($virshcmd);
|
|
795
|
$url .= "&status=--&logentry=" . uri_escape($logentry);
|
|
796
|
my $newcontent = $browser->get($url)->content();
|
|
797
|
}
|
|
798
|
elsif ($task_1 eq "RESUME") {
|
|
799
|
$naptime = 1; # Temporarily speed up in order to report back promptly
|
|
800
|
my $logentry = "$task_3: servers: $task_2: resuming: Resume request received";
|
|
801
|
logit('info', $logentry);
|
|
802
|
my $virshcmd = "virsh -c $virshemu:///system resume $task_2";
|
|
803
|
run_in_bg($virshcmd);
|
|
804
|
$url .= "&status=--&logentry=" . uri_escape($logentry);
|
|
805
|
my $newcontent = $browser->get($url)->content();
|
|
806
|
}
|
|
807
|
elsif ($task_1 eq "MOUNT") {
|
|
808
|
$naptime = 1; # Temporarily speed up in order to report back promptly
|
|
809
|
my $user = $task_3;
|
|
810
|
my $cdrom = $tasks[3];
|
|
811
|
my $logentry ="$user: servers: $task_2: mounting: Mount request received - $cdrom" .
|
|
812
|
($cdrom eq "--"?" unmounting cdrom":" mounting $cdrom");
|
|
813
|
logit('info', $logentry);
|
|
814
|
if ($cdrom eq "--") {
|
|
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 emptydrive --forceunmount|;
|
|
820
|
print `$vboxcmd`,"\n";
|
|
821
|
1;
|
|
822
|
} else {
|
|
823
|
# my $dom = $vmm->get_domain_by_uuid($muuid);
|
|
824
|
# $dom->attach_device();
|
|
825
|
my $virshcmd = qq|virsh -c $virshemu:///system attach-device $task_2 $tenderpathslist[0]/ejectcdrom.xml|;
|
|
826
|
print `$virshcmd`,"\n";
|
|
827
|
1;
|
|
828
|
}
|
|
829
|
} or do {print $@;};
|
|
830
|
}
|
|
831
|
} elsif ($cdrom eq "virtio") {
|
|
832
|
$pid = fork();
|
|
833
|
unless ($pid) {
|
|
834
|
eval {
|
|
835
|
my $virshcmd = qq|virsh -c $virshemu:///system detach-device $task_2 $tenderpathslist[0]/mountvirtio.xml|;
|
|
836
|
print `$virshcmd`,"\n";
|
|
837
|
my $virshcmd = qq|virsh -c $virshemu:///system attach-device $task_2 $tenderpathslist[0]/mountvirtio.xml|;
|
|
838
|
print `$virshcmd`,"\n";
|
|
839
|
1;
|
|
840
|
} or do {print $@;};
|
|
841
|
}
|
|
842
|
} else {
|
|
843
|
$pid = fork();
|
|
844
|
unless ($pid) {
|
|
845
|
eval {
|
|
846
|
if ($identity eq "vbox") {
|
|
847
|
my $vboxcmd = qq|VBoxManage storageattach $task_2 --storagectl "IDE Controller" --port 1 --device 0 --type dvddrive --medium "$cdrom" --forceunmount|;
|
|
848
|
print `$vboxcmd`,"\n";
|
|
849
|
1;
|
|
850
|
} else {
|
|
851
|
# my $dom = $vmm->get_domain_by_uuid($muuid);
|
|
852
|
# $dom->attach_disk();
|
|
853
|
my $virshcmd = qq{echo 'attach-disk $task_2 "$cdrom" hdd --mode readonly --type cdrom' | virsh -c $virshemu:///system};
|
|
854
|
print "$virshcmd\n";
|
|
855
|
print `$virshcmd`,"\n";
|
|
856
|
1;
|
|
857
|
}
|
|
858
|
} or do {print $@;};
|
|
859
|
}
|
|
860
|
}
|
|
861
|
chop $@; $logentry .= "\n$@" if $@;
|
|
862
|
$url .= "&status=--";
|
|
863
|
my $newcontent = $browser->get($url)->content();
|
|
864
|
}
|
|
865
|
elsif ($task_1 eq "BACKUP") {
|
|
866
|
my $user = $task_2;
|
|
867
|
my $uistatus = $task_3;
|
|
868
|
my $status = $tasks[3];
|
|
869
|
my $path = $tasks[4];
|
|
870
|
my $backupdir = $tasks[5];
|
|
871
|
my $remolder = $tasks[6];
|
|
872
|
my $targetdir = "$mainvalve\:\:$backupdir";
|
|
873
|
logit("info", "Backup request received $user $uistatus $status \"$path\" \"$targetdir\" $remolder");
|
|
874
|
eval {
|
|
875
|
#`/usr/local/sbin/movepiston command=backup $user $uistatus $status "$path" "$targetdir" &`;
|
|
876
|
|
|
877
|
# my $pid = exec(qq{/usr/local/sbin/movepiston command=backup $user $uistatus $status "$path" "$targetdir" &});
|
|
878
|
|
|
879
|
#my $daemon = Proc::Daemon->new(
|
|
880
|
# child_STDOUT => STDOUT,
|
|
881
|
# child_STDERR => STDERR,
|
|
882
|
# work_dir => '/usr/local/sbin',
|
|
883
|
# exec_command => "/usr/local/sbin/movepiston command=backup $user $uistatus $status \"$path\" \"$targetdir\""
|
|
884
|
# ) or do {logit("info", "ERROR doing backup of $path $@")};
|
|
885
|
#my $pid = $daemon->Init() or do {logit("info", "ERROR performing backup of $path $@")};
|
|
886
|
|
|
887
|
# Line below is the only variant that does not terminate movepiston - not sure why...
|
|
888
|
# my $backupcmd = qq{/usr/local/sbin/movepiston command=backup $user $uistatus $status "$path" "$targetdir" $remolder &};
|
|
889
|
# my $pid = system($backupcmd);
|
|
890
|
my $backupcmd = qq{$user $uistatus $status "$path" "$targetdir" $remolder};
|
|
891
|
my $backuptasks = "backup." . time;
|
|
892
|
`echo '$backupcmd' >> /tmp/$backuptasks`;
|
|
893
|
sleep 1;
|
|
894
|
my $pid = system(qq{/usr/local/sbin/movepiston command=$backuptasks &});
|
|
895
|
1;
|
|
896
|
} or do {print "Error! ", $@;};
|
|
897
|
logit("info", "Backup of \"$path\" running...");
|
|
898
|
}
|
|
899
|
elsif ($task_1 eq "ABORT") {
|
|
900
|
$naptime = 1; # Temporarily speed up in order to report back promptly
|
|
901
|
my $virshcmd = "virsh -c $virshemu:///system list --uuid | grep $task_2";
|
|
902
|
my $cres = `$virshcmd`; chomp $cres;
|
|
903
|
if ($cres) { # domain is actually still running
|
|
904
|
$virshcmd = "virsh -c $virshemu:///system domjobabort $task_2";
|
|
905
|
# run_in_bg($virshcmd);
|
|
906
|
$cres = `$virshcmd 2>\&1`;
|
|
907
|
chomp $cres;
|
|
908
|
my $logentry = "$task_3: servers: $task_2: aborting: Aborting server move $cres";
|
|
909
|
$url .= "&status=--&logentry=" . uri_escape($logentry);
|
|
910
|
my $newcontent = $browser->get($url)->content();
|
|
911
|
`echo "Migration of server $task_2 aborted by user" > /tmp/$task_2.bg.out`;
|
|
912
|
} else {
|
|
913
|
my $logentry = "$task_3: servers: $task_2: aborting: Unable to abort server move (server already moved?)";
|
|
914
|
$url .= "&status=--&logentry=" . uri_escape($logentry);
|
|
915
|
my $newcontent = $browser->get($url)->content();
|
|
916
|
}
|
|
917
|
}
|
|
918
|
elsif ($task_1 eq "MOVE" || $task_1 eq "MOVESTOR") {
|
|
919
|
my $vm = $task_2;
|
|
920
|
my $targethost = $task_3;
|
|
921
|
my $targetmac = $tasks[3];
|
|
922
|
my $user = $tasks[4];
|
|
923
|
my $logentry = "$nmac: servers: $task_2: moving: Now moving to $targethost...";
|
|
924
|
logit('info', $logentry);
|
|
925
|
my $newurl = $url . "&status=--&logentry=" . uri_escape($logentry);
|
|
926
|
my $newcontent = $browser->get($newurl)->content();
|
|
927
|
|
|
928
|
if ($identity eq "vbox") {
|
|
929
|
changeHosts($targethost, "piston$targetmac") or
|
|
930
|
$logentry = "$user: servers: /etc/hosts could not be updated\n".$@."\n"; # probably only needed for KVM but...
|
|
931
|
eval {
|
|
932
|
my $cmd = "/usr/bin/VBoxManage controlvm $vm teleport --host $targethost --port 6000";
|
|
933
|
run_in_bg($cmd);
|
|
934
|
1;
|
|
935
|
} or do {$logentry = "$user: Servers: " . "\n".$@."\n";};
|
|
936
|
} else {
|
|
937
|
changeHosts($targethost, "piston$targetmac") or
|
|
938
|
$logentry = "$user: servers: /etc/hosts could not be updated\n".$@."\n"; # probably only needed for KVM but...
|
|
939
|
my $uriport = 15900 + int(rand(200)); # Choose a random port for live migration
|
|
940
|
my $copystorage = '';
|
|
941
|
my $migratedisks = '';
|
|
942
|
if ($task_1 eq "MOVESTOR") { # We're live migrating storage as well
|
|
943
|
my $disks = listCopyDisks($vm);
|
|
944
|
my $xml;
|
|
945
|
my $copycmd = "--copy-storage-all";
|
|
946
|
foreach my $dev (keys %$disks) {
|
|
947
|
next if ($dev eq 'status' || $dev eq 'xml');
|
|
948
|
my $image = $disks->{$dev}->{image};
|
|
949
|
# We don't migrate data disks away from shared storage
|
|
950
|
unless ($disks->{$dev}->{image} =~ /\/stabile-images\/images\/.*-data\..*\.qcow2/) {
|
|
951
|
if ($image =~ /\/stabile-images\/images/ && $identity eq 'local_kvm') { # Moving image from shared storage to node storage
|
|
952
|
$migratedisks .= ($migratedisks =~ /--migrate-disks/)?",$dev":" --migrate-disks $dev";
|
|
953
|
$xml = $xml || $disks->{xml};
|
|
954
|
my $newimage = $image;
|
|
955
|
$newimage =~ s/\/stabile-images\/images/\/mnt\/stabile\/node/;
|
|
956
|
$xml =~ s/$image/$newimage/;
|
|
957
|
$copycmd = "--copy-storage-inc" if ($disks->{$dev}->{master});
|
|
958
|
} elsif ($image =~ /\/mnt\/stabile\/node/ && $targethost eq '10.0.0.1') { # Moving image from node storage to shared storage
|
|
959
|
$migratedisks .= ($migratedisks =~ /--migrate-disks/)?",$dev":" --migrate-disks $dev";
|
|
960
|
$xml = $xml || $disks->{xml};
|
|
961
|
my $newimage = $image;
|
|
962
|
$newimage =~ s/\/mnt\/stabile\/node/\/stabile-images\/images/;
|
|
963
|
$xml =~ s/$image/$newimage/;
|
|
964
|
$copycmd = "--copy-storage-inc" if ($disks->{$dev}->{master});
|
|
965
|
} elsif ($image =~ /\/mnt\/stabile\/node/ && $targethost ne '10.0.0.1') { # Moving image between nodes
|
|
966
|
$migratedisks .= ($migratedisks =~ /--migrate-disks/)?",$dev":" --migrate-disks $dev";
|
|
967
|
$copycmd = "--copy-storage-inc" if ($disks->{$dev}->{master});
|
|
968
|
}
|
|
969
|
}
|
|
970
|
}
|
|
971
|
if ($xml) {
|
|
972
|
open( FILE, ">/tmp/$vm.xml" ) or { print "unable to open xml file for writing\n" };
|
|
973
|
print FILE $xml;
|
|
974
|
close(FILE);
|
|
975
|
$copystorage .= " --xml /tmp/$vm.xml";
|
|
976
|
}
|
|
977
|
$copystorage .= " $copycmd $migratedisks" if ($migratedisks); # only copy storage if any disks to migrate
|
|
978
|
}
|
|
979
|
my $cmd = "sudo -u irigo virsh -c qemu:///system migrate $copystorage --verbose --migrateuri tcp://$targethost:$uriport --live --unsafe $vm qemu+ssh://$targethost/system";
|
|
980
|
logit('info', $cmd);
|
|
981
|
`echo "$targethost" > /tmp/$vm.dest`;
|
|
982
|
run_in_bg($cmd, $vm);
|
|
983
|
}
|
|
984
|
$dogpus = 1;
|
|
985
|
#eval { # We do not want the same domain reported in different states from two different nodes
|
|
986
|
# my $dom = $vmm->get_domain_by_uuid($vm);
|
|
987
|
# if ($dom) {$dom->undefine()};
|
|
988
|
# 1;
|
|
989
|
#} or do {print $@;};
|
|
990
|
}
|
|
991
|
elsif ($task_1 eq "RECEIVE" || $task_1 eq "RECEIVESTOR") {
|
|
992
|
my $uuid = $task_2; my $user = $task_3;
|
|
993
|
my $logentry = "$user: servers: $task_2: receiving: Receive domain request received";
|
|
994
|
logit('info', $logentry);
|
|
995
|
my $mounts = `cat /proc/mounts`;
|
|
996
|
for (my $i=0; $i<=$#tenderpathslist; $i++
|
|
997
|
)
|
|
998
|
{
|
|
999
|
my $path = $tenderpathslist[$i];
|
|
1000
|
my $host = $tenderlist[$i];
|
|
1001
|
# Directory / mount point must exist
|
|
1002
|
unless (-d $path) {
|
|
1003
|
mkdir "$path" or {print ("Error $path could not be created\n")};
|
|
1004
|
};
|
|
1005
|
unless ($mounts =~ m/$path/i || ($identity eq 'local_kvm' && $host =~ /10\.0\.0\.1/)) {
|
|
1006
|
logit('info', "Mounting (2) $path from $host");
|
|
1007
|
eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
|
|
1008
|
}
|
|
1009
|
}
|
|
1010
|
|
|
1011
|
my $xml = $browser->get($base_url . "?status=listxml&uuid=$uuid&mac=$mac")->content();
|
|
1012
|
if ($xml =~ /<domain /i) {
|
|
1013
|
if ($task_1 eq "RECEIVESTOR") {
|
|
1014
|
print "Adding $uuid to storage move list\n" if ($debug);
|
|
1015
|
push (@storreceiveuuids, $uuid);
|
|
1016
|
} else {
|
|
1017
|
print "Adding $uuid to move list\n" if ($debug);
|
|
1018
|
push (@receiveuuids, $uuid);
|
|
1019
|
}
|
|
1020
|
eval { # Undefine domain in case it has been running here before
|
|
1021
|
my $dom = $vmm->get_domain_by_uuid($task_2);
|
|
1022
|
if ($dom) {$dom->undefine()};
|
|
1023
|
1;
|
|
1024
|
} or do {print $@;};
|
|
1025
|
logit('info', "Defining $task_2");
|
|
1026
|
# Add bridge interfaces
|
|
1027
|
eval {print `modprobe 8021q`; 1;} or do {print $@;};
|
|
1028
|
eval {print `ifconfig $datanic up`; 1;} or do {print $@;};
|
|
1029
|
if ($xml =~ /<interface type=\'bridge\'/i
|
|
1030
|
)
|
|
1031
|
{
|
|
1032
|
my $char = "<source bridge=";
|
|
1033
|
my $offset = 0;
|
|
1034
|
my $result = index($xml, $char, $offset);
|
|
1035
|
while ($result != -1) {
|
|
1036
|
my $br = substr($xml, $result+18, 5);
|
|
1037
|
if ($br =~ /(\d+)/) {
|
|
1038
|
$br = $1;
|
|
1039
|
$logentry .= " - bringing up bridge br $br on $datanic";
|
|
1040
|
eval {print `vconfig add $datanic $br`; 1;} or do {print $@;};
|
|
1041
|
eval {print `brctl addbr br$br`; 1;} or do {print $@;};
|
|
1042
|
eval {print `brctl stp br$br on`; 1;} or do {print $@;};
|
|
1043
|
# Adding VLANs on wifi NICs does not seem to work. Disabling for now until we figure out what is going on.
|
|
1044
|
unless ($datanic =~ /^wl/) {
|
|
1045
|
eval {print `brctl addif br$br $datanic.$br`; 1;} or do {print $@;};
|
|
1046
|
}
|
|
1047
|
eval {print `ifconfig $datanic.$br up`; 1;} or do {print $@;};
|
|
1048
|
eval {print `ifconfig br$br up`; 1;} or do {print $@;};
|
|
1049
|
}
|
|
1050
|
$offset = $result + 1;
|
|
1051
|
$result = index($xml, $char, $offset);
|
|
1052
|
}
|
|
1053
|
}
|
|
1054
|
|
|
1055
|
chop $@; $logentry .= "\n$br : $@" if $@;
|
|
1056
|
if ($identity eq "vbox") { # vbox domains need to be defined on the receiving end
|
|
1057
|
eval {
|
|
1058
|
my $dom = $vmm->define_domain($xml);
|
|
1059
|
logit ('info', "Defined: " + $dom);
|
|
1060
|
1;
|
|
1061
|
} or do {print $@;};
|
|
1062
|
if ($@) {chop $@; $logentry .= "\n$@";}
|
|
1063
|
# $logentry .= $dom;
|
|
1064
|
my $res;
|
|
1065
|
eval {$res = `/usr/bin/VBoxManage modifyvm $task_2 --teleporter on --teleporterport 6000`; 1;} or
|
|
1066
|
do {$logentry .= "\n$user: servers: ".$res."\n".$@;};
|
|
1067
|
eval {$res = `/usr/bin/VBoxManage startvm $task_2 --type vrdp`; 1;} or
|
|
1068
|
do {$logentry .= "\n$user: servers: ".$res."\n".$@;};
|
|
1069
|
} else {
|
|
1070
|
;
|
|
1071
|
}
|
|
1072
|
$dogpus = 1;
|
|
1073
|
} else {
|
|
1074
|
$logentry .= "\n$user: servers: Invalid domain xml...";
|
|
1075
|
}
|
|
1076
|
}
|
|
1077
|
elsif ($task_1 eq "BCLONE") {
|
|
1078
|
my $user = $task_3;
|
|
1079
|
my $image = uri_unescape($task_2);
|
|
1080
|
my $logentry = "$user: images: $image: cloning: Clone request received";
|
|
1081
|
logit('info', $logentry);
|
|
1082
|
my $master = $browser->get($base_url . "?status=listimagemaster&image=$task_2")->content();
|
|
1083
|
if ($master) {
|
|
1084
|
$master = uri_unescape($master);
|
|
1085
|
$logentry = "Cloning $image from $master ";
|
|
1086
|
$image =~ /(.+)\/.*/;
|
|
1087
|
my $dir = $1;
|
|
1088
|
unless (-e $dir) {
|
|
1089
|
`/bin/mkdir -p "$dir"`;
|
|
1090
|
`chmod 777 "$dir"`;
|
|
1091
|
}
|
|
1092
|
my $cmd = qq|/usr/bin/qemu-img create -f qcow2 -b "$master" "$image"|;
|
|
1093
|
$logentry .= `$cmd`;
|
|
1094
|
$logentry =~ tr/\n/ /;
|
|
1095
|
logit('info', $logentry);
|
|
1096
|
} else {
|
|
1097
|
logit('info', "Master for $image not found $master");
|
|
1098
|
}
|
|
1099
|
}
|
|
1100
|
elsif ($task_1 eq "DROWSE") {
|
|
1101
|
drowse('', 1);
|
|
1102
|
}
|
|
1103
|
elsif ($task_1 eq "REMOVE") {
|
|
1104
|
my $user = $task_3;
|
|
1105
|
my $image = uri_unescape($task_2);
|
|
1106
|
my $logentry = "$user: images: $image: removing: Remove image request received";
|
|
1107
|
logit('info', $logentry);
|
|
1108
|
$logengry = "Removed image $image " . unlink($image);
|
|
1109
|
logit('info', $logentry);
|
|
1110
|
}
|
|
1111
|
elsif ($task_1 eq "PREMOVE") { # preserve backup
|
|
1112
|
my $user = $task_3;
|
|
1113
|
my $image = uri_unescape($task_2);
|
|
1114
|
my $logentry = "$user: images: $image: removing: Premove image request received";
|
|
1115
|
logit('info', $logentry);
|
|
1116
|
$logengry = "Removed image $image (preserved) " . `mv "$image" "$image.bak"`;
|
|
1117
|
logit('info', $logentry);
|
|
1118
|
}
|
|
1119
|
elsif ($task_1 eq "START") {
|
|
1120
|
$naptime = 1; # Temporarily speed up in order to report back promptly
|
|
1121
|
my $user = $task_3;
|
|
1122
|
my $logentry = "$user: servers: $task_2: starting: Start request received";
|
|
1123
|
logit('info', $logentry);
|
|
1124
|
|
|
1125
|
my $mounts = `cat /proc/mounts`;
|
|
1126
|
for (my $i=0; $i<=$#tenderpathslist; $i++
|
|
1127
|
)
|
|
1128
|
{
|
|
1129
|
my $path = $tenderpathslist[$i];
|
|
1130
|
my $host = $tenderlist[$i];
|
|
1131
|
# Directory / mount point must exist
|
|
1132
|
unless (-d $path) {
|
|
1133
|
mkdir "$path" or {print ("Error $path could not be created\n")};
|
|
1134
|
};
|
|
1135
|
if ($mounts =~ m/$path /i || ($identity eq 'local_kvm' && $host =~ /10\.0\.0\.1/)) {
|
|
1136
|
print ("$path already mounted\n") if ($debug);
|
|
1137
|
} else {
|
|
1138
|
logit('info', "Mounting (3) $path from $host");
|
|
1139
|
eval {print `mount -o intr,noatime,nfsvers=3 $host $path`; 1;} or do {print $@;};
|
|
1140
|
}
|
|
1141
|
}
|
|
1142
|
my $xml = $browser->get($base_url . "?status=listxml&uuid=$task_2&mac=$mac")->content();
|
|
1143
|
if ($xml =~ /<domain /i) {
|
|
1144
|
logit('info', "Creating $task_2");
|
|
1145
|
unless ($identity eq "local_kvm") {
|
|
1146
|
# Add bridge interfaces
|
|
1147
|
eval {print `modprobe 8021q`; 1;} or do {print $@;};
|
|
1148
|
eval {print `ifconfig $datanic up`; 1;} or do {print $@;};
|
|
1149
|
if ($xml =~ /<interface type=\'bridge\'/i) {
|
|
1150
|
my $char = "<source bridge=";
|
|
1151
|
my $offset = 0;
|
|
1152
|
my $result = index($xml, $char, $offset);
|
|
1153
|
while ($result != -1) {
|
|
1154
|
my $br = substr($xml, $result+18, 5);
|
|
1155
|
if ($br =~ /(\d+)/) {
|
|
1156
|
$br = $1;
|
|
1157
|
$logentry .= " - bringing up bridge br$br on $datanic ";
|
|
1158
|
eval {print `vconfig add $datanic $br`; 1;} or do {print $@;};
|
|
1159
|
eval {print `brctl addbr br$br`; 1;} or do {print $@;};
|
|
1160
|
eval {print `brctl stp br$br on`; 1;} or do {print $@;};
|
|
1161
|
# Adding VLANs on wifi NICs does not seem to work. Disabling for now until we figure out what is going on.
|
|
1162
|
unless ($datanic =~ /^wl/) {
|
|
1163
|
eval {print `brctl addif br$br $datanic.$br`; 1;} or do {print $@;};
|
|
1164
|
}
|
|
1165
|
eval {print `ifconfig $datanic.$br up`; 1;} or do {print $@;};
|
|
1166
|
eval {print `ifconfig br$br up`; 1;} or do {print $@;};
|
|
1167
|
}
|
|
1168
|
print $logentry if ($debug);
|
|
1169
|
$offset = $result + 1;
|
|
1170
|
$result = index($xml, $char, $offset);
|
|
1171
|
}
|
|
1172
|
}
|
|
1173
|
chop $@; $logentry .= " -- $br : $@" if $@;
|
|
1174
|
}
|
|
1175
|
# GPU passthrough - keep track of GPUs
|
|
1176
|
if ($xml =~ /<hostdev/) {
|
|
1177
|
# https://stackoverflow.com/questions/9538542/counting-number-of-occurrences-of-a-string-inside-another-perl
|
|
1178
|
my $numgpus = () = $xml =~ /<hostdev/g;
|
|
1179
|
print "Marking $numgpus GPUs as in-use by $task_2\n" if ($debug);
|
|
1180
|
$gpusfree -= $numgpus unless ($gpusfree == 0);
|
|
1181
|
my $xs = XML::Simple->new(ForceArray => ['hostdev']); # forces hostdev to be an array even if just one
|
|
1182
|
my $data = $xs->XMLin($xml);
|
|
1183
|
my $hostdevs = $data->{devices}->{hostdev};
|
|
1184
|
foreach my $dev (@$hostdevs) {
|
|
1185
|
my $bus = $dev->{address}->{bus};
|
|
1186
|
$bus = substr($bus,2);
|
|
1187
|
my $device = $dev->{address}->{slot};
|
|
1188
|
$device = substr($device,2);
|
|
1189
|
my $function = $dev->{address}->{function};
|
|
1190
|
$function = substr($function,2);
|
|
1191
|
my $bdf = $bus . "_" . $device . "_" . $function;
|
|
1192
|
foreach my $gpu (@gpus) {
|
|
1193
|
if ($gpu->{bdf} eq $bdf) {
|
|
1194
|
$gpu->{domainid} = substr($task_2, 0, 8); # store abbreviated dom uuid so we can increase $gpusfree when domain is shutoff
|
|
1195
|
last;
|
|
1196
|
}
|
|
1197
|
}
|
|
1198
|
}
|
|
1199
|
}
|
|
1200
|
|
|
1201
|
eval {
|
|
1202
|
my $domid = `virsh -c $virshemu:///system domid $task_2`;
|
|
1203
|
my $virshcmd = "virsh -c $virshemu:///system undefine $domid 2>/dev/null";
|
|
1204
|
print `$virshcmd` if ($domid);
|
|
1205
|
1;
|
|
1206
|
} or do {
|
|
1207
|
;# print $@;
|
|
1208
|
};
|
|
1209
|
|
|
1210
|
if ($xml=~/<source file=\'(.+)\'/i
|
|
1211
|
&& -s $1)
|
|
1212
|
{
|
|
1213
|
eval {
|
|
1214
|
if ($xml =~ /<hostdev /i) {
|
|
1215
|
# `modprobe pci_stub`;
|
|
1216
|
# `echo "10de 1b81" > /sys/bus/pci/drivers/pci-stub/new_id`;
|
|
1217
|
# `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`;
|
|
1218
|
# `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`;
|
|
1219
|
# `echo 1 > /sys/bus/pci/devices/0000:01:00.1/remove`;
|
|
1220
|
# `echo 1 > /sys/bus/pci/devices/0000:02:00.1/remove`;
|
|
1221
|
|
|
1222
|
# `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`;
|
|
1223
|
# `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`;
|
|
1224
|
}
|
|
1225
|
print "Defining domain from:\n$xml\n" if ($debug);
|
|
1226
|
print `echo "$xml" > /tmp/$task_2.xml`;
|
|
1227
|
my $virshcmd = "virsh -c $virshemu:///system create /tmp/$task_2.xml";
|
|
1228
|
run_in_bg( $virshcmd );
|
|
1229
|
logit ('info', "Created: $task_2");
|
|
1230
|
$logentry .= " - Created: $task_2" ;
|
|
1231
|
1;
|
|
1232
|
} or do {print "Error: " . $@;};
|
|
1233
|
if ($@) {
|
|
1234
|
chop $@; $logentry .= "\n$@";
|
|
1235
|
# $returntasks = uri_escape("START $task_2 $user"); # START did not succeed - return it to try again
|
|
1236
|
}
|
|
1237
|
} else {
|
|
1238
|
logit ('info', "Image $1 not found creating: $task_2");
|
|
1239
|
$logentry .= " - Image $1 not found creating: $task_2" ;
|
|
1240
|
}
|
|
1241
|
} else {
|
|
1242
|
$logentry .= " - $user: servers: Invalid domain xml...";
|
|
1243
|
}
|
|
1244
|
my $rtasks = $returntasks?"returntasks=$returntasks":'';
|
|
1245
|
my $newurl = $url . "&status=--&logentry=". uri_escape($logentry) . $rtasks;
|
|
1246
|
my $newcontent = $browser->get($newurl)->content();
|
|
1247
|
$dogpus = 1;
|
|
1248
|
} elsif ($task_1 ne "OK") {
|
|
1249
|
my $logentry = "--: --: Info not accepted: $task_1 - $task_2 - $task_3";
|
|
1250
|
logit('debug', $logentry);
|
|
1251
|
}
|
|
1252
|
}
|
|
1253
|
if (@receiveuuids) {
|
|
1254
|
$url .= "&receive=" . uri_escape(join(',', @receiveuuids)) . "&status=--";
|
|
1255
|
logit('info', "Asking to send me: " . join(',', @receiveuuids) . " $url ") if ($debug);
|
|
1256
|
my $newcontent = $browser->get($url)->content();
|
|
1257
|
}
|
|
1258
|
if (@storreceiveuuids) {
|
|
1259
|
$url .= "&receivestor=" . uri_escape(join(',', @storreceiveuuids)) . "&status=--";
|
|
1260
|
logit('info', "Asking to storage send me: " . join(',', @storreceiveuuids) . " $url ") if ($debug);
|
|
1261
|
my $newcontent = $browser->get($url)->content();
|
|
1262
|
}
|
|
1263
|
} else {
|
|
1264
|
logit('info', "Couldn't get: $url");
|
|
1265
|
}
|
|
1266
|
if ($pid) {return "";}
|
|
1267
|
else {return $running;}
|
|
1268
|
}
|
|
1269
|
|
|
1270
|
sub logit {
|
|
1271
|
my ($priority, $msg) = @_;
|
|
1272
|
if ($priority =~ /info|err/ || $debug) {print pretty_time(), ": ", $priority, ": ", $msg, "\n"};
|
|
1273
|
|
|
1274
|
setlogsock('unix');
|
|
1275
|
# Log the PID and to CONSole if there's a problem. Use facility 'user'.
|
|
1276
|
openlog(basename($0), 'pid,cons', 'user');
|
|
1277
|
syslog($priority, "$nmac: $msg");
|
|
1278
|
closelog();
|
|
1279
|
}
|
|
1280
|
|
|
1281
|
sub dominfo {
|
|
1282
|
my $vmm = shift;
|
|
1283
|
my $domreq = ();
|
|
1284
|
$domreq->{'dominfo'} = 1;
|
|
1285
|
my @domains = $vmm->list_domains();
|
|
1286
|
my %activedoms;
|
|
1287
|
my $i = 0;
|
|
1288
|
if (!$cgset) {
|
|
1289
|
setCgroups();
|
|
1290
|
$cgset = 1;
|
|
1291
|
}
|
|
1292
|
|
|
1293
|
print "Looking at " . scalar @domains . " domains\n" if ($debug);
|
|
1294
|
foreach my $dom (@domains) {
|
|
1295
|
eval {
|
|
1296
|
my $xml = $dom->get_xml_description();
|
|
1297
|
my $domxml = XMLin($xml);
|
|
1298
|
my $display = $domxml->{devices}->{graphics}->{type};
|
|
1299
|
my $port = $domxml->{devices}->{graphics}->{port};
|
|
1300
|
my $domstate = $domstates[$dom->get_info->{ 'state' }];
|
|
1301
|
my $domuuid = $dom->get_uuid_string;
|
|
1302
|
if (-e "/tmp/$domuuid.bg.out") { # A domain is migrating away
|
|
1303
|
my $pss = `pgrep -c -f "system migrate .* $domuuid"`;
|
|
1304
|
chomp $pss;
|
|
1305
|
if ($pss >1) { # migration is ongoing
|
|
1306
|
my $percentage = `grep -Po '\\d+ %' /tmp/$domuuid.bg.out | tail -n1`;
|
|
1307
|
chomp $percentage;
|
|
1308
|
if ($percentage) { # report percentage
|
|
1309
|
$percentage =~ s/ //;
|
|
1310
|
$domstate = "moving-$percentage";
|
|
1311
|
}
|
|
1312
|
}
|
|
1313
|
}
|
|
1314
|
$i++;
|
|
1315
|
$activedoms{$domuuid} = $domstate;
|
|
1316
|
# $dominfo .= "&dom$i=$domuuid&domstate$i=$domstate&domdisplay$i=" . $display . "&domport$i=" . $port;
|
|
1317
|
$domreq->{"dom$i"} = $domuuid;
|
|
1318
|
$domreq->{"domstate$i"} = $domstate;
|
|
1319
|
$domreq->{"domdisplay$i"} = $display;
|
|
1320
|
$domreq->{"domport$i"} = $port;
|
|
1321
|
|
|
1322
|
if (-e "/tmp/$domuuid.xml") {
|
|
1323
|
unlink "/tmp/$domuuid.xml";
|
|
1324
|
}
|
|
1325
|
|
|
1326
|
if ($domstate eq "shutoff") {
|
|
1327
|
my $j = 0;
|
|
1328
|
foreach my $gpu (@gpus) {
|
|
1329
|
print "Checking if $gpus[$j]->{domainid} is using a GPU\n" if ($debug);
|
|
1330
|
if ($domuuid =~ /^$gpu->{domainid}/) {
|
|
1331
|
delete $gpus[$j]->{domainid};
|
|
1332
|
delete $gpus[$j]->{domain};
|
|
1333
|
print "Freeing one GPU from $gpus[$j]->{domainid}\n" if ($debug);
|
|
1334
|
$gpusfree++ if ($gpusfree < $gpucount);
|
|
1335
|
last;
|
|
1336
|
}
|
|
1337
|
$j++;
|
|
1338
|
}
|
|
1339
|
};
|
|
1340
|
|
|
1341
|
# If cgroups are enabled, put in values
|
|
1342
|
# We put in values in /mnt/cgroup/libvirt/qemu/ instead of for individual domains
|
|
1343
|
# if (-d '/mnt/' && -e '/proc/cgroups') {
|
|
1344
|
# if ($xml=~/<name>(.+)<\/name>/) {
|
|
1345
|
# my $domname = $1;
|
|
1346
|
# if (-e "/tmp/$domuuid.xml" && -d "/mnt/cgroup/libvirt/qemu/$domname/") {
|
|
1347
|
# logit('info', "Setting cgroups limits $readlimit/$writelimit, $iopsreadlimit/$iopswritelimit for $domuuid ($domname)");
|
|
1348
|
# `echo "8:0 $readlimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.read_bps_device"`;
|
|
1349
|
# `echo "8:0 $writelimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.write_bps_device"`;
|
|
1350
|
# `echo "8:0 $iopsreadlimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.read_iops_device"`;
|
|
1351
|
# `echo "8:0 $iopswritelimit" > "/mnt/cgroup/libvirt/qemu/$domname/blkio.throttle.write_iops_device"`;
|
|
1352
|
# unlink "/tmp/$domuuid.xml";
|
|
1353
|
# }
|
|
1354
|
# } else {
|
|
1355
|
# logit('info', "Not setting cgroup limits for " . $dom->get_name() ) if ($debug);
|
|
1356
|
# }
|
|
1357
|
# }
|
|
1358
|
1;
|
|
1359
|
} or do {print $@;};
|
|
1360
|
|
|
1361
|
}
|
|
1362
|
@domains = $vmm->list_defined_domains();
|
|
1363
|
print "Looking at " . scalar @domains . " defined domains\n" if ($debug);
|
|
1364
|
foreach my $dom (@domains) {
|
|
1365
|
eval {
|
|
1366
|
my $domstate = $domstates[$dom->get_info->{ 'state' }];
|
|
1367
|
my $domuuid = $dom->get_uuid_string;
|
|
1368
|
if ($domstate ne "running") {
|
|
1369
|
$i++;
|
|
1370
|
$activedoms{$domuuid} = $domstate;
|
|
1371
|
$domreq->{"dom$i"} = $domuuid;
|
|
1372
|
$domreq->{"domstate$i"} = $domstate;
|
|
1373
|
}
|
|
1374
|
eval {
|
|
1375
|
if ($domstate eq "shutoff") {
|
|
1376
|
my $j = 0;
|
|
1377
|
foreach my $gpu (@gpus) {
|
|
1378
|
print "Checking if $gpus[$j]->{domainid} is using a GPU\n" if ($debug);
|
|
1379
|
if ($domuuid =~ /^$gpu->{domainid}/) {
|
|
1380
|
delete $gpus[$j]->{domainid};
|
|
1381
|
delete $gpus[$j]->{domain};
|
|
1382
|
print "Freeing one GPU from $gpus[$j]->{domainid}\n" if ($debug);
|
|
1383
|
$gpusfree++ if ($gpusfree < $gpucount);
|
|
1384
|
last;
|
|
1385
|
}
|
|
1386
|
$j++;
|
|
1387
|
}
|
|
1388
|
$dom->undefine()
|
|
1389
|
};
|
|
1390
|
1;
|
|
1391
|
} or do {print $@;};
|
|
1392
|
} or do {print $@;};
|
|
1393
|
}
|
|
1394
|
foreach my $domuuid (keys %mortuary) {
|
|
1395
|
unless ($activedoms{$domuuid}) {
|
|
1396
|
$i++;
|
|
1397
|
$domreq->{"dom$i"} = $domuuid;
|
|
1398
|
$domreq->{"domstate$i"} = 'shutoff';
|
|
1399
|
delete $mortuary{$domuuid};
|
|
1400
|
}
|
|
1401
|
}
|
|
1402
|
if (%mortuary) {
|
|
1403
|
store \%mortuary, $tombstones;
|
|
1404
|
} else {
|
|
1405
|
`> $tombstones` if (-e $tombstones && !(-z $tombstones));
|
|
1406
|
}
|
|
1407
|
|
|
1408
|
# Check if a domain has been moved and report and remove file from /tmp if so
|
|
1409
|
my @thefiles = recurse("/tmp");
|
|
1410
|
foreach my $f (@thefiles) {
|
|
1411
|
if ($f =~ /\/tmp\/(.*)\.bg\.out$/) {
|
|
1412
|
my $domuuid = $1;
|
|
1413
|
my $mes = '';
|
|
1414
|
my $error = '';
|
|
1415
|
print "Found migration $domuuid\n" if ($debug);
|
|
1416
|
my $pss = `pgrep -c -f "system migrate .* $domuuid"`;
|
|
1417
|
chomp $pss;
|
|
1418
|
if ($pss >1) { # migration is ongoing
|
|
1419
|
print "Migration of $domuuid $pss ongoing\n" if ($debug);
|
|
1420
|
} else {
|
|
1421
|
# my $mes = `cat "/tmp/$domuuid.bg.out" | tail -n1`;
|
|
1422
|
my $percentage = `grep -Po '\\d+ %' /tmp/$domuuid.bg.out | tail -n1`;
|
|
1423
|
if ($percentage) {
|
|
1424
|
$mes = "Domain $domuuid was moved";
|
|
1425
|
unlink "/tmp/$domuuid.bg.out";
|
|
1426
|
} else {
|
|
1427
|
$error = `cat /tmp/$domuuid.bg.out | tail -n1`;
|
|
1428
|
chomp $error;
|
|
1429
|
if (!$error) {
|
|
1430
|
$error = `cat /tmp/$domuuid.bg.out | tail -n2`;
|
|
1431
|
chomp $error; chomp $error;
|
|
1432
|
}
|
|
1433
|
$mes = "The domain $domuuid was not moved";
|
|
1434
|
$mes =~ s/:/ /;
|
|
1435
|
`mv /tmp/$domuuid.bg.out "/tmp/$domuuid.bg.error"`; # leave the file for inspection
|
|
1436
|
}
|
|
1437
|
# Update the client UI
|
|
1438
|
my $logentry = "--: servers: $domuuid: $status: $mes";
|
|
1439
|
# Update the client UI
|
|
1440
|
my $url = $base_url . "?mac=$mac&status=updateui&logentry=" . uri_escape($logentry);
|
|
1441
|
my $content = $browser->get($url);
|
|
1442
|
print "$mes\n" if ($debug);
|
|
1443
|
print $content if ($debug);
|
|
1444
|
}
|
|
1445
|
}
|
|
1446
|
}
|
|
1447
|
print "GPUs:\n" . Dumper(\@gpus) if ($debug);
|
|
1448
|
return $domreq;
|
|
1449
|
}
|
|
1450
|
|
|
1451
|
sub drowse {
|
|
1452
|
my $vmm = shift;
|
|
1453
|
$vmm = Sys::Virt->new(address => "$virshemu:///system") unless $vmm;
|
|
1454
|
my $drowsenow = shift;
|
|
1455
|
|
|
1456
|
my @domains = $vmm->list_domains();
|
|
1457
|
my $i = 0;
|
|
1458
|
foreach my $dom (@domains) {
|
|
1459
|
if ($domstates[$dom->get_info->{ 'state' }] eq "running" || $domstates[$dom->get_info->{ 'state' }] eq "paused") {
|
|
1460
|
$i++;
|
|
1461
|
last;
|
|
1462
|
}
|
|
1463
|
}
|
|
1464
|
if ($i==0) {$drowsiness += $naptime} else {$drowsiness = 0};
|
|
1465
|
if (($sleepafter > 0 && $drowsiness > $sleepafter) || $drowsenow) {
|
|
1466
|
if ($identity eq "vbox") {
|
|
1467
|
logit('info', "Taking down Virtual Box piston");
|
|
1468
|
print `/etc/init.d/vboxdrv stop`,"\n";
|
|
1469
|
} else {
|
|
1470
|
logit('info', "Taking down KVM piston");
|
|
1471
|
print `/etc/init.d/kvm stop`,"\n";
|
|
1472
|
}
|
|
1473
|
$status = "drowsing";
|
|
1474
|
my $logentry = "--: nodes: $mac: $status: Feeling drowsy ($drowsiness > $sleepafter) - putting node to sleep";
|
|
1475
|
logit('info', $logentry);
|
|
1476
|
$running = 0;
|
|
1477
|
|
|
1478
|
my $meminfo = `cat /proc/meminfo`;
|
|
1479
|
$meminfo =~ m/MemTotal:\s*(.*) kB\n/i;
|
|
1480
|
my $memtotal = $1;
|
|
1481
|
$meminfo =~ m/MemFree:\s*(.*) kB\n/i;
|
|
1482
|
my $memfree = $1;
|
|
1483
|
|
|
1484
|
my $url = $base_url . "?mac=" . uri_escape($mac);
|
|
1485
|
$url .= "&status=$status&logentry=" . uri_escape($logentry) ."&memtotal=$memtotal&memfree=$memfree&identity=$identity";
|
|
1486
|
`umount -a`;
|
|
1487
|
my $newcontent = $browser->get($url)->content();
|
|
1488
|
my @clines = split /\n/, $newcontent;
|
|
1489
|
foreach my $line (@clines) {
|
|
1490
|
if ($line =~ m/^\S+=SWEETDREAMS/ig) {
|
|
1491
|
print "Awating power off...\n";
|
|
1492
|
return;
|
|
1493
|
}
|
|
1494
|
}
|
|
1495
|
|
|
1496
|
$meminfo = `cat /proc/acpi/sleep`;
|
|
1497
|
my $s3sleep = ($meminfo =~ m/S3/);
|
|
1498
|
if ($s3sleep) {
|
|
1499
|
print `/etc/init.d/libvirt-bin stop`,"\n" if ($identity eq "vbox");
|
|
1500
|
print `/etc/acpi/sleep.sh`;
|
|
1501
|
} else {
|
|
1502
|
print `systemctl stop movepiston`;
|
|
1503
|
`echo 0 > /proc/sys/kernel/hung_task_timeout_secs`;
|
|
1504
|
print `poweroff`;
|
|
1505
|
# print `/sbin/shutdown -P +1`;
|
|
1506
|
}
|
|
1507
|
};
|
|
1508
|
}
|
|
1509
|
|
|
1510
|
sub listCopyDisks {
|
|
1511
|
my $suuid = shift;
|
|
1512
|
eval {
|
|
1513
|
my $vmm = Sys::Virt->new(address => "$virshemu:///system");
|
|
1514
|
my $dom = $vmm->get_domain_by_uuid($suuid);
|
|
1515
|
if ($dom) {
|
|
1516
|
my $xml = $dom->get_xml_description();
|
|
1517
|
my $xs = XML::Simple->new(ForceArray => ['disk']); # ForceArray makes sure 'disk' is always an array
|
|
1518
|
my $data = $xs->XMLin($xml);
|
|
1519
|
my $disks = $data->{devices}->{disk};
|
|
1520
|
my %devs = ("status", "OK");
|
|
1521
|
foreach my $disk (@$disks) {
|
|
1522
|
# Only consider disks of device type "disk"
|
|
1523
|
next unless $disk->{device} && $disk->{device} eq 'disk';
|
|
1524
|
my $dev = $disk->{target}->{dev} // 'unknown';
|
|
1525
|
my $file = $disk->{source}->{file} // undef;
|
|
1526
|
my $master = $disk->{backingStore}->{source}->{file} // undef;
|
|
1527
|
$devs{$dev} = {
|
|
1528
|
image => $file,
|
|
1529
|
master => $master
|
|
1530
|
}
|
|
1531
|
}
|
|
1532
|
$devs{xml} = $xml;
|
|
1533
|
return \%devs;
|
|
1534
|
} else {
|
|
1535
|
return {message=>"Domain $suuid not found", status => "Error"}
|
|
1536
|
}
|
|
1537
|
|
|
1538
|
} or do {print $@;};
|
|
1539
|
|
|
1540
|
}
|
|
1541
|
|
|
1542
|
sub changeHosts {
|
|
1543
|
my $hosts = "/etc/hosts";
|
|
1544
|
my $targetip = $_[0];
|
|
1545
|
my $targetname = $_[1];
|
|
1546
|
return 0 unless ($targetip && $targetname);
|
|
1547
|
copy($hosts, "$hosts.bak") or return 0;
|
|
1548
|
|
|
1549
|
my $newfile = "";
|
|
1550
|
my $match;
|
|
1551
|
open (FILE, $hosts);
|
|
1552
|
while (<FILE>) {
|
|
1553
|
chomp;
|
|
1554
|
my $line = $_;
|
|
1555
|
$newfile .= "$line\n" unless ($line =~ /^$targetip/);
|
|
1556
|
}
|
|
1557
|
$newfile .= "$targetip $targetname";
|
|
1558
|
close (FILE);
|
|
1559
|
open( FILE, ">$hosts" ) or return 0;
|
|
1560
|
print FILE $newfile;
|
|
1561
|
close(FILE);
|
|
1562
|
return "$hosts updated\n";
|
|
1563
|
}
|
|
1564
|
|
|
1565
|
sub pretty_time {
|
|
1566
|
my $current_time = time;
|
|
1567
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($current_time);
|
|
1568
|
my $pretty_time = sprintf "%4d-%02d-%02d@%02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec;
|
|
1569
|
return $pretty_time;
|
|
1570
|
}
|
|
1571
|
|
|
1572
|
sub recurse {
|
|
1573
|
my($path) = shift; # @_;
|
|
1574
|
my @files;
|
|
1575
|
## append a trailing / if it's not there
|
|
1576
|
$path .= '/' if($path !~ /\/$/);
|
|
1577
|
## loop through the files contained in the directory
|
|
1578
|
for my $eachFile (glob($path.'*')) {
|
|
1579
|
## if the file is a directory
|
|
1580
|
if( -d $eachFile) {
|
|
1581
|
## pass the directory to the routine ( recursion )
|
|
1582
|
push(@files,recurse($eachFile));
|
|
1583
|
} else {
|
|
1584
|
push(@files,$eachFile);
|
|
1585
|
}
|
|
1586
|
}
|
|
1587
|
return @files;
|
|
1588
|
}
|
|
1589
|
|
|
1590
|
sub getSizes {
|
|
1591
|
my $f = shift;
|
|
1592
|
my $lmtime = shift;
|
|
1593
|
|
|
1594
|
#print "$f :";
|
|
1595
|
my @stat = stat($f);
|
|
1596
|
my $size = $stat[7];
|
|
1597
|
my $realsize = $stat[12] * 512;
|
|
1598
|
my $virtualsize = $size;
|
|
1599
|
my $mtime = $stat[9];
|
|
1600
|
# Only fire up qemu-img etc. if image has been modified
|
|
1601
|
#print " $lmtime : $mtime\n";
|
|
1602
|
if ($mtime ne $lmtime) {
|
|
1603
|
my($fname, $dirpath, $suffix) = fileparse($f, (".vmdk", ".img", ".vhd", ".qcow", ".qcow2", ".vdi", ".iso"));
|
|
1604
|
# Special handling of vmdk's
|
|
1605
|
if ($suffix eq ".vmdk") {
|
|
1606
|
my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
|
|
1607
|
$qinfo =~ /virtual size:.*\((.+) bytes\)/g;
|
|
1608
|
$virtualsize = int($1);
|
|
1609
|
if ( -s ($dirpath . $fname . "-flat" . $suffix)) {
|
|
1610
|
my @fstatus = stat($dirpath . $fname . "-flat" . $suffix);
|
|
1611
|
my $fsize = $fstatus[7];
|
|
1612
|
my $frealsize = $fstatus[12] * 512;
|
|
1613
|
$size += $fsize;
|
|
1614
|
$virtualsize += $fsize;
|
|
1615
|
$realsize += $frealsize;
|
|
1616
|
}
|
|
1617
|
my $i = 1;
|
|
1618
|
while (@fstatus = stat($dirpath . $fname . "-s00$i" . $suffix)) {
|
|
1619
|
$fsize = $fstatus[7];
|
|
1620
|
$frealsize = $fstatus[12] * 512;
|
|
1621
|
$size += $fsize;
|
|
1622
|
$virtualsize += $fsize;
|
|
1623
|
$realsize += $frealsize;
|
|
1624
|
$i++;
|
|
1625
|
}
|
|
1626
|
# Get virtual size of qcow2 auto-grow volumes
|
|
1627
|
} elsif ($suffix eq ".qcow2") {
|
|
1628
|
my $qinfo = `/usr/bin/qemu-img info --force-share "$f"`;
|
|
1629
|
$qinfo =~ /virtual size:.*\((.+) bytes\)/g;
|
|
1630
|
$virtualsize = int($1);
|
|
1631
|
# Get virtual size of vdi auto-grow volumes
|
|
1632
|
} elsif ($suffix eq ".vdi") {
|
|
1633
|
my $qinfo = `/usr/bin/VBoxManage showhdinfo "$f"`;
|
|
1634
|
$qinfo =~ /Logical size:\s*(\d+) MBytes/g;
|
|
1635
|
$virtualsize = int($1) * 1024 * 1024;
|
|
1636
|
}
|
|
1637
|
# Actual used blocks times block size on disk, i.e. $realsize may be bigger than the
|
|
1638
|
# logical size of the image file $virtualsize and the logical provisioned size of the disk $virtualsize
|
|
1639
|
# in order to minimize confusion, we set $realsize to $size if this is the case
|
|
1640
|
$realsize = $size if ($realsize > $size);
|
|
1641
|
return ($size, $realsize, $virtualsize, $mtime);
|
|
1642
|
} else {
|
|
1643
|
return 0;
|
|
1644
|
}
|
|
1645
|
|
|
1646
|
}
|
|
1647
|
|
|
1648
|
sub updatePistonStats {
|
|
1649
|
my $vmm = shift;
|
|
1650
|
logit('info', "Updating domain statistics...") if $debug == 1;
|
|
1651
|
|
|
1652
|
# Connect to libvirt...
|
|
1653
|
$vmm = Sys::Virt->new(address => "$virshemu:///system") unless $vmm;
|
|
1654
|
my @domains = $vmm->list_domains();
|
|
1655
|
my $postreq = ();
|
|
1656
|
my $i = 0;
|
|
1657
|
# Loop through all local domains...
|
|
1658
|
foreach my $dom (@domains) {
|
|
1659
|
$i++;
|
|
1660
|
print "\tProcessing '",$dom->get_name(),"' [",$dom->get_uuid_string(),"]...\n" if $debug;
|
|
1661
|
# my ($timestamp_seconds, $timestamp_microseconds_decimals) = gettimeofday();
|
|
1662
|
my $timestamp_useconds = Time::HiRes::time();
|
|
1663
|
my $timestamp_seconds = floor($timestamp_useconds);
|
|
1664
|
my $uuid = $dom->get_uuid_string();
|
|
1665
|
$postreq->{"$i.uuid"} = $uuid;
|
|
1666
|
# $postreq->{"$i.timestamp"} = sprintf("%.0f%06.0f", $timestamp_seconds, $timestamp_microseconds_decimals);
|
|
1667
|
$postreq->{"$i.timestamp"} = $timestamp_seconds;
|
|
1668
|
|
|
1669
|
# Fetch basic node/domain information (cpu, memory, cputime etc)...
|
|
1670
|
my $dom_info = $dom->get_info();
|
|
1671
|
while (my($key, $value) = each(%$dom_info)) {
|
|
1672
|
$postreq->{"$i.domain.$key"} = $value;
|
|
1673
|
};
|
|
1674
|
|
|
1675
|
my $t2 = $timestamp_useconds;
|
|
1676
|
my $t1 = $oldTimes{$uuid}->{timestamp_useconds};
|
|
1677
|
my $c2 = $dom_info->{cpuTime};
|
|
1678
|
my $c1 = $oldTimes{$uuid}->{cpuTime};
|
|
1679
|
my $delta = $t2-$t1;
|
|
1680
|
|
|
1681
|
if ($t1 && $c2>$c1) { # Work across reboots
|
|
1682
|
$postreq->{"$i.domain.cpuLoad"} = sprintf("%.4f", (($c2 - $c1)/1000000000) / $delta );
|
|
1683
|
$postreq->{"$i.delta"} = floor($delta);
|
|
1684
|
}
|
|
1685
|
$oldTimes{$uuid}->{cpuTime} = $dom_info->{cpuTime};
|
|
1686
|
$oldTimes{$uuid}->{timestamp_useconds} = $timestamp_useconds;
|
|
1687
|
$oldTimes{$uuid}->{timestamp} = $timestamp_seconds;
|
|
1688
|
# Fetch the xml description of the specific domain...
|
|
1689
|
my $domxml = XMLin($dom->get_xml_description());
|
|
1690
|
|
|
1691
|
# Process block devices...
|
|
1692
|
my @devices;
|
|
1693
|
# Collect statistics for several block devices...
|
|
1694
|
if (ref($domxml->{devices}->{disk}) eq 'ARRAY') {@devices = @{$domxml->{devices}->{disk}};}
|
|
1695
|
# Collect statistics for a single block device...
|
|
1696
|
else {push @devices, $domxml->{devices}->{disk};}
|
|
1697
|
|
|
1698
|
my $wr2;
|
|
1699
|
my $wr1 = $oldTimes{$uuid}->{"wr_kbytes_s"};
|
|
1700
|
my $rd2;
|
|
1701
|
my $rd1 = $oldTimes{$uuid}->{"rd_kbytes_s"};
|
|
1702
|
foreach my $device (@devices) {
|
|
1703
|
if ($device->{device} eq 'disk') {
|
|
1704
|
my $blockdev = $device->{target}->{dev};
|
|
1705
|
eval {
|
|
1706
|
my $blockstats = $dom->block_stats($blockdev);
|
|
1707
|
while (my($key, $value) = each(%$blockstats)) {
|
|
1708
|
$postreq->{"$i.blk.$blockdev.$key"} = $value;
|
|
1709
|
# $postreq->{"$i.blk.hd.$key"} += $value; # We report collected traffic under hd
|
|
1710
|
$wr2 += $value if ($key eq 'wr_bytes');
|
|
1711
|
$rd2 += $value if ($key eq 'rd_bytes');
|
|
1712
|
}
|
|
1713
|
};
|
|
1714
|
|
|
1715
|
print("\tFailed while requesting block device statistics for $blockdev, skipping...") if $@;
|
|
1716
|
}
|
|
1717
|
}
|
|
1718
|
$postreq->{"$i.blk.hd.wr_bytes"} = $wr2;
|
|
1719
|
$postreq->{"$i.blk.hd.rd_bytes"} = $rd2;
|
|
1720
|
if ($t1 && $c2>$c1) {
|
|
1721
|
$postreq->{"$i.blk.hd.wr_kbytes_s"} = sprintf("%.2f", (($wr2 - $wr1)/1024) / $delta );
|
|
1722
|
$postreq->{"$i.blk.hd.rd_kbytes_s"} = sprintf("%.2f", (($rd2 - $rd1)/1024) / $delta );
|
|
1723
|
$postreq->{"$i.blk.hd.wr_kbytes_s"} = 0 if ($postreq->{"$i.blk.hd.wr_kbytes_s"} eq '0.00');
|
|
1724
|
$postreq->{"$i.blk.hd.rd_kbytes_s"} = 0 if ($postreq->{"$i.blk.hd.rd_kbytes_s"} eq '0.00');
|
|
1725
|
}
|
|
1726
|
$oldTimes{$uuid}->{wr_kbytes_s} = $wr2;
|
|
1727
|
$oldTimes{$uuid}->{rd_kbytes_s} = $rd2;
|
|
1728
|
|
|
1729
|
# Collect statistics for network interfaces...
|
|
1730
|
my @netdevices;
|
|
1731
|
if (ref($domxml->{devices}->{interface}) eq 'ARRAY') {@netdevices = @{$domxml->{devices}->{interface}};}
|
|
1732
|
else {push @netdevices, $domxml->{devices}->{interface};}
|
|
1733
|
|
|
1734
|
my $rx2;
|
|
1735
|
my $rx1 = $oldTimes{$uuid}->{"rx_kbytes_s"};
|
|
1736
|
my $tx2;
|
|
1737
|
my $tx1 = $oldTimes{$uuid}->{"tx_kbytes_s"};
|
|
1738
|
foreach my $device (@netdevices) {
|
|
1739
|
my $interface = $device->{target}->{dev};
|
|
1740
|
if ($interface) {
|
|
1741
|
eval {
|
|
1742
|
my $ifstats = $dom->interface_stats($interface);
|
|
1743
|
while (my($key, $value) = each(%$ifstats)) {
|
|
1744
|
$postreq->{"$i.if.$interface.$key"} = $value;
|
|
1745
|
$postreq->{"$i.if.vnet.$key"} += $value; # We report collected traffic under vnet
|
|
1746
|
$rx2 += $value if ($key eq 'rx_bytes');
|
|
1747
|
$tx2 += $value if ($key eq 'tx_bytes');
|
|
1748
|
}
|
|
1749
|
};
|
|
1750
|
print("\tFailed while requesting interface statistics ('"+$@+"'), skipping...") if $@;
|
|
1751
|
}
|
|
1752
|
}
|
|
1753
|
if ($t1 && $c2>$c1) {
|
|
1754
|
$postreq->{"$i.if.vnet.rx_kbytes_s"} = sprintf("%.2f", (($rx2 - $rx1)/1024) / $delta );
|
|
1755
|
$postreq->{"$i.if.vnet.tx_kbytes_s"} = sprintf("%.2f", (($tx2 - $tx1)/1024) / $delta );
|
|
1756
|
$postreq->{"$i.if.vnet.rx_kbytes_s"} = 0 if ($postreq->{"$i.if.vnet.rx_kbytes_s"} eq '0.00');
|
|
1757
|
$postreq->{"$i.if.vnet.tx_kbytes_s"} = 0 if ($postreq->{"$i.if.vnet.tx_kbytes_s"} eq '0.00');
|
|
1758
|
}
|
|
1759
|
$oldTimes{$uuid}->{rx_kbytes_s} = $rx2;
|
|
1760
|
$oldTimes{$uuid}->{tx_kbytes_s} = $tx2;
|
|
1761
|
}
|
|
1762
|
if ($postreq) {
|
|
1763
|
# POST request to admin server...
|
|
1764
|
logit('info', "Posting stats to: $stats_url") if $debug;
|
|
1765
|
print("POSTREQ:\n".Dumper($postreq)) if $debug;
|
|
1766
|
$content = $browser->post($stats_url, $postreq)->content();
|
|
1767
|
print "$content\n" if $debug;
|
|
1768
|
}
|
|
1769
|
}
|
|
1770
|
|
|
1771
|
sub backup {
|
|
1772
|
my $user = $_[0];
|
|
1773
|
my $uistatus = $_[1];
|
|
1774
|
my $status =$_[2];
|
|
1775
|
my $path = $_[3];
|
|
1776
|
my $targetdir = $_[4];
|
|
1777
|
my $remolder = $_[5];
|
|
1778
|
my $pool = "/mnt/stabile/node";
|
|
1779
|
my $image;
|
|
1780
|
my $subdir; # 1 level of subdirs supported
|
|
1781
|
my $res;
|
|
1782
|
return 0 unless ($path && $targetdir && $user);
|
|
1783
|
# $image is the image to back up (including potential subdir), $pool the source dir (storage pool) and $targetdir the target dir (general backup dir)
|
|
1784
|
|
|
1785
|
#mkdir "$targetdir/$user" unless -d "$targetdir/$user"; # Create the target dirs which will contain the backup
|
|
1786
|
$path =~ /\/$user\/(.+)/;
|
|
1787
|
my $imagepath = $1;
|
|
1788
|
if ($path =~ /\/$user\/(.+)\/(.+)/) {
|
|
1789
|
$subdir = $1;
|
|
1790
|
$image = $2;
|
|
1791
|
} else {
|
|
1792
|
$path =~ /\/$user\/(.+)/;
|
|
1793
|
$image = $1;
|
|
1794
|
}
|
|
1795
|
if ($subdir) { # Creation of $targetdir/$user is done when user logs in
|
|
1796
|
#mkdir "$targetdir/$user/$subdir" unless -d "$targetdir/$user/$subdir";
|
|
1797
|
#mkdir "$targetdir/$user/$subdir/$image" unless -d "$targetdir/$user/$subdir/$image";
|
|
1798
|
my $dironly = $1 if ($targetdir =~ /.+::(.+)/);
|
|
1799
|
eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/ssh $mainvalve mkdir "$dironly/$user/$subdir"`; 1;}
|
|
1800
|
} else { # Image subdir is created by rdiff-backup
|
|
1801
|
#mkdir "$targetdir/$user/$image" unless -d "$targetdir/$user/$image";
|
|
1802
|
}
|
|
1803
|
$res .= `/bin/echo $status > "$pool/$user/$imagepath.meta"`;
|
|
1804
|
|
|
1805
|
if (-d "/mnt/$user-$image") {
|
|
1806
|
$res .= "Image is already being backed up";
|
|
1807
|
} else {
|
|
1808
|
my $snapname;
|
|
1809
|
my $snappath;
|
|
1810
|
my $snapsrcdir;
|
|
1811
|
if ($status eq "lbackingup") { # Do a local lvm snapshot before backing up
|
|
1812
|
$res .= `/sbin/modprobe dm-snapshot`; # Make sure we can make lvm snapshots
|
|
1813
|
$snapname = "$user-$image";
|
|
1814
|
$snapname =~ tr/ /-/; #No spaces allowed in snapshot names...
|
|
1815
|
$snapname =~ tr/@/+/; #No spaces allowed in snapshot names...
|
|
1816
|
$snappath = "/mnt/$snapname"; # The path to mount our snapshot on
|
|
1817
|
mkdir $snappath;
|
|
1818
|
|
|
1819
|
my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
|
|
1820
|
$q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
|
|
1821
|
my $lvolgroup = $1;
|
|
1822
|
my $lvol = $2;
|
|
1823
|
|
|
1824
|
$res .= `/sbin/lvcreate -L1024M -s -n $snapname /dev/$lvolgroup/$lvol`; # Take a snapshot
|
|
1825
|
$res .= changeFstab($snapname, $pool); # Change fstab to allow mount
|
|
1826
|
$res .= `/bin/mount "$snappath"`; # Mount the snapshot
|
|
1827
|
$snapsrcdir = "$snappath/$user"; # Change source dir to our new snapshot
|
|
1828
|
} else {
|
|
1829
|
$snapsrcdir = "$pool/$user";
|
|
1830
|
}
|
|
1831
|
|
|
1832
|
# Do the backup
|
|
1833
|
eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --include "$snapsrcdir/$imagepath" --exclude '**' "$snapsrcdir" "$targetdir/$user/$imagepath"`; 1;}
|
|
1834
|
or do {$res .= "Problem executing backup";};
|
|
1835
|
if ($remolder) {
|
|
1836
|
eval {$res .= `/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --force --remove-older-than $remolder "$targetdir/$user/$imagepath"`; 1;}
|
|
1837
|
or do {$res .= "Problem cleaning up old backups";};
|
|
1838
|
}
|
|
1839
|
$res .= qq{/usr/bin/sudo -u irigo /usr/bin/rdiff-backup --print-statistics --include "$snapsrcdir/$imagepath" --exclude '**' "$snapsrcdir" "$targetdir/$user/$imagepath"};
|
|
1840
|
# Clean up
|
|
1841
|
if ($status eq "lbackingup") {
|
|
1842
|
$res .= `/bin/umount "$snappath"`;
|
|
1843
|
$res .= changeFstab($snapname, $pool, 1);
|
|
1844
|
$res .= `/bin/rm -r "$snappath"` unless (-d "$snappath/$user");
|
|
1845
|
$res .= `/sbin/lvremove -f /dev/$lvolgroup/$snapname`;
|
|
1846
|
}
|
|
1847
|
logit("info", "Backed up $snapsrcdir/$imagepath to $targetdir/$user/$imagepath");
|
|
1848
|
}
|
|
1849
|
unlink "$pool/$user/$imagepath.meta";
|
|
1850
|
print "$res\n" if ($debug);
|
|
1851
|
|
|
1852
|
|
|
1853
|
my $mes = "";
|
|
1854
|
if ($res =~ /TotalDestinationSizeChange (\d+)(.+\))/) {
|
|
1855
|
if ($1 eq "0") {
|
|
1856
|
$mes = "No changes to back up ($imagepath)";
|
|
1857
|
} else {
|
|
1858
|
$mes = "Backed up $1$2 ($imagepath)";
|
|
1859
|
}
|
|
1860
|
} elsif ($res =~ /(Image is already being backed up)/) {
|
|
1861
|
$mes = "$1 ($imagepath)";
|
|
1862
|
} else {
|
|
1863
|
my $hres = $res;
|
|
1864
|
$hres =~ s/\n/<br>/g;
|
|
1865
|
$hres =~ s/\"/\\"/g;
|
|
1866
|
$mes = "Backup failed ($imagepath)";
|
|
1867
|
logit('err', "Backup of $imagepath failed - $hres");
|
|
1868
|
}
|
|
1869
|
my $logentry = "$user: images: $path: $status: $mes";
|
|
1870
|
|
|
1871
|
# Update the client UI
|
|
1872
|
my $url = $base_url . "?mac=$mac&status=updateui&logentry=" . uri_escape($logentry);
|
|
1873
|
$content = $browser->get($url);
|
|
1874
|
}
|
|
1875
|
|
|
1876
|
sub changeFstab {
|
|
1877
|
my $image = $_[0];
|
|
1878
|
my $pool = $_[1];
|
|
1879
|
my $remove = 1 if $_[2];
|
|
1880
|
return 0 unless ($image);
|
|
1881
|
return 0 unless (index($image, " ")==-1);
|
|
1882
|
copy($fstab, "$fstab.steam.bak") or return 0;
|
|
1883
|
|
|
1884
|
my $q = `/bin/cat /proc/mounts | grep $pool`; # Find the lvm volume mounted on /mnt/images
|
|
1885
|
$q =~ /\/dev\/mapper\/(\S+)-(\S+) $pool .+/;
|
|
1886
|
my $lvolgroup = $1;
|
|
1887
|
my $lvol = $2;
|
|
1888
|
|
|
1889
|
my $newfile = "";
|
|
1890
|
my $match;
|
|
1891
|
open (FILE, $fstab);
|
|
1892
|
while (<FILE>) {
|
|
1893
|
chomp;
|
|
1894
|
my $line = $_;
|
|
1895
|
if ($line =~ /^\/dev\/$lvolgroup\/$image/) {
|
|
1896
|
$newfile .= "$line\n" unless ($remove);
|
|
1897
|
$match = 1;
|
|
1898
|
} else {
|
|
1899
|
$newfile .= "$line\n";
|
|
1900
|
}
|
|
1901
|
}
|
|
1902
|
$newfile .= "/dev/$lvolgroup/$image /mnt/$image ext3 users,ro 0 0\n" unless ($match || $remove);
|
|
1903
|
close (FILE);
|
|
1904
|
open( FILE, ">$fstab" );
|
|
1905
|
print FILE $newfile;
|
|
1906
|
close(FILE);
|
|
1907
|
return "fstab updated $remove\n";
|
|
1908
|
}
|
|
1909
|
|
|
1910
|
sub initializeLocalDisk {
|
|
1911
|
my $initld = shift;
|
|
1912
|
my $force = shift;
|
|
1913
|
my $res;
|
|
1914
|
if ((-e "/dev/sda" || -e "/dev/vda" || -e "/dev/nvme0n1") && -e '/sbin/sfdisk') {
|
|
1915
|
my $dev = "sda";
|
|
1916
|
$dev = "vda" if (-e "/dev/vda");
|
|
1917
|
my $part = $dev . "1";
|
|
1918
|
if (-e "/dev/nvme0n1") {
|
|
1919
|
$dev = "nvme0n1";
|
|
1920
|
$part = $dev . "p1";
|
|
1921
|
}
|
|
1922
|
|
|
1923
|
`chmod 666 /dev/zfs` if (-e '/dev/zfs'); # TODO: This should be removed once we upgrade to Bionic and zfs allow is supported
|
|
1924
|
my $partinfo = `/sbin/sfdisk -q -d /dev/$dev`;
|
|
1925
|
my $zlist = `zpool list`;
|
|
1926
|
|
|
1927
|
if (!$force) {
|
|
1928
|
my $mounts = `/bin/cat /proc/mounts`;
|
|
1929
|
if ($mounts =~ /volgroup1-lvol1/ || $mounts =~ /\mnt\/stabile\/node/) {
|
|
1930
|
$res = "Local disk is already mounted.";
|
|
1931
|
print "$res\n";
|
|
1932
|
return $res;
|
|
1933
|
} else {
|
|
1934
|
if (( $partinfo =~ /\/dev\/$part.+size=.*(\d+),/i && $1>0 ) || $zlist =~ /stabile-node/) {
|
|
1935
|
$res = "Local disk is already partitioned. Trying to mount.";
|
|
1936
|
if ($initld eq 'zfs') {
|
|
1937
|
$res .= " ZFS specified.";
|
|
1938
|
`zpool import stabile-node`;
|
|
1939
|
`zfs mount stabile-node/node`;
|
|
1940
|
}
|
|
1941
|
$res .= " LVM specified." if ($initld eq 'lvm');
|
|
1942
|
# We try to mount in any case to support mixed setups with old disks that have not been converted to ZFS
|
|
1943
|
`/bin/mount /dev/volgroup1/lvol1 /mnt/stabile/node`;
|
|
1944
|
print "$res\n";
|
|
1945
|
}
|
|
1946
|
`/bin/chmod 777 /mnt/stabile/node`;
|
|
1947
|
return $res;
|
|
1948
|
}
|
|
1949
|
}
|
|
1950
|
|
|
1951
|
if ($force) {
|
|
1952
|
if (`ls -l /mnt/stabile/node/*/*.qcow2`) {
|
|
1953
|
$res = "Node storage dir not empty";
|
|
1954
|
print "$res\n";
|
|
1955
|
return $res;
|
|
1956
|
}
|
|
1957
|
print `umount /mnt/stabile/node`;
|
|
1958
|
print `umount /stabile-node`;
|
|
1959
|
my $mounts = `cat /proc/mounts`;
|
|
1960
|
if ($mounts =~ /stabile-node/ || $mounts =~ /\/mnt\/stabile\/node/) {
|
|
1961
|
$res = "Unable to unmount node storage\n";
|
|
1962
|
print "$res\n";
|
|
1963
|
return $res;
|
|
1964
|
}
|
|
1965
|
print `zpool destroy stabile-node`;
|
|
1966
|
print `vgremove -f volgroup1`;
|
|
1967
|
}
|
|
1968
|
if ($initld eq 'zfs') { # ZFS was specified
|
|
1969
|
$res = "Initializing local disk with ZFS...";
|
|
1970
|
print "$res\n";
|
|
1971
|
print `rmdir /mnt/stabile/node` if (-e "/mnt/stabile/node" && !(`ls /mnt/stabile/node`));
|
|
1972
|
print `parted -s /dev/$dev mklabel GPT`;
|
|
1973
|
print `zpool create stabile-node /dev/$dev`;
|
|
1974
|
print `zfs create stabile-node/node`;
|
|
1975
|
print `zfs set mountpoint=/mnt/stabile/node stabile-node/node`;
|
|
1976
|
print `zfs set atime=off stabile-node/node`;
|
|
1977
|
} else { # Assume LVM
|
|
1978
|
$res = "Initializing local disk with LVM...";
|
|
1979
|
print "$res\n";
|
|
1980
|
`/sbin/sfdisk -d /dev/$dev > /root/$dev-partition-sectors.save`;
|
|
1981
|
`sfdisk /dev/$dev << EOF\n;\nEOF`;
|
|
1982
|
`/sbin/vgcreate -f volgroup1 /dev/$part`;
|
|
1983
|
`/sbin/vgchange -a y volgroup1`;
|
|
1984
|
my $totalpe =`/sbin/vgdisplay volgroup1 | grep "Total PE"`;
|
|
1985
|
$totalpe =~ /Total PE\s+(\d+)/;
|
|
1986
|
my $size = $1 -2000;
|
|
1987
|
`/sbin/lvcreate -l $size volgroup1 -n lvol1`;
|
|
1988
|
`/sbin/mkfs.ext3 /dev/volgroup1/lvol1`;
|
|
1989
|
`/bin/mount /dev/volgroup1/lvol1 /mnt/stabile/node`;
|
|
1990
|
}
|
|
1991
|
`/bin/chmod 777 /mnt/stabile/node`;
|
|
1992
|
my $lsistatus = `/usr/local/bin/lsi.sh status`;
|
|
1993
|
if ($lsistatus =~ /Adapter 0/) {
|
|
1994
|
#unless (-e "/etc/cron.hourly/lsicheck.sh") {
|
|
1995
|
print "Adding hourly cron check of LSI raid\n";
|
|
1996
|
my $alertemail = `cat /etc/stabile/nodeconfig.cfg | grep ALERT_EMAIL | cut -f2 -d "="`;
|
|
1997
|
`/bin/echo "#!/bin/bash\n\n/usr/local/bin/lsi.sh checkNemail $alertemail" > /etc/cron.hourly/lsicheck.sh`;
|
|
1998
|
$res .= "Adding hourly cron check of LSI raid";
|
|
1999
|
print "$res\n";
|
|
2000
|
`/bin/echo "#!/bin/bash\n\n/usr/local/bin/lsi.sh status | mail -s \\"$hostname LSI status\\" $alertemail" > /etc/cron.weekly/lsistatus.sh`;
|
|
2001
|
#}
|
|
2002
|
}
|
|
2003
|
} else {
|
|
2004
|
$res = "No local disk";
|
|
2005
|
print "$res\n";
|
|
2006
|
}
|
|
2007
|
return $res;
|
|
2008
|
}
|
|
2009
|
|
|
2010
|
sub dont_die {
|
|
2011
|
print "We trudge along\n";
|
|
2012
|
}
|
|
2013
|
|
|
2014
|
sub run_in_bg {
|
|
2015
|
my ($cmd, $uuid) = @_;
|
|
2016
|
if ($uuid) {
|
|
2017
|
my $proc1 = Proc::Background->new("$cmd 2>&1 | /usr/bin/tee /tmp/$uuid.bg.out"); # We're moving a domain
|
|
2018
|
} else {
|
|
2019
|
my $proc1 = Proc::Background->new($cmd);
|
|
2020
|
}
|
|
2021
|
}
|
|
2022
|
|
|
2023
|
sub setCgroups {
|
|
2024
|
if (-d "/sys/fs/cgroup/blkio") {
|
|
2025
|
print `cgconfigparser -l /etc/stabile/cgconfig.conf`;
|
|
2026
|
} else {
|
|
2027
|
print "cgroups are not enabled!!\n";
|
|
2028
|
}
|
|
2029
|
}
|
|
2030
|
|
|
2031
|
sub updateInterfaces {
|
|
2032
|
if ($identity eq 'local_kvm' || -e "/etc/stabile/config.cfg") {
|
|
2033
|
unless (`ifconfig | grep "inet 10\.0\.0\.1"`) {
|
|
2034
|
# print "Adding 10.0.0.1 as to $datanic\n";
|
|
2035
|
# `ifconfig $datanic:1 10.0.0.1/24 up`;
|
|
2036
|
print "Adding 10.0.0.1 as to $adminnic\n";
|
|
2037
|
`ifconfig $adminnic:1 10.0.0.1/24 up`;
|
|
2038
|
`steamExec post-wake`;
|
|
2039
|
}
|
|
2040
|
}
|
|
2041
|
}
|
|
2042
|
|
|
2043
|
# Enumerate and return network interfaces
|
|
2044
|
sub getNics {
|
|
2045
|
my $droute = `ip route show default`;
|
|
2046
|
my $internalnic = $1 if ($droute =~ /default via .+ dev (.+) proto/); # On the node, default route is on the internal network
|
|
2047
|
# First get all nics and activate link on ethers - for some reason Ubuntu puts them down if they are not configured with an IP
|
|
2048
|
my $niclist = `ifconfig -a | grep flags= | sed -n -e 's/: .*//p'`;
|
|
2049
|
foreach my $line (split("\n", $niclist)) {
|
|
2050
|
my $nic = $1 if ($line =~ /(\S+)/);
|
|
2051
|
if ($nic=~/^en/) {
|
|
2052
|
`ifconfig $nic up`;
|
|
2053
|
}
|
|
2054
|
}
|
|
2055
|
sleep 1;
|
|
2056
|
# Then list those that are up i.e. have link
|
|
2057
|
my $niclist = `ifconfig | grep flags= | sed -n -e 's/: .*//p'`;
|
|
2058
|
# my $niclist = `netstat -in`;
|
|
2059
|
my @nics = ();
|
|
2060
|
push @nics, $internalnic if ($internalnic);
|
|
2061
|
foreach my $line (split("\n", $niclist)) {
|
|
2062
|
my $nic = $1 if ($line =~ /(\S+)/);
|
|
2063
|
if ($nic ne 'lo' && $nic ne $internalnic && !($nic=~/^virbr/) && !($nic=~/^docker/) && !($nic=~/^br/) && !($nic=~/^vnet/) && !($nic=~/^Name/) && !($nic=~/^Kernel/) && !($nic=~/^Iface/) && !($nic=~/(\.|\:)/)) {
|
|
2064
|
push @nics, $1;
|
|
2065
|
}
|
|
2066
|
}
|
|
2067
|
$internalnic = $nics[0] unless ($internalnic);
|
|
2068
|
my $externalnic = $internalnic;
|
|
2069
|
$externalnic = $nics[1] if (scalar @nics > 1);
|
|
2070
|
if ($identity eq 'local_kvm') { # local_kvm uses external NIC for vlans and internal NIC for 10.0.0.1
|
|
2071
|
return ($externalnic, $internalnic);
|
|
2072
|
} else {
|
|
2073
|
return ($internalnic, $externalnic);
|
|
2074
|
}
|
|
2075
|
}
|
|
2076
|
|
|
2077
|
sub listGpus {
|
|
2078
|
my $gapi = shift;
|
|
2079
|
my $getvram = shift;
|
|
2080
|
$api = $api || $gapi;
|
|
2081
|
|
|
2082
|
my %gpushash;
|
|
2083
|
|
|
2084
|
# First check if iommu is enabled
|
|
2085
|
my $cmd = "cat /proc/cmdline | grep iommu";
|
|
2086
|
my $cmdline = `$cmd`;
|
|
2087
|
chomp $cmdline;
|
|
2088
|
my $iommu = 0;
|
|
2089
|
$iommu = 1 if ($cmdline =~ /iommu/);
|
|
2090
|
$cmd = "lspci -nnv";
|
|
2091
|
my $lspci = `$cmd`;
|
|
2092
|
chomp $lspci;
|
|
2093
|
my @gpu_lines = split "\n", $lspci;
|
|
2094
|
push @gpu_lines, "END";
|
|
2095
|
my $gpu;
|
|
2096
|
my $nvidia;
|
|
2097
|
my $amd;
|
|
2098
|
|
|
2099
|
my $audiodrivers = '';
|
|
2100
|
my $lookforaudiodriver = 0;
|
|
2101
|
my $bdf = '';
|
|
2102
|
foreach my $gpu_line (@gpu_lines) {
|
|
2103
|
if ($gpu_line =~ /(\w+):(\w+)\.(\w+) VGA .+\]:(.+)$/) {
|
|
2104
|
# Add bdf information
|
|
2105
|
$bdf = "$1_$2_$3";
|
|
2106
|
$gpu = {
|
|
2107
|
bus => $1,
|
|
2108
|
device => $2,
|
|
2109
|
function => $3,
|
|
2110
|
name => $4,
|
|
2111
|
bdf => $bdf,
|
|
2112
|
available => 0
|
|
2113
|
};
|
|
2114
|
$gpu->{nvidia} = 1 if ($gpu->{name} =~ /nvidia/i);
|
|
2115
|
$gpu->{amd} = 1 if ($gpu->{name} =~ /advanced micro devices/i);
|
|
2116
|
unless ($gpu->{nvidia} || $gpu->{amd}) {
|
|
2117
|
$gpu->{error} = "GPU is not Nvidia or AMD";
|
|
2118
|
}
|
|
2119
|
$gpushash{$bdf} = $gpu;
|
|
2120
|
} elsif (!$gpu) {
|
|
2121
|
$bdf = '';
|
|
2122
|
next;
|
|
2123
|
}
|
|
2124
|
# Now look for video driver in the following lines
|
|
2125
|
if (!$lookforaudiodriver && $gpu_line =~ /Kernel driver in use: (.*)/) {
|
|
2126
|
$gpu->{driver} = $1;
|
|
2127
|
# If nvidia or amd try to detach in order to check if it is in use
|
|
2128
|
if ($iommu) {
|
|
2129
|
if ($gpu->{name} && ($gpu->{nvidia} || $gpu->{amd})) {
|
|
2130
|
$cmd = "virsh nodedev-detach pci_0000_$gpu->{bus}_$gpu->{device}_$gpu->{function} 2>\&1";
|
|
2131
|
my $detach = `$cmd`;
|
|
2132
|
$gpu->{domain} = '';
|
|
2133
|
if ($detach =~ /detached/s) {
|
|
2134
|
$gpu->{detached} = 1;
|
|
2135
|
$gpu->{available} = 1;
|
|
2136
|
}
|
|
2137
|
elsif ($detach =~ /domain (.+)(\S{8})/) {
|
|
2138
|
my $domname = $1;
|
|
2139
|
my $dom = $2;
|
|
2140
|
$gpu->{domain} = $domname;
|
|
2141
|
$gpu->{domainid} = $dom;
|
|
2142
|
$gpu->{detached} = 0;
|
|
2143
|
$gpu->{available} = 1;
|
|
2144
|
}
|
|
2145
|
else {
|
|
2146
|
$gpu->{detached} = 0;
|
|
2147
|
}
|
|
2148
|
} else {
|
|
2149
|
$gpu->{detached} = 0;
|
|
2150
|
$gpu->{error} = "GPU is not Nvidia or AMD";
|
|
2151
|
}
|
|
2152
|
} else {
|
|
2153
|
$gpu->{detached} = 0;
|
|
2154
|
$gpu->{error} = "iommu is not enabled, please update your grub configuration";
|
|
2155
|
$gpushash{$bdf} = $gpu;
|
|
2156
|
$gpu = '';
|
|
2157
|
}
|
|
2158
|
}
|
|
2159
|
# If gpu has an audio controller, it should be right after the VGA part - look for audio driver
|
|
2160
|
elsif ($gpu_line =~ /^(\w+):(\w+)\.(\w+) (\S+) .+\]:(.+)$/) {
|
|
2161
|
if (lc $4 eq 'audio' ) {
|
|
2162
|
$lookforaudiodriver = 1;
|
|
2163
|
} else {
|
|
2164
|
$lookforaudiodriver = 0;
|
|
2165
|
$gpushash{$bdf} = $gpu;
|
|
2166
|
}
|
|
2167
|
} elsif ($lookforaudiodriver && $gpu_line =~ /Kernel driver in use: (\S+)/) {
|
|
2168
|
$audiodrivers .= $1;
|
|
2169
|
$lookforaudiodriver = 0;
|
|
2170
|
$gpu->{audiodrivers} = $audiodrivers;
|
|
2171
|
$gpushash{$bdf} = $gpu;
|
|
2172
|
$gpu = '';
|
|
2173
|
} elsif ($gpu_line =~ /END/) {
|
|
2174
|
$gpushash{$bdf} = $gpu;
|
|
2175
|
$gpu = '';
|
|
2176
|
}
|
|
2177
|
}
|
|
2178
|
my $smi = `command -v nvidia-smi`;
|
|
2179
|
chomp $smi;
|
|
2180
|
# Look for amount of VRAM
|
|
2181
|
if ($getvram && $smi) {
|
|
2182
|
my $vramtotal = 0;
|
|
2183
|
my $attach;
|
|
2184
|
foreach my $gpu (values %gpushash) {
|
|
2185
|
if ($gpu->{nvidia}) {
|
|
2186
|
# In order to query vram Nvidia GPUs must be re-attached
|
|
2187
|
$cmd = "virsh nodedev-reattach pci_0000_$gpu->{bus}_$gpu->{device}_$gpu->{function} 2>\&1";
|
|
2188
|
$attach = `$cmd`;
|
|
2189
|
$attach = 1 if ($attach =~ /re-attached/);
|
|
2190
|
# https://stackoverflow.com/questions/77708142/how-can-i-fetch-vram-and-gpu-cache-size-in-linux
|
|
2191
|
} elsif ($gpu->{amd}) {
|
|
2192
|
my $slot = "0000:$gpu->{bus}:$gpu->{device}:$gpu->{function}";
|
|
2193
|
$cmd = "cat /sys/bus/pci/devices/$slot/mem_info_vram_total";
|
|
2194
|
my $vram = `$cmd`;
|
|
2195
|
chomp $vram;
|
|
2196
|
$vram = $vram /1024/1024; # bytes -> MB
|
|
2197
|
$vramtotal += $vram;
|
|
2198
|
$gpushash{$gpu->{bdf}}->{vram} = $vram+0;
|
|
2199
|
}
|
|
2200
|
}
|
|
2201
|
if ($attach && $smi) { # We have at elast 1 Nvidia GPU attached
|
|
2202
|
$cmd = "modprobe nvidia";
|
|
2203
|
`$cmd`;
|
|
2204
|
$cmd = "LANG=C $smi --query-gpu=gpu_bus_id,memory.total,name --format=csv,noheader,nounits";
|
|
2205
|
my $vramlines = `$cmd`;
|
|
2206
|
foreach my $line (split "\n", $vramlines) {
|
|
2207
|
my ($line_bdf, $line_vram, $line_name) = split( /, ?/, $line);
|
|
2208
|
next unless ($line_bdf);
|
|
2209
|
$vramtotal += $line_vram*1024; # GB -> MB
|
|
2210
|
if ($line_bdf =~ /:(\d+):(\d+)\.(\d+)/) {
|
|
2211
|
$line_bdf = "$1_$2_$3";
|
|
2212
|
$gpushash{$line_bdf}->{vram} = $line_vram ; # MB
|
|
2213
|
}
|
|
2214
|
}
|
|
2215
|
}
|
|
2216
|
}
|
|
2217
|
if ($audiodrivers) {
|
|
2218
|
my $lsmod = `lsmod`;
|
|
2219
|
my @adrivers = split / +|, ?/, $audiodrivers;
|
|
2220
|
foreach my $adriver (@adrivers) {
|
|
2221
|
if ($lsmod =~ /$adriver/) {
|
|
2222
|
my $res = `modprobe -rv $adriver 2>&1`;
|
|
2223
|
}
|
|
2224
|
}
|
|
2225
|
}
|
|
2226
|
my @gpulist = values %gpushash;
|
|
2227
|
my $gfree = 0;
|
|
2228
|
foreach my $gpu (@gpulist) {
|
|
2229
|
$gfree++ if (!$gpu->{error} && $gpu->{available} && $gpu->{detached});
|
|
2230
|
}
|
|
2231
|
$gpusfree = $gfree;
|
|
2232
|
if ($api) {
|
|
2233
|
return values @gpulist;
|
|
2234
|
} else {
|
|
2235
|
return JSON::to_json(\@gpulist, {pretty => 1});
|
|
2236
|
}
|
|
2237
|
}
|
|
2238
|
|
|
2239
|
sub TERMINATE {
|
|
2240
|
$running = 0;
|
|
2241
|
$status = "shutdown" unless ($status eq "asleep");
|
|
2242
|
$glogentry = "--: nodes: $nmac: $status: Shutting down $identity piston...";
|
|
2243
|
updatePistonInfo();
|
|
2244
|
if ($identity eq "vbox") {
|
|
2245
|
logit('info', "Shutting down Virtual Box piston");
|
|
2246
|
# print `/etc/init.d/vboxdrv stop`,"\n";
|
|
2247
|
} else {
|
|
2248
|
logit('info', "Shutting down KVM piston");
|
|
2249
|
# print `/etc/init.d/kvm stop`,"\n";
|
|
2250
|
}
|
|
2251
|
##logit("debug", `killall movepiston`);
|
|
2252
|
##exit(0);
|
|
2253
|
}
|
|
2254
|
|
|
2255
|
##
|