Project

General

Profile

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