|
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::Systems;
|
|
9
|
|
|
10
|
use Webmin::API;
|
|
11
|
use File::Basename;
|
|
12
|
use lib dirname (__FILE__);
|
|
13
|
use Stabile;
|
|
14
|
use Error qw(:try);
|
|
15
|
use String::Escape qw( unbackslash backslash );
|
|
16
|
use Config::Simple;
|
|
17
|
use Time::Local;
|
|
18
|
use Mon::Client;
|
|
19
|
use File::Glob qw(bsd_glob);
|
|
20
|
use POSIX;
|
|
21
|
use Proc::Daemon;
|
|
22
|
use Data::UUID;
|
|
23
|
use LWP::Simple qw(!head);
|
|
24
|
use MIME::Lite;
|
|
25
|
use RRDTool::OO;
|
|
26
|
use Text::CSV_XS qw( csv );
|
|
27
|
use Geo::IP;
|
|
28
|
|
|
29
|
my $cfg = new Config::Simple("/etc/stabile/config.cfg");
|
|
30
|
|
|
31
|
my $engineid = $Stabile::config->get('ENGINEID') || "";
|
|
32
|
my $enginename = $Stabile::config->get('ENGINENAME') || "";
|
|
33
|
my $doxmpp = $Stabile::config->get('DO_XMPP') || "";
|
|
34
|
my $disablesnat = $Stabile::config->get('DISABLE_SNAT') || "";
|
|
35
|
my ($datanic, $extnic) = $main::getNics->();
|
|
36
|
my $extiprangestart = $Stabile::config->get('EXTERNAL_IP_RANGE_START');
|
|
37
|
my $extiprangeend = $Stabile::config->get('EXTERNAL_IP_RANGE_END');
|
|
38
|
|
|
39
|
if (!$Stabile::Servers::q && !$Stabile::Images::q && !$Stabile::Networks::q && !$Stabile::Users::q && !$Stabile::Nodes::q) { # We are not being called from another script
|
|
40
|
$q = new CGI;
|
|
41
|
my %cgiparams = $q->Vars;
|
|
42
|
%params = %cgiparams if (%cgiparams);
|
|
43
|
} else {
|
|
44
|
$console = 1;
|
|
45
|
}
|
|
46
|
|
|
47
|
my %ahash; # A hash of accounts and associated privileges current user has access to
|
|
48
|
$uiuuid;
|
|
49
|
$uistatus;
|
|
50
|
$help = 0; # If this is set, functions output help
|
|
51
|
|
|
52
|
our %ahash; # A hash of accounts and associated privileges current user has access to
|
|
53
|
#our %options=();
|
|
54
|
# -a action -h help -u uuid -m match pattern -f full list, i.e. all users
|
|
55
|
# -v verbose, include HTTP headers -s impersonate subaccount -t target [uuid or image]
|
|
56
|
# -g args to gearman task
|
|
57
|
#Getopt::Std::getopts("a:hfu:g:m:vs:t:", \%options);
|
|
58
|
|
|
59
|
try {
|
|
60
|
Init(); # Perform various initalization tasks
|
|
61
|
process() if ($package);
|
|
62
|
|
|
63
|
} catch Error with {
|
|
64
|
my $ex = shift;
|
|
65
|
print header('text/html', '500 Internal Server Error') unless ($console);
|
|
66
|
if ($ex->{-text}) {
|
|
67
|
print "Got error $package: ", $ex->{-text}, " on line ", $ex->{-line}, "\n";
|
|
68
|
} else {
|
|
69
|
print "Status=ERROR\n";
|
|
70
|
}
|
|
71
|
} finally {
|
|
72
|
};
|
|
73
|
|
|
74
|
1;
|
|
75
|
|
|
76
|
sub getObj {
|
|
77
|
my %h = %{@_[0]};
|
|
78
|
$console = 1 if $obj->{"console"};
|
|
79
|
my $obj;
|
|
80
|
$action = $action || $h{'action'};
|
|
81
|
if ($action =~ /updateaccountinfo|monitors|listuptime|buildsystem|removeusersystems|updateengineinfo|^register$|^packages$/) {
|
|
82
|
$obj = \%h;
|
|
83
|
$obj->{domuuid} = $curdomuuid if ($curdomuuid);
|
|
84
|
} else {
|
|
85
|
my $uuid =$h{"uuid"} || $curuuid;
|
|
86
|
$uuid = $curuuid if ($uuid eq 'this');
|
|
87
|
my $status = $h{"status"};
|
|
88
|
if ((!$uuid && $uuid ne '0') && (!$status || $status eq 'new')) {
|
|
89
|
my $ug = new Data::UUID;
|
|
90
|
$uuid = $ug->create_str();
|
|
91
|
$status = 'new';
|
|
92
|
};
|
|
93
|
return 0 unless ($uuid && length $uuid == 36);
|
|
94
|
|
|
95
|
$obj = {uuid => $uuid};
|
|
96
|
my @props = qw(uuid name memory vcpu user notes created opemail opfullname opphone email fullname phone services
|
|
97
|
recovery alertemail image networkuuid1 internalip autostart issystem system systemstatus from to
|
|
98
|
appid callback installsystem installaccount networkuuids ports);
|
|
99
|
if ($register{$uuid}) {
|
|
100
|
foreach my $prop (@props) {
|
|
101
|
my $val = $h{$prop} || $register{$uuid}->{$prop};
|
|
102
|
$obj->{$prop} = $val if ($val);
|
|
103
|
}
|
|
104
|
} else {
|
|
105
|
foreach my $prop (@props) {
|
|
106
|
my $val = $h{$prop};
|
|
107
|
$obj->{$prop} = $val if ($val);
|
|
108
|
}
|
|
109
|
}
|
|
110
|
}
|
|
111
|
return $obj;
|
|
112
|
}
|
|
113
|
|
|
114
|
sub Init {
|
|
115
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {$posterror = "Unable to access user register"; return;};
|
|
116
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {$posterror = "Unable to access domain register"; return;};
|
|
117
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {$posterror = "Unable to access network register"; return;};
|
|
118
|
unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$posterror = "Unable to access system register"; return;};
|
|
119
|
|
|
120
|
$cursysuuid = $domreg{$curuuid}->{'system'}if ($domreg{$curuuid});
|
|
121
|
$tktuser = $tktuser || $Stabile::tktuser;
|
|
122
|
$user = $user || $Stabile::user;
|
|
123
|
|
|
124
|
*Deletesystem = \&Removesystem;
|
|
125
|
*Backup = \&systemAction;
|
|
126
|
*Snapshot = \&systemAction;
|
|
127
|
*Unsnap = \&systemAction;
|
|
128
|
|
|
129
|
*do_help = \&action;
|
|
130
|
*do_tablelist = \&do_list;
|
|
131
|
*do_arraylist = \&do_list;
|
|
132
|
*do_flatlist = \&do_list;
|
|
133
|
*do_monitors = \&privileged_action;
|
|
134
|
*do_suspend = \&systemAction;
|
|
135
|
*do_resume = \&systemAction;
|
|
136
|
*do_shutdown = \&systemAction;
|
|
137
|
*do_destroy = \&systemAction;
|
|
138
|
*do_start = \&systemAction;
|
|
139
|
*do_backup = \&privileged_action;
|
|
140
|
*do_snapshot = \&privileged_action;
|
|
141
|
*do_unsnap = \&privileged_action;
|
|
142
|
*do_packages_load = \&privileged_action;
|
|
143
|
*do_monitors_save = \&privileged_action;
|
|
144
|
*do_monitors_remove = \&privileged_action;
|
|
145
|
*do_monitors_enable = \&privileged_action;
|
|
146
|
*do_monitors_disable = \&privileged_action;
|
|
147
|
*do_monitors_acknowledge = \&privileged_action;
|
|
148
|
*do_save = \&privileged_action;
|
|
149
|
*do_changemonitoremail = \&privileged_action;
|
|
150
|
*do_buildsystem = \&privileged_action;
|
|
151
|
*do_removesystem = \&privileged_action;
|
|
152
|
*do_deletesystem = \&privileged_action;
|
|
153
|
*do_removeusersystems = \&privileged_action;
|
|
154
|
*do_updateengineinfo = \&privileged_action;
|
|
155
|
|
|
156
|
*do_gear_backup = \&do_gear_action;
|
|
157
|
*do_gear_snapshot = \&do_gear_action;
|
|
158
|
*do_gear_unsnap = \&do_gear_action;
|
|
159
|
*do_gear_packages_load = \&do_gear_action;
|
|
160
|
*do_gear_monitors = \&do_gear_action;
|
|
161
|
*do_gear_monitors_enable = \&do_gear_action;
|
|
162
|
*do_gear_monitors_save = \&do_gear_action;
|
|
163
|
*do_gear_monitors_remove = \&do_gear_action;
|
|
164
|
*do_gear_monitors_disable = \&do_gear_action;
|
|
165
|
*do_gear_monitors_acknowledge = \&do_gear_action;
|
|
166
|
*do_gear_save = \&do_gear_action;
|
|
167
|
*do_gear_changemonitoremail = \&do_gear_action;
|
|
168
|
*do_gear_buildsystem = \&do_gear_action;
|
|
169
|
*do_gear_removesystem = \&do_gear_action;
|
|
170
|
*do_gear_deletesystem = \&do_gear_action;
|
|
171
|
*do_gear_removeusersystems = \&do_gear_action;
|
|
172
|
*do_gear_updateengineinfo = \&do_gear_action;
|
|
173
|
*Monitors_remove = \&Monitors_save;
|
|
174
|
*Monitors_enable = \&Monitors_action;
|
|
175
|
*Monitors_disable = \&Monitors_action;
|
|
176
|
*Monitors_acknowledge = \&Monitors_action;
|
|
177
|
}
|
|
178
|
|
|
179
|
sub do_uuidlookup {
|
|
180
|
if ($help) {
|
|
181
|
return <<END
|
|
182
|
GET:uuid:
|
|
183
|
Simple action for looking up a uuid or part of a uuid and returning the complete uuid.
|
|
184
|
END
|
|
185
|
}
|
|
186
|
my $res;
|
|
187
|
$res .= header('text/plain') unless $console;
|
|
188
|
my $u = $options{u};
|
|
189
|
$u = $curuuid unless ($u || $u eq '0');
|
|
190
|
my $ruuid;
|
|
191
|
if ($u || $u eq '0') {
|
|
192
|
my $match;
|
|
193
|
foreach my $uuid (keys %register) {
|
|
194
|
if ($uuid =~ /^$u/) {
|
|
195
|
$ruuid = $uuid if ($register{$uuid}->{'user'} eq $user || index($privileges,"a")!=-1);
|
|
196
|
$match = 1;
|
|
197
|
last;
|
|
198
|
}
|
|
199
|
}
|
|
200
|
unless ($match) {
|
|
201
|
foreach my $uuid (keys %domreg) {
|
|
202
|
if ($uuid =~ /^$u/) {
|
|
203
|
$ruuid = $uuid if ((!$domreg{$uuid}->{'system'} || $domreg{$uuid}->{'system'} eq '--' )&& ($domreg{$uuid}->{'user'} eq $user || index($privileges,"a")!=-1));
|
|
204
|
last;
|
|
205
|
}
|
|
206
|
}
|
|
207
|
}
|
|
208
|
}
|
|
209
|
$res .= "$ruuid\n" if ($ruuid);
|
|
210
|
return $res;
|
|
211
|
}
|
|
212
|
|
|
213
|
sub do_uuidshow {
|
|
214
|
if ($help) {
|
|
215
|
return <<END
|
|
216
|
GET:uuid:
|
|
217
|
Simple action for showing a single system.
|
|
218
|
END
|
|
219
|
}
|
|
220
|
my $res;
|
|
221
|
$res .= header('application/json') unless $console;
|
|
222
|
my $u = $options{u};
|
|
223
|
$u = $curuuid unless ($u || $u eq '0');
|
|
224
|
if ($u) {
|
|
225
|
foreach my $uuid (keys %register) {
|
|
226
|
if (($register{$uuid}->{'user'} eq $user || $register{$uuid}->{'user'} eq 'common' || index($privileges,"a")!=-1)
|
|
227
|
&& $uuid =~ /^$u/) {
|
|
228
|
my %hash = %{$register{$uuid}};
|
|
229
|
delete $hash{'action'};
|
|
230
|
delete $hash{'nextid'};
|
|
231
|
my $dump = to_json(\%hash, {pretty=>1});
|
|
232
|
$dump =~ s/undef/"--"/g;
|
|
233
|
$res .= $dump;
|
|
234
|
last;
|
|
235
|
}
|
|
236
|
}
|
|
237
|
}
|
|
238
|
return $res;
|
|
239
|
}
|
|
240
|
|
|
241
|
sub do_list {
|
|
242
|
my ($uuid, $action, $obj) = @_;
|
|
243
|
if ($help) {
|
|
244
|
return <<END
|
|
245
|
GET:uuid:
|
|
246
|
List systems current user has access to.
|
|
247
|
END
|
|
248
|
}
|
|
249
|
my $sysuuid;
|
|
250
|
if ($uripath =~ /systems(\.cgi)?\/(\?|)(this)/) {
|
|
251
|
$sysuuid = $cursysuuid || $curuuid;
|
|
252
|
} elsif ($uripath =~ /systems(\.cgi)?\/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/) {
|
|
253
|
$sysuuid = $2;
|
|
254
|
} elsif ($params{'system'}) {
|
|
255
|
$sysuuid = $obj->{'system'};
|
|
256
|
$sysuuid = $cursysuuid || $curuuid if ($obj->{system} eq 'this');
|
|
257
|
}
|
|
258
|
$postreply = getSystemsListing($action, $uuid);
|
|
259
|
return $postreply;
|
|
260
|
}
|
|
261
|
|
|
262
|
sub Monitors_action {
|
|
263
|
my ($uuid, $action, $obj) = @_;
|
|
264
|
if ($help) {
|
|
265
|
return <<END
|
|
266
|
GET:id:
|
|
267
|
Enable, disable or acknowledge a monitor. Id is of the form serveruuid:service
|
|
268
|
END
|
|
269
|
}
|
|
270
|
my $monitor_action = "enable";
|
|
271
|
$monitor_action = "disable" if ($action eq 'monitors_disable');
|
|
272
|
$monitor_action = "acknowledge" if ($action eq 'monitors_acknowledge');
|
|
273
|
my $log_action = uc $monitor_action;
|
|
274
|
my $group;
|
|
275
|
my $service;
|
|
276
|
my $logline;
|
|
277
|
if ($uuid =~ /(.+):(.+)/) {
|
|
278
|
$group = $1;
|
|
279
|
$service = $2;
|
|
280
|
}
|
|
281
|
if ($group && $service) {
|
|
282
|
my $reguser = $domreg{$group}->{'user'};
|
|
283
|
# Security check
|
|
284
|
if ($user eq $reguser || index($privileges,"a")!=-1) {
|
|
285
|
my $oplogfile = "/var/log/stabile/$year-$month:$group:$service";
|
|
286
|
unless (-e $oplogfile) {
|
|
287
|
`/usr/bin/touch "$oplogfile"`;
|
|
288
|
`/bin/chown mon:mon "$oplogfile"`;
|
|
289
|
}
|
|
290
|
if ($monitor_action =~ /enable|disable/) {
|
|
291
|
my $res = `/usr/bin/moncmd $monitor_action service $group $service`;
|
|
292
|
chomp $res;
|
|
293
|
$logline = "$current_time, $log_action, , $pretty_time";
|
|
294
|
} elsif ($monitor_action eq "acknowledge") {
|
|
295
|
my $ackcomment = $obj->{"ackcomment"};
|
|
296
|
# my $ackcomment = backslash( $obj->{"ackcomment"} );
|
|
297
|
#$ackcomment =~ s/ /\\\20/g;
|
|
298
|
my $monc = new Mon::Client (
|
|
299
|
host => "127.0.0.1"
|
|
300
|
);
|
|
301
|
$ackcomment = ($ackcomment)?"$user, $ackcomment":$user;
|
|
302
|
$monc->connect();
|
|
303
|
$monc->ack($group, $service, $ackcomment);
|
|
304
|
$monc->disconnect();
|
|
305
|
$logline = "$current_time, ACKNOWLEDGE, $ackcomment, $pretty_time";
|
|
306
|
my %emails;
|
|
307
|
my @emaillist = split(/\n/, `/bin/cat /etc/mon/mon.cf`);
|
|
308
|
my $emailuuid;
|
|
309
|
foreach my $eline (@emaillist) {
|
|
310
|
my ($a, $b, $c, $d) = split(/ +/, $eline);
|
|
311
|
if ($a eq 'watch') {
|
|
312
|
if ($b =~ /\S+-\S+-\S+-\S+-\S+/) {$emailuuid = $b;}
|
|
313
|
else {$emailuuid = ''};
|
|
314
|
}
|
|
315
|
$emails{$emailuuid} = $d if ($emailuuid && $b eq 'alert' && $c eq 'stabile.alert');
|
|
316
|
};
|
|
317
|
my $email = $emails{$group};
|
|
318
|
my $servername = $domreg{$group}->{'name'};
|
|
319
|
my $serveruser = $domreg{$group}->{'user'};
|
|
320
|
if ($email) {
|
|
321
|
my $mailtext = <<EOF;
|
|
322
|
Acknowledged by: $user
|
|
323
|
Server name: $servername
|
|
324
|
Server UUID: $group
|
|
325
|
System UUID: $sysuuid
|
|
326
|
Server user: $serveruser
|
|
327
|
Service: $service
|
|
328
|
EOF
|
|
329
|
;
|
|
330
|
|
|
331
|
my $mailhtml = <<END;
|
|
332
|
<!DOCTYPE html
|
|
333
|
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
|
|
334
|
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
|
335
|
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
|
|
336
|
<head>
|
|
337
|
<title>Problems with $servername:$service are being handled</title>
|
|
338
|
<meta http-equiv="Pragma" content="no-cache" />
|
|
339
|
<link rel="stylesheet" type="text/css" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/css/bootstrap.min.css" />
|
|
340
|
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
|
|
341
|
</head>
|
|
342
|
<body class="tundra">
|
|
343
|
<div>
|
|
344
|
<div class="well" style="margin:20px;">
|
|
345
|
<h3 style="color: #2980b9!important; margin-bottom:30px;">Relax, the problems with your service are being handled!</h3>
|
|
346
|
<div>The problems with the service <strong>$service</strong> on the server <strong>$servername</strong> running on <strong>$enginename</strong> have been acknowledged at $pretty_time and are being handled by <strong>$tktuser ($user)</strong>.</div>
|
|
347
|
<br>
|
|
348
|
<div>Thanks,<br>your friendly monitoring daemon</div>
|
|
349
|
</div>
|
|
350
|
</div>
|
|
351
|
</body>
|
|
352
|
</html>
|
|
353
|
END
|
|
354
|
;
|
|
355
|
|
|
356
|
my $xmpptext = "ACK: $servername:$service is being handled ($pretty_time)\n";
|
|
357
|
$xmpptext .= "Acknowledged by: $tktuser ($user)\n";
|
|
358
|
|
|
359
|
my $msg = MIME::Lite->new(
|
|
360
|
From => 'monitoring',
|
|
361
|
To => $email,
|
|
362
|
Type => 'multipart/alternative',
|
|
363
|
Subject => "ACK: $servername:$service is being handled ($pretty_time)",
|
|
364
|
);
|
|
365
|
$msg->add("sysuuid" => $sysuuid);
|
|
366
|
|
|
367
|
my $att_text = MIME::Lite->new(
|
|
368
|
Type => 'text',
|
|
369
|
Data => $mailtext,
|
|
370
|
Encoding => 'quoted-printable',
|
|
371
|
);
|
|
372
|
$att_text->attr('content-type'
|
|
373
|
=> 'text/plain; charset=UTF-8');
|
|
374
|
$msg->attach($att_text);
|
|
375
|
|
|
376
|
my $att_html = MIME::Lite->new(
|
|
377
|
Type => 'text',
|
|
378
|
Data => $mailhtml,
|
|
379
|
Encoding => 'quoted-printable',
|
|
380
|
);
|
|
381
|
$att_html->attr('content-type'
|
|
382
|
=> 'text/html; charset=UTF-8');
|
|
383
|
$msg->attach($att_html);
|
|
384
|
|
|
385
|
$msg->send;
|
|
386
|
|
|
387
|
if ($doxmpp) {
|
|
388
|
foreach my $to (split /, */, $email) {
|
|
389
|
my $xres = $main::xmppSend->($to, $xmpptext, $engineid, $sysuuid);
|
|
390
|
}
|
|
391
|
# Send alerts to Origo operators on duty
|
|
392
|
my $oponduty = 'operator@sa.origo.io';
|
|
393
|
$msg->replace('to', $oponduty);
|
|
394
|
$msg->send;
|
|
395
|
my $xres = $main::xmppSend->($oponduty, $xmpptext, $engineid, $sysuuid);
|
|
396
|
}
|
|
397
|
}
|
|
398
|
}
|
|
399
|
`/bin/echo >> $oplogfile "$logline"`;
|
|
400
|
$postreply .= "Status=OK OK $monitor_action"." $service service\n";
|
|
401
|
}
|
|
402
|
} else {
|
|
403
|
$postreply = "Status=Error problem $monitor_action monitor $uuid\n";
|
|
404
|
}
|
|
405
|
return $postreply;
|
|
406
|
}
|
|
407
|
|
|
408
|
sub do_register {
|
|
409
|
my ($uuid, $action, $obj) = @_;
|
|
410
|
if ($help) {
|
|
411
|
return <<END
|
|
412
|
GET:uuid,format:
|
|
413
|
Print software register for server or system of servers with given uuid. Format is html, csv or json (default).
|
|
414
|
END
|
|
415
|
}
|
|
416
|
|
|
417
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
418
|
my @domregvalues = values %domreg;
|
|
419
|
my %reghash;
|
|
420
|
foreach my $valref (@domregvalues) {
|
|
421
|
if ($valref->{'user'} eq $user || $fulllist) {
|
|
422
|
if (!$uuid || $uuid eq '*' || $uuid eq $valref->{'uuid'} || $uuid eq $valref->{'system'}) {
|
|
423
|
my $os = $valref->{'os'} || 'unknown';
|
|
424
|
my $domname = $valref->{'name'};
|
|
425
|
utf8::decode($domname);
|
|
426
|
if ($reghash{$os}) {
|
|
427
|
$reghash{ $os . '-' . $reghash{$os}->{'oscount'} } = {
|
|
428
|
os=>'',
|
|
429
|
sortos=>$os."*",
|
|
430
|
user=>$valref->{'user'},
|
|
431
|
name=>$domname,
|
|
432
|
hostname=>$valref->{'hostname'}
|
|
433
|
};
|
|
434
|
$reghash{$os}->{'oscount'}++;
|
|
435
|
} else {
|
|
436
|
$reghash{$os} = {
|
|
437
|
os=>$os,
|
|
438
|
sortos=>$os,
|
|
439
|
user=>$valref->{'user'},
|
|
440
|
name=>$domname,
|
|
441
|
hostname=>$valref->{'hostname'},
|
|
442
|
oscount=>1
|
|
443
|
}
|
|
444
|
}
|
|
445
|
}
|
|
446
|
}
|
|
447
|
|
|
448
|
}
|
|
449
|
untie %domreg;
|
|
450
|
my @sorted_oslist = sort {$a->{'sortos'} cmp $b->{'sortos'}} values %reghash;
|
|
451
|
if ($obj->{'format'} eq 'html') {
|
|
452
|
my $res;
|
|
453
|
$res .= qq[<tr><th>OS</th><th>Name</th><th>Hostname</th><th>Count</th></tr>];
|
|
454
|
foreach my $valref (@sorted_oslist) {
|
|
455
|
$res .= qq[<tr><td>$valref->{'os'}</td><td>$valref->{'name'}</td><td>$valref->{'hostname'}</td><td>$valref->{'oscount'}</td></tr>];
|
|
456
|
}
|
|
457
|
$postreply = header();
|
|
458
|
$postreply .= qq[<table cellspacing="0" frame="void" rules="rows" class="systemTables">$res</table>];
|
|
459
|
} elsif ($obj->{'format'} eq 'csv') {
|
|
460
|
$postreply = header("text/plain");
|
|
461
|
csv(in => \@sorted_oslist, out => \my $csvdata);
|
|
462
|
$postreply .= $csvdata;
|
|
463
|
} else {
|
|
464
|
$postreply .= to_json(\@sorted_oslist);
|
|
465
|
}
|
|
466
|
return $postreply;
|
|
467
|
|
|
468
|
}
|
|
469
|
|
|
470
|
sub Monitors {
|
|
471
|
my ($uuid, $action, $obj) = @_;
|
|
472
|
if ($help) {
|
|
473
|
return <<END
|
|
474
|
GET:uuid:
|
|
475
|
Handling of monitors
|
|
476
|
END
|
|
477
|
}
|
|
478
|
# We are dealing with a POST request, i.e. an action on a monitor
|
|
479
|
# or a PUT or DELETE request, i.e. creating/saving/deleting items
|
|
480
|
if (($ENV{'REQUEST_METHOD'} eq 'DELETE' || $params{"PUTDATA"} || $ENV{'REQUEST_METHOD'} eq 'PUT' || $ENV{'REQUEST_METHOD'} eq 'POST') && !$isreadonly) {
|
|
481
|
my @json_array;
|
|
482
|
my %json_hash;
|
|
483
|
my $delete;
|
|
484
|
if ($ENV{'REQUEST_METHOD'} eq 'DELETE' && $uripath =~ /action=monitors\/(.+):(.+)/) {
|
|
485
|
print header('text/json', '204 No Content') unless $console;
|
|
486
|
%json_hash = ('serveruuid', $1, 'service', $2);
|
|
487
|
@json_array = (\%json_hash);
|
|
488
|
$delete = 1;
|
|
489
|
# print Monitors_save(\%json_hash, $delete);
|
|
490
|
print Monitors_save($uuid, "monitors_remove", $obj);
|
|
491
|
} else {
|
|
492
|
my $json_text = $params{"PUTDATA"} || $params{'keywords'};
|
|
493
|
$json_text = encode('latin1', decode('utf8', $json_text));
|
|
494
|
$json_text =~ s/\x/ /g;
|
|
495
|
@json_array = from_json($json_text);
|
|
496
|
$json_hash_ref = @json_array[0];
|
|
497
|
# my $res = Monitors_save($json_hash_ref, $delete);
|
|
498
|
my $res = Monitors_save($uuid, "monitors_save", $obj);
|
|
499
|
if ($res =~ /^{/) {
|
|
500
|
print header('text/json') unless $console;
|
|
501
|
print $res;
|
|
502
|
} else {
|
|
503
|
print header('text/html', '400 Bad Request') unless $console;
|
|
504
|
print qq|$res|;
|
|
505
|
}
|
|
506
|
}
|
|
507
|
|
|
508
|
# We are dealing with a regular GET request, i.e. a listing
|
|
509
|
} else {
|
|
510
|
my $selgroup;
|
|
511
|
my $selservice;
|
|
512
|
if ($uuid && $uuid ne '*') { # List all monitors for specific server
|
|
513
|
$selgroup = $uuid;
|
|
514
|
if ($uuid =~ /(.+):(.+)/){ # List specific monitor for specific server
|
|
515
|
$selgroup = $1;
|
|
516
|
$selservice = $2;
|
|
517
|
}
|
|
518
|
}
|
|
519
|
my $usemoncmd = 0;
|
|
520
|
my %opstatus = getOpstatus($selgroup, $selservice, $usemoncmd);
|
|
521
|
my @monitors = values(%opstatus);
|
|
522
|
my @sorted_monitors = sort {$a->{'opstatus'} cmp $b->{'opstatus'}} @monitors;
|
|
523
|
my $json_text;
|
|
524
|
if ($obj->{'listaction'} eq 'show' && scalar @monitors == 1) {
|
|
525
|
$json_text = to_json($sorted_monitors[0], {pretty => 1});
|
|
526
|
} else {
|
|
527
|
$json_text = to_json(\@sorted_monitors, {pretty => 1});
|
|
528
|
}
|
|
529
|
utf8::decode($json_text);
|
|
530
|
$postreply = $json_text;
|
|
531
|
return $postreply;
|
|
532
|
}
|
|
533
|
|
|
534
|
}
|
|
535
|
|
|
536
|
sub do_remove {
|
|
537
|
my ($uuid, $action, $obj) = @_;
|
|
538
|
if ($help) {
|
|
539
|
return <<END
|
|
540
|
DELETE:uuid:
|
|
541
|
Delete a system from database and make all member servers free agents.
|
|
542
|
END
|
|
543
|
}
|
|
544
|
if ($register{$uuid}) {
|
|
545
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
546
|
my @domregvalues = values %domreg;
|
|
547
|
my @curregvalues;
|
|
548
|
foreach my $valref (@domregvalues) {
|
|
549
|
# Only include VM's belonging to current user (or all users if specified and user is admin)
|
|
550
|
if ($user eq $valref->{'user'} || $fulllist) {
|
|
551
|
my $system = $valref->{'system'};
|
|
552
|
if ($system eq $uuid) {
|
|
553
|
$valref->{'system'} = '';
|
|
554
|
push(@curregvalues, $valref);
|
|
555
|
}
|
|
556
|
}
|
|
557
|
}
|
|
558
|
delete $register{$uuid};
|
|
559
|
tied(%domreg)->commit;
|
|
560
|
tied(%register)->commit;
|
|
561
|
untie %domreg;
|
|
562
|
if ($match) {
|
|
563
|
$postreply = to_json(@curregvalues);
|
|
564
|
} else {
|
|
565
|
$postreply = header('text/plain', '204 No Content') unless $console;
|
|
566
|
}
|
|
567
|
}
|
|
568
|
return $postreply;
|
|
569
|
}
|
|
570
|
|
|
571
|
sub Save {
|
|
572
|
my ($uuid, $action, $obj) = @_;
|
|
573
|
if ($help) {
|
|
574
|
return <<END
|
|
575
|
PUT:uuid, name, servers, memory, vcpu, fullname, email, phone, opfullname, opemail, opphone, alertemail, services, recovery, notes, networkuuids:
|
|
576
|
Save properties for a system. If no uuid is provided, a new stack is created.[networkuuids] is a comma-separated list of networks reserved to this stack for use not associated with specific servers.
|
|
577
|
[networkuuids] is a list of UUIDs of linked network connections, i.e. connections reserved for this system to handle
|
|
578
|
|
|
579
|
Specify '--' to clear a value.
|
|
580
|
END
|
|
581
|
}
|
|
582
|
|
|
583
|
my $name = $obj->{"name"};
|
|
584
|
my $memory = $obj->{"memory"};
|
|
585
|
my $vcpu = $obj->{"vcpu"};
|
|
586
|
my $reguser;
|
|
587
|
$reguser = $register{$uuid}->{'user'} if ($register{$uuid});
|
|
588
|
$console = 1 if ($obj->{'console'});
|
|
589
|
my $issystem = $obj->{'issystem'} || $register{$uuid};
|
|
590
|
my $notes = $obj->{"notes"};
|
|
591
|
my $email = $obj->{'email'};
|
|
592
|
my $fullname = $obj->{'fullname'};
|
|
593
|
my $phone = $obj->{'phone'};
|
|
594
|
my $opemail = $obj->{'opemail'};
|
|
595
|
my $opfullname = $obj->{'opfullname'};
|
|
596
|
my $opphone = $obj->{'opphone'};
|
|
597
|
my $alertemail = $obj->{'alertemail'};
|
|
598
|
my $services = $obj->{'services'};
|
|
599
|
my $recovery = $obj->{'recovery'};
|
|
600
|
my $networkuuids = $obj->{'networkuuids'};
|
|
601
|
my $ports = $obj->{'ports'};
|
|
602
|
my $autostart = $obj->{'autostart'};
|
|
603
|
if (!$name) {
|
|
604
|
if ($issystem) {
|
|
605
|
$name = $register{$uuid}->{'name'};
|
|
606
|
} else {
|
|
607
|
$name = $domreg{$uuid}->{'name'};
|
|
608
|
}
|
|
609
|
}
|
|
610
|
if ((!$uuid)) {
|
|
611
|
my $ug = new Data::UUID;
|
|
612
|
$uuid = $ug->create_str();
|
|
613
|
$issystem = 1;
|
|
614
|
};
|
|
615
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Status=Error Unable to access domain register"};
|
|
616
|
unless ($register{$uuid} || $domreg{$uuid}) {
|
|
617
|
$obj->{'status'} = 'new';
|
|
618
|
$issystem = 1;
|
|
619
|
}
|
|
620
|
$issystem = 1 if ($register{$uuid});
|
|
621
|
unless (($uuid && length $uuid == 36)) {
|
|
622
|
$postreply = "Status=Error Invalid UUID\n";
|
|
623
|
return $postreply;
|
|
624
|
}
|
|
625
|
|
|
626
|
# Sanity checks
|
|
627
|
if ($name && length $name > 255) {
|
|
628
|
$postreply .= "Status=Error Bad data: $name " . (length $name) . "\n";
|
|
629
|
return $postreply;
|
|
630
|
};
|
|
631
|
|
|
632
|
if ($issystem) { # We are dealing with a system
|
|
633
|
# Security check
|
|
634
|
if (($user eq $reguser || $isadmin) && $register{$uuid}) { # Existing system
|
|
635
|
my @props = ('name', 'fullname','email','phone','opfullname','opemail','opphone','alertemail'
|
|
636
|
,'notes','services','recovery','autostart');
|
|
637
|
my %oldvals;
|
|
638
|
foreach my $prop (@props) {
|
|
639
|
my $val = $obj->{$prop};
|
|
640
|
if ($val) {
|
|
641
|
$val = '' if ($val eq '--');
|
|
642
|
$oldvals{$prop} = $register{$uuid}->{$prop} || $userreg{$user}->{$prop};
|
|
643
|
if ($val eq $userreg{$user}->{$prop}) {
|
|
644
|
$register{$uuid}->{$prop} = ''; # Same val as parent (user val), reset
|
|
645
|
} else {
|
|
646
|
if ($prop eq 'name' && $obj->{ports}) {
|
|
647
|
next; # TODO: ugly hack because we dont know why UTF8 is not handled correctly
|
|
648
|
}
|
|
649
|
$register{$uuid}->{$prop} = $val;
|
|
650
|
}
|
|
651
|
if ($prop eq 'autostart') {
|
|
652
|
$register{$uuid}->{$prop} = ($val)?'1':'';
|
|
653
|
}
|
|
654
|
if ($prop eq 'name') {
|
|
655
|
my $json_text = qq|{"uuid": "$uuid" , "name": "$name"}|;
|
|
656
|
$main::postAsyncToOrigo->($engineid, 'updateapps', "[$json_text]");
|
|
657
|
}
|
|
658
|
}
|
|
659
|
}
|
|
660
|
my %childrenhash;
|
|
661
|
my $alertmatch;
|
|
662
|
push @props, ('vcpu', 'memory', 'ports');
|
|
663
|
foreach my $prop (@props) {
|
|
664
|
my $val = $obj->{$prop};
|
|
665
|
if ($val) {
|
|
666
|
$val = '' if ($val eq '--');
|
|
667
|
# Update children
|
|
668
|
foreach my $domvalref (values %domreg) {
|
|
669
|
if ($domvalref->{'user'} eq $user && $domvalref->{'system'} eq $uuid) {
|
|
670
|
my %domval = %{$domvalref};
|
|
671
|
my $serveruuid = $domvalref->{'uuid'};
|
|
672
|
$childrenhash{$serveruuid} =\%domval unless ($childrenhash{$serveruuid});
|
|
673
|
$childrenhash{$serveruuid}->{$prop} = $val;
|
|
674
|
if ($prop eq 'autostart') {
|
|
675
|
$domvalref->{$prop} = ($val) ? '1' : ''; # Always update child servers with autostart prop
|
|
676
|
} elsif ((
|
|
677
|
($obj->{'vcpu'} && $prop eq 'vcpu')
|
|
678
|
|| ($obj->{'memory'} && $prop eq 'memory')
|
|
679
|
) && $domvalref->{status} eq 'shutoff') {
|
|
680
|
$Stabile::Servers::console = 1;
|
|
681
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
682
|
$postreply .= Stabile::Servers::Save($serveruuid, 'save',
|
|
683
|
{ uuid => $serveruuid, $prop => $obj->{$prop} });
|
|
684
|
} elsif ($obj->{'ports'} && $prop eq 'ports') {
|
|
685
|
$Stabile::Networks::console = 1;
|
|
686
|
require "$Stabile::basedir/cgi/networks.cgi";
|
|
687
|
my $networkuuid1 = $domvalref->{'networkuuid1'};
|
|
688
|
my $saveobj = {uuid => $networkuuid1};
|
|
689
|
$saveobj->{ports} = $ports;
|
|
690
|
$postreply .= Stabile::Networks::Deactivate($networkuuid1);
|
|
691
|
$postreply .= Stabile::Networks::Save($networkuuid1, 'save', $saveobj);
|
|
692
|
$postreply .= Stabile::Networks::Activate($networkuuid1);
|
|
693
|
} elsif (!$domvalref->{$prop} || $domvalref->{$prop} eq $oldvals{$prop}) { # Inheritance is implied, so delete redundant entries
|
|
694
|
$domvalref->{$prop} = '';
|
|
695
|
if ($prop eq 'alertemail') {
|
|
696
|
if (change_monitor_email($serveruuid, $val, $oldvals{$prop})) {
|
|
697
|
$alertmatch = 1;
|
|
698
|
}
|
|
699
|
}
|
|
700
|
}
|
|
701
|
}
|
|
702
|
}
|
|
703
|
}
|
|
704
|
}
|
|
705
|
my @children = values %childrenhash;
|
|
706
|
$obj->{'children'} = \@children if (@children);
|
|
707
|
$postreply = getSystemsListing();
|
|
708
|
} elsif ($obj->{'status'} eq 'new') { # New system
|
|
709
|
$register{$uuid} = {
|
|
710
|
uuid=>$uuid,
|
|
711
|
name=>$name,
|
|
712
|
user=>$user,
|
|
713
|
created=>$current_time
|
|
714
|
};
|
|
715
|
my $valref = $register{$uuid};
|
|
716
|
my %val = %{$valref};
|
|
717
|
$val{'issystem'} = 1;
|
|
718
|
$val{'status'} = '--';
|
|
719
|
$dojson = 1;
|
|
720
|
$postreply = to_json(\%val, {pretty=>1});
|
|
721
|
} else {
|
|
722
|
$postreply .= "Status=Error Not enough privileges: $user\n";
|
|
723
|
}
|
|
724
|
} else { # We are dealing with a server
|
|
725
|
my $valref = $domreg{$uuid};
|
|
726
|
if (!$valref && $obj->{'uuid'}[0]) {$valref = $domreg{ $obj->{'uuid'}[0] }}; # We are dealing with a newly created server
|
|
727
|
if ($valref && ($valref->{'user'} eq $user || $isadmin)) {
|
|
728
|
my $system = $obj->{'system'};
|
|
729
|
my $servername = $obj->{'name'};
|
|
730
|
if ($servername && $servername ne $valref->{'name'}) {
|
|
731
|
$valref->{'name'} = $servername;
|
|
732
|
# Update status of images
|
|
733
|
my @imgs = ($domreg{$uuid}->{image}, $domreg{$uuid}->{image2}, $domreg{$uuid}->{image3}, $domreg{$uuid}->{image4});
|
|
734
|
my @imgkeys = ('image', 'image2', 'image3', 'image4');
|
|
735
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Status=Error Unable to access image register"};
|
|
736
|
for (my $i=0; $i<4; $i++) {
|
|
737
|
my $img = $imgs[$i];
|
|
738
|
my $k = $imgkeys[$i];
|
|
739
|
if ($img && $img ne '--') {
|
|
740
|
$imagereg{$img}->{'domains'} = $uuid;
|
|
741
|
$imagereg{$img}->{'domainnames'} = $servername;
|
|
742
|
}
|
|
743
|
}
|
|
744
|
untie %imagereg;
|
|
745
|
my $json_text = qq|{"uuid": "$uuid" , "name": "$servername"}|;
|
|
746
|
$main::postAsyncToOrigo->($engineid, 'updateapps', "[$json_text]");
|
|
747
|
}
|
|
748
|
$valref->{'system'} = ($system eq '--'?'':$system) if ($system);
|
|
749
|
$valref->{'notes'} = (($notes eq '--')?'':$notes) if ($notes);
|
|
750
|
$valref->{'email'} = ($email eq '--'?'':$email) if ($email);
|
|
751
|
$valref->{'fullname'} = ($fullname eq '--'?'':$fullname) if ($fullname);
|
|
752
|
$valref->{'phone'} = ($phone eq '--'?'':$phone) if ($phone);
|
|
753
|
$valref->{'opemail'} = ($opemail eq '--'?'':$opemail) if ($opemail);
|
|
754
|
$valref->{'opfullname'} = ($opfullname eq '--'?'':$opfullname) if ($opfullname);
|
|
755
|
$valref->{'opphone'} = ($opphone eq '--'?'':$opphone) if ($opphone);
|
|
756
|
$valref->{'services'} = ($services eq '--'?'':$services) if ($services);
|
|
757
|
$valref->{'recovery'} = ($recovery eq '--'?'':$recovery) if ($recovery);
|
|
758
|
$valref->{'autostart'} = ($autostart && $autostart ne '--'?'1':'');
|
|
759
|
if ($alertemail) {
|
|
760
|
$alertemail = '' if ($alertemail eq '--');
|
|
761
|
if ($valref->{'alertemail'} ne $alertemail) {
|
|
762
|
# If alert email is changed, update monitor if it is configured with this email
|
|
763
|
if (change_monitor_email($valref->{'uuid'}, $alertemail, $valref->{'alertemail'})){
|
|
764
|
$alertmatch = 1;
|
|
765
|
#`/usr/bin/moncmd reset keepstate`;
|
|
766
|
}
|
|
767
|
$valref->{'alertemail'} = $alertemail;
|
|
768
|
}
|
|
769
|
}
|
|
770
|
if (($vcpu || $memory) && $valref->{status} eq 'shutoff') {
|
|
771
|
$Stabile::Servers::console = 1;
|
|
772
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
773
|
my $saveobj = {uuid => $valref->{'uuid'}};
|
|
774
|
$saveobj->{vcpu} = $vcpu if ($vcpu);
|
|
775
|
$saveobj->{memory} = $memory if ($memory);
|
|
776
|
$postreply .= Stabile::Servers::Save($valref->{'uuid'}, 'save', $saveobj);
|
|
777
|
|
|
778
|
}
|
|
779
|
if ($ports) {
|
|
780
|
$Stabile::Networks::console = 1;
|
|
781
|
require "$Stabile::basedir/cgi/networks.cgi";
|
|
782
|
my $networkuuid1 = $valref->{'networkuuid1'};
|
|
783
|
my $saveobj = {uuid => $networkuuid1};
|
|
784
|
$saveobj->{ports} = $ports;
|
|
785
|
$postreply .= Stabile::Networks::Deactivate($networkuuid1);
|
|
786
|
$postreply .= Stabile::Networks::Save($networkuuid1, 'save', $saveobj);
|
|
787
|
$postreply .= Stabile::Networks::Activate($networkuuid1);
|
|
788
|
|
|
789
|
}
|
|
790
|
tied(%domreg)->commit;
|
|
791
|
$postreply = getSystemsListing(); # Hard to see what else to do, than to send entire table
|
|
792
|
}
|
|
793
|
}
|
|
794
|
if ($networkuuids && $networkuuids ne '--') { # link networks to this system
|
|
795
|
my @networks = split(/, ?/, $networkuuids);
|
|
796
|
my @newnetworks = ();
|
|
797
|
my @newnetworknames = ();
|
|
798
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access networks register"};
|
|
799
|
foreach my $networkuuid (@networks) {
|
|
800
|
next unless ($networkreg{$networkuuid});
|
|
801
|
if (
|
|
802
|
!$networkreg{$networkuuid}->{'domains'} # a network cannot both be linked and in active use
|
|
803
|
&& (!$networkreg{$networkuuid}->{'systems'} || $networkreg{$networkuuid}->{'systems'} eq $uuid) # check if network is already linked to another system
|
|
804
|
) {
|
|
805
|
$networkreg{$networkuuid}->{'systems'} = $uuid;
|
|
806
|
$networkreg{$networkuuid}->{'systemnames'} = $name;
|
|
807
|
push @newnetworks, $networkuuid;
|
|
808
|
push @newnetworknames, $networkreg{$networkuuid}->{'name'};
|
|
809
|
}
|
|
810
|
}
|
|
811
|
if ($issystem && $register{$uuid}) {
|
|
812
|
$register{$uuid}->{'networkuuids'} = join(", ", @newnetworks);
|
|
813
|
$register{$uuid}->{'networknames'} = join(", ", @newnetworknames);
|
|
814
|
} elsif ($domreg{$uuid}) {
|
|
815
|
$domreg{$uuid}->{'networkuuids'} = join(", ", @newnetworks);
|
|
816
|
$domreg{$uuid}->{'networknames'} = join(", ", @newnetworknames);
|
|
817
|
}
|
|
818
|
}
|
|
819
|
untie %domreg;
|
|
820
|
return $postreply;
|
|
821
|
}
|
|
822
|
|
|
823
|
sub do_resettoaccountinfo {
|
|
824
|
my ($uuid, $action, $obj) = @_;
|
|
825
|
if ($help) {
|
|
826
|
return <<END
|
|
827
|
GET::
|
|
828
|
Recursively reset contact data for all systems and servers
|
|
829
|
END
|
|
830
|
}
|
|
831
|
my @props = ('fullname','email','phone','opfullname','opemail','opphone','alertemail');
|
|
832
|
my $alertmatch;
|
|
833
|
foreach my $sysvalref (values %register) {
|
|
834
|
if ($user eq $sysvalref->{'user'}) {
|
|
835
|
my $sysuuid = $sysvalref->{'uuid'};
|
|
836
|
foreach my $prop (@props) {
|
|
837
|
# Does this system have a value?
|
|
838
|
if ($sysvalref->{$prop}) {
|
|
839
|
$sysvalref->{$prop} = ''; # An empty val refers to parent (user) val
|
|
840
|
}
|
|
841
|
}
|
|
842
|
}
|
|
843
|
}
|
|
844
|
# Update domains
|
|
845
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {$posterror = "Unable to access domain register"; return;};
|
|
846
|
foreach my $domvalref (values %domreg) {
|
|
847
|
if ($domvalref->{'user'} eq $user) {
|
|
848
|
foreach my $prop (@props) {
|
|
849
|
if ($domvalref->{$prop}) {
|
|
850
|
$domvalref->{$prop} = '';
|
|
851
|
}
|
|
852
|
if ($prop eq 'alertemail') {
|
|
853
|
if (change_monitor_email($domvalref->{'uuid'}, $userreg{$user}->{$prop})) {
|
|
854
|
$alertmatch = 1;
|
|
855
|
}
|
|
856
|
}
|
|
857
|
}
|
|
858
|
}
|
|
859
|
}
|
|
860
|
tied(%domreg)->commit;
|
|
861
|
untie %domreg;
|
|
862
|
#`/usr/bin/moncmd reset keepstate` if ($alertmatch);
|
|
863
|
$postreply .= "Status=OK OK - reset systems and servers contacts to account values\n";
|
|
864
|
return $postreply;
|
|
865
|
}
|
|
866
|
|
|
867
|
sub do_start_server {
|
|
868
|
my ($uuid, $action, $obj) = @_;
|
|
869
|
if ($help) {
|
|
870
|
return <<END
|
|
871
|
GET:uuid:
|
|
872
|
Start specific server.
|
|
873
|
END
|
|
874
|
}
|
|
875
|
$Stabile::Servers::console = 1;
|
|
876
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
877
|
$postreply .= Stabile::Servers::Start($uuid, 'start', { buildsystem => 0 });
|
|
878
|
}
|
|
879
|
|
|
880
|
sub systemAction {
|
|
881
|
my ($uuid, $action, $obj) = @_;
|
|
882
|
if ($help) {
|
|
883
|
return <<END
|
|
884
|
GET:uuid:
|
|
885
|
Suspend, resume, start, shutdown, destroy og backup individual servers or servers belonging to a system.
|
|
886
|
END
|
|
887
|
}
|
|
888
|
my $issystem = $obj->{'issystem'} || $register{$uuid};
|
|
889
|
my $reguser;
|
|
890
|
$reguser = $register{$uuid}->{'user'} if ($register{$uuid});
|
|
891
|
|
|
892
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
893
|
unless (tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access images register"}|; return $res;};
|
|
894
|
|
|
895
|
if ($issystem) { # Existing system
|
|
896
|
if (($user eq $reguser || $isadmin) && $register{$uuid}){ # Existing system
|
|
897
|
my $domactions;
|
|
898
|
my $imageactions;
|
|
899
|
|
|
900
|
foreach my $domvalref (values %domreg) {
|
|
901
|
if (($domvalref->{'system'} eq $uuid || $domvalref->{'uuid'} eq $uuid)
|
|
902
|
&& ($domvalref->{'user'} eq $user || $isadmin)) {
|
|
903
|
my $domaction;
|
|
904
|
my $imageaction;
|
|
905
|
if ($domvalref->{'status'} eq 'paused' && ($action eq 'start' || $action eq 'resume')) {
|
|
906
|
$domaction = 'resume';
|
|
907
|
} elsif ($domvalref->{'status'} eq 'running' && $action eq 'suspend') {
|
|
908
|
$domaction = $action;
|
|
909
|
} elsif ($domvalref->{'status'} eq 'shutoff' && $action eq 'start') {
|
|
910
|
$domaction = $action;
|
|
911
|
} elsif ($domvalref->{'status'} eq 'inactive' && $action eq 'start') {
|
|
912
|
$domaction = $action;
|
|
913
|
} elsif ($domvalref->{'status'} eq 'running' && $action eq 'shutdown') {
|
|
914
|
$domaction = $action;
|
|
915
|
} elsif ($domvalref->{'status'} eq 'running' && $action eq 'destroy') {
|
|
916
|
$domaction = $action;
|
|
917
|
} elsif ($domvalref->{'status'} eq 'shuttingdown' && $action eq 'destroy') {
|
|
918
|
$domaction = $action;
|
|
919
|
} elsif ($domvalref->{'status'} eq 'destroying' && $action eq 'destroy') {
|
|
920
|
$domaction = $action;
|
|
921
|
} elsif ($domvalref->{'status'} eq 'starting' && $action eq 'destroy') {
|
|
922
|
$domaction = $action;
|
|
923
|
} elsif ($domvalref->{'status'} eq 'inactive' && $action eq 'destroy') {
|
|
924
|
$domaction = $action;
|
|
925
|
} elsif ($domvalref->{'status'} eq 'paused' && $action eq 'destroy') {
|
|
926
|
$domaction = $action;
|
|
927
|
} elsif ($action eq 'backup' || $action eq 'snapshot' || $action eq 'unsnap') {
|
|
928
|
$imageaction = $action;
|
|
929
|
}
|
|
930
|
if ($domaction) {
|
|
931
|
$domactions .= qq/{"uuid":"$domvalref->{'uuid'}","action":"$domaction"},/;
|
|
932
|
}
|
|
933
|
if ($imageaction) {
|
|
934
|
my $image = $domvalref->{'image'};
|
|
935
|
if ($imagereg{$image}->{'status'} =~ /used|active/) {
|
|
936
|
$imageactions .= qq/{"uuid":"$imagereg{$image}->{'uuid'}","action":"gear_$imageaction"},/;
|
|
937
|
}
|
|
938
|
my $image2 = $domvalref->{'image2'};
|
|
939
|
if ($image2 && $image2 ne '--' && $imagereg{$image2}->{'status'} =~ /used|active/) {
|
|
940
|
$imageactions .= qq/{"uuid":"$imagereg{$image2}->{'uuid'}","action":"gear_$imageaction"},/;
|
|
941
|
}
|
|
942
|
my $image3 = $domvalref->{'image3'};
|
|
943
|
if ($image3 && $image3 ne '--' && $imagereg{$image3}->{'status'} =~ /used|active/) {
|
|
944
|
$imageactions .= qq/{"uuid":"$imagereg{$image3}->{'uuid'}","action":"gear_$imageaction"},/;
|
|
945
|
}
|
|
946
|
my $image4 = $domvalref->{'image4'};
|
|
947
|
if ($image4 && $image4 ne '--' && $imagereg{$image4}->{'status'} =~ /used|active/) {
|
|
948
|
$imageactions .= qq/{"uuid":"$imagereg{$image4}->{'uuid'}","action":"gear_$imageaction"},/;
|
|
949
|
}
|
|
950
|
}
|
|
951
|
}
|
|
952
|
}
|
|
953
|
|
|
954
|
if ($domactions) {
|
|
955
|
$domactions = substr($domactions,0,-1);
|
|
956
|
my $uri_action = qq/{"items":[$domactions]}/;
|
|
957
|
$uri_action = URI::Escape::uri_escape($uri_action);
|
|
958
|
$uri_action =~ /(.+)/; $uri_action = $1; #untaint
|
|
959
|
$postreply .= `REMOTE_USER=$user $Stabile::basedir/cgi/servers.cgi -k $uri_action`;
|
|
960
|
}
|
|
961
|
if ($imageactions) {
|
|
962
|
$imageactions = substr($imageactions,0,-1);
|
|
963
|
my $uri_action = qq/{"items":[$imageactions]}/;
|
|
964
|
$uri_action = URI::Escape::uri_escape($uri_action);
|
|
965
|
$uri_action =~ /(.+)/; $uri_action = $1; #untaint
|
|
966
|
my $cmd = qq|REQUEST_METHOD=POST REMOTE_USER=$user $Stabile::basedir/cgi/images.cgi -k $uri_action|;
|
|
967
|
$postreply .= `$cmd`;
|
|
968
|
}
|
|
969
|
if (!$domactions && !$imageactions) {
|
|
970
|
$postreply .= "Stream=ERROR $action";
|
|
971
|
}
|
|
972
|
}
|
|
973
|
} else {
|
|
974
|
if ($action eq 'backup' || $action eq 'snapshot' || $action eq 'unsnap') {
|
|
975
|
my $image = $domreg{$uuid}->{'image'};
|
|
976
|
my $imageactions;
|
|
977
|
if ($imagereg{$image}->{'status'} =~ /used|active/) {
|
|
978
|
$imageactions .= qq/{"uuid":"$imagereg{$image}->{'uuid'}","action":"gear_$action"},/;
|
|
979
|
}
|
|
980
|
my $image2 = $domreg{$uuid}->{'image2'};
|
|
981
|
if ($image2 && $image2 ne '--' && $imagereg{$image2}->{'status'} =~ /used|active/) {
|
|
982
|
$imageactions .= qq/{"uuid":"$imagereg{$image2}->{'uuid'}","action":"gear_$action"},/;
|
|
983
|
}
|
|
984
|
my $image3 = $domreg{$uuid}->{'image3'};
|
|
985
|
if ($image3 && $image3 ne '--' && $imagereg{$image3}->{'status'} =~ /used|active/) {
|
|
986
|
$imageactions .= qq/{"uuid":"$imagereg{$image3}->{'uuid'}","action":"gear_$action"},/;
|
|
987
|
}
|
|
988
|
my $image4 = $domreg{$uuid}->{'image4'};
|
|
989
|
if ($image4 && $image4 ne '--' && $imagereg{$image4}->{'status'} =~ /used|active/) {
|
|
990
|
$imageactions .= qq/{"uuid":"$imagereg{$image4}->{'uuid'}","action":"gear_$action"},/;
|
|
991
|
}
|
|
992
|
if ($imageactions) {
|
|
993
|
$imageactions = substr($imageactions,0,-1);
|
|
994
|
my $uri_action = qq/{"items":[$imageactions]}/;
|
|
995
|
$uri_action = URI::Escape::uri_escape($uri_action);
|
|
996
|
$uri_action = $1 if $uri_action =~ /(.+)/; #untaint
|
|
997
|
my $cmd = qq|REQUEST_METHOD=POST REMOTE_USER=$user $Stabile::basedir/cgi/images.cgi -k "$uri_action"|;
|
|
998
|
$postreply .= `$cmd`;
|
|
999
|
}
|
|
1000
|
} else {
|
|
1001
|
my $cmd = qq|REQUEST_METHOD=GET REMOTE_USER=$user $Stabile::basedir/cgi/servers.cgi -a $action -u $uuid|;
|
|
1002
|
$postreply = `$cmd`;
|
|
1003
|
#$postreply = $cmd;
|
|
1004
|
my $uistatus = $action."ing";
|
|
1005
|
$uistatus = "resuming" if ($action eq 'resume');
|
|
1006
|
$uistatus = "shuttingdown" if ($action eq 'shutdown');
|
|
1007
|
$main::updateUI->({ tab => 'servers',
|
|
1008
|
user => $user,
|
|
1009
|
uuid => $uuid,
|
|
1010
|
status => $uistatus })
|
|
1011
|
|
|
1012
|
}
|
|
1013
|
}
|
|
1014
|
untie %domreg;
|
|
1015
|
untie %imagereg;
|
|
1016
|
|
|
1017
|
return $postreply;
|
|
1018
|
}
|
|
1019
|
|
|
1020
|
sub Updateengineinfo {
|
|
1021
|
my ($uuid, $action, $obj) = @_;
|
|
1022
|
if ($help) {
|
|
1023
|
return <<END
|
|
1024
|
PUT:downloadmasters, externaliprangestart, externaliprangeend, proxyiprangestart, proxyiprangeend, proxygw, vmreadlimit, vmwritelimit, vmiopsreadlimit, vmiopswritelimit:
|
|
1025
|
Save engine information.
|
|
1026
|
END
|
|
1027
|
}
|
|
1028
|
unless ($isadmin) {
|
|
1029
|
$postreply = "Status=Error Not allowed\n";
|
|
1030
|
return $postreply;
|
|
1031
|
}
|
|
1032
|
my $msg = "Engine updated";
|
|
1033
|
my $dl = $obj->{'downloadmasters'};
|
|
1034
|
if ($dl eq '--' || $dl eq '0') {
|
|
1035
|
if ($downloadmasters) {
|
|
1036
|
$downloadmasters = '';
|
|
1037
|
`perl -pi -e 's/DOWNLOAD_MASTERS=.*/DOWNLOAD_MASTERS=0/;' /etc/stabile/config.cfg`;
|
|
1038
|
}
|
|
1039
|
$postreply .= "Status=OK Engine updated\n";
|
|
1040
|
my @ps = split("\n", `pgrep pressurecontrol` ); `kill -HUP $ps[0]`;
|
|
1041
|
}
|
|
1042
|
elsif ($dl eq '1' || $dl eq '2') {
|
|
1043
|
if (!$downloadmasters || $dl eq '2') { # We use a value of 2 to force check for downloads
|
|
1044
|
$downloadmasters = 1;
|
|
1045
|
`perl -pi -e 's/DOWNLOAD_MASTERS=.*/DOWNLOAD_MASTERS=$dl/;' /etc/stabile/config.cfg`;
|
|
1046
|
}
|
|
1047
|
if ($dl eq '2') {
|
|
1048
|
$msg = "Checking for new or updated masters...";
|
|
1049
|
}
|
|
1050
|
$postreply .= "Status=OK Engine updated\n";
|
|
1051
|
my @ps = split("\n", `pgrep pressurecontrol` );
|
|
1052
|
`kill -HUP $ps[0]`;
|
|
1053
|
}
|
|
1054
|
elsif ($obj->{'disablesnat'} eq '--' || $obj->{'disablesnat'} eq '0') {
|
|
1055
|
if ($disablesnat) {
|
|
1056
|
$disablesnat = '';
|
|
1057
|
`perl -pi -e 's/DISABLE_SNAT=.*/DISABLE_SNAT=0/;' /etc/stabile/config.cfg`;
|
|
1058
|
}
|
|
1059
|
$postreply .= "Status=OK Engine updated\n";
|
|
1060
|
}
|
|
1061
|
elsif ($obj->{'disablesnat'} eq '1') {
|
|
1062
|
unless ($disablesnat) {
|
|
1063
|
$disablesnat = 1;
|
|
1064
|
`perl -pi -e 's/DISABLE_SNAT=.*/DISABLE_SNAT=1/;' /etc/stabile/config.cfg`;
|
|
1065
|
}
|
|
1066
|
$postreply .= "Status=OK Engine updated\n";
|
|
1067
|
}
|
|
1068
|
elsif ($obj->{'enforceiolimits'} eq '--' || $obj->{'enforceiolimits'} eq '0') {
|
|
1069
|
if ($enforceiolimits) {
|
|
1070
|
$enforceiolimits = '';
|
|
1071
|
`perl -pi -e 's/ENFORCE_IO_LIMITS=.*/ENFORCE_IO_LIMITS=0/;' /etc/stabile/config.cfg`;
|
|
1072
|
}
|
|
1073
|
$postreply .= "Status=OK Engine updated\n";
|
|
1074
|
}
|
|
1075
|
elsif ($obj->{'enforceiolimits'} eq '1') {
|
|
1076
|
unless ($enforceiolimits) {
|
|
1077
|
$enforceiolimits = 1;
|
|
1078
|
`perl -pi -e 's/ENFORCE_IO_LIMITS=.*/ENFORCE_IO_LIMITS=1/;' /etc/stabile/config.cfg`;
|
|
1079
|
}
|
|
1080
|
$postreply .= "Status=OK Engine updated\n";
|
|
1081
|
}
|
|
1082
|
elsif ($obj->{'externaliprangestart'}) {
|
|
1083
|
if ($obj->{'externaliprangestart'} =~ /\d+\.\d+\.\d+\.\d+/) {
|
|
1084
|
$extiprangestart = $obj->{'externaliprangestart'};
|
|
1085
|
$msg = "Setting external IP range start to $extiprangestart";
|
|
1086
|
`perl -pi -e 's/EXTERNAL_IP_RANGE_START=.*/EXTERNAL_IP_RANGE_START=$extiprangestart/;' /etc/stabile/config.cfg`;
|
|
1087
|
$postreply .= "Status=OK Engine updated\n";
|
|
1088
|
} else {
|
|
1089
|
$msg = "Not changing IP range - $obj->{'externaliprangestart'} is not valid";
|
|
1090
|
}
|
|
1091
|
}
|
|
1092
|
elsif ($obj->{'externaliprangeend'}) {
|
|
1093
|
if ($obj->{'externaliprangeend'} =~ /\d+\.\d+\.\d+\.\d+/) {
|
|
1094
|
$extiprangeend = $obj->{'externaliprangeend'};
|
|
1095
|
$msg = "Setting external IP range end to $extiprangeend";
|
|
1096
|
`perl -pi -e 's/EXTERNAL_IP_RANGE_END=.*/EXTERNAL_IP_RANGE_END=$extiprangeend/;' /etc/stabile/config.cfg`;
|
|
1097
|
$postreply .= "Status=OK Engine updated\n";
|
|
1098
|
} else {
|
|
1099
|
$msg = "Not changing IP range - $obj->{'externaliprangeend'} is not valid";
|
|
1100
|
}
|
|
1101
|
}
|
|
1102
|
elsif ($obj->{'proxyiprangestart'}) {
|
|
1103
|
if ($obj->{'proxyiprangestart'} =~ /\d+\.\d+\.\d+\.\d+/) {
|
|
1104
|
$extiprangestart = $obj->{'proxyiprangestart'};
|
|
1105
|
$msg = "Setting proxy IP range start to $extiprangestart";
|
|
1106
|
`perl -pi -e 's/PROXY_IP_RANGE_START=.*/PROXY_IP_RANGE_START=$extiprangestart/;' /etc/stabile/config.cfg`;
|
|
1107
|
$postreply .= "Status=OK Engine updated\n";
|
|
1108
|
} else {
|
|
1109
|
$msg = "Not changing IP range - $obj->{'proxyiprangestart'} is not valid";
|
|
1110
|
}
|
|
1111
|
}
|
|
1112
|
elsif ($obj->{'proxyiprangeend'}) {
|
|
1113
|
if ($obj->{'proxyiprangeend'} =~ /\d+\.\d+\.\d+\.\d+/) {
|
|
1114
|
$extiprangeend = $obj->{'proxyiprangeend'};
|
|
1115
|
$msg = "Setting proxy IP range end to $extiprangeend";
|
|
1116
|
`perl -pi -e 's/PROXY_IP_RANGE_END=.*/PROXY_IP_RANGE_END=$extiprangeend/;' /etc/stabile/config.cfg`;
|
|
1117
|
$postreply .= "Status=OK Engine updated\n";
|
|
1118
|
} else {
|
|
1119
|
$msg = "Not changing IP range - $obj->{'proxyiprangeend'} is not valid";
|
|
1120
|
}
|
|
1121
|
}
|
|
1122
|
elsif ($obj->{'proxygw'}) {
|
|
1123
|
if ($obj->{'proxygw'} =~ /\d+\.\d+\.\d+\.\d+/) {
|
|
1124
|
$proxygw = $obj->{'proxygw'};
|
|
1125
|
$msg = "Setting proxy gw to $proxygw";
|
|
1126
|
`perl -pi -e 's/PROXY_GW=.*/PROXY_GW=$proxygw/;' /etc/stabile/config.cfg`;
|
|
1127
|
$postreply .= "Status=OK Engine updated\n";
|
|
1128
|
} else {
|
|
1129
|
$msg = "Not changing IP range - $obj->{'proxygw'} is not valid";
|
|
1130
|
}
|
|
1131
|
}
|
|
1132
|
elsif ($obj->{'vmreadlimit'} || $obj->{'vmwritelimit'} || $obj->{'vmiopsreadlimit'} || $obj->{'vmiopswritelimit'}) {
|
|
1133
|
my $lim = 'vmreadlimit';
|
|
1134
|
my $uclim = 'VM_READ_LIMIT';
|
|
1135
|
if ($obj->{'vmwritelimit'}) {
|
|
1136
|
$lim = 'vmwritelimit';
|
|
1137
|
$uclim = 'VM_WRITE_LIMIT';
|
|
1138
|
} elsif ($obj->{'vmiopsreadlimit'}) {
|
|
1139
|
$lim = 'vmiopsreadlimit';
|
|
1140
|
$uclim = 'VM_IOPS_READ_LIMIT';
|
|
1141
|
} elsif ($obj->{'vmiopswritelimit'}) {
|
|
1142
|
$lim = 'vmiopswritelimit';
|
|
1143
|
$uclim = 'VM_IOPS_WRITE_LIMIT';
|
|
1144
|
}
|
|
1145
|
if ($obj->{$lim} >= 0 && $obj->{$lim} < 10000 *1024*1024) { #sanity checks
|
|
1146
|
unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities',key=>'identity',CLOBBER=>3}, $Stabile::dbopts)) ) {return "Unable to access id register"};
|
|
1147
|
my @nodeconfigs;
|
|
1148
|
# Build hash of known node config files
|
|
1149
|
foreach my $valref (values %idreg) {
|
|
1150
|
my $nodeconfigfile = $valref->{'path'} . "/casper/filesystem.dir/etc/stabile/nodeconfig.cfg";
|
|
1151
|
next if ($nodeconfigs{$nodeconfigfile}); # Node identities may share basedir and node config file
|
|
1152
|
if (-e $nodeconfigfile) {
|
|
1153
|
push @nodeconfigs, $nodeconfigfile;
|
|
1154
|
}
|
|
1155
|
}
|
|
1156
|
untie %idreg;
|
|
1157
|
push @nodeconfigs, "/etc/stabile/nodeconfig.cfg";
|
|
1158
|
my $limit = int $obj->{$lim};
|
|
1159
|
$msg = "Setting $uclim limit to $limit";
|
|
1160
|
foreach my $nodeconfig (@nodeconfigs) {
|
|
1161
|
my $cfg = new Config::Simple($nodeconfig);
|
|
1162
|
$cfg->param($uclim, $limit);
|
|
1163
|
$cfg->save();
|
|
1164
|
}
|
|
1165
|
$Stabile::Nodes::console = 1;
|
|
1166
|
require "$Stabile::basedir/cgi/nodes.cgi";
|
|
1167
|
$postreply .= Stabile::Nodes::Configurecgroups();
|
|
1168
|
$postreply .= Stabile::Nodes::do_reloadall('','reloadall', {'nodeaction'=>'CGLOAD'});
|
|
1169
|
$postreply .= "Status=OK Engine and nodes updated: $lim set to $limit\n";
|
|
1170
|
} else {
|
|
1171
|
$msg = "Not changing limit - $obj->{$lim} is not valid";
|
|
1172
|
}
|
|
1173
|
}
|
|
1174
|
if (!$postreply) {
|
|
1175
|
$msg = "Engine not updated";
|
|
1176
|
$postreply = "Status=Error Engine not updated\n" ;
|
|
1177
|
}
|
|
1178
|
$main::updateUI->({tab=>'home', user=>$user, type=>'update', message=>$msg});
|
|
1179
|
return $postreply;
|
|
1180
|
}
|
|
1181
|
|
|
1182
|
sub do_updateaccountinfo {
|
|
1183
|
my ($uuid, $action, $obj) = @_;
|
|
1184
|
if ($help) {
|
|
1185
|
return <<END
|
|
1186
|
PUT:fullname, email, phone, opfullname, opemail, opphone, alertemail, allowfrom, allowinternalapi:
|
|
1187
|
Save user information.
|
|
1188
|
END
|
|
1189
|
}
|
|
1190
|
my @props = ('fullname','email','phone','opfullname','opemail','opphone','alertemail', 'allowfrom', 'allowinternalapi');
|
|
1191
|
my %oldvals;
|
|
1192
|
if ($obj->{'allowfrom'} && $obj->{'allowfrom'} ne '--') {
|
|
1193
|
my @allows = split(/,\s*/, $obj->{'allowfrom'});
|
|
1194
|
$obj->{'allowfrom'} = '';
|
|
1195
|
my %allowshash;
|
|
1196
|
foreach my $ip (@allows) {
|
|
1197
|
$allowshash{"$1$2"} = 1 if ($ip =~ /(\d+\.\d+\.\d+\.\d+)(\/\d+)?/);
|
|
1198
|
if ($ip =~ /\w\w/) { # Check if we are dealing with a country code
|
|
1199
|
$ip = uc $ip;
|
|
1200
|
my $geoip = Geo::IP->new(GEOIP_MEMORY_CACHE);
|
|
1201
|
my $tz = $geoip->time_zone($ip, '');
|
|
1202
|
$allowshash{$ip} = 1 if ($tz); # We have a valid country code
|
|
1203
|
}
|
|
1204
|
}
|
|
1205
|
$obj->{'allowfrom'} = join(", ", sort(keys %allowshash));
|
|
1206
|
unless ($obj->{'allowfrom'}) {
|
|
1207
|
$postreply .= "Status=Error Account not updated\n";
|
|
1208
|
return $postreply;
|
|
1209
|
}
|
|
1210
|
}
|
|
1211
|
|
|
1212
|
foreach my $prop (@props) {
|
|
1213
|
if ($obj->{$prop}) {
|
|
1214
|
$obj->{$prop} = '' if ($obj->{$prop} eq '--');
|
|
1215
|
$oldvals{$prop} = $userreg{$user}->{$prop};
|
|
1216
|
$userreg{$user}->{$prop} = decode('utf8', $obj->{$prop});
|
|
1217
|
}
|
|
1218
|
}
|
|
1219
|
|
|
1220
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
1221
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Unable to access user register"};
|
|
1222
|
my $alertmatch;
|
|
1223
|
foreach my $sysvalref (values %register) {
|
|
1224
|
if ($user eq $sysvalref->{'user'}) {
|
|
1225
|
my $sysuuid = $sysvalref->{'uuid'};
|
|
1226
|
foreach my $prop (@props) {
|
|
1227
|
my $val = $obj->{$prop};
|
|
1228
|
if ($val) {
|
|
1229
|
$val = '' if ($val eq '--');
|
|
1230
|
# Does this system have the same value as the old user value or, equivalently, is it empty?
|
|
1231
|
if (!$sysvalref->{$prop} || $sysvalref->{$prop} eq $oldvals{$prop}) {
|
|
1232
|
# $postreply .= "Resetting system prop $prop to $val\n";
|
|
1233
|
$sysvalref->{$prop} = ''; # An empty val refers to parent (user) val
|
|
1234
|
# Update children
|
|
1235
|
foreach my $domvalref (values %domreg) {
|
|
1236
|
if ($domvalref->{'user'} eq $user && ($domvalref->{'system'} eq $sysuuid || $domvalref->{'system'} eq '--' || !$domvalref->{'system'})) {
|
|
1237
|
if (!$domvalref->{$prop} || $domvalref->{$prop} eq $oldvals{$prop}) {
|
|
1238
|
$domvalref->{$prop} = '';
|
|
1239
|
if ($prop eq 'alertemail') {
|
|
1240
|
if (change_monitor_email($domvalref->{'uuid'}, $val, $oldvals{$prop})) {
|
|
1241
|
$alertmatch = 1;
|
|
1242
|
}
|
|
1243
|
}
|
|
1244
|
}
|
|
1245
|
}
|
|
1246
|
}
|
|
1247
|
}
|
|
1248
|
}
|
|
1249
|
}
|
|
1250
|
}
|
|
1251
|
}
|
|
1252
|
#`/usr/bin/moncmd reset keepstate` if ($alertmatch);
|
|
1253
|
tied(%domreg)->commit;
|
|
1254
|
tied(%userreg)->commit;
|
|
1255
|
untie %domreg;
|
|
1256
|
untie %userreg;
|
|
1257
|
$postreply .= "Status=OK Account updated\n";
|
|
1258
|
# Send changes to origo.io
|
|
1259
|
$Stabile::Users::console = 1;
|
|
1260
|
require "$Stabile::basedir/cgi/users.cgi";
|
|
1261
|
$postreply .= Stabile::Users::sendEngineUser($user) if ($enginelinked);
|
|
1262
|
$main::updateUI->({tab=>'home', user=>$user, type=>'update', message=>"Account updated"});
|
|
1263
|
return $postreply;
|
|
1264
|
}
|
|
1265
|
|
|
1266
|
sub do_listuptime {
|
|
1267
|
my ($uuid, $action, $obj) = @_;
|
|
1268
|
if ($help) {
|
|
1269
|
return <<END
|
|
1270
|
GET:yearmonth,uuid,format:
|
|
1271
|
List uptime for defined monitors. If uuid is supplied, only uptime for matching server or servers belonging to matching
|
|
1272
|
system is shown. Format is either html or json.
|
|
1273
|
END
|
|
1274
|
}
|
|
1275
|
my $format = $obj->{'format'};
|
|
1276
|
my $yearmonth = $obj->{'yearmonth'} || "$year-$month";
|
|
1277
|
my $pathid = $yearmonth . ':';
|
|
1278
|
my $name;
|
|
1279
|
|
|
1280
|
my %sysdoms;
|
|
1281
|
if ($uuid && $register{$uuid}) {
|
|
1282
|
$name = $register{$uuid}->{'name'};
|
|
1283
|
foreach my $valref (values %domreg) {
|
|
1284
|
$sysdoms{$valref->{'uuid'}} = $uuid if ($valref->{system} eq $uuid);
|
|
1285
|
}
|
|
1286
|
} else {
|
|
1287
|
$pathid .= $uuid;
|
|
1288
|
$name = $domreg{$uuid}->{'name'} if ($domreg{$uuid});
|
|
1289
|
}
|
|
1290
|
my %uptimes;
|
|
1291
|
my $jtext = {};
|
|
1292
|
my @csvrows;
|
|
1293
|
|
|
1294
|
unless ($pathid =~ /\// || $pathid =~ /\./) { # Security check
|
|
1295
|
my $path = "/var/log/stabile/$pathid*"; # trailing / is required. No $pathid lists all files in log dir.
|
|
1296
|
my $utext = '';
|
|
1297
|
my %numfiles;
|
|
1298
|
my %sumupp;
|
|
1299
|
## loop through the files contained in the directory
|
|
1300
|
for my $eachFile (bsd_glob($path.'*')) {
|
|
1301
|
if (!(-d $eachFile) && $eachFile =~ /\/var\/log\/stabile\/(.+):(.+):(.+)/) {
|
|
1302
|
my $ymonth = $1;
|
|
1303
|
my $domuuid = $2;
|
|
1304
|
my $service = $3;
|
|
1305
|
next unless ($domreg{$domuuid});
|
|
1306
|
my $servername = $domreg{$domuuid}->{'name'};
|
|
1307
|
if ($domreg{$domuuid}->{'user'} eq $user) {
|
|
1308
|
next if (%sysdoms && !$sysdoms{$domuuid}); # If we are listing a system, match system uuid
|
|
1309
|
open(FILE, $eachFile) or {print("Unable to access $eachFile")};
|
|
1310
|
@lines = <FILE>;
|
|
1311
|
close(FILE);
|
|
1312
|
my $starttime;
|
|
1313
|
my $lastup;
|
|
1314
|
my $firststamp; # First timestamp of measuring period
|
|
1315
|
my $laststamp; # Last timestamp of measuring period
|
|
1316
|
my $curstate = 'UNKNOWN';
|
|
1317
|
my $dstate = 'UNKNOWN';
|
|
1318
|
my ($y, $m) = split('-', $ymonth);
|
|
1319
|
my $timespan = 0;
|
|
1320
|
my $dtime = 0; # Time disabled
|
|
1321
|
my $lastdtime = 0;
|
|
1322
|
my $uptime = 0;
|
|
1323
|
foreach my $line (@lines) {
|
|
1324
|
my ($timestamp, $event, $summary, $ptime) = split(/, */,$line);
|
|
1325
|
if (!$starttime) { # First line
|
|
1326
|
$starttime = $timestamp;
|
|
1327
|
# Find 00:00 of first day of month - http://www.perlmonks.org/?node_id=97120
|
|
1328
|
$firststamp = POSIX::mktime(0,0,0,1,$m-1,$year-1900,0,0,-1);
|
|
1329
|
# Round to month start if within 15 min
|
|
1330
|
$starttime = $firststamp if ($starttime-$firststamp<15*60);
|
|
1331
|
$lastup = $starttime if ($event eq 'STARTUP' || $event eq 'UP');
|
|
1332
|
$curstate = 'UP'; # Assume up - down alerts are always triggered
|
|
1333
|
}
|
|
1334
|
if ($event eq 'UP') {
|
|
1335
|
if ($curstate eq 'UP') {
|
|
1336
|
$uptime += ($timestamp - $lastup) if ($lastup);
|
|
1337
|
}
|
|
1338
|
$lastup = $timestamp;
|
|
1339
|
$curstate = 'UP';
|
|
1340
|
} elsif ($event eq 'DOWN') {
|
|
1341
|
if ($curstate eq 'UP' && $lastup!=$starttime) { # If down is immediately after startup - dont count uptime
|
|
1342
|
$uptime += ($timestamp - $lastup) if ($lastup);
|
|
1343
|
$lastup = $timestamp;
|
|
1344
|
}
|
|
1345
|
$curstate = 'DOWN';
|
|
1346
|
} elsif ($event eq 'STARTUP') {
|
|
1347
|
} elsif ($event eq 'DISABLE' && $curstate ne 'UNKNOWN') {
|
|
1348
|
if ($curstate eq 'UP') {
|
|
1349
|
$uptime += ($timestamp - $lastup) if ($lastup);
|
|
1350
|
$lastup = $timestamp;
|
|
1351
|
}
|
|
1352
|
$lastdtime = $timestamp;
|
|
1353
|
$dstate = $curstate;
|
|
1354
|
$curstate = 'UNKNOWN';
|
|
1355
|
} elsif ($event eq 'ENABLE') {
|
|
1356
|
if ($dstate eq 'UP' && $curstate eq 'UNKNOWN') {
|
|
1357
|
$lastup = $timestamp;
|
|
1358
|
}
|
|
1359
|
$curstate = 'UP';
|
|
1360
|
}
|
|
1361
|
# All non-disable events must mean monitor is enabled again
|
|
1362
|
if ($event ne 'DISABLE') {
|
|
1363
|
if ($lastdtime) {
|
|
1364
|
$dtime += ($timestamp - $lastdtime);
|
|
1365
|
$lastdtime = 0;
|
|
1366
|
}
|
|
1367
|
}
|
|
1368
|
|
|
1369
|
}
|
|
1370
|
if ($ymonth ne "$year-$month") { # If not current month, assume monitoring to end of month
|
|
1371
|
# Find 00:00 of first day of next month - http://www.perlmonks.org/?node_id=97120
|
|
1372
|
$laststamp = POSIX::mktime(0,0,0,1,$m,$year-1900,0,0,-1);
|
|
1373
|
} else {
|
|
1374
|
$laststamp = $current_time;
|
|
1375
|
}
|
|
1376
|
if ($curstate eq 'UP' && !$lastdtime && $lastup) {
|
|
1377
|
$uptime += ($laststamp - $lastup);
|
|
1378
|
}
|
|
1379
|
if ($lastdtime) {
|
|
1380
|
$dtime += ($laststamp - $lastdtime);
|
|
1381
|
}
|
|
1382
|
$timespan = $laststamp - $starttime;
|
|
1383
|
$uptimes{"$domuuid:$service"}->{'timespan'} = $timespan;
|
|
1384
|
$uptimes{"$domuuid:$service"}->{'uptime'} = $uptime;
|
|
1385
|
my $timespanh = int(0.5 + 100*$timespan/3600)/100;
|
|
1386
|
my $dtimeh = int(0.5 + 100*$dtime/3600)/100;
|
|
1387
|
my $uptimeh = int(0.5 + 100*$uptime/3600)/100;
|
|
1388
|
my $upp = int(0.5+ 10000*$uptime/($timespan-$dtime) ) / 100;
|
|
1389
|
$sumupp{$service} += $upp;
|
|
1390
|
$numfiles{$service} += 1;
|
|
1391
|
|
|
1392
|
utf8::decode($servername);
|
|
1393
|
|
|
1394
|
$utext .= qq[<div class="uptime_header">$service on $servername:</div>\n];
|
|
1395
|
my $color = ($upp<98)?'red':'green';
|
|
1396
|
$utext .= qq[<span style="color: $color;">Uptime: $uptimeh hours ($upp%)</span>\n];
|
|
1397
|
$utext .= qq{[timespan: $timespanh hours, \n};
|
|
1398
|
$utext .= qq{disabled: $dtimeh hours]\n};
|
|
1399
|
|
|
1400
|
$jtext->{$domuuid}->{'servername'} = $servername;
|
|
1401
|
$jtext->{$domuuid}->{$service}->{'uptime'} = $upp;
|
|
1402
|
$jtext->{$domuuid}->{$service}->{'uptimeh'} = $uptimeh;
|
|
1403
|
$jtext->{$domuuid}->{$service}->{'color'} = ($upp<98)?'red':'green';
|
|
1404
|
$jtext->{$domuuid}->{$service}->{'disabledtimeh'} = $dtimeh;
|
|
1405
|
$jtext->{$domuuid}->{$service}->{'timespanh'} = $timespanh;
|
|
1406
|
|
|
1407
|
push @csvrows, {serveruuid=>$domuuid, service=>$service, servername=>$servername, uptime=>$upp, uptimeh=>$uptimeh, color=>($upp<98)?'red':'green',disabledtimeh=>$dtimeh, timespanh=>$timespanh, yearmonth=>$yearmonth};
|
|
1408
|
}
|
|
1409
|
}
|
|
1410
|
}
|
|
1411
|
my @avgtxt;
|
|
1412
|
my $alertclass = "info";
|
|
1413
|
my $compcolor;
|
|
1414
|
$jtext->{'averages'} = {};
|
|
1415
|
$jtext->{'year-month'} = $yearmonth;
|
|
1416
|
foreach $svc (keys %sumupp) {
|
|
1417
|
my $avgupp = int(0.5 + 100*$sumupp{$svc}/$numfiles{$svc})/100;
|
|
1418
|
my $color = ($avgupp<98)?'red':'green';
|
|
1419
|
push @avgtxt, qq[<span style="color: $color;" class="uptime_header">$svc: $avgupp%</span>\n];
|
|
1420
|
$jtext->{'averages'}->{$svc}->{'uptime'} = $avgupp;
|
|
1421
|
$jtext->{'averages'}->{$svc}->{'color'} = $color;
|
|
1422
|
$compcolor = ($compcolor)? ( ($compcolor eq $color)? $color : 'info' ) : $color;
|
|
1423
|
}
|
|
1424
|
$alertclass = "warning" if ($compcolor eq 'red');
|
|
1425
|
$alertclass = "success" if ($compcolor eq 'green');
|
|
1426
|
$postreply = header();
|
|
1427
|
if ($name) {
|
|
1428
|
$postreply .= qq[<div class="alert alert-$alertclass uptime_alert"><h4 class="uptime_header">Average uptime for $name:</h4>\n<div style="margin-top:10px;">\n];
|
|
1429
|
} else {
|
|
1430
|
$postreply .= qq[<div class="alert alert-$alertclass uptime_alert"><h4 class="uptime_header">Average uptime report</h4>\n<div style="margin-top:10px;">\n];
|
|
1431
|
}
|
|
1432
|
$postreply .= join(", ", @avgtxt);
|
|
1433
|
my $uuidlink = "&uuid=$uuid" if ($uuid);
|
|
1434
|
$postreply .= qq[</div></div><hr class="uptime_line"><h5 class="uptime_header">Uptime details: (<span><a href="/stabile/systems?action=listuptime&format=csv$uuidlink&yearmonth=$yearmonth" target="blank" title="Download as CSV">csv</a></span>)</h5>\n];
|
|
1435
|
$postreply .= "<span class=\"uptime_text\">$utext</span>";
|
|
1436
|
}
|
|
1437
|
if ($params{'format'} eq 'csv') {
|
|
1438
|
$postreply = header("text/plain");
|
|
1439
|
csv(in => \@csvrows, out => \my $csvdata, key => "servername");
|
|
1440
|
$postreply .= $csvdata;
|
|
1441
|
} elsif ($format ne 'html') {
|
|
1442
|
$postreply = to_json($jtext, {pretty=>1});
|
|
1443
|
}
|
|
1444
|
return $postreply;
|
|
1445
|
}
|
|
1446
|
|
|
1447
|
sub do_appstore {
|
|
1448
|
my ($uuid, $action, $obj) = @_;
|
|
1449
|
if ($help) {
|
|
1450
|
return <<END
|
|
1451
|
GET:appid,callback:
|
|
1452
|
Look up app info for app with given appid in appstore on origo.io. Data is returned as padded JSON (JSONP).
|
|
1453
|
Optionally provide name of your JSONP callback function, which should parse the returned script data.
|
|
1454
|
END
|
|
1455
|
}
|
|
1456
|
my $appid = $params{'appid'};
|
|
1457
|
my $callback = $params{'callback'};
|
|
1458
|
if ($appid) {
|
|
1459
|
$postreply = header("application/javascript");
|
|
1460
|
$postreply .= $main::postToOrigo->($engineid, 'engineappstore', $appid, 'appid', $callback);
|
|
1461
|
} else {
|
|
1462
|
$postreply = qq|Status=Error Please provide appid|;
|
|
1463
|
}
|
|
1464
|
return $postreply;
|
|
1465
|
}
|
|
1466
|
|
|
1467
|
sub do_resetmonitoring {
|
|
1468
|
my ($uuid, $action, $obj) = @_;
|
|
1469
|
if ($help) {
|
|
1470
|
return <<END
|
|
1471
|
GET::
|
|
1472
|
Reset mon daemon while keeping states.
|
|
1473
|
END
|
|
1474
|
}
|
|
1475
|
saveOpstatus();
|
|
1476
|
$postreply = "Status=OK " . `/usr/bin/moncmd reset keepstate`;
|
|
1477
|
return $postreply;
|
|
1478
|
}
|
|
1479
|
|
|
1480
|
sub do_installsystem {
|
|
1481
|
my ($uuid, $action, $obj) = @_;
|
|
1482
|
if ($help) {
|
|
1483
|
return <<END
|
|
1484
|
GET:installsystem,installaccount:
|
|
1485
|
Helper function to initiate the installation of a new stack with system ID [installsystem] to account [installaccount] by redirecting with appropriate cookies set.
|
|
1486
|
END
|
|
1487
|
}
|
|
1488
|
my $installsystem = $obj->{'installsystem'};
|
|
1489
|
my $installaccount = $obj->{'installaccount'};
|
|
1490
|
my $systemcookie;
|
|
1491
|
my $ia_cookie;
|
|
1492
|
my $sa_cookie;
|
|
1493
|
|
|
1494
|
push(@INC, "$Stabile::basedir/auth");
|
|
1495
|
require Apache::AuthTkt;# 0.03;
|
|
1496
|
require AuthTktConfig;
|
|
1497
|
my $at = Apache::AuthTkt->new(conf => $ENV{MOD_AUTH_TKT_CONF});
|
|
1498
|
my ($server_name, $server_port) = split /:/, $ENV{HTTP_HOST} if $ENV{HTTP_HOST};
|
|
1499
|
$server_name ||= $ENV{SERVER_NAME} if $ENV{SERVER_NAME};
|
|
1500
|
$server_port ||= $ENV{SERVER_PORT} if $ENV{SERVER_PORT};
|
|
1501
|
my $AUTH_DOMAIN = $at->domain || $server_name;
|
|
1502
|
my @auth_domain = $AUTH_DOMAIN ? ( -domain => $AUTH_DOMAIN ) : ();
|
|
1503
|
|
|
1504
|
if ($installsystem) {
|
|
1505
|
$systemcookie = CGI::Cookie->new(
|
|
1506
|
-name => 'installsystem',
|
|
1507
|
-value => "$installsystem",
|
|
1508
|
-path => '/',
|
|
1509
|
@auth_domain
|
|
1510
|
);
|
|
1511
|
};
|
|
1512
|
if ($installaccount) {
|
|
1513
|
$ia_cookie = CGI::Cookie->new(
|
|
1514
|
-name => 'installaccount',
|
|
1515
|
-value => "$installaccount",
|
|
1516
|
-path => '/',
|
|
1517
|
@auth_domain
|
|
1518
|
);
|
|
1519
|
$sa_cookie = CGI::Cookie->new(
|
|
1520
|
-name => 'steamaccount',
|
|
1521
|
-value => "$installaccount",
|
|
1522
|
-path => '/',
|
|
1523
|
@auth_domain
|
|
1524
|
);
|
|
1525
|
};
|
|
1526
|
|
|
1527
|
$tktcookie = CGI::Cookie->new(
|
|
1528
|
-name => 'tktuser',
|
|
1529
|
-value => "$tktuser",
|
|
1530
|
-path => '/',
|
|
1531
|
@auth_domain
|
|
1532
|
);
|
|
1533
|
|
|
1534
|
$postreply = redirect(
|
|
1535
|
-uri => '/stabile/mainvalve/',
|
|
1536
|
-cookie => [$tktcookie, $systemcookie, $ia_cookie, $sa_cookie]
|
|
1537
|
);
|
|
1538
|
return $postreply;
|
|
1539
|
}
|
|
1540
|
|
|
1541
|
sub Changemonitoremail {
|
|
1542
|
my ($uuid, $action, $obj) = @_;
|
|
1543
|
if ($help) {
|
|
1544
|
return <<END
|
|
1545
|
GET:uuid,email:
|
|
1546
|
Change the email for all monitors belonging to server with given uuid. May be called with command line switches -u server uuid, -m old email, -k new email.
|
|
1547
|
END
|
|
1548
|
}
|
|
1549
|
if ($isreadonly) {
|
|
1550
|
$postreply = "Status=Error Not permitted\n";
|
|
1551
|
} else {
|
|
1552
|
my $serveruuid = $options{u} || $uuid;
|
|
1553
|
my $email = $options{k} || $obj->{'email'};
|
|
1554
|
if (change_monitor_email($serveruuid, $email)) {
|
|
1555
|
$postreply = "Status=OK " . `/usr/bin/moncmd reset keepstate`;
|
|
1556
|
} else {
|
|
1557
|
$postreply = "Status=Error There was a problem changing monitor email for $serveruuid\n";
|
|
1558
|
}
|
|
1559
|
}
|
|
1560
|
return $postreply;
|
|
1561
|
}
|
|
1562
|
|
|
1563
|
sub do_getmetrics {
|
|
1564
|
my ($suuid, $action, $obj) = @_;
|
|
1565
|
if ($help) {
|
|
1566
|
return <<END
|
|
1567
|
GET:uuid,metric,from,until,last,format:
|
|
1568
|
Get performance and load metrics in JSON format from Graphite backend. [metric] is one of: cpuload, diskreads, diskwrites, networkactivityrx, networkactivitytx
|
|
1569
|
From and until are Unix timestamps. Alternatively specify "last" number of seconds you want metrics for. Format is "json" (default) or "csv".
|
|
1570
|
END
|
|
1571
|
}
|
|
1572
|
my $metric = $params{metric} || "cpuLoad";
|
|
1573
|
my $now = time();
|
|
1574
|
my $from = $params{"from"} || ($now-$params{"last"}) || ($now-300);
|
|
1575
|
my $until = $params{"until"} || $now;
|
|
1576
|
|
|
1577
|
my @uuids;
|
|
1578
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
1579
|
|
|
1580
|
if ($domreg{$suuid}) { # We are dealing with a server
|
|
1581
|
push @uuids, $suuid;
|
|
1582
|
} else { # We are dealing with a system
|
|
1583
|
foreach my $valref (values %domreg) {
|
|
1584
|
my $sysuuid = $valref->{'system'};
|
|
1585
|
push @uuids, $valref->{'uuid'} if ($sysuuid eq $suuid)
|
|
1586
|
}
|
|
1587
|
}
|
|
1588
|
untie %domreg;
|
|
1589
|
|
|
1590
|
my @datapoints;
|
|
1591
|
my @targets;
|
|
1592
|
my $all;
|
|
1593
|
my $jobj = [];
|
|
1594
|
foreach my $uuid (@uuids) {
|
|
1595
|
next unless (-e "/var/lib/graphite/whisper/domains/$uuid");
|
|
1596
|
my $url = "https://127.0.0.1/graphite/graphite.wsgi/render?format=json&from=$from&until=$until&target=domains.$uuid.$metric";
|
|
1597
|
my $jstats = `curl -k "$url"`;
|
|
1598
|
$jobj = from_json($jstats);
|
|
1599
|
push @targets, $jobj->[0]->{target};
|
|
1600
|
if ($jobj->[0]->{target}) {
|
|
1601
|
if (@datapoints) {
|
|
1602
|
my $j=0;
|
|
1603
|
foreach my $p ( @{$jobj->[0]->{datapoints}} ) {
|
|
1604
|
# print "adding: ", $datapoints[$j]->[0], " + ", $p->[0];
|
|
1605
|
$datapoints[$j]->[0] += $p->[0];
|
|
1606
|
# print " = ", $datapoints[$j]->[0], " to ",$datapoints[$j]->[1], "\n";
|
|
1607
|
$j++;
|
|
1608
|
}
|
|
1609
|
} else {
|
|
1610
|
@datapoints = @{$jobj->[0]->{datapoints}};
|
|
1611
|
}
|
|
1612
|
}
|
|
1613
|
}
|
|
1614
|
pop @datapoints; # We discard the last datapoint because of possible clock drift
|
|
1615
|
$all = [{targets=>\@targets, datapoints=>\@datapoints, period=>{from=>$from, until=>$until, span=>$until-$from}}];
|
|
1616
|
if ($params{'format'} eq 'csv') {
|
|
1617
|
$postreply = header("text/plain");
|
|
1618
|
csv(in => \@datapoints, out => \my $csvdata);
|
|
1619
|
$postreply .= $csvdata;
|
|
1620
|
} else {
|
|
1621
|
$postreply = to_json($all);
|
|
1622
|
}
|
|
1623
|
return $postreply;
|
|
1624
|
}
|
|
1625
|
|
|
1626
|
sub do_metrics {
|
|
1627
|
my ($suuid, $action, $obj) = @_;
|
|
1628
|
if ($help) {
|
|
1629
|
return <<END
|
|
1630
|
GET:uuid,metric,from,to:
|
|
1631
|
Get performance and load metrics in JSON format from RRD backend. [metric] is one of: cpuload, diskreads, diskwrites, networkactivityrx, networkactivitytx
|
|
1632
|
From and to are Unix timestamps.
|
|
1633
|
END
|
|
1634
|
}
|
|
1635
|
|
|
1636
|
my $from = $params{"from"};
|
|
1637
|
my $to = $params{"to"};
|
|
1638
|
my $dif = $to - $from;
|
|
1639
|
my $now = time();
|
|
1640
|
|
|
1641
|
my @items;
|
|
1642
|
my %cpuLoad = ();
|
|
1643
|
my %networkActivityRX = ();
|
|
1644
|
my %networkActivityTX = ();
|
|
1645
|
my %diskReads = ();
|
|
1646
|
my %diskWrites = ();
|
|
1647
|
|
|
1648
|
my $i = 0;
|
|
1649
|
my @uuids;
|
|
1650
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
1651
|
|
|
1652
|
if ($domreg{$suuid}) { # We are dealing with a server
|
|
1653
|
push @uuids, $suuid;
|
|
1654
|
} else { # We are dealing with a system
|
|
1655
|
foreach my $valref (values %domreg) {
|
|
1656
|
my $sysuuid = $valref->{'system'};
|
|
1657
|
push @uuids, $valref->{'uuid'} if ($sysuuid eq $suuid)
|
|
1658
|
}
|
|
1659
|
}
|
|
1660
|
untie %domreg;
|
|
1661
|
|
|
1662
|
foreach my $uuid (@uuids) {
|
|
1663
|
next unless hasRRD($uuid);
|
|
1664
|
$i++;
|
|
1665
|
# Fetch data from RRD buckets...
|
|
1666
|
my $rrd = RRDTool::OO->new(file =>"/var/cache/rrdtool/".$uuid."_highres.rrd");
|
|
1667
|
my $last = $rrd->last();
|
|
1668
|
$rrd->fetch_start(start => $now-$dif, end=> $now);
|
|
1669
|
while(my($timestamp, @value) = $rrd->fetch_next()) {
|
|
1670
|
last if ($timestamp >= $last && $now-$last<20);
|
|
1671
|
my $domain_cpuTime = shift(@value);
|
|
1672
|
my $blk_hda_rdBytes = shift(@value);
|
|
1673
|
my $blk_hda_wrBytes = shift(@value);
|
|
1674
|
my $if_vnet0_rxBytes = shift(@value);
|
|
1675
|
my $if_vnet0_txBytes = shift(@value);
|
|
1676
|
|
|
1677
|
# domain_cpuTime is avg. nanosecs spent pr. 1s
|
|
1678
|
# convert to value [0;1]
|
|
1679
|
$domain_cpuTime = $domain_cpuTime / 10**9 if ($domain_cpuTime);
|
|
1680
|
$cpuLoad{$timestamp} += $domain_cpuTime;
|
|
1681
|
|
|
1682
|
$blk_hda_rdBytes = $blk_hda_rdBytes if ($blk_hda_rdBytes);
|
|
1683
|
$diskReads{$timestamp} += $blk_hda_rdBytes;
|
|
1684
|
|
|
1685
|
$blk_hda_wrBytes = $blk_hda_wrBytes if ($blk_hda_wrBytes);
|
|
1686
|
$diskWrites{$timestamp} += $blk_hda_wrBytes;
|
|
1687
|
|
|
1688
|
$networkActivityRX{$timestamp} += $if_vnet0_rxBytes;
|
|
1689
|
$networkActivityTX{$timestamp} += $if_vnet0_txBytes;
|
|
1690
|
}
|
|
1691
|
}
|
|
1692
|
my @t = ( $now-$dif, $now);
|
|
1693
|
my @a = (undef, undef);
|
|
1694
|
$i = $i || 1;
|
|
1695
|
|
|
1696
|
my $item = ();
|
|
1697
|
$item->{"uuid"} = $suuid if ($suuid);
|
|
1698
|
my @tstamps = sort keys %cpuLoad;
|
|
1699
|
$item->{"timestamps"} = \@tstamps || \@t;
|
|
1700
|
|
|
1701
|
if ($params{"metric"} eq "cpuload" || $params{'cpuload'}) {
|
|
1702
|
my @vals;
|
|
1703
|
my $load = int(100*$cpuLoad{$_})/100;
|
|
1704
|
$load = $i if ($cpuLoad{$_} > $i);
|
|
1705
|
foreach(@tstamps) {push @vals, $load};
|
|
1706
|
$item->{"cpuload"} = \@vals || \@a;
|
|
1707
|
}
|
|
1708
|
elsif ($params{"metric"} eq "diskreads" || $params{'diskReads'}) {
|
|
1709
|
my @vals;
|
|
1710
|
foreach(@tstamps) {push @vals, int(100*$diskReads{$_})/100;};
|
|
1711
|
$item->{"diskReads"} = \@vals || \@a;
|
|
1712
|
}
|
|
1713
|
elsif ($params{"metric"} eq "diskwrites" || $params{'diskWrites'}) {
|
|
1714
|
my @vals;
|
|
1715
|
foreach(@tstamps) {push @vals, int(100*$diskWrites{$_})/100;};
|
|
1716
|
$item->{"diskWrites"} = \@vals || \@a;
|
|
1717
|
}
|
|
1718
|
elsif ($params{"metric"} eq "networkactivityrx" || $params{'networkactivityrx'}) {
|
|
1719
|
my @vals;
|
|
1720
|
foreach(@tstamps) {push @vals, int(100*$networkActivityRX{$_})/100;};
|
|
1721
|
$item->{"networkactivityrx"} = \@vals || \@a;
|
|
1722
|
}
|
|
1723
|
elsif ($params{"metric"} eq "networkactivitytx" || $params{'networkactivitytx'}) {
|
|
1724
|
my @vals;
|
|
1725
|
foreach(@tstamps) {push @vals, int(100*$networkActivityTX{$_})/100;};
|
|
1726
|
$item->{"networkactivitytx"} = \@vals || \@a;
|
|
1727
|
}
|
|
1728
|
push @items, $item;
|
|
1729
|
$postreply .= to_json(\@items, {pretty=>1});
|
|
1730
|
return $postreply;
|
|
1731
|
}
|
|
1732
|
|
|
1733
|
sub hasRRD {
|
|
1734
|
my($uuid) = @_;
|
|
1735
|
my $rrd_file = "/var/cache/rrdtool/".$uuid."_highres.rrd";
|
|
1736
|
|
|
1737
|
if ((not -e $rrd_file) and ($uuid)) {
|
|
1738
|
return(0);
|
|
1739
|
} else {
|
|
1740
|
return(1);
|
|
1741
|
}
|
|
1742
|
}
|
|
1743
|
|
|
1744
|
sub do_packages_remove {
|
|
1745
|
my ($uuid, $action, $obj) = @_;
|
|
1746
|
if ($help) {
|
|
1747
|
return <<END
|
|
1748
|
DELETE:uuid:
|
|
1749
|
Remove packages belonging to server or system with given uuid.
|
|
1750
|
END
|
|
1751
|
}
|
|
1752
|
my $issystem = $obj->{"issystem"} || $register{$uuid};
|
|
1753
|
unless ( tie(%packreg,'Tie::DBI', Hash::Merge::merge({table=>'packages', key=>'id'}, $Stabile::dbopts)) ) {return "Unable to access package register"};
|
|
1754
|
my @domains;
|
|
1755
|
if ($issystem) {
|
|
1756
|
foreach my $valref (values %domreg) {
|
|
1757
|
if (($valref->{'system'} eq $uuid || $uuid eq '*')
|
|
1758
|
&& ($valref->{'user'} eq $user || $fulllist)) {
|
|
1759
|
push(@domains, $valref->{'uuid'});
|
|
1760
|
}
|
|
1761
|
}
|
|
1762
|
} else { # Allow if domain no longer exists or belongs to user
|
|
1763
|
push(@domains, $uuid) if (!$domreg{$uuid} || $domreg{$uuid}->{'user'} eq $user || $fulllist);
|
|
1764
|
}
|
|
1765
|
foreach my $domuuid (@domains) {
|
|
1766
|
foreach my $packref (values %packreg) {
|
|
1767
|
my $id = $packref->{'id'};
|
|
1768
|
if (substr($id, 0,36) eq $domuuid || ($uuid eq '*' && $packref->{'user'} eq $user)) {
|
|
1769
|
delete $packreg{$id};
|
|
1770
|
}
|
|
1771
|
}
|
|
1772
|
}
|
|
1773
|
tied(%packreg)->commit;# if (%packreg);
|
|
1774
|
if ($issystem && $register{$uuid}) {
|
|
1775
|
$postreply = "Status=OK Cleared packages for $register{$uuid}->{'name'}\n";
|
|
1776
|
} elsif ($domreg{$uuid}) {
|
|
1777
|
$postreply = "Status=OK Cleared packages for $domreg{$uuid}->{'name'}\n";
|
|
1778
|
} else {
|
|
1779
|
$postreply = "Status=OK Cleared packages. System not registered\n";
|
|
1780
|
}
|
|
1781
|
return $postreply;
|
|
1782
|
}
|
|
1783
|
|
|
1784
|
sub Packages_load {
|
|
1785
|
my ($uuid, $action, $obj) = @_;
|
|
1786
|
if ($help) {
|
|
1787
|
return <<END
|
|
1788
|
POST:uuid:
|
|
1789
|
Load list of installed software packages that are installed on the image. Image must contain a valid OS.
|
|
1790
|
END
|
|
1791
|
}
|
|
1792
|
if (!$isreadonly) {
|
|
1793
|
unless ( tie(%packreg,'Tie::DBI', Hash::Merge::merge({table=>'packages', key=>'id'}, $Stabile::dbopts)) ) {return "Unable to access package register"};
|
|
1794
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
1795
|
my $curimg;
|
|
1796
|
my $apps;
|
|
1797
|
my @domains;
|
|
1798
|
my $issystem = $obj->{'issystem'};
|
|
1799
|
if ($issystem) {
|
|
1800
|
foreach my $valref (values %domreg) {
|
|
1801
|
if (($valref->{'system'} eq $uuid || $uuid eq '*')
|
|
1802
|
&& ($valref->{'user'} eq $user || $fulllist)) {
|
|
1803
|
push(@domains, $valref->{'uuid'});
|
|
1804
|
}
|
|
1805
|
}
|
|
1806
|
} else {
|
|
1807
|
push(@domains, $uuid) if ($domreg{$uuid}->{'user'} eq $user || $fulllist);
|
|
1808
|
}
|
|
1809
|
|
|
1810
|
foreach my $domuuid (@domains) {
|
|
1811
|
if ($domreg{$domuuid}) {
|
|
1812
|
$curimg = $domreg{$domuuid}->{'image'};
|
|
1813
|
$apps = getPackages($curimg);
|
|
1814
|
if ($apps) {
|
|
1815
|
my @packages;
|
|
1816
|
my @packages2;
|
|
1817
|
open my $fh, '<', \$apps or die $!;
|
|
1818
|
my $distro;
|
|
1819
|
my $hostname;
|
|
1820
|
my $i;
|
|
1821
|
while (<$fh>) {
|
|
1822
|
if (!$distro) {
|
|
1823
|
$distro = $_;
|
|
1824
|
chomp $distro;
|
|
1825
|
} elsif (!$hostname) {
|
|
1826
|
$hostname = $_;
|
|
1827
|
chomp $hostname;
|
|
1828
|
} elsif ($_ =~ /\[(\d+)\]/) {
|
|
1829
|
push @packages2, $packages[$i];
|
|
1830
|
$i = $1;
|
|
1831
|
} elsif ($_ =~ /(\S+): (.+)/ && $2) {
|
|
1832
|
$packages[$i]->{$1} = $2;
|
|
1833
|
}
|
|
1834
|
}
|
|
1835
|
close $fh or die $!;
|
|
1836
|
$domreg{$domuuid}->{'os'} = $distro;
|
|
1837
|
$domreg{$domuuid}->{'hostname'} = $hostname;
|
|
1838
|
foreach $package (@packages) {
|
|
1839
|
my $id = "$domuuid-$package->{'app_name'}";
|
|
1840
|
$packreg{$id} = $package;
|
|
1841
|
$packreg{$id}->{'app_display_name'} = $packreg{$id}->{'app_name'} unless ($packreg{$id}->{'app_display_name'});
|
|
1842
|
$packreg{$id}->{'domuuid'} = $domuuid;
|
|
1843
|
$packreg{$id}->{'user'} = $user;
|
|
1844
|
}
|
|
1845
|
$postreply .= "Status=OK Updated packages for $domreg{$domuuid}->{'name'}\n";
|
|
1846
|
} else {
|
|
1847
|
$domreg{$domuuid}->{'os'} = 'unknown';
|
|
1848
|
$domreg{$domuuid}->{'hostname'} = 'unknown';
|
|
1849
|
$postreply .= "Status=Error Could not update packages for $domreg{$domuuid}->{'name'}";
|
|
1850
|
}
|
|
1851
|
}
|
|
1852
|
}
|
|
1853
|
tied(%packreg)->commit;
|
|
1854
|
tied(%domreg)->commit;
|
|
1855
|
untie %domreg;
|
|
1856
|
untie %packreg;
|
|
1857
|
|
|
1858
|
} else {
|
|
1859
|
$postreply .= "Status=Error Not allowed\n";
|
|
1860
|
}
|
|
1861
|
return $postreply;
|
|
1862
|
}
|
|
1863
|
|
|
1864
|
sub do_packages {
|
|
1865
|
my ($uuid, $action, $obj) = @_;
|
|
1866
|
if ($help) {
|
|
1867
|
return <<END
|
|
1868
|
GET:uuid:
|
|
1869
|
Handling of packages
|
|
1870
|
END
|
|
1871
|
}
|
|
1872
|
|
|
1873
|
unless ( tie(%packreg,'Tie::DBI', Hash::Merge::merge({table=>'packages', key=>'id'}, $Stabile::dbopts)) ) {return "Unable to access package register"};
|
|
1874
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
1875
|
|
|
1876
|
# List packages
|
|
1877
|
my @packregvalues = values %packreg;
|
|
1878
|
my @curregvalues;
|
|
1879
|
my %packhash;
|
|
1880
|
my %sysdoms; # Build list of members of system
|
|
1881
|
foreach $sysdom (values %domreg) {
|
|
1882
|
if ($sysdom->{'system'} eq $curuuid) {
|
|
1883
|
$sysdoms{$sysdom->{'uuid'}} = $curuuid;
|
|
1884
|
}
|
|
1885
|
}
|
|
1886
|
foreach my $valref (@packregvalues) {
|
|
1887
|
if ($valref->{'user'} eq $user || $fulllist) {
|
|
1888
|
if ((!$curuuid || $curuuid eq '*') # List packages from all servers
|
|
1889
|
|| ($domreg{$curuuid} && $curuuid eq $valref->{'domuuid'}) # List packages from a single server
|
|
1890
|
|| ($register{$curuuid} && $sysdoms{ $valref->{'domuuid'} }) # List packages from multiple servers - a system
|
|
1891
|
) {
|
|
1892
|
# push(@curregvalues, $valref);
|
|
1893
|
my $packid = "$valref->{'app_display_name'}:$valref->{'app_version'}";
|
|
1894
|
if ($packhash{$packid}) {
|
|
1895
|
($packhash{$packid}->{'app_count'})++;
|
|
1896
|
} else {
|
|
1897
|
$packhash{$packid} = {
|
|
1898
|
app_display_name=>$valref->{'app_display_name'},
|
|
1899
|
app_name=>$valref->{'app_name'},
|
|
1900
|
app_release=>$valref->{'app_release'},
|
|
1901
|
# app_publisher=>$valref->{'app_publisher'},
|
|
1902
|
app_version=>$valref->{'app_version'},
|
|
1903
|
app_count=>1
|
|
1904
|
}
|
|
1905
|
}
|
|
1906
|
}
|
|
1907
|
}
|
|
1908
|
}
|
|
1909
|
my @sorted_packs = sort {$a->{'app_display_name'} cmp $b->{'app_display_name'}} values %packhash;
|
|
1910
|
if ($obj->{format} eq 'html') {
|
|
1911
|
my $res;
|
|
1912
|
$res .= qq[<tr><th>Name</th><th>Version</th><th>Count</th></tr>\n];
|
|
1913
|
foreach my $valref (@sorted_packs) {
|
|
1914
|
$res .= qq[<tr><td>$valref->{'app_display_name'}</td><td>$valref->{'app_version'}</td><td>$valref->{'app_count'}</td></tr>\n];
|
|
1915
|
}
|
|
1916
|
$postreply .= qq[<table cellspacing="0" frame="void" rules="rows" class="systemTables">\n$res</table>\n];
|
|
1917
|
} elsif ($obj->{'format'} eq 'csv') {
|
|
1918
|
$postreply = header("text/plain");
|
|
1919
|
csv(in => \@sorted_packs, out => \my $csvdata);
|
|
1920
|
$postreply .= $csvdata;
|
|
1921
|
} else {
|
|
1922
|
$postreply .= to_json(\@sorted_packs);
|
|
1923
|
}
|
|
1924
|
untie %domreg;
|
|
1925
|
untie %packreg;
|
|
1926
|
return $postreply;
|
|
1927
|
}
|
|
1928
|
|
|
1929
|
sub Buildsystem {
|
|
1930
|
my ($uuid, $action, $obj) = @_;
|
|
1931
|
if ($help) {
|
|
1932
|
return <<END
|
|
1933
|
GET:name, master, storagepool, system, instances, networkuuid, bschedule, networktype1, ports, memory, vcpu, diskbus, cdrom, boot, loader, nicmodel1, nicmac1, networkuuid2, nicmac2, storagepool2, monitors, managementlink, start:
|
|
1934
|
Build a complete system from cloned master image.
|
|
1935
|
master is the only required parameter. Set [storagepool2] to -1 if you want data images to be put on node storage.
|
|
1936
|
END
|
|
1937
|
}
|
|
1938
|
$curuuid = $uuid unless ($curuuid);
|
|
1939
|
$postreply = buildSystem(
|
|
1940
|
$obj->{name},
|
|
1941
|
$obj->{master},
|
|
1942
|
$obj->{storagepool},
|
|
1943
|
$obj->{system},
|
|
1944
|
$obj->{instances},
|
|
1945
|
$obj->{networkuuid1},
|
|
1946
|
$obj->{bschedule},
|
|
1947
|
$obj->{networktype1},
|
|
1948
|
$obj->{ports},
|
|
1949
|
$obj->{memory},
|
|
1950
|
$obj->{vcpu},
|
|
1951
|
$obj->{diskbus},
|
|
1952
|
$obj->{cdrom},
|
|
1953
|
$obj->{boot},
|
|
1954
|
$obj->{nicmodel1},
|
|
1955
|
$obj->{nicmac1},
|
|
1956
|
$obj->{networkuuid2},
|
|
1957
|
$obj->{nicmac2},
|
|
1958
|
$obj->{monitors},
|
|
1959
|
$obj->{managementlink},
|
|
1960
|
$obj->{start},
|
|
1961
|
$obj->{domuuid},
|
|
1962
|
$obj->{storagepool2},
|
|
1963
|
$obj->{loader}
|
|
1964
|
);
|
|
1965
|
|
|
1966
|
return $postreply;
|
|
1967
|
}
|
|
1968
|
|
|
1969
|
sub Upgradesystem {
|
|
1970
|
my ($uuid, $action, $obj) = @_;
|
|
1971
|
if ($help) {
|
|
1972
|
return <<END
|
|
1973
|
GET:uuid,internalip:
|
|
1974
|
Upgrades a system
|
|
1975
|
END
|
|
1976
|
}
|
|
1977
|
my $internalip = $params{'internalip'};
|
|
1978
|
$postreply = upgradeSystem($internalip);
|
|
1979
|
return $postreply;
|
|
1980
|
}
|
|
1981
|
|
|
1982
|
sub Removeusersystems {
|
|
1983
|
my ($uuid, $action, $obj) = @_;
|
|
1984
|
if ($help) {
|
|
1985
|
return <<END
|
|
1986
|
GET:username:
|
|
1987
|
Removes all systems belonging to a user, i.e. completely deletes all servers, images and networks belonging to an account.
|
|
1988
|
Use with extreme care.
|
|
1989
|
END
|
|
1990
|
}
|
|
1991
|
my $username = $obj->{username};
|
|
1992
|
$username = $username || $user;
|
|
1993
|
$postreply = removeusersystems($username); # method performs security check
|
|
1994
|
return $postreply;
|
|
1995
|
}
|
|
1996
|
|
|
1997
|
sub Removesystem {
|
|
1998
|
my ($uuid, $action, $obj) = @_;
|
|
1999
|
if ($help) {
|
|
2000
|
return <<END
|
|
2001
|
GET:uuid:
|
|
2002
|
Removes specified system, i.e. completely deletes all servers, images, networks and backups belonging to a system.
|
|
2003
|
Use with care.
|
|
2004
|
END
|
|
2005
|
}
|
|
2006
|
my $duuid = $obj->{uuid} || $uuid;
|
|
2007
|
$postreply = remove($duuid, 0, 1);
|
|
2008
|
return $postreply;
|
|
2009
|
}
|
|
2010
|
|
|
2011
|
1;
|
|
2012
|
|
|
2013
|
# Print list of available actions on objects
|
|
2014
|
sub do_plainhelp {
|
|
2015
|
my $res;
|
|
2016
|
$res .= header('text/plain') unless $console;
|
|
2017
|
$res .= <<END
|
|
2018
|
new [name="name"]
|
|
2019
|
start
|
|
2020
|
suspend
|
|
2021
|
resume
|
|
2022
|
shutdown
|
|
2023
|
destroy
|
|
2024
|
buildsystem [master, storagepool, system (uuid), instances, networkuuid1,bschedule,
|
|
2025
|
networktype1, ports, memory, vcpu, diskbus, cdrom, boot, nicmodel1, nicmac1, networkuuid2,
|
|
2026
|
nicmac2, monitors, start]
|
|
2027
|
removesystem
|
|
2028
|
updateaccountinfo
|
|
2029
|
resettoaccountinfo
|
|
2030
|
|
|
2031
|
END
|
|
2032
|
;
|
|
2033
|
}
|
|
2034
|
|
|
2035
|
# Save current mon status to /etc/stabile/opstatus, in order to preserve state when reloading mon
|
|
2036
|
sub saveOpstatus {
|
|
2037
|
my $deleteid = shift;
|
|
2038
|
my %opstatus = getSavedOpstatus();
|
|
2039
|
my @monarray = split("\n", `/usr/bin/moncmd list opstatus`);
|
|
2040
|
my $opfile = "/etc/stabile/opstatus";
|
|
2041
|
open(FILE, ">$opfile") or {throw Error::Simple("Unable to write $opfile")};
|
|
2042
|
foreach my $line (@monarray) {
|
|
2043
|
my @pairs = split(/ /,$line);
|
|
2044
|
my %h;
|
|
2045
|
my $ALERT;
|
|
2046
|
foreach my $pair (@pairs) {
|
|
2047
|
my ($key, $val) = split(/=/,$pair);
|
|
2048
|
$obj->{$key} = $val;
|
|
2049
|
}
|
|
2050
|
my $ops = $opstatus{"$group:$service"};
|
|
2051
|
my $group = $obj->{'group'};
|
|
2052
|
my $service = $obj->{'service'};
|
|
2053
|
my $curstatus = $ops->{'opstatus'};
|
|
2054
|
my $curack = $ops->{'ack'};
|
|
2055
|
my $curackcomment = $ops->{'ackcomment'};
|
|
2056
|
my $curline = $ops->{'line'};
|
|
2057
|
if ($deleteid && $deleteid eq "$group:$service") {
|
|
2058
|
; # Don't write line for service we are deleting
|
|
2059
|
} elsif (($obj->{'opstatus'} eq '0' || $obj->{'opstatus'} eq '7') && $curack && $curstatus eq '0') {
|
|
2060
|
# A failure has been acknowledged and service is still down
|
|
2061
|
print FILE "$curline\n";
|
|
2062
|
$ALERT = ($obj->{'opstatus'}?'UP':'DOWN');
|
|
2063
|
} elsif (($obj->{'opstatus'} || $obj->{'opstatus'} eq '0') && $obj->{'opstatus'} ne '7') {
|
|
2064
|
print FILE "$line\n";
|
|
2065
|
$ALERT = ($obj->{'opstatus'}?'UP':'DOWN');
|
|
2066
|
} elsif (($curstatus || $curstatus eq '0') && $curstatus ne '7') {
|
|
2067
|
print FILE "$curline\n";
|
|
2068
|
$ALERT = ($obj->{'opstatus'}?'UP':'DOWN');
|
|
2069
|
} else {
|
|
2070
|
# Don't write anything if neither is different from 7
|
|
2071
|
}
|
|
2072
|
# Create empty log file if it does not exist
|
|
2073
|
my $oplogfile = "/var/log/stabile/$year-$month:$group:$service";
|
|
2074
|
unless (-s $oplogfile) {
|
|
2075
|
if ($group && $service && $ALERT) {
|
|
2076
|
`/usr/bin/touch "$oplogfile"`;
|
|
2077
|
`/bin/chown mon:mon "$oplogfile"`;
|
|
2078
|
my $logline = "$current_time, $ALERT, MARK, $pretty_time";
|
|
2079
|
`/bin/echo >> $oplogfile "$logline"`;
|
|
2080
|
}
|
|
2081
|
}
|
|
2082
|
}
|
|
2083
|
close (FILE);
|
|
2084
|
#if ((!-e $opfile) || ($current_time - (stat($opfile))[9] > 120) ) {
|
|
2085
|
# `/usr/bin/moncmd list opstatus > $opfile`;
|
|
2086
|
#}
|
|
2087
|
}
|
|
2088
|
|
|
2089
|
sub getSavedOpstatus {
|
|
2090
|
my $dounbackslash = shift;
|
|
2091
|
my $opfile = "/etc/stabile/opstatus";
|
|
2092
|
my @oparray;
|
|
2093
|
my %opstatus;
|
|
2094
|
# Build hash (%opstatus) with opstatus'es etc. to use for services that are in state unknown because of mon reload
|
|
2095
|
if (-e $opfile) {
|
|
2096
|
open(FILE, $opfile) or {throw Error::Simple("Unable to read $opfile")};
|
|
2097
|
@oparray = <FILE>;
|
|
2098
|
close(FILE);
|
|
2099
|
foreach my $line (@oparray) {
|
|
2100
|
my @pairs = split(/ /,$line);
|
|
2101
|
my %h;
|
|
2102
|
foreach my $pair (@pairs) {
|
|
2103
|
my ($key, $val) = split(/=/,$pair);
|
|
2104
|
if ($key eq 'last_result' || !$dounbackslash) {
|
|
2105
|
$obj->{$key} = $val;
|
|
2106
|
} else {
|
|
2107
|
$val =~ s/\\/\\x/g;
|
|
2108
|
$obj->{$key} = unbackslash($val);
|
|
2109
|
}
|
|
2110
|
}
|
|
2111
|
$obj->{'line'} = $line;
|
|
2112
|
$opstatus{"$obj->{'group'}:$obj->{'service'}"} = \%h;
|
|
2113
|
}
|
|
2114
|
}
|
|
2115
|
return %opstatus;
|
|
2116
|
}
|
|
2117
|
|
|
2118
|
sub getOpstatus {
|
|
2119
|
my ($selgroup, $selservice, $usemoncmd) = @_;
|
|
2120
|
my %opcodes = ("", "checking", "0", "down", "1", "ok", "3", "3", "4", "4", "5", "5", "6", "6", "7", "checking", "9", "disabled");
|
|
2121
|
my %s;
|
|
2122
|
my %opstatus;
|
|
2123
|
my %savedopstatus = getSavedOpstatus(1);
|
|
2124
|
my %sysdoms;
|
|
2125
|
|
|
2126
|
my %disabled;
|
|
2127
|
my %desc;
|
|
2128
|
my @dislist = split(/\n/, `/usr/bin/moncmd list disabled`);
|
|
2129
|
foreach my $disline (@dislist) {
|
|
2130
|
my ($a, $b, $c, $d) = split(' ', $disline);
|
|
2131
|
$disabled{"$b" . ($d?":$d":'')} = 1;
|
|
2132
|
};
|
|
2133
|
my %emails;
|
|
2134
|
my @emaillist = split(/\n/, `/bin/cat /etc/mon/mon.cf`);
|
|
2135
|
my $emailuuid;
|
|
2136
|
foreach my $eline (@emaillist) {
|
|
2137
|
my ($a, $b, $c, $d) = split(/ +/, $eline, 4);
|
|
2138
|
if ($a eq 'watch') {
|
|
2139
|
if ($b =~ /\S+-\S+-\S+-\S+-\S+/) {$emailuuid = $b;}
|
|
2140
|
else {$emailuuid = ''};
|
|
2141
|
}
|
|
2142
|
$emails{$emailuuid} = $d if ($emailuuid && $b eq 'alert' && $c eq 'stabile.alert');
|
|
2143
|
};
|
|
2144
|
|
|
2145
|
# We are dealing with a system group rather than a domain, build hash of domains in system
|
|
2146
|
if ($selgroup && !$domreg{$selgroup} && $register{$selgroup}) {
|
|
2147
|
foreach my $valref (values %domreg) {
|
|
2148
|
$sysdoms{$valref->{'uuid'}} = $selgroup if ($valref->{system} eq $selgroup);
|
|
2149
|
}
|
|
2150
|
}
|
|
2151
|
if ($usemoncmd) {
|
|
2152
|
my @oparray = split("\n", `/usr/bin/moncmd list opstatus`);
|
|
2153
|
foreach my $line (@oparray) {
|
|
2154
|
my @pairs = split(/ /,$line);
|
|
2155
|
my %h;
|
|
2156
|
foreach my $pair (@pairs) {
|
|
2157
|
my ($key, $val) = split(/=/,$pair);
|
|
2158
|
if ($key eq 'last_result') {
|
|
2159
|
$obj->{$key} = $val;
|
|
2160
|
} else {
|
|
2161
|
$val =~ s/\\/\\x/g;
|
|
2162
|
$obj->{$key} = unbackslash($val);
|
|
2163
|
}
|
|
2164
|
}
|
|
2165
|
if (!$selgroup || $sysdoms{$obj->{'group'}}
|
|
2166
|
(!$selservice && $selgroup eq $obj->{'group'}) ||
|
|
2167
|
($selgroup eq $obj->{'group'} && $selservice eq $obj->{'service'})
|
|
2168
|
)
|
|
2169
|
{
|
|
2170
|
#$obj->{'line'} = $line;
|
|
2171
|
#$opstatus{"$obj->{'group'}:$obj->{'service'}"} = \%h;
|
|
2172
|
$s{$obj->{'group'}}->{$obj->{'service'}} = \%h if($obj->{'group'});
|
|
2173
|
}
|
|
2174
|
}
|
|
2175
|
|
|
2176
|
} else {
|
|
2177
|
my $monc;
|
|
2178
|
$monc = new Mon::Client (
|
|
2179
|
host => "127.0.0.1"
|
|
2180
|
);
|
|
2181
|
$monc->connect();
|
|
2182
|
%desc = $monc->list_descriptions; # Get descriptions
|
|
2183
|
#%disabled = $monc->list_disabled;
|
|
2184
|
$selgroup = '' if (%sysdoms);
|
|
2185
|
my @selection = [$selgroup, $selservice];
|
|
2186
|
if ($selgroup && $selservice) {%s = $monc->list_opstatus( @selection );}
|
|
2187
|
elsif ($selgroup) {%s = $monc->list_opstatus( (@selection) );}# List selection
|
|
2188
|
else {%s = $monc->list_opstatus;} # List all
|
|
2189
|
$monc->disconnect();
|
|
2190
|
}
|
|
2191
|
|
|
2192
|
foreach my $group (keys %s) {
|
|
2193
|
if ($domreg{$group} && ($domreg{$group}->{'user'} eq $user || $fulllist)) {
|
|
2194
|
foreach my $service (values %{$s{$group}}) {
|
|
2195
|
|
|
2196
|
next if (%sysdoms && !$sysdoms{$group});
|
|
2197
|
next unless ($service->{'monitor'});
|
|
2198
|
my $ostatus = $service->{'opstatus'};
|
|
2199
|
my $id = "$group:$service->{'service'}";
|
|
2200
|
if (%sysdoms) {
|
|
2201
|
$service->{'system'} = $sysdoms{$group};
|
|
2202
|
}
|
|
2203
|
if ($ostatus == 7 && $savedopstatus{$id}) { # Get status etc. from %savedopstatus because mon has recently been reloaded
|
|
2204
|
$service->{'opstatus'} = $savedopstatus{$id}->{'opstatus'};
|
|
2205
|
$service->{'last_success'} = $savedopstatus{$id}->{'last_success'};
|
|
2206
|
$service->{'last_check'} = $savedopstatus{$id}->{'last_check'};
|
|
2207
|
$service->{'last_detail'} = $savedopstatus{$id}->{'last_detail'};
|
|
2208
|
$service->{'checking'} = "1";
|
|
2209
|
}
|
|
2210
|
# if (($ostatus == 7 || $ostatus == 0) && $savedopstatus{$id}->{'ack'}) { # Get ack because mon has recently been reloaded
|
|
2211
|
if ($ostatus == 7 && $savedopstatus{$id}->{'ack'}) { # Get ack because mon has recently been reloaded
|
|
2212
|
$service->{'ack'} = $savedopstatus{$id}->{'ack'};
|
|
2213
|
$service->{'ackcomment'} = $savedopstatus{$id}->{'ackcomment'};
|
|
2214
|
$service->{'first_failure'} = $savedopstatus{$id}->{'first_failure'};
|
|
2215
|
}
|
|
2216
|
$service->{'ackcomment'} = $1 if ($service->{'ackcomment'} =~ /^: *(.*)/);
|
|
2217
|
my $status = $opcodes{$service->{'opstatus'}};
|
|
2218
|
if ($disabled{$id} || $disabled{$group}){
|
|
2219
|
$status = 'disabled';
|
|
2220
|
$service->{'opstatus'} = "9";
|
|
2221
|
}
|
|
2222
|
$service->{'status'} = $status;
|
|
2223
|
$service->{'id'} = $id;
|
|
2224
|
$service->{'name'} = "$domreg{$group}->{'name'} : $service->{'service'}";
|
|
2225
|
$service->{'servername'} = $domreg{$group}->{'name'};
|
|
2226
|
$service->{'serveruuid'} = $domreg{$group}->{'uuid'};
|
|
2227
|
$service->{'serverstatus'} = $domreg{$group}->{'status'};
|
|
2228
|
my $serverip = `cat /etc/mon/mon.cf |sed -n -e 's/^hostgroup $group //p'`;
|
|
2229
|
chomp $serverip;
|
|
2230
|
$service->{'serverip'} = $serverip;
|
|
2231
|
|
|
2232
|
my $desc = $desc{$group}->{$service->{'service'}};
|
|
2233
|
$desc = '' if ($desc eq '--');
|
|
2234
|
$service->{'desc'} = $desc;
|
|
2235
|
$service->{'last_detail'} =~ s/-//g;
|
|
2236
|
$service->{'last_detail'} =~ s/^\n//;
|
|
2237
|
$service->{'last_detail'} =~ s/\n+/\n/g;
|
|
2238
|
|
|
2239
|
my $monitor = $service->{'monitor'};
|
|
2240
|
|
|
2241
|
$service->{'request'} = $service->{'okstring'} = $service->{'port'} = $service->{'email'} = '';
|
|
2242
|
#$monitor = URI::Escape::uri_unescape($monitor);
|
|
2243
|
#if ( $monitor =~ /stabile-diskspace\.monitor\s+(\S+)\s+(\S+)\s+(\S+)/ ) {
|
|
2244
|
if ( $monitor =~ /stabile-diskspace\.monitor\s+(\S+)\s+(\S+)/ ) {
|
|
2245
|
$service->{'request'} = $2 if ( $monitor =~ /stabile-diskspace\.monitor\s+(\S+)\s+(\S+)/ );
|
|
2246
|
$service->{'okstring'} = $3 if ( $monitor =~ /stabile-diskspace\.monitor\s+(\S+)\s+(\S+)\s+(\S+)/ );
|
|
2247
|
}
|
|
2248
|
|
|
2249
|
$service->{'okstring'} = $1 if ( $monitor =~ /--okstring \"(.*)\"/ );
|
|
2250
|
$service->{'okstring'} = $1 if ( $monitor =~ /-l \"(.*)\"/ );
|
|
2251
|
# $service->{'request'} = $2 if ( $monitor =~ /http(s*):\/\/.+\/(.*)/ );
|
|
2252
|
$service->{'request'} = $2 if ( $monitor =~ /http(s*):\/\/[^\/]+\/(.*)/ );
|
|
2253
|
$service->{'port'} = $2 if ( $monitor =~ /http(s*):\/\/.+:(\d+)/ );
|
|
2254
|
$service->{'request'} = $1 if ( $monitor =~ /--from \"(\S*)\"/ );
|
|
2255
|
$service->{'okstring'} = $1 if ( $monitor =~ /--to \"(\S*)\"/ );
|
|
2256
|
$service->{'port'} = $1 if ( $monitor =~ /--port (\d+)/ );
|
|
2257
|
|
|
2258
|
$service->{'email'} = $emails{$group};
|
|
2259
|
|
|
2260
|
$opstatus{$id} = $service;
|
|
2261
|
#push @monitors, $service;
|
|
2262
|
}
|
|
2263
|
}
|
|
2264
|
}
|
|
2265
|
return %opstatus;
|
|
2266
|
}
|
|
2267
|
|
|
2268
|
sub change_monitor_email {
|
|
2269
|
my $serveruuid = shift;
|
|
2270
|
my $email = shift;
|
|
2271
|
my $match;
|
|
2272
|
if ($email && $serveruuid) {
|
|
2273
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
2274
|
if ($domreg{$serveruuid}->{'user'} eq $user || $isadmin) {
|
|
2275
|
local($^I, @ARGV) = ('.bak', "/etc/mon/mon.cf"); # $^I is the in-place edit switch
|
|
2276
|
# undef $/; # This makes <> read in the entire file in one go
|
|
2277
|
my $uuidmatch;
|
|
2278
|
while (<>) {
|
|
2279
|
if (/^watch (\S+)/) {
|
|
2280
|
if ($1 eq $serveruuid) {$uuidmatch = $serveruuid}
|
|
2281
|
else {$uuidmatch = ''};
|
|
2282
|
};
|
|
2283
|
if ($uuidmatch) {
|
|
2284
|
$match = 1 if (s/(stabile\.alert) (.*)/$1 $email/);
|
|
2285
|
}
|
|
2286
|
print;
|
|
2287
|
close ARGV if eof;
|
|
2288
|
# $match = 1 if (s/(watch $serveruuid\n.+\n.+\n.+\n.+\n.+)$oldemail(\n.+)$oldemail(\n.+)$oldemail/$1$email$2$email$3$email/g);
|
|
2289
|
}
|
|
2290
|
# $/ = "\n";
|
|
2291
|
}
|
|
2292
|
}
|
|
2293
|
return $match;
|
|
2294
|
}
|
|
2295
|
|
|
2296
|
# Delete all monitors belonging to a server
|
|
2297
|
sub deleteMonitors {
|
|
2298
|
my ($serveruuid) = @_;
|
|
2299
|
my $match;
|
|
2300
|
if ($serveruuid) {
|
|
2301
|
if ($domreg{$serveruuid}->{'user'} eq $user || $isadmin) {
|
|
2302
|
local($^I, @ARGV) = ('.bak', "/etc/mon/mon.cf");
|
|
2303
|
# undef $/; # This makes <> read in the entire file in one go
|
|
2304
|
my $uuidmatch;
|
|
2305
|
while (<>) {
|
|
2306
|
if (/^watch (\S+)/) {
|
|
2307
|
if ($1 eq $serveruuid) {$uuidmatch = $serveruuid}
|
|
2308
|
else {$uuidmatch = ''};
|
|
2309
|
};
|
|
2310
|
if ($uuidmatch) {
|
|
2311
|
$match = 1;
|
|
2312
|
} else {
|
|
2313
|
#chomp;
|
|
2314
|
print unless (/^hostgroup $serveruuid/);
|
|
2315
|
}
|
|
2316
|
close ARGV if eof;
|
|
2317
|
}
|
|
2318
|
#$/ = "\n";
|
|
2319
|
}
|
|
2320
|
unlink glob "/var/log/stabile/*:$serveruuid:*";
|
|
2321
|
}
|
|
2322
|
`/usr/bin/moncmd reset keepstate` if ($match);
|
|
2323
|
return $match;
|
|
2324
|
}
|
|
2325
|
|
|
2326
|
# Add a monitors to a server when building system
|
|
2327
|
sub addSimpleMonitors {
|
|
2328
|
my ($serveruuid, $email, $monitors_ref) = @_;
|
|
2329
|
my @mons = @{$monitors_ref};
|
|
2330
|
|
|
2331
|
my $match;
|
|
2332
|
my $hmatch1;
|
|
2333
|
my $hmatch2;
|
|
2334
|
my $hmatch3;
|
|
2335
|
if ($serveruuid && $domreg{$serveruuid}) {
|
|
2336
|
if ($domreg{$serveruuid}->{'user'} eq $user || $isadmin) {
|
|
2337
|
my $monitors = {
|
|
2338
|
ping=>"fping.monitor",
|
|
2339
|
diskspace=>"stabile-diskspace.monitor $serveruuid",
|
|
2340
|
http=>"http_tppnp.monitor",
|
|
2341
|
https=>"http_tppnp.monitor",
|
|
2342
|
smtp=>"smtp3.monitor",
|
|
2343
|
smtps=>"smtp3.monitor",
|
|
2344
|
imap=>"imap.monitor",
|
|
2345
|
imaps=>"imap-ssl.monitor",
|
|
2346
|
ldap=>"ldap.monitor",
|
|
2347
|
telnet=>"telnet.monitor"
|
|
2348
|
};
|
|
2349
|
|
|
2350
|
if (!$email) {$email = $domreg{$serveruuid}->{'alertemail'}};
|
|
2351
|
if (!$email && $register{$domreg{$serveruuid}->{'system'}}) {$email = $register{$domreg{$serveruuid}->{'system'}}->{'alertemail'}};
|
|
2352
|
if (!$email) {$email = $userreg{$user}->{'alertemail'}};
|
|
2353
|
|
|
2354
|
unless (tie %networkreg,'Tie::DBI', {
|
|
2355
|
db=>'mysql:steamregister',
|
|
2356
|
table=>'networks',
|
|
2357
|
key=>'uuid',
|
|
2358
|
autocommit=>0,
|
|
2359
|
CLOBBER=>3,
|
|
2360
|
user=>$dbiuser,
|
|
2361
|
password=>$dbipasswd}) {throw Error::Simple("Stroke=Error Register could not be accessed")};
|
|
2362
|
|
|
2363
|
my $networkuuid1 = $domreg{$serveruuid}->{'networkuuid1'};
|
|
2364
|
my $networktype = $networkreg{$networkuuid1}->{'type'};
|
|
2365
|
my $ip = $networkreg{$networkuuid1}->{'internalip'};
|
|
2366
|
$ip = $networkreg{$networkuuid1}->{'externalip'} if ($networktype eq 'externalip');
|
|
2367
|
$ip = '127.0.0.1' if ($networktype eq 'gateway'); #Dummy IP - we only support diskspace checks
|
|
2368
|
untie %networkreg;
|
|
2369
|
|
|
2370
|
local($^I, @ARGV) = ('.bak', "/etc/mon/mon.cf");
|
|
2371
|
my $uuidmatch;
|
|
2372
|
while (<>) {
|
|
2373
|
$hmatch1=1 if (/^hostgroup/);
|
|
2374
|
$hmatch2=1 if ($hmatch1 && !/^hostgroup/);
|
|
2375
|
if ($hmatch1 && $hmatch2 && !$hmatch3) {
|
|
2376
|
print "hostgroup $serveruuid $ip\n";
|
|
2377
|
$hmatch3 = 1;
|
|
2378
|
}
|
|
2379
|
print;
|
|
2380
|
if (eof) {
|
|
2381
|
print "watch $serveruuid\n";
|
|
2382
|
foreach $service (@mons) {
|
|
2383
|
print <<END;
|
|
2384
|
service $service
|
|
2385
|
interval 1m
|
|
2386
|
monitor $monitors->{$service}
|
|
2387
|
description --
|
|
2388
|
period
|
|
2389
|
alert stabile.alert $email
|
|
2390
|
upalert stabile.alert $email
|
|
2391
|
startupalert stabile.alert $email
|
|
2392
|
numalerts 2
|
|
2393
|
no_comp_alerts
|
|
2394
|
END
|
|
2395
|
;
|
|
2396
|
my $oplogfile = "/var/log/stabile/$year-$month:$serveruuid:$service";
|
|
2397
|
unless (-e $oplogfile) {
|
|
2398
|
`/usr/bin/touch "$oplogfile"`;
|
|
2399
|
`/bin/chown mon:mon "$oplogfile"`;
|
|
2400
|
my $logline = "$current_time, UP, STARTUP, $pretty_time";
|
|
2401
|
`/bin/echo >> $oplogfile "$logline"`;
|
|
2402
|
}
|
|
2403
|
}
|
|
2404
|
close ARGV;
|
|
2405
|
}
|
|
2406
|
}
|
|
2407
|
} else {
|
|
2408
|
return "Server $serveruuid not available";
|
|
2409
|
}
|
|
2410
|
} else {
|
|
2411
|
return "Invalid uuid $serveruuid";
|
|
2412
|
}
|
|
2413
|
return "OK";
|
|
2414
|
}
|
|
2415
|
|
|
2416
|
sub Monitors_save {
|
|
2417
|
my ($id, $action, $obj) = @_;
|
|
2418
|
if ($help) {
|
|
2419
|
return <<END
|
|
2420
|
PUT:id:
|
|
2421
|
Enable, disable or acknowledge a monitor. Id is of the form serveruuid:service
|
|
2422
|
END
|
|
2423
|
}
|
|
2424
|
|
|
2425
|
my $delete = ($action eq 'monitors_remove'); # Delete an existing monitor
|
|
2426
|
$id = $obj->{'id'} || $id; # ID in params supersedes id in path
|
|
2427
|
my $update; # Update an existing monitor?
|
|
2428
|
my $postmsg;
|
|
2429
|
|
|
2430
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
2431
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access networks register"};
|
|
2432
|
foreign_require("mon", "mon-lib.pl");
|
|
2433
|
$conf = mon::get_mon_config();
|
|
2434
|
# my @ogroups = mon::find("hostgroup", $conf);
|
|
2435
|
# my @owatches = mon::find("watch", $conf);
|
|
2436
|
my $doreset;
|
|
2437
|
my $email;
|
|
2438
|
|
|
2439
|
my $serveruuid;
|
|
2440
|
my $servicename;
|
|
2441
|
if ($id =~ /(.+):(.+)/){ # List specific monitor for specific server
|
|
2442
|
$serveruuid = $1;
|
|
2443
|
$servicename = $2;
|
|
2444
|
}
|
|
2445
|
$serveruuid = $serveruuid || $obj->{'serveruuid'};
|
|
2446
|
my $desc = $obj->{'desc'};
|
|
2447
|
my $okstring = $obj->{'okstring'};
|
|
2448
|
my $request = $obj->{'request'};
|
|
2449
|
my $port = $obj->{'port'};
|
|
2450
|
$servicename = $servicename || $obj->{'service'};
|
|
2451
|
my $interval = '1'; # Number of minutes between checks
|
|
2452
|
$interval = '20' if ($servicename eq 'diskspace');
|
|
2453
|
$email = $obj->{'alertemail'};
|
|
2454
|
my $serv = $domreg{$serveruuid};
|
|
2455
|
if (!$email) {$email = $serv->{'alertemail'}};
|
|
2456
|
if (!$email && $serv->{'system'}) {$email = $register{$serv->{'system'}}->{'alertemail'}};
|
|
2457
|
if (!$email) {$email = $userreg{$user}->{'alertemail'}};
|
|
2458
|
my $networkuuid1 = $serv->{'networkuuid1'};
|
|
2459
|
my $networktype = $networkreg{$networkuuid1}->{'type'};
|
|
2460
|
my $deleteid;
|
|
2461
|
|
|
2462
|
if (!$serveruuid || !$servicename) {
|
|
2463
|
$postmsg = qq|No monitor specified|;
|
|
2464
|
$postreply = "Status=Error $postmsg\n";
|
|
2465
|
return $postreply;
|
|
2466
|
}
|
|
2467
|
|
|
2468
|
if (!$delete && $networktype eq 'gateway' && $servicename ne 'diskspace'
|
|
2469
|
&& (!$obj->{'serverip'} || !($obj->{'serverip'} =~ /^\d+\.\d+\.\d+\.\d+$/) )) {
|
|
2470
|
$postmsg = qq|Invalid IP address|;
|
|
2471
|
} elsif (!$domreg{$serveruuid}) {
|
|
2472
|
$postmsg = qq|Unknown server $serveruuid|;
|
|
2473
|
# Security check
|
|
2474
|
} elsif ($domreg{$serveruuid}->{'user'} ne $user) {
|
|
2475
|
$postmsg = qq|Bad server|;
|
|
2476
|
} else {
|
|
2477
|
my $monitors = {
|
|
2478
|
ping=>"fping.monitor",
|
|
2479
|
diskspace=>"stabile-diskspace.monitor",
|
|
2480
|
http=>"http_tppnp.monitor",
|
|
2481
|
https=>"http_tppnp.monitor",
|
|
2482
|
smtp=>"smtp3.monitor",
|
|
2483
|
smtps=>"smtp3.monitor",
|
|
2484
|
imap=>"imap.monitor",
|
|
2485
|
imaps=>"imap-ssl.monitor",
|
|
2486
|
ldap=>"ldap.monitor",
|
|
2487
|
telnet=>"telnet.monitor"
|
|
2488
|
};
|
|
2489
|
my $args = '';
|
|
2490
|
my $ip = $networkreg{$networkuuid1}->{'internalip'};
|
|
2491
|
$ip = $networkreg{$networkuuid1}->{'externalip'} if ($networktype eq 'externalip');
|
|
2492
|
$ip = '127.0.0.1' if ($networktype eq 'gateway' && $servicename eq 'diskspace'); #Dummy IP - we only support diskspace checks
|
|
2493
|
if ($networktype eq 'gateway' && $servicename eq 'ping') {
|
|
2494
|
$ip = $obj->{'serverip'};
|
|
2495
|
# We can only check 10.x.x.x addresses on vlan because of routing
|
|
2496
|
if ($ip =~ /^10\./) {
|
|
2497
|
$monitors->{'ping'} = "stabile-arping.monitor";
|
|
2498
|
my $id = $networkreg{$networkuuid1}->{'id'};
|
|
2499
|
if ($id > 1) {
|
|
2500
|
my $if = $datanic . "." . $id;
|
|
2501
|
$args = " $if";
|
|
2502
|
} else {
|
|
2503
|
$args = " $extnic";
|
|
2504
|
}
|
|
2505
|
$args .= " $ip";
|
|
2506
|
}
|
|
2507
|
}
|
|
2508
|
|
|
2509
|
if ($servicename eq 'ping') {
|
|
2510
|
;
|
|
2511
|
} elsif ($servicename eq 'diskspace'){
|
|
2512
|
#my $macip = $domreg{$serveruuid}->{'macip'};
|
|
2513
|
#my $image = URI::Escape::uri_escape($domreg{$serveruuid}->{'image'});
|
|
2514
|
#$args .= " $macip $image $serveruuid";
|
|
2515
|
$args .= " $serveruuid";
|
|
2516
|
$args .= ($request)?" $request":" 10"; #min free %
|
|
2517
|
$args .= " $okstring" if ($okstring); #Comma-separated partion list, e.g. 0,1
|
|
2518
|
} elsif ($servicename eq 'http'){
|
|
2519
|
$args .= " --okcodes \"200,403\" --debuglog -";
|
|
2520
|
$args .= " --okstring \"$okstring\"" if ($okstring);
|
|
2521
|
$args .= " http://$ip";
|
|
2522
|
$args .= ":$port" if ($port && $port>10 && $port<65535);
|
|
2523
|
$request = substr($request,1) if ($request =~ /^\//);
|
|
2524
|
$args .= "/$request" if ($request);
|
|
2525
|
} elsif ($servicename eq 'https'){
|
|
2526
|
$args .= " --okcodes \"200,403\" --debuglog -";
|
|
2527
|
$args .= " --okstring \"$okstring\"" if ($okstring);
|
|
2528
|
$args .= " https://$ip";
|
|
2529
|
$args .= ":$port" if ($port && $port>10 && $port<65535);
|
|
2530
|
$request = substr($request,1) if ($request =~ /^\//);
|
|
2531
|
$args .= "/$request" if ($request);
|
|
2532
|
} elsif ($servicename eq 'smtp'){
|
|
2533
|
$args .= " --from \"$request\"" if ($request);
|
|
2534
|
$args .= " --to \"$okstring\"" if ($okstring);
|
|
2535
|
$args .= " --port $port" if ($port && $port>10 && $port<65535);
|
|
2536
|
} elsif ($servicename eq 'smtps'){
|
|
2537
|
$args .= " --requiretls";
|
|
2538
|
$args .= " --from \"$request\"" if ($request);
|
|
2539
|
$args .= " --to \"$okstring\"" if ($okstring);
|
|
2540
|
$args .= " --port $port" if ($port && $port>10 && $port<65535);
|
|
2541
|
} elsif ($servicename eq 'imap'){
|
|
2542
|
$args .= " -p $port" if ($port && $port>10 && $port<65535);
|
|
2543
|
} elsif ($servicename eq 'imaps'){
|
|
2544
|
$args .= " -p $port" if ($port && $port>10 && $port<65535);
|
|
2545
|
} elsif ($servicename eq 'ldap'){
|
|
2546
|
$args .= " --port $port" if ($port && $port>10 && $port<65535);
|
|
2547
|
$args .= " --basedn \"$request\"" if ($request);
|
|
2548
|
$args .= " --attribute \"$okstring\"" if ($okstring);
|
|
2549
|
} elsif ($servicename eq 'telnet'){
|
|
2550
|
$args .= " -l \"$okstring\"" if ($okstring);
|
|
2551
|
$args .= " -p $port" if ($port && $port>10 && $port<65535);
|
|
2552
|
}
|
|
2553
|
|
|
2554
|
my @ogroups = mon::find("hostgroup", $conf);
|
|
2555
|
my @owatches = mon::find("watch", $conf);
|
|
2556
|
|
|
2557
|
$group = { 'name' => 'hostgroup', 'values' => [ $serveruuid, $ip ] };
|
|
2558
|
my $ogroup = undef;
|
|
2559
|
my $i;
|
|
2560
|
for($i=0; $i<scalar @ogroups; $i++) {
|
|
2561
|
if ($ogroups[$i]->{'values'}[0] eq $serveruuid) {
|
|
2562
|
$ogroup = $ogroups[$i];
|
|
2563
|
last;
|
|
2564
|
}
|
|
2565
|
}
|
|
2566
|
mon::save_directive($conf, $ogroup, $group); #Update host hostgroup
|
|
2567
|
|
|
2568
|
$watch = { 'name' => 'watch','values' => [ $serveruuid ], 'members' => [ ] };
|
|
2569
|
my $owatch = undef;
|
|
2570
|
my $oservice = undef;
|
|
2571
|
my $widx = undef;
|
|
2572
|
for($i=0; $i<scalar @owatches; $i++) { # Run through all watches and locate match
|
|
2573
|
if ($owatches[$i]->{'values'}[0] eq $serveruuid) {
|
|
2574
|
$owatch = $watch = $owatches[$i];
|
|
2575
|
$widx = $owatch->{'index'};
|
|
2576
|
my @oservices = mon::find("service", $watch->{'members'});
|
|
2577
|
for($j=0; $j<@oservices; $j++) { # Run through all services for watch and locate match
|
|
2578
|
if ($oservices[$j]->{'values'}[0] eq $servicename) {
|
|
2579
|
$oservice = $oservices[$j];
|
|
2580
|
my $newmonargs = "$monitors->{$servicename}$args";
|
|
2581
|
$newmonargs =~ s/\s+$//; # Remove trailing spaces
|
|
2582
|
my $oldmonargs = "$oservices[$j]->{'members'}[2]->{'values'}[0] $oservices[$j]->{'members'}[2]->{'values'}[1]";
|
|
2583
|
$oldmonargs =~ s/\s+$//; # Remove trailing spaces
|
|
2584
|
if ($newmonargs ne $oldmonargs) {
|
|
2585
|
$update = 1; #We are changing an existing service definition
|
|
2586
|
};
|
|
2587
|
last;
|
|
2588
|
}
|
|
2589
|
}
|
|
2590
|
last;
|
|
2591
|
}
|
|
2592
|
}
|
|
2593
|
my $in = {
|
|
2594
|
args=>undef,
|
|
2595
|
desc=>"$desc",
|
|
2596
|
idx=>$widx,
|
|
2597
|
interval=>$interval,
|
|
2598
|
interval_u=>'m',
|
|
2599
|
monitor=>$monitors->{$servicename} . $args,
|
|
2600
|
monitor_def=>1,
|
|
2601
|
name=>$servicename,
|
|
2602
|
other=>undef,
|
|
2603
|
sidx=>undef,
|
|
2604
|
delete=>$delete,
|
|
2605
|
email=>$email
|
|
2606
|
};
|
|
2607
|
|
|
2608
|
if ($update || $delete) {
|
|
2609
|
unlink glob "/var/log/stabile/*:$serveruuid:$servicename";
|
|
2610
|
} else {
|
|
2611
|
my $oplogfile = "/var/log/stabile/$year-$month:$serveruuid:$servicename";
|
|
2612
|
unless (-e $oplogfile) {
|
|
2613
|
`/usr/bin/touch "$oplogfile"`;
|
|
2614
|
`/bin/chown mon:mon "$oplogfile"`;
|
|
2615
|
my $logline = "$current_time, UP, STARTUP, $pretty_time";
|
|
2616
|
`/bin/echo >> $oplogfile "$logline"`;
|
|
2617
|
}
|
|
2618
|
}
|
|
2619
|
$deleteid = (($delete || $update)?"$serveruuid:$servicename":'');
|
|
2620
|
save_service($in, $owatch, $oservice);
|
|
2621
|
$doreset = 1;
|
|
2622
|
$obj->{'last_check'} = '--';
|
|
2623
|
$obj->{'opstatus'} = '7';
|
|
2624
|
$obj->{'status'} = 'checking';
|
|
2625
|
$obj->{'alertemail'} = $email;
|
|
2626
|
mon::flush_file_lines();
|
|
2627
|
$main::syslogit->($user, 'info', "updating monitor $serveruuid:$servicename" . (($delete)?" delete":""));
|
|
2628
|
saveOpstatus($deleteid);
|
|
2629
|
`/usr/bin/moncmd reset keepstate`;
|
|
2630
|
}
|
|
2631
|
|
|
2632
|
untie %networkreg;
|
|
2633
|
untie %domreg;
|
|
2634
|
|
|
2635
|
$postreply = to_json(\%h, {pretty => 1});
|
|
2636
|
$postmsg = "OK" unless ($postmsg);
|
|
2637
|
return $postreply;
|
|
2638
|
}
|
|
2639
|
|
|
2640
|
## Copied from save_service.cgi (from webmin) and slightly modified - well heavily perhaps
|
|
2641
|
|
|
2642
|
sub save_service {
|
|
2643
|
my $sin = shift;
|
|
2644
|
my $owatch = shift;
|
|
2645
|
my $oservice = shift;
|
|
2646
|
my %in = %{$sin};
|
|
2647
|
my $oldservice = undef;
|
|
2648
|
my $service;
|
|
2649
|
if ($oservice) {
|
|
2650
|
# $oldservice = $service = $watch->{'members'}->[$in{'sidx'}];
|
|
2651
|
$oldservice = $service = $oservice;
|
|
2652
|
} else {
|
|
2653
|
$service = { 'name' => 'service',
|
|
2654
|
'indent' => ' ',
|
|
2655
|
'members' => [ ] };
|
|
2656
|
}
|
|
2657
|
|
|
2658
|
if ($in{'delete'}) {
|
|
2659
|
# Delete this service from the watch
|
|
2660
|
mon::save_directive($watch->{'members'}, $service, undef) if ($oservice);
|
|
2661
|
my @rservices = mon::find("service", $watch->{'members'});
|
|
2662
|
# Delete watch and hostgroup if no services left
|
|
2663
|
if (@rservices==0) {
|
|
2664
|
mon::save_directive($conf, $watch, undef);
|
|
2665
|
mon::save_directive($conf, $group, undef);
|
|
2666
|
}
|
|
2667
|
} else {
|
|
2668
|
# Validate and store service inputs
|
|
2669
|
$in{'name'} =~ /^\S+$/ || {$in{'name'} = 'ping'};
|
|
2670
|
$service->{'values'} = [ $in{'name'} ];
|
|
2671
|
$in{'interval'} =~ /^\d+$/ || {$in{'interval'} = 1};
|
|
2672
|
|
|
2673
|
&set_directive($service->{'members'}, "interval", $in{'interval'}.$in{'interval_u'});
|
|
2674
|
|
|
2675
|
if ($in{'monitor_def'}) {
|
|
2676
|
&set_directive($service->{'members'}, "monitor", $in{'monitor'}.' '.$in{'args'});
|
|
2677
|
}
|
|
2678
|
else {
|
|
2679
|
$in{'other'} =~ /^\S+$/ || return "No other monitor specified";
|
|
2680
|
&set_directive($service->{'members'}, "monitor", $in{'other'}.' '.$in{'args'});
|
|
2681
|
}
|
|
2682
|
|
|
2683
|
# Save the description
|
|
2684
|
if ($in{'desc'}) {
|
|
2685
|
my $desc = $in{'desc'};
|
|
2686
|
$desc =~ tr/\n/ /;
|
|
2687
|
&set_directive($service->{'members'}, "description", $in{'desc'});
|
|
2688
|
}
|
|
2689
|
else {
|
|
2690
|
&set_directive($service->{'members'}, "description", '--');
|
|
2691
|
}
|
|
2692
|
|
|
2693
|
my $period = { 'name' => 'period', 'members' => [ ] };
|
|
2694
|
my @alert;
|
|
2695
|
my @v = ( "stabile.alert", $in{'email'} );
|
|
2696
|
my @num = (2); # The number of alerts to send
|
|
2697
|
push(@alert, { 'name' => 'alert', 'values' => \@v });
|
|
2698
|
&set_directive($period->{'members'}, "alert", @alert);
|
|
2699
|
my @upalert;
|
|
2700
|
push(@upalert, { 'name' => 'upalert', 'values' => \@v });
|
|
2701
|
&set_directive($period->{'members'}, "upalert", @upalert);
|
|
2702
|
my @startupalert;
|
|
2703
|
push(@startupalert, { 'name' => 'startupalert', 'values' => \@v });
|
|
2704
|
&set_directive($period->{'members'}, "startupalert", @startupalert);
|
|
2705
|
my @numalerts;
|
|
2706
|
push(@numalerts, { 'name' => 'numalerts', 'values' => \@num });
|
|
2707
|
&set_directive($period->{'members'}, "numalerts", @numalerts);
|
|
2708
|
my @no_comp_alerts;
|
|
2709
|
push(@no_comp_alerts, { 'name' => 'no_comp_alerts', 'values' => 0 });
|
|
2710
|
&set_directive($period->{'members'}, "no_comp_alerts", @no_comp_alerts);
|
|
2711
|
|
|
2712
|
push(@period, $period);
|
|
2713
|
|
|
2714
|
&set_directive($service->{'members'}, "period", @period);
|
|
2715
|
|
|
2716
|
if ($owatch) {
|
|
2717
|
# Store the service in existing watch in the config file
|
|
2718
|
mon::save_directive($watch->{'members'}, $oldservice, $service);
|
|
2719
|
} else {
|
|
2720
|
# Create new watch
|
|
2721
|
push(@service, $service);
|
|
2722
|
&set_directive($watch->{'members'}, "service", @service);
|
|
2723
|
mon::save_directive($conf, undef, $watch);
|
|
2724
|
}
|
|
2725
|
}
|
|
2726
|
}
|
|
2727
|
|
|
2728
|
# set_directive(&config, name, value, value, ..)
|
|
2729
|
sub set_directive
|
|
2730
|
{
|
|
2731
|
local @o = mon::find($_[1], $_[0]);
|
|
2732
|
local @n = @_[2 .. @_-1];
|
|
2733
|
local $i;
|
|
2734
|
for($i=0; $i<@o || $i<@n; $i++) {
|
|
2735
|
local $idx = &indexof($o[$i], @{$_[0]}) if ($o[$i]);
|
|
2736
|
local $nv = ref($n[$i]) ? $n[$i] : { 'name' => $_[1],
|
|
2737
|
'values' => [ $n[$i] ] }
|
|
2738
|
if (defined($n[$i]));
|
|
2739
|
if ($o[$i] && defined($n[$i])) {
|
|
2740
|
$_[0]->[$idx] = $nv;
|
|
2741
|
}
|
|
2742
|
elsif ($o[$i]) {
|
|
2743
|
splice(@{$_[0]}, $idx, 1);
|
|
2744
|
}
|
|
2745
|
else {
|
|
2746
|
push(@{$_[0]}, $nv);
|
|
2747
|
}
|
|
2748
|
}
|
|
2749
|
}
|
|
2750
|
|
|
2751
|
sub getSystemsListing {
|
|
2752
|
my ($action, $curuuid, $username) = @_;
|
|
2753
|
$username = $user unless ($username);
|
|
2754
|
my @domregvalues = values %domreg;
|
|
2755
|
my @curregvalues;
|
|
2756
|
my %curreg;
|
|
2757
|
|
|
2758
|
$userfullname = $userreg{$username}->{'fullname'};
|
|
2759
|
$useremail = $userreg{$username}->{'email'};
|
|
2760
|
$userphone = $userreg{$username}->{'phone'};
|
|
2761
|
$useropfullname = $userreg{$username}->{'opfullname'};
|
|
2762
|
$useropemail = $userreg{$username}->{'opemail'};
|
|
2763
|
$useropphone = $userreg{$username}->{'opphone'};
|
|
2764
|
$useralertemail = $userreg{$username}->{'alertemail'};
|
|
2765
|
|
|
2766
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$postreply = "Unable to access image register"; return;};
|
|
2767
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access networks register"};
|
|
2768
|
|
|
2769
|
# Collect systems from domains and include domains as children
|
|
2770
|
if ($action ne 'flatlist') { # Dont include children in select
|
|
2771
|
my @imagenames = qw(image image2 image3 image4);
|
|
2772
|
foreach my $valref (@domregvalues) {
|
|
2773
|
# Only include VM's belonging to current user (or all users if specified and user is admin)
|
|
2774
|
if ($username eq $valref->{'user'} || $fulllist) {
|
|
2775
|
next unless (!$curuuid || ($valref->{'uuid'} eq $curuuid || $valref->{'system'} eq $curuuid));
|
|
2776
|
|
|
2777
|
my %val = %{$valref}; # Deference and assign to new ass array, effectively cloning object
|
|
2778
|
my $sysuuid = $val{'system'};
|
|
2779
|
my $dbobj = $register{$sysuuid};
|
|
2780
|
$val{'memory'} += 0;
|
|
2781
|
$val{'vcpu'} += 0;
|
|
2782
|
$val{'nodetype'} = 'child';
|
|
2783
|
$val{'fullname'} = $val{'fullname'} || $dbobj->{'fullname'} || $userfullname;
|
|
2784
|
$val{'email'} = $val{'email'} || $dbobj->{'email'} || $useremail;
|
|
2785
|
$val{'phone'} = $val{'phone'} || $dbobj->{'phone'} || $userphone;
|
|
2786
|
$val{'opfullname'} = $val{'opfullname'} || $dbobj->{'opfullname'} || $useropfullname;
|
|
2787
|
$val{'opemail'} = $val{'opemail'} || $dbobj->{'opemail'} || $useropemail;
|
|
2788
|
$val{'opphone'} = $val{'opphone'} || $dbobj->{'opphone'} || $useropphone;
|
|
2789
|
$val{'alertemail'} = $val{'alertemail'} || $dbobj->{'alertemail'} || $useralertemail;
|
|
2790
|
$val{'autostart'} = ($val{'autostart'})?'1':'';
|
|
2791
|
|
|
2792
|
foreach my $img (@imagenames) {
|
|
2793
|
if ($imagereg{$val{$img}} && $imagereg{$val{$img}}->{'storagepool'} == -1) {
|
|
2794
|
$val{'nodestorage'} += $imagereg{$val{$img}}->{'virtualsize'};
|
|
2795
|
} else {
|
|
2796
|
$val{'storage'} += $imagereg{$val{$img}}->{'virtualsize'} if ($imagereg{$val{$img}});
|
|
2797
|
}
|
|
2798
|
}
|
|
2799
|
$val{'externalips'} += 1 if ($networkreg{$val{'networkuuid1'}} && $networkreg{$val{'networkuuid1'}}->{'type'} =~ /externalip|ipmapping/);
|
|
2800
|
$val{'externalips'} += 1 if ($networkreg{$val{'networkuuid2'}} && $networkreg{$val{'networkuuid2'}}->{'type'} =~ /externalip|ipmapping/);
|
|
2801
|
$val{'externalips'} += 1 if ($networkreg{$val{'networkuuid3'}} && $networkreg{$val{'networkuuid3'}}->{'type'} =~ /externalip|ipmapping/);
|
|
2802
|
$val{'networktype1'} = $networkreg{$val{'networkuuid1'}}->{'type'} if ($networkreg{$val{'networkuuid1'}});
|
|
2803
|
$val{'imageuuid'} = $imagereg{$val{'image'}}->{'uuid'} if ($imagereg{$val{'image'}});
|
|
2804
|
$val{'imageuuid2'} = $imagereg{$val{'image2'}}->{'uuid'} if ($imagereg{$val{'image2'}} && $val{'image2'} && $val{'image2'} ne '--');
|
|
2805
|
$val{'internalip'} = $networkreg{$val{'networkuuid1'}}->{'internalip'} if ($networkreg{$val{'networkuuid1'}});
|
|
2806
|
$val{'externalip'} = $networkreg{$val{'networkuuid1'}}->{'externalip'} if ($networkreg{$val{'networkuuid1'}});
|
|
2807
|
|
|
2808
|
my $networkuuid1; # needed for generating management url
|
|
2809
|
if ($sysuuid && $sysuuid ne '--') { # We are dealing with a server that's part of a system
|
|
2810
|
if (!$register{$sysuuid}) { #System does not exist - create it
|
|
2811
|
$sysname = $val{'name'};
|
|
2812
|
$sysname = $1 if ($sysname =~ /(.+)\..*/);
|
|
2813
|
$sysname =~ s/server/System/i;
|
|
2814
|
$register{$sysuuid} = {
|
|
2815
|
uuid => $sysuuid,
|
|
2816
|
name => $sysname,
|
|
2817
|
user => $username,
|
|
2818
|
created => $current_time
|
|
2819
|
};
|
|
2820
|
}
|
|
2821
|
|
|
2822
|
my %pval = %{$register{$sysuuid}};
|
|
2823
|
$pval{'status'} = '--';
|
|
2824
|
$pval{'issystem'} = 1;
|
|
2825
|
$pval{'fullname'} = $pval{'fullname'} || $userfullname;
|
|
2826
|
$pval{'email'} = $pval{'email'} || $useremail;
|
|
2827
|
$pval{'phone'} = $pval{'phone'} || $userphone;
|
|
2828
|
$pval{'opfullname'} = $pval{'opfullname'} || $useropfullname;
|
|
2829
|
$pval{'opemail'} = $pval{'opemail'} || $useropemail;
|
|
2830
|
$pval{'opphone'} = $pval{'opphone'} || $useropphone;
|
|
2831
|
$pval{'alertemail'} = $pval{'alertemail'} || $useralertemail;
|
|
2832
|
$pval{'autostart'} = ($pval{'autostart'})?'1':'';
|
|
2833
|
|
|
2834
|
my @children;
|
|
2835
|
if ($curreg{$sysuuid}->{'children'}) {
|
|
2836
|
@children = @{$curreg{$sysuuid}->{'children'}};
|
|
2837
|
}
|
|
2838
|
# If system has an admin image, update networkuuid1 with the image's server's info
|
|
2839
|
if ($pval{'image'} && $pval{'image'} ne '--') {
|
|
2840
|
my $dbimg = $imagereg{$pval{'image'}};
|
|
2841
|
$networkuuid1 = $domreg{$dbimg->{'domains'}}->{'networkuuid1'} if ($domreg{$dbimg->{'domains'}});
|
|
2842
|
my $externalip = '';
|
|
2843
|
my $ports = '';
|
|
2844
|
if ($networkreg{$networkuuid1}) {
|
|
2845
|
$externalip = $networkreg{$networkuuid1}->{'externalip'};
|
|
2846
|
$ports = $networkreg{$networkuuid1}->{'ports'}
|
|
2847
|
}
|
|
2848
|
$register{$sysuuid}->{'networkuuid1'} = $networkuuid1;
|
|
2849
|
$register{$sysuuid}->{'internalip'} = $networkreg{$networkuuid1}->{'internalip'} if ($networkreg{$networkuuid1});
|
|
2850
|
$pval{'master'} = $dbimg->{'master'};
|
|
2851
|
$pval{'appid'} = $dbimg->{'appid'};
|
|
2852
|
$pval{'version'} = $dbimg->{'version'};
|
|
2853
|
my $managementurl;
|
|
2854
|
$managementurl = $dbimg->{'managementlink'};
|
|
2855
|
$managementurl =~ s/\{uuid\}/$networkuuid1/;
|
|
2856
|
$managementurl =~ s/\{externalip\}/$externalip/;
|
|
2857
|
$pval{'managementurl'} = $managementurl;
|
|
2858
|
my $upgradeurl;
|
|
2859
|
$upgradeurl = $dbimg->{'upgradelink'};
|
|
2860
|
$upgradeurl =~ s/\{uuid\}/$networkuuid1/;
|
|
2861
|
$pval{'upgradeurl'} = $upgradeurl;
|
|
2862
|
my $terminalurl;
|
|
2863
|
$terminalurl = $dbimg->{'terminallink'};
|
|
2864
|
$terminalurl =~ s/\{uuid\}/$networkuuid1/;
|
|
2865
|
$pval{'terminalurl'} = $terminalurl;
|
|
2866
|
$pval{'externalip'} = $externalip;
|
|
2867
|
$pval{'ports'} = $ports;
|
|
2868
|
$pval{'imageuuid'} = $dbimg->{'uuid'};
|
|
2869
|
$pval{'imageuuid2'} = $imagereg{$pval{'image2'}}->{'uuid'} if ($pval{'image2'} && $pval{'image2'} ne '--');
|
|
2870
|
}
|
|
2871
|
push @children,\%val;
|
|
2872
|
$pval{'children'} = \@children;
|
|
2873
|
$curreg{$sysuuid} = \%pval;
|
|
2874
|
} else { # This server is not part of a system
|
|
2875
|
$sysuuid = $val{'uuid'};
|
|
2876
|
my $dbimg = $imagereg{$val{'image'}};
|
|
2877
|
$networkuuid1 = $domreg{$dbimg->{'domains'}}->{'networkuuid1'} if ($domreg{$dbimg->{'domains'}});
|
|
2878
|
my $externalip;
|
|
2879
|
if ($networkreg{$networkuuid1}) {
|
|
2880
|
$externalip = $networkreg{$networkuuid1}->{'externalip'};
|
|
2881
|
$val{'internalip'} = $networkreg{$networkuuid1}->{'internalip'};
|
|
2882
|
$val{'ports'} = $networkreg{$networkuuid1}->{'ports'};
|
|
2883
|
}
|
|
2884
|
$val{'networkuuid1'} = $networkuuid1;
|
|
2885
|
$val{'master'} = $dbimg->{'master'};
|
|
2886
|
$val{'appid'} = $dbimg->{'appid'};
|
|
2887
|
$val{'version'} = $dbimg->{'version'};
|
|
2888
|
$val{'imageuuid'} = $dbimg->{'uuid'};
|
|
2889
|
$val{'imageuuid2'} = $imagereg{$val{'image2'}}->{'uuid'} if ($val{'image2'} && $val{'image2'} ne '--' && $imagereg{$val{'image2'}});
|
|
2890
|
|
|
2891
|
my $managementurl = $dbimg->{'managementlink'};
|
|
2892
|
$managementurl =~ s/\{uuid\}/$networkuuid1/;
|
|
2893
|
$managementurl =~ s/\{externalip\}/$externalip/;
|
|
2894
|
$val{'managementurl'} = $managementurl;
|
|
2895
|
my $upgradeurl;
|
|
2896
|
$upgradeurl = $dbimg->{'upgradelink'};
|
|
2897
|
$upgradeurl =~ s/\{uuid\}/$networkuuid1/;
|
|
2898
|
$val{'upgradeurl'} = $upgradeurl;
|
|
2899
|
my $terminalurl;
|
|
2900
|
$terminalurl = $dbimg->{'terminallink'};
|
|
2901
|
$terminalurl =~ s/\{uuid\}/$networkuuid1/;
|
|
2902
|
$val{'terminalurl'} = $terminalurl;
|
|
2903
|
$val{'externalip'} = $externalip;
|
|
2904
|
$val{'system'} = '--';
|
|
2905
|
|
|
2906
|
$curreg{$sysuuid} = \%val;
|
|
2907
|
}
|
|
2908
|
}
|
|
2909
|
}
|
|
2910
|
tied(%register)->commit;
|
|
2911
|
}
|
|
2912
|
untie %imagereg;
|
|
2913
|
|
|
2914
|
my @regvalues = values %register;
|
|
2915
|
# Go through systems register, add empty systems and update statuses
|
|
2916
|
foreach my $valref (@regvalues) {
|
|
2917
|
# Only include items belonging to current user (or all users if specified and user is admin)
|
|
2918
|
if ($username eq $valref->{'user'} || $fulllist) {
|
|
2919
|
next unless (!$curuuid || $valref->{'uuid'} eq $curuuid);
|
|
2920
|
|
|
2921
|
my %val = %{$valref};
|
|
2922
|
# add empty system (must be empty since not included from going through servers
|
|
2923
|
if (!($curreg{$val{'uuid'}})) {
|
|
2924
|
$val{'issystem'} = 1;
|
|
2925
|
$val{'status'} = 'inactive';
|
|
2926
|
$curreg{$val{'uuid'}} = \%val;
|
|
2927
|
} else {
|
|
2928
|
# Update status
|
|
2929
|
my $status = 'running';
|
|
2930
|
my $externalips = 0;
|
|
2931
|
foreach my $child (@{$curreg{$val{'uuid'}}-> {'children'}}) {
|
|
2932
|
$status = $child->{'status'} unless ($child->{'status'} eq $status);
|
|
2933
|
$externalips += $child->{'externalips'} unless ($child->{'externalips'} eq '');
|
|
2934
|
}
|
|
2935
|
$status = 'degraded' unless ($status eq 'running' || $status eq 'shutoff');
|
|
2936
|
$curreg{$val{'uuid'}}->{'status'} = $status;
|
|
2937
|
$curreg{$val{'uuid'}}->{'externalips'} = $externalips;
|
|
2938
|
# $networkreg{$domreg{$curdomuuid}->{'networkuuid1'}}->{'internalip'};
|
|
2939
|
if ($curuuid && !$curreg{$val{'uuid'}}->{'internalip'}) { # Add calling server's own internalip if it's part of an ad-hoc assembled system
|
|
2940
|
$curreg{$val{'uuid'}}->{'internalip'} = $networkreg{$domreg{$curdomuuid}->{'networkuuid1'}}->{'internalip'};
|
|
2941
|
}
|
|
2942
|
}
|
|
2943
|
}
|
|
2944
|
}
|
|
2945
|
untie %networkreg;
|
|
2946
|
|
|
2947
|
@curregvalues = values %curreg;
|
|
2948
|
my @sorted_systems = sort {$a->{'name'} cmp $b->{'name'}} @curregvalues;
|
|
2949
|
@sorted_systems = sort {$a->{'status'} cmp $b->{'status'}} @sorted_systems;
|
|
2950
|
|
|
2951
|
if ($action eq 'tablelist') {
|
|
2952
|
my $t2 = Text::SimpleTable->new(40,24,14);
|
|
2953
|
|
|
2954
|
$t2->row('uuid', 'name', 'user');
|
|
2955
|
$t2->hr;
|
|
2956
|
my $pattern = $options{m};
|
|
2957
|
foreach $rowref (@sorted_systems){
|
|
2958
|
if ($pattern) {
|
|
2959
|
my $rowtext = $rowref->{'uuid'} . " " . $rowref->{'name'} . " " . $rowref->{'user'};
|
|
2960
|
next unless ($rowtext =~ /$pattern/i);
|
|
2961
|
}
|
|
2962
|
$t2->row($rowref->{'uuid'}, $rowref->{'name'}||'--', $rowref->{'user'}||'--');
|
|
2963
|
}
|
|
2964
|
return $t2->draw;
|
|
2965
|
} elsif ($action eq 'removeusersystems') {
|
|
2966
|
return @sorted_systems;
|
|
2967
|
} elsif ($action eq 'arraylist') {
|
|
2968
|
return @sorted_systems;
|
|
2969
|
} elsif ($console) {
|
|
2970
|
return Dumper(\@sorted_systems);
|
|
2971
|
} else {
|
|
2972
|
my %it = ('uuid','--','name','--', 'issystem', 1);
|
|
2973
|
push(@sorted_systems, \%it) if ($action eq 'flatlist');
|
|
2974
|
my $json_text = to_json(\@sorted_systems, {pretty => 1});
|
|
2975
|
$json_text =~ s/"false"/false/g;
|
|
2976
|
$json_text =~ s/"true"/true/g;
|
|
2977
|
# $json_text =~ s/""/"--"/g;
|
|
2978
|
$json_text =~ s/null/"--"/g;
|
|
2979
|
$json_text =~ s/\x/ /g;
|
|
2980
|
if ($action eq 'flatlist') {
|
|
2981
|
return qq|{"identifier": "uuid", "label": "name", "items": $json_text}|;
|
|
2982
|
} else {
|
|
2983
|
return $json_text;
|
|
2984
|
}
|
|
2985
|
}
|
|
2986
|
}
|
|
2987
|
|
|
2988
|
# Build a complete system around cloned image
|
|
2989
|
sub buildSystem {
|
|
2990
|
my ($name, $hmaster, $hstoragepool, $hsystem, $hinstances,
|
|
2991
|
$hnetworkuuid1, $hbschedule, $hnetworktype1, $hports, $hmemory, $hvcpu, $hdiskbus,
|
|
2992
|
$hcdrom, $hboot, $hnicmodel1, $hnicmac1, $hnetworkuuid2, $hnicmac2, $hmonitors,
|
|
2993
|
$hmanagementlink, $hstart, $duuid, $hstoragepool2, $hloader ) = @_;
|
|
2994
|
|
|
2995
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {$postreply = "Unable to access domain register"; return $postreply;};
|
|
2996
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {$postreply = "Unable to access image register"; return $postreply;};
|
|
2997
|
|
|
2998
|
my $master = $hmaster;
|
|
2999
|
|
|
3000
|
if ($curuuid && !$domreg{$curuuid} && $duuid) { # curuuid is a system uuid
|
|
3001
|
$curuuid = $duuid;
|
|
3002
|
}
|
|
3003
|
|
|
3004
|
if (!$master && $curuuid && $domreg{$curuuid} && $imagereg{$domreg{$curuuid}->{image}}) {
|
|
3005
|
$master = $imagereg{$domreg{$curuuid}->{image}}->{master};
|
|
3006
|
}
|
|
3007
|
my $cdrom = $hcdrom;
|
|
3008
|
my $storagepool = $hstoragepool;
|
|
3009
|
my $storagepool2 = $hstoragepool2 || '0';
|
|
3010
|
my $loader = $hloader || 'bios';
|
|
3011
|
my $image2;
|
|
3012
|
$hinstances = 1 unless ($hinstances);
|
|
3013
|
my $ioffset = 0;
|
|
3014
|
if (!$name && $curuuid) {
|
|
3015
|
$ioffset = 1; # Looks like we are called from an existing server - bump
|
|
3016
|
$name = $domreg{$curuuid}->{'name'};
|
|
3017
|
$name = $1 if ($name =~ /(.+)\.\d+$/);
|
|
3018
|
foreach my $dom (values %domreg) { # Sequential naming of related systems
|
|
3019
|
if ($dom->{'user'} eq $user && $dom->{'name'} =~ /$name\.(\d+)$/) {
|
|
3020
|
$ioffset = $1+1 if ($1 >= $ioffset);
|
|
3021
|
}
|
|
3022
|
}
|
|
3023
|
}
|
|
3024
|
if ($master && !$imagereg{"$master"}) {
|
|
3025
|
# Try to look up master based on file name
|
|
3026
|
my @spoolpaths = $cfg->param('STORAGE_POOLS_LOCAL_PATHS');
|
|
3027
|
my @users = ('common', $user);
|
|
3028
|
foreach my $u (@accounts) {push @users,$u;};
|
|
3029
|
# Include my sponsors master images
|
|
3030
|
my $billto = $userreg{$user}->{'billto'};
|
|
3031
|
push @users, $billto if ($billto);
|
|
3032
|
# Also include my subusers' master images
|
|
3033
|
my @userregkeys = (tied %userreg)->select_where("billto = '$user'");
|
|
3034
|
push @users, @userregkeys if (@userregkeys);
|
|
3035
|
|
|
3036
|
my $match;
|
|
3037
|
foreach my $u (@users) {
|
|
3038
|
foreach $sp (@spoolpaths) {
|
|
3039
|
if ($imagereg{"$sp/$u/$master"}) {
|
|
3040
|
$master = "$sp/$u/$master";
|
|
3041
|
$match = 1;
|
|
3042
|
last;
|
|
3043
|
}
|
|
3044
|
}
|
|
3045
|
last if ($match),
|
|
3046
|
}
|
|
3047
|
}
|
|
3048
|
|
|
3049
|
if (!$imagereg{$master} && length $master == 36) {
|
|
3050
|
# Try to look up master by uuid
|
|
3051
|
unless ( tie(%imagereg2,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {$postreply = "Unable to access image register"; return $postreply;};
|
|
3052
|
$master = $imagereg2{$master}->{'path'} if ($imagereg2{$master});
|
|
3053
|
untie %imagereg2;
|
|
3054
|
}
|
|
3055
|
|
|
3056
|
if (!$master && $curuuid) {
|
|
3057
|
$master = $imagereg{$domreg{$curuuid}->{'image'}}->{'master'};
|
|
3058
|
}
|
|
3059
|
|
|
3060
|
unless ($imagereg{$master}) {$postreply = "Status=Error Invalid master $master"; return $postreply;};
|
|
3061
|
my $masterimage2 = $imagereg{$master}->{'image2'};
|
|
3062
|
my $sysuuid = $hsystem;
|
|
3063
|
|
|
3064
|
if ($cdrom && $cdrom ne '--' && !$imagereg{"$cdrom"}) {
|
|
3065
|
# Try to look up cdrom based on file name
|
|
3066
|
my @spoolpaths = $cfg->param('STORAGE_POOLS_LOCAL_PATHS');
|
|
3067
|
my @users = ('common', $user);
|
|
3068
|
foreach my $u (@accounts) {push @users,$u;};
|
|
3069
|
my $match;
|
|
3070
|
foreach my $u (@users) {
|
|
3071
|
foreach $sp (@spoolpaths) {
|
|
3072
|
if ($imagereg{"$sp/$u/$cdrom"}) {
|
|
3073
|
$cdrom = "$sp/$u/$cdrom";
|
|
3074
|
$match = 1;
|
|
3075
|
last;
|
|
3076
|
}
|
|
3077
|
}
|
|
3078
|
last if ($match),
|
|
3079
|
}
|
|
3080
|
}
|
|
3081
|
|
|
3082
|
#open OUTPUT, '>', "/dev/null"; select OUTPUT;
|
|
3083
|
$Stabile::Images::console = 1;
|
|
3084
|
require "$Stabile::basedir/cgi/images.cgi";
|
|
3085
|
$Stabile::Networks::console = 1;
|
|
3086
|
require "$Stabile::basedir/cgi/networks.cgi";
|
|
3087
|
$Stabile::Servers::console = 1;
|
|
3088
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
3089
|
|
|
3090
|
#close(OUTPUT); select STDOUT;
|
|
3091
|
# reset stdout to be the default file handle
|
|
3092
|
my $oipath; # This var stores admin servers image, if only one server initially
|
|
3093
|
if ($sysuuid eq 'new') {
|
|
3094
|
$sysuuid = '';
|
|
3095
|
} elsif ($sysuuid eq 'auto' || (!$sysuuid && $curuuid)) { # $curuuid means request is coming from a running vm
|
|
3096
|
my $domuuid = $curuuid || Stabile::Networks::ip2domain( $ENV{'REMOTE_ADDR'} );
|
|
3097
|
if ($domuuid && $domreg{$domuuid}) {
|
|
3098
|
if ($domreg{$domuuid}->{'system'}) {
|
|
3099
|
$sysuuid = $domreg{$domuuid}->{'system'};
|
|
3100
|
} else {
|
|
3101
|
my $ug = new Data::UUID;
|
|
3102
|
$sysuuid = $ug->create_str();
|
|
3103
|
#$sysuuid = $domuuid; # Make sysuuid same as primary domains uuid
|
|
3104
|
$domreg{$domuuid}->{'system'} = $sysuuid;
|
|
3105
|
$oipath = $domreg{$domuuid}->{'image'};
|
|
3106
|
}
|
|
3107
|
} else {
|
|
3108
|
$sysuuid = '';
|
|
3109
|
}
|
|
3110
|
}
|
|
3111
|
|
|
3112
|
# Check if images should be moved to node storage
|
|
3113
|
if ($storagepool eq "-1") {
|
|
3114
|
if (index($privileges, 'n')==-1 && !$isadmin) {
|
|
3115
|
$storagepool = '';
|
|
3116
|
} else {
|
|
3117
|
$storagepool = -1;
|
|
3118
|
# %nodereg is needed in order to increment reservedvcpus for nodes
|
|
3119
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac'}, $Stabile::dbopts)) ) {$postreply = "Unable to access node register"; return $postreply;};
|
|
3120
|
}
|
|
3121
|
}
|
|
3122
|
|
|
3123
|
my @domains;
|
|
3124
|
my $systemuuid;
|
|
3125
|
for (my $i=$ioffset; $i<$hinstances+$ioffset; $i++) {
|
|
3126
|
my $ipath;
|
|
3127
|
my $mac;
|
|
3128
|
my $res;
|
|
3129
|
my $istr = ".$i";
|
|
3130
|
$istr = '' if ($hinstances==1 && $i==0);
|
|
3131
|
|
|
3132
|
# Clone image
|
|
3133
|
my $imagename = $name;
|
|
3134
|
$imagename =~ s/system/Image/i;
|
|
3135
|
$res = Stabile::Images::Clone($master, 'clone', '', $storagepool, '', "$imagename$istr", $hbschedule, 1, $hmanagementlink, $appid, 1, $hvcpu, $hmemory);
|
|
3136
|
$postreply .= $res;
|
|
3137
|
if ($res =~ /path: (.+)/) {
|
|
3138
|
$ipath = $1;
|
|
3139
|
} else {
|
|
3140
|
next;
|
|
3141
|
}
|
|
3142
|
$mac = $1 if ($res =~ /mac: (.+)/);
|
|
3143
|
Stabile::Images::updateBilling();
|
|
3144
|
|
|
3145
|
# Secondary image - clone it
|
|
3146
|
if ($masterimage2 && $masterimage2 ne '--' && $masterimage2 =~ /\.master\.qcow2$/) {
|
|
3147
|
$res = Stabile::Images::Clone($masterimage2, 'clone', '', $storagepool2, $mac, "$imagename$istr-data", $hbschedule, 1, '', '', 1);
|
|
3148
|
$postreply .= $res;
|
|
3149
|
$image2 = $1 if ($res =~ /path: (.+)/);
|
|
3150
|
}
|
|
3151
|
|
|
3152
|
# Create network
|
|
3153
|
my $networkuuid1;
|
|
3154
|
if ($hnetworkuuid1) { # An existing network was specified
|
|
3155
|
$networkuuid1 = $hnetworkuuid1;
|
|
3156
|
} else { # Create new network
|
|
3157
|
my $networkname = $name;
|
|
3158
|
$networkname =~ s/system/Connection/i;
|
|
3159
|
my $type = ($i==0)?$hnetworktype1 : '';
|
|
3160
|
if (!$type) {
|
|
3161
|
if ($curuuid && $i==0) { # This should never be true, leaving for now...
|
|
3162
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {$postreply = "Unable to access networks register"; return $postreply;};
|
|
3163
|
$type = $networkreg{$domreg{$curuuid}->{'networkuuid1'}}->{'type'};
|
|
3164
|
untie %networkreg;
|
|
3165
|
} else {
|
|
3166
|
$type = 'internalip';
|
|
3167
|
}
|
|
3168
|
}
|
|
3169
|
$main::syslogit->($user, 'info', "saving network $networkname$istr");
|
|
3170
|
$res = Stabile::Networks::save('', '', "$networkname$istr", 'new', $type, '','',$hports,1,$user);
|
|
3171
|
$postreply .= $res;
|
|
3172
|
if ($res =~ /uuid: (.+)/) {
|
|
3173
|
$networkuuid1 = $1;
|
|
3174
|
} else {
|
|
3175
|
next;
|
|
3176
|
}
|
|
3177
|
if ($hstart) {
|
|
3178
|
Stabile::Networks::Activate($networkuuid1, 'activate'); # Ugly hack, seems to be needed
|
|
3179
|
}
|
|
3180
|
}
|
|
3181
|
|
|
3182
|
# Create server
|
|
3183
|
my $servername = $name;
|
|
3184
|
$servername =~ s/system/Server/i;
|
|
3185
|
if ($curuuid) {
|
|
3186
|
$hmemory = $hmemory || $domreg{$curuuid}->{'memory'};
|
|
3187
|
$hvcpu = $hvcpu || $domreg{$curuuid}->{'vcpu'};
|
|
3188
|
$hdiskbus = $hdiskbus || $domreg{$curuuid}->{'diskbus'};
|
|
3189
|
$cdrom = $cdrom || $domreg{$curuuid}->{'cdrom'};
|
|
3190
|
$hboot = $hboot || $domreg{$curuuid}->{'boot'};
|
|
3191
|
$hnicmodel1 = $hnicmodel1 || $domreg{$curuuid}->{'nicmodel1'};
|
|
3192
|
}
|
|
3193
|
|
|
3194
|
$main::syslogit->($user, 'info', "saving server $servername$istr");
|
|
3195
|
$res = Stabile::Servers::Save('', '', {
|
|
3196
|
uuid => '',
|
|
3197
|
name => "$servername$istr",
|
|
3198
|
memory => $hmemory,
|
|
3199
|
vcpu => $hvcpu,
|
|
3200
|
image => $ipath,
|
|
3201
|
imagename => '',
|
|
3202
|
image2 => $image2,
|
|
3203
|
image2name => '',
|
|
3204
|
diskbus => $hdiskbus,
|
|
3205
|
cdrom => $cdrom,
|
|
3206
|
boot => $hboot,
|
|
3207
|
loader => $loader,
|
|
3208
|
networkuuid1 => $networkuuid1,
|
|
3209
|
networkid1 => '',
|
|
3210
|
networkname1 => '',
|
|
3211
|
nicmodel1 => $hnicmodel1,
|
|
3212
|
nicmac1 => $hnicmac1,
|
|
3213
|
nicmac2 => $hnicmac2,
|
|
3214
|
status => 'new',
|
|
3215
|
notes => $notes,
|
|
3216
|
system => $sysuuid,
|
|
3217
|
newsystem => ($hinstances>1 && !$sysuuid),
|
|
3218
|
buildsystem => 1,
|
|
3219
|
console => 1
|
|
3220
|
});
|
|
3221
|
|
|
3222
|
$postreply .= "$res\n";
|
|
3223
|
$sysuuid = $1 if ($res =~ /sysuuid: (\S+)/);
|
|
3224
|
my $serveruuid;
|
|
3225
|
$serveruuid = $1 if ($res =~ /uuid: (\S+)/);
|
|
3226
|
my $sys = $register{$sysuuid};
|
|
3227
|
if ($sysuuid && $i==$ioffset) {
|
|
3228
|
$register{$sysuuid} = {
|
|
3229
|
uuid => $sysuuid,
|
|
3230
|
name => $sys->{'name'} || $servername, #Don't rename existing system
|
|
3231
|
user => $user,
|
|
3232
|
image => $sys->{'image'} || $oipath || $ipath, #Don't update admin image for existing system
|
|
3233
|
created => $current_time
|
|
3234
|
};
|
|
3235
|
}
|
|
3236
|
|
|
3237
|
# Create monitors
|
|
3238
|
my @monitors = split(",", $hmonitors);
|
|
3239
|
if (@monitors) {
|
|
3240
|
$res = addSimpleMonitors($serveruuid, $alertemail, \@monitors);
|
|
3241
|
if ( $res eq 'OK' ) {
|
|
3242
|
`/usr/bin/moncmd reset keepstate &`;
|
|
3243
|
$postreply .= "Status=OK Saved monitors @monitors\n";
|
|
3244
|
} else {
|
|
3245
|
$postreply .= "Status=OK Not saving monitors: $res\n";
|
|
3246
|
}
|
|
3247
|
|
|
3248
|
}
|
|
3249
|
|
|
3250
|
if ($serveruuid) {
|
|
3251
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {$postreply = "Unable to access networks register"; return $postreply;};
|
|
3252
|
$networkreg{$networkuuid1}->{'domains'} = $serveruuid;
|
|
3253
|
tied(%networkreg)->commit;
|
|
3254
|
untie %networkreg;
|
|
3255
|
|
|
3256
|
push @domains, $serveruuid;
|
|
3257
|
$imagereg{$ipath}->{'domains'} = $serveruuid;
|
|
3258
|
$imagereg{$ipath}->{'domainnames'} = "$servername$istr";
|
|
3259
|
if ($storagepool == -1) {
|
|
3260
|
# my $mac = $imagereg{$ipath}->{'mac'};
|
|
3261
|
# Increment reserved vcpus in order for location of target node to spread out
|
|
3262
|
$postreply .= "Status=OK Cloned image to node $mac: $nodereg{$mac}->{'reservedvcpus'}";
|
|
3263
|
$nodereg{$mac}->{'reservedvcpus'} += $hvcpu;
|
|
3264
|
$postreply .= ":$nodereg{$mac}->{'reservedvcpus'}\n";
|
|
3265
|
tied(%nodereg)->commit;
|
|
3266
|
if (!$hstart) { # If we are not starting servers, wake up node anyway to perform clone operation
|
|
3267
|
if ($nodereg{$mac}->{'status'} eq 'asleep') {
|
|
3268
|
require "$Stabile::basedir/cgi/nodes.cgi";
|
|
3269
|
$Stabile::Nodes::console = 1;
|
|
3270
|
Stabile::Nodes::wake($mac);
|
|
3271
|
}
|
|
3272
|
}
|
|
3273
|
}
|
|
3274
|
}
|
|
3275
|
$systemuuid = (($sysuuid)? $sysuuid : $serveruuid) unless ($systemuuid);
|
|
3276
|
}
|
|
3277
|
if ($storagepool == -1) {
|
|
3278
|
untie %nodereg;
|
|
3279
|
}
|
|
3280
|
|
|
3281
|
$postreply .= "Status=OK sysuuid: $systemuuid\n" if ($systemuuid);
|
|
3282
|
if ($hstart) {
|
|
3283
|
foreach my $serveruuid (@domains) {
|
|
3284
|
$postreply .= Stabile::Servers::Start($serveruuid, 'start',{buildsystem=>1});
|
|
3285
|
}
|
|
3286
|
} else {
|
|
3287
|
$main::updateUI->({tab=>'servers', user=>$user, uuid=>$serveruuid, status=>'shutoff'});
|
|
3288
|
}
|
|
3289
|
untie %imagereg;
|
|
3290
|
#if (@domains) {
|
|
3291
|
# return to_json(\@domains, {pretty=>1});
|
|
3292
|
#} else {
|
|
3293
|
return $postreply;
|
|
3294
|
#}
|
|
3295
|
}
|
|
3296
|
|
|
3297
|
sub upgradeSystem {
|
|
3298
|
my $internalip = shift;
|
|
3299
|
|
|
3300
|
unless (tie %imagereg,'Tie::DBI', { # Needed for ValidateItem
|
|
3301
|
db=>'mysql:steamregister',
|
|
3302
|
table=>'images',
|
|
3303
|
key=>'path',
|
|
3304
|
autocommit=>0,
|
|
3305
|
CLOBBER=>3,
|
|
3306
|
user=>$dbiuser,
|
|
3307
|
password=>$dbipasswd}) {throw Error::Simple("Stroke=ERROR Image register could not be accessed")};
|
|
3308
|
|
|
3309
|
my $appid;
|
|
3310
|
my $appversion;
|
|
3311
|
my $appname;
|
|
3312
|
my $master;
|
|
3313
|
my $progress;
|
|
3314
|
my $currentversion;
|
|
3315
|
|
|
3316
|
# Locate the system we should upgrade
|
|
3317
|
if ($internalip) {
|
|
3318
|
foreach my $network (values %networkreg) {
|
|
3319
|
if ($internalip =~ /^10\.\d+\.\d+\.\d+/
|
|
3320
|
&& $network->{'internalip'} eq $internalip
|
|
3321
|
&& $network->{'user'} eq $user
|
|
3322
|
) {
|
|
3323
|
$curuuid = $domreg{$network->{'domains'}}->{'uuid'};
|
|
3324
|
$cursysuuid = $domreg{$curuuid}->{'system'};
|
|
3325
|
$master = $imagereg{$domreg{$curuuid}->{'image'}}->{'master'};
|
|
3326
|
$appid = $imagereg{$master}->{'appid'};
|
|
3327
|
$appversion = $imagereg{$master}->{'version'};
|
|
3328
|
$appname = $imagereg{$master}->{'name'};
|
|
3329
|
last;
|
|
3330
|
}
|
|
3331
|
}
|
|
3332
|
}
|
|
3333
|
# Locate the newest version of master image
|
|
3334
|
my $currentmaster;
|
|
3335
|
foreach my $imgref (values %imagereg) {
|
|
3336
|
if ($imgref->{'path'} =~ /\.master\.qcow2$/
|
|
3337
|
&& $imgref->{'path'} !~ /-data\.master\.qcow2$/
|
|
3338
|
&& $imgref->{'appid'} eq $appid
|
|
3339
|
) {
|
|
3340
|
if ($imgref->{'version'} > $currentversion) {
|
|
3341
|
$currentmaster = $imgref;
|
|
3342
|
$currentversion = $imgref->{'version'};
|
|
3343
|
}
|
|
3344
|
}
|
|
3345
|
}
|
|
3346
|
# Build list of system members
|
|
3347
|
my @doms;
|
|
3348
|
if ($cursysuuid && $register{$cursysuuid}) {
|
|
3349
|
$register{$cursysuuid}->{'status'} = 'upgrading';
|
|
3350
|
foreach my $domref (values %domreg) {
|
|
3351
|
push( @doms, $domref ) if ($domref->{'system'} eq $cursysuuid && $domref->{'user'} eq $user);
|
|
3352
|
}
|
|
3353
|
} else {
|
|
3354
|
push( @doms, $domreg{$curuuid} ) if ($domreg{$curuuid}->{'user'} eq $user);
|
|
3355
|
}
|
|
3356
|
$membs = int @doms;
|
|
3357
|
|
|
3358
|
my $problem = 0;
|
|
3359
|
foreach my $dom (@doms) {
|
|
3360
|
if ($dom->{'status'} ne 'running') {
|
|
3361
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user,
|
|
3362
|
status=>qq|Server $dom->{name} is not running. All member servers must be running when upgrading an app.|});
|
|
3363
|
$problem = 1;
|
|
3364
|
last;
|
|
3365
|
}
|
|
3366
|
}
|
|
3367
|
# First dump each servers data to nfs
|
|
3368
|
unless ($problem) {
|
|
3369
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>"Already newest version, reinstalling version $currentversion!", title=>'Reinstalling, hold on...'});
|
|
3370
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>'Beginning data dump!'});
|
|
3371
|
|
|
3372
|
my $browser = LWP::UserAgent->new;
|
|
3373
|
$browser->agent('movepiston/1.0b');
|
|
3374
|
$browser->protocols_allowed( [ 'http','https'] );
|
|
3375
|
|
|
3376
|
foreach my $dom (@doms) {
|
|
3377
|
my $upgradelink = $imagereg{$dom->{'image'}}->{'upgradelink'};
|
|
3378
|
if ($upgradelink) {
|
|
3379
|
my $res;
|
|
3380
|
my $networkuuid1 = $dom->{'networkuuid1'};
|
|
3381
|
my $ip = $networkreg{$networkuuid1}->{'internalip'};
|
|
3382
|
$upgradelink = "http://internalip$upgradelink" unless ($upgradelink =~ s/\{internalip\}/$ip/);
|
|
3383
|
$domreg{$dom->{'uuid'}}->{'status'} = 'upgrading';
|
|
3384
|
$main::updateUI->({tab=>'servers', user=>$user, uuid=>$dom->{'uuid'}, status=>'upgrading'});
|
|
3385
|
my $content = $browser->get($upgradelink)->content();
|
|
3386
|
if ($content =~ /^\{/) { # Looks like json
|
|
3387
|
$jres = from_json($content);
|
|
3388
|
$res = $jres->{'message'};
|
|
3389
|
unless (lc $jres->{'status'} eq 'ok') {
|
|
3390
|
$problem = 2;
|
|
3391
|
}
|
|
3392
|
} else { # no json returned, assume things went hayward
|
|
3393
|
$res = $content;
|
|
3394
|
$res =~ s/</</g;
|
|
3395
|
$res =~ s/>/>/g;
|
|
3396
|
$problem = "Data dump failed ($upgradelink)";
|
|
3397
|
}
|
|
3398
|
$res =~ s/\n/ /;
|
|
3399
|
$progress += 10;
|
|
3400
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>"$ip: $res", progress=>$progress});
|
|
3401
|
}
|
|
3402
|
}
|
|
3403
|
}
|
|
3404
|
tied(%domreg)->commit;
|
|
3405
|
|
|
3406
|
# Shut down all servers
|
|
3407
|
unless ($problem) {
|
|
3408
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>'Beginning shutdown of servers!'});
|
|
3409
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
3410
|
$Stabile::Servers::console = 1;
|
|
3411
|
foreach my $dom (@doms) {
|
|
3412
|
$progress += 10;
|
|
3413
|
my $networkuuid1 = $dom->{'networkuuid1'};
|
|
3414
|
my $ip = $networkreg{$networkuuid1}->{'internalip'};
|
|
3415
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>"$ip: Shutting down...", progress=>$progress});
|
|
3416
|
if ($dom->{'status'} eq 'shutoff' || $dom->{'status'} eq 'inactive') {
|
|
3417
|
next;
|
|
3418
|
} else {
|
|
3419
|
my $res = Stabile::Servers::destroyUserServers($user, 1, $dom->{'uuid'});
|
|
3420
|
if ($dom->{'status'} ne 'shutoff' && $dom->{'status'} ne 'inactive') {
|
|
3421
|
$problem = "ERROR $res"; # We could not shut down a server, fail...
|
|
3422
|
last;
|
|
3423
|
}
|
|
3424
|
}
|
|
3425
|
}
|
|
3426
|
}
|
|
3427
|
# Then replace each image with new version
|
|
3428
|
unless ($problem) {
|
|
3429
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>'Attaching new images!'});
|
|
3430
|
require "$Stabile::basedir/cgi/images.cgi";
|
|
3431
|
$Stabile::Images::console = 1;
|
|
3432
|
foreach my $dom (@doms) {
|
|
3433
|
$progress += 10;
|
|
3434
|
my $networkuuid1 = $dom->{'networkuuid1'};
|
|
3435
|
my $ip = $networkreg{$networkuuid1}->{'internalip'};
|
|
3436
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>"$ip: Attaching image...", progress=>$progress});
|
|
3437
|
my $image = $imagereg{$dom->{'image'}};
|
|
3438
|
my $ipath;
|
|
3439
|
# Clone image
|
|
3440
|
my $imagename = $image->{'name'};
|
|
3441
|
my $res = Stabile::Images::Clone($currentmaster->{'path'}, 'clone', '', $image->{'storagepool'}, '', $imagename, $image->{'bschedule'}, 1, $currentmaster->{'managementlink'}, $appid, 1);
|
|
3442
|
$postreply .= $res;
|
|
3443
|
if ($res =~ /path: (.+)/) {
|
|
3444
|
$ipath = $1;
|
|
3445
|
} else {
|
|
3446
|
$problem = 5;
|
|
3447
|
}
|
|
3448
|
|
|
3449
|
if ($ipath =~ /\.qcow2$/) {
|
|
3450
|
Stabile::Images::updateBilling();
|
|
3451
|
# Attach new image to server
|
|
3452
|
$main::syslogit->($user, 'info', "attaching new image to server $dom->{'name'} ($dom->{'uuid'})");
|
|
3453
|
$res = Stabile::Servers::Save({
|
|
3454
|
uuid => $dom->{'uuid'},
|
|
3455
|
image => $ipath,
|
|
3456
|
imagename => $imagename,
|
|
3457
|
});
|
|
3458
|
# Update systems admin image
|
|
3459
|
$register{$cursysuuid}->{'image'} = $ipath if ($register{$cursysuuid} && $dom->{'uuid'} eq $curuuid);
|
|
3460
|
# Update image properties
|
|
3461
|
$imagereg{$ipath}->{'domains'} = $dom->{'uuid'};
|
|
3462
|
$imagereg{$ipath}->{'domainnames'} = $dom->{'name'};
|
|
3463
|
} else {
|
|
3464
|
$problem = 6;
|
|
3465
|
}
|
|
3466
|
}
|
|
3467
|
}
|
|
3468
|
|
|
3469
|
# Finally start all servers with new image
|
|
3470
|
unless ($problem) {
|
|
3471
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>'Starting servers!'});
|
|
3472
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
3473
|
$Stabile::Servers::console = 1;
|
|
3474
|
foreach my $dom (@doms) {
|
|
3475
|
$progress += 10;
|
|
3476
|
my $networkuuid1 = $dom->{'networkuuid1'};
|
|
3477
|
my $ip = $networkreg{$networkuuid1}->{'internalip'};
|
|
3478
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, status=>"$ip: Starting...", progress=>$progress});
|
|
3479
|
if ($dom->{'status'} eq 'shutoff' || $dom->{'status'} eq 'inactive') {
|
|
3480
|
Stabile::Servers::Start($dom->{'uuid'}, 'start', {uistatus=>'upgrading'});
|
|
3481
|
$main::updateUI->({ tab=>'servers',
|
|
3482
|
user=>$user,
|
|
3483
|
uuid=>$dom->{'uuid'},
|
|
3484
|
status=>'upgrading'})
|
|
3485
|
}
|
|
3486
|
}
|
|
3487
|
} else {
|
|
3488
|
foreach my $dom (@doms) {
|
|
3489
|
$dom->{'status'} = 'inactive'; # Prevent servers from being stuck in upgrading status
|
|
3490
|
}
|
|
3491
|
}
|
|
3492
|
|
|
3493
|
my $nlink = $imagereg{$doms[0]->{'image'}}->{'managementlink'}; # There might be a new managementlink for image
|
|
3494
|
my $nuuid = $doms[0]->{'networkuuid1'};
|
|
3495
|
$nlink =~ s/\{uuid\}/$nuuid/;
|
|
3496
|
|
|
3497
|
unless ($problem) {
|
|
3498
|
# All servers successfully upgraded
|
|
3499
|
my $status = qq|Your $appname app has exported its data and new images have been attached to your servers. Now, your app will start again and import your data.|;
|
|
3500
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, progress=>100, status=>$status, managementlink=>$nlink, message=>"All done!"});
|
|
3501
|
} else {
|
|
3502
|
my $status = qq|Problem: $problem encountered. Your $appname could not be upgraded to the version $appversion. You can try again, or contact the app developer if this fails.|;
|
|
3503
|
$main::updateUI->({tab=>'upgrade', type=>'update', user=>$user, progress=>100, status=>$status, managementlink=>$nlink, message=>"Something went wrong :("});
|
|
3504
|
}
|
|
3505
|
untie %imagereg;
|
|
3506
|
|
|
3507
|
my $reply = qq|{"message": "Upgrading $domreg{$curuuid}->{name} with $membs members"}|;
|
|
3508
|
return "$reply\n";
|
|
3509
|
}
|
|
3510
|
|
|
3511
|
sub removeusersystems {
|
|
3512
|
my $username = shift;
|
|
3513
|
return $postreply unless (($isadmin || $user eq $username) && !$isreadonly);
|
|
3514
|
$user = $username;
|
|
3515
|
my @allsystems = getSystemsListing('removeusersystems');
|
|
3516
|
foreach my $sys (@allsystems) {
|
|
3517
|
next unless $sys->{'uuid'};
|
|
3518
|
# $postreply .= "Status=OK Removing $username system $sys->{'name'} ($sys->{'uuid'})\n";
|
|
3519
|
remove($sys->{'uuid'}, $sys->{'issystem'}, 1);
|
|
3520
|
}
|
|
3521
|
return $postreply || "[]";
|
|
3522
|
}
|
|
3523
|
|
|
3524
|
|
|
3525
|
# Remove every trace of a system including servers, images, etc.
|
|
3526
|
sub remove {
|
|
3527
|
my ($uuid, $issystem, $destroy) = @_;
|
|
3528
|
my $sysuuid = $uuid;
|
|
3529
|
my $reguser = $register{$uuid}->{'user'} if ($register{$uuid});
|
|
3530
|
$reguser = $domreg{$uuid}->{'user'} if (!$reguser && $domreg{$uuid});
|
|
3531
|
|
|
3532
|
$Stabile::Images::user = $user;
|
|
3533
|
require "$Stabile::basedir/cgi/images.cgi";
|
|
3534
|
$Stabile::Images::console = 1;
|
|
3535
|
|
|
3536
|
$Stabile::Networks::user = $user;
|
|
3537
|
require "$Stabile::basedir/cgi/networks.cgi";
|
|
3538
|
$Stabile::Networks::console = 1;
|
|
3539
|
|
|
3540
|
$Stabile::Servers::user = $user;
|
|
3541
|
require "$Stabile::basedir/cgi/servers.cgi";
|
|
3542
|
$Stabile::Servers::console = 1;
|
|
3543
|
|
|
3544
|
$issystem = 1 if ($register{$uuid});
|
|
3545
|
my @domains;
|
|
3546
|
my $res;
|
|
3547
|
|
|
3548
|
if ($issystem) {
|
|
3549
|
# Delete child servers
|
|
3550
|
if (($user eq $reguser || $isadmin) && $register{$uuid}){ # Existing system
|
|
3551
|
# First delete any linked networks
|
|
3552
|
if ($register{$uuid}->{'networkuuids'} && $register{$uuid}->{'networkuuids'} ne '--') {
|
|
3553
|
my @lnetworks = split /, ?/, $register{$uuid}->{'networkuuids'};
|
|
3554
|
foreach my $networkuuid (@lnetworks) {
|
|
3555
|
if ($networkuuid) {
|
|
3556
|
Stabile::Networks::Deactivate($networkuuid);
|
|
3557
|
$res .= Stabile::Networks::Remove($networkuuid, 'remove', {force=>1});
|
|
3558
|
}
|
|
3559
|
}
|
|
3560
|
}
|
|
3561
|
foreach my $domvalref (values %domreg) {
|
|
3562
|
if ($domvalref->{'system'} eq $uuid && ($domvalref->{'user'} eq $user || $isadmin)) {
|
|
3563
|
if ($domvalref->{'status'} eq 'shutoff' || $domvalref->{'status'} eq 'inactive') {
|
|
3564
|
push @domains, $domvalref->{'uuid'};
|
|
3565
|
} elsif ($destroy) {
|
|
3566
|
Stabile::Servers::destroyUserServers($reguser, 1, $domvalref->{'uuid'});
|
|
3567
|
push @domains, $domvalref->{'uuid'} if ($domvalref->{'status'} eq 'shutoff' || $domvalref->{'status'} eq 'inactive');
|
|
3568
|
}
|
|
3569
|
}
|
|
3570
|
}
|
|
3571
|
}
|
|
3572
|
$postreply .= "Status=removing OK Removing system $register{$uuid}->{'name'} ($uuid)\n";
|
|
3573
|
delete $register{$uuid};
|
|
3574
|
tied(%register)->commit;
|
|
3575
|
} elsif ($domreg{$uuid} && $domreg{$uuid}->{uuid}) {
|
|
3576
|
# Delete single server
|
|
3577
|
if ($domreg{$uuid}->{'status'} eq 'shutoff' || $domreg{$uuid}->{'status'} eq 'inactive') {
|
|
3578
|
push @domains, $uuid;
|
|
3579
|
} elsif ($destroy) {
|
|
3580
|
Stabile::Servers::destroyUserServers($reguser, 1, $uuid);
|
|
3581
|
push @domains, $uuid if ($domreg{$uuid}->{'status'} eq 'shutoff' || $domreg{$uuid}->{'status'} eq 'inactive');
|
|
3582
|
}
|
|
3583
|
# $postreply .= "Status=OK Removing server $domreg{$uuid}->{'name'} ($uuid)\n";
|
|
3584
|
} else {
|
|
3585
|
$postreply .= "Status=Error System $uuid not found\n";
|
|
3586
|
return $postreply;
|
|
3587
|
}
|
|
3588
|
my $duuid;
|
|
3589
|
foreach my $domuuid (@domains) {
|
|
3590
|
if ($domreg{$domuuid}->{'status'} ne 'shutoff' && $domreg{$domuuid}->{'status'} ne 'inactive' ) {
|
|
3591
|
$postreply .= "Status=ERROR Cannot delete server (active)\n";
|
|
3592
|
} else {
|
|
3593
|
my $imagepath = $domreg{$domuuid}->{'image'};
|
|
3594
|
my $image2path = $domreg{$domuuid}->{'image2'};
|
|
3595
|
my $networkuuid1 = $domreg{$domuuid}->{'networkuuid1'};
|
|
3596
|
my $networkuuid2 = $domreg{$domuuid}->{'networkuuid2'};
|
|
3597
|
|
|
3598
|
# Delete packages from software register
|
|
3599
|
# $postreply .= deletePackages($domuuid);
|
|
3600
|
# Delete monitors
|
|
3601
|
# $postreply .= deleteMonitors($domuuid)?"Stream=OK Deleted monitors for $domreg{$domuuid}->{'name'}\n":"Stream=OK No monitors to delete for $domreg{$domuuid}->{'name'}\n";
|
|
3602
|
# Delete server
|
|
3603
|
$res .= Stabile::Servers::Remove($domuuid);
|
|
3604
|
|
|
3605
|
# Delete images
|
|
3606
|
$res .= Stabile::Images::Remove($imagepath);
|
|
3607
|
if ($image2path && $image2path ne '--') {
|
|
3608
|
$res .= Stabile::Images::Remove($image2path);
|
|
3609
|
}
|
|
3610
|
# Delete networks
|
|
3611
|
if ($networkuuid1 && $networkuuid1 ne '--' && $networkuuid1 ne '0' && $networkuuid1 ne '1') {
|
|
3612
|
Stabile::Networks::Deactivate($networkuuid1);
|
|
3613
|
$res .= Stabile::Networks::Remove($networkuuid1);
|
|
3614
|
}
|
|
3615
|
if ($networkuuid2 && $networkuuid2 ne '--' && $networkuuid2 ne '0' && $networkuuid2 ne '1') {
|
|
3616
|
Stabile::Networks::Deactivate($networkuuid2);
|
|
3617
|
$res .= Stabile::Networks::Remove($networkuuid2);
|
|
3618
|
}
|
|
3619
|
}
|
|
3620
|
$duuid = $domuuid;
|
|
3621
|
}
|
|
3622
|
if ($register{$uuid}) {
|
|
3623
|
delete $register{$uuid};
|
|
3624
|
tied(%register)->commit;
|
|
3625
|
}
|
|
3626
|
if (@domains) {
|
|
3627
|
$main::updateUI->(
|
|
3628
|
{tab=>'servers',
|
|
3629
|
user=>$user,
|
|
3630
|
type=>'update',
|
|
3631
|
message=>((scalar @domains==1)?"Server has been removed":"Stack has been removed!")
|
|
3632
|
},
|
|
3633
|
{tab=>'images',
|
|
3634
|
user=>$user
|
|
3635
|
},
|
|
3636
|
{tab=>'networks',
|
|
3637
|
user=>$user
|
|
3638
|
},
|
|
3639
|
{tab=>'home',
|
|
3640
|
user=>$user,
|
|
3641
|
type=>'removal',
|
|
3642
|
uuid=>$uuid,
|
|
3643
|
domuuid=>$duuid
|
|
3644
|
}
|
|
3645
|
);
|
|
3646
|
} else {
|
|
3647
|
$main::updateUI->(
|
|
3648
|
{tab=>'servers',
|
|
3649
|
user=>$user,
|
|
3650
|
type=>'update',
|
|
3651
|
message=>"Nothing to remove!"
|
|
3652
|
}
|
|
3653
|
);
|
|
3654
|
}
|
|
3655
|
|
|
3656
|
if ($engineid && $enginelinked) {
|
|
3657
|
# Remove domain from origo.io
|
|
3658
|
my $json_text = qq|{"uuid": "$sysuuid" , "status": "delete"}|;
|
|
3659
|
$main::postAsyncToOrigo->($engineid, 'updateapps', "[$json_text]");
|
|
3660
|
}
|
|
3661
|
return $postreply || qq|Content-type: application/json\n\n|;
|
|
3662
|
}
|
|
3663
|
|
|
3664
|
sub getPackages {
|
|
3665
|
my $curimg = shift;
|
|
3666
|
|
|
3667
|
unless (tie %imagereg,'Tie::DBI', { # Needed for ValidateItem
|
|
3668
|
db=>'mysql:steamregister',
|
|
3669
|
table=>'images',
|
|
3670
|
key=>'path',
|
|
3671
|
autocommit=>0,
|
|
3672
|
CLOBBER=>0,
|
|
3673
|
user=>$dbiuser,
|
|
3674
|
password=>$dbipasswd}) {throw Error::Simple("Stroke=ERROR Image register could not be accessed")};
|
|
3675
|
|
|
3676
|
my $mac = $imagereg{$curimg}->{'mac'};
|
|
3677
|
untie %imagereg;
|
|
3678
|
|
|
3679
|
my $macip;
|
|
3680
|
if ($mac && $mac ne '--') {
|
|
3681
|
unless (tie %nodereg,'Tie::DBI', {
|
|
3682
|
db=>'mysql:steamregister',
|
|
3683
|
table=>'nodes',
|
|
3684
|
key=>'mac',
|
|
3685
|
autocommit=>0,
|
|
3686
|
CLOBBER=>1,
|
|
3687
|
user=>$dbiuser,
|
|
3688
|
password=>$dbipasswd}) {return 0};
|
|
3689
|
$macip = $nodereg{$mac}->{'ip'};
|
|
3690
|
untie %nodereg;
|
|
3691
|
}
|
|
3692
|
$curimg =~ /(.+)/; $curimg = $1;
|
|
3693
|
my $sshcmd;
|
|
3694
|
if ($macip && $macip ne '--') {
|
|
3695
|
$sshcmd = "/usr/bin/ssh -q -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no $macip";
|
|
3696
|
}
|
|
3697
|
my $apps;
|
|
3698
|
|
|
3699
|
if ($sshcmd) {
|
|
3700
|
my $cmd = qq[eval \$(/usr/bin/guestfish --ro -a "$curimg" --i --listen); ]; # sets $GUESTFISH_PID shell var
|
|
3701
|
$cmd .= qq[root="\$(/usr/bin/guestfish --remote inspect-get-roots)"; ];
|
|
3702
|
$cmd .= qq[guestfish --remote inspect-get-product-name "\$root"; ];
|
|
3703
|
$cmd .= qq[guestfish --remote inspect-get-hostname "\$root"; ];
|
|
3704
|
$cmd .= qq[guestfish --remote inspect-list-applications "\$root"; ];
|
|
3705
|
$cmd .= qq[guestfish --remote exit];
|
|
3706
|
$cmd = "$sshcmd '$cmd'";
|
|
3707
|
$apps = `$cmd`;
|
|
3708
|
} else {
|
|
3709
|
my $cmd;
|
|
3710
|
# my $pid = open my $cmdpipe, "-|",qq[/usr/bin/guestfish --ro -a "$curimg" --i --listen];
|
|
3711
|
$cmd .= qq[eval \$(/usr/bin/guestfish --ro -a "$curimg" --i --listen); ];
|
|
3712
|
# Start listening guestfish
|
|
3713
|
my $daemon = Proc::Daemon->new(
|
|
3714
|
work_dir => '/usr/local/bin',
|
|
3715
|
setuid => 'www-data',
|
|
3716
|
exec_command => $cmd
|
|
3717
|
) or do {$posterror .= "Stream=ERROR $@\n";};
|
|
3718
|
my $pid = $daemon->Init();
|
|
3719
|
while ($daemon->Status($pid)) {
|
|
3720
|
sleep 1;
|
|
3721
|
}
|
|
3722
|
# Find pid of the listening guestfish
|
|
3723
|
my $pid2;
|
|
3724
|
my $t = new Proc::ProcessTable;
|
|
3725
|
foreach $p ( @{$t->table} ){
|
|
3726
|
my $pcmd = $p->cmndline;
|
|
3727
|
if ($pcmd =~ /guestfish.+$curimg/) {
|
|
3728
|
$pid2 = $p->pid;
|
|
3729
|
last;
|
|
3730
|
}
|
|
3731
|
}
|
|
3732
|
my $cmd2;
|
|
3733
|
if ($pid2) {
|
|
3734
|
$cmd2 .= qq[root="\$(/usr/bin/guestfish --remote=$pid2 inspect-get-roots)"; ];
|
|
3735
|
$cmd2 .= qq[guestfish --remote=$pid2 inspect-get-product-name "\$root"; ];
|
|
3736
|
$cmd2 .= qq[guestfish --remote=$pid2 inspect-get-hostname "\$root"; ];
|
|
3737
|
$cmd2 .= qq[guestfish --remote=$pid2 inspect-list-applications "\$root"; ];
|
|
3738
|
$cmd2 .= qq[guestfish --remote=$pid2 exit];
|
|
3739
|
}
|
|
3740
|
$apps = `$cmd2`;
|
|
3741
|
$apps .= $cmd2;
|
|
3742
|
}
|
|
3743
|
return $apps;
|
|
3744
|
}
|