Project

General

Profile

Download (59.7 KB) Statistics
| Branch: | Revision:
1
#!/usr/bin/perl
2

    
3
# All rights reserved and Copyright (c) 2020 Origo Systems ApS.
4
# This file is provided with no warranty, and is subject to the terms and conditions defined in the license file LICENSE.md.
5
# The license file is part of this source code package and its content is also available at:
6
# https://www.origo.io/info/stabiledocs/licensing/stabile-open-source-license
7

    
8
package Stabile::Nodes;
9

    
10
# use LWP::Simple;
11
use Error qw(:try);
12
use File::Basename;
13
use Config::Simple;
14
use lib dirname (__FILE__);
15
use Stabile;
16

    
17
my $backupdir = $Stabile::config->get('STORAGE_BACKUPDIR') || "/mnt/stabile/backups";
18
my $tenderpaths = $Stabile::config->get('STORAGE_POOLS_LOCAL_PATHS') || "/mnt/stabile/images";
19
my @tenderpathslist = split(/,\s*/, $tenderpaths);
20
my $tendernames = $Stabile::config->get('STORAGE_POOLS_NAMES') || "Standard storage";
21
my @tendernameslist = split(/,\s*/, $tendernames);
22
$amtpasswd = $Stabile::config->get('AMT_PASSWD') || "";
23
$brutalsleep = $Stabile::config->get('BRUTAL_SLEEP') || "";
24

    
25
$uiuuid;
26
$uistatus;
27
$help = 0; # If this is set, functions output help
28

    
29
our %ahash; # A hash of accounts and associated privileges current user has access to
30
#our %options=();
31
# -a action -h help -u uuid -m match pattern -f full list, i.e. all users
32
# -v verbose, include HTTP headers -s impersonate subaccount -t target [uuid or image]
33
# -g args to gearman task
34
#Getopt::Std::getopts("a:hfu:g:m:vs:t:", \%options);
35

    
36
try {
37
    Init(); # Perform various initalization tasks
38
    if (!$isadmin && $action ne "list" && $action ne "listnodeidentities" && $action ne "listlog" && $action ne "help") {return "Status=Error Insufficient privileges for $user ($tktuser)\n"};
39
    process() if ($package);
40

    
41
} catch Error with {
42
    my $ex = shift;
43
    print header('text/html', '500 Internal Server Error') unless ($console);
44
    if ($ex->{-text}) {
45
        print "Got error: ", $ex->{-text}, " on line ", $ex->{-line}, " in file ", $ex->{-file}, "\n";
46
    } else {
47
        print "Status=ERROR\n";
48
    }
49
} finally {
50
};
51

    
52
1;
53

    
54
sub getObj {
55
    my %h = %{@_[0]};
56
    $console = 1 if $h{"console"};
57
    $api = 1 if $h{"api"};
58
    $action = $action || $h{'action'};
59
    my $mac = $h{"uuid"} || $h{"mac"};
60
    my $dbobj = $register{$mac} || {};
61
    my $obj;
62
    my $status = $dbobj->{'status'} || $h{"status"}; # Trust db status if it exists
63
    if ($action =~ /all$|configurecgroups|listgpus|getnextgpus/) {
64
        $obj = \%h;
65
    } else {
66
        return 0 unless (($mac && length $mac == 12) );
67
        my $name = $h{"name"} || $dbobj->{'name'};
68
        $obj = $dbobj;
69
        $obj->{"name"} = $name if ($name);
70
        $obj->{"status"} = $status if ($status);
71
    }
72
    return $obj;
73
}
74

    
75
sub Init {
76
    # Tie database tables to hashes
77
    unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac'}, $Stabile::dbopts)) ) {return "Unable to access nodes register"};
78
    unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username'}, $Stabile::dbopts)) ) {return "Unable to access user register"};
79

    
80
    # simplify globals initialized in Stabile.pm
81
    $tktuser = $tktuser || $Stabile::tktuser;
82
    $user = $user || $Stabile::user;
83

    
84
    # Create aliases of functions
85
    *header = \&CGI::header;
86

    
87
    *Fullstats = \&Stats;
88
    *Fullstatsb = \&Stats;
89

    
90
    *do_help = \&action;
91
    *do_remove = \&do_delete;
92
    *do_tablelist = \&do_list;
93
    *do_listnodes = \&do_list;
94
    *do_stats = \&action;
95
    *do_fullstats = \&privileged_action;
96
    *do_fullstatsb = \&privileged_action;
97
    *do_updateamtinfo = \&privileged_action;
98
    *do_gear_updateamtinfo = \&do_gear_action;
99
    *do_configurecgroups = \&privileged_action;
100
    *do_gear_fullstats = \&do_gear_action;
101
    *do_gear_fullstatsb = \&do_gear_action;
102
    *do_gear_configurecgroups = \&do_gear_action;
103
    *do_listgpus = \&privileged_action;
104
    *do_getnextgpus = \&privileged_action;
105
    *do_gear_listgpus = \&do_gear_action;
106
    *do_gear_getnextgpus = \&do_gear_action;
107

    
108
}
109

    
110
sub do_listnodeidentities {
111
    my ($uuid, $action, $obj) = @_;
112
    if ($help) {
113
        return <<END
114
GET::
115
List the identities supported by this engine.
116
END
117
    }
118
    unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities', key=>'identity'}, $Stabile::dbopts)) ) {return "Unable to access identity register"};
119
    my @idvalues = values %idreg;
120
    my @newidvalues;
121
    my $i = 1;
122
    foreach my $val (@idvalues) {
123
        my %h = %$val;
124
        if ($h{'identity'} eq "default") {$h{'id'} = "0";}
125
        else {$h{'id'} = "$i"; $i++;};
126
        push @newidvalues,\%h;
127
    }
128
    untie %idreg;
129
    my $json_text = to_json(\@newidvalues, {pretty=>1});
130
    $postreply = qq|{"identifier": "id", "label": "name", "items": $json_text }|;
131
    return $postreply;
132
}
133

    
134
sub do_terminal {
135
    my ($uuid, $action, $obj) = @_;
136
    if ($help) {
137
        return <<END
138
GET:mac:
139
Open direct ssh access to specified node through shellinabox.
140
END
141
    }
142
    my $mac = $uuid || $params{'mac'} || $obj->{'mac'};
143
    if ($mac && $isadmin) {
144
        my $macip = $register{$mac}->{'ip'};
145
        my $macname = $register{$mac}->{'name'};
146
        my $terminalcmd = qq[/usr/share/stabile/shellinabox/shellinaboxd --cgi -t --css=$Stabile::basedir/static/css/shellinabox.css --debug -s "/:www-data:www-data:HOME:/usr/bin/ssh -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no $macip" 2>/tmp/sib.log];
147
        my $cmdout = `$terminalcmd`;
148
        $cmdout =~ s/<title>.+<\/title>/<title>Node: $macname<\/title>/;
149
        $cmdout =~ s/:(\d+)\//\/shellinabox\/$1\//g;
150
        $postreply = $cmdout;
151
    } else {
152
        $postreply = "Status=ERROR Unable to open terminal: $Stabile::basedir\n";
153
    }
154
    return $postreply;
155
}
156

    
157
sub do_save {
158
    my ($uuid, $action, $obj) = @_;
159
    if ($help) {
160
        return <<END
161
PUT:name:
162
Set the name of node.
163
END
164

    
165
    }
166
}
167

    
168
sub do_sol {
169
    my ($uuid, $action, $obj) = @_;
170
    if ($help) {
171
        return <<END
172
GET:mac:
173
Open serial over lan access to specified node through shellinabox.
174
END
175
    }
176
    my $mac = $uuid || $params{'mac'} || $obj->{'mac'};
177
    if ($mac && $isadmin) {
178
        my $solcmd;
179
        my $macname = $register{$mac}->{'name'};
180
        my $amtip = $register{$mac}->{'amtip'};
181
        my $ipmiip = $register{$mac}->{'ipmiip'};
182
        if ($amtip && $amtip ne '--') {
183
            `pkill -f 'amtterm $amtip'`;
184
            $amtpasswd =~ s/\!/\\!/;
185
            $solcmd = "AMT_PASSWORD='$amtpasswd' /usr/bin/amtterm $amtip";
186
        } elsif ($ipmiip && $ipmiip ne '--') {
187
            `ipmitool -I lanplus -H $ipmiip -U ADMIN -P ADMIN sol deactivate`;
188
            $solcmd .= "ipmitool -I lanplus -H $ipmiip -U ADMIN -P ADMIN sol activate";
189
        }
190
        if ($solcmd ) {
191
            my $terminalcmd = qq[/usr/share/stabile/shellinabox/shellinaboxd --cgi -t --css=$Stabile::basedir/static/css/shellinabox.css --debug -s "/:www-data:www-data:HOME:$solcmd" 2>/tmp/sib.log];
192
         #   print header(), "Got sol $terminalcmd\n"; exit;
193
            my $cmdout = `$terminalcmd`;
194
            $cmdout =~ s/<title>.+<\/title>/<title>SOL: $macname<\/title>/;
195
            $cmdout =~ s/:(\d+)\//\/shellinabox\/$1\//g;
196
            $postreply = $cmdout;
197
        } else {
198
            $postreply = "Status=ERROR This node does not support serial over lan\n";
199
        }
200
    } else {
201
        $postreply = "Status=ERROR You must specify mac address and have admin rights.\n";
202
    }
203
    return $postreply;
204
}
205

    
206
sub do_maintenance {
207
    my ($uuid, $action, $obj) = @_;
208
    if ($help) {
209
        return <<END
210
GET:mac:
211
Puts the specified node in maintenance mode. A node in maintenance mode is not available for starting new servers.
212
END
213
    }
214
    my $status = $obj->{'status'};
215
    my $mac = $obj->{'mac'};
216
    my $name = $obj->{'name'};
217
    my $dbstatus = $register{$mac}->{'status'};
218
    if ($dbstatus eq "running") {
219
        $uistatus = "maintenance";
220
        $uiuuid = $mac;
221
        $register{$mac}->{'status'} = $uistatus;
222
        $register{$mac}->{'maintenance'} = 1;
223
        my $logmsg = "Node $mac marked for $action";
224
        $main::syslogit->($user, "info", $logmsg);
225
        $postreply .= "Status=$uistatus OK putting $name in maintenance mode\n";
226
        $main::updateUI->({tab=>"nodes", user=>$user, uuid=>$uiuuid, status=>$uistatus});
227
    } else {
228
        $postreply .= "Status=ERROR Cannot $action a $status node\n";
229
    }
230
    return $postreply;
231
}
232

    
233
sub do_sleep {
234
    my ($uuid, $action, $obj) = @_;
235
    if ($help) {
236
        return <<END
237
GET:mac:
238
Put an idle node to sleep. S3 sleep must be supported and enabled.
239
END
240
    }
241
    my $status = $obj->{'status'};
242
    my $mac = $obj->{'mac'};
243
    my $name = $obj->{'name'};
244
    my $dbstatus = $register{$mac}->{'status'};
245

    
246
    if ($status eq "running" && $register{$mac}->{'vms'}==0) {
247
        my $logmsg = "Node $mac marked for $action ";
248
        $uiuuid = $mac;
249
        if ($brutalsleep && (
250
            ($register{$mac}->{'amtip'} && $register{$mac}->{'amtip'} ne '--')
251
                || ($register{$mac}->{'ipmiip'} && $register{$mac}->{'ipmiip'} ne '--')
252
        )) {
253
            my $sleepcmd;
254
            $uistatus = "asleep";
255
            if ($register{$mac}->{'amtip'} && $register{$mac}->{'amtip'} ne '--') {
256
                $sleepcmd = "echo 'y' | AMT_PASSWORD='$amtpasswd' /usr/bin/amttool $register{$mac}->{'amtip'} powerdown";
257
            } else {
258
                $uistatus = "asleep";
259
                $sleepcmd = "ipmitool -I lanplus -H $register{$mac}->{'ipmiip'} -U ADMIN -P ADMIN power off";
260
            }
261
            $uiuuid = $mac;
262
            $register{$mac}->{'status'} = $uistatus;
263
            $logmsg .= `$sleepcmd`;
264
        } else {
265
            $uistatus = "sleeping";
266
            my $tasks = $register{$mac}->{'tasks'};
267
            $register{$mac}->{'tasks'} = $tasks . $action . " $user \n";
268
            $register{$mac}->{'action'} = "";
269
        }
270
        $register{$mac}->{'status'} = $uistatus;
271
        $logmsg =~ s/\n/ /g;
272
        $main::syslogit->($user, "info", $logmsg);
273
        $postreply .= "Status=$uistatus OK putting $name to sleep\n";
274
    } else {
275
        $postreply .= "Status=ERROR Cannot $action a $dbstatus node or a node with running VMs\n";
276
    }
277
    return $postreply;
278
}
279

    
280
sub do_wake {
281
    my ($uuid, $action, $obj) = @_;
282
    if ($help) {
283
        return <<END
284
GET:mac:
285
Tries to wake or start a node by sending a wake-on-LAN magic packet to the node.
286
END
287
    }
288
    my $status = $obj->{'status'};
289
    my $mac = $obj->{'mac'} || $uuid;
290
    my $name = $obj->{'name'};
291
    my $wakecmd;
292

    
293
    if (1 || $status eq "asleep" || $status eq "inactive" || $status eq "shutdown") {
294
        $uistatus = "waking";
295
        my $logmsg = "Node $mac marked for wake ";
296
        if ($brutalsleep && (
297
            ($register{$mac}->{'amtip'} && $register{$mac}->{'amtip'} ne '--')
298
                || ($register{$mac}->{'ipmiip'} && $register{$mac}->{'ipmiip'} ne '--')
299
        )) {
300
            if ($register{$mac}->{'amtip'} && $register{$mac}->{'amtip'} ne '--') {
301
                $wakecmd = "echo 'y' | AMT_PASSWORD='$amtpasswd' /usr/bin/amttool $register{$mac}->{'amtip'} powerup pxe";
302
            } else {
303
                $wakecmd = "ipmitool -I lanplus -H $register{$mac}->{'ipmiip'} -U ADMIN -P ADMIN power on";
304
            }
305
            $register{$mac}->{'status'} = $uistatus;
306
            $logmsg .= `$wakecmd`;
307
        } else {
308
            $realmac = substr($mac,0,2).":".substr($mac,2,2).":".substr($mac,4,2).":".substr($mac,6,2).":".substr($mac,8,2).":".substr($mac,10,2);
309
            my $broadcastip = $register{$mac}->{'ip'};
310
            $broadcastip =~ s/\.\d{1,3}$/.255/;
311
            $broadcastip = $broadcastip || '10.0.0.255';
312
            $wakecmd = "/usr/bin/wakeonlan -i $broadcastip $realmac";
313
            $logmsg .= `$wakecmd`;
314
        }
315
        $logmsg =~ s/\n/ /g;
316
        $main::syslogit->($user, "info", $logmsg);
317
        $register{$mac}->{'status'} = 'waking';
318
        $postreply .= "Status=$uistatus OK $uistatus $name ($mac)\n";
319
    } else {
320
        $postreply .= "Status=ERROR Cannot $action up a $status node\n";
321
    }
322
    return $postreply;
323
}
324

    
325
sub do_carryon {
326
    my ($uuid, $action, $obj) = @_;
327
    if ($help) {
328
        return <<END
329
GET:mac:
330
Puts the specified node out of maintenance mode. A node in maintenance mode is not available for starting new servers.
331
END
332
    }
333
    my $status = $obj->{'status'};
334
    my $mac = $obj->{'mac'};
335
    my $name = $obj->{'name'};
336
    my $dbstatus = $register{$mac}->{'status'};
337
    if ($dbstatus eq "maintenance") {
338
        $uistatus = "running";
339
        $uiuuid = $mac;
340
        $register{$mac}->{'status'} = $uistatus;
341
        $register{$mac}->{'maintenance'} = 0;
342
        my $logmsg = "Node $mac marked for $action";
343
        $main::syslogit->($user, "info", $logmsg);
344
        $postreply .= "Status=$uistatus OK putting $name out of maintenance mode\n";
345
        $main::updateUI->({tab=>"nodes", user=>$user, uuid=>$uiuuid, status=>$uistatus});
346
    } else {
347
        $postreply .= "Status=ERROR Cannot $action a $status node\n";
348
    }
349
    return $postreply;
350
}
351

    
352
sub do_reboot {
353
    my ($uuid, $action, $obj) = @_;
354
    if ($help) {
355
        return <<END
356
GET:mac:
357
Reboots the specified node.
358
END
359
    }
360
    my $status = $obj->{'status'};
361
    my $mac = $obj->{'mac'};
362
    my $name = $obj->{'name'};
363
    if (($status eq "running" || $status eq "maintenance" ) && $register{$mac}->{'vms'}==0) {
364
        $uistatus = "rebooting";
365
        $uiuuid = $mac;
366
        my $tasks = $register{$mac}->{'tasks'};
367
        $register{$mac}->{'tasks'} = $tasks . $action . " $user\n";
368
        $register{$mac}->{'action'} = "";
369
        $register{$mac}->{'status'} = $uistatus;
370
        my $logmsg = "Node $mac marked for $action";
371
        $main::syslogit->($user, "info", $logmsg);
372
        $postreply = "Status=$uistatus OK rebooting $name\n";
373
    } else {
374
        $postreply = "Status=ERROR Cannot $action a $status node or a node with running VMs\n";
375
    }
376
    return $postreply;
377
}
378

    
379
sub do_halt {
380
    my ($uuid, $action, $obj) = @_;
381
    if ($help) {
382
        return <<END
383
GET:mac:
384
Halts the specified node.
385
END
386
    }
387
    my $mac = $obj->{'mac'};
388
    my $name = $obj->{'name'};
389
    $uistatus = "halting";
390
    $uiuuid = $mac;
391
	my $tasks = $register{$mac}->{'tasks'};
392
	$register{$mac}->{'tasks'} = $tasks . $action . " $user\n";
393
	$register{$mac}->{'action'} = "";
394
	$register{$mac}->{'status'} = $uistatus;
395
	my $logmsg = "Node $mac marked for $action";
396
	$main::syslogit->($user, "info", $logmsg);
397
	$postreply .= "Status=$uistatus OK $uistatus $name\n";
398
    return $postreply;
399
}
400

    
401
sub do_delete {
402
    my ($uuid, $action, $obj) = @_;
403
    if ($help) {
404
        return <<END
405
GET:mac:
406
Deletes a node. Use if a node has been physically removed from engine.
407
END
408
    }
409
    my $mac = $obj->{'mac'};
410
    my $name = $obj->{'name'};
411
    if ($status ne "running" && $status ne "maintenance" && $status ne "sleeping"
412
        && $status ne "reload" && $status ne "reloading") {
413
        if ($register{$mac}) {
414
            $uistatus = "deleting";
415
            $uiuuid = $mac;
416
            my $logmsg = "Node $mac marked for deletion";
417
            $main::syslogit->($user, "info", $logmsg);
418
            $postreply .= "Status=$uistatus OK deleting $name ($mac)\n";
419
            $mac =~ /(\w\w)(\w\w)(\w\w)(\w\w)(\w\w)(\w\w)/;
420
            my $file = "/mnt/stabile/tftp/pxelinux.cfg/01-$1-$2-$3-$4-$5-$6";
421
            unlink $file if (-e $file);
422
            delete $register{$mac};
423
            $main::updateUI->({tab=>"nodes", user=>$user});
424
        } else {
425
            $postreply .= "Status=ERROR Node $mac not found\n" . Dumper($obj);
426
        }
427
    } else {
428
        $postreply .= "Status=ERROR Cannot $action a $status node\n";
429
    }
430
    return $postreply;
431
}
432

    
433
sub do_shutdown {
434
    my ($uuid, $action, $obj) = @_;
435
    if ($help) {
436
        return <<END
437
GET:mac:
438
Shuts down the specified node.
439
END
440
    }
441
    my $status = $obj->{'status'};
442
    my $mac = $obj->{'mac'};
443
    my $name = $obj->{'name'};
444
    if ($status eq "running" && $register{$mac}->{'vms'}==0) {
445
        $uistatus = "shuttingdown";
446
        $uiuuid = $mac;
447
        my $tasks = $register{$mac}->{'tasks'};
448
        $register{$mac}->{'tasks'} = $tasks . $action . " $user\n";
449
        $register{$mac}->{'action'} = "";
450
        $register{$mac}->{'status'} = $uistatus;
451
        my $logmsg = "Node $mac marked for $action";
452
        $main::syslogit->($user, "info", $logmsg);
453
        $postreply .= "Status=$uistatus OK shutting down $name\n";
454
    } else {
455
        $postreply .= "Status=ERROR Cannot $action a $status node or a node with running VMs\n";
456
    }
457
}
458

    
459
sub do_evacuate {
460
    my ($uuid, $action, $obj) = @_;
461
    if ($help) {
462
        return <<END
463
GET:mac:
464
Evacuates the specified node, i.e. tries to migrate all servers away from the node. Node must be in maintenance mode.
465
END
466
    }
467
    my $status = $obj->{'status'};
468
    my $mac = $obj->{'mac'};
469
    my $name = $obj->{'name'};
470
    my $dbstatus = $register{$mac}->{'status'};
471
    if ($dbstatus eq "maintenance" || $dbstatus eq "running") {
472
        $register{$mac}->{'status'} = 'maintenance' if ($dbstatus eq "running");
473
        $uistatus = "evacuating";
474
        $uiuuid = $mac;
475
        unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
476

    
477
        my $actionstr;
478
        my $i = 0;
479
        foreach my $dom (keys %domreg) {
480
            if ($domreg{$dom}->{'mac'} eq $mac &&
481
                ($domreg{$dom}->{'status'} eq 'running' || $domreg{$dom}->{'status'} eq 'paused')) {
482
                $actionstr .= qq[{"uuid": "$dom", "action": "stormove", "console": 1}, ];
483
                $i++;
484
            }
485
        }
486
        untie %domreg;
487
        if ($actionstr) {
488
            $actionstr = substr($actionstr,0,-2);
489
            my $postdata = URI::Escape::uri_escape(
490
                qq/{"identifier": "uuid", "label": "uuid", "items":[$actionstr]}/
491
            );
492
            my $res;
493
            my $cmd;
494
            if ($console) {
495
                $res = `REMOTE_USER=$user $Stabile::basedir/cgi/servers.cgi -g $postdata`;
496
                $postreply .= "Stroke=OK Move: $res\n";
497
            } else {
498
                $cmd = qq|/usr/bin/ssh -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no localhost REMOTE_USER=$user $Stabile::basedir/cgi/servers.cgi -g $postdata|;
499
                $res = `$cmd`;
500
#                $postreply .= "Stroke=OK Now moving: $i servers $actionstr\n";
501
            }
502
#            $res =~ s/\n/ - /g;
503
            my $logmsg = "Node $mac marked for $action";
504
            $main::syslogit->($user, "info", $logmsg);
505
            $postreply .= "Status=OK Node $name marked for evacuation ($i servers)\n";
506
        } else {
507
            $postreply .= "Status=OK No servers found to evacaute\n";
508
        }
509
    } else {
510
        $postreply .= "Status=ERROR Cannot $action a $status node (not in maintenance, not running)\n";
511
    }
512
    return $postreply;
513
}
514

    
515

    
516
sub do_reset {
517
    my ($uuid, $action, $obj) = @_;
518
    if ($help) {
519
        return <<END
520
GET:mac:
521
Resets the specified node.
522
END
523
    }
524
    my $mac = $obj->{'mac'};
525
    my $name = $obj->{'name'};
526
    my $dbstatus = $register{$mac}->{'status'};
527
    if (($dbstatus eq "maintenance" && $register{$mac}->{'vms'} == 0)
528
        || $dbstatus eq "inactive"
529
        || $dbstatus eq "waking"
530
        || $dbstatus eq "sleeping"
531
        || $dbstatus eq "shuttingdown"
532
        || $dbstatus eq "shutdown"
533
        || $dbstatus eq "joining"
534
    ) {
535
        my $resetcmd;
536
        if ($register{$mac}->{'amtip'} && $register{$mac}->{'amtip'} ne '--') {
537
            $uistatus = "reset";
538
            $resetcmd = "echo 'y' | AMT_PASSWORD='$amtpasswd' /usr/bin/amttool $register{$mac}->{'amtip'} reset bios";
539
        } elsif ($register{$mac}->{'ipmiip'} && $register{$mac}->{'ipmiip'} ne '--') {
540
            $uistatus = "reset";
541
            $resetcmd = "ipmitool -I lanplus -H $register{$mac}->{'ipmiip'} -U ADMIN -P ADMIN power reset";
542
        } else {
543
            $postreply .= "Status=ERROR This node does not support hardware reset\n";
544
        }
545
        if ($uistatus eq 'reset') {
546
            $uiuuid = $mac;
547
            $register{$mac}->{'status'} = $uistatus;
548
            my $logmsg = "Node $mac marked for $action";
549
            $logmsg .= `$resetcmd`;
550
            $logmsg =~ s/\n/ /g;
551
            $main::syslogit->($user, "info", $logmsg);
552
            $postreply .= "Stroke=$uistatus OK resetting $name ";
553
        }
554
    } else {
555
        $postreply .= "Status=ERROR Cannot $action a $dbstatus node\n";
556
    }
557
    return $postreply;
558
}
559

    
560
sub do_unjoin {
561
    my ($uuid, $action, $obj) = @_;
562
    if ($help) {
563
        return <<END
564
GET:mac:
565
Disassciates a node from the engine and reboots it. After rebooting, it will join the engine with the default
566
node identity
567
END
568
    }
569
    my $mac = $obj->{'mac'};
570
    my $name = $obj->{'name'};
571
    my $dbstatus = $register{$mac}->{'status'};
572
    if ($dbstatus eq "running" && $register{$mac}->{'vms'}==0) {
573
        $uistatus = "unjoining";
574
        $uiuuid = $mac;
575
        my $tasks = $register{$mac}->{'tasks'};
576
        $register{$mac}->{'tasks'} = $tasks . $action . " $user\n";
577
        $register{$mac}->{'action'} = "";
578
        $register{$mac}->{'status'} = $uistatus;
579
        my $logmsg = "Node $mac marked for $action";
580
        $main::syslogit->($user, "info", $logmsg);
581
        $postreply .= "Status=$uistatus OK unjoining $name\n";
582
    } else {
583
        $postreply .= "Status=ERROR Cannot $action a $dbstatus node or a node with running VMs\n";
584
    }
585
    return $postreply;
586
}
587

    
588
sub do_wipe {
589
    my ($uuid, $action, $obj) = @_;
590
    if ($help) {
591
        return <<END
592
GET:mac:
593
Erases a node's harddrive and formats it with either ext4 or zfs, depending on settings.
594
Only allowed if /mnt/stabile/node is empty.
595
END
596
    }
597
    my $mac = $obj->{'mac'};
598
    my $name = $obj->{'name'};
599
    unless ($register{$mac}) {
600
        $postreply .= "Status=ERROR Please specify a valid mac.\n";
601
        return $postreply;
602
    }
603
    my $dbstatus = $register{$mac}->{'status'};
604
    if ($dbstatus eq "running" && $register{$mac}->{'vms'}==0) {
605
        $uistatus = "wiping";
606
        $uiuuid = $mac;
607
        my $tasks = $register{$mac}->{'tasks'};
608
        $register{$mac}->{'tasks'} = $tasks . $action . " $user\n";
609
        $register{$mac}->{'action'} = "";
610
        $register{$mac}->{'status'} = $uistatus;
611
        my $logmsg = "Node $mac marked for $action";
612
        $main::syslogit->($user, "info", $logmsg);
613
        $postreply .= "Status=$uistatus OK wiping $name\n";
614
    } else {
615
        $postreply .= "Status=ERROR Cannot $action a $dbstatus node or a node with running VMs\n";
616
    }
617
    return $postreply;
618
}
619

    
620
sub do_setdefaultnodeidentity {
621
    my ($uuid, $action, $obj) = @_;
622
    if ($help) {
623
        return <<END
624
GET:hid,sleepafter:
625
Sets the default identity a node should boot as. [sleepafter] is in seconds, [hid] is [name] of one the alternatives listed by [listnodeidentities].
626
END
627
    }
628
    my $hid = $params{'hid'};
629
    my $sleepafter = $params{'sleepafter'};
630
    unless ($hid) {return "Status=ERROR No identity selected\n"};
631
    unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities', key=>'name'}, $Stabile::dbopts)) ) {return "Unable to access id register"};
632
    my @idvalues = values %idreg;
633
    foreach my $val (@idvalues) {
634
        my $identity = $val->{'name'};
635
        if ($identity eq $hid) {$identity = "default"}
636
        $idreg{$val->{'name'}} = {
637
            identity=>$identity,
638
            sleepafter=>int($sleepafter)
639
        }
640
    }
641
    tied(%idreg)->commit;
642
    untie %idreg;
643
    $postreply = "Status=OK Set $hid as new default identity, sleeping after $sleepafter minutes\n";
644
}
645

    
646
sub do_listlog {
647
    my ($uuid, $action, $obj) = @_;
648
    if ($help) {
649
        return <<END
650
GET::
651
Lists the last 200 lines from the local activity log file.
652
END
653
    }
654
    $postreply = header("text/plain");
655
    if ($isadmin) {
656
        $postreply .= `tail -n 200 $main::logfile`;
657
    } else {
658
        $postreply .= `tail -n 200 $main::logfile | grep ': $user :'`;
659
    }
660
}
661

    
662
sub do_clearlog {
663
    my ($uuid, $action, $obj) = @_;
664
    if ($help) {
665
        return <<END
666
GET::
667
Clear the local activity log file.
668
END
669
    }
670
    `> $main::logfile`;
671
    # unlink $logfile;
672
    $postreply = header("text/plain");
673
    $postreply .=  "Status=OK Log cleared\n";
674
    return $postreply;
675
}
676

    
677
sub do_updateregister {
678
    my ($uuid, $action, $obj) = @_;
679
    if ($help) {
680
        return <<END
681
GET::
682
Updates the node register.
683
END
684
    }
685
    updateRegister();
686
    $postreply = "Stream=OK Updated node register for all users\n";
687
    return $postreply;
688
}
689

    
690
sub do_reload {
691
    my ($uuid, $action, $obj) = @_;
692
    if ($help) {
693
        return <<END
694
GET:mac,nodeaction:
695
Reload configuration on the specified node or perform specified action.
696
END
697
    }
698
    my $status = $obj->{'status'};
699
    my $mac = $obj->{'mac'};
700
    my $nodeaction = "reload" || $obj->{'nodeaction'};
701
    if ($status eq "running") {
702
        $uistatus = "reloading";
703
        $uiuuid = $mac;
704
        my $tasks = $register{$mac}->{'tasks'};
705
        $register{$mac}->{'tasks'} = $tasks . $nodeaction . " $user\n";
706
        $register{$mac}->{'action'} = "";
707
        $register{$mac}->{'status'} = $uistatus;
708
        my $logmsg = "Node $mac marked for $action";
709
        $main::syslogit->($user, "info", $logmsg);
710
        $postreply .= "Status=$uistatus OK reloading $name\n";
711
    }
712
    else {
713
        $postreply .= "Status=ERROR Cannot $action a $status node\n";
714
    }
715
    return $postreply;
716
}
717

    
718
sub do_reloadall {
719
    my ($uuid, $action, $obj) = @_;
720
    if ($help) {
721
        return <<END
722
GET:nodeaction:
723
Reload configuration on all nodes. Alternatively specify a "nodeaction" to have it executed on all nodes.
724
Currently supported nodeactions: CGLOAD [reload cgroup configuration]
725
END
726
    }
727
    my $nodeaction = $obj->{'nodeaction'} || "reload";
728
    my @regvalues = values %register;
729
    # Only include pistons we have heard from in the last 20 secs
730
    foreach $val (@regvalues) {
731
        my $curstatus =  $val->{'status'};
732
        my $mac = $val->{'mac'};
733
        my $name = $val->{'name'};
734
        if ($curstatus eq "running" || $curstatus eq "maintenance") {
735
            $uistatus = "reloading";
736
            $uiuuid = $mac;
737
            my $tasks = $register{$mac}->{'tasks'};
738
            $register{$mac}->{'tasks'} = $tasks . $nodeaction . " $user\n";
739
            $register{$mac}->{'action'} = "";
740
            $register{$mac}->{'status'} = $uistatus;
741
            my $logmsg = "Node $mac marked for $nodeaction";
742
            $main::syslogit->($user, "info", $logmsg);
743
            $postreply .= "Status=OK $uistatus $name\n";
744
        } else {
745
            $postreply .= "Status=OK Node $mac ($register->{$mac}) is $register{$mac}->{'status'} not reloading\n";
746
        }
747
    }
748
    return $postreply;
749
}
750

    
751
sub do_rebootall {
752
    my ($uuid, $action, $obj) = @_;
753
    if ($help) {
754
        return <<END
755
GET::
756
Reboot all active nodes.
757
END
758
    }
759
    my @regvalues = values %register;
760
# Only include pistons we have heard from in the last 20 secs
761
    foreach $val (@regvalues) {
762
        my $curstatus =  $val->{'status'};
763
        my $mac = $val->{'mac'};
764
        $action = "reboot";
765
        my $name = $val->{'name'};
766
        my $identity = $val->{'identity'};
767
        if (($curstatus eq "running" || $curstatus eq "maintenance") && $identity ne 'local_kvm')
768
        {
769
              $uistatus = "rebooting";
770
              $uiuuid = $mac;
771
              my $tasks = $register{$mac}->{'tasks'};
772
              $register{$mac}->{'tasks'} = $tasks . $action . " $user\n";
773
              $register{$mac}->{'action'} = "";
774
              $register{$mac}->{'status'} = $uistatus;
775
              my $logmsg = "Node $mac marked for $action";
776
              $main::syslogit->($user, "info", $logmsg);
777
              $postreply .= "Status=OK $uistatus $name\n";
778
        }
779
    }
780
    $postreply = $postreply || "Status=ERROR No active nodes found\n";
781
    return $postreply;
782
}
783

    
784
sub do_haltall {
785
    my ($uuid, $action, $obj) = @_;
786
    if ($help) {
787
        return <<END
788
GET:nowait:
789
Unceremoniously halt all active nodes.
790
END
791
    }
792
    my @regvalues = values %register;
793
    my $nowait = $obj->{'nowait'};
794
# Only include pistons we have heard from in the last 20 secs
795
    foreach $val (@regvalues) {
796
        my $curstatus =  $val->{'status'};
797
        my $identity = $val->{'identity'};
798
        my $mac = $val->{'mac'};
799
        $action = "halt";
800
        my $name = $val->{'name'};
801
        if (($curstatus eq "running" || $curstatus eq "maintenance") && $identity ne 'local_kvm')
802
        {
803
              $uistatus = "halting";
804
              $uiuuid = $mac;
805
              my $tasks = $register{$mac}->{'tasks'};
806
              $register{$mac}->{'tasks'} = $tasks . $action . " $user\n";
807
              $register{$mac}->{'action'} = "";
808
              $register{$mac}->{'status'} = $uistatus;
809
              my $logmsg = "Node $mac marked for $action";
810
              $main::syslogit->($user, "info", $logmsg);
811
              $postreply .= "Status=OK $uistatus $name\n";
812
        }
813
    }
814
    unless ($nowait) {
815
        $postreply .= "Status=OK Waiting up to 100 seconds for running nodes to shut down\n";
816
        my $livenodes = 0;
817
        for (my $i; $i<10; $i++) {
818
            $livenodes = 0;
819
            do_list();
820
            foreach $val (@regvalues) {
821
                my $curstatus =  $val->{'status'};
822
                my $identity = $val->{'identity'};
823
                my $mac = $val->{'mac'};
824
                my $name = $val->{'name'};
825
                if (($curstatus eq "running" || $curstatus eq "maintenance" || $curstatus eq "halting") && $identity ne 'local_kvm') {
826
                    $livenodes = 1;
827
                }
828
            }
829
            last unless ($livenodes);
830
            sleep 10;
831
        }
832

    
833
    }
834
    $postreply = $postreply || "Status=ERROR No active nodes found\n";
835
    return $postreply;
836
}
837

    
838
sub Updateamtinfo {
839
    my ($uuid, $action, $obj) = @_;
840
    if ($help) {
841
        return <<END
842
GET::
843
Updates info about the nodes' AMT configuration by scanning the network.
844
END
845
    }
846
    $postreply = updateAmtInfo();
847
    return $postreply;
848
}
849

    
850
sub Listgpus {
851
    my ($uuid, $action, $obj) = @_;
852
    if ($help) {
853
        return <<END
854
GET:getvram:
855
List the GPUs that are available on this node.
856
END
857
    }
858
    $postreply = listGpus(0, $obj->{getvram});
859
    return $postreply;
860
}
861

    
862
sub Getnextgpus {
863
    my ($uuid, $action, $obj) = @_;
864
    if ($help) {
865
        return <<END
866
GET:gpus:
867
Get the specified amount of GPUs that are available on this node.
868
END
869
    }
870
    my @res = getNextGpus($obj->{gpus} || "1");
871
    $postreply = to_json(\@res, {pretty=>1});
872
    $postreply = qq|{"gpus": $postreply}|;
873
    return $postreply;
874
}
875

    
876
sub Stats {
877
    my ($uuid, $action, $obj) = @_;
878
    if ($help) {
879
        return <<END
880
GET::
881
Collect and show stats for this engine. May also be called as fullstats or fullstatsb (includes backup info).
882
END
883
    }
884
    return "Status=Error Not allowed\n" unless ($isadmin);
885
    my @regvalues = values %register;
886
    my %stats;
887
    my $cpuloadsum = 0;
888
    my $memtotalsum = 0;
889
    my $memfreesum = 0;
890
    my $memusedsum = 0;
891
    my $corestotal = 0;
892
    my $gpustotal = 0;
893
    my $vmemtotal = 0;
894
    my $vmstotal = 0;
895
    my $vmvcpustotal = 0;
896
    my $vmvgpustotal = 0;
897
    my $nodestorfree = 0;
898
    my $nodestorused = 0;
899
    my $nodestortotal = 0;
900
    my $i = 0;
901

    
902
    $Stabile::Systems::user = $user;
903
    require "$Stabile::basedir/cgi/systems.cgi";
904
    $Stabile::Systems::console = 1;
905
    #$console = 1;
906

    
907
    # Only include pistons we have heard from in the last 20 secs
908
    foreach $val (@regvalues) {
909
        if ((($val->{'status'} eq "asleep") || ($current_time - ($val->{'timestamp'}) < 20)) && ($val->{'status'} ne "joining") && ($val->{'status'} ne "shutdown") && ($val->{'status'} ne "reboot") ) {
910
            $cpuloadsum += $val->{'cpuload'} / ($val->{'cpucount'} * $val->{'cpucores'}) if ($val->{'cpucount'}>0);
911
            $memtotalsum += $val->{'memtotal'};
912
            $memfreesum += $val->{'memfree'};
913
            $corestotal += $val->{'cpucount'} * $val->{'cpucores'};
914
            $gpustotal += $val->{'gpucount'};
915
            $vmemtotal += $val->{'vmem'};
916
            $vmstotal += $val->{'vms'};
917
            $vmvcpustotal += $val->{'vmvcpus'};
918
            $vmvgpustotal += $val->{'vmvgpus'};
919
            $nodestorfree += $val->{'storfree'};
920
            $nodestortotal += $val->{'stortotal'};
921
            $readynodes ++ if ($val->{'status'} eq 'running' || $val->{'status'} eq 'maintenance' || $val->{'status'} eq 'asleep');
922
            $i++;
923
#        } elsif (($val->{'identity'} ne "local_kvm") &&($val->{'status'} eq 'running' || $val->{'status'} eq 'maintenance')) {
924
#            $readynodes++;
925
        }
926
    }
927
    $memusedsum = $memtotalsum - $memfreesum;
928
    $nodestorused = $nodestortotal - $nodestorfree;
929

    
930
    $cpuloadsum = $cpuloadsum / $i if ($i > 0); # Avoid division by zero
931

    
932
#    my @gpulist = listGpus(1);
933
#    my $gpustotal = scalar @gpulist;
934

    
935
    my %avgs = ("cpuloadavg" => $cpuloadsum, "memtotalsum" =>  $memtotalsum, "memfreesum" =>  $memfreesum,
936
        "nodestotal" => $i,"corestotal" => $corestotal, "gpustotal" => $gpustotal,  "vmemtotalsum" => $vmemtotal, "readynodes" => $readynodes,
937
        "vmstotal" => $vmstotal, "vmvcpustotal" => $vmvcpustotal, "vmvgpustotal" => $vmvgpustotal,
938
        "nodestortotal" => $nodestortotal, "nodestorfree" => $nodestorfree);
939

    
940
    my %storavgs;
941
    my $stortext;
942
    my $j = 0;
943
    push @tenderpathslist, $backupdir;
944
    push @tendernameslist, "Backup";
945
    foreach my $storpath (@tenderpathslist) {
946
        my $storfree = `df $storpath`;
947
        $storfree =~ m/(\d\d\d\d+)(\s+)(\d\d+)(\s+)(\d\d+)(\s+)(\S+)/i;
948
        my $stortotal = $1;
949
        my $storused = $3;
950
        $storfree = $5;
951
        $storavgs{$tendernameslist[$j].'-used'} = $storused;
952
        $storavgs{$tendernameslist[$j].'-total'} = $stortotal;
953
        $stortext .= $tendernameslist[$j] . ": " .int($storused/1024/1024) . " (" . int($stortotal/1024/1024) . ") GB&nbsp;&nbsp;";
954
        $j++;
955
    }
956

    
957
    my %mons;
958
    my @monservices = ('ping', 'diskspace', 'http', 'https', 'smtp', 'smtps', 'ldap', 'imap', 'imaps', 'telnet');
959
    if ($action eq "fullstats" || $action eq "fullstatsb") {
960
        $Stabile::Systems::fulllist = 1;
961
        %mons = Stabile::Systems::getOpstatus();
962
        $Stabile::Systems::fulllist = 0;
963
    }
964
    if ($action eq "fullstatsb") {
965
        require "images.cgi";
966
        $Stabile::Images::isadmin = $isadmin;
967
        $Stabile::Images::console = 1;
968
    }
969
    my @lusers;
970
    # We use images billing to report storage usage
971
    unless ( tie(%billingreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_images', key=>'userstoragepooltime'}, $Stabile::dbopts)) ) {return "Unable to access billing register"};
972
    foreach my $uref (values %userreg) {
973
        my %uval = %{$uref};
974

    
975
        delete $uval{'password'};
976
        delete $uval{'lasttkt'};
977
        delete $uval{'tasks'};
978

    
979
        # Skip if not logged in in 5 days
980
        # next unless ($uval{'lastlogin'} && ($current_time-$uval{'lastlogin'} < 5 * 86400));
981
        my @systems = Stabile::Systems::getSystemsListing('arraylist', '', $uval{'username'});
982
        # Skip if user has no systems
983
        # next unless (@systems);
984

    
985
        my @returnsystems;
986
        my $vcpus = 0;
987
        my $mem = 0;
988
        my $servers = 0;
989
        foreach my $sys (@systems) {
990
            my $sysvcpus = 0;
991
            my $sysmem = 0;
992
            my $sysvgpus = 0;
993
            my $sysvmem = 0;
994
            my $sysstor = 0;
995
            my $sysnodestor = 0;
996
            if ($sys->{'issystem'}) {
997
                foreach my $dom (@{$sys->{'children'}}) {
998
                    my $status = $dom->{'status'};
999
#                    if ($status ne 'shutoff' && $status ne 'inactive') { # We now report usage also when not running
1000
                        $sysvcpus += $dom->{'vcpu'};
1001
                        $sysmem += $dom->{'memory'};
1002
                        $sysvgpus += $dom->{'vgpu'};
1003
                        $sysvmem += $dom->{'vmemory'};
1004
#                    }
1005
                    $sysstor += $dom->{'storage'}/1024/1024;
1006
                    $sysnodestor += $dom->{'nodestorage'}/1024/1024;
1007
                }
1008
            } else {
1009
                my $status = $sys->{'status'};
1010
#                if ($status ne 'shutoff' && $status ne 'inactive') {
1011
                    $sysvcpus = $sys->{'vcpu'};
1012
                    $sysmem = $sys->{'memory'};
1013
                    $sysvgpus = $sys->{'vgpu'};
1014
                    $sysvmem = $sys->{'vmemory'};
1015
#                }
1016
                $sysstor = $sys->{'storage'}/1024/1024;
1017
                $sysnodestor = $sys->{'nodestorage'}/1024/1024;
1018
            }
1019
            $vcpus += $sysvcpus;
1020
            $mem += $sysmem;
1021
            $vgpus += $sysvgpus;
1022
            $vmem += $sysvmem;
1023
            my $serveruuids = $sys->{'uuid'};
1024
            if ($sys->{'issystem'}) {
1025
                my @suuids;
1026
                foreach my $child (@{$sys->{'children'}}) {
1027
                    push @suuids, $child->{'uuid'};
1028
                };
1029
                $serveruuids = join(', ', @suuids);
1030
            }
1031

    
1032
            $returnsys = {
1033
                'appid'=>$sys->{'appid'},
1034
                'version'=>$sys->{'version'},
1035
                'managementurl'=>$sys->{'managementurl'},
1036
                'upgradeurl'=>$sys->{'upgradeurl'},
1037
                'terminalurl'=>$sys->{'terminalurl'},
1038
                'master'=>$sys->{'master'},
1039
                'name'=>$sys->{'name'},
1040
                'image'=>$sys->{'image'},
1041
                'status'=>$sys->{'status'},
1042
                'user'=>$sys->{'user'},
1043
                'uuid'=>$sys->{'uuid'},
1044
                'servers'=>($sys->{'issystem'}?scalar @{$sys->{'children'}}:1),
1045
                'serveruuids' => $serveruuids,
1046
                'vcpus' => $sysvcpus,
1047
                'memory' => $sysmem,
1048
                'vgpus' => $sysvgpus,
1049
                'vmemory' => $sysvmem,
1050
                'storage' => $sysstor+0,
1051
                'nodestorage' => $sysnodestor+0,
1052
                'externalips' => $sys->{'externalips'}+0,
1053
                'externalip' => $sys->{'externalip'},
1054
                'ports' => $sys->{'ports'},
1055
                'internalip' => $sys->{'internalip'}
1056
            };
1057
            $servers += ($sys->{'issystem'}?scalar @{$sys->{'children'}}:1);
1058
            my $monitors;
1059
            my $backups;
1060

    
1061
            if (%mons || $action eq "fullstatsb") {
1062
                if ($sys->{'issystem'}) {
1063
                    foreach my $dom (@{$sys->{'children'}}) {
1064
                        foreach my $service (@monservices) {
1065
                            my $id = $dom->{'uuid'} . ":$service";
1066
                            if ($mons{$id}) {
1067
                                my $last_status = $mons{$id}->{'last_success'} || $mons{$id}->{'last_failure'};
1068
                                $monitors .= "$dom->{'name'}/$service/$mons{$id}->{'status'}/$last_status, " ;
1069
                            }
1070
                        }
1071
                        if ($action eq "fullstatsb") {
1072
                            my $bups = Stabile::Images::Getserverbackups($dom->{'uuid'});
1073
                            $backups  .= "$bups, " if ($bups);
1074
                        }
1075
                    }
1076
                    $monitors = substr($monitors, 0,-2) if ($monitors);
1077
                    $backups = substr($backups, 0,-2) if ($backups);
1078
                } else {
1079
                    foreach my $service (@monservices) {
1080
                        my $id = $sys->{'uuid'} . ":$service";
1081
                        if ($mons{$id}) {
1082
                            my $last_status = $mons{$id}->{'last_success'} || $mons{$id}->{'last_failure'};
1083
                            $monitors .= "$sys->{'name'}/$service/$mons{$id}->{'status'}/$last_status, ";
1084
                        }
1085
                    }
1086
                    $monitors = substr($monitors, 0,-2) if ($monitors);
1087
                    $backups = Stabile::Images::Getserverbackups($sys->{'uuid'}) if ($action eq "fullstatsb");
1088
                }
1089
                $returnsys->{'monitors'} = $monitors if ($monitors);
1090
                $returnsys->{'backups'} = $backups if ($backups);
1091
            }
1092

    
1093
            push @returnsystems, $returnsys;
1094
        }
1095
        $uval{'systems'} = \@returnsystems;
1096

    
1097
        $uval{'nodestorage'} = int($billingreg{"$uval{username}--1-$year-$month"}->{'virtualsize'}/1024/1024) if ($billingreg{"$uval{username}--1-$year-$month"});
1098
        my $stor = 0;
1099
        for (my $i=0; $i <= scalar @tenderpathslist; $i++) {
1100
            $stor += $billingreg{"$uval{username}-$i-$year-$month"}->{'virtualsize'} if ($billingreg{"$uval{username}-$i-$year-$month"});
1101
        }
1102

    
1103
        $uval{'storage'} = int($stor/1024/1024);
1104
        $uval{'vcpu'} = $vcpus;
1105
        $uval{'memory'} = $mem;
1106
        $uval{'vgpu'} = $vgpus;
1107
        $uval{'vmemory'} = $vmem;
1108
        $uval{'servers'} = $servers;
1109

    
1110
        push @lusers, \%uval;
1111
    }
1112
    untie %billingreg;
1113
    my $ver = `cat /etc/stabile/version`; chomp $ver;
1114
    $stortext .= "Nodes: " . int($nodestorused/1024/1024) . " (" . int($nodestortotal/1024/1024) . ") GB";
1115
    $stats{'status'} = ($readynodes>0?'ready':'nonodes');
1116
    $stats{'storavgs'} = \%storavgs;
1117
    $stats{'avgs'} = \%avgs;
1118
    $stats{'users'} = \@lusers;
1119
    $stats{'stortext'} = $stortext;
1120
    # $stats{'version'} = $version;
1121
    $stats{'version'} = $ver;
1122

    
1123
    my $json_text = to_json(\%stats, {pretty=>1});
1124
    $json_text =~ s/\x/ /g;
1125
    $json_text =~ s/null/""/g;
1126
    #$postreply = header("application/json") unless ($console);
1127
    $postreply .= $json_text;
1128
    return $postreply;
1129
}
1130

    
1131
sub do_list {
1132
    my ($uuid, $action, $obj) = @_;
1133
    if ($help) {
1134
        return <<END
1135
GET:uuid:
1136
List the nodes running this engine.
1137
END
1138
    }
1139
    if ($isadmin || index($privileges,"n")!=-1) {
1140
        my @regvalues = values %register;
1141
        my @curregvalues;
1142
        # Only include pistons we have heard from in the last 20 secs
1143
        foreach $valref (@regvalues) {
1144
            my $curstatus =  $valref->{'status'};
1145
            if (
1146
                ($current_time - ($valref->{'timestamp'}) > 20)
1147
                    && ($curstatus ne "joining") && ($curstatus ne "shutdown") && ($curstatus ne "reboot")
1148
                    && ($curstatus ne "asleep") && ($curstatus ne "waking") && ($curstatus ne "sleeping")
1149
            ) {$valref->{'status'} = "inactive"};
1150

    
1151
            $valref->{'name'} = $valref->{'mac'} unless ($valref->{'name'} && $valref->{'name'} ne '--');
1152
            my %val = %{$valref}; # Deference and assign to new ass array, effectively cloning object
1153
            # %{$valref}->{'cpucores'}  is the same as $valref->{'cpucores'};
1154
            # These values should be sent as numbers
1155
            $val{'cpucores'} += 0;
1156
            $val{'cpucount'} += 0;
1157
            $val{'gpucount'} += 0;
1158
            $val{'memfree'} += 0;
1159
            $val{'vmem'} += 0;
1160
            $val{'gpusfree'} += 0;
1161
            $val{'memtotal'} += 0;
1162
            $val{'storfree'} += 0;
1163
            $val{'stortotal'} += 0;
1164
            $val{'vms'} += 0;
1165
            $val{'cpuload'} += 0;
1166

    
1167
            push @curregvalues,\%val ;
1168
        }
1169

    
1170
        # Sort @curregvalues
1171
        my $sort = 'name';
1172
        $sort = $2 if ($uripath =~ /sort\((\+|\-)(\S+)\)/);
1173
        my $reverse;
1174
        $reverse = 1 if ($1 eq '-');
1175
        if ($reverse) { # sort reverse
1176
            if ($sort =~ /cpucores|cpucount|memfree|memtotal|vms|cpuload|gpucount|vmem|gpusfree/) {
1177
                @curregvalues = (sort {$b->{$sort} <=> $a->{$sort}} @curregvalues); # Sort as number
1178
            } else {
1179
                @curregvalues = (sort {$b->{$sort} cmp $a->{$sort}} @curregvalues); # Sort as string
1180
            }
1181
        } else {
1182
            if ($sort =~ /cpucores|cpucount|memfree|memtotal|vms|cpuload|gpucount|vmem|gpusfree/) {
1183
                @curregvalues = (sort {$a->{$sort} <=> $b->{$sort}} @curregvalues); # Sort as number
1184
            } else {
1185
                @curregvalues = (sort {$a->{$sort} cmp $b->{$sort}} @curregvalues); # Sort as string
1186
            }
1187
        }
1188

    
1189
        if ($action eq 'tablelist') {
1190
            my $t2 = Text::SimpleTable->new(14,20,14,10,5,5,12,7);
1191
            $t2->row('mac', 'name', 'ip', 'identity', 'cores', 'gpus', 'vms', 'memfree', 'status');
1192
            $t2->hr;
1193
            my $pattern = $options{m};
1194
            foreach $rowref (@curregvalues){
1195
                if ($pattern) {
1196
                    my $rowtext = "$rowref->{'mac'} $rowref->{'name'} $rowref->{'ip'} $rowref->{'identity'}, $rowref->{'cpucores'}, $rowref->{'gpucount'} "
1197
                        . "$rowref->{'vms'} $rowref->{'memfree'} $rowref->{'status'}";
1198
                    $rowtext .= " " . $rowref->{'mac'} if ($isadmin);
1199
                    next unless ($rowtext =~ /$pattern/i);
1200
                }
1201
                $t2->row($rowref->{'mac'}, $rowref->{'name'}, $rowref->{'ip'}, $rowref->{'identity'}, $rowref->{'cpucores'}, $rowref->{'gpucount'},
1202
                    $rowref->{'vms'}, $rowref->{'memfree'}, $rowref->{'status'});
1203
            }
1204
            $postreply .= header("text/plain") unless ($console);
1205
            $postreply .= $t2->draw;
1206
        } elsif ($console) {
1207
            $postreply = Dumper(\@curregvalues);
1208
        } else {
1209
            my $json_text = to_json(\@curregvalues, {pretty=>1});
1210
            $json_text =~ s/""/"--"/g;
1211
            $json_text =~ s/null/"--"/g;
1212
            $json_text =~ s/\x/ /g;
1213
            $postreply .= qq|{"identifier": "mac", "label": "name", "items":| if ($action && $action ne 'list');
1214
            $postreply .= $json_text;
1215
            $postreply .= "}" if ($action && $action ne 'list');
1216
        }
1217
    } else {
1218
        $postreply .= q|{"identifier": "mac", "label": "name", "items":| if ($action && $action ne 'list');
1219
        $postreply .= "[]";
1220
        $postreply .= "}" if ($action && $action ne 'list');
1221
    }
1222
    return $postreply;
1223
}
1224

    
1225
sub do_uuidlookup {
1226
    if ($help) {
1227
        return <<END
1228
GET:uuid:
1229
Simple action for looking up a uuid or part of a uuid and returning the complete uuid.
1230
END
1231
    }
1232

    
1233
    my $u = $options{u};
1234
    $u = $params{'uuid'} unless ($u || $u eq '0');
1235
    my $ruuid;
1236
    if ($u || $u eq '0') {
1237
        foreach my $uuid (keys %register) {
1238
            if ($uuid =~ /^$u/ || $register{$uuid}->{'name'} =~ /^$u/) {
1239
                return "$uuid\n";
1240
            }
1241
        }
1242
    }
1243
}
1244

    
1245
sub do_uuidshow {
1246
    if ($help) {
1247
        return <<END
1248
GET:uuid:
1249
Simple action for showing a single network.
1250
END
1251
    }
1252
    my $u = $options{u};
1253
    $u = $params{'uuid'} unless ($u || $u eq '0');
1254
    if ($u || $u eq '0') {
1255
        foreach my $uuid (keys %register) {
1256
            if ($uuid =~ /^$u/) {
1257
                my %hash = %{$register{$uuid}};
1258
                delete $hash{'action'};
1259
                my $dump = Dumper(\%hash);
1260
                $dump =~ s/undef/"--"/g;
1261
                return $dump;
1262
            }
1263
        }
1264
    }
1265
}
1266

    
1267
# Print list of available actions on objects
1268
sub do_plainhelp {
1269
    my $res;
1270
    $res .= header('text/plain') unless $console;
1271
    $res .= <<END
1272
* reboot: Reboots a node
1273
* shutdown: Shuts down a node
1274
* unjoin: Disassciates a node from the engine and reboots it. After rebooting, it will join the engine with the default
1275
node identity
1276
* delete: Deletes a node. Use if a node has been physically removed from engine
1277
* sleep: Puts an idle node to sleep. S3 sleep must be supported and enabled
1278
* wake: Tries to wake or start a node by sending a wake-on-LAN magic packet to the node.
1279
* evacuate: Tries to live-migrate all running servers away from node
1280
* maintenance: Puts the node in maintenance mode. A node in maintenance mode is not available for starting new servers.
1281
* carryon: Puts a node out of maintenance mode.
1282
* reload: Reloads the movepiston daemon on the node.
1283

    
1284
END
1285
;
1286
}
1287

    
1288

    
1289
sub updateRegister {
1290
    my @regvalues = values %register;
1291
# Mark pistons we haven't heard from in the last 20 secs as inactive
1292
    foreach $valref (@regvalues) {
1293
        my $curstatus =  $valref->{'status'};
1294
        if (
1295
            ($current_time - ($valref->{'timestamp'}) > 20)
1296
            && ($curstatus ne "joining") && ($curstatus ne "shutdown") && ($curstatus ne "reboot")
1297
            && ($curstatus ne "asleep") && ($curstatus ne "waking") && ($curstatus ne "sleeping")
1298
        ) {
1299
            $valref->{'status'} = 'inactive';
1300
            print "Marking node as inactive\n";
1301
            if ($curstatus ne 'inactive') {
1302
                $main::updateUI->({tab=>'nodes', user=>$user, uuid=>$valref->{'mac'}, status=>'inactive'});
1303
            }
1304
        }
1305
    }
1306
}
1307

    
1308
sub trim {
1309
   my $string = shift;
1310
   $string =~ s/^\s+|\s+$//g;
1311
   return $string;
1312
}
1313

    
1314
# This is called when starting a domain
1315
sub getNextGpus {
1316
    my $numgpus = shift;
1317
    my $targetmac = shift;
1318
    my @gpus = listGpus(1);
1319
    my @rgpus;
1320
    my $i = 0;
1321
    foreach my $gpu (@gpus) {
1322
        if ($gpu->{available} && $gpu->{detached} && $gpu->{node} eq $targetmac) {
1323
            # if ($gpu->{audiodrivers} ) {
1324
            #     my $lsmod = `lsmod`;
1325
            #     my @adrivers = split / +|, ?/, $gpu->{audiodrivers};
1326
            #     foreach my $adriver (@adrivers) {
1327
            #         if ($lsmod =~ /$adriver/) {
1328
            #             my $res = `modprobe -rv $adriver 2>&1`;
1329
            #         }
1330
            #     }
1331
            # }
1332
            $i++;
1333
            push @rgpus, $gpu;
1334
            last if ($i >= $numgpus);
1335
        }
1336
    }
1337
    return @rgpus;
1338
}
1339

    
1340
sub listGpus {
1341
    my $gapi = shift;
1342
    my $getvram = shift;
1343
    $api = $api || $gapi;
1344

    
1345
    my %gpus;
1346
    my $sshcmd = '';
1347
    my @nodes = values %register;
1348
    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
1349

    
1350
    foreach my $node (@nodes) {
1351
        if ($node->{identity} eq 'local_kvm') {
1352
            $sshcmd = '';
1353
        } else {
1354
            $sshcmd = $Stabile::sshcmd;
1355
            $sshcmd = "$sshcmd $node->{ip} ";
1356
        }
1357
        # First check if iommu is enabled
1358
        my $cmd = "cat /proc/cmdline | grep iommu";
1359
        my $cmdline = `$sshcmd$cmd`;
1360
        chomp $cmdline;
1361
        my $iommu = 0;
1362
        $iommu = 1 if ($cmdline =~ /iommu/);
1363
        $cmd = "lspci -nnv";
1364
        my $lspci = `$sshcmd$cmd`;
1365
        chomp $lspci;
1366
        my @gpu_lines = split "\n", $lspci;
1367
        push @gpu_lines, "END";
1368
        my $gpu;
1369

    
1370
        my $audiodrivers = '';
1371
        my $lookforaudiodriver = 0;
1372
        my $bdf = '';
1373
        foreach my $gpu_line (@gpu_lines) {
1374
            if ($gpu_line =~ /(\w+):(\w+)\.(\w+) VGA .+\]:(.+)$/) {
1375
                # Add bdf information
1376
                $bdf = "$1_$2_$3";
1377
                $gpu = {
1378
                    node => $node->{mac},
1379
                    nodename => $node->{name},
1380
                    bus       => $1,
1381
                    device    => $2,
1382
                    function  => $3,
1383
                    name      => $4,
1384
                    bdf => $bdf,
1385
                    available => 0
1386
                };
1387
                $gpu->{nvidia} = 1 if ($gpu->{name} =~ /nvidia/i);
1388
                $gpu->{amd} = 1 if ($gpu->{name} =~ /advanced micro devices/i);
1389
                unless ($gpu->{nvidia} || $gpu->{amd}) {
1390
                    $gpu->{error} = "GPU is not Nvidia or AMD";
1391
                }
1392
                $gpus{$bdf} = $gpu;
1393
            } elsif (!$gpu) {
1394
                $bdf = '';
1395
                next;
1396
            }
1397
            # Now look for video driver in the following lines
1398
            if (!$lookforaudiodriver && $gpu_line =~ /Kernel driver in use: (.*)/) {
1399
                $gpu->{driver} = $1;
1400
                # If nvidia or amd try to detach in order to check if it is in use
1401
                if ($iommu) {
1402
                    if ($gpu->{name} && ($gpu->{nvidia} || $gpu->{amd})) {
1403
                        $cmd = "virsh nodedev-detach pci_0000_$gpu->{bus}_$gpu->{device}_$gpu->{function} 2>\&1";
1404
                        my $detach = `$sshcmd$cmd`;
1405
                        chomp $detach;
1406
                        $gpu->{domain} = '';
1407
                        if ($detach =~ /detached/s) {
1408
                            $gpu->{detached} = 1;
1409
                            $gpu->{available} = 1;
1410
                        } elsif ($detach =~ /domain (.+)(\S{8})/) {
1411
                            my $domname = $1;
1412
                            my $dom = $2;
1413
                            my @regkeys = (tied %domreg)->select_where("uuid LIKE '$dom%'");
1414
                            if (scalar @regkeys) {
1415
                                $dom = $regkeys[0];
1416
                                $domname = $domreg{$dom}->{name};
1417
                            }
1418
                            $gpu->{domain} = $domname;
1419
                            $gpu->{domainid} = $dom;
1420
                            $gpu->{detached} = 0;
1421
                            $gpu->{available} = 1;
1422
                        } else {
1423
                            $gpu->{detached} = 0;
1424
                        }
1425
                    } else {
1426
                        $gpu->{detached} = 0;
1427
                        $gpu->{error} = "GPU is not Nvidia or AMD";
1428
                    }
1429
                } else {
1430
                    $gpu->{detached} = 0;
1431
                    $gpu->{error} = "iommu is not enabled, please update your grub configuration";
1432
                    $gpus{$bdf} = $gpu;
1433
                    $gpu = '';
1434
                }
1435
            }
1436
            # If gpu has an audio controller, it should be right after the VGA part - look for audio driver
1437
            elsif ($gpu_line =~ /^(\w+):(\w+)\.(\w+) (\S+) .+\]:(.+)$/) {
1438
                if (lc $4 eq 'audio' ) {
1439
                    $lookforaudiodriver = 1;
1440
                } else {
1441
                    $lookforaudiodriver = 0;
1442
                    $gpus{$bdf} = $gpu;
1443
                }
1444
            } elsif ($lookforaudiodriver &&  $gpu_line =~ /Kernel driver in use: (\S+)/) {
1445
                $audiodrivers .= $1;
1446
                # Removal is done before starting a domain
1447
                #    `rmmod $1`; # Remove audio driver(s) locking GPU
1448
                $lookforaudiodriver = 0;
1449
                $gpu->{audiodrivers} = $audiodrivers;
1450
                $gpus{$bdf} = $gpu;
1451
                $gpu = '';
1452
            } elsif ($gpu_line =~ /END/) {
1453
                $gpus{$bdf} = $gpu;
1454
                $gpu = '';
1455
            }
1456
        }
1457
        if ($getvram) {
1458
            my $vramtotal = 0;
1459
            my $attach;
1460
            # In order to query vram Nvidia GPUs must be re-attached
1461
            foreach my $gpu (values %gpus) {
1462
                if ($gpu->{nvidia}) {
1463
                    $cmd = "virsh nodedev-reattach pci_0000_$gpu->{bus}_$gpu->{device}_$gpu->{function} 2>\&1";
1464
                    $attach = `$sshcmd$cmd`;
1465
                    $attach = 1 if ($attach =~ /re-attached/);
1466
                # https://stackoverflow.com/questions/77708142/how-can-i-fetch-vram-and-gpu-cache-size-in-linux
1467
                } elsif ($gpu->{amd}) {
1468
                    my $slot = "0000:$gpu->{bus}:$gpu->{device}:$gpu->{function}";
1469
                    $cmd = "cat /sys/bus/pci/devices/$slot/mem_info_vram_total";
1470
                    my $vram = `$sshcmd$cmd`;
1471
                    chomp $vram;
1472
                    $vramtotal += $vram;
1473
                    $gpus{$gpu->{bdf}}->{vram} = $vram+0;
1474
                }
1475
            }
1476
            if ($attach) { # We have at elast 1 Nvidia GPU attached
1477
#                `rmmod drm_kms_helper nvidia_drm nvidia_modeset nvidia_uvm nvidia ast`;
1478
                $cmd = "modprobe nvidia";
1479
                `$sshcmd$cmd`;
1480
                $cmd = "LANG=C nvidia-smi --query-gpu=gpu_bus_id,memory.total,name --format=csv,noheader,nounits";
1481
                my $vramlines = `$sshcmd$cmd`;
1482
                foreach my $line (split "\n", $vramlines) {
1483
                    my ($line_bdf, $line_vram, $line_name) = split( /, ?/, $line);
1484
                    next unless ($line_bdf);
1485
                    $vramtotal += $line_vram*1024*1024;
1486
                    if ($line_bdf =~ /:(\d+):(\d+)\.(\d+)/) {
1487
                        $line_bdf = "$1_$2_$3";
1488
                        $gpus{$line_bdf}->{vram} = $line_vram; # MB
1489
                    }
1490
                }
1491
            }
1492
        }
1493
    }
1494

    
1495
    untie %domreg;
1496
    # `modprobe $audiodrivers` if ($audiodrivers);
1497
    my @gpulist = values %gpus;
1498
    if ($api) {
1499
        return values @gpulist;
1500
    } else {
1501
        return JSON::to_json(\@gpulist, {pretty => 1});
1502
    }
1503
}
1504

    
1505
sub updateAmtInfo {
1506
    my @vals = values(%register);
1507
    if (scalar @vals == 1 && $vals[0]->{identity} eq 'local_kvm') {
1508
        return "Status=OK Only local node registered - not scanning for AMT\n"
1509
    }
1510
    my $amtinfo = `/usr/bin/nmap -n -v --send-ip -Pn -p 16992 10.0.0.*`;
1511
    my $match;
1512
    my %macs;
1513
    my $amtip;
1514
    my $res;
1515
    foreach my $line (split /\n/, $amtinfo) {
1516
        if ($line =~ /16992\/tcp open/) {
1517
            $match = 1;
1518
        } elsif ($line =~ /Nmap scan report for (\S+)/) {
1519
            $amtip = $1;
1520
        } elsif ($line =~ /Host (\S+) is up/) {
1521
            $amtip = $1;
1522
        }
1523
        if ($match && $line =~ /MAC Address: (\S+)/) {
1524
            my $amtmac = $1;
1525
            $amtmac =~ tr/://d;
1526
            $macs{$amtmac} = 1;
1527
            $match = 0;
1528
            $res .= "Status=OK Found $amtmac with $amtip\n";
1529
            $register{$amtmac}->{'amtip'} = $amtip if ($register{$amtmac});
1530
        }
1531
    };
1532
    if (%macs) {
1533
        my $n = scalar values %macs;
1534
        $res .= "Status=OK Found $n nodes with AMT enabled\n";
1535
    } else {
1536
        $res .= "Status=OK Could not find any nodes with AMT enabled\n";
1537
    }
1538
    return $res;
1539
}
1540

    
1541
sub Configurecgroups {
1542
    my ($uuid, $action, $obj) = @_;
1543
    if ($help) {
1544
        return <<END
1545
GET::
1546
Parse Stabile config nodeconfig.cfg and configure /etc/stabile/cgconfig.conf for all known node roots.
1547
END
1548
    }
1549

    
1550
    unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities',key=>'identity',CLOBBER=>3}, $Stabile::dbopts)) ) {return "Unable to access id register"};
1551
    my @noderoots;
1552
    # Build hash of known node roots
1553
    foreach my $valref (values %idreg) {
1554
        my $noderoot = $valref->{'path'} . "/casper/filesystem.dir";
1555
        next if ($noderoots{$noderoot}); # Node identities may share basedir and node config file
1556
        if (-e $noderoot && -e "$noderoot/etc/cgconfig.conf" && -e "$noderoot/etc/stabile/nodeconfig.cfg") {
1557
            push @noderoots, $noderoot;
1558
        }
1559
    }
1560
    untie %idreg;
1561
    push @noderoots, "/";
1562
    foreach my $noderoot (@noderoots) {
1563
        $noderoot = '' if ($noderoot eq '/');
1564
        next unless (-e "$noderoot/etc/stabile/nodeconfig.cfg");
1565
        my $nodecfg = new Config::Simple("$noderoot/etc/stabile/nodeconfig.cfg");
1566
        my $vm_readlimit = $nodecfg->param('VM_READ_LIMIT'); # e.g. 125829120 = 120 * 1024 * 1024 = 120 MB / s
1567
        my $vm_writelimit = $nodecfg->param('VM_WRITE_LIMIT');
1568
        my $vm_iopsreadlimit = $nodecfg->param('VM_IOPS_READ_LIMIT'); # e.g. 1000 IOPS
1569
        my $vm_iopswritelimit = $nodecfg->param('VM_IOPS_WRITE_LIMIT');
1570

    
1571
        my $piston_readlimit = $nodecfg->param('PISTON_READ_LIMIT'); # e.g. 125829120 = 120 * 1024 * 1024 = 120 MB / s
1572
        my $piston_writelimit = $nodecfg->param('PISTON_WRITE_LIMIT');
1573
        my $piston_iopsreadlimit = $nodecfg->param('PISTON_IOPS_READ_LIMIT'); # e.g. 1000 IOPS
1574
        my $piston_iopswritelimit = $nodecfg->param('PISTON_IOPS_WRITE_LIMIT');
1575

    
1576
        my $file = "$noderoot/etc/stabile/cgconfig.conf";
1577
        unless (open(FILE, "< $file")) {
1578
            $postreply .= "Status=Error problem opening $file\n";
1579
            return $postreply;
1580
        }
1581
        my @lines = <FILE>;
1582
        close FILE;
1583
        chomp @lines;
1584
        my $group;
1585
        my @newlines;
1586
        for my $line (@lines) {
1587
            $group = $1 if ($line =~ /group (\w+) /);
1588
            if ($group eq 'stabile' && $noderoot) {
1589
                # These are already set to valve values by pressurecontrol
1590
                $line =~ s/(blkio.throttle.read_bps_device = "\d+:\d+).*/$1 $piston_readlimit";/;
1591
                $line =~ s/(blkio.throttle.write_bps_device = "\d+:\d+).*/$1 $piston_writelimit";/;
1592
                $line =~ s/(blkio.throttle.read_iops_device = "\d+:\d+).*/$1 $piston_iopsreadlimit";/;
1593
                $line =~ s/(blkio.throttle.write_iops_device = "\d+:\d+).*/$1 $piston_iopswritelimit";/;
1594
            }
1595
            elsif ($group eq 'stabilevm') {
1596
                $line =~ s/(blkio.throttle.read_bps_device = "\d+:\d+).*/$1 $vm_readlimit";/;
1597
                $line =~ s/(blkio.throttle.write_bps_device = "\d+:\d+).*/$1 $vm_writelimit";/;
1598
                $line =~ s/(blkio.throttle.read_iops_device = "\d+:\d+).*/$1 $vm_iopsreadlimit";/;
1599
                $line =~ s/(blkio.throttle.write_iops_device = "\d+:\d+).*/$1 $vm_iopswritelimit";/;
1600
            }
1601
            push @newlines, $line;
1602
        }
1603
        unless (open(FILE, "> $file")) {
1604
            $postreply .= "Status=Error Problem opening $file\n";
1605
            return $postreply;
1606
        }
1607
        print FILE join("\n", @newlines);
1608
        close(FILE);
1609
        $postreply .= "Status=OK Setting VM and auxilliary cgroups limits in $file: $vm_readlimit, $vm_writelimit, $vm_iopsreadlimit, $vm_iopswritelimit\n";
1610
    }
1611
    return $postreply;
1612
}
(4-4/9)