| 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 |
48fcda6b
|
Origo
|
# https://www.stabile.io/info/stabiledocs/licensing/stabile-open-source-license
|
| 7 |
95b003ff
|
Origo
|
|
| 8 |
|
|
package Stabile::Users;
|
| 9 |
|
|
|
| 10 |
|
|
use Error qw(:try);
|
| 11 |
|
|
use Time::Local;
|
| 12 |
|
|
# use Time::HiRes qw( time );
|
| 13 |
|
|
use Config::Simple;
|
| 14 |
|
|
use Text::CSV_XS qw( csv );
|
| 15 |
|
|
use Proc::Daemon;
|
| 16 |
|
|
use MIME::Lite;
|
| 17 |
|
|
use File::Basename;
|
| 18 |
|
|
use Data::Password qw(:all);
|
| 19 |
4aef7ef6
|
hq
|
use Geo::IP;
|
| 20 |
95b003ff
|
Origo
|
use lib dirname (__FILE__);
|
| 21 |
|
|
use Stabile;
|
| 22 |
|
|
|
| 23 |
|
|
$engineid = $Stabile::config->get('ENGINEID') || "";
|
| 24 |
|
|
$enginename = $Stabile::config->get('ENGINENAME') || "";
|
| 25 |
|
|
#$enginelinked = $Stabile::config->get('ENGINE_LINKED') || "";
|
| 26 |
|
|
$showcost = $Stabile::config->get('SHOW_COST') || "";
|
| 27 |
|
|
$cur = $Stabile::config->get('CURRENCY') || "USD";
|
| 28 |
|
|
$engineuser = $Stabile::config->get('ENGINEUSER') || "";
|
| 29 |
|
|
$externaliprangestart = $Stabile::config->get('EXTERNAL_IP_RANGE_START') || "";
|
| 30 |
|
|
$externaliprangeend = $Stabile::config->get('EXTERNAL_IP_RANGE_END') || "";
|
| 31 |
|
|
$proxyiprangestart = $Stabile::config->get('PROXY_IP_RANGE_START') || "";
|
| 32 |
|
|
$proxyiprangeend = $Stabile::config->get('PROXY_IP_RANGE_END') || "";
|
| 33 |
|
|
$proxygw = $Stabile::config->get('PROXY_GW') || "";
|
| 34 |
|
|
|
| 35 |
|
|
$uiuuid;
|
| 36 |
|
|
$uistatus;
|
| 37 |
|
|
$help = 0; # If this is set, functions output help
|
| 38 |
|
|
|
| 39 |
|
|
#our %options=();
|
| 40 |
|
|
# -a action -h help -u uuid -m match pattern -f full list, i.e. all users
|
| 41 |
|
|
# -v verbose, include HTTP headers -s impersonate subaccount -t target [uuid or image]
|
| 42 |
|
|
# -g args to gearman task
|
| 43 |
|
|
#Getopt::Std::getopts("a:hfu:g:m:vs:t:", \%options);
|
| 44 |
|
|
|
| 45 |
|
|
try {
|
| 46 |
|
|
Init(); # Perform various initalization tasks
|
| 47 |
|
|
process() if ($package);
|
| 48 |
|
|
|
| 49 |
|
|
} catch Error with {
|
| 50 |
|
|
my $ex = shift;
|
| 51 |
|
|
print header('text/html', '500 Internal Server Error') unless ($console);
|
| 52 |
|
|
if ($ex->{-text}) {
|
| 53 |
|
|
print "Got error: ", $ex->{-text}, " on line ", $ex->{-line}, "\n";
|
| 54 |
|
|
} else {
|
| 55 |
|
|
print "Status=ERROR\n";
|
| 56 |
|
|
}
|
| 57 |
|
|
} finally {
|
| 58 |
|
|
};
|
| 59 |
|
|
|
| 60 |
|
|
1;
|
| 61 |
|
|
|
| 62 |
|
|
sub getObj {
|
| 63 |
|
|
my %h = %{@_[0]};
|
| 64 |
|
|
$console = 1 if $h{"console"};
|
| 65 |
|
|
$api = 1 if $h{"api"};
|
| 66 |
|
|
my $username = $h{"username"} || $h{"uuid"};
|
| 67 |
|
|
my $obj;
|
| 68 |
|
|
$action = $action || $h{'action'};
|
| 69 |
|
|
if ($action=~ /engine$|updateclientui$|updateui$/) {
|
| 70 |
|
|
$obj = \%h;
|
| 71 |
|
|
$obj->{pwd} = $obj->{password} if ($obj->{password});
|
| 72 |
|
|
} else {
|
| 73 |
|
|
$obj = $register{$username};
|
| 74 |
|
|
my %hobj = %{$register{$username}};
|
| 75 |
|
|
$obj = \%hobj; # We do this to get around a weird problem with freeze...
|
| 76 |
|
|
my @props = qw ( restorefile engineid enginename engineurl username user password pwd fullname email
|
| 77 |
|
|
opemail alertemail phone opphone opfullname allowfrom allowinternalapi privileges accounts accountsprivileges
|
| 78 |
51e32e00
|
hq
|
storagepools memoryquota storagequota nodestoragequota vcpuquota externalipquota rxquota txquota billto dnsdomains appstoreurl totpsecret);
|
| 79 |
95b003ff
|
Origo
|
foreach my $prop (@props) {
|
| 80 |
|
|
if (defined $h{$prop}) {
|
| 81 |
|
|
$obj->{$prop} = $h{$prop};
|
| 82 |
|
|
}
|
| 83 |
|
|
}
|
| 84 |
|
|
}
|
| 85 |
|
|
return $obj;
|
| 86 |
|
|
}
|
| 87 |
|
|
|
| 88 |
|
|
sub Init {
|
| 89 |
|
|
# Tie database tables to hashes
|
| 90 |
|
|
unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username'}, $Stabile::dbopts)) ) {return "Unable to access users register"};
|
| 91 |
|
|
|
| 92 |
|
|
# simplify globals initialized in Stabile.pm
|
| 93 |
|
|
$tktuser = $tktuser || $Stabile::tktuser;
|
| 94 |
|
|
$user = $user || $Stabile::user;
|
| 95 |
|
|
|
| 96 |
|
|
$fullname = $register{$user}->{'fullname'};
|
| 97 |
|
|
$email = $register{$user}->{'email'};
|
| 98 |
|
|
$opemail = $register{$user}->{'opemail'};
|
| 99 |
|
|
$alertemail = $register{$user}->{'alertemail'};
|
| 100 |
|
|
$phone = $register{$user}->{'phone'};
|
| 101 |
|
|
$opphone = $register{$user}->{'opphone'};
|
| 102 |
|
|
$opfullname = $register{$user}->{'opfullname'};
|
| 103 |
|
|
$allowfrom = $register{$user}->{'allowfrom'};
|
| 104 |
|
|
$allowinternalapi = $register{$user}->{'allowinternalapi'};
|
| 105 |
|
|
$lastlogin = $register{$user}->{'lastlogin'};
|
| 106 |
|
|
$lastloginfrom = $register{$user}->{'lastloginfrom'};
|
| 107 |
|
|
|
| 108 |
|
|
# if ($register{$user}->{'lastlogin'} ne $tkt) {
|
| 109 |
|
|
# $register{$user}->{'lastlogin'} = time;
|
| 110 |
|
|
# $register{$user}->{'lastloginfrom'} = $ENV{'REMOTE_ADDR'};
|
| 111 |
|
|
# $register{$user}->{'lasttkt'} = $tkt;
|
| 112 |
|
|
# }
|
| 113 |
|
|
|
| 114 |
|
|
$Stabile::userstoragequota = 0+ $register{$user}->{'storagequota'};
|
| 115 |
|
|
$Stabile::usernodestoragequota = 0+ $register{$user}->{'nodestoragequota'};
|
| 116 |
|
|
$usermemoryquota = 0+ $register{$user}->{'memoryquota'};
|
| 117 |
|
|
$uservcpuquota = 0+ $register{$user}->{'vcpuquota'};
|
| 118 |
a93267ad
|
hq
|
$uservmemoryquota = 0+ $register{$user}->{'vmemoryquota'};
|
| 119 |
|
|
$uservgpuquota = 0+ $register{$user}->{'vgpuquota'};
|
| 120 |
95b003ff
|
Origo
|
$userexternalipquota = 0+ $register{$user}->{'externalipquota'};
|
| 121 |
|
|
$userrxquota = 0+ $register{$user}->{'rxquota'};
|
| 122 |
|
|
$usertxquota = 0+ $register{$user}->{'txquota'};
|
| 123 |
|
|
|
| 124 |
|
|
$storagequota = $Stabile::userstoragequota || $defaultstoragequota;
|
| 125 |
|
|
$nodestoragequota = $Stabile::usernodestoragequota || $defaultnodestoragequota;
|
| 126 |
|
|
$memoryquota = $usermemoryquota || $defaultmemoryquota;
|
| 127 |
|
|
$vcpuquota = $uservcpuquota || $defaultvcpuquota;
|
| 128 |
a93267ad
|
hq
|
$vmemoryquota = $uservmemoryquota || $defaultvmemoryquota;
|
| 129 |
|
|
$vgpuquota = $uservgpuquota || $defaultvgpuquota;
|
| 130 |
95b003ff
|
Origo
|
$externalipquota = $userexternalipquota || $defaultexternalipquota;
|
| 131 |
|
|
$rxquota = $userrxquota || $defaultrxquota;
|
| 132 |
|
|
$txquota = $usertxquota || $defaulttxquota;
|
| 133 |
|
|
|
| 134 |
|
|
# Create aliases of functions
|
| 135 |
|
|
*header = \&CGI::header;
|
| 136 |
|
|
|
| 137 |
|
|
*Unlinkengine = \&Linkengine;
|
| 138 |
|
|
*Updateengine = \&Linkengine;
|
| 139 |
|
|
*Saveengine = \&Linkengine;
|
| 140 |
|
|
*Syncusers = \&Linkengine;
|
| 141 |
|
|
|
| 142 |
|
|
*do_help = \&action;
|
| 143 |
|
|
*do_show = \&do_uuidshow;
|
| 144 |
|
|
*do_delete = \&do_remove;
|
| 145 |
|
|
*do_tablelist = \&do_list;
|
| 146 |
|
|
*do_billingstatus = \&do_billing;
|
| 147 |
|
|
*do_usage = \&do_billing;
|
| 148 |
|
|
*do_usagestatus = \&do_billing;
|
| 149 |
|
|
*do_billingavgstatus = \&do_billing;
|
| 150 |
|
|
*do_usageavgstatus = \&do_billing;
|
| 151 |
|
|
*do_upgradeengine = \&privileged_action;
|
| 152 |
|
|
*do_gear_upgradeengine = \&do_gear_action;
|
| 153 |
|
|
*do_backupengine = \&privileged_action;
|
| 154 |
|
|
*do_gear_backupengine = \&do_gear_action;
|
| 155 |
|
|
*do_restoreengine = \&privileged_action;
|
| 156 |
|
|
*do_gear_restoreengine = \&do_gear_action;
|
| 157 |
|
|
*do_releasepressure = \&privileged_action_async;
|
| 158 |
|
|
*do_gear_releasepressure = \&do_gear_action;
|
| 159 |
|
|
|
| 160 |
|
|
*do_linkengine = \&privileged_action;
|
| 161 |
|
|
*do_gear_linkengine = \&do_gear_action;
|
| 162 |
|
|
*do_saveengine = \&privileged_action_async;
|
| 163 |
|
|
*do_gear_saveengine = \&do_gear_action;
|
| 164 |
|
|
*do_unlinkengine = \&privileged_action;
|
| 165 |
|
|
*do_gear_unlinkengine = \&do_gear_action;
|
| 166 |
|
|
*do_updateengine = \&privileged_action;
|
| 167 |
|
|
*do_syncusers = \&privileged_action;
|
| 168 |
|
|
*do_gear_updateengine = \&do_gear_action;
|
| 169 |
|
|
*do_gear_syncusers = \&do_gear_action;
|
| 170 |
|
|
*do_deleteentirely = \&privileged_action;
|
| 171 |
|
|
*do_gear_deleteentirely = \&do_gear_action;
|
| 172 |
51e32e00
|
hq
|
*do_vent = \&privileged_action_async;
|
| 173 |
95b003ff
|
Origo
|
*do_gear_vent = \&do_gear_action;
|
| 174 |
51e32e00
|
hq
|
*do_gettimezone = \&privileged_action;
|
| 175 |
|
|
*do_gear_gettimezone = \&do_gear_action;
|
| 176 |
95b003ff
|
Origo
|
*do_updateui = \&privileged_action;
|
| 177 |
|
|
*do_gear_updateui = \&do_gear_action;
|
| 178 |
|
|
}
|
| 179 |
|
|
|
| 180 |
|
|
sub do_listaccounts {
|
| 181 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 182 |
|
|
if ($help) {
|
| 183 |
|
|
return <<END
|
| 184 |
|
|
GET:common:
|
| 185 |
|
|
List other user accounts current user has access to use and switch to. This is an internal method which includes html
|
| 186 |
|
|
specifically for use with Dojo.
|
| 187 |
|
|
END
|
| 188 |
|
|
}
|
| 189 |
|
|
my $common = $params{'common'};
|
| 190 |
|
|
my %bhash;
|
| 191 |
|
|
my @accounts = split(/,\s*/, $register{$tktuser}->{'accounts'});
|
| 192 |
|
|
my @accountsprivs = split(/,\s*/, $register{$tktuser}->{'accountsprivileges'});
|
| 193 |
|
|
for my $i (0 .. $#accounts) {
|
| 194 |
|
|
$bhash{$accounts[$i]} = {
|
| 195 |
|
|
id=>$accounts[$i],
|
| 196 |
|
|
privileges=>$accountsprivs[$i] || 'r'
|
| 197 |
|
|
} if ($register{$accounts[$i]}); # Only include accounts that exist on this engine
|
| 198 |
|
|
};
|
| 199 |
|
|
$bhash{$tktuser} = {id=>$tktuser, privileges=>$privileges};
|
| 200 |
|
|
delete $bhash{$user};
|
| 201 |
|
|
$bhash{'common'} = {id=>'common', privileges=>'--'} if ($common);
|
| 202 |
|
|
my @bvalues = values %bhash;
|
| 203 |
|
|
unshift(@bvalues, {id=>$user, privileges=>$privileges});
|
| 204 |
|
|
my $logout = {privileges=>'', id=>'<span class="glyphicon glyphicon-log-out" aria-hidden="true" style="font-size:15px;color:#3c3c3c; vertical-align:top; margin-top:8px;"></span> Log out '};
|
| 205 |
|
|
push(@bvalues, $logout) unless ($common);
|
| 206 |
|
|
$postreply = "{\"identifier\": \"id\",\"label\": \"id\", \"items\":" . JSON::to_json(\@bvalues, {pretty=>1}) . "}";
|
| 207 |
|
|
return $postreply;
|
| 208 |
|
|
}
|
| 209 |
|
|
|
| 210 |
|
|
sub do_listids {
|
| 211 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 212 |
|
|
if ($help) {
|
| 213 |
|
|
return <<END
|
| 214 |
|
|
GET::
|
| 215 |
|
|
List other user accounts current user has read access to. Call with flat=1 if you want a flat array.
|
| 216 |
|
|
END
|
| 217 |
|
|
}
|
| 218 |
|
|
require "$Stabile::basedir/cgi/images.cgi";
|
| 219 |
|
|
my $backupdevice = Stabile::Images::Getbackupdevice('', 'getbackupdevice');
|
| 220 |
|
|
my $imagesdevice = Stabile::Images::Getimagesdevice('', 'getimagesdevice');
|
| 221 |
|
|
my $mounts = `cat /proc/mounts | grep zfs`;
|
| 222 |
|
|
my %engine_h;
|
| 223 |
|
|
my $zbackupavailable = ( (($mounts =~ /$backupdevice\/backup (\S+) zfs/) && ($mounts =~ /$imagesdevice\/images (\S+) zfs/) )?1:'');
|
| 224 |
|
|
my $jsontext = qq|{"identifier": "id","label": "id", "items":[| .
|
| 225 |
|
|
qq|{"id": "$user", "privileges": "$privileges", "userprivileges": "$dbprivileges", "tktuser": "$tktuser", |.
|
| 226 |
a93267ad
|
hq
|
qq|"storagequota": $storagequota, "nodestoragequota": $nodestoragequota, "memoryquota": $memoryquota, "vcpuquota": $vcpuquota, "vmemoryquota": $vmemoryquota, "vgpuquota": $vgpuquota, |.
|
| 227 |
95b003ff
|
Origo
|
qq|"fullname": "$fullname", "email": "$email", "opemail": "$opemail", "alertemail": "$alertemail", |.
|
| 228 |
|
|
qq|"phone": "$phone", "opphone": "$opphone", "opfullname": "$opfullname", "appstoreurl": "$appstoreurl", |.
|
| 229 |
71b897d3
|
hq
|
qq|"allowfrom": "$allowfrom", "lastlogin": "$lastlogin", "lastloginfrom": "$lastloginfrom", "allowinternalapi": "$allowinternalapi", "billto": "$billto", |.
|
| 230 |
45cc3024
|
hq
|
qq|"dnsdomain": "$dnsdomain", "appstoreurl": "$appstoreurl", |;
|
| 231 |
95b003ff
|
Origo
|
|
| 232 |
|
|
if ($isadmin && $engineid) {
|
| 233 |
|
|
$engine_h{"engineid"} = $engineid;
|
| 234 |
|
|
$engine_h{"engineuser"} = $engineuser;
|
| 235 |
|
|
$engine_h{"externaliprangestart"} = $externaliprangestart;
|
| 236 |
|
|
$engine_h{"externaliprangeend"} = $externaliprangeend;
|
| 237 |
|
|
$engine_h{"proxyiprangestart"} = $proxyiprangestart;
|
| 238 |
|
|
$engine_h{"proxyiprangeend"} = $proxyiprangeend;
|
| 239 |
|
|
$engine_h{"proxygw"} = $proxygw;
|
| 240 |
|
|
|
| 241 |
|
|
$engine_h{"disablesnat"} = $disablesnat;
|
| 242 |
|
|
$engine_h{"imagesdevice"} = $imagesdevice;
|
| 243 |
|
|
$engine_h{"backupdevice"} = $backupdevice;
|
| 244 |
|
|
|
| 245 |
|
|
my $nodecfg = new Config::Simple("/etc/stabile/nodeconfig.cfg");
|
| 246 |
|
|
my $readlimit = $nodecfg->param('VM_READ_LIMIT'); # e.g. 125829120 = 120 * 1024 * 1024 = 120 MB / s
|
| 247 |
|
|
my $writelimit = $nodecfg->param('VM_WRITE_LIMIT');
|
| 248 |
|
|
my $iopsreadlimit = $nodecfg->param('VM_IOPS_READ_LIMIT'); # e.g. 1000 IOPS
|
| 249 |
|
|
my $iopswritelimit = $nodecfg->param('VM_IOPS_WRITE_LIMIT');
|
| 250 |
|
|
$engine_h{"vmreadlimit"} = $readlimit;
|
| 251 |
|
|
$engine_h{"vmwritelimit"} = $writelimit;
|
| 252 |
|
|
$engine_h{"vmiopsreadlimit"} = $iopsreadlimit;
|
| 253 |
|
|
$engine_h{"vmiopswritelimit"} = $iopswritelimit;
|
| 254 |
d3805c61
|
hq
|
$engine_h{"enforceiolimits"} = $enforceiolimits;
|
| 255 |
95b003ff
|
Origo
|
|
| 256 |
|
|
$engine_h{"zfsavailable"} = $zbackupavailable;
|
| 257 |
|
|
$engine_h{"downloadmasters"} = $downloadmasters;
|
| 258 |
f222b89c
|
hq
|
$engine_h{"downloadallmasters"} = $downloadallmasters;
|
| 259 |
95b003ff
|
Origo
|
}
|
| 260 |
6fdc8676
|
hq
|
if (-e "/var/www/stabile/static/img/logo-icon-" . $ENV{HTTP_HOST} . ".png") {
|
| 261 |
|
|
$jsontext .= qq|"favicon": "/stabile/static/img/logo-icon-$ENV{HTTP_HOST}.png", |;
|
| 262 |
|
|
}
|
| 263 |
c899e439
|
Origo
|
$engine_h{"enginename"} = $enginename;
|
| 264 |
|
|
$engine_h{"enginelinked"} = $enginelinked;
|
| 265 |
a2e0bc7e
|
hq
|
$engine_h{"remoteipenabled"} = $Stabile::remoteipenabled;
|
| 266 |
a93267ad
|
hq
|
$engine_h{"gpupassthroughenabled"} = $Stabile::gpupassthroughenabled;
|
| 267 |
95b003ff
|
Origo
|
$jsontext .= "\"showcost\": \"$showcost\", ";
|
| 268 |
|
|
$jsontext .= "\"externalipquota\": $externalipquota, \"rxquota\": $rxquota, \"txquota\": $txquota, ";
|
| 269 |
|
|
$jsontext .= qq|"defaultstoragequota": $defaultstoragequota, "defaultnodestoragequota": $defaultnodestoragequota, "defaultmemoryquota": $defaultmemoryquota, "defaultvcpuquota": $defaultvcpuquota, |;
|
| 270 |
|
|
$jsontext .= "\"defaultexternalipquota\": $defaultexternalipquota, \"defaultrxquota\": $defaultrxquota, \"defaulttxquota\": $defaulttxquota, ";
|
| 271 |
|
|
$jsontext .= qq|"engine": | . to_json(\%engine_h);
|
| 272 |
|
|
$jsontext .= "}, ";
|
| 273 |
a93267ad
|
hq
|
# Add common user
|
| 274 |
95b003ff
|
Origo
|
$jsontext .= "{\"id\": \"common\", \"privileges\": \"--\"," .
|
| 275 |
|
|
"\"fullname\": \"--\", \"email\": \"--\"," .
|
| 276 |
a93267ad
|
hq
|
"\"storagequota\": 0, \"memoryquota\": 0, \"vcpuquota\": 0, \"vmemoryquota\": 0, \"vgpuquota\": 0, \"externalipquota\": 0," .
|
| 277 |
95b003ff
|
Origo
|
"\"rxquota\": 0, \"txquota\": 0}";
|
| 278 |
|
|
|
| 279 |
|
|
$jsontext .= ", {\"id\": \"$billto\"}" if ($billto && $billto ne '--');
|
| 280 |
|
|
|
| 281 |
|
|
foreach my $aid (keys %ahash) {
|
| 282 |
|
|
my $privs = $ahash{$aid};
|
| 283 |
|
|
$jsontext .= qq|, {"id": "$aid", "privileges": "$privs"}| unless ($aid eq $user || $aid eq $billto);
|
| 284 |
|
|
}
|
| 285 |
|
|
|
| 286 |
|
|
$jsontext .= "]}";
|
| 287 |
|
|
# Create ui_update link in case we are logging in with a remotely generated ticket, i.e. not passing through login.cgi
|
| 288 |
|
|
`/bin/ln -s ../ui_update.cgi ../cgi/ui_update/$user~ui_update.cgi` unless (-e "../cgi/ui_update/$user~ui_update.cgi");
|
| 289 |
|
|
$postreply = to_json(from_json($jsontext), {pretty=>1});
|
| 290 |
|
|
return $postreply;
|
| 291 |
|
|
}
|
| 292 |
|
|
|
| 293 |
|
|
sub do_listengines{
|
| 294 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 295 |
|
|
if ($help) {
|
| 296 |
|
|
return <<END
|
| 297 |
|
|
GET::
|
| 298 |
|
|
List other engines user has access to
|
| 299 |
|
|
END
|
| 300 |
|
|
}
|
| 301 |
|
|
if ($enginelinked) {
|
| 302 |
|
|
require LWP::Simple;
|
| 303 |
|
|
my $browser = LWP::UserAgent->new;
|
| 304 |
|
|
$browser->agent('stabile/1.0b');
|
| 305 |
|
|
$browser->protocols_allowed( [ 'http','https'] );
|
| 306 |
|
|
|
| 307 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 308 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 309 |
|
|
|
| 310 |
|
|
$postreq->{'engineid'} = $engineid;
|
| 311 |
2a63870a
|
Christian Orellana
|
$postreq->{'user'} = $user;
|
| 312 |
95b003ff
|
Origo
|
$postreq->{'enginetkthash'} = Digest::SHA::sha512_hex($tktkey);
|
| 313 |
6372a66e
|
hq
|
$postreq->{'api'} = $params{api};
|
| 314 |
|
|
$postreq->{'usertkt'} = $params{auth_tkt};
|
| 315 |
95b003ff
|
Origo
|
|
| 316 |
48fcda6b
|
Origo
|
my $content = $browser->post("https://www.stabile.io/irigo/engine.cgi?action=listengines", $postreq)->content();
|
| 317 |
95b003ff
|
Origo
|
if ($content =~ /ERROR:(.+)"/) {
|
| 318 |
|
|
$postreply = qq|{"identifier": "url", "label": "name", "items": [{"url": "# $1", "name": "$enginename"}]}|;
|
| 319 |
|
|
} else {
|
| 320 |
|
|
$postreply = qq|{"identifier": "url", "label": "name", "items": $content}|;
|
| 321 |
|
|
}
|
| 322 |
|
|
} else {
|
| 323 |
|
|
$postreply = qq|{"identifier": "url", "label": "name", "items": [{"url": "#", "name": "$enginename"}]}|;
|
| 324 |
|
|
}
|
| 325 |
|
|
return $postreply;
|
| 326 |
|
|
}
|
| 327 |
|
|
|
| 328 |
6372a66e
|
hq
|
sub do_listengineconfigs{
|
| 329 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 330 |
|
|
if ($help) {
|
| 331 |
|
|
return <<END
|
| 332 |
|
|
GET::
|
| 333 |
|
|
List configs of engines user has access to
|
| 334 |
|
|
END
|
| 335 |
|
|
}
|
| 336 |
|
|
if ($enginelinked) {
|
| 337 |
|
|
require LWP::Simple;
|
| 338 |
|
|
my $browser = LWP::UserAgent->new;
|
| 339 |
|
|
$browser->agent('stabile/1.0b');
|
| 340 |
|
|
$browser->protocols_allowed( [ 'http','https'] );
|
| 341 |
|
|
|
| 342 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 343 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 344 |
|
|
|
| 345 |
|
|
$postreq->{'engineid'} = $engineid;
|
| 346 |
|
|
$postreq->{'user'} = $user;
|
| 347 |
|
|
$postreq->{'username'} = $params{username};
|
| 348 |
|
|
$postreq->{'usertkt'} = $params{auth_tkt};
|
| 349 |
|
|
$postreq->{'enginetkthash'} = Digest::SHA::sha512_hex($tktkey);
|
| 350 |
|
|
|
| 351 |
|
|
my $content = $browser->post("https://www.stabile.io/irigo/engine.cgi?action=listengineconfigs", $postreq)->content();
|
| 352 |
|
|
$postreply = $content;
|
| 353 |
|
|
} else {
|
| 354 |
|
|
$postreply = qq|{"status": "Error", "message": "Engine not linked"}|;
|
| 355 |
|
|
}
|
| 356 |
|
|
return $postreply;
|
| 357 |
|
|
}
|
| 358 |
|
|
|
| 359 |
95b003ff
|
Origo
|
sub do_billing {
|
| 360 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 361 |
|
|
if ($help) {
|
| 362 |
|
|
return <<END
|
| 363 |
|
|
GET:uuid,username,month,startmonth,endmonth,format:
|
| 364 |
d24d9a01
|
hq
|
List usage data, optionally for specific server/system [uuid] or user [username]. May be called as usage, usagestatus or usageavgstatus.
|
| 365 |
95b003ff
|
Origo
|
When called as "usage", format may be csv, in which case startmonth and endmonth may be specified.
|
| 366 |
|
|
END
|
| 367 |
|
|
}
|
| 368 |
|
|
my $buser = $params{'user'} || $params{'username'} || $user;
|
| 369 |
|
|
my $bmonth = $params{'month'} || $month;
|
| 370 |
|
|
$bmonth = substr("0$bmonth", -2);
|
| 371 |
|
|
my $byear = $params{'year'} || $year;
|
| 372 |
a93267ad
|
hq
|
my $vcpu=0, $memory=0, $vgpu=0, $vmemory=0, $virtualsize=0, $nodevirtualsize=0, $backupsize=0, $externalip=0;
|
| 373 |
95b003ff
|
Origo
|
my $rx = 0;
|
| 374 |
|
|
my $tx = 0;
|
| 375 |
|
|
my $vcpuavg = 0;
|
| 376 |
a93267ad
|
hq
|
my $vgpuavg = 0;
|
| 377 |
95b003ff
|
Origo
|
my $externalipavg = 0;
|
| 378 |
|
|
$uuid = '' if ($register{$uuid}); # check if $uuid was set to $user because no actual uuid passed
|
| 379 |
|
|
|
| 380 |
|
|
if ($user eq $buser || index($privileges,"a")!=-1) {
|
| 381 |
|
|
my %stats = collectBillingData( $uuid, $buser, $bmonth, $byear, $showcost );
|
| 382 |
|
|
my $memoryquotagb = int(0.5 + 100*$memoryquota/1024)/100;
|
| 383 |
a93267ad
|
hq
|
my $vmemoryquotagb = int(0.5 + 100*$vmemoryquota/1024)/100;
|
| 384 |
95b003ff
|
Origo
|
my $storagequotagb = int(0.5 + 100*$storagequota/1024)/100;
|
| 385 |
|
|
my $nodestoragequotagb = int(0.5 + 100*$nodestoragequota/1024)/100;
|
| 386 |
|
|
my $irigo_cost = ($showcost?"showcost":"hidecost");
|
| 387 |
|
|
|
| 388 |
|
|
if ($action eq "billing" || $action eq "usage") {
|
| 389 |
|
|
if ($params{'format'} eq 'csv') {
|
| 390 |
|
|
$postreply = header("text/plain");
|
| 391 |
|
|
my $startmonth = $params{'startmonth'} || 1;
|
| 392 |
|
|
my $endmonth = $params{'endmonth'} || $bmonth;
|
| 393 |
|
|
my @vals;
|
| 394 |
|
|
for (my $i=$startmonth; $i<=$endmonth; $i++) {
|
| 395 |
|
|
my $m = substr("0$i", -2);
|
| 396 |
|
|
my %mstats = collectBillingData( $uuid, $buser, $m, $byear, $showcost );
|
| 397 |
|
|
push @vals, \%mstats;
|
| 398 |
|
|
}
|
| 399 |
|
|
csv(in => \@vals, out => \my $csvdata);
|
| 400 |
|
|
$postreply .= $csvdata;
|
| 401 |
|
|
} else {
|
| 402 |
|
|
my $json_text = JSON::to_json(\%stats, {pretty => 1});
|
| 403 |
|
|
$postreply = "$json_text";
|
| 404 |
|
|
}
|
| 405 |
|
|
|
| 406 |
|
|
} elsif ($action eq "billingstatus" || $action eq "usagestatus") {
|
| 407 |
2a63870a
|
Christian Orellana
|
my $virtualsizegb = $stats{'virtualsize'};
|
| 408 |
|
|
my $backupsizegb = $stats{'backupsize'};
|
| 409 |
|
|
my $externalip = $stats{'externalip'};
|
| 410 |
|
|
my $memorygb = $stats{'memory'};
|
| 411 |
a93267ad
|
hq
|
my $vmemorygb = $stats{'vmemory'};
|
| 412 |
2a63870a
|
Christian Orellana
|
my $nodevirtualsizegb = $stats{'nodevirtualsize'};
|
| 413 |
95b003ff
|
Origo
|
$rx = $stats{'rx'};
|
| 414 |
|
|
$tx = $stats{'tx'};
|
| 415 |
|
|
$vcpu = $stats{'vcpu'};
|
| 416 |
a93267ad
|
hq
|
$vgpu = $stats{'vgpu'};
|
| 417 |
95b003ff
|
Origo
|
|
| 418 |
|
|
my $res;
|
| 419 |
|
|
if ($params{'format'} eq 'html') {
|
| 420 |
|
|
$postreply .= header("text/html");
|
| 421 |
|
|
$res .= qq[<tr><th>Ressource</th><th>Quantity</th><th class="$irigo_cost">Cost/month</th><th>Quota</th></tr>];
|
| 422 |
a93267ad
|
hq
|
|
| 423 |
|
|
$res .= qq[<tr><td>vCPUs:</td><td align="right">$vcpu</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$vcpu*$vcpuprice) . qq[</td><td align="right">$vcpuquota</td></tr>];
|
| 424 |
95b003ff
|
Origo
|
$res .= qq[<tr><td>Memory:</td><td align="right">$memorygb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$memorygb*$memoryprice) . qq[</td><td align="right">$memoryquotagb GB</td></tr>];
|
| 425 |
a93267ad
|
hq
|
|
| 426 |
|
|
$res .= qq[<tr><td>vGPUs:</td><td align="right">$vgpu</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$vgpu*$vgpuprice) . qq[</td><td align="right">$vgpuquota</td></tr>];
|
| 427 |
|
|
$res .= qq[<tr><td>vMemory:</td><td align="right">$vmemorygb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$vmemorygb*$vmemoryprice) . qq[</td><td align="right">$vmemoryquotagb GB</td></tr>];
|
| 428 |
|
|
|
| 429 |
95b003ff
|
Origo
|
$res .= qq[<tr><td>Shared storage:</td><td align="right">$virtualsizegb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$virtualsizegb*$storageprice) . qq[</td><td align="right">$storagequotagb GB</td></tr>];
|
| 430 |
|
|
$res .= qq[<tr><td>Node storage:</td><td align="right">$nodevirtualsizegb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$nodevirtualsizegb*$nodestorageprice) . qq[</td><td align="right">$nodestoragequotagb GB</td></tr>];
|
| 431 |
8d7785ff
|
Origo
|
$res .= qq[<tr><td>Backup storage (est.):</td><td align="right">$backupsizegb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$backupsizegb*$storageprice) . qq[</td><td align="right">∞</td></tr>];
|
| 432 |
95b003ff
|
Origo
|
$res .= qq[<tr><td>External IP addresses:</td><td align="right">$externalip</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$externalip*$externalipprice) . qq[</td><td align="right">$externalipquota</td></tr>];
|
| 433 |
|
|
if (!$uuid) {
|
| 434 |
8d7785ff
|
Origo
|
$res .= qq[<tr><td>Network traffic out:</td><td align="right">] . $rx . qq[ GB</td><td align="right" class="$irigo_cost">$cur 0</td><td align="right">] . int(0.5 + $rxquota/1024/1024) . qq[ GB</td></tr>];
|
| 435 |
|
|
$res .= qq[<tr><td>Network traffic in:</td><td align="right">] . $tx . qq[ GB</td><td align="right" class="$irigo_cost">$cur 0</td><td align="right">] . int(0.5 + $txquota/1024/1024) . qq[ GB</td></tr>];
|
| 436 |
95b003ff
|
Origo
|
}
|
| 437 |
|
|
|
| 438 |
|
|
$res =~ s/-1/∞/g;
|
| 439 |
|
|
$res =~ s/>0 .B<\/td><\/tr>/>∞<\/td><\/tr>/g;
|
| 440 |
|
|
$postreply .= qq[<table cellspacing="0" noframe="void" norules="rows" class="systemTables">$res</table>];
|
| 441 |
|
|
} else {
|
| 442 |
|
|
my $bill = {
|
| 443 |
|
|
vcpus => {quantity => $vcpu, quota => $vcpuquota},
|
| 444 |
|
|
memory => {quantity => $memorygb, unit => 'GB', quota => $memoryquotagb},
|
| 445 |
a93267ad
|
hq
|
vgpus => {quantity => $vgpu, quota => $vgpuquota},
|
| 446 |
|
|
vmemory => {quantity => $vmemorygb, unit => 'GB', quota => $vmemoryquotagb},
|
| 447 |
95b003ff
|
Origo
|
shared_storage => {quantity => $virtualsizegb, unit => 'GB', quota => $storagequotagb},
|
| 448 |
|
|
node_storage => {quantity => $nodevirtualsizegb, unit => 'GB', quota => $nodestoragequotagb},
|
| 449 |
|
|
backup_storage => {quantity => $backupsizegb, unit => 'GB'},
|
| 450 |
|
|
external_ips => {quantity => $externalip, quota => $externalipquota},
|
| 451 |
8d7785ff
|
Origo
|
network_traffic_out => {quantity => $rx, unit => 'GB', quota => int(0.5 + $rxquota/1024/1024)},
|
| 452 |
|
|
network_traffic_in => {quantity => $tx, unit => 'GB', quota => int(0.5 + $txquota/1024/1024)}
|
| 453 |
95b003ff
|
Origo
|
};
|
| 454 |
|
|
if ($showcost) {
|
| 455 |
|
|
$bill->{vcpus}->{cost} = int(0.5+$vcpu*$vcpuprice);
|
| 456 |
|
|
$bill->{memory}->{cost} = int(0.5+$memorygb*$memoryprice);
|
| 457 |
a93267ad
|
hq
|
$bill->{vgpus}->{cost} = int(0.5+$vgpu*$vgpuprice);
|
| 458 |
|
|
$bill->{vmemory}->{cost} = int(0.5+$vmemorygb*$vmemoryprice);
|
| 459 |
95b003ff
|
Origo
|
$bill->{shared_storage}->{cost} = int(0.5+$virtualsizegb*$storageprice);
|
| 460 |
|
|
$bill->{node_storage}->{cost} = int(0.5+$nodevirtualsizegb*$nodestorageprice);
|
| 461 |
|
|
$bill->{backup_storage}->{cost} = int(0.5+$backupsizegb*$storageprice);
|
| 462 |
|
|
$bill->{external_ips}->{cost} = int(0.5+$externalip*$externalipprice);
|
| 463 |
|
|
$bill->{currency} = $cur;
|
| 464 |
|
|
$bill->{username} = $buser;
|
| 465 |
|
|
}
|
| 466 |
|
|
$postreply .= to_json($bill, {pretty=>1});
|
| 467 |
|
|
}
|
| 468 |
|
|
} elsif ($action eq "billingavgstatus" || $action eq "usageavgstatus") {
|
| 469 |
2a63870a
|
Christian Orellana
|
my $virtualsizeavggb = $stats{'virtualsizeavg'};
|
| 470 |
|
|
my $backupsizeavggb = $stats{'backupsizeavg'};
|
| 471 |
|
|
my $nodevirtualsizeavggb = $stats{'nodevirtualsizeavg'};
|
| 472 |
a93267ad
|
hq
|
my $memoryavggb = $stats{'memoryavg'};
|
| 473 |
|
|
my $vmemoryavggb = $stats{'vmemoryavg'};
|
| 474 |
95b003ff
|
Origo
|
$vcpuavg = $stats{'vcpuavg'};
|
| 475 |
a93267ad
|
hq
|
$vgpuavg = $stats{'vgpuavg'};
|
| 476 |
95b003ff
|
Origo
|
$externalipavg = $stats{'externalipavg'};
|
| 477 |
|
|
$rx = $stats{'rx'};
|
| 478 |
|
|
$tx = $stats{'tx'};
|
| 479 |
|
|
if ($params{'format'} eq 'html') {
|
| 480 |
|
|
$postreply .= header("text/html");
|
| 481 |
|
|
my $res;
|
| 482 |
|
|
$res .= qq[<tr><th>Ressource</th><th>Quantity</th><th class="$irigo_cost">Cost/month</th><th>Quota</th></tr>];
|
| 483 |
a93267ad
|
hq
|
|
| 484 |
|
|
$res .= qq[<tr><td>vCPUs:</td><td align="right">] . int(0.5+100*$vcpuavg)/100 . qq[</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$vcpuavg*$vcpuprice) . qq[</td><td align="right">$vcpuquota</td></tr>];
|
| 485 |
95b003ff
|
Origo
|
$res .= qq[<tr><td>Memory:</td><td align="right">$memoryavggb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$memoryavggb*$memoryprice) . qq[</td><td align="right">$memoryquotagb GB</td></tr>];
|
| 486 |
a93267ad
|
hq
|
|
| 487 |
|
|
$res .= qq[<tr><td>vGPUs:</td><td align="right">] . int(0.5+100*$vgpuavg)/100 . qq[</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$vgpuavg*$vgpuprice) . qq[</td><td align="right">$vgpuquota</td></tr>];
|
| 488 |
|
|
$res .= qq[<tr><td>vMemory:</td><td align="right">$vmemoryavggb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$vmemoryavggb*$vmemoryprice) . qq[</td><td align="right">$vmemoryquotagb GB</td></tr>];
|
| 489 |
|
|
|
| 490 |
95b003ff
|
Origo
|
$res .= qq[<tr><td>Shared storage:</td><td align="right">$virtualsizeavggb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$virtualsizeavggb*$storageprice) . qq[</td><td align="right">$storagequotagb GB</td></tr>];
|
| 491 |
|
|
$res .= qq[<tr><td>Node storage:</td><td align="right">$nodevirtualsizeavggb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$nodevirtualsizeavggb*$nodestorageprice) . qq[</td><td align="right">$nodestoragequotagb GB</td></tr>];
|
| 492 |
8d7785ff
|
Origo
|
$res .= qq[<tr><td>Backup storage (est.):</td><td align="right">$backupsizeavggb GB</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$backupsizeavggb*$storageprice) . qq[</td><td align="right">∞</td></tr>];
|
| 493 |
95b003ff
|
Origo
|
$res .= qq[<tr><td>External IP addresses:</td><td align="right">] . int(0.5+100*$externalipavg)/100 . qq[</td><td align="right" class="$irigo_cost">$cur ] . int(0.5+$externalipavg*$externalipprice) . qq[</td><td align="right">$externalipquota</td></tr>];
|
| 494 |
|
|
$res .= qq[<tr><td>Network traffic in:</td><td align="right">] . int(0.5 + $rx) . qq[ GB</td><td align="right" class="$irigo_cost">$cur 0</td><td align="right">] . int(0.5 + $rxquota/1024/1024) . qq[ GB</td></tr>];
|
| 495 |
|
|
$res .= qq[<tr><td>Network traffic out:</td><td align="right">] . int(0.5 + $tx) . qq[ GB</td><td align="right" class="$irigo_cost">$cur 0</td><td align="right">] . int(0.5 + $txquota/1024/1024) . qq[ GB</td></tr>];
|
| 496 |
|
|
|
| 497 |
|
|
$res =~ s/-1/∞/g;
|
| 498 |
|
|
$res =~ s/>0 .B<\/td><\/tr>/>∞<\/td><\/tr>/g;
|
| 499 |
|
|
$postreply .= qq[<table cellspacing="0" noframe="void" norules="rows" class="systemTables">$res</table>];
|
| 500 |
|
|
} else {
|
| 501 |
|
|
my $bill = {
|
| 502 |
|
|
vcpus => {quantity => $vcpuavg, quota => $vcpuquota},
|
| 503 |
|
|
memory => {quantity => $memoryavggb, unit => 'GB', quota => $memoryquotagb},
|
| 504 |
a93267ad
|
hq
|
vgpus => {quantity => $vgpuavg, quota => $vgpuquota},
|
| 505 |
|
|
vmemory => {quantity => $vmemoryavggb, unit => 'GB', quota => $vmemoryquotagb},
|
| 506 |
95b003ff
|
Origo
|
shared_storage => {quantity => $virtualsizeavggb, unit => 'GB', quota => $storagequotagb},
|
| 507 |
|
|
node_storage => {quantity => $nodevirtualsizeavggb, unit => 'GB', quota => $nodestoragequotagb},
|
| 508 |
|
|
backup_storage => {quantity => $backupsizeavggb, unit => 'GB'},
|
| 509 |
|
|
external_ips => {quantity => $externalipavg, quota => $externalipquota},
|
| 510 |
|
|
network_traffic_out => {quantity => int(0.5 + $rx), unit => 'GB', quota => int(0.5 + $rxquota/1024/1024)},
|
| 511 |
|
|
network_traffic_in => {quantity => int(0.5 + $tx), unit => 'GB', quota => int(0.5 + $txquota/1024/1024)}
|
| 512 |
|
|
};
|
| 513 |
|
|
if ($showcost) {
|
| 514 |
|
|
$bill->{vcpus}->{cost} = int(0.5+$vcpuavg*$vcpuprice);
|
| 515 |
|
|
$bill->{memory}->{cost} = int(0.5+$memoryavggb*$memoryprice);
|
| 516 |
a93267ad
|
hq
|
$bill->{vgpus}->{cost} = int(0.5+$vgpuavg*$vgpuprice);
|
| 517 |
|
|
$bill->{vmemory}->{cost} = int(0.5+$vmemoryavggb*$vmemoryprice);
|
| 518 |
95b003ff
|
Origo
|
$bill->{shared_storage}->{cost} = int(0.5+$virtualsizeavggb*$storageprice);
|
| 519 |
|
|
$bill->{node_storage}->{cost} = int(0.5+$nodevirtualsizeavggb*$nodestorageprice);
|
| 520 |
|
|
$bill->{backup_storage}->{cost} = int(0.5+$backupsizeavggb*$storageprice);
|
| 521 |
|
|
$bill->{external_ips}->{cost} = int(0.5+$externalipavg*$externalipprice);
|
| 522 |
|
|
$bill->{currency} = $cur;
|
| 523 |
|
|
$bill->{username} = $buser;
|
| 524 |
|
|
}
|
| 525 |
|
|
$postreply .= to_json($bill, {pretty=>1});
|
| 526 |
|
|
}
|
| 527 |
|
|
}
|
| 528 |
|
|
} else {
|
| 529 |
|
|
$postreply .= "Status=ERROR no privileges!!\n";
|
| 530 |
|
|
}
|
| 531 |
|
|
return $postreply;
|
| 532 |
|
|
}
|
| 533 |
|
|
|
| 534 |
|
|
sub do_listenginebackups {
|
| 535 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 536 |
|
|
if ($help) {
|
| 537 |
|
|
return <<END
|
| 538 |
|
|
GET::
|
| 539 |
48fcda6b
|
Origo
|
List the backups of this engine's configuration in the registry.
|
| 540 |
95b003ff
|
Origo
|
END
|
| 541 |
|
|
}
|
| 542 |
|
|
if ($enginelinked) {
|
| 543 |
|
|
require LWP::Simple;
|
| 544 |
|
|
my $browser = LWP::UserAgent->new;
|
| 545 |
|
|
$browser->agent('stabile/1.0b');
|
| 546 |
|
|
$browser->protocols_allowed( [ 'http','https'] );
|
| 547 |
|
|
|
| 548 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 549 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 550 |
|
|
|
| 551 |
|
|
$postreq->{'engineid'} = $engineid;
|
| 552 |
|
|
$postreq->{'enginetkthash'} = Digest::SHA::sha512_hex($tktkey);
|
| 553 |
|
|
|
| 554 |
48fcda6b
|
Origo
|
my $content = $browser->post("https://www.stabile.io/irigo/engine.cgi?action=listbackups", $postreq)->content();
|
| 555 |
95b003ff
|
Origo
|
if ($content =~ /\[\]/) {
|
| 556 |
|
|
$postreply = qq|{"identifier": "path", "label": "name", "items": [{"path": "#", "name": "No backups"}]}|;
|
| 557 |
|
|
} else {
|
| 558 |
|
|
$postreply = qq|{"identifier": "path", "label": "name", "items": $content}|;
|
| 559 |
|
|
}
|
| 560 |
|
|
} else {
|
| 561 |
|
|
$postreply = qq|{"identifier": "path", "label": "name", "items": [{"path": "#", "name": "Engine not linked"}]}|;
|
| 562 |
|
|
}
|
| 563 |
|
|
return $postreply;
|
| 564 |
|
|
}
|
| 565 |
|
|
|
| 566 |
|
|
sub Backupengine {
|
| 567 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 568 |
|
|
if ($help) {
|
| 569 |
|
|
return <<END
|
| 570 |
|
|
GET::
|
| 571 |
48fcda6b
|
Origo
|
Backup this engine's configuration to the registry.
|
| 572 |
95b003ff
|
Origo
|
END
|
| 573 |
|
|
}
|
| 574 |
|
|
my $backupname = "$enginename.$engineid.$pretty_time";
|
| 575 |
|
|
$backupname =~ tr/:/-/; # tar has a problem with colons in filenames
|
| 576 |
|
|
if (-e "/tmp/$backupname.tgz") {
|
| 577 |
|
|
$postreply .= "Status=ERROR Engine is already being backed up";
|
| 578 |
|
|
} else {
|
| 579 |
|
|
$res .= `mysqldump --ignore-table=steamregister.nodeidentities steamregister > /etc/stabile/steamregister.sql`;
|
| 580 |
|
|
$res .= `cp /etc/apache2/conf-available/auth_tkt_cgi.conf /etc/stabile`;
|
| 581 |
|
|
$res .= `cp /etc/apache2/ssl/*.crt /etc/stabile`;
|
| 582 |
|
|
$res .= `cp /etc/apache2/ssl/*.pem /etc/stabile`;
|
| 583 |
|
|
$res .= `cp /etc/apache2/ssl/*.key /etc/stabile`;
|
| 584 |
|
|
$res .= `cp /etc/hosts.allow /etc/stabile`;
|
| 585 |
|
|
$res .= `cp /etc/mon/mon.cf /etc/stabile`;
|
| 586 |
|
|
|
| 587 |
|
|
# copy default node configuration to /etc/stabile
|
| 588 |
|
|
unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities', key=>'identity'}, $Stabile::dbopts)) ) {return "Unable to access identity register"};
|
| 589 |
|
|
|
| 590 |
|
|
my $defaultpath = $idreg{'default'}->{'path'} . "/casper/filesystem.dir/etc/stabile/nodeconfig.cfg";
|
| 591 |
|
|
$res .= `cp $defaultpath /etc/stabile`;
|
| 592 |
|
|
|
| 593 |
|
|
# Make tarball
|
| 594 |
|
|
my $cmd = qq[(cd /etc/stabile; /bin/tar -czf "/tmp/$backupname.tgz" * 2>/dev/null)];
|
| 595 |
|
|
$res .= `$cmd`;
|
| 596 |
|
|
|
| 597 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 598 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 599 |
|
|
my $enginetkthash = Digest::SHA::sha512_hex($tktkey);
|
| 600 |
|
|
|
| 601 |
48fcda6b
|
Origo
|
my $res = `/usr/bin/curl -k -F engineid=$engineid -F enginetkthash=$enginetkthash -F filedata=@"/tmp/$backupname.tgz" https://www.stabile.io/irigo/engine.cgi?action=backup`;
|
| 602 |
95b003ff
|
Origo
|
if ($res =~ /OK: $backupname.tgz received/) {
|
| 603 |
48fcda6b
|
Origo
|
$postreply .= "Status=OK Engine configuration saved to the registry";
|
| 604 |
|
|
$main::syslogit->($user, "info", "Engine configuration saved to the registry");
|
| 605 |
95b003ff
|
Origo
|
unlink("/tmp/$backupname.tgz");
|
| 606 |
|
|
} else {
|
| 607 |
48fcda6b
|
Origo
|
$postreply .= "Status=ERROR Problem backing configuration up to the registry\n$res\n";
|
| 608 |
95b003ff
|
Origo
|
}
|
| 609 |
|
|
}
|
| 610 |
|
|
return $postreply;
|
| 611 |
|
|
}
|
| 612 |
|
|
|
| 613 |
|
|
sub Upgradeengine {
|
| 614 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 615 |
|
|
if ($help) {
|
| 616 |
|
|
return <<END
|
| 617 |
|
|
GET::
|
| 618 |
48fcda6b
|
Origo
|
Try to upgrade this engine to latest release from the registry
|
| 619 |
95b003ff
|
Origo
|
END
|
| 620 |
|
|
}
|
| 621 |
4aef7ef6
|
hq
|
$postreply = "Status=OK Requesting upgrade of Stabile\n";
|
| 622 |
|
|
print header("text/plain"), $postreply;
|
| 623 |
95b003ff
|
Origo
|
`echo "UPGRADE=1" >> /etc/stabile/config.cfg` unless ( `grep ^UPGRADE=1 /etc/stabile/config.cfg`);
|
| 624 |
4aef7ef6
|
hq
|
my $cmd = "echo 'sleep 5 ; /usr/bin/pkill pressurecontrol' | at now";
|
| 625 |
|
|
system($cmd);
|
| 626 |
|
|
exit 0;
|
| 627 |
95b003ff
|
Origo
|
}
|
| 628 |
|
|
|
| 629 |
|
|
sub do_billengine {
|
| 630 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 631 |
|
|
if ($help) {
|
| 632 |
|
|
return <<END
|
| 633 |
|
|
GET::
|
| 634 |
48fcda6b
|
Origo
|
Submit billing data for this engine to the registry.
|
| 635 |
95b003ff
|
Origo
|
END
|
| 636 |
|
|
}
|
| 637 |
|
|
require LWP::Simple;
|
| 638 |
|
|
my $browser = LWP::UserAgent->new;
|
| 639 |
|
|
$browser->agent('stabile/1.0b');
|
| 640 |
|
|
$browser->protocols_allowed( [ 'http','https'] );
|
| 641 |
|
|
|
| 642 |
|
|
my $bmonth = $params{'month'} || $month;
|
| 643 |
|
|
$bmonth = substr("0$bmonth", -2);
|
| 644 |
|
|
my $byear = $params{'year'} || $year;
|
| 645 |
|
|
$showcost = 1;
|
| 646 |
|
|
|
| 647 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 648 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 649 |
|
|
my $tkthash = Digest::SHA::sha512_hex($tktkey);
|
| 650 |
|
|
|
| 651 |
|
|
my $postreq = ();
|
| 652 |
|
|
my %bill;
|
| 653 |
|
|
my @regvalues = values %register; # Sort by id
|
| 654 |
|
|
foreach my $valref (@regvalues) {
|
| 655 |
d24d9a01
|
hq
|
my $cuser = $valref->{'username'};
|
| 656 |
|
|
my %stats = collectBillingData( '', $cuser, $bmonth, $byear, $showcost );
|
| 657 |
|
|
$bill{"$cuser-$byear-$bmonth"} = \%stats;
|
| 658 |
95b003ff
|
Origo
|
}
|
| 659 |
|
|
$postreq->{'engineid'} = $engineid;
|
| 660 |
|
|
$postreq->{'enginetkthash'} = $tkthash;
|
| 661 |
|
|
$postreq->{'keywords'} = JSON::to_json(\%bill, {pretty=>1});
|
| 662 |
48fcda6b
|
Origo
|
my $url = "https://www.stabile.io/irigo/engine.cgi";
|
| 663 |
95b003ff
|
Origo
|
$content = $browser->post($url, $postreq)->content();
|
| 664 |
|
|
$postreply = "Status=OK Billed this engine ($engineid)\n";
|
| 665 |
|
|
$postreply .= "$postreq->{'keywords'}\n$content";
|
| 666 |
|
|
return $postreply;
|
| 667 |
|
|
}
|
| 668 |
|
|
|
| 669 |
|
|
sub Linkengine {
|
| 670 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 671 |
|
|
if ($help) {
|
| 672 |
|
|
return <<END
|
| 673 |
|
|
PUT:username,password,engineid,enginename,engineurl:
|
| 674 |
48fcda6b
|
Origo
|
Links engine to the registry
|
| 675 |
95b003ff
|
Origo
|
END
|
| 676 |
|
|
}
|
| 677 |
|
|
return "Status=Error Not allowed\n" unless ($isadmin || ($user eq $engineuser));
|
| 678 |
|
|
my $linkaction = 'update';
|
| 679 |
|
|
$linkaction = 'link' if ($action eq 'linkengine');
|
| 680 |
|
|
$linkaction = 'unlink' if ($action eq 'unlinkengine');
|
| 681 |
|
|
$linkaction = 'update' if ($action eq 'updateengine');
|
| 682 |
|
|
$linkaction = 'update' if ($action eq 'syncusers');
|
| 683 |
|
|
|
| 684 |
|
|
require LWP::Simple;
|
| 685 |
|
|
my $browser = LWP::UserAgent->new;
|
| 686 |
|
|
$browser->agent('stabile/1.0b');
|
| 687 |
|
|
$browser->protocols_allowed( [ 'http','https'] );
|
| 688 |
|
|
|
| 689 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 690 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 691 |
|
|
|
| 692 |
|
|
my $postreq = ();
|
| 693 |
|
|
$postreq->{'user'} = $user || $obj->{'username'};
|
| 694 |
|
|
$postreq->{'engineid'} = $obj->{'engineid'} || $engineid;
|
| 695 |
|
|
$postreq->{'pwd'} = $obj->{'pwd'} if ($obj->{'pwd'});
|
| 696 |
|
|
$postreq->{'enginename'} = $obj->{'enginename'} if ($obj->{'enginename'});
|
| 697 |
|
|
$postreq->{'engineurl'} = $obj->{'engineurl'} if ($obj->{'engineurl'});
|
| 698 |
|
|
if ($tktkey) {
|
| 699 |
|
|
if ($action eq 'linkengine') {
|
| 700 |
48fcda6b
|
Origo
|
$main::syslogit->($user, "info", "Linking engine with the registry");
|
| 701 |
95b003ff
|
Origo
|
$postreq->{'enginetktkey'} = $tktkey;
|
| 702 |
|
|
} else {
|
| 703 |
|
|
$postreq->{'enginetkthash'} = Digest::SHA::sha512_hex($tktkey);
|
| 704 |
|
|
}
|
| 705 |
|
|
}
|
| 706 |
48fcda6b
|
Origo
|
if ($action eq "saveengine") { # Save request from the registry - don't post back
|
| 707 |
|
|
# Pressurecontrol reads new configuration data from the registry, simply reload it
|
| 708 |
95b003ff
|
Origo
|
my $pressureon = !(`systemctl is-active pressurecontrol` =~ /inactive/);
|
| 709 |
|
|
$postreply = ($pressureon)? "Status=OK Engine updating...\n":"Status=OK Engine not updating because pressurecontrol not active\n";
|
| 710 |
|
|
$postreply .= `systemctl restart pressurecontrol` if ($pressureon);
|
| 711 |
|
|
} else {
|
| 712 |
|
|
my $res;
|
| 713 |
|
|
my $cfg = new Config::Simple("/etc/stabile/config.cfg");
|
| 714 |
|
|
if ($action eq 'linkengine' || $action eq 'syncusers') {
|
| 715 |
48fcda6b
|
Origo
|
# Send engine users to the registry
|
| 716 |
95b003ff
|
Origo
|
my @vals = values %register;
|
| 717 |
|
|
my $json = JSON::to_json(\@vals);
|
| 718 |
|
|
$json =~ s/null/""/g;
|
| 719 |
|
|
$json = URI::Escape::uri_escape($json);
|
| 720 |
|
|
$postreq->{'POSTDATA'} = $json;
|
| 721 |
|
|
}
|
| 722 |
|
|
if ($action eq 'linkengine' || $action eq 'updateengine') {
|
| 723 |
|
|
# Update name in config file
|
| 724 |
|
|
if ($postreq->{'enginename'} && $cfg->param("ENGINENAME") ne $postreq->{'enginename'}) {
|
| 725 |
|
|
$cfg->param("ENGINENAME", $postreq->{'enginename'});
|
| 726 |
|
|
$cfg->save();
|
| 727 |
|
|
}
|
| 728 |
48fcda6b
|
Origo
|
# Send entire engine config file to the registry
|
| 729 |
95b003ff
|
Origo
|
my %cfghash = $cfg->vars();
|
| 730 |
|
|
foreach my $param (keys %cfghash) {
|
| 731 |
|
|
$param =~ /default\.(.+)/; # Get rid of default. prefix
|
| 732 |
|
|
if ($1) {
|
| 733 |
|
|
my $k = $1;
|
| 734 |
|
|
my @cvals = $cfg->param($param);
|
| 735 |
|
|
my $cval = join(", ", @cvals);
|
| 736 |
|
|
$postreq->{$k} = URI::Escape::uri_escape($cval);
|
| 737 |
|
|
}
|
| 738 |
|
|
}
|
| 739 |
48fcda6b
|
Origo
|
# Send entire engine piston config file to the registry
|
| 740 |
95b003ff
|
Origo
|
my $nodeconfigfile = "/mnt/stabile/tftp/bionic/casper/filesystem.dir/etc/stabile/nodeconfig.cfg";
|
| 741 |
|
|
if (-e $nodeconfigfile) {
|
| 742 |
|
|
my $pistoncfg = new Config::Simple($nodeconfigfile);
|
| 743 |
|
|
%cfghash = $pistoncfg->vars();
|
| 744 |
|
|
foreach my $param (keys %cfghash) {
|
| 745 |
|
|
$param =~ /default\.(.+)/; # Get rid of default. prefix
|
| 746 |
|
|
if ($1) {
|
| 747 |
|
|
my $k = $1;
|
| 748 |
|
|
my @cvals = $pistoncfg->param($param);
|
| 749 |
|
|
my $cval = join(", ", @cvals);
|
| 750 |
|
|
$postreq->{$k} = URI::Escape::uri_escape($cval);
|
| 751 |
|
|
}
|
| 752 |
|
|
}
|
| 753 |
|
|
}
|
| 754 |
|
|
}
|
| 755 |
|
|
if ($linkaction eq 'link' || $enginelinked) {
|
| 756 |
48fcda6b
|
Origo
|
my $content = $browser->post("https://www.stabile.io/irigo/engine.cgi?action=$linkaction", $postreq)->content();
|
| 757 |
95b003ff
|
Origo
|
if ($content =~ /(Engine linked|Engine not linked|Engine unlinked|Engine updated|Unknown engine|Invalid credentials .+\.)/i) {
|
| 758 |
|
|
$res = "Status=OK $1";
|
| 759 |
|
|
my $linked = 1;
|
| 760 |
|
|
$linked = 0 unless ($content =~ /Engine linked/i || $content =~ /Engine updated/i);
|
| 761 |
|
|
$cfg->param("ENGINE_LINKED", $linked);
|
| 762 |
|
|
$cfg->save();
|
| 763 |
48fcda6b
|
Origo
|
} elsif ($action eq 'syncusers' || $action eq 'linkengine') { # If we send user list to the registry we get merged list back
|
| 764 |
95b003ff
|
Origo
|
if ($content =~ /^\[/) { # Sanity check to see if we got json back
|
| 765 |
|
|
$res .= "Status=OK Engine linked\n" if ($action eq 'linkengine');
|
| 766 |
48fcda6b
|
Origo
|
# Update engine users with users from the registry
|
| 767 |
|
|
$res .= updateEngineUsers($content);
|
| 768 |
|
|
$res .= "Status=OK Users synced with registry\n";
|
| 769 |
95b003ff
|
Origo
|
$main::updateUI->({ tab => 'users', type=>'update', user=>$user});
|
| 770 |
|
|
}
|
| 771 |
48fcda6b
|
Origo
|
$res .= "$content" unless ($res =~ /Status=OK/); # Only add if there are problems
|
| 772 |
95b003ff
|
Origo
|
}
|
| 773 |
|
|
$postreply = $res;
|
| 774 |
|
|
$content =~ s/\n/ - /;
|
| 775 |
|
|
$res =~ s/\n/ - /;
|
| 776 |
64c667ea
|
hq
|
# $main::syslogit->($user, "info", "$content");
|
| 777 |
|
|
$main::syslogit->($user, "info", "Synced users");
|
| 778 |
95b003ff
|
Origo
|
} else {
|
| 779 |
|
|
$postreply .= "Status=OK Engine not linked, saving name\n";
|
| 780 |
|
|
}
|
| 781 |
|
|
}
|
| 782 |
|
|
return $postreply;
|
| 783 |
|
|
}
|
| 784 |
|
|
|
| 785 |
|
|
sub Releasepressure {
|
| 786 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 787 |
|
|
if ($help) {
|
| 788 |
|
|
return <<END
|
| 789 |
|
|
GET::
|
| 790 |
|
|
Restarts pressurecontrol.
|
| 791 |
|
|
END
|
| 792 |
|
|
}
|
| 793 |
|
|
my $res;
|
| 794 |
|
|
unless (`systemctl is-active pressurecontrol` =~ /inactive/) {
|
| 795 |
|
|
my $daemon = Proc::Daemon->new(
|
| 796 |
|
|
work_dir => '/usr/local/bin',
|
| 797 |
|
|
exec_command => "systemctl restart pressurecontrol"
|
| 798 |
|
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
| 799 |
|
|
my $pid = $daemon->Init();
|
| 800 |
|
|
# $res = `systemctl restart pressurecontrol`;
|
| 801 |
|
|
return "Status=OK Venting...\n";
|
| 802 |
|
|
} else {
|
| 803 |
|
|
return "Status=OK Not venting\n";
|
| 804 |
|
|
}
|
| 805 |
|
|
}
|
| 806 |
|
|
|
| 807 |
|
|
sub do_enable {
|
| 808 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 809 |
|
|
if ($help) {
|
| 810 |
|
|
return <<END
|
| 811 |
|
|
GET:username:
|
| 812 |
|
|
Enable a user.
|
| 813 |
|
|
END
|
| 814 |
|
|
}
|
| 815 |
|
|
my $username = $obj->{'username'};
|
| 816 |
71b897d3
|
hq
|
return unless ($username);
|
| 817 |
95b003ff
|
Origo
|
if ($isadmin || ($user eq $engineuser)) {
|
| 818 |
71b897d3
|
hq
|
# Create user on this engine if not yet created
|
| 819 |
|
|
do_save($username, 'save', $obj);
|
| 820 |
95b003ff
|
Origo
|
my $uprivileges = $register{$username}->{'privileges'};
|
| 821 |
|
|
$uprivileges =~ s/d//;
|
| 822 |
|
|
$uprivileges .= 'n' unless ($uprivileges =~ /n/);# These are constant sources of problems - enable by default when enabling users to alleviate situation
|
| 823 |
|
|
$register{$username}->{'privileges'} = $uprivileges;
|
| 824 |
|
|
$register{$username}->{'allowinternalapi'} = 1;
|
| 825 |
|
|
$postreply .= "Status=OK User $username enabled\n";
|
| 826 |
|
|
} else {
|
| 827 |
|
|
$postreply .= "Status=ERROR Not allowed\n";
|
| 828 |
|
|
}
|
| 829 |
|
|
$uiuuid = $username;
|
| 830 |
|
|
return $postreply;
|
| 831 |
|
|
}
|
| 832 |
|
|
|
| 833 |
|
|
sub do_disable {
|
| 834 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 835 |
|
|
if ($help) {
|
| 836 |
|
|
return <<END
|
| 837 |
|
|
GET:username:
|
| 838 |
|
|
Disable a user.
|
| 839 |
|
|
END
|
| 840 |
|
|
}
|
| 841 |
|
|
my $username = $obj->{'username'};
|
| 842 |
|
|
if ($isadmin || ($user eq $engineuser)) {
|
| 843 |
|
|
my $uprivileges = $register{$username}->{'privileges'};
|
| 844 |
|
|
$uprivileges .= 'd' unless ($uprivileges =~ /d/);
|
| 845 |
|
|
$register{$username}->{'privileges'} = $uprivileges;
|
| 846 |
|
|
$postreply .= "Stream=OK User $username disabled, halting servers...\n";
|
| 847 |
|
|
require "$Stabile::basedir/cgi/servers.cgi";
|
| 848 |
|
|
$Stabile::Servers::console = 1;
|
| 849 |
|
|
$postreply .= Stabile::Servers::destroyUserServers($username,1);
|
| 850 |
|
|
`/bin/rm /tmp/$username~*.tasks`;
|
| 851 |
|
|
} else {
|
| 852 |
|
|
$postreply .= "Status=ERROR Not allowed\n";
|
| 853 |
|
|
}
|
| 854 |
|
|
$uiuuid = $username;
|
| 855 |
|
|
return $postreply;
|
| 856 |
|
|
}
|
| 857 |
|
|
|
| 858 |
|
|
sub Updateui {
|
| 859 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 860 |
|
|
if ($help) {
|
| 861 |
|
|
return <<END
|
| 862 |
|
|
GET:username,message,tab:
|
| 863 |
|
|
Update the UI for given user if logged into UI.
|
| 864 |
|
|
END
|
| 865 |
|
|
}
|
| 866 |
|
|
my $username = $obj->{'username'} || $user;
|
| 867 |
|
|
my $message = $obj->{'message'};
|
| 868 |
|
|
my $tab = $obj->{'tab'} || 'home';
|
| 869 |
|
|
if ($isadmin || ($username eq $user) || ($user eq $engineuser)) {
|
| 870 |
|
|
$postreply = $main::updateUI->({ tab => $tab, user => $username, message =>$message, type=>'update'});
|
| 871 |
|
|
} else {
|
| 872 |
|
|
$postreply = "Status=ERROR Not allowed\n";
|
| 873 |
|
|
}
|
| 874 |
|
|
}
|
| 875 |
|
|
|
| 876 |
|
|
sub do_updateclientui {
|
| 877 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 878 |
|
|
if ($help) {
|
| 879 |
|
|
return <<END
|
| 880 |
6fdc8676
|
hq
|
GET:username,message,tab,type:
|
| 881 |
95b003ff
|
Origo
|
Update the UI for given user if logged into UI.
|
| 882 |
|
|
END
|
| 883 |
|
|
}
|
| 884 |
|
|
my $username = $obj->{'username'} || $user;
|
| 885 |
|
|
my $message = $obj->{'message'};
|
| 886 |
|
|
my $tab = $obj->{'tab'} || 'home';
|
| 887 |
6fdc8676
|
hq
|
my $type= $obj->{'type'} || 'update';
|
| 888 |
95b003ff
|
Origo
|
if ($isadmin || ($username eq $user) || ($user eq $engineuser)) {
|
| 889 |
6fdc8676
|
hq
|
$postreply = $main::updateUI->({ tab => $tab, user => $username, message =>$message, type=>$type});
|
| 890 |
95b003ff
|
Origo
|
} else {
|
| 891 |
|
|
$postreply = "Status=ERROR Not allowed\n";
|
| 892 |
|
|
}
|
| 893 |
|
|
}
|
| 894 |
|
|
|
| 895 |
51e32e00
|
hq
|
sub Gettimezone {
|
| 896 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 897 |
|
|
if ($help) {
|
| 898 |
|
|
return <<END
|
| 899 |
|
|
GET::
|
| 900 |
|
|
Returns the timezone of the engine. Useful for setting timezone on VMs, specifically Kubernetes nodes.
|
| 901 |
|
|
END
|
| 902 |
|
|
}
|
| 903 |
|
|
my $tz = `cat /etc/timezone`;
|
| 904 |
|
|
chomp $tz;
|
| 905 |
|
|
$postreply = qq|{"timezone": "$tz"}\n|;
|
| 906 |
|
|
return $postreply;
|
| 907 |
|
|
}
|
| 908 |
|
|
|
| 909 |
95b003ff
|
Origo
|
sub Vent {
|
| 910 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 911 |
|
|
if ($help) {
|
| 912 |
|
|
return <<END
|
| 913 |
|
|
GET::
|
| 914 |
|
|
Restart pressurecontrol.
|
| 915 |
|
|
END
|
| 916 |
|
|
}
|
| 917 |
51e32e00
|
hq
|
if ($isadmin) {
|
| 918 |
|
|
my $daemon = Proc::Daemon->new(
|
| 919 |
|
|
work_dir => '/tmp',
|
| 920 |
|
|
exec_command => "systemctl restart pressurecontrol"
|
| 921 |
|
|
) or do {$postreply .= "Status=ERROR $@\n";};
|
| 922 |
|
|
my $pid = $daemon->Init();
|
| 923 |
|
|
$postreply = "Status=OK Restarting pressurecontrol\n";
|
| 924 |
|
|
} else {
|
| 925 |
|
|
$postreply = "Status=Error Not allowed\n";
|
| 926 |
|
|
}
|
| 927 |
95b003ff
|
Origo
|
return $postreply;
|
| 928 |
|
|
}
|
| 929 |
|
|
|
| 930 |
|
|
sub Deleteentirely {
|
| 931 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 932 |
|
|
if ($help) {
|
| 933 |
|
|
return <<END
|
| 934 |
|
|
GET:username:
|
| 935 |
|
|
Deletes a user and all the user's servers, images, networks etc. Warning: This destroys data
|
| 936 |
|
|
END
|
| 937 |
|
|
}
|
| 938 |
|
|
my $username = $obj->{'username'};
|
| 939 |
6372a66e
|
hq
|
my $reply = "Status=OK Removed $username";
|
| 940 |
95b003ff
|
Origo
|
if (($isadmin || ($user eq $engineuser)) && $register{$username} && !($register{$username}->{'privileges'} =~ /a/) && !($username eq $engineuser)) {
|
| 941 |
|
|
#Never delete admins
|
| 942 |
|
|
my @dusers = ($username);
|
| 943 |
|
|
# Add list of subusers - does not look like a good idea
|
| 944 |
|
|
# foreach my $u (values %register) {
|
| 945 |
|
|
# push @dusers, $u->{'username'} if ($u->{'billto'} && $u->{'billto'} eq $username);
|
| 946 |
|
|
# };
|
| 947 |
|
|
|
| 948 |
|
|
foreach my $uname (@dusers) {
|
| 949 |
6372a66e
|
hq
|
if ($register{$uname}->{privileges} =~ /a/) { #Never delete admins
|
| 950 |
|
|
$postreply .= "Stream=OK Not deleting user $uname - demote before deleting!\n";
|
| 951 |
|
|
next;
|
| 952 |
|
|
}
|
| 953 |
95b003ff
|
Origo
|
$main::updateUI->({ tab => 'users', type=>'update', user=>$user, username=>$username, status=>'deleting'});
|
| 954 |
|
|
|
| 955 |
|
|
$postreply .= "Stream=OK Deleting user $uname and all associated data!!!\n";
|
| 956 |
6372a66e
|
hq
|
$main::syslogit->($user, "info", "Deleting user $uname and all associated data");
|
| 957 |
95b003ff
|
Origo
|
|
| 958 |
|
|
require "$Stabile::basedir/cgi/servers.cgi";
|
| 959 |
|
|
$Stabile::Servers::console = 1;
|
| 960 |
6372a66e
|
hq
|
$Stabile::Servers::isadmin = $isadmin;
|
| 961 |
95b003ff
|
Origo
|
require "$Stabile::basedir/cgi/systems.cgi";
|
| 962 |
|
|
$Stabile::Systems::console = 1;
|
| 963 |
6372a66e
|
hq
|
$Stabile::Systems::isadmin = $isadmin;
|
| 964 |
95b003ff
|
Origo
|
Stabile::Systems::removeusersystems($uname);
|
| 965 |
|
|
Stabile::Servers::removeUserServers($uname);
|
| 966 |
|
|
|
| 967 |
|
|
require "$Stabile::basedir/cgi/images.cgi";
|
| 968 |
|
|
$Stabile::Images::console = 1;
|
| 969 |
|
|
$postreply .= Stabile::Images::removeUserImages($uname);
|
| 970 |
|
|
|
| 971 |
|
|
require "$Stabile::basedir/cgi/networks.cgi";
|
| 972 |
|
|
$Stabile::Networks::console = 1;
|
| 973 |
6372a66e
|
hq
|
$Stabile::Networks::isadmin = $isadmin;
|
| 974 |
95b003ff
|
Origo
|
Stabile::Networks::Removeusernetworks($uname);
|
| 975 |
|
|
remove($uname);
|
| 976 |
|
|
$reply = "$reply\n$postreply";
|
| 977 |
|
|
|
| 978 |
a2e0bc7e
|
hq
|
do_billengine(); # Send latest billing data to origo before removing user
|
| 979 |
|
|
# Also remove billing data from previous months - these are assumed reported to origo for linked and billed engines
|
| 980 |
|
|
`echo "delete from billing_domains where (usernodetime like '$uname-%') AND (not (usernodetime LIKE '$uname-%-$year-$month'));" | mysql steamregister`;
|
| 981 |
|
|
`echo "delete from billing_images where (userstoragepooltime like '$uname-%') AND (not (userstoragepooltime LIKE '$uname-%-$year-$month'));" | mysql steamregister`;
|
| 982 |
|
|
`echo "delete from billing_networks where (useridtime like '$uname-%') AND (not (useridtime LIKE '$uname-%-$year-$month'));" | mysql steamregister`;
|
| 983 |
95b003ff
|
Origo
|
}
|
| 984 |
48fcda6b
|
Origo
|
$main::updateUI->({tab => 'users', type=>'update', user=>$user});
|
| 985 |
95b003ff
|
Origo
|
|
| 986 |
|
|
} else {
|
| 987 |
|
|
$postreply .= "Stream=ERROR Cannot delete user $username - you cannot delete administrators!\n";
|
| 988 |
|
|
$reply = $postreply;
|
| 989 |
|
|
}
|
| 990 |
|
|
return $reply;
|
| 991 |
|
|
}
|
| 992 |
|
|
|
| 993 |
|
|
sub do_save {
|
| 994 |
71b897d3
|
hq
|
my ($username, $action, $obj) = @_;
|
| 995 |
95b003ff
|
Origo
|
if ($help) {
|
| 996 |
|
|
return <<END
|
| 997 |
a93267ad
|
hq
|
POST:username, password, privileges, fullname, email, opemail, alertemail, phone, opphone, opfullname, allowfrom, allowinternalapi, accounts, accountsprivileges, storagepools, memoryquota, vcpuquota, vmemoryquota, vgpuquota, storagequota, nodestoragequota, externalipquota, rxquota, txquota:
|
| 998 |
71b897d3
|
hq
|
Saves a user. If [username] does not exist, it is created if privileges allow this. [password] can be plaintext or a SHA256 hash.
|
| 999 |
95b003ff
|
Origo
|
END
|
| 1000 |
|
|
}
|
| 1001 |
71b897d3
|
hq
|
$username = $username || $obj->{"username"};
|
| 1002 |
95b003ff
|
Origo
|
unless ($username && (($user eq $username) || $isadmin || ($user eq $engineuser))) {
|
| 1003 |
|
|
$postreply = "Status=ERROR Please provide a valid username\n";
|
| 1004 |
|
|
return $postreply;
|
| 1005 |
|
|
}
|
| 1006 |
|
|
my $password = '';
|
| 1007 |
|
|
my $reguser = $register{$username};
|
| 1008 |
|
|
if ($obj->{"password"} && $obj->{"password"} ne '--') {
|
| 1009 |
|
|
if (length $obj->{'password'} == 86) {
|
| 1010 |
|
|
$password = $obj->{"password"}; # This is already encoded
|
| 1011 |
|
|
} else {
|
| 1012 |
|
|
$password = $obj->{"password"};
|
| 1013 |
|
|
$MAXLEN = 20;
|
| 1014 |
|
|
my $msg = IsBadPassword($password);
|
| 1015 |
|
|
if ($msg) {
|
| 1016 |
|
|
$postreply = "Status=Error $msg - please choose a stronger password\n";
|
| 1017 |
|
|
$postmsg = "$msg - please choose a stronger password";
|
| 1018 |
|
|
return $postreply;
|
| 1019 |
|
|
} else {
|
| 1020 |
|
|
$password = Digest::SHA::sha512_base64($password);
|
| 1021 |
|
|
}
|
| 1022 |
|
|
}
|
| 1023 |
|
|
} else {
|
| 1024 |
|
|
$password = $reguser->{'password'};
|
| 1025 |
|
|
}
|
| 1026 |
|
|
my $fullname = $obj->{"fullname"} || $reguser->{'fullname'};
|
| 1027 |
|
|
my $email = $obj->{"email"} || $reguser->{'email'};
|
| 1028 |
|
|
my $opemail = $obj->{"opemail"} || $reguser->{'opemail'};
|
| 1029 |
|
|
my $alertemail = $obj->{"alertemail"} || $reguser->{'alertemail'};
|
| 1030 |
|
|
my $phone = $obj->{"phone"} || $reguser->{'phone'};
|
| 1031 |
|
|
my $opphone = $obj->{"opphone"} || $reguser->{'opphone'};
|
| 1032 |
|
|
my $opfullname = $obj->{"opfullname"} || $reguser->{'opfullname'};
|
| 1033 |
4aef7ef6
|
hq
|
my $allowfrom = $obj->{"allowfrom"};
|
| 1034 |
705b5366
|
hq
|
my $totpsecret = $reguser->{'totpsecret'};
|
| 1035 |
|
|
$totpsecret = $obj->{"totpsecret"} if (defined $obj->{"totpsecret"});
|
| 1036 |
95b003ff
|
Origo
|
my $allowinternalapi = $obj->{"allowinternalapi"} || $reguser->{'allowinternalapi'};
|
| 1037 |
|
|
|
| 1038 |
4aef7ef6
|
hq
|
if (defined $obj->{"allowfrom"}) {
|
| 1039 |
95b003ff
|
Origo
|
my @allows = split(/(,\s*|\s+)/, $allowfrom);
|
| 1040 |
|
|
$allowfrom = '';
|
| 1041 |
4aef7ef6
|
hq
|
my %allowshash;
|
| 1042 |
95b003ff
|
Origo
|
foreach my $ip (@allows) {
|
| 1043 |
4aef7ef6
|
hq
|
$allowshash{"$1$2"} = 1 if ($ip =~ /(\d+\.\d+\.\d+\.\d+)(\/\d+)?/);
|
| 1044 |
|
|
if ($ip =~ /\w\w/) { # Check if we are dealing with a country code
|
| 1045 |
|
|
$ip = uc $ip;
|
| 1046 |
|
|
my $geoip = Geo::IP->new(GEOIP_MEMORY_CACHE);
|
| 1047 |
|
|
my $tz = $geoip->time_zone($ip, '');
|
| 1048 |
|
|
$allowshash{$ip} = 1 if ($tz); # We have a valid country code
|
| 1049 |
|
|
}
|
| 1050 |
95b003ff
|
Origo
|
}
|
| 1051 |
4aef7ef6
|
hq
|
$allowfrom = join(", ", sort(keys %allowshash));
|
| 1052 |
95b003ff
|
Origo
|
}
|
| 1053 |
|
|
|
| 1054 |
|
|
my $uprivileges = $reguser->{'privileges'};
|
| 1055 |
|
|
my $uaccounts = $reguser->{'accounts'};
|
| 1056 |
|
|
my $uaccountsprivileges = $reguser->{'accountsprivileges'};
|
| 1057 |
|
|
my $storagepools = $reguser->{'storagepools'};
|
| 1058 |
|
|
my $storagequota = $reguser->{'storagequota'};
|
| 1059 |
|
|
my $nodestoragequota = $reguser->{'nodestoragequota'};
|
| 1060 |
a93267ad
|
hq
|
my $memoryquota = $reguser->{'memoryquota'};
|
| 1061 |
95b003ff
|
Origo
|
my $vcpuquota = $reguser->{'vcpuquota'};
|
| 1062 |
a93267ad
|
hq
|
my $vmemoryquota = $reguser->{'vmemoryquota'};
|
| 1063 |
|
|
my $vgpuquota = $reguser->{'vgpuquota'};
|
| 1064 |
95b003ff
|
Origo
|
my $externalipquota = $reguser->{'externalipquota'};
|
| 1065 |
|
|
my $rxquota = $reguser->{'rxquota'};
|
| 1066 |
|
|
my $txquota = $reguser->{'txquota'};
|
| 1067 |
|
|
my $tasks = $reguser->{'tasks'};
|
| 1068 |
|
|
my $ubillto = $reguser->{'billto'};
|
| 1069 |
45cc3024
|
hq
|
my $udnsdomains = $reguser->{'dnsdomains'};
|
| 1070 |
|
|
my $uappstoreurl = $reguser->{'appstoreurl'}; $uappstoreurl = '' if ($uappstoreurl eq '--');
|
| 1071 |
95b003ff
|
Origo
|
my $created = $reguser->{'created'} || $current_time; # set created timestamp for new users
|
| 1072 |
|
|
|
| 1073 |
|
|
# Only allow admins to change user privileges and quotas
|
| 1074 |
|
|
if ($isadmin || $user eq $engineuser) {
|
| 1075 |
|
|
$uprivileges = $obj->{"privileges"} || $reguser->{'privileges'};
|
| 1076 |
|
|
$uprivileges = '' if ($uprivileges eq '--');
|
| 1077 |
|
|
$uprivileges = 'n' if (!$reguser->{'username'} && !$uprivileges); # Allow new users to use node storage unless explicitly disallowed
|
| 1078 |
|
|
$uprivileges =~ tr/adnrpu//cd; # filter out non-valid privileges
|
| 1079 |
|
|
$uprivileges =~ s/(.)(?=.*?\1)//g; # filter out duplicates using positive lookahead
|
| 1080 |
|
|
$storagepools = ($obj->{"storagepools"} || $obj->{"storagepools"} eq '0')?$obj->{"storagepools"} : $reguser->{'storagepools'};
|
| 1081 |
|
|
$memoryquota = (defined $obj->{"memoryquota"}) ? $obj->{"memoryquota"} : $reguser->{'memoryquota'};
|
| 1082 |
a93267ad
|
hq
|
$vcpuquota = (defined $obj->{"vcpuquota"}) ? $obj->{"vcpuquota"} : $reguser->{'vcpuquota'};
|
| 1083 |
|
|
$vmemoryquota = (defined $obj->{"vmemoryquota"}) ? $obj->{"vmemoryquota"} : $reguser->{'vmemoryquota'};
|
| 1084 |
|
|
$vgpuquota = (defined $obj->{"vgpuquota"}) ? $obj->{"vgpuquota"} : $reguser->{'vgpuquota'};
|
| 1085 |
95b003ff
|
Origo
|
$storagequota = (defined $obj->{"storagequota"}) ? $obj->{"storagequota"} : $reguser->{'storagequota'};
|
| 1086 |
|
|
$nodestoragequota = (defined $obj->{"nodestoragequota"}) ? $obj->{"nodestoragequota"} : $reguser->{'nodestoragequota'};
|
| 1087 |
|
|
$externalipquota = (defined $obj->{"externalipquota"}) ? $obj->{"externalipquota"} : $reguser->{'externalipquota'};
|
| 1088 |
|
|
$rxquota = (defined $obj->{"rxquota"}) ? $obj->{"rxquota"} : $reguser->{'rxquota'};
|
| 1089 |
|
|
$txquota = (defined $obj->{"txquota"}) ? $obj->{"txquota"} : $reguser->{'txquota'};
|
| 1090 |
|
|
$tasks = $obj->{"tasks"} || $reguser->{'tasks'};
|
| 1091 |
|
|
$ubillto = $obj->{"billto"} || $reguser->{'billto'};
|
| 1092 |
45cc3024
|
hq
|
$udnsdomains = $obj->{"dnsdomains"} || $udnsdomains; $udnsdomains = '' if ($udnsdomains eq '--');
|
| 1093 |
|
|
$uappstoreurl = $obj->{"appstoreurl"} || $uappstoreurl;
|
| 1094 |
95b003ff
|
Origo
|
$uaccounts = $obj->{"accounts"} || $reguser->{'accounts'};
|
| 1095 |
|
|
$uaccountsprivileges = $obj->{"accountsprivileges"} || $reguser->{'accountsprivileges'};
|
| 1096 |
a439a9c4
|
hq
|
my @ua = split(/, ?/, $uaccounts);
|
| 1097 |
|
|
my @up = split(/, ?/, $uaccountsprivileges);
|
| 1098 |
95b003ff
|
Origo
|
my @ua2 = ();
|
| 1099 |
|
|
my @up2 = ();
|
| 1100 |
|
|
my $i = 0;
|
| 1101 |
|
|
foreach my $u (@ua) {
|
| 1102 |
|
|
if ($register{$u} && ($u ne $username)) {
|
| 1103 |
|
|
push @ua2, $u;
|
| 1104 |
|
|
my $uprivs = $up[$i] || 'u';
|
| 1105 |
|
|
$uprivs =~ tr/adnrpu//cd; # filter out non-valid privileges
|
| 1106 |
|
|
$uprivs =~ s/(.)(?=.*?\1)//g; # filter out duplicates using positive lookahead
|
| 1107 |
|
|
push @up2, $uprivs;
|
| 1108 |
|
|
}
|
| 1109 |
|
|
$i++;
|
| 1110 |
|
|
}
|
| 1111 |
|
|
$uaccounts = join(", ", @ua2);
|
| 1112 |
|
|
$uaccountsprivileges = join(", ", @up2);
|
| 1113 |
|
|
}
|
| 1114 |
|
|
|
| 1115 |
|
|
# Sanity checks
|
| 1116 |
|
|
if (
|
| 1117 |
|
|
($fullname && length $fullname > 255)
|
| 1118 |
|
|
|| ($password && length $password > 255)
|
| 1119 |
|
|
) {
|
| 1120 |
|
|
$postreply .= "Status=ERROR Bad data: $username\n";
|
| 1121 |
|
|
return $postreply;
|
| 1122 |
|
|
}
|
| 1123 |
|
|
# Only allow new users to be created by admins, i.e. no auto-registration
|
| 1124 |
|
|
if ($reguser->{'username'} || $isadmin) {
|
| 1125 |
|
|
$register{$username} = {
|
| 1126 |
|
|
password => $password,
|
| 1127 |
|
|
fullname => $fullname,
|
| 1128 |
|
|
email => $email,
|
| 1129 |
|
|
opemail => $opemail,
|
| 1130 |
|
|
alertemail => $alertemail,
|
| 1131 |
|
|
phone => $phone,
|
| 1132 |
|
|
opphone => $opphone,
|
| 1133 |
|
|
opfullname => $opfullname,
|
| 1134 |
|
|
allowfrom => $allowfrom,
|
| 1135 |
54401133
|
hq
|
totpsecret => $totpsecret,
|
| 1136 |
95b003ff
|
Origo
|
privileges => $uprivileges,
|
| 1137 |
|
|
accounts => $uaccounts,
|
| 1138 |
|
|
accountsprivileges => $uaccountsprivileges,
|
| 1139 |
|
|
storagepools => $storagepools,
|
| 1140 |
|
|
memoryquota => $memoryquota+0,
|
| 1141 |
a93267ad
|
hq
|
vcpuquota => $vcpuquota+0,
|
| 1142 |
|
|
vmemoryquota => $vmemoryquota+0,
|
| 1143 |
|
|
vgpuquota => $vgpuquota+0,
|
| 1144 |
95b003ff
|
Origo
|
storagequota => $storagequota+0,
|
| 1145 |
|
|
nodestoragequota => $nodestoragequota+0,
|
| 1146 |
|
|
externalipquota => $externalipquota+0,
|
| 1147 |
|
|
rxquota => $rxquota+0,
|
| 1148 |
|
|
txquota => $txquota+0,
|
| 1149 |
|
|
tasks => $tasks,
|
| 1150 |
|
|
allowinternalapi => $allowinternalapi || 1, # specify '--' to explicitly disallow
|
| 1151 |
|
|
billto => $ubillto,
|
| 1152 |
45cc3024
|
hq
|
dnsdomains => $udnsdomains,
|
| 1153 |
|
|
appstoreurl => $uappstoreurl,
|
| 1154 |
|
|
created => $created,
|
| 1155 |
95b003ff
|
Origo
|
modified => $current_time,
|
| 1156 |
|
|
action => ""
|
| 1157 |
|
|
};
|
| 1158 |
|
|
my %uref = %{$register{$username}};
|
| 1159 |
|
|
$uref{result} = "OK";
|
| 1160 |
|
|
$uref{password} = "";
|
| 1161 |
|
|
$uref{status} = ($uprivileges =~ /d/)?'disabled':'enabled';
|
| 1162 |
|
|
$postreply = JSON::to_json(\%uref, { pretty => 1 });
|
| 1163 |
|
|
# $postreply =~ s/""/"--"/g;
|
| 1164 |
|
|
$postreply =~ s/null/""/g;
|
| 1165 |
|
|
# $postreply =~ s/\x/ /g;
|
| 1166 |
|
|
}
|
| 1167 |
|
|
return $postreply;
|
| 1168 |
|
|
}
|
| 1169 |
|
|
|
| 1170 |
|
|
sub do_list {
|
| 1171 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1172 |
|
|
if ($help) {
|
| 1173 |
|
|
return <<END
|
| 1174 |
|
|
GET::
|
| 1175 |
|
|
List users registered on this engine.
|
| 1176 |
|
|
END
|
| 1177 |
|
|
}
|
| 1178 |
|
|
my $userfilter;
|
| 1179 |
|
|
my $usermatch;
|
| 1180 |
|
|
my $propmatch;
|
| 1181 |
|
|
if ($uripath =~ /users(\.cgi)?\/(\?|)(me|this)/) {
|
| 1182 |
|
|
$usermatch = $user;
|
| 1183 |
|
|
$propmatch = $4 if ($uripath =~ /users(\.cgi)?\/(\?|)(me|this)\/(.+)/);
|
| 1184 |
|
|
} elsif ($uripath =~ /users(\.cgi)?\/(\?|)(username)/) {
|
| 1185 |
|
|
$userfilter = $3 if ($uripath =~ /users(\.cgi)?\/\??username(:|=)(.+)/);
|
| 1186 |
|
|
$userfilter = $1 if ($userfilter =~ /(.*)\*/);
|
| 1187 |
|
|
} elsif ($uripath =~ /users(\.cgi)?\/(\S+)/) {
|
| 1188 |
|
|
$usermatch = $2;
|
| 1189 |
|
|
$propmatch = $4 if ($uripath =~ /users(\.cgi)?\/(\S+)\/(.+)/);
|
| 1190 |
|
|
}
|
| 1191 |
|
|
|
| 1192 |
|
|
my @regvalues = (sort {$a->{'id'} <=> $b->{'id'}} values %register); # Sort by id
|
| 1193 |
|
|
my @curregvalues;
|
| 1194 |
|
|
|
| 1195 |
|
|
foreach my $valref (@regvalues) {
|
| 1196 |
|
|
my $reguser = $valref->{'username'};
|
| 1197 |
|
|
if ($user eq $reguser || $isadmin) {
|
| 1198 |
|
|
next if ($reguser eq 'irigo' || $reguser eq 'guest');
|
| 1199 |
|
|
my %val = %{$valref}; # Deference and assign to new ass array, effectively cloning object
|
| 1200 |
54401133
|
hq
|
$val{'password'} = '';
|
| 1201 |
|
|
$val{'status'} = ($val{'privileges'} =~ /d/)?'disabled':'enabled';
|
| 1202 |
|
|
if ((!$userfilter && !$usermatch) || ($userfilter && $reguser =~ /$userfilter/) || $reguser eq $usermatch) {
|
| 1203 |
|
|
push @curregvalues,\%val;
|
| 1204 |
|
|
}
|
| 1205 |
95b003ff
|
Origo
|
}
|
| 1206 |
|
|
}
|
| 1207 |
|
|
if ($action eq 'tablelist') {
|
| 1208 |
|
|
my $t2 = Text::SimpleTable->new(14,32,24,10);
|
| 1209 |
|
|
|
| 1210 |
|
|
$t2->row('username', 'fullname', 'lastlogin', 'privileges');
|
| 1211 |
|
|
$t2->hr;
|
| 1212 |
|
|
my $pattern = $options{m};
|
| 1213 |
|
|
foreach $rowref (@curregvalues){
|
| 1214 |
|
|
if ($pattern) {
|
| 1215 |
|
|
my $rowtext = $rowref->{'username'} . " " . $rowref->{'fullname'} . " " . $rowref->{'lastlogin'}
|
| 1216 |
|
|
. " " . $rowref->{'privileges'};
|
| 1217 |
|
|
$rowtext .= " " . $rowref->{'mac'} if ($isadmin);
|
| 1218 |
|
|
next unless ($rowtext =~ /$pattern/i);
|
| 1219 |
|
|
}
|
| 1220 |
|
|
$t2->row($rowref->{'username'}, $rowref->{'fullname'}||'--', localtime($rowref->{'lastlogin'})||'--',
|
| 1221 |
|
|
$rowref->{'privileges'}||'--');
|
| 1222 |
|
|
}
|
| 1223 |
|
|
#$t2->row('common', '--', '--', '--');
|
| 1224 |
|
|
#$t2->row('all', '--', '--', '--') if (index($privileges,"a")!=-1);
|
| 1225 |
|
|
$postreply .= $t2->draw;
|
| 1226 |
|
|
} elsif ($console) {
|
| 1227 |
|
|
$postreply = Dumper(\@curregvalues);
|
| 1228 |
|
|
} else {
|
| 1229 |
|
|
my $json_text;
|
| 1230 |
|
|
if ($propmatch) {
|
| 1231 |
|
|
$json_text = JSON::to_json($curregvalues[0]->{$propmatch}, {allow_nonref=>1});
|
| 1232 |
|
|
} else {
|
| 1233 |
|
|
$json_text = JSON::to_json(\@curregvalues, {pretty=>1});
|
| 1234 |
|
|
}
|
| 1235 |
|
|
$json_text =~ s/"--"/""/g;
|
| 1236 |
|
|
$json_text =~ s/null/""/g;
|
| 1237 |
|
|
# $json_text =~ s/\x/ /g;
|
| 1238 |
|
|
$postreply = qq|{"identifier": "username", "label": "username", "items": | unless ($usermatch || $action ne 'listusers');
|
| 1239 |
|
|
$postreply .= $json_text;
|
| 1240 |
|
|
$postreply .= "}\n" unless ($usermatch || $action ne 'listusers');
|
| 1241 |
|
|
}
|
| 1242 |
|
|
return $postreply;
|
| 1243 |
|
|
}
|
| 1244 |
|
|
|
| 1245 |
|
|
sub do_uuidlookup {
|
| 1246 |
|
|
if ($help) {
|
| 1247 |
|
|
return <<END
|
| 1248 |
|
|
GET:uuid:
|
| 1249 |
|
|
Simple action for looking up a username (uuid) or part of a username and returning the complete username.
|
| 1250 |
|
|
END
|
| 1251 |
|
|
}
|
| 1252 |
|
|
my $u = $options{u};
|
| 1253 |
|
|
$u = $params{'uuid'} unless ($u || $u eq '0');
|
| 1254 |
|
|
if ($u || $u eq '0') {
|
| 1255 |
|
|
foreach my $uuid (keys %register) {
|
| 1256 |
|
|
if ($uuid =~ /^$u/) {
|
| 1257 |
|
|
return "$uuid\n" if ($uuid eq $user || index($privileges,"a")!=-1);
|
| 1258 |
|
|
}
|
| 1259 |
|
|
}
|
| 1260 |
|
|
}
|
| 1261 |
|
|
}
|
| 1262 |
|
|
|
| 1263 |
|
|
sub do_uuidshow {
|
| 1264 |
|
|
if ($help) {
|
| 1265 |
|
|
return <<END
|
| 1266 |
|
|
GET:uuid:
|
| 1267 |
|
|
Simple action for showing a single user. Pass username as uuid.
|
| 1268 |
|
|
END
|
| 1269 |
|
|
}
|
| 1270 |
|
|
my $u = $options{u};
|
| 1271 |
|
|
$u = $params{'uuid'} unless ($u || $u eq '0');
|
| 1272 |
|
|
if ($u eq $user || index($privileges,"a")!=-1) {
|
| 1273 |
|
|
foreach my $uuid (keys %register) {
|
| 1274 |
|
|
if ($uuid =~ /^$u/) {
|
| 1275 |
|
|
my %hash = %{$register{$uuid}};
|
| 1276 |
|
|
delete $hash{'action'};
|
| 1277 |
|
|
my $dump = to_json(\%hash, {pretty=>1});
|
| 1278 |
|
|
$dump =~ s/undef/"--"/g;
|
| 1279 |
|
|
return $dump;
|
| 1280 |
|
|
}
|
| 1281 |
|
|
}
|
| 1282 |
|
|
}
|
| 1283 |
|
|
}
|
| 1284 |
|
|
|
| 1285 |
|
|
sub Restoreengine {
|
| 1286 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1287 |
|
|
if ($help) {
|
| 1288 |
|
|
return <<END
|
| 1289 |
|
|
GET:restorefile:
|
| 1290 |
|
|
Restores this engine's configuration from "restorefile", which must be one of the paths listed in listenginebackups
|
| 1291 |
|
|
END
|
| 1292 |
|
|
}
|
| 1293 |
|
|
if (!$isadmin) {
|
| 1294 |
|
|
$postreply = "Status=ERROR You must be an administrator in order to restore this engine";
|
| 1295 |
|
|
} else {
|
| 1296 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 1297 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 1298 |
|
|
my $enginetkthash = Digest::SHA::sha512_hex($tktkey);
|
| 1299 |
|
|
|
| 1300 |
|
|
my $restoredir = "/etc";
|
| 1301 |
|
|
my $dbname = "steamregister";
|
| 1302 |
|
|
my $restorefile = $obj->{'restorefile'};
|
| 1303 |
|
|
|
| 1304 |
|
|
if ($restorefile && !($restorefile =~ /\//)) {
|
| 1305 |
|
|
my $urifile = URI::Escape::uri_escape($restorefile);
|
| 1306 |
48fcda6b
|
Origo
|
my $uri = "https://www.stabile.io/irigo/engine.cgi";
|
| 1307 |
95b003ff
|
Origo
|
my $cmd = qq|/usr/bin/curl -f --cookie -O -L -F action=getbackup -F restorefile=$urifile -F engineid=$engineid -F enginetkthash=$enginetkthash "$uri" > "/tmp/$restorefile"|;
|
| 1308 |
|
|
my $res = `$cmd`;
|
| 1309 |
|
|
if (-s "/tmp/$restorefile") {
|
| 1310 |
|
|
$res .= `(mkdir $restoredir/stabile; cd $restoredir/stabile; /bin/tar -zxf "/tmp/$restorefile")`;
|
| 1311 |
|
|
$res .= `/usr/bin/mysql -e "create database $dbname;"`;
|
| 1312 |
|
|
$res .= `/usr/bin/mysql $dbname < $restoredir/stabile/steamregister.sql`;
|
| 1313 |
|
|
$res .= `cp -b $restoredir/stabile/hosts.allow /etc/hosts.allow`;
|
| 1314 |
|
|
$res .= `cp -b $restoredir/stabile/auth_tkt_cgi.conf /etc/apache2/conf.d/`;
|
| 1315 |
|
|
$res .= `cp -b $restoredir/stabile/*.crt /etc/apache2/ssl/`;
|
| 1316 |
|
|
$res .= `cp -b $restoredir/stabile/*.key /etc/apache2/ssl/`;
|
| 1317 |
|
|
$res .= `cp -b $restoredir/stabile/mon.cf /etc/mon/`;
|
| 1318 |
|
|
$res .= `service apache2 reload`;
|
| 1319 |
|
|
|
| 1320 |
|
|
# Restore default node configuration
|
| 1321 |
|
|
unless ( tie(%idreg,'Tie::DBI', Hash::Merge::merge({table=>'nodeidentities', key=>'identity'}, $Stabile::dbopts)) ) {return "Unable to access identity register"};
|
| 1322 |
|
|
my $defaultpath = $idreg{'default'}->{'path'} . "/casper/filesystem.dir/etc/stabile/nodeconfig.cfg";
|
| 1323 |
|
|
untie %idreg;
|
| 1324 |
|
|
$res .= `cp $restoredir/stabile/nodeconfig.cfg $defaultpath`;
|
| 1325 |
48fcda6b
|
Origo
|
$main::syslogit->($user, "info", "Engine configuration $restorefile restored from the registry");
|
| 1326 |
|
|
$postreply .= "Status=OK Engine configuration $restorefile restored from the registry - reloading UI\n";
|
| 1327 |
95b003ff
|
Origo
|
} else {
|
| 1328 |
|
|
$postreply .= "Status=ERROR Restore failed, $restorefile not found...\n";
|
| 1329 |
|
|
}
|
| 1330 |
|
|
} else {
|
| 1331 |
|
|
$postreply .= "Status=ERROR You must select a restore file\n";
|
| 1332 |
|
|
}
|
| 1333 |
|
|
}
|
| 1334 |
|
|
return $postreply;
|
| 1335 |
|
|
}
|
| 1336 |
|
|
|
| 1337 |
|
|
# Print list of available actions on objects
|
| 1338 |
|
|
sub do_plainhelp {
|
| 1339 |
|
|
my $res;
|
| 1340 |
|
|
$res .= header('text/plain') unless $console;
|
| 1341 |
|
|
$res .= <<END
|
| 1342 |
|
|
new [username="name", password="password"]
|
| 1343 |
|
|
* enable: Enables a disabled user
|
| 1344 |
|
|
* disable: Disables a user, disallowing login
|
| 1345 |
|
|
* remove: Deletes a user, leaving servers, images, networks etc. untouched
|
| 1346 |
|
|
* deleteentirely: Deletes a user and all the user's servers, images, networks etc. Warning: This destroys data
|
| 1347 |
|
|
|
| 1348 |
|
|
END
|
| 1349 |
|
|
;
|
| 1350 |
|
|
}
|
| 1351 |
|
|
|
| 1352 |
8d7785ff
|
Origo
|
sub do_cleanbillingdata {
|
| 1353 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1354 |
|
|
if ($help) {
|
| 1355 |
|
|
return <<END
|
| 1356 |
|
|
GET:year,dryrun,cleanup:
|
| 1357 |
|
|
Deletes billing from [year]. Default is current year-2. Set dryrun to do a test run. Set cleanup to remove invalid entries.
|
| 1358 |
|
|
END
|
| 1359 |
|
|
}
|
| 1360 |
|
|
return "Status=Error Not allowed\n" unless ($isadmin);
|
| 1361 |
|
|
|
| 1362 |
|
|
my $y = $params{'year'} || ($year-2);
|
| 1363 |
|
|
my $dryrun = $params{'dryrun'};
|
| 1364 |
|
|
my $cleanup = $params{'cleanup'};
|
| 1365 |
|
|
my $pattern = qq|like '%-$y-__'|;
|
| 1366 |
|
|
if ($cleanup) {
|
| 1367 |
|
|
$pattern = qq|not like '%-____-__'|;
|
| 1368 |
|
|
$y = '';
|
| 1369 |
|
|
}
|
| 1370 |
|
|
|
| 1371 |
|
|
unless ( tie(%bnetworksreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_networks', key=>'useridtime'}, $Stabile::dbopts)) ) {return "Status=Error Unable to access billing register"};
|
| 1372 |
|
|
my @bkeys = (tied %bnetworksreg)->select_where("useridtime $pattern");
|
| 1373 |
|
|
$postreply .= "Status=OK -- this is only a test run ---\n" if ($dryrun);
|
| 1374 |
|
|
$postreply .= "Status=OK Cleaning " . scalar @bkeys . " $y network rows\n";
|
| 1375 |
|
|
foreach my $bkey (@bkeys) {
|
| 1376 |
|
|
$postreply .= "Status=OK removing $bnetworksreg{$bkey}->{useridtime}\n";
|
| 1377 |
|
|
delete($bnetworksreg{$bkey}) unless ($dryrun);
|
| 1378 |
|
|
}
|
| 1379 |
|
|
untie(%bnetworksreg);
|
| 1380 |
|
|
|
| 1381 |
|
|
unless ( tie(%bimagesreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_images', key=>'userstoragepooltime'}, $Stabile::dbopts)) ) {return "Status=Error Unable to access billing register"};
|
| 1382 |
|
|
my @bkeys = (tied %bimagesreg)->select_where("userstoragepooltime $pattern");
|
| 1383 |
|
|
$postreply .= "Status=OK Cleaning " . scalar @bkeys . " $y image rows\n";
|
| 1384 |
|
|
foreach my $bkey (@bkeys) {
|
| 1385 |
|
|
$postreply .= "Status=OK removing $bimagesreg{$bkey}->{userstoragepooltime}\n";
|
| 1386 |
|
|
delete($bimagesreg{$bkey}) unless ($dryrun);
|
| 1387 |
|
|
}
|
| 1388 |
|
|
untie(%bimagesreg);
|
| 1389 |
|
|
|
| 1390 |
|
|
unless ( tie(%bserversreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_domains', key=>'usernodetime'}, $Stabile::dbopts)) ) {return "Status=Error Unable to access billing register"};
|
| 1391 |
|
|
my @bkeys = (tied %bserversreg)->select_where("usernodetime $pattern");
|
| 1392 |
|
|
$postreply .= "Status=OK Cleaning " . scalar @bkeys . " $y server rows\n";
|
| 1393 |
|
|
foreach my $bkey (@bkeys) {
|
| 1394 |
|
|
$postreply .= "Status=OK removing $bserversreg{$bkey}->{usernodetime}\n";
|
| 1395 |
|
|
delete($bserversreg{$bkey}) unless ($dryrun);
|
| 1396 |
|
|
}
|
| 1397 |
|
|
untie(%bserversreg);
|
| 1398 |
|
|
|
| 1399 |
|
|
return $postreply;
|
| 1400 |
|
|
|
| 1401 |
|
|
}
|
| 1402 |
|
|
|
| 1403 |
95b003ff
|
Origo
|
sub collectBillingData {
|
| 1404 |
|
|
my ( $curuuid, $buser, $bmonth, $byear, $showcost ) = @_;
|
| 1405 |
|
|
|
| 1406 |
|
|
my $rx = 0;
|
| 1407 |
|
|
my $tx = 0;
|
| 1408 |
a93267ad
|
hq
|
|
| 1409 |
|
|
my $vcpu=0;
|
| 1410 |
95b003ff
|
Origo
|
my $vcpuavg = 0;
|
| 1411 |
8d7785ff
|
Origo
|
my $memory = 0;
|
| 1412 |
95b003ff
|
Origo
|
my $memoryavg = 0;
|
| 1413 |
a93267ad
|
hq
|
|
| 1414 |
|
|
my $vgpu=0;
|
| 1415 |
|
|
my $vgpuavg = 0;
|
| 1416 |
|
|
my $vmemory = 0;
|
| 1417 |
|
|
my $vmemoryavg = 0;
|
| 1418 |
|
|
|
| 1419 |
8d7785ff
|
Origo
|
my $backupsize = 0;
|
| 1420 |
95b003ff
|
Origo
|
my $backupsizeavg = 0;
|
| 1421 |
8d7785ff
|
Origo
|
my $nodevirtualsize = 0;
|
| 1422 |
95b003ff
|
Origo
|
my $nodevirtualsizeavg = 0;
|
| 1423 |
8d7785ff
|
Origo
|
my $virtualsize = 0;
|
| 1424 |
95b003ff
|
Origo
|
my $virtualsizeavg = 0;
|
| 1425 |
8d7785ff
|
Origo
|
my $externalip = 0;
|
| 1426 |
95b003ff
|
Origo
|
my $externalipavg = 0;
|
| 1427 |
|
|
|
| 1428 |
|
|
my $prevmonth = $bmonth-1;
|
| 1429 |
|
|
my $prevyear = $byear;
|
| 1430 |
|
|
if ($prevmonth == 0) {$prevmonth=12; $prevyear--;};
|
| 1431 |
|
|
$prevmonth = substr("0" . $prevmonth, -2);
|
| 1432 |
|
|
my $prev_rx = 0;
|
| 1433 |
|
|
my $prev_tx = 0;
|
| 1434 |
|
|
# List pricing for a single system/server
|
| 1435 |
|
|
if ($curuuid) {
|
| 1436 |
|
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domains register"};
|
| 1437 |
|
|
unless ( tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images',key=>'path'}, $Stabile::dbopts)) ) {return "Unable to access images register"};
|
| 1438 |
|
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access networks register"};
|
| 1439 |
|
|
|
| 1440 |
|
|
my @domains;
|
| 1441 |
|
|
my $isserver = 1 if ($domreg{$curuuid});
|
| 1442 |
|
|
if ($isserver) {
|
| 1443 |
|
|
@domains = $domreg{$curuuid};
|
| 1444 |
|
|
} else {
|
| 1445 |
|
|
@domains = values %domreg;
|
| 1446 |
|
|
}
|
| 1447 |
|
|
foreach my $valref (@domains) {
|
| 1448 |
|
|
if ($valref->{'system'} eq $curuuid || $isserver) {
|
| 1449 |
|
|
$memory += $valref->{'memory'};
|
| 1450 |
|
|
$vcpu += $valref->{'vcpu'};
|
| 1451 |
a93267ad
|
hq
|
$vmemory += $valref->{'vmemory'};
|
| 1452 |
|
|
$vgpu += $valref->{'vgpu'};
|
| 1453 |
95b003ff
|
Origo
|
my $image = $valref->{'image'};
|
| 1454 |
|
|
my $storagepool;
|
| 1455 |
|
|
if ($imagereg{$image}) {
|
| 1456 |
|
|
$storagepool = $imagereg{$image}->{'storagepool'};
|
| 1457 |
|
|
if ($storagepool == -1) {
|
| 1458 |
|
|
$nodevirtualsize += $imagereg{$image}->{'virtualsize'};
|
| 1459 |
|
|
} else {
|
| 1460 |
|
|
$virtualsize += $imagereg{$image}->{'virtualsize'};
|
| 1461 |
|
|
}
|
| 1462 |
|
|
$backupsize += $imagereg{$image}->{'backupsize'};
|
| 1463 |
|
|
}
|
| 1464 |
|
|
$image = $valref->{'image2'};
|
| 1465 |
|
|
if ($imagereg{$image}) {
|
| 1466 |
|
|
$storagepool = $imagereg{$image}->{'storagepool'};
|
| 1467 |
|
|
if ($storagepool == -1) {
|
| 1468 |
|
|
$nodevirtualsize += $imagereg{$image}->{'virtualsize'};
|
| 1469 |
|
|
} else {
|
| 1470 |
|
|
$virtualsize += $imagereg{$image}->{'virtualsize'};
|
| 1471 |
|
|
}
|
| 1472 |
|
|
$backupsize += $imagereg{$image}->{'backupsize'};
|
| 1473 |
|
|
}
|
| 1474 |
|
|
my $networkuuid = $valref->{'networkuuid1'};
|
| 1475 |
|
|
my $networktype = $networkreg{$networkuuid}->{'type'};
|
| 1476 |
|
|
$externalip++ if ($networktype eq 'externalip'|| $networktype eq 'ipmapping');
|
| 1477 |
|
|
$networkuuid = $valref->{'networkuuid2'};
|
| 1478 |
|
|
if ($networkreg{$networkuuid}) {
|
| 1479 |
|
|
$networktype = $networkreg{$networkuuid}->{'type'};
|
| 1480 |
2a63870a
|
Christian Orellana
|
$externalip++ if ($networktype eq 'externalip'|| $networktype eq 'ipmapping');
|
| 1481 |
95b003ff
|
Origo
|
}
|
| 1482 |
|
|
}
|
| 1483 |
|
|
}
|
| 1484 |
|
|
untie %domreg;
|
| 1485 |
|
|
untie %imagereg;
|
| 1486 |
|
|
untie %networkreg;
|
| 1487 |
|
|
|
| 1488 |
|
|
# List pricing for all servers
|
| 1489 |
|
|
} else {
|
| 1490 |
d24d9a01
|
hq
|
# Network billing
|
| 1491 |
95b003ff
|
Origo
|
unless ( tie(%bnetworksreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_networks', key=>'useridtime'}, $Stabile::dbopts)) ) {return "Unable to access billing register"};
|
| 1492 |
|
|
unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access networks register"};
|
| 1493 |
|
|
|
| 1494 |
d24d9a01
|
hq
|
# Build list of the user's network id's
|
| 1495 |
95b003ff
|
Origo
|
my %usernetworks;
|
| 1496 |
8d7785ff
|
Origo
|
my @nkeys = (tied %networkreg)->select_where("user = '$buser'");
|
| 1497 |
95b003ff
|
Origo
|
foreach $network (@nkeys) {
|
| 1498 |
|
|
my $id = $networkreg{$network}->{'id'};
|
| 1499 |
|
|
$usernetworks{$id} = $id unless ($usernetworks{$id} || $id==0 || $id==1);
|
| 1500 |
|
|
}
|
| 1501 |
|
|
untie %networkreg;
|
| 1502 |
|
|
|
| 1503 |
|
|
foreach $id (keys %usernetworks) {
|
| 1504 |
|
|
my $networkobj = $bnetworksreg{"$buser-$id-$byear-$bmonth"};
|
| 1505 |
|
|
my $prevnetworkobj = $bnetworksreg{"$buser-$id-$prevyear-$prevmonth"};
|
| 1506 |
|
|
$externalip += $networkobj->{'externalip'};
|
| 1507 |
|
|
$externalipavg += $networkobj->{'externalipavg'};
|
| 1508 |
|
|
$rx += $networkobj->{'rx'};
|
| 1509 |
|
|
$tx += $networkobj->{'tx'};
|
| 1510 |
|
|
$prev_rx += $prevnetworkobj->{'rx'};
|
| 1511 |
|
|
$prev_tx += $prevnetworkobj->{'tx'};
|
| 1512 |
|
|
}
|
| 1513 |
|
|
untie %bnetworksreg;
|
| 1514 |
|
|
|
| 1515 |
|
|
# Image billing
|
| 1516 |
|
|
|
| 1517 |
|
|
unless ( tie(%bimagesreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_images', key=>'userstoragepooltime'}, $Stabile::dbopts)) ) {return "Unable to access billing register"};
|
| 1518 |
|
|
|
| 1519 |
|
|
# Build list of the users storage pools
|
| 1520 |
|
|
my $storagepools = $Stabile::config->get('STORAGE_POOLS_DEFAULTS') || "0";
|
| 1521 |
|
|
my $upools = $register{$buser}->{'storagepools'}; # Prioritized list of users storage pools as numbers, e.g. "0,2,1"
|
| 1522 |
8d7785ff
|
Origo
|
$storagepools = $upools if ($upools && $upools ne '--');
|
| 1523 |
95b003ff
|
Origo
|
my @spl = split(/,\s*/, $storagepools);
|
| 1524 |
|
|
my $bimageobj = $bimagesreg{"$buser--1-$byear-$bmonth"};
|
| 1525 |
|
|
$backupsize = $bimageobj->{'backupsize'}+0;
|
| 1526 |
|
|
$nodevirtualsize = $bimageobj->{'virtualsize'}+0;
|
| 1527 |
|
|
$backupsizeavg = $bimageobj->{'backupsizeavg'}+0;
|
| 1528 |
|
|
$nodevirtualsizeavg = $bimageobj->{'virtualsizeavg'}+0;
|
| 1529 |
|
|
foreach $pool (@spl) {
|
| 1530 |
|
|
$bimageobj = $bimagesreg{"$buser-$pool-$byear-$bmonth"};
|
| 1531 |
|
|
$virtualsize += $bimageobj->{'virtualsize'};
|
| 1532 |
|
|
$backupsize += $bimageobj->{'backupsize'};
|
| 1533 |
|
|
$virtualsizeavg += $bimageobj->{'virtualsizeavg'};
|
| 1534 |
|
|
$backupsizeavg += $bimageobj->{'backupsizeavg'};
|
| 1535 |
|
|
}
|
| 1536 |
|
|
untie %bimagesreg;
|
| 1537 |
|
|
|
| 1538 |
|
|
# Server billing
|
| 1539 |
|
|
|
| 1540 |
|
|
unless ( tie(%bserversreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_domains', key=>'usernodetime'}, $Stabile::dbopts)) ) {return "Unable to access billing register"};
|
| 1541 |
|
|
unless ( tie(%nodereg,'Tie::DBI', Hash::Merge::merge({table=>'nodes', key=>'mac'}, $Stabile::dbopts)) ) {return "Unable to access billing register"};
|
| 1542 |
|
|
|
| 1543 |
c899e439
|
Origo
|
my @usernodes = keys %nodereg;
|
| 1544 |
95b003ff
|
Origo
|
untie %nodereg;
|
| 1545 |
|
|
|
| 1546 |
|
|
my @nodebills;
|
| 1547 |
c899e439
|
Origo
|
foreach $mac (@usernodes) {
|
| 1548 |
95b003ff
|
Origo
|
my $bserverobj = $bserversreg{"$buser-$mac-$byear-$bmonth"};
|
| 1549 |
|
|
$vcpu += $bserverobj->{'vcpu'};
|
| 1550 |
|
|
$memory += $bserverobj->{'memory'};
|
| 1551 |
|
|
$vcpuavg += $bserverobj->{'vcpuavg'};
|
| 1552 |
|
|
$memoryavg += $bserverobj->{'memoryavg'};
|
| 1553 |
a93267ad
|
hq
|
|
| 1554 |
|
|
$vgpu += $bserverobj->{'vgpu'};
|
| 1555 |
|
|
$vmemory += $bserverobj->{'vmemory'};
|
| 1556 |
|
|
$vgpuavg += $bserverobj->{'vgpuavg'};
|
| 1557 |
|
|
$vmemoryavg += $bserverobj->{'vmemoryavg'};
|
| 1558 |
95b003ff
|
Origo
|
}
|
| 1559 |
|
|
untie %bserversreg;
|
| 1560 |
|
|
}
|
| 1561 |
|
|
|
| 1562 |
|
|
my $uservcpuprice = 0+ $register{$user}->{'vcpuprice'};
|
| 1563 |
|
|
my $usermemoryprice = 0+ $register{$user}->{'memoryprice'};
|
| 1564 |
a93267ad
|
hq
|
my $uservgpuprice = 0+ $register{$user}->{'vgpuprice'};
|
| 1565 |
|
|
my $uservmemoryprice = 0+ $register{$user}->{'vmemoryprice'};
|
| 1566 |
95b003ff
|
Origo
|
my $userstorageprice = 0+ $register{$user}->{'storageprice'};
|
| 1567 |
|
|
my $usernodestorageprice = 0+ $register{$user}->{'nodestorageprice'};
|
| 1568 |
|
|
my $userexternalipprice = 0+ $register{$user}->{'externalipprice'};
|
| 1569 |
|
|
|
| 1570 |
|
|
$vcpuprice = $uservcpuprice || $Stabile::config->get('VCPU_PRICE') + 0;
|
| 1571 |
|
|
$memoryprice = $usermemoryprice || $Stabile::config->get('MEMORY_PRICE') + 0;
|
| 1572 |
a93267ad
|
hq
|
$vgpuprice = $uservgpuprice || $Stabile::config->get('VGPU_PRICE') + 0;
|
| 1573 |
|
|
$vmemoryprice = $uservmemoryprice || $Stabile::config->get('VMEMORY_PRICE') + 0;
|
| 1574 |
95b003ff
|
Origo
|
$storageprice = $userstorageprice || $Stabile::config->get('STORAGE_PRICE') + 0;
|
| 1575 |
|
|
$nodestorageprice = $usernodestorageprice || $Stabile::config->get('NODESTORAGE_PRICE') + 0;
|
| 1576 |
|
|
$externalipprice = $userexternalipprice || $Stabile::config->get('EXTERNALIP_PRICE') + 0;
|
| 1577 |
|
|
|
| 1578 |
|
|
my $memorygb = int(0.5 + 100*$memory/1024)/100;
|
| 1579 |
a93267ad
|
hq
|
my $vmemorygb = int(0.5 + 100*$vmemory/1024)/100;
|
| 1580 |
95b003ff
|
Origo
|
my $virtualsizegb = int(0.5 + 100*$virtualsize/1024/1024/1024)/100;
|
| 1581 |
|
|
my $nodevirtualsizegb = int(0.5 + 100*$nodevirtualsize/1024/1024/1024)/100;
|
| 1582 |
|
|
my $backupsizegb = int(0.5 + 100*$backupsize/1024/1024/1024)/100;
|
| 1583 |
|
|
|
| 1584 |
a93267ad
|
hq
|
my $totalprice = int(0.5 + 100*(
|
| 1585 |
|
|
$vcpu*$vcpuprice + $memorygb*$memoryprice
|
| 1586 |
|
|
+ $vgpu*$vgpuprice + $vmemorygb*$vemoryprice
|
| 1587 |
|
|
+ $virtualsizegb*$storageprice
|
| 1588 |
|
|
+ $nodevirtualsizegb*$nodestorageprice + $backupsizegb*$storageprice + $externalip*$externalipprice)
|
| 1589 |
|
|
) /100;
|
| 1590 |
95b003ff
|
Origo
|
|
| 1591 |
|
|
my $memoryavggb = int(0.5 + 100*$memoryavg/1024)/100;
|
| 1592 |
a93267ad
|
hq
|
my $vmemoryavggb = int(0.5 + 100*$vmemoryavg/1024)/100;
|
| 1593 |
95b003ff
|
Origo
|
my $virtualsizeavggb = int(0.5 + 100*$virtualsizeavg/1024/1024/1024)/100;
|
| 1594 |
|
|
my $nodevirtualsizeavggb = int(0.5 + 100*$nodevirtualsizeavg/1024/1024/1024)/100;
|
| 1595 |
|
|
my $backupsizeavggb = int(0.5 + 100*$backupsizeavg/1024/1024/1024)/100;
|
| 1596 |
|
|
|
| 1597 |
|
|
my $monfac = 1;
|
| 1598 |
|
|
if ($bmonth == $month) {
|
| 1599 |
|
|
# Find 00:00 of first day of month - http://www.perlmonks.org/?node_id=97120
|
| 1600 |
|
|
my $fstamp = POSIX::mktime(0,0,0,1,$mon,$year-1900,0,0,-1);
|
| 1601 |
|
|
my $lstamp = POSIX::mktime(0,0,0,1,$mon+1,$year-1900,0,0,-1);
|
| 1602 |
|
|
$monfac = ($current_time-$fstamp)/($lstamp-$fstamp);
|
| 1603 |
|
|
}
|
| 1604 |
|
|
|
| 1605 |
a93267ad
|
hq
|
my $totalpriceavg = int(0.5 + 100*$monfac * (
|
| 1606 |
|
|
$vcpuavg*$vcpuprice + $memoryavggb*$memoryprice
|
| 1607 |
|
|
+ $vgpuavg*$vcpuprice + $vmemoryavggb*$memoryprice
|
| 1608 |
|
|
+ $virtualsizeavggb*$storageprice
|
| 1609 |
|
|
+ $nodevirtualsizeavggb*$nodestorageprice + $backupsizeavggb*$storageprice + $externalipavg*$externalipprice)
|
| 1610 |
|
|
) /100;
|
| 1611 |
95b003ff
|
Origo
|
|
| 1612 |
|
|
$prev_rx = 0 if ($prev_rx>$rx); # Something is fishy
|
| 1613 |
|
|
$prev_tx = 0 if ($prev_tx>$tx);
|
| 1614 |
|
|
my $rxgb = int(0.5 + 100*($rx-$prev_rx)/1024**3)/100;
|
| 1615 |
|
|
my $txgb = int(0.5 + 100*($tx-$prev_tx)/1024**3)/100;
|
| 1616 |
|
|
|
| 1617 |
|
|
my %stats;
|
| 1618 |
|
|
$stats{'virtualsize'} = $virtualsizegb;
|
| 1619 |
|
|
$stats{'backupsize'} = $backupsizegb;
|
| 1620 |
|
|
$stats{'externalip'} = $externalip;
|
| 1621 |
|
|
$stats{'memory'} = $memorygb;
|
| 1622 |
a93267ad
|
hq
|
$stats{'vcpu'} = $vcpu;
|
| 1623 |
|
|
$stats{'vmemory'} = $vmemorygb;
|
| 1624 |
|
|
$stats{'vgpu'} = $vgpu;
|
| 1625 |
95b003ff
|
Origo
|
$stats{'month'} = $bmonth;
|
| 1626 |
|
|
$stats{'nodevirtualsize'} = $nodevirtualsizegb;
|
| 1627 |
|
|
$stats{'rx'} = $rxgb;
|
| 1628 |
|
|
$stats{'tx'} = $txgb;
|
| 1629 |
|
|
$stats{'username'} = $buser;
|
| 1630 |
|
|
$stats{'year'} = $byear;
|
| 1631 |
|
|
$stats{'totalcost'} = "$cur $totalprice" if ($showcost);
|
| 1632 |
|
|
$stats{'curtotal'} = $totalprice if ($showcost);
|
| 1633 |
|
|
|
| 1634 |
|
|
if (!$curuuid) {
|
| 1635 |
|
|
$stats{'virtualsizeavg'} = $virtualsizeavggb;
|
| 1636 |
|
|
$stats{'backupsizeavg'} = $backupsizeavggb;
|
| 1637 |
|
|
$stats{'memoryavg'} = $memoryavggb;
|
| 1638 |
|
|
$stats{'vcpuavg'} = int(0.5 + 100*$vcpuavg)/100;
|
| 1639 |
a93267ad
|
hq
|
$stats{'vmemoryavg'} = $vmemoryavggb;
|
| 1640 |
|
|
$stats{'vgpuavg'} = int(0.5 + 100*$vgpuavg)/100;
|
| 1641 |
|
|
$stats{'nodevirtualsizeavg'} = $nodevirtualsizeavggb;
|
| 1642 |
95b003ff
|
Origo
|
$stats{'externalipavg'} = int(0.5 + 100*$externalipavg)/100;
|
| 1643 |
|
|
$stats{'totalcostavg'} = "$cur $totalpriceavg" if ($showcost);
|
| 1644 |
|
|
}
|
| 1645 |
|
|
return %stats;
|
| 1646 |
|
|
}
|
| 1647 |
|
|
|
| 1648 |
|
|
sub do_resetpassword {
|
| 1649 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1650 |
|
|
if ($help) {
|
| 1651 |
|
|
return <<END
|
| 1652 |
|
|
GET:username:
|
| 1653 |
|
|
Sends an email to a user with a link to reset his password. The user must have a valid email address.
|
| 1654 |
|
|
END
|
| 1655 |
|
|
}
|
| 1656 |
|
|
my $username = $obj->{'username'} || $user;
|
| 1657 |
|
|
if ($register{$username} && ($username eq $user || $isadmin)) {
|
| 1658 |
|
|
my $mailaddrs = $register{$username}->{'email'};
|
| 1659 |
|
|
$mailaddrs = $username if (!$mailaddrs && $username =~ /\@/);
|
| 1660 |
|
|
if ($mailaddrs) {
|
| 1661 |
|
|
require (dirname(__FILE__)) . "/../auth/Apache/AuthTkt.pm";
|
| 1662 |
|
|
my $tktname = 'auth_' . substr($engineid, 0, 8);
|
| 1663 |
|
|
my $at = Apache::AuthTkt->new(conf => $ENV{MOD_AUTH_TKT_CONF});
|
| 1664 |
|
|
my $tkt = $at->ticket(uid => $username, digest_type => 'SHA512', tokens => '', debug => 0);
|
| 1665 |
|
|
# my $valid = $at->valid_ticket($tkt);
|
| 1666 |
|
|
|
| 1667 |
|
|
my $mailhtml = <<END;
|
| 1668 |
|
|
<!DOCTYPE html
|
| 1669 |
|
|
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
|
| 1670 |
|
|
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
| 1671 |
|
|
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
|
| 1672 |
|
|
<head>
|
| 1673 |
|
|
<title>Password reset</title>
|
| 1674 |
|
|
<meta http-equiv="Pragma" content="no-cache" />
|
| 1675 |
|
|
<link rel="stylesheet" type="text/css" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/css/bootstrap.min.css" />
|
| 1676 |
|
|
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
|
| 1677 |
|
|
</head>
|
| 1678 |
|
|
<body class="tundra">
|
| 1679 |
|
|
<div>
|
| 1680 |
|
|
<div class="well" style="margin:20px;">
|
| 1681 |
|
|
<h3 style="color: #e74c3c!important; margin-bottom:30px;">You requested a password reset at $enginename</h3>
|
| 1682 |
|
|
To log in and set a new password, please click <a href="$baseurl/auth/autologin?$tktname=$tkt\&back=#chpwd">here</a>.<br>
|
| 1683 |
|
|
<div>Thanks,<br>your friendly infrastructure services</div>
|
| 1684 |
|
|
</div>
|
| 1685 |
|
|
</div>
|
| 1686 |
|
|
</div>
|
| 1687 |
|
|
</body>
|
| 1688 |
|
|
</html>
|
| 1689 |
|
|
END
|
| 1690 |
|
|
;
|
| 1691 |
|
|
my $msg = MIME::Lite->new(
|
| 1692 |
|
|
From => "$enginename",
|
| 1693 |
|
|
To => $mailaddrs,
|
| 1694 |
|
|
Type => 'multipart/alternative',
|
| 1695 |
|
|
Subject => "Password reset on $enginename",
|
| 1696 |
|
|
);
|
| 1697 |
|
|
# my $att_text = MIME::Lite->new(
|
| 1698 |
|
|
# Type => 'text',
|
| 1699 |
|
|
# Data => $mailtext,
|
| 1700 |
|
|
# Encoding => 'quoted-printable',
|
| 1701 |
|
|
# );
|
| 1702 |
|
|
# $att_text->attr('content-type' => 'text/plain; charset=UTF-8');
|
| 1703 |
|
|
# $msg->attach($att_text);
|
| 1704 |
|
|
my $att_html = MIME::Lite->new(
|
| 1705 |
|
|
Type => 'text',
|
| 1706 |
|
|
Data => $mailhtml,
|
| 1707 |
|
|
Encoding => 'quoted-printable',
|
| 1708 |
|
|
);
|
| 1709 |
|
|
$att_html->attr('content-type' => 'text/html; charset=UTF-8');
|
| 1710 |
|
|
$msg->attach($att_html);
|
| 1711 |
|
|
my $res = $msg->send;
|
| 1712 |
|
|
$postreply = "Status=OK Password reset email sent to $mailaddrs\n";
|
| 1713 |
|
|
} else {
|
| 1714 |
|
|
$postreply = "Status=Error user does not have a registered email address\n";
|
| 1715 |
|
|
}
|
| 1716 |
|
|
} else {
|
| 1717 |
|
|
$postreply = "Status=Error invalid data submitted\n";
|
| 1718 |
|
|
}
|
| 1719 |
|
|
return $postreply;
|
| 1720 |
|
|
}
|
| 1721 |
|
|
|
| 1722 |
|
|
sub do_changepassword {
|
| 1723 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1724 |
|
|
if ($help) {
|
| 1725 |
|
|
return <<END
|
| 1726 |
|
|
GET:username,password:
|
| 1727 |
|
|
Changes the password for a user.
|
| 1728 |
|
|
END
|
| 1729 |
|
|
}
|
| 1730 |
|
|
my $username = $obj->{'username'} || $user;
|
| 1731 |
|
|
my $password = $obj->{'password'};
|
| 1732 |
|
|
if ($password && $register{$username} && ($username eq $user || $isadmin)) {
|
| 1733 |
|
|
$MAXLEN = 20;
|
| 1734 |
|
|
var $msg = IsBadPassword($password);
|
| 1735 |
|
|
if ($msg) {
|
| 1736 |
|
|
$postreply = "Status=Error $msg - please choose a stronger password\n";
|
| 1737 |
|
|
} else {
|
| 1738 |
|
|
$password = Digest::SHA::sha512_base64($password);
|
| 1739 |
|
|
$register{$username}->{'password'} = $password;
|
| 1740 |
|
|
$postreply = "Status=OK Password changed for $username\n";
|
| 1741 |
|
|
}
|
| 1742 |
|
|
} else {
|
| 1743 |
|
|
$postreply = "Status=Error invalid data submitted\n";
|
| 1744 |
|
|
}
|
| 1745 |
|
|
return $postreply;
|
| 1746 |
|
|
}
|
| 1747 |
|
|
|
| 1748 |
|
|
sub do_remove {
|
| 1749 |
|
|
my ($uuid, $action, $obj) = @_;
|
| 1750 |
|
|
if ($help) {
|
| 1751 |
|
|
return <<END
|
| 1752 |
|
|
GET:username:
|
| 1753 |
|
|
Removes a user.
|
| 1754 |
|
|
END
|
| 1755 |
|
|
}
|
| 1756 |
|
|
my $username = $obj->{'username'};
|
| 1757 |
|
|
$postreply = remove($username);
|
| 1758 |
|
|
return $postreply;
|
| 1759 |
|
|
}
|
| 1760 |
|
|
|
| 1761 |
|
|
sub remove {
|
| 1762 |
|
|
my $username = shift;
|
| 1763 |
|
|
if (!$isadmin && ($user ne $engineuser)) {
|
| 1764 |
|
|
$postreply .= "Status=ERROR You are not allowed to remove user $username\n";
|
| 1765 |
|
|
} elsif ($register{$username}) {
|
| 1766 |
|
|
delete $register{$username};
|
| 1767 |
|
|
tied(%register)->commit;
|
| 1768 |
|
|
`/bin/rm /tmp/$username~*.tasks`;
|
| 1769 |
|
|
unlink "../cgi/ui_update/$username~ui_update.cgi" if (-e "../cgi/ui_update/$username~ui_update.cgi");
|
| 1770 |
|
|
$main::syslogit->($user, "info", "Deleted user $username from db");
|
| 1771 |
|
|
if ($console) {
|
| 1772 |
|
|
$postreply .= "Status=OK Deleted user $username\n";
|
| 1773 |
|
|
} else {
|
| 1774 |
|
|
# $main::updateUI->({ tab => 'users', type=>'update', user=>$user});
|
| 1775 |
|
|
return "{}";
|
| 1776 |
|
|
}
|
| 1777 |
|
|
return $postreply;
|
| 1778 |
|
|
} else {
|
| 1779 |
|
|
$postreply .= "Status=ERROR No such user: $username\n";
|
| 1780 |
|
|
}
|
| 1781 |
|
|
}
|
| 1782 |
|
|
|
| 1783 |
48fcda6b
|
Origo
|
# Update engine users with users received from the registry
|
| 1784 |
95b003ff
|
Origo
|
sub updateEngineUsers {
|
| 1785 |
|
|
my ($json_text) = @_;
|
| 1786 |
|
|
return unless ($isadmin || ($user eq $engineuser));
|
| 1787 |
|
|
my $res;
|
| 1788 |
|
|
my $json = JSON->new;
|
| 1789 |
|
|
$json->utf8([1]);
|
| 1790 |
|
|
my $json_obj = $json->decode($json_text);
|
| 1791 |
|
|
my @ulist = @$json_obj;
|
| 1792 |
|
|
my @efields = qw(password
|
| 1793 |
|
|
address city company country email fullname phone
|
| 1794 |
eb31fb38
|
hq
|
state zip alertemail opemail opfullname opphone billto
|
| 1795 |
95b003ff
|
Origo
|
memoryquota storagequota vcpuquota externalipquota rxquota txquota nodestoragequota
|
| 1796 |
54401133
|
hq
|
accounts accountsprivileges privileges modified dnsdomains appstoreurl totpsecret
|
| 1797 |
95b003ff
|
Origo
|
);
|
| 1798 |
48fcda6b
|
Origo
|
my $ures;
|
| 1799 |
|
|
my $ucount = 0;
|
| 1800 |
95b003ff
|
Origo
|
foreach my $u (@ulist) {
|
| 1801 |
|
|
my $username = $u->{'username'};
|
| 1802 |
|
|
if (!$register{$username} && $u->{'password'}) {
|
| 1803 |
|
|
$register{$username} = {
|
| 1804 |
|
|
username => $username,
|
| 1805 |
d24d9a01
|
hq
|
password => $u->{'password'},
|
| 1806 |
|
|
allowinternalapi => 1
|
| 1807 |
95b003ff
|
Origo
|
};
|
| 1808 |
48fcda6b
|
Origo
|
$ures .= " *";
|
| 1809 |
95b003ff
|
Origo
|
}
|
| 1810 |
|
|
next unless ($register{$username});
|
| 1811 |
|
|
next if ($register{$username}->{'modified'} && $register{$username}->{'modified'} > $u->{'modified'});
|
| 1812 |
|
|
foreach my $efield (@efields) {
|
| 1813 |
|
|
if ($efield eq 'privileges') {
|
| 1814 |
|
|
$u->{$efield} =~ tr/adnrpu//cd; # filter out non-valid privileges
|
| 1815 |
|
|
}
|
| 1816 |
|
|
if (defined $u->{$efield}) {
|
| 1817 |
|
|
$u->{$efield} += 0 if ($efield =~ /(quota|price)$/);
|
| 1818 |
|
|
$register{$username}->{$efield} = $u->{$efield};
|
| 1819 |
|
|
}
|
| 1820 |
|
|
delete $u->{$efield} if (defined $u->{$efield} && $u->{$efield} eq '' && $efield ne 'password')
|
| 1821 |
|
|
}
|
| 1822 |
48fcda6b
|
Origo
|
$ures .= "$username ($u->{'fullname'}), ";
|
| 1823 |
|
|
$ucount++;
|
| 1824 |
95b003ff
|
Origo
|
my $uid = `id -u irigo-$username`; chomp $uid;
|
| 1825 |
|
|
if (!$uid) { # Check user has system account for disk quotas
|
| 1826 |
|
|
$main::syslogit->($user, "info", "Adding system user $username");
|
| 1827 |
|
|
`/usr/sbin/useradd -m "irigo-$username"`;
|
| 1828 |
104449f5
|
Origo
|
`echo "[User]\nSystemAccount=true" > /var/lib/AccountsService/users/irigo-$username`; # Don't show in login screen
|
| 1829 |
95b003ff
|
Origo
|
}
|
| 1830 |
|
|
|
| 1831 |
|
|
}
|
| 1832 |
48fcda6b
|
Origo
|
$ures = substr($res, 0, -2) . "\n";
|
| 1833 |
705b5366
|
hq
|
$res .= "Status=OK Received $ucount updates on " .(scalar(@ulist)). " registry users\n";
|
| 1834 |
95b003ff
|
Origo
|
return $res;
|
| 1835 |
|
|
}
|
| 1836 |
|
|
|
| 1837 |
|
|
sub sendEngineUser {
|
| 1838 |
|
|
my ($username) = @_;
|
| 1839 |
|
|
if ($enginelinked) {
|
| 1840 |
48fcda6b
|
Origo
|
# Send engine user to the registry
|
| 1841 |
95b003ff
|
Origo
|
require LWP::Simple;
|
| 1842 |
|
|
my $browser = LWP::UserAgent->new;
|
| 1843 |
|
|
$browser->agent('stabile/1.0b');
|
| 1844 |
|
|
$browser->protocols_allowed( [ 'http','https'] );
|
| 1845 |
|
|
|
| 1846 |
|
|
my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
|
| 1847 |
|
|
my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
|
| 1848 |
|
|
my $tkthash = Digest::SHA::sha512_hex($tktkey);
|
| 1849 |
|
|
my $json = '[' . JSON::to_json(\%{$register{$username}}) . ']';
|
| 1850 |
|
|
$json =~ s/null/""/g;
|
| 1851 |
|
|
# $json = uri_escape_utf8($json);
|
| 1852 |
|
|
$json = URI::Escape::uri_escape($json);
|
| 1853 |
48fcda6b
|
Origo
|
my $posturl = "https://www.stabile.io/irigo/engine.cgi?action=update";
|
| 1854 |
95b003ff
|
Origo
|
my $postreq = ();
|
| 1855 |
|
|
$postreq->{'POSTDATA'} = $json;
|
| 1856 |
|
|
$postreq->{'engineid'} = $engineid;
|
| 1857 |
|
|
$postreq->{'enginetkthash'} = $tkthash;
|
| 1858 |
|
|
|
| 1859 |
|
|
# my $req = HTTP::Request->new(POST => $posturl);
|
| 1860 |
|
|
# $req->content_type("application/json; charset='utf8'");
|
| 1861 |
|
|
# $req->content($postreq);
|
| 1862 |
|
|
|
| 1863 |
|
|
$content = $browser->post($posturl, $postreq)->content();
|
| 1864 |
|
|
# $content = $browser->post($posturl, 'Content-type' => 'text/plain;charset=utf-8', Content => $postreq)->content();
|
| 1865 |
|
|
# $content = $browser->request($req)->content();
|
| 1866 |
|
|
my $fullname = $register{$username}->{'fullname'};
|
| 1867 |
|
|
$fullname = Encode::decode('utf8', $fullname);
|
| 1868 |
71b897d3
|
hq
|
return "Updated $fullname in registry\n";
|
| 1869 |
95b003ff
|
Origo
|
}
|
| 1870 |
|
|
} |