Origo OS

#!/usr/bin/perl

# All rights reserved and Copyright (c) 2020 Origo Systems ApS.

# This file is provided with no warranty, and is subject to the terms and conditions defined in the license file LICENSE.md.

# The license file is part of this source code package and its content is also available at:

# https://www.origo.io/info/stabiledocs/licensing/stabile-open-source-license

package Stabile::Systems;

use Webmin::API;

use File::Basename;

use lib dirname (__FILE__);

use Stabile;

use Error qw(:try);

use String::Escape qw( unbackslash backslash );

use Config::Simple;

use Time::Local;

use Mon::Client;

use File::Glob qw(bsd_glob);

use POSIX;

use Proc::Daemon;

use Data::UUID;

use LWP::Simple qw(!head);

use MIME::Lite;

use RRDTool::OO;

use Text::CSV_XS qw( csv );

use Geo::IP;

my $cfg = new Config::Simple("/etc/stabile/config.cfg");

my $engineid = $Stabile::config->get('ENGINEID') || "";

my $enginename = $Stabile::config->get('ENGINENAME') || "";

my $doxmpp = $Stabile::config->get('DO_XMPP') || "";

my $disablesnat = $Stabile::config->get('DISABLE_SNAT') || "";

my ($datanic, $extnic) = $main::getNics->();

my $extiprangestart = $Stabile::config->get('EXTERNAL_IP_RANGE_START');

my $extiprangeend = $Stabile::config->get('EXTERNAL_IP_RANGE_END');

if (!$Stabile::Servers::q && !$Stabile::Images::q  && !$Stabile::Networks::q && !$Stabile::Users::q && !$Stabile::Nodes::q) { # We are not being called from another script

    $q = new CGI;

    my %cgiparams = $q->Vars;

    %params = %cgiparams if (%cgiparams);

} else {

    $console = 1;

}

my %ahash; # A hash of accounts and associated privileges current user has access to

$uiuuid;

$uistatus;

$help = 0; # If this is set, functions output help

our %ahash; # A hash of accounts and associated privileges current user has access to

#our %options=();

# -a action -h help -u uuid -m match pattern -f full list, i.e. all users

# -v verbose, include HTTP headers -s impersonate subaccount -t target [uuid or image]

# -g args to gearman task

#Getopt::Std::getopts("a:hfu:g:m:vs:t:", \%options);

try {

    Init(); # Perform various initalization tasks

    process() if ($package);

} catch Error with {

	my $ex = shift;

    print header('text/html', '500 Internal Server Error') unless ($console);

	if ($ex->{-text}) {

        print "Got error $package: ", $ex->{-text}, " on line ", $ex->{-line}, "\n";

	} else {

	    print "Status=ERROR\n";

	}

} finally {

};

1;

sub getObj {

    my %h = %{@_[0]};

    $console = 1 if $obj->{"console"};

    my $obj;

    $action =  $action || $h{'action'};

    if ($action =~ /updateaccountinfo|monitors|listuptime|buildsystem|removeusersystems|updateengineinfo|^register$|^packages$/) {

        $obj = \%h;

        $obj->{domuuid} = $curdomuuid if ($curdomuuid);

    } else {

        my $uuid =$h{"uuid"} || $curuuid;

        $uuid = $curuuid if ($uuid eq 'this');

        my $status = $h{"status"};

        if ((!$uuid && $uuid ne '0') && (!$status || $status eq 'new')) {

            my $ug = new Data::UUID;

            $uuid = $ug->create_str();

            $status = 'new';

        };

        return 0 unless ($uuid && length $uuid == 36);

        $obj = {uuid => $uuid};

        my @props = qw(uuid name memory vcpu  user  notes  created  opemail  opfullname  opphone  email  fullname  phone  services

            recovery  alertemail  image  networkuuid1  internalip autostart issystem system systemstatus from to

            appid callback installsystem installaccount networkuuids ports);

        if ($register{$uuid}) {

            foreach my $prop (@props) {

                my $val = $h{$prop} || $register{$uuid}->{$prop};

                $obj->{$prop} = $val if ($val);

            }

        } else {

            foreach my $prop (@props) {

                my $val = $h{$prop};

                $obj->{$prop} = $val if ($val);

            }

        }

    }

    return $obj;

}

sub Init {

    unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {$posterror = "Unable to access user register"; return;};

    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {$posterror = "Unable to access domain register"; return;};

    unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {$posterror = "Unable to access network register"; return;};

    unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$posterror = "Unable to access system register"; return;};

    $cursysuuid = $domreg{$curuuid}->{'system'}if ($domreg{$curuuid});

    $tktuser = $tktuser || $Stabile::tktuser;

    $user = $user || $Stabile::user;

    *Deletesystem = \&Removesystem;

    *Backup = \&systemAction;

    *do_help = \&action;

    *do_tablelist = \&do_list;

    *do_arraylist = \&do_list;

    *do_flatlist = \&do_list;

    *do_monitors = \&privileged_action;

    *do_suspend = \&systemAction;

    *do_resume = \&systemAction;

    *do_shutdown = \&systemAction;

    *do_destroy = \&systemAction;

    *do_start = \&systemAction;

    *do_backup = \&privileged_action;

    *do_packages_load = \&privileged_action;

    *do_monitors_save = \&privileged_action;

    *do_monitors_remove = \&privileged_action;

    *do_monitors_enable = \&privileged_action;

    *do_monitors_disable = \&privileged_action;

    *do_monitors_acknowledge = \&privileged_action;

    *do_save = \&privileged_action;

    *do_changemonitoremail = \&privileged_action;

    *do_buildsystem = \&privileged_action;

    *do_removesystem = \&privileged_action;

    *do_deletesystem = \&privileged_action;

    *do_removeusersystems = \&privileged_action;

    *do_updateengineinfo = \&privileged_action;

    *do_gear_backup = \&do_gear_action;

    *do_gear_packages_load = \&do_gear_action;

    *do_gear_monitors = \&do_gear_action;

    *do_gear_monitors_enable = \&do_gear_action;

    *do_gear_monitors_save = \&do_gear_action;

    *do_gear_monitors_remove = \&do_gear_action;

    *do_gear_monitors_disable = \&do_gear_action;

    *do_gear_monitors_acknowledge = \&do_gear_action;

    *do_gear_save = \&do_gear_action;

    *do_gear_changemonitoremail = \&do_gear_action;

    *do_gear_buildsystem = \&do_gear_action;

    *do_gear_removesystem = \&do_gear_action;

    *do_gear_deletesystem = \&do_gear_action;

    *do_gear_removeusersystems = \&do_gear_action;

    *do_gear_updateengineinfo = \&do_gear_action;

    *Monitors_remove = \&Monitors_save;

    *Monitors_enable = \&Monitors_action;

    *Monitors_disable = \&Monitors_action;

    *Monitors_acknowledge = \&Monitors_action;

}

sub do_uuidlookup {

    if ($help) {

        return <<END

GET:uuid:

Simple action for looking up a uuid or part of a uuid and returning the complete uuid.

END

    }

    my $res;

    $res .= header('text/plain') unless $console;

    my $u = $options{u};

    $u = $curuuid unless ($u || $u eq '0');

    my $ruuid;

    if ($u || $u eq '0') {

        my $match;

        foreach my $uuid (keys %register) {

            if ($uuid =~ /^$u/) {

                $ruuid = $uuid if ($register{$uuid}->{'user'} eq $user || index($privileges,"a")!=-1);

                $match = 1;

                last;

            }

        }

        unless ($match) {

            foreach my $uuid (keys %domreg) {

                if ($uuid =~ /^$u/) {

                    $ruuid = $uuid if ((!$domreg{$uuid}->{'system'} || $domreg{$uuid}->{'system'} eq '--' )&&  ($domreg{$uuid}->{'user'} eq $user || index($privileges,"a")!=-1));

                    last;

                }

            }

        }

    }

    $res .= "$ruuid\n" if ($ruuid);

    return $res;

}

sub do_uuidshow {

    if ($help) {

        return <<END

GET:uuid:

Simple action for showing a single system.

END

    }

    my $res;

    $res .= header('application/json') unless $console;

    my $u = $options{u};

    $u = $curuuid unless ($u || $u eq '0');

    if ($u) {

        foreach my $uuid (keys %register) {

            if (($register{$uuid}->{'user'} eq $user || $register{$uuid}->{'user'} eq 'common' || index($privileges,"a")!=-1)

                && $uuid =~ /^$u/) {

                my %hash = %{$register{$uuid}};

                delete $hash{'action'};

                delete $hash{'nextid'};

                my $dump = to_json(\%hash, {pretty=>1});

                $dump =~ s/undef/"--"/g;

                $res .= $dump;

                last;

            }

        }

    }

    return $res;

}

sub do_list {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:uuid:

List systems current user has access to.

END

    }

    my $sysuuid;

    if ($uripath =~ /systems(\.cgi)?\/(\?|)(this)/) {

        $sysuuid = $cursysuuid || $curuuid;

    } elsif ($uripath =~ /systems(\.cgi)?\/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/) {

        $sysuuid = $2;

    } elsif ($params{'system'}) {

        $sysuuid = $obj->{'system'};

        $sysuuid = $cursysuuid || $curuuid if ($obj->{system} eq 'this');

    }

    $postreply = getSystemsListing($action, $uuid);

    return $postreply;

}

sub Monitors_action {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:id:

Enable, disable or acknowledge a monitor. Id is of the form serveruuid:service

END

    }

    my $monitor_action = "enable";

    $monitor_action = "disable" if ($action eq 'monitors_disable');

    $monitor_action = "acknowledge" if ($action eq 'monitors_acknowledge');

    my $log_action = uc $monitor_action;

    my $group;

    my $service;

    my $logline;

    if ($uuid =~ /(.+):(.+)/) {

        $group = $1;

        $service = $2;

    }

    if ($group && $service) {

        my $reguser = $domreg{$group}->{'user'};

        # Security check

        if ($user eq $reguser || index($privileges,"a")!=-1) {

            my $oplogfile = "/var/log/stabile/$year-$month:$group:$service";

            unless (-e $oplogfile) {

                `/usr/bin/touch "$oplogfile"`;

                `/bin/chown mon:mon "$oplogfile"`;

            }

            if ($monitor_action =~ /enable|disable/) {

                my $res = `/usr/bin/moncmd $monitor_action service $group $service`;

                chomp $res;

                $logline = "$current_time, $log_action, , $pretty_time";

            } elsif ($monitor_action eq "acknowledge") {

                my $ackcomment = $obj->{"ackcomment"};

                # my $ackcomment = backslash( $obj->{"ackcomment"} );

                #$ackcomment =~ s/ /\\\20/g;

                my $monc = new Mon::Client (

                    host => "127.0.0.1"

                );

                $ackcomment = ($ackcomment)?"$user, $ackcomment":$user;

                $monc->connect();

                $monc->ack($group, $service, $ackcomment);

                $monc->disconnect();

                $logline = "$current_time, ACKNOWLEDGE, $ackcomment, $pretty_time";

                my %emails;

                my @emaillist = split(/\n/, `/bin/cat /etc/mon/mon.cf`);

                my $emailuuid;

                foreach my $eline (@emaillist) {

                    my ($a, $b, $c, $d) = split(/ +/, $eline);

                    if ($a eq 'watch') {

                        if ($b =~ /\S+-\S+-\S+-\S+-\S+/) {$emailuuid = $b;}

                        else {$emailuuid = ''};

                    }

                    $emails{$emailuuid} = $d if ($emailuuid && $b eq 'alert' && $c eq 'stabile.alert');

                };

                my $email = $emails{$group};

                my $servername = $domreg{$group}->{'name'};

                my $serveruser = $domreg{$group}->{'user'};

                if ($email) {

                    my $mailtext = <<EOF;

Acknowledged by: $user

Server name: $servername

Server UUID: $group

System UUID: $sysuuid

Server user: $serveruser

Service: $service

EOF

                    ;

                    my $mailhtml = <<END;

<!DOCTYPE html

    PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"

     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">

    <head>

        <title>Problems with $servername:$service are being handled</title>

        <meta http-equiv="Pragma" content="no-cache" />

		<link rel="stylesheet" type="text/css" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/css/bootstrap.min.css" />

        <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />

    </head>

    <body class="tundra">

        <div>

            <div class="well" style="margin:20px;">

                <h3 style="color: #2980b9!important; margin-bottom:30px;">Relax, the problems with your service are being handled!</h3>

                <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>

                <br>

                <div>Thanks,<br>your friendly monitoring daemon</div>

            </div>

        </div>

    </body>

</html>

END

                    ;

                    my $xmpptext = "ACK: $servername:$service is being handled ($pretty_time)\n";

                    $xmpptext .= "Acknowledged by: $tktuser ($user)\n";

                    my $msg = MIME::Lite->new(

                        From     => 'monitoring',

                        To       => $email,

                        Type     => 'multipart/alternative',

                        Subject  => "ACK: $servername:$service is being handled ($pretty_time)",

                    );

                    $msg->add("sysuuid" => $sysuuid);

                    my $att_text = MIME::Lite->new(

                        Type     => 'text',

                        Data     => $mailtext,

                        Encoding => 'quoted-printable',

                    );

                    $att_text->attr('content-type'

                        => 'text/plain; charset=UTF-8');

                    $msg->attach($att_text);

                    my $att_html = MIME::Lite->new(

                        Type     => 'text',

                        Data     => $mailhtml,

                        Encoding => 'quoted-printable',

                    );

                    $att_html->attr('content-type'

                        => 'text/html; charset=UTF-8');

                    $msg->attach($att_html);

                    $msg->send;

                    if ($doxmpp) {

                        foreach my $to (split /, */, $email) {

                            my $xres = $main::xmppSend->($to, $xmpptext, $engineid, $sysuuid);

                        }

                        # Send alerts to Origo operators on duty

                        my $oponduty = 'operator@sa.origo.io';

                        $msg->replace('to', $oponduty);

                        $msg->send;

                        my $xres = $main::xmppSend->($oponduty, $xmpptext, $engineid, $sysuuid);

                    }

                }

            }

            `/bin/echo >> $oplogfile "$logline"`;

            $postreply .= "Status=OK OK $monitor_action"." $service service\n";

        }

    } else {

        $postreply = "Status=Error problem $monitor_action monitor $uuid\n";

    }

    return $postreply;

}

sub do_register {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:uuid,format:

Print software register for server or system of servers with given uuid. Format is html, csv or json (default).

END

    }

    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};

    my @domregvalues = values %domreg;

    my %reghash;

    foreach my $valref (@domregvalues) {

        if ($valref->{'user'} eq $user || $fulllist) {

            if (!$uuid || $uuid eq '*' || $uuid eq $valref->{'uuid'} || $uuid eq $valref->{'system'}) {

                my $os = $valref->{'os'} || 'unknown';

                my $domname = $valref->{'name'};

                utf8::decode($domname);

                if ($reghash{$os}) {

                    $reghash{ $os . '-' . $reghash{$os}->{'oscount'} } = {

                        os=>'',

                        sortos=>$os."*",

                        user=>$valref->{'user'},

                        name=>$domname,

                        hostname=>$valref->{'hostname'}

                    };

                    $reghash{$os}->{'oscount'}++;

                } else {

                    $reghash{$os} = {

                        os=>$os,

                        sortos=>$os,

                        user=>$valref->{'user'},

                        name=>$domname,

                        hostname=>$valref->{'hostname'},

                        oscount=>1

                    }

                }

            }

        }

    }

    untie %domreg;

    my @sorted_oslist = sort {$a->{'sortos'} cmp $b->{'sortos'}} values %reghash;

    if ($obj->{'format'} eq 'html') {

        my $res;

        $res .= qq[<tr><th>OS</th><th>Name</th><th>Hostname</th><th>Count</th></tr>];

        foreach my $valref (@sorted_oslist) {

            $res .= qq[<tr><td>$valref->{'os'}</td><td>$valref->{'name'}</td><td>$valref->{'hostname'}</td><td>$valref->{'oscount'}</td></tr>];

        }

        $postreply = header();

        $postreply .= qq[<table cellspacing="0" frame="void" rules="rows" class="systemTables">$res</table>];

    } elsif ($obj->{'format'} eq 'csv') {

        $postreply = header("text/plain");

        csv(in => \@sorted_oslist, out => \my $csvdata);

        $postreply .= $csvdata;

    } else {

        $postreply .= to_json(\@sorted_oslist);

    }

    return $postreply;

}

sub Monitors {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:uuid:

Handling of monitors

END

    }

# We are dealing with a POST request, i.e. an action on a monitor

# or a PUT or DELETE request, i.e. creating/saving/deleting items

    if (($ENV{'REQUEST_METHOD'} eq 'DELETE' || $params{"PUTDATA"} || $ENV{'REQUEST_METHOD'} eq 'PUT' || $ENV{'REQUEST_METHOD'} eq 'POST') && !$isreadonly) {

        my @json_array;

        my %json_hash;

        my $delete;

        if ($ENV{'REQUEST_METHOD'} eq 'DELETE' && $uripath =~ /action=monitors\/(.+):(.+)/) {

            print header('text/json', '204 No Content') unless $console;

            %json_hash = ('serveruuid', $1, 'service', $2);

            @json_array = (\%json_hash);

            $delete = 1;

#            print Monitors_save(\%json_hash, $delete);

            print Monitors_save($uuid, "monitors_remove", $obj);

        } else {

            my $json_text = $params{"PUTDATA"} || $params{'keywords'};

            $json_text = encode('latin1', decode('utf8', $json_text));

            $json_text =~ s/\x/ /g;

            @json_array = from_json($json_text);

            $json_hash_ref = @json_array[0];

#            my $res = Monitors_save($json_hash_ref, $delete);

            my $res = Monitors_save($uuid, "monitors_save", $obj);

            if ($res =~ /^{/) {

                print header('text/json') unless $console;

                print $res;

            } else {

                print header('text/html', '400 Bad Request') unless $console;

                print qq|$res|;

            }

        }

# We are dealing with a regular GET request, i.e. a listing

    } else {

        my $selgroup;

        my $selservice;

        if ($uuid && $uuid ne '*') { # List all monitors for specific server

            $selgroup = $uuid;

            if ($uuid =~ /(.+):(.+)/){ # List specific monitor for specific server

                $selgroup = $1;

                $selservice = $2;

            }

        }

        my $usemoncmd = 0;

        my %opstatus = getOpstatus($selgroup, $selservice, $usemoncmd);

        my @monitors = values(%opstatus);

        my @sorted_monitors = sort {$a->{'opstatus'} cmp $b->{'opstatus'}} @monitors;

        my $json_text;

        if ($obj->{'listaction'} eq 'show' && scalar @monitors == 1) {

            $json_text = to_json($sorted_monitors[0], {pretty => 1});

        } else {

            $json_text = to_json(\@sorted_monitors, {pretty => 1});

        }

        utf8::decode($json_text);

        $postreply = $json_text;

        return $postreply;

    }

}

sub do_remove {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

DELETE:uuid:

Delete a system from database and make all member servers free agents.

END

    }

    if ($register{$uuid}) {

        unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};

        my @domregvalues = values %domreg;

        my @curregvalues;

        foreach my $valref (@domregvalues) {

            # Only include VM's belonging to current user (or all users if specified and user is admin)

            if ($user eq $valref->{'user'} || $fulllist) {

                my $system = $valref->{'system'};

                if ($system eq $uuid) {

                    $valref->{'system'} = '';

                    push(@curregvalues, $valref);

                }

            }

        }

        delete $register{$uuid};

        tied(%domreg)->commit;

        tied(%register)->commit;

        untie %domreg;

        if ($match) {

            $postreply = to_json(@curregvalues);

        } else {

            $postreply = header('text/plain', '204 No Content') unless $console;

        }

    }

    return $postreply;

}

sub Save {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

PUT:uuid, name, servers, memory, vcpu, fullname, email, phone, opfullname, opemail, opphone, alertemail, services, recovery, notes, networkuuids:

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.

[networkuuids] is a list of UUIDs of linked network connections, i.e. connections reserved for this system to handle

        Specify '--' to clear a value.

END

    }

    my $name = $obj->{"name"};

    my $memory = $obj->{"memory"};

    my $vcpu = $obj->{"vcpu"};

    my $reguser;

    $reguser = $register{$uuid}->{'user'} if ($register{$uuid});

    $console = 1 if ($obj->{'console'});

    my $issystem = $obj->{'issystem'} || $register{$uuid};

    my $notes = $obj->{"notes"};

    my $email = $obj->{'email'};

    my $fullname = $obj->{'fullname'};

    my $phone = $obj->{'phone'};

    my $opemail = $obj->{'opemail'};

    my $opfullname = $obj->{'opfullname'};

    my $opphone = $obj->{'opphone'};

    my $alertemail = $obj->{'alertemail'};

    my $services = $obj->{'services'};

    my $recovery = $obj->{'recovery'};

    my $networkuuids = $obj->{'networkuuids'};

    my $ports = $obj->{'ports'};

    my $autostart = $obj->{'autostart'};

    if (!$name) {

        if ($issystem) {

            $name = $register{$uuid}->{'name'};

        } else {

            $name = $domreg{$uuid}->{'name'};

        }

    }

    if ((!$uuid)) {

        my $ug = new Data::UUID;

        $uuid = $ug->create_str();

        $issystem = 1;

    };

    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Status=Error Unable to access domain register"};

    unless ($register{$uuid} || $domreg{$uuid}) {

        $obj->{'status'} = 'new';

        $issystem = 1;

    }

    $issystem = 1 if ($register{$uuid});

    unless (($uuid && length $uuid == 36)) {

        $postreply = "Status=Error Invalid UUID\n";

        return $postreply;

    }

    # Sanity checks

    if ($name && length $name > 255) {

        $postreply .= "Status=Error Bad data: $name " . (length $name) . "\n";

        return $postreply;

    };

    if ($issystem) { # We are dealing with a system

        # Security check

        if (($user eq $reguser || $isadmin) && $register{$uuid}) { # Existing system

            my @props = ('name', 'fullname','email','phone','opfullname','opemail','opphone','alertemail'

                ,'notes','services','recovery','autostart');

            my %oldvals;

            foreach my $prop (@props) {

                my $val = $obj->{$prop};

                if ($val) {

                    $val = '' if ($val eq '--');

                    $oldvals{$prop} = $register{$uuid}->{$prop} || $userreg{$user}->{$prop};

                    if ($val eq $userreg{$user}->{$prop}) {

                        $register{$uuid}->{$prop} = ''; # Same val as parent (user val), reset

                    } else {

                        if ($prop eq 'name' && $obj->{ports}) {

                            next; # TODO: ugly hack because we dont know why UTF8 is not handled correctly

                        }

                        $register{$uuid}->{$prop} = $val;

                    }

                    if ($prop eq 'autostart') {

                        $register{$uuid}->{$prop} = ($val)?'1':'';

                    }

                    if ($prop eq 'name') {

                        my $json_text = qq|{"uuid": "$uuid" , "name": "$name"}|;

                        $main::postAsyncToOrigo->($engineid, 'updateapps', "[$json_text]");

                    }

                }

            }

            my %childrenhash;

            my $alertmatch;

            push @props, ('vcpu', 'memory', 'ports');

            foreach my $prop (@props) {

                my $val = $obj->{$prop};

                if ($val) {

                    $val = '' if ($val eq '--');

                    # Update children

                    foreach my $domvalref (values %domreg) {

                        if ($domvalref->{'user'} eq $user && $domvalref->{'system'} eq $uuid) {

                            my %domval = %{$domvalref};

                            my $serveruuid = $domvalref->{'uuid'};

                            $childrenhash{$serveruuid} =\%domval unless ($childrenhash{$serveruuid});

                            $childrenhash{$serveruuid}->{$prop} = $val;

                            if ($prop eq 'autostart') {

                                $domvalref->{$prop} = ($val) ? '1' : ''; # Always update child servers with autostart prop

                            } elsif ((

                                ($obj->{'vcpu'} && $prop eq 'vcpu')

                                || ($obj->{'memory'} && $prop eq 'memory')

                            ) && $domvalref->{status} eq 'shutoff') {

                                $Stabile::Servers::console = 1;

                                require "$Stabile::basedir/cgi/servers.cgi";

                                $postreply .= Stabile::Servers::Save($serveruuid, 'save',

                                    { uuid => $serveruuid, $prop => $obj->{$prop} });

                            } elsif ($obj->{'ports'} && $prop eq 'ports') {

                                $Stabile::Networks::console = 1;

                                require "$Stabile::basedir/cgi/networks.cgi";

                                my $networkuuid1 = $domvalref->{'networkuuid1'};

                                my $saveobj = {uuid => $networkuuid1};

                                $saveobj->{ports} = $ports;

                                $postreply .= Stabile::Networks::Deactivate($networkuuid1);

                                $postreply .= Stabile::Networks::Save($networkuuid1, 'save', $saveobj);

                                $postreply .= Stabile::Networks::Activate($networkuuid1);

                            } elsif (!$domvalref->{$prop} || $domvalref->{$prop} eq $oldvals{$prop}) { # Inheritance is implied, so delete redundant entries

                                $domvalref->{$prop} = '';

                                if ($prop eq 'alertemail') {

                                    if (change_monitor_email($serveruuid, $val, $oldvals{$prop})) {

                                        $alertmatch = 1;

                                    }

                                }

                            }

                        }

                    }

                }

            }

            my @children = values %childrenhash;

            $obj->{'children'} = \@children if (@children);

            $postreply = getSystemsListing();

        } elsif ($obj->{'status'} eq 'new')  { # New system

            $register{$uuid} = {

                uuid=>$uuid,

                name=>$name,

                user=>$user,

                created=>$current_time

            };

            my $valref = $register{$uuid};

            my %val = %{$valref};

            $val{'issystem'} = 1;

            $val{'status'} = '--';

            $dojson = 1;

            $postreply = to_json(\%val, {pretty=>1});

        } else {

            $postreply .= "Status=Error Not enough privileges: $user\n";

        }

    } else { # We are dealing with a server

        my $valref = $domreg{$uuid};

        if (!$valref && $obj->{'uuid'}[0]) {$valref = $domreg{ $obj->{'uuid'}[0] }}; # We are dealing with a newly created server

        if ($valref && ($valref->{'user'} eq $user || $isadmin)) {

            my $system = $obj->{'system'};

            my $servername = $obj->{'name'};

            if ($servername && $servername ne $valref->{'name'}) {

                $valref->{'name'} = $servername;

                # Update status of images

                my @imgs = ($domreg{$uuid}->{image}, $domreg{$uuid}->{image2}, $domreg{$uuid}->{image3}, $domreg{$uuid}->{image4});

                my @imgkeys = ('image', 'image2', 'image3', 'image4');

                unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', key=>'path'}, $Stabile::dbopts)) ) {return "Status=Error Unable to access image register"};

                for (my $i=0; $i<4; $i++) {

                    my $img = $imgs[$i];

                    my $k = $imgkeys[$i];

                    if ($img && $img ne '--') {

                        $imagereg{$img}->{'domains'} = $uuid;

                        $imagereg{$img}->{'domainnames'} = $servername;

                    }

                }

                untie %imagereg;

                my $json_text = qq|{"uuid": "$uuid" , "name": "$servername"}|;

                $main::postAsyncToOrigo->($engineid, 'updateapps', "[$json_text]");

            }

            $valref->{'system'} = ($system eq '--'?'':$system) if ($system);

            $valref->{'notes'} = (($notes eq '--')?'':$notes) if ($notes);

            $valref->{'email'} = ($email eq '--'?'':$email) if ($email);

            $valref->{'fullname'} = ($fullname eq '--'?'':$fullname) if ($fullname);

            $valref->{'phone'} = ($phone eq '--'?'':$phone) if ($phone);

            $valref->{'opemail'} = ($opemail eq '--'?'':$opemail) if ($opemail);

            $valref->{'opfullname'} = ($opfullname eq '--'?'':$opfullname) if ($opfullname);

            $valref->{'opphone'} = ($opphone eq '--'?'':$opphone) if ($opphone);

            $valref->{'services'} = ($services eq '--'?'':$services) if ($services);

            $valref->{'recovery'} = ($recovery eq '--'?'':$recovery) if ($recovery);

            $valref->{'autostart'} = ($autostart && $autostart ne '--'?'1':'');

            if ($alertemail) {

                $alertemail = '' if ($alertemail eq '--');

                if ($valref->{'alertemail'} ne $alertemail) {

                    # If alert email is changed, update monitor if it is configured with this email

                    if (change_monitor_email($valref->{'uuid'}, $alertemail, $valref->{'alertemail'})){

                        $alertmatch = 1;

                        #`/usr/bin/moncmd reset keepstate`;

                    }

                    $valref->{'alertemail'} = $alertemail;

                }

            }

            if (($vcpu || $memory) && $valref->{status} eq 'shutoff') {

                $Stabile::Servers::console = 1;

                require "$Stabile::basedir/cgi/servers.cgi";

                my $saveobj = {uuid => $valref->{'uuid'}};

                $saveobj->{vcpu} = $vcpu if ($vcpu);

                $saveobj->{memory} = $memory if ($memory);

                $postreply .= Stabile::Servers::Save($valref->{'uuid'}, 'save', $saveobj);

            }

            if ($ports) {

                $Stabile::Networks::console = 1;

                require "$Stabile::basedir/cgi/networks.cgi";

                my $networkuuid1 = $valref->{'networkuuid1'};

                my $saveobj = {uuid => $networkuuid1};

                $saveobj->{ports} = $ports;

                $postreply .= Stabile::Networks::Deactivate($networkuuid1);

                $postreply .= Stabile::Networks::Save($networkuuid1, 'save', $saveobj);

                $postreply .= Stabile::Networks::Activate($networkuuid1);

            }

            tied(%domreg)->commit;

            $postreply = getSystemsListing(); # Hard to see what else to do, than to send entire table

        }

    }

    if ($networkuuids && $networkuuids ne '--') { # link networks to this system

        my @networks = split(/, ?/, $networkuuids);

        my @newnetworks = ();

        my @newnetworknames = ();

        unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access networks register"};

        foreach my $networkuuid (@networks) {

            next unless ($networkreg{$networkuuid});

            if (

                !$networkreg{$networkuuid}->{'domains'} # a network cannot both be linked and in active use

                    && (!$networkreg{$networkuuid}->{'systems'} ||  $networkreg{$networkuuid}->{'systems'} eq $uuid) # check if network is already linked to another system

            ) {

                $networkreg{$networkuuid}->{'systems'} = $uuid;

                $networkreg{$networkuuid}->{'systemnames'} = $name;

                push @newnetworks, $networkuuid;

                push @newnetworknames, $networkreg{$networkuuid}->{'name'};

            }

        }

        if ($issystem && $register{$uuid}) {

            $register{$uuid}->{'networkuuids'} = join(", ", @newnetworks);

            $register{$uuid}->{'networknames'} = join(", ", @newnetworknames);

        } elsif ($domreg{$uuid}) {

            $domreg{$uuid}->{'networkuuids'} = join(", ", @newnetworks);

            $domreg{$uuid}->{'networknames'} = join(", ", @newnetworknames);

        }

    }

    untie %domreg;

    return $postreply;

}

sub do_resettoaccountinfo {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET::

Recursively reset contact data for all systems and servers

END

    }

    my @props = ('fullname','email','phone','opfullname','opemail','opphone','alertemail');

    my $alertmatch;

    foreach my $sysvalref (values %register) {

        if ($user eq $sysvalref->{'user'}) {

            my $sysuuid = $sysvalref->{'uuid'};

            foreach my $prop (@props) {

                # Does this system have a value?

                if ($sysvalref->{$prop}) {

                    $sysvalref->{$prop} = ''; # An empty val refers to parent (user) val

                }

            }

        }

    }

    # Update domains

    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {$posterror = "Unable to access domain register"; return;};

    foreach my $domvalref (values %domreg) {

        if ($domvalref->{'user'} eq $user) {

            foreach my $prop (@props) {

                if ($domvalref->{$prop}) {

                    $domvalref->{$prop} = '';

                }

                if ($prop eq 'alertemail') {

                    if (change_monitor_email($domvalref->{'uuid'}, $userreg{$user}->{$prop})) {

                        $alertmatch = 1;

                    }

                }

            }

        }

    }

    tied(%domreg)->commit;

    untie %domreg;

    #`/usr/bin/moncmd reset keepstate` if ($alertmatch);

    $postreply .= "Status=OK OK - reset systems and servers contacts to account values\n";

    return $postreply;

}

sub do_start_server {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:uuid:

Start specific server.

END

    }

    $Stabile::Servers::console = 1;

    require "$Stabile::basedir/cgi/servers.cgi";

    $postreply .= Stabile::Servers::Start($uuid, 'start', { buildsystem => 0 });

}

sub systemAction {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:uuid:

Suspend, resume, start, shutdown, destroy og backup individual servers or servers belonging to a system.

END

    }

    my $issystem = $obj->{'issystem'} || $register{$uuid};

    my $reguser;

    $reguser = $register{$uuid}->{'user'} if ($register{$uuid});

    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};

    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;};

    if ($issystem) { # Existing system

        if (($user eq $reguser || $isadmin) && $register{$uuid}){ # Existing system

            my $domactions;

            my $imageactions;

            foreach my $domvalref (values %domreg) {

                if (($domvalref->{'system'} eq $uuid || $domvalref->{'uuid'} eq $uuid)

                    && ($domvalref->{'user'} eq $user || $isadmin)) {

                    my $domaction;

                    my $imageaction;

                    if ($domvalref->{'status'} eq 'paused' && ($action eq 'start' || $action eq 'resume')) {

                        $domaction = 'resume';

                    } elsif ($domvalref->{'status'} eq 'running' && $action eq 'suspend') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'shutoff' && $action eq 'start') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'inactive' && $action eq 'start') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'running' && $action eq 'shutdown') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'running' && $action eq 'destroy') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'shuttingdown' && $action eq 'destroy') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'destroying' && $action eq 'destroy') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'starting' && $action eq 'destroy') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'inactive' && $action eq 'destroy') {

                        $domaction = $action;

                    } elsif ($domvalref->{'status'} eq 'paused' && $action eq 'destroy') {

                        $domaction = $action;

                    } elsif ($action eq 'backup') {

                        $imageaction = $action;

                    }

                    if ($domaction) {

                        $domactions .= qq/{"uuid":"$domvalref->{'uuid'}","action":"$domaction"},/;

                    }

                    if ($imageaction) {

                        my $image = $domvalref->{'image'};

                        if ($imagereg{$image}->{'status'} =~ /used|active/) {

                            $imageactions .= qq/{"uuid":"$imagereg{$image}->{'uuid'}","action":"backup"},/;

                        }

                        my $image2 = $domvalref->{'image2'};

                        if ($image2 && $image2 ne '--' && $imagereg{$image2}->{'status'} =~ /used|active/) {

                            $imageactions .= qq/{"uuid":"$imagereg{$image2}->{'uuid'}","action":"backup"},/;

                        }

                        my $image3 = $domvalref->{'image3'};

                        if ($image3 && $image3 ne '--' && $imagereg{$image3}->{'status'} =~ /used|active/) {

                            $imageactions .= qq/{"uuid":"$imagereg{$image3}->{'uuid'}","action":"backup"},/;

                        }

                        my $image4 = $domvalref->{'image4'};

                        if ($image4 && $image4 ne '--' && $imagereg{$image4}->{'status'} =~ /used|active/) {

                            $imageactions .= qq/{"uuid":"$imagereg{$image4}->{'uuid'}","action":"backup"},/;

                        }

                    }

                }

            }

            if ($domactions) {

                $domactions = substr($domactions,0,-1);

                my $uri_action = qq/{"items":[$domactions]}/;

                $uri_action = URI::Escape::uri_escape($uri_action);

                $uri_action =~ /(.+)/; $uri_action = $1; #untaint

                $postreply .= `REMOTE_USER=$user $Stabile::basedir/cgi/servers.cgi -k $uri_action`;

            }

            if ($imageactions) {

                $imageactions = substr($imageactions,0,-1);

                my $uri_action = qq/{"items":[$imageactions]}/;

                $uri_action = URI::Escape::uri_escape($uri_action);

                $uri_action =~ /(.+)/; $uri_action = $1; #untaint

                $postreply .= `REMOTE_USER=$user $Stabile::basedir/cgi/images.cgi -k $uri_action`;

            }

            if (!$domactions && !$imageactions) {

                $postreply .= "Stream=ERROR $action";

            }

        }

    } else {

        if ($action eq 'backup') {

            my $image = $domreg{$uuid}->{'image'};

            my $imageactions;

            if ($imagereg{$image}->{'status'} =~ /used|active/) {

                $imageactions .= qq/{"uuid":"$imagereg{$image}->{'uuid'}","action":"gear_backup"},/;

            }

            my $image2 = $domreg{$uuid}->{'image2'};

            if ($image2 && $image2 ne '--' && $imagereg{$image2}->{'status'} =~ /used|active/) {

                $imageactions .= qq/{"uuid":"$imagereg{$image2}->{'uuid'}","action":"gear_backup"},/;

            }

            my $image3 = $domreg{$uuid}->{'image3'};

            if ($image3 && $image3 ne '--' && $imagereg{$image3}->{'status'} =~ /used|active/) {

                $imageactions .= qq/{"uuid":"$imagereg{$image3}->{'uuid'}","action":"gear_backup"},/;

            }

            my $image4 = $domreg{$uuid}->{'image4'};

            if ($image4 && $image4 ne '--' && $imagereg{$image4}->{'status'} =~ /used|active/) {

                $imageactions .= qq/{"uuid":"$imagereg{$image4}->{'uuid'}","action":"gear_backup"},/;

            }

            if ($imageactions) {

                $imageactions = substr($imageactions,0,-1);

                my $uri_action = qq/{"items":[$imageactions]}/;

                $uri_action = URI::Escape::uri_escape($uri_action);

                $uri_action = $1 if $uri_action =~ /(.+)/; #untaint

                $postreply .= `REQUEST_METHOD=POST REMOTE_USER=$user $Stabile::basedir/cgi/images.cgi -k "$uri_action"`;

            }

        } else {

            my $cmd = qq|REQUEST_METHOD=GET REMOTE_USER=$user $Stabile::basedir/cgi/servers.cgi -a $action -u $uuid|;

            $postreply = `$cmd`;

            #$postreply = $cmd;

            my $uistatus = $action."ing";

            $uistatus = "resuming" if ($action eq 'resume');

            $uistatus = "shuttingdown" if ($action eq 'shutdown');

            $main::updateUI->({ tab => 'servers',

                user                => $user,

                uuid                => $uuid,

                status              => $uistatus })

        }

    }

    untie %domreg;

    untie %imagereg;

    return $postreply;

}

sub Updateengineinfo {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

PUT:downloadmasters, externaliprangestart, externaliprangeend, proxyiprangestart, proxyiprangeend, proxygw, vmreadlimit, vmwritelimit, vmiopsreadlimit, vmiopswritelimit:

Save engine information.

END

    }

    unless ($isadmin) {

        $postreply = "Status=Error Not allowed\n";

        return $postreply;

    }

    my $msg = "Engine updated";

    my $dl = $obj->{'downloadmasters'};

    if ($dl eq '--' || $dl eq '0') {

        if ($downloadmasters) {

            $downloadmasters = '';

            `perl -pi -e 's/DOWNLOAD_MASTERS=.*/DOWNLOAD_MASTERS=0/;' /etc/stabile/config.cfg`;

        }

        $postreply .= "Status=OK Engine updated\n";

        my @ps = split("\n",  `pgrep pressurecontrol` ); `kill -HUP $ps[0]`;

    }

    elsif ($dl eq '1' || $dl eq '2') {

        if (!$downloadmasters || $dl eq '2') { # We use a value of 2 to force check for downloads

            $downloadmasters = 1;

            `perl -pi -e 's/DOWNLOAD_MASTERS=.*/DOWNLOAD_MASTERS=$dl/;' /etc/stabile/config.cfg`;

        }

        if ($dl eq '2') {

            $msg = "Checking for new or updated masters...";

        }

        $postreply .= "Status=OK Engine updated\n";

        my @ps = split("\n",  `pgrep pressurecontrol` );

        `kill -HUP $ps[0]`;

    }

    elsif ($obj->{'disablesnat'} eq '--' || $obj->{'disablesnat'} eq '0') {

        if ($disablesnat) {

            $disablesnat = '';

            `perl -pi -e 's/DISABLE_SNAT=.*/DISABLE_SNAT=0/;' /etc/stabile/config.cfg`;

        }

        $postreply .= "Status=OK Engine updated\n";

    }

    elsif ($obj->{'disablesnat'} eq '1') {

        unless ($disablesnat) {

            $disablesnat = 1;

            `perl -pi -e 's/DISABLE_SNAT=.*/DISABLE_SNAT=1/;' /etc/stabile/config.cfg`;

        }

        $postreply .= "Status=OK Engine updated\n";

    }

    elsif ($obj->{'externaliprangestart'}) {

        if ($obj->{'externaliprangestart'} =~ /\d+\.\d+\.\d+\.\d+/) {

            $extiprangestart = $obj->{'externaliprangestart'};

            $msg = "Setting external IP range start to $extiprangestart";

            `perl -pi -e 's/EXTERNAL_IP_RANGE_START=.*/EXTERNAL_IP_RANGE_START=$extiprangestart/;' /etc/stabile/config.cfg`;

            $postreply .= "Status=OK Engine updated\n";

        } else {

            $msg = "Not changing IP range - $obj->{'externaliprangestart'} is not valid";

        }

    }

    elsif ($obj->{'externaliprangeend'}) {

        if ($obj->{'externaliprangeend'} =~ /\d+\.\d+\.\d+\.\d+/) {

            $extiprangeend = $obj->{'externaliprangeend'};

            $msg = "Setting external IP range end to $extiprangeend";

            `perl -pi -e 's/EXTERNAL_IP_RANGE_END=.*/EXTERNAL_IP_RANGE_END=$extiprangeend/;' /etc/stabile/config.cfg`;

            $postreply .= "Status=OK Engine updated\n";

        } else {

            $msg = "Not changing IP range - $obj->{'externaliprangeend'} is not valid";

        }

    }

    elsif ($obj->{'proxyiprangestart'}) {

        if ($obj->{'proxyiprangestart'} =~ /\d+\.\d+\.\d+\.\d+/) {

            $extiprangestart = $obj->{'proxyiprangestart'};

            $msg = "Setting proxy IP range start to $extiprangestart";

            `perl -pi -e 's/PROXY_IP_RANGE_START=.*/PROXY_IP_RANGE_START=$extiprangestart/;' /etc/stabile/config.cfg`;

            $postreply .= "Status=OK Engine updated\n";

        } else {

            $msg = "Not changing IP range - $obj->{'proxyiprangestart'} is not valid";

        }

    }

    elsif ($obj->{'proxyiprangeend'}) {

        if ($obj->{'proxyiprangeend'} =~ /\d+\.\d+\.\d+\.\d+/) {

            $extiprangeend = $obj->{'proxyiprangeend'};

            $msg = "Setting proxy IP range end to $extiprangeend";

            `perl -pi -e 's/PROXY_IP_RANGE_END=.*/PROXY_IP_RANGE_END=$extiprangeend/;' /etc/stabile/config.cfg`;

            $postreply .= "Status=OK Engine updated\n";

        } else {

            $msg = "Not changing IP range - $obj->{'proxyiprangeend'} is not valid";

        }

    }

    elsif ($obj->{'proxygw'}) {

        if ($obj->{'proxygw'} =~ /\d+\.\d+\.\d+\.\d+/) {

            $proxygw = $obj->{'proxygw'};

            $msg = "Setting proxy gw to $proxygw";

            `perl -pi -e 's/PROXY_GW=.*/PROXY_GW=$proxygw/;' /etc/stabile/config.cfg`;

            $postreply .= "Status=OK Engine updated\n";

        } else {

            $msg = "Not changing IP range - $obj->{'proxygw'} is not valid";

        }

    }

    elsif ($obj->{'vmreadlimit'} || $obj->{'vmwritelimit'} || $obj->{'vmiopsreadlimit'} || $obj->{'vmiopswritelimit'}) {

        my $lim = 'vmreadlimit';

        my $uclim = 'VM_READ_LIMIT';

        if ($obj->{'vmwritelimit'}) {

            $lim = 'vmwritelimit';

            $uclim = 'VM_WRITE_LIMIT';

        } elsif ($obj->{'vmiopsreadlimit'}) {

            $lim = 'vmiopsreadlimit';

            $uclim = 'VM_IOPS_READ_LIMIT';

        } elsif ($obj->{'vmiopswritelimit'}) {

            $lim = 'vmiopswritelimit';

            $uclim = 'VM_IOPS_WRITE_LIMIT';

        }

        if ($obj->{$lim} >= 0 &&  $obj->{$lim} < 10000 *1024*1024) { #sanity checks

            unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities',key=>'identity',CLOBBER=>3}, $Stabile::dbopts)) ) {return "Unable to access id register"};

            my @nodeconfigs;

            # Build hash of known node config files

            foreach my $valref (values %idreg) {

                my $nodeconfigfile = $valref->{'path'} . "/casper/filesystem.dir/etc/stabile/nodeconfig.cfg";

                next if ($nodeconfigs{$nodeconfigfile}); # Node identities may share basedir and node config file

                if (-e $nodeconfigfile) {

                    push @nodeconfigs, $nodeconfigfile;

                }

            }

            untie %idreg;

            push @nodeconfigs, "/etc/stabile/nodeconfig.cfg";

            my $limit = int $obj->{$lim};

            $msg = "Setting read limit to $limit";

            foreach my $nodeconfig (@nodeconfigs) {

                my $cfg = new Config::Simple($nodeconfig);

                $cfg->param($uclim, $limit);

                $cfg->save();

            }

            $Stabile::Nodes::console = 1;

            require "$Stabile::basedir/cgi/nodes.cgi";

            $postreply .= Stabile::Nodes::Configurecgroups();

            $postreply .= Stabile::Nodes::do_reloadall('','reloadall', {'nodeaction'=>'CGLOAD'});

            $postreply .= "Status=OK Engine and nodes updated: $lim set to $limit\n";

        } else {

            $msg = "Not changing limit - $obj->{$lim} is not valid";

        }

    }

    if (!$postreply) {

        $msg = "Engine not updated";

        $postreply = "Status=Error Engine not updated\n" ;

    }

    $main::updateUI->({tab=>'home', user=>$user, type=>'update', message=>$msg});

    return $postreply;

}

sub do_updateaccountinfo {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

PUT:fullname, email, phone, opfullname, opemail, opphone, alertemail, allowfrom, allowinternalapi:

Save user information.

END

    }

    my @props = ('fullname','email','phone','opfullname','opemail','opphone','alertemail', 'allowfrom', 'allowinternalapi');

    my %oldvals;

    if ($obj->{'allowfrom'} && $obj->{'allowfrom'} ne '--') {

        my @allows = split(/,\s*/, $obj->{'allowfrom'});

        $obj->{'allowfrom'} = '';

        my %allowshash;

        foreach my $ip (@allows) {

            $allowshash{"$1$2"} = 1 if ($ip =~ /(\d+\.\d+\.\d+\.\d+)(\/\d+)?/);

            if ($ip =~ /\w\w/) { # Check if we are dealing with a country code

                $ip = uc $ip;

                my $geoip = Geo::IP->new(GEOIP_MEMORY_CACHE);

                my $tz = $geoip->time_zone($ip, '');

                $allowshash{$ip} = 1 if ($tz); # We have a valid country code

            }

        }

        $obj->{'allowfrom'} = join(", ", sort(keys %allowshash));

        unless ($obj->{'allowfrom'}) {

            $postreply .= "Status=Error Account not updated\n";

            return $postreply;

        }

    }

    foreach my $prop (@props) {

        if ($obj->{$prop}) {

            $obj->{$prop} = '' if ($obj->{$prop} eq '--');

            $oldvals{$prop} = $userreg{$user}->{$prop};

            $userreg{$user}->{$prop} = decode('utf8', $obj->{$prop});

        }

    }

    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};

    unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return "Unable to access user register"};

    my $alertmatch;

    foreach my $sysvalref (values %register) {

        if ($user eq $sysvalref->{'user'}) {

            my $sysuuid = $sysvalref->{'uuid'};

            foreach my $prop (@props) {

                my $val = $obj->{$prop};

                if ($val) {

                    $val = '' if ($val eq '--');

                    # Does this system have the same value as the old user value or, equivalently, is it empty?

                    if (!$sysvalref->{$prop} || $sysvalref->{$prop} eq $oldvals{$prop}) {

                    #    $postreply .= "Resetting system prop $prop to $val\n";

                        $sysvalref->{$prop} = ''; # An empty val refers to parent (user) val

                    # Update children

                        foreach my $domvalref (values %domreg) {

                            if ($domvalref->{'user'} eq $user && ($domvalref->{'system'} eq $sysuuid || $domvalref->{'system'} eq '--' || !$domvalref->{'system'})) {

                                if (!$domvalref->{$prop} || $domvalref->{$prop} eq $oldvals{$prop}) {

                                    $domvalref->{$prop} = '';

                                    if ($prop eq 'alertemail') {

                                        if (change_monitor_email($domvalref->{'uuid'}, $val, $oldvals{$prop})) {

                                            $alertmatch = 1;

                                        }

                                    }

                                }

                            }

                        }

                    }

                }

            }

        }

    }

    #`/usr/bin/moncmd reset keepstate` if ($alertmatch);

    tied(%domreg)->commit;

    tied(%userreg)->commit;

    untie %domreg;

    untie %userreg;

    $postreply .= "Status=OK Account updated\n";

    # Send changes to origo.io

    $Stabile::Users::console = 1;

    require "$Stabile::basedir/cgi/users.cgi";

    $postreply .= Stabile::Users::sendEngineUser($user) if ($enginelinked);

    $main::updateUI->({tab=>'home', user=>$user, type=>'update', message=>"Account updated"});

    return $postreply;

}

sub do_listuptime {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:yearmonth,uuid,format:

List uptime for defined monitors. If uuid is supplied, only uptime for matching server or servers belonging to matching

system is shown. Format is either html or json.

END

    }

    my $format = $obj->{'format'};

    my $yearmonth = $obj->{'yearmonth'} || "$year-$month";

    my $pathid = $yearmonth . ':';

    my $name;

    my %sysdoms;

    if ($uuid && $register{$uuid}) {

        $name = $register{$uuid}->{'name'};

        foreach my $valref (values %domreg) {

            $sysdoms{$valref->{'uuid'}} = $uuid if ($valref->{system} eq $uuid);

        }

    } else {

        $pathid .= $uuid;

        $name = $domreg{$uuid}->{'name'} if ($domreg{$uuid});

    }

    my %uptimes;

    my $jtext = {};

    my @csvrows;

    unless ($pathid =~ /\// || $pathid =~ /\./) { # Security check

        my $path = "/var/log/stabile/$pathid*"; # trailing / is required. No $pathid lists all files in log dir.

        my $utext = '';

        my %numfiles;

        my %sumupp;

        ## loop through the files contained in the directory

        for my $eachFile (bsd_glob($path.'*')) {

            if (!(-d $eachFile) && $eachFile =~ /\/var\/log\/stabile\/(.+):(.+):(.+)/) {

                my $ymonth = $1;

                my $domuuid = $2;

                my $service = $3;

                next unless ($domreg{$domuuid});

                my $servername = $domreg{$domuuid}->{'name'};

                if ($domreg{$domuuid}->{'user'} eq $user) {

                    next if (%sysdoms && !$sysdoms{$domuuid}); # If we are listing a system, match system uuid

                    open(FILE, $eachFile) or {print("Unable to access $eachFile")};

                    @lines = <FILE>;

                    close(FILE);

                    my $starttime;

                    my $lastup;

                    my $firststamp; # First timestamp of measuring period

                    my $laststamp; # Last timestamp of measuring period

                    my $curstate = 'UNKNOWN';

                    my $dstate = 'UNKNOWN';

                    my ($y, $m) = split('-', $ymonth);

                    my $timespan = 0;

                    my $dtime = 0; # Time disabled

                    my $lastdtime = 0;

                    my $uptime = 0;

                    foreach my $line (@lines) {

                        my ($timestamp, $event, $summary, $ptime) = split(/, */,$line);

                        if (!$starttime) { # First line

                            $starttime = $timestamp;

                            # Find 00:00 of first day of month - http://www.perlmonks.org/?node_id=97120

                            $firststamp = POSIX::mktime(0,0,0,1,$m-1,$year-1900,0,0,-1);

                            # Round to month start if within 15 min

                            $starttime = $firststamp if ($starttime-$firststamp<15*60);

                            $lastup = $starttime if ($event eq 'STARTUP' || $event eq 'UP');

                            $curstate = 'UP'; # Assume up - down alerts are always triggered

                        }

                        if ($event eq 'UP') {

                            if ($curstate eq 'UP') {

                                $uptime += ($timestamp - $lastup) if ($lastup);

                            }

                            $lastup = $timestamp;

                            $curstate = 'UP';

                        } elsif ($event eq 'DOWN') {

                            if ($curstate eq 'UP' && $lastup!=$starttime) { # If down is immediately after startup - dont count uptime

                                $uptime += ($timestamp - $lastup) if ($lastup);

                                $lastup = $timestamp;

                            }

                            $curstate = 'DOWN';

                        } elsif ($event eq 'STARTUP') {

                        } elsif ($event eq 'DISABLE' && $curstate ne 'UNKNOWN') {

                            if ($curstate eq 'UP') {

                                $uptime += ($timestamp - $lastup) if ($lastup);

                                $lastup = $timestamp;

                            }

                            $lastdtime = $timestamp;

                            $dstate = $curstate;

                            $curstate = 'UNKNOWN';

                        } elsif ($event eq 'ENABLE') {

                            if ($dstate eq 'UP' && $curstate eq 'UNKNOWN') {

                                $lastup = $timestamp;

                            }

                            $curstate = 'UP';

                        }

                        # All non-disable events must mean monitor is enabled again

                        if ($event ne 'DISABLE') {

                            if ($lastdtime) {

                                $dtime += ($timestamp - $lastdtime);

                                $lastdtime = 0;

                            }

                        }

                    }

                    if ($ymonth ne "$year-$month") { # If not current month, assume monitoring to end of month

                        # Find 00:00 of first day of next month - http://www.perlmonks.org/?node_id=97120

                        $laststamp = POSIX::mktime(0,0,0,1,$m,$year-1900,0,0,-1);

                    } else {

                        $laststamp = $current_time;

                    }

                    if ($curstate eq 'UP' && !$lastdtime && $lastup) {

                        $uptime += ($laststamp - $lastup);

                    }

                    if ($lastdtime) {

                        $dtime += ($laststamp - $lastdtime);

                    }

                    $timespan = $laststamp - $starttime;

                    $uptimes{"$domuuid:$service"}->{'timespan'} = $timespan;

                    $uptimes{"$domuuid:$service"}->{'uptime'} = $uptime;

                    my $timespanh = int(0.5 + 100*$timespan/3600)/100;

                    my $dtimeh = int(0.5 + 100*$dtime/3600)/100;

                    my $uptimeh = int(0.5 + 100*$uptime/3600)/100;

                    my $upp = int(0.5+ 10000*$uptime/($timespan-$dtime) ) / 100;

                    $sumupp{$service} += $upp;

                    $numfiles{$service} += 1;

                    utf8::decode($servername);

                    $utext .= qq[<div class="uptime_header">$service on $servername:</div>\n];

                    my $color = ($upp<98)?'red':'green';

                    $utext .= qq[<span style="color: $color;">Uptime: $uptimeh hours ($upp%)</span>\n];

                    $utext .= qq{[timespan: $timespanh hours, \n};

                    $utext .= qq{disabled: $dtimeh hours]\n};

                    $jtext->{$domuuid}->{'servername'} = $servername;

                    $jtext->{$domuuid}->{$service}->{'uptime'} = $upp;

                    $jtext->{$domuuid}->{$service}->{'uptimeh'} = $uptimeh;

                    $jtext->{$domuuid}->{$service}->{'color'} = ($upp<98)?'red':'green';

                    $jtext->{$domuuid}->{$service}->{'disabledtimeh'} = $dtimeh;

                    $jtext->{$domuuid}->{$service}->{'timespanh'} = $timespanh;

                    push @csvrows, {serveruuid=>$domuuid, service=>$service, servername=>$servername, uptime=>$upp, uptimeh=>$uptimeh, color=>($upp<98)?'red':'green',disabledtimeh=>$dtimeh, timespanh=>$timespanh, yearmonth=>$yearmonth};

                }

            }

        }

        my @avgtxt;

        my $alertclass = "info";

        my $compcolor;

        $jtext->{'averages'} = {};

        $jtext->{'year-month'} = $yearmonth;

        foreach $svc (keys %sumupp) {

            my $avgupp = int(0.5 + 100*$sumupp{$svc}/$numfiles{$svc})/100;

            my $color = ($avgupp<98)?'red':'green';

            push @avgtxt, qq[<span style="color: $color;" class="uptime_header">$svc: $avgupp%</span>\n];

            $jtext->{'averages'}->{$svc}->{'uptime'} = $avgupp;

            $jtext->{'averages'}->{$svc}->{'color'} = $color;

            $compcolor = ($compcolor)? ( ($compcolor eq $color)? $color : 'info' ) : $color;

        }

        $alertclass = "warning" if ($compcolor eq 'red');

        $alertclass = "success" if ($compcolor eq 'green');

        $postreply = header();

        if ($name) {

            $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];

        } else {

            $postreply .= qq[<div class="alert alert-$alertclass uptime_alert"><h4 class="uptime_header">Average uptime report</h4>\n<div style="margin-top:10px;">\n];

        }

        $postreply .= join(", ", @avgtxt);

        my $uuidlink = "&uuid=$uuid" if ($uuid);

        $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];

        $postreply .= "<span class=\"uptime_text\">$utext</span>";

    }

    if ($params{'format'} eq 'csv') {

        $postreply = header("text/plain");

        csv(in => \@csvrows, out => \my $csvdata, key => "servername");

        $postreply .= $csvdata;

    } elsif ($format ne 'html') {

        $postreply = to_json($jtext, {pretty=>1});

    }

    return $postreply;

}

sub do_appstore {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:appid,callback:

Look up app info for app with given appid in appstore on origo.io. Data is returned as padded JSON (JSONP).

Optionally provide name of your JSONP callback function, which should parse the returned script data.

END

    }

    my $appid = $params{'appid'};

    my $callback = $params{'callback'};

    if ($appid) {

        $postreply = header("application/javascript");

        $postreply .= $main::postToOrigo->($engineid, 'engineappstore', $appid, 'appid', $callback);

    } else {

        $postreply = qq|Status=Error Please provide appid|;

    }

    return $postreply;

}

sub do_resetmonitoring {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET::

Reset mon daemon while keeping states.

END

    }

    saveOpstatus();

    $postreply = "Status=OK " . `/usr/bin/moncmd reset keepstate`;

    return $postreply;

}

sub do_installsystem {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:installsystem,installaccount:

Helper function to initiate the installation of a new stack with system ID [installsystem] to account [installaccount] by redirecting with appropriate cookies set.

END

    }

    my $installsystem = $obj->{'installsystem'};

    my $installaccount = $obj->{'installaccount'};

    my $systemcookie;

    my $ia_cookie;

    my $sa_cookie;

    push(@INC, "$Stabile::basedir/auth");

    require Apache::AuthTkt;# 0.03;

    require AuthTktConfig;

    my $at = Apache::AuthTkt->new(conf => $ENV{MOD_AUTH_TKT_CONF});

    my ($server_name, $server_port) = split /:/, $ENV{HTTP_HOST} if $ENV{HTTP_HOST};

    $server_name ||= $ENV{SERVER_NAME} if $ENV{SERVER_NAME};

    $server_port ||= $ENV{SERVER_PORT} if $ENV{SERVER_PORT};

    my $AUTH_DOMAIN = $at->domain || $server_name;

    my @auth_domain = $AUTH_DOMAIN ? ( -domain => $AUTH_DOMAIN ) : ();

    if ($installsystem) {

        $systemcookie = CGI::Cookie->new(

            -name => 'installsystem',

            -value => "$installsystem",

            -path => '/',

            @auth_domain

        );

    };

    if ($installaccount) {

        $ia_cookie = CGI::Cookie->new(

            -name => 'installaccount',

            -value => "$installaccount",

            -path => '/',

            @auth_domain

        );

        $sa_cookie = CGI::Cookie->new(

            -name => 'steamaccount',

            -value => "$installaccount",

            -path => '/',

            @auth_domain

        );

    };

    $tktcookie = CGI::Cookie->new(

        -name => 'tktuser',

        -value => "$tktuser",

        -path => '/',

        @auth_domain

    );

    $postreply = redirect(

        -uri => '/stabile/mainvalve/',

        -cookie => [$tktcookie, $systemcookie, $ia_cookie, $sa_cookie]

    );

    return $postreply;

}

sub Changemonitoremail {

    my ($uuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:uuid,email:

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.

END

    }

    if ($isreadonly) {

        $postreply = "Status=Error Not permitted\n";

    } else {

        my $serveruuid = $options{u} || $uuid;

        my $email = $options{k} || $obj->{'email'};

        if (change_monitor_email($serveruuid, $email)) {

            $postreply = "Status=OK " . `/usr/bin/moncmd reset keepstate`;

        } else {

            $postreply = "Status=Error There was a problem changing monitor email for $serveruuid\n";

        }

    }

    return $postreply;

}

sub do_getmetrics {

    my ($suuid, $action, $obj) = @_;

    if ($help) {

        return <<END

GET:uuid,metric,from,until,last,format:

Get performance and load metrics in JSON format from Graphite backend. [metric] is one of: cpuload, diskreads, diskwrites, networkactivityrx, networkactivitytx

From and until are Unix timestamps. Alternatively specify "last" number of seconds you want metrics for. Format is "json" (default) or "csv".

END

    }

    my $metric = $params{metric} || "cpuLoad";

    my $now = time();

    my $from = $params{"from"} || ($now-$params{"last"}) || ($now-300);

    my $until = $params{"until"} || $now;

    my @uuids;

    unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};

    if ($domreg{$suuid}) { # We are dealing with a server

        push @uuids, $suuid;

    } else { # We are dealing with a system

        foreach my $valref (values %domreg) {

            my $sysuuid = $valref->{'system'};

            push @uuids, $valref->{'uuid'} if ($sysuuid eq $suuid)

        }

    }

    untie %domreg;

    my @datapoints;

    my @targets;

    my $all;

    my $jobj = [];

    foreach my $uuid (@uuids) {

        next unless (-e "/var/lib/graphite/whisper/domains/$uuid");

        my $url = "https://127.0.0.1/graphite/graphite.wsgi/render?format=json&from=$from&until=$until&target=domains.$uuid.$metric";

        my $jstats = `curl -k "$url"`;

        $jobj = from_json($jstats);

        push @targets, $jobj->[0]->{target};