Project

General

Profile

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