Project

General

Profile

Download (67.7 KB) Statistics
| Branch: | Revision:
1 95b003ff Origo
#!/usr/bin/perl
2
3
# All rights reserved and Copyright (c) 2020 Origo Systems ApS.
4
# This file is provided with no warranty, and is subject to the terms and conditions defined in the license file LICENSE.md.
5
# The license file is part of this source code package and its content is also available at:
6
# https://www.origo.io/info/stabiledocs/licensing/stabile-open-source-license
7
8
# Clear up tainted environment
9
$ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin';
10
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
11
12
#use warnings FATAL => 'all';
13
use CGI::Carp qw(fatalsToBrowser);
14 f222b89c hq
use CGI qw(:standard -head);
15 95b003ff Origo
use Getopt::Std;
16
use JSON;
17
use URI::Escape qw(uri_escape uri_unescape);
18
use Tie::DBI;
19
use Data::Dumper;
20
use Encode;
21
use Text::SimpleTable;
22
use ConfigReader::Simple;
23
use Sys::Syslog qw( :DEFAULT setlogsock);
24
use Digest::SHA qw(sha512_base64 sha512_hex);
25
use utf8;
26
use Hash::Merge qw( merge );
27
use Storable qw(freeze thaw);
28
use Gearman::Client;
29
use Proc::ProcessTable;
30
use HTTP::Async;
31
use HTTP::Request::Common;
32
use LWP::Simple qw(!head);
33
use Error::Simple;
34
35
our %options=();
36
# -a action -h help -f full list -p full update -u uuid -i image -m match pattern -k keywords -g args to gearman task
37
# -v verbose, include HTTP headers -s impersonate subaccount -t target [uuid or image] -c force console
38
Getopt::Std::getopts("a:hfpu:i:g:m:k:vs:t:c", \%options);
39
40
$Stabile::config = ConfigReader::Simple->new("/etc/stabile/config.cfg",
41
    [qw(
42
        AMT_PASSWD
43
        DBI_PASSWD
44
        DBI_USER
45
        DO_DNS
46
        DNS_DOMAIN
47
        DO_XMPP
48
        ENGINEID
49
        ENGINENAME
50
        ENGINE_DATA_NIC
51
        ENGINE_LINKED
52
        EXTERNAL_IP_RANGE_START
53
        EXTERNAL_IP_RANGE_END
54
        EXTERNAL_IP_QUOTA
55
        EXTERNAL_NIC
56
        EXTERNAL_SUBNET_SIZE
57
        MEMORY_QUOTA
58
        NODE_STORAGE_OVERCOMMISSION
59
        NODESTORAGE_QUOTA
60
        PROXY_GW
61
        PROXY_IP
62
        PROXY_IP_RANGE_END
63
        PROXY_IP_RANGE_START
64
        PROXY_SUBNET_SIZE
65
        RDIFF-BACKUP_ENABLED
66
        RDIFF-BACKUP_USERS
67 6372a66e hq
        REMOTE_IP_ENABLED
68
        REMOTE_IP_PROVIDER
69 a93267ad hq
        GPU_PASSTHROUGH_ENABLED
70 95b003ff Origo
        RX_QUOTA
71
        SHOW_COST
72
        STORAGE_BACKUPDIR
73
        STORAGE_POOLS_ADDRESS_PATHS
74
        STORAGE_POOLS_DEFAULTS
75
        STORAGE_POOLS_LOCAL_PATHS
76
        STORAGE_POOLS_NAMES
77
        STORAGE_POOLS_RDIFF-BACKUP_ENABLED
78
        STORAGE_QUOTA
79
        Z_IMAGE_RETENTION
80
        Z_BACKUP_RETENTION
81
        TX_QUOTA
82
        VCPU_QUOTA
83
        VLAN_RANGE_START
84
        VLAN_RANGE_END
85
        VERSION
86
    )]);
87
88
$dbiuser =  $Stabile::config->get('DBI_USER') || "irigo";
89
$dbipasswd = $Stabile::config->get('DBI_PASSWD') || "";
90
$dnsdomain = $Stabile::config->get('DNS_DOMAIN') || "stabile.io";
91 2a63870a Christian Orellana
$appstoreurl = $Stabile::config->get('APPSTORE_URL') || "https://www.origo.io/registry";
92 c899e439 Origo
$appstores = $Stabile::config->get('APPSTORES') || "stabile.io"; # Used for publishing apps
93 95b003ff Origo
$engineuser = $Stabile::config->get('ENGINEUSER') || "";
94
$imageretention = $Stabile::config->get('Z_IMAGE_RETENTION') || "";
95
$backupretention = $Stabile::config->get('Z_BACKUP_RETENTION') || "";
96
$enginelinked = $Stabile::config->get('ENGINE_LINKED') || "";
97 a2e0bc7e hq
$downloadmasters = $Stabile::config->get('DOWNLOAD_MASTERS') || "";
98 f222b89c hq
$downloadallmasters = $Stabile::config->get('DOWNLOAD_ALL_MASTERS') || "";
99 95b003ff Origo
$disablesnat = $Stabile::config->get('DISABLE_SNAT') || "";
100 d3805c61 hq
our $enforceiolimits = $Stabile::config->get('ENFORCE_IO_LIMITS') || "";
101 e9af6c24 Origo
our $engineid = $Stabile::config->get('ENGINEID') || "";
102 95b003ff Origo
103 a2e0bc7e hq
$Stabile::remoteipprovider = ($Stabile::config->get('REMOTE_IP_PROVIDER')) || "";
104
$Stabile::remoteipenabled = ($Stabile::config->get('REMOTE_IP_ENABLED') && $Stabile::config->get('ENGINE_LINKED')) || "";
105
$Stabile::engineuser = $Stabile::config->get('ENGINEUSER') || "";
106
107 a93267ad hq
$Stabile::gpupassthroughenabled = ($Stabile::config->get('GPU_PASSTHROUGH_ENABLED')) || "";
108
109 95b003ff Origo
$Stabile::dbopts = {db=>'mysql:steamregister', key=>'uuid', autocommit=>0, CLOBBER=>2, user=>$dbiuser, password=>$dbipasswd};
110
$Stabile::auth_tkt_conf = "/etc/apache2/conf-available/auth_tkt_cgi.conf";
111
112
my $base = "/var/www/stabile";
113
$base = `cat /etc/stabile/basedir` if (-e "/etc/stabile/basedir");
114
chomp $base;
115
$base =~ /(.+)/; $base = $1; #untaint
116
$main::logfile = "/var/log/stabile/steam.log";
117
118
$current_time = time;
119
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($current_time);
120
$year += 1900;
121
$month = substr("0" . ($mon+1), -2);
122
$pretty_time = sprintf "%4d-%02d-%02d@%02d:%02d:%02d",$year,$mon+1,$mday,$hour,$min,$sec;
123
124 d24d9a01 hq
if ($ENV{'HTTP_HOST'} && !($ENV{'HTTP_HOST'} =~ /^10\./) && $ENV{'HTTP_HOST'} ne 'localhost' && !($ENV{'HTTP_HOST'} =~ /^127/)) {
125
    $baseurl = "https://$ENV{'HTTP_HOST'}/stabile";
126
    `echo "$baseurl" > /tmp/baseurl` if ((! -e "/tmp/baseurl") && $baseurl);
127 2a63870a Christian Orellana
} else  {
128
    if (!$baseurl && (-e "/tmp/baseurl" || -e "/etc/stabile/baseurl")) {
129
        if (-e "/etc/stabile/baseurl") {
130
            $baseurl = `cat /etc/stabile/baseurl`;
131
        } else {
132
            $baseurl = `cat /tmp/baseurl`;
133
            chomp $baseurl;
134
            `echo "$baseurl" >/etc/stabile/baseurl` unless (-e "/etc/stabile/baseurl");
135
        }
136
    }
137
}
138
if (!$baseurl) {
139
    my $hostname = `hostname`; chomp $hostname;
140
    $baseurl = "https://$hostname/stabile";
141
}
142 95b003ff Origo
$baseurl = $1 if ($baseurl =~ /(.+)/); #untaint
143
144
$Stabile::basedir = "/var/www/stabile";
145
$Stabile::basedir = `cat /etc/stabile/basedir` if -e "/etc/stabile/basedir";
146
chomp $Stabile::basedir;
147
$Stabile::basedir = $1 if ($Stabile::basedir =~ /(.+)/); #untaint
148
149
$package = substr(lc __PACKAGE__, length "Stabile::");
150
$programname = "Stabile";
151
152
$sshcmd = qq|ssh -l irigo -i /var/www/.ssh/id_rsa_www -o UserKnownHostsFile=/dev/null -o StrictHostKeyChecking=no|;
153
154
$ENV{'REQUEST_METHOD'} = $ENV{'REQUEST_METHOD'} || 'GET';
155
156
preInit();
157
1;
158
159
$main::syslogit = sub {
160
	my ($user, $p, $msg) = @_;
161
	my $priority = ($p eq 'syslog')?'info':$p;
162
163
    $current_time = time;
164
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($current_time);
165
    $year += 1900;
166
    $month = substr("0" . ($mon+1), -2);
167
    my $pretty_time = sprintf "%4d-%02d-%02d@%02d:%02d:%02d",$year,$mon+1,$mday,$hour,$min,$sec;
168
169
    my $loguser = (!$tktuser || $tktuser eq $user)?"$user":"$user ($tktuser)";
170
	if ($msg && $msg ne '') {
171
	    utf8::decode($msg);
172
		unless (open(TEMP3, ">>$main::logfile")) {$posterror .= "Status=Error log file '$main::logfile' could not be written";}
173
        $msg =~ /(.+)/; $msg = $1; #untaint
174
		print TEMP3 $pretty_time, " : $loguser : $msg\n";
175
		close(TEMP3);
176
	}
177
	return 0 unless ($priority =~ /err|debug/);
178
	setlogsock('unix');
179
	# $programname is assumed to be a global.  Also log the PID
180
	# and to CONSole if there's a problem.  Use facility 'user'.
181
	openlog($programname, 'pid,cons', 'user');
182
	syslog($priority, "($loguser) $msg");
183
	closelog();
184
	return 1;
185
};
186
187
188
$main::postToOrigo = sub {
189
    my ($engineid, $postaction, $postcontent, $postkey, $callback) = @_;
190
    my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
191
    my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
192
    my $ret;
193
194
    if ($tktkey && $engineid) {
195
        my $browser = LWP::UserAgent->new;
196
        $browser->timeout(15);
197
        $browser->agent('pressurecontrol/1.0b');
198
        $browser->protocols_allowed( [ 'http','https'] );
199
200
        my $postreq;
201
        $postreq->{'engineid'} = $engineid;
202
        $postreq->{'enginetkthash'} = sha512_hex($tktkey) if ($enginelinked);
203
        $postreq->{'appuser'} = $user;
204
        $postreq->{'callback'} .= $callback if ($callback);
205
        $postkey = 'POSTDATA' unless ($postkey);
206
        $postreq->{$postkey} = $postcontent;
207
        my $posturl = "https://www.origo.io/irigo/engine.cgi?action=$postaction";
208
        my $content = $browser->post($posturl, $postreq)->content();
209
        my $ok = ($content =~ /OK: (.*)/i);
210
        $ret .= $content;
211
    } else {
212
        $main::syslogit->('pressurecontrol', 'info', "Unable to get engine tktkey...");
213
        $ret .= "Unable to get engine tktkey...";
214
    }
215
    return $ret;
216
};
217
218 48fcda6b Origo
$main::uploadToOrigo = sub {
219
    my ($engineid, $filepath, $force) = @_;
220
    my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
221
    my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
222
    my $ret;
223
224
    if (!$filepath || !(-e $filepath)) {
225
        $ret = "Status=Error Invalid file path\n";
226
    } elsif ($tktkey && $engineid) {
227 2a63870a Christian Orellana
        $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
228 48fcda6b Origo
        my $browser = LWP::UserAgent->new;
229
        $browser->timeout(15 * 60); # 15 min
230
        $browser->agent('pressurecontrol/1.0b');
231
        $browser->protocols_allowed( [ 'http','https'] );
232
        my $fname = $1 if ($filepath =~ /.*\/(.+\.qcow2)$/);
233
        return "Status=Error Invalid file\n" unless ($fname);
234
        my $posturl = "https://www.origo.io/irigo/engine.cgi?action=uploadimage";
235 2a63870a Christian Orellana
236
# -- using ->post
237
#         my $postreq = [
238
#             'file'          => [ $filepath ],
239
#             'filename'      => $fname,
240
#             'engineid'      => $engineid,
241
#             'enginetkthash' => sha512_hex($tktkey),
242
#             'appuser'       => $user,
243
#             'force'         => $force
244
#         ];
245
#         my $content = $browser->post($posturl, $postreq, 'Content_Type' => 'form-data')->content;
246
#         $ret .= $content;
247
248
# -- using ->request
249
        my $req = POST $posturl,
250
            Content_Type => 'form-data',
251
            Content => [
252
                'file'          => [ $filepath ],
253
                'filename'      => $fname,
254
                'engineid'      => $engineid,
255
                'enginetkthash' => sha512_hex($tktkey),
256
                'appuser'       => $user,
257
                'force'         => $force
258
            ];
259
        my $total;
260
        my $callback = $req->content;
261
        if (ref($callback) eq "CODE") {
262
            my $size = $req->header('content-length');
263
            my $counter = 0;
264
            my $progress = '';
265
            $req->content(
266
                sub {
267
                    my $chunk = $callback->();
268
                    if ($chunk) {
269
                        my $length = length $chunk;
270
                        $total += $length;
271
                        if ($total / $size * 100 > $counter) {
272
                            $counter = 1+ int $total / $size * 100;
273
                            $progress .= "#";
274
                            `echo "$progress$counter" >> /tmp/upload-$fname`;
275
                        }
276
#                        printf "%+5d = %5.1f%%\n", $length, $total / $size * 100;
277
#                        printf "%5.1f%%\n", $total / $size * 100;
278
279
                    } else {
280
#                        print "Done\n";
281
                    }
282
                    $chunk;
283
                }
284
            );
285
            my $resp = $browser->request($req)->content();
286
            $ret .= $resp;
287
            $ret .= "Status=OK $progress\n";
288
        } else {
289
            $ret .= "Status=Error Did not get a callback";
290
        }
291 48fcda6b Origo
    } else {
292
        $ret .= "Status=Error Unable to get engine tktkey...";
293
    }
294
    return $ret;
295
};
296
297 95b003ff Origo
$main::postAsyncToOrigo = sub {
298
    my ($engineid, $postaction, $json_text) = @_;
299
    my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
300
    my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
301
    my $ret;
302
303
    if ($tktkey && $engineid) {
304
        my $browser = LWP::UserAgent->new;
305
        $browser->timeout(15);
306
        $browser->agent('pressurecontrol/1.0b');
307
        $browser->protocols_allowed( [ 'http','https'] );
308
309
        $ret .= "Posting $postaction to origo.io\n";
310
311
        my $postreq;
312
        $postreq->{'engineid'} = $engineid;
313
        $postreq->{'enginetkthash'} = sha512_hex($tktkey);
314
        $postreq->{'POSTDATA'} = $json_text;
315
#        my $content = $browser->post("https://www.origo.io/irigo/engine.cgi?action=$postaction", $postreq)->content();
316
#        my $ok = ($content =~ /OK: (.*)/i);
317
#        $ret .= $content;
318
319
        my $async = HTTP::Async->new;
320
        my $post = POST "https://www.origo.io/irigo/engine.cgi?action=$postaction",
321
            [   engineid => $engineid,
322
                enginetkthash => sha512_hex($tktkey),
323
                POSTDATA => $json_text
324
            ];
325
        $async->add( $post );
326
#        while ( my $response = $async->wait_for_next_response ) {
327
#            $ret .= $response->decoded_content;
328
#        }
329
    } else {
330
        $main::syslogit->('pressurecontrol', 'info', "Unable to get engine tktkey...");
331
        $ret .= "Unable to get engine tktkey...";
332
    }
333
    return $ret;
334
};
335
336
$main::dnsCreate = sub {
337
    my ($engineid, $name, $value, $type, $username) = @_;
338
    my $res;
339 e9af6c24 Origo
    my $dnssubdomain = substr($engineid, 0, 8);
340
    $type = uc $type;
341
    $type || 'CNAME';
342 95b003ff Origo
    $name = $1 if ($name =~ /(.+)\.$dnsdomain/);
343 e9af6c24 Origo
    # $name =$1 if ($name =~ /(.+)\.$dnssubdomain/);
344
    if ($type eq 'A') { # Look for initial registrations and format correctly
345
        if (!$name && $value) { # If no name provided assume we are creating initial A-record
346
            $name = $value;
347
        } elsif ($name =~ /^(\d+\.\d+\.\d+\.\d+)/) { # Looks like an IP address - must be same as value
348
            if ($1 eq $value) { # Keep some order in registrations
349
                $name = "$value.$dnssubdomain"; # The way we format initial registrations
350
            } else {
351
                $name = '';
352
            }
353
        }
354
    }
355 95b003ff Origo
    # Only allow creation of records corresponding to user's own networks when username is supplied
356
    # When username is not supplied, we assume checking has been done
357
    if ($username) {
358
        my $checkval = $value;
359 e9af6c24 Origo
        # Remove any trailing period
360 95b003ff Origo
        $checkval = $1 if ($checkval =~ /(.+)\.$/);
361 6fdc8676 hq
        if ($type eq 'TXT') {
362
            $checkval = '';
363
        } elsif ($type eq 'A') {
364 95b003ff Origo
            $checkval = $value;
365
        } else {
366 e9af6c24 Origo
            $checkval = $1 if ($checkval =~ /(\d+\.\d+\.\d+\.\d+)\.$dnssubdomain\.$dnsdomain$/);
367 95b003ff Origo
            $checkval = $1 if ($checkval =~ /(\d+\.\d+\.\d+\.\d+)\.$dnsdomain$/);
368 e9af6c24 Origo
            $checkval = $1 if ($checkval =~ /(\d+\.\d+\.\d+\.\d+)$/);
369 95b003ff Origo
        }
370
        if ($checkval) {
371
            unless (tie %networkreg,'Tie::DBI', {
372
                    db=>'mysql:steamregister',
373
                    table=>'networks',
374
                    key=>'uuid',
375
                    autocommit=>0,
376
                    CLOBBER=>0,
377
                    user=>$dbiuser,
378
                    password=>$dbipasswd}) {throw Error::Simple("Error Register could not be accessed")};
379
            my @regkeys = (tied %networkreg)->select_where("externalip = '$checkval'");
380
            if (scalar @regkeys == 1) {
381 04c16f26 hq
                if ($register{$regkeys[0]} && $register{$regkeys[0]}->{'user'} eq $username) {
382 95b003ff Origo
                    ; # OK
383
                } else {
384 eb31fb38 hq
                    return qq|{"status": "Error", "message": "Invalid value $checkval, not allowed"}|;
385 95b003ff Origo
                }
386
            } elsif (scalar @regkeys >1) {
387 eb31fb38 hq
                return qq|{"status": "Error", "message": "Invalid value $checkval"}|;
388 95b003ff Origo
            }
389
            untie %networkreg;
390 e9af6c24 Origo
            if ($type eq 'A') {
391 6fdc8676 hq
#                $name = "$checkval.$dnssubdomain"; # Only allow this type of A-records...?
392 e9af6c24 Origo
            } else {
393
                $value = "$checkval.$dnssubdomain";
394
            }
395 95b003ff Origo
        }
396
    }
397
398 6fdc8676 hq
    if ($type ne 'MX' && $type ne 'TXT' && `host $name.$dnsdomain authns1.cabocomm.dk` =~ /has address/) {
399 eb31fb38 hq
        return qq|{"status": "Error", "message": "$name is already registered"}|;
400 e9af6c24 Origo
    };
401
402 95b003ff Origo
    if ($enginelinked && $name && $value) {
403
        require LWP::Simple;
404
        my $browser = LWP::UserAgent->new;
405
        $browser->agent('Stabile/1.0b');
406
        $browser->protocols_allowed( [ 'http','https'] );
407
        $browser->timeout(10);
408
        my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
409
        my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
410
        my $tkthash = sha512_hex($tktkey);
411
        my $posturl = "https://www.origo.io/irigo/engine.cgi?action=dnscreate";
412
413
        my $async = HTTP::Async->new;
414
        my $post = POST $posturl,
415 6fdc8676 hq
            [ engineid        => $engineid,
416 95b003ff Origo
                enginetkthash => $tkthash,
417 6fdc8676 hq
                name          => $name,
418
                domain        => $dnsdomain,
419
                value         => $value,
420
                type          => $type,
421
                username      => $username || $user
422 95b003ff Origo
            ];
423
        # We fire this asynchronously and hope for the best. Waiting for an answer is just too erratic for now
424
        $async->add( $post );
425
426
        if ($username) {
427
            my $response;
428
            while ( $response = $async->wait_for_next_response ) {
429
                $ret .= $response->decoded_content;
430
            }
431
            foreach my $line (split /\n/, $ret) {
432
               $res .= $line unless ($line =~ /^\d/);
433
            }
434
        }
435 eb31fb38 hq
    #    $res =~ s/://g;
436 3657de20 Origo
        return "$res\n";
437 95b003ff Origo
438
    } else {
439 eb31fb38 hq
        return qq|{"status": "Error", "message": "Problem creating dns record with data $name, $value.| . ($enginelinked?"":" Engine is not linked!") . qq|"}|;
440 95b003ff Origo
    }
441
};
442
443
$main::dnsDelete = sub {
444 ca937547 hq
    my ($engineid, $name, $value, $type, $username) = @_;
445 e9af6c24 Origo
    my $dnssubdomain = substr($engineid, 0, 8);
446 afc024ef hq
    $name = $1 if ($name =~ /(.+)\.$dnsdomain$/);
447
#    $name =$1 if ($name =~ /(.+)\.$dnssubdomain/);
448 ca937547 hq
    if ($name =~ /^(\d+\.\d+\.\d+\.\d+)$/) {
449
        $name = "$1.$dnssubdomain";
450
        $type = $type || 'A';
451 95b003ff Origo
    }
452
453 ca937547 hq
    $main::syslogit->($user, "info", "Deleting DNS entry $type $name $dnsdomain");
454 95b003ff Origo
    if ($enginelinked && $name) {
455
        require LWP::Simple;
456
        my $browser = LWP::UserAgent->new;
457
        $browser->agent('Stabile/1.0b');
458
        $browser->protocols_allowed( [ 'http','https'] );
459
        my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
460
        my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
461
        my $tkthash = sha512_hex($tktkey);
462
        my $posturl = "https://www.origo.io/irigo/engine.cgi?action=dnsdelete";
463
464
        my $postreq = ();
465
        $postreq->{'engineid'} = $engineid;
466
        $postreq->{'enginetkthash'} = $tkthash;
467
        $postreq->{'name'} = $name;
468 ca937547 hq
        $postreq->{'value'} = $value;
469
        $postreq->{'type'} = $type;
470 6fdc8676 hq
        $postreq->{'username'} = $username || $user;
471
        $postreq->{'domain'} = "$dnsdomain";
472 95b003ff Origo
        $content = $browser->post($posturl, $postreq)->content();
473 eb31fb38 hq
    #    $content =~ s/://g;
474 95b003ff Origo
        return $content;
475
    } else {
476
        return "ERROR Invalid data $name." . ($enginelinked?"":" Engine is not linked!") . "\n";
477
    }
478
};
479
480 48fcda6b Origo
$main::dnsUpdate = sub {
481 eb31fb38 hq
    my ($engineid, $name, $value, $type, $oldname, $oldvalue, $username) = @_;
482 48fcda6b Origo
    $name = $1 if ($name =~ /(.+)\.$dnsdomain/);
483 eb31fb38 hq
    $type = uc $type;
484
    $type || 'CNAME';
485 48fcda6b Origo
486
    # Only allow deletion of records corresponding to user's own networks when username is supplied
487
    # When username is not supplied, we assume checking has been done
488 eb31fb38 hq
    # Obsolete
489
    # my $checkval;
490
    # if ($username) {
491
    #     if ($name =~ /\d+\.\d+\.\d+\.\d+/) {
492
    #         $checkval = $name;
493
    #     } else {
494
    #         my $checkname = $name;
495
    #         # Remove trailing period
496
    #         $checkname = $1 if ($checkname =~ /(.+)\.$/);
497
    #         $checkname = "$checkname.$dnsdomain" unless ($checkname =~ /(.+)\.$dnsdomain$/);
498
    #         $checkval = $1 if (`host $checkname authns1.cabocomm.dk` =~ /has address (\d+\.\d+\.\d+\.\d+)/);
499
    #         return "ERROR Invalid value $checkname\n" unless ($checkval);
500
    #     }
501
    #
502
    #     unless (tie %networkreg,'Tie::DBI', {
503
    #         db=>'mysql:steamregister',
504
    #         table=>'networks',
505
    #         key=>'uuid',
506
    #         autocommit=>0,
507
    #         CLOBBER=>0,
508
    #         user=>$dbiuser,
509
    #         password=>$dbipasswd}) {throw Error::Simple("Error Register could not be accessed")};
510
    #     my @regkeys = (tied %networkreg)->select_where("externalip = '$checkval' OR internalip = '$checkval'");
511
    #     if ($isadmin || (scalar @regkeys == 1 && $register{$regkeys[0]}->{'user'} eq $username)) {
512
    #         ; # OK
513
    #     } else {
514
    #         return "ERROR Invalid user for $checkval, not allowed\n";
515
    #     }
516
    #     untie %networkreg;
517
    # }
518 48fcda6b Origo
519
    $main::syslogit->($user, "info", "Updating DNS entries for $name $dnsdomain");
520
    if ($enginelinked && $name) {
521
        require LWP::Simple;
522
        my $browser = LWP::UserAgent->new;
523
        $browser->agent('Stabile/1.0b');
524
        $browser->protocols_allowed( [ 'http','https'] );
525
        my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
526
        my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
527
        my $tkthash = sha512_hex($tktkey);
528
        my $posturl = "https://www.origo.io/irigo/engine.cgi?action=dnsupdate";
529
530
        my $postreq = ();
531
        $postreq->{'engineid'} = $engineid;
532
        $postreq->{'enginetkthash'} = $tkthash;
533
        $postreq->{'name'} = $name;
534 eb31fb38 hq
        $postreq->{'value'} = $value;
535
        $postreq->{'type'} = $type;
536
        $postreq->{'oldname'} = $oldname if ($oldname);
537
        $postreq->{'oldvalue'} = $oldvalue if ($oldvalue);
538 6fdc8676 hq
        $postreq->{'username'} = $username || $user;
539 48fcda6b Origo
        $postreq->{'domain'} = $dnsdomain;
540
        $content = $browser->post($posturl, $postreq)->content();
541
        return $content;
542
    } else {
543
        return "ERROR Invalid data $name." . ($enginelinked?"":" Engine is not linked!") . "\n";
544
    }
545
};
546
547 e9af6c24 Origo
$main::dnsList = sub {
548 eb31fb38 hq
    my ($engineid, $username, $domain) = @_;
549 e9af6c24 Origo
    if ($enginelinked) {
550
        require LWP::Simple;
551
        my $browser = LWP::UserAgent->new;
552
        $browser->agent('Stabile/1.0b');
553
        $browser->protocols_allowed( [ 'http','https'] );
554
        my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
555
        my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
556
        my $tkthash = sha512_hex($tktkey);
557
        my $posturl = "https://www.origo.io/irigo/engine.cgi?action=dnslist";
558 eb31fb38 hq
        $domain = $domain || $dnsdomain;
559 e9af6c24 Origo
560
        my $postreq = ();
561
        $postreq->{'engineid'} = $engineid;
562
        $postreq->{'enginetkthash'} = $tkthash;
563 eb31fb38 hq
        $postreq->{'domain'} = $domain;
564 6fdc8676 hq
        $postreq->{'username'} = $username || $user;
565 e9af6c24 Origo
        $content = $browser->post($posturl, $postreq)->content();
566 eb31fb38 hq
    #    $content =~ s/://g;
567 e9af6c24 Origo
        return $content;
568
    } else {
569
        return "ERROR Engine is not linked!\n";
570
    }
571
};
572
573
$main::dnsClean = sub {
574
    my ($engineid, $username) = @_;
575
    if ($enginelinked) {
576
        require LWP::Simple;
577
        my $browser = LWP::UserAgent->new;
578
        $browser->agent('Stabile/1.0b');
579
        $browser->protocols_allowed( [ 'http','https'] );
580
        my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
581
        my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
582
        my $tkthash = sha512_hex($tktkey);
583
        my $posturl = "https://www.origo.io/irigo/engine.cgi?action=dnsclean";
584
        my $postreq = ();
585
        $postreq->{'engineid'} = $engineid;
586
        $postreq->{'enginetkthash'} = $tkthash;
587
        $postreq->{'domain'} = $dnsdomain;
588
        $content = $browser->post($posturl, $postreq)->content();
589
        $content =~ s/://g;
590
        return $content;
591
    } else {
592
        return "ERROR Engine is not linked!\n";
593
    }
594
};
595
596 95b003ff Origo
$main::xmppSend = sub {
597
    my ($to, $msg, $engineid, $sysuuid) = @_;
598
    $engineid = `cat /etc/stabile/config.cfg | sed -n -e 's/^ENGINEID=//p'` unless ($engineid);
599
    my $doxmpp = `cat /etc/stabile/config.cfg | sed -n -e 's/^DO_XMPP=//p'`;
600
    if (!$doxmpp) {
601
        return "INFO: DO_XMPP not enabled in config\n";
602
603
    } elsif ($to && $msg) {
604
        my $xdom;
605
        $xdom = $1 if ($to =~ /\@(.+)$/);
606
        if ($xdom && `host -t SRV _xmpp-server._tcp.$xdom` !~ /NXDOMAIN/) {
607
            require LWP::Simple;
608
            my $browser = LWP::UserAgent->new;
609
            $browser->agent('Stabile/1.0b');
610
            $browser->protocols_allowed( [ 'http','https'] );
611
            $browser->timeout(10);
612
            my $tktcfg = ConfigReader::Simple->new($Stabile::auth_tkt_conf, [qw(TKTAuthSecret)]);
613
            my $tktkey = $tktcfg->get('TKTAuthSecret') || '';
614
            my $tkthash = sha512_hex($tktkey);
615
            my $posturl = "https://www.origo.io/irigo/engine.cgi?action=xmppsend";
616
617
            my $async = HTTP::Async->new;
618
            my $post = POST $posturl,
619
                [   engineid => $engineid,
620
                    enginetkthash => $tkthash,
621
                    sysuuid => $sysuuid,
622
                    to => $to,
623
                    msg => $msg
624
                ];
625
            $async->add( $post );
626
627
            #my $postreq = ();
628
            #$postreq->{'engineid'} = $engineid;
629
            #$postreq->{'enginetkthash'} = $tkthash;
630
            #$postreq->{'to'} = $to;
631
            #$postreq->{'msg'} = $msg;
632
            #$content = $browser->post($posturl, $postreq)->content();
633
634
            return "Status=OK Sent xmpp message to $to\n";
635
        } else {
636
            return "Status=ERROR XMPP srv records not found for domain \"$xdom\"\n";
637
        }
638
639
    } else {
640
        return "Status=ERROR Invalid xmpp data $to, $msg\n";
641
    }
642
};
643
644 2a63870a Christian Orellana
# Enumerate and return network interfaces
645
$main::getNics = sub {
646
    my $internalnic = $Stabile::config->get('ENGINE_DATA_NIC');
647
    my $externalnic = $Stabile::config->get('EXTERNAL_NIC');
648
    if (!$externalnic) {
649
        my $droute = `ip route show default`;
650
        $externalnic = $1 if ($droute =~ /default via .+ dev (.+) proto/);
651
    }
652
    my @nics = ();
653
    if (!$externalnic || !$internalnic) {
654
        my $niclist = `ifconfig | grep flags= | sed -n -e 's/: .*//p'`;
655
        if (-e "/mnt/stabile/tftp/bionic") { # If a piston root exists, assume we will be providing boot services over secondary NIC even if it has no link
656
            $niclist = `ifconfig -a | grep flags= | sed -n -e 's/: .*//p'`;
657
        }
658
        # my $niclist = `netstat -in`;
659
        push @nics, $externalnic if ($externalnic);
660
        foreach my $line (split("\n", $niclist)) {
661
            if ($line =~ /^(\w+)$/) {
662
                my $nic = $1;
663
                push(@nics, $nic) if ($nic ne 'lo' && $nic ne $externalnic && !($nic=~/^virbr/) && !($nic=~/^docker/) && !($nic=~/^br/) && !($nic=~/^vnet/) && !($nic=~/^Name/) && !($nic=~/^Kernel/) && !($nic=~/^Iface/) && !($nic=~/(\.|\:)/));
664
            }
665
        }
666
    }
667
    $externalnic = $externalnic || $nics[0];
668
    $internalnic = $internalnic || $nics[1] || $externalnic;
669 f222b89c hq
    # We're dealing with a wlan interface, we are probably on a laptop
670
    if ($internalnic =~ /^wl/ && !$Stabile::config->get('EXTERNAL_NIC')) {
671
        $internalnic = $externalnic; # It's very unlikely that we would want to server nfs over wlan
672 f4b82f15 hq
    }
673 2a63870a Christian Orellana
    return ($internalnic, $externalnic);
674
};
675
676 95b003ff Origo
$main::updateUI = sub {
677
    my @parslist = @_;
678
    my $newtasks;
679
    my $tab;
680
    my $duser;
681
    foreach my $pars (@parslist) {
682
        my $type = $pars->{type};
683
        my $duuid = $pars->{uuid};
684
        my $domuuid = $pars->{domuuid};
685
        my $dstatus = $pars->{status};
686
        my $message = $pars->{message};
687 48fcda6b Origo
        $message =~ s/"/\\"/g;
688
        $message =~ s/'/\\'/g;
689 95b003ff Origo
        my $newpath = $pars->{newpath};
690
        my $displayip = $pars->{displayip};
691
        my $displayport = $pars->{displayport};
692
        my $name = $pars->{name};
693
        my $master = $pars->{master};
694
        my $mac = $pars->{mac};
695
        my $macname = $pars->{macname};
696
        my $progress = $pars->{progress};
697
        my $title = $pars->{title};
698
        my $managementlink = $pars->{managementlink};
699
        my $backup = $pars->{backup};
700 2a63870a Christian Orellana
        my $download = $pars->{download};
701
        my $size = $pars->{size};
702 95b003ff Origo
        my $sender = $pars->{sender};
703
        my $path = $pars->{path};
704
        my $snap1 = $pars->{snap1};
705
        my $username = $pars->{username};
706
707
        $tab = $pars->{tab};
708
        $duser = $pars->{user};
709
        $duser = "irigo" if ($duser eq "--");
710
        $tab = $tab || substr(lc __PACKAGE__, 9);
711
        $type = $type || ($message?'message':'update');
712
        $sender = $sender || "stabile:$package";
713
714
        if ($package eq 'users' && $pars->{'uuid'}) {
715
            my %u = %{$register{$pars->{'uuid'}}};
716
            delete $u{'password'};
717
            $u{'user'} = $duser;
718
            $u{'type'} = 'update';
719
            $u{'status'} = ($u{'privileges'} =~ /d/)?'disabled':'enabled';
720
            $u{'tab'} = $package;
721
            $u{'timestamp'} = $current_time;
722
            $newtasks .= to_json(\%u) . ", ";
723
        } else {
724
            $newtasks .= "{\"type\":\"$type\",\"tab\":\"$tab\",\"timestamp\":$current_time" .
725
                ($duuid?",\"uuid\":\"$duuid\"":"") .
726
                ($domuuid?",\"domuuid\":\"$domuuid\"":"") .
727
                ($duser?",\"user\":\"$duser\"":"") .
728
                ($dstatus?",\"status\":\"$dstatus\"":"") .
729
                ($message?",\"message\":\"$message\"":"") .
730
                ($newpath?",\"path\":\"$newpath\"":"") .
731
                ($displayip?",\"displayip\":\"$displayip\"":"") .
732
                ($displayport?",\"displayport\":\"$displayport\"":"") .
733
                ($name?",\"name\":\"$name\"":"") .
734
                ($backup?",\"backup\":\"$backup\"":"") .
735 2a63870a Christian Orellana
                ($download?",\"download\":\"$download\"":"") .
736
                ($size?",\"size\":\"$size\"":"") .
737 95b003ff Origo
                ($mac?",\"mac\":\"$mac\"":"") .
738
                ($macname?",\"macname\":\"$macname\"":"") .
739
                ($progress?",\"progress\":$progress":"") . # This must be a number between 0 and 100
740
                ($title?",\"title\":\"$title\"":"") .
741
                ($managementlink?",\"managementlink\":\"$managementlink\"":"") .
742
                ($master?",\"master\":\"$master\"":"") .
743
                ($snap1?",\"snap1\":\"$snap1\"":"") .
744
                ($username?",\"username\":\"$username\"":"") .
745 48fcda6b Origo
                ($path?",\"path\":\"$path\"":"") .
746
                ",\"sender\":\"$sender\"}, ";
747 95b003ff Origo
        }
748
    }
749
    $newtasks = $1 if ($newtasks =~ /(.+)/); #untaint
750
    my $res;
751
    eval {
752
        opendir my($dh), '/tmp' or die "Couldn't open '/tmp': $!";
753
        my @files;
754
        if ($tab eq 'nodes' || $duser eq 'irigo') {
755
            # write tasks to all admin user's session task pipes
756
            @files = grep { /.*~A-.*\.tasks$/ } readdir $dh;
757
        } else {
758
            # write tasks to all the user's session task pipes
759
            @files = grep { /^$duser~.*\.tasks$/ } readdir $dh;
760
        }
761
        closedir $dh;
762
        my $t = new Proc::ProcessTable;
763
        my @ptable = @{$t->table};
764
        my @pfiles;
765
        my $cmnds;
766
        foreach my $f (@files) {
767
#            my $n = `pgrep -fc "$f"`;
768
#            chomp $n;
769
            foreach my $p ( @ptable ){
770
                my $pcmd = $p->cmndline;
771
                $cmnds .= $pcmd . "\n" if ($pcmd =~ /tmp/);
772
                if ($pcmd =~ /\/tmp\/$f/) { # Only include pipes with active listeners
773
                    push @pfiles, "/tmp/$f";
774
                    last;
775
                }
776
            }
777
        };
778
        my $tasksfiles = join(' ', @pfiles);
779
        $tasksfiles = $1 if ($tasksfiles =~ /(.+)/); #untaint
780
        # Write to users named pipes if user is logged in and session file found
781
        if ($tasksfiles) {
782
            $res = `/bin/echo \'$newtasks\' | /usr/bin/tee  $tasksfiles \&`;
783
        } else {
784
        # If session file not found, append to orphan tasks file wait a sec and reload
785
            $res = `/bin/echo \'$newtasks\' >> /tmp/$duser.tasks`;
786
            $res .= `chown www-data:www-data /tmp/$duser.tasks`;
787
#            sleep 1;
788
            eval {`/usr/bin/pkill -HUP -f ui_update`; 1;} or do {;};
789 ca937547 hq
#            `echo "duh: $duser" >> /tmp/duh`;
790 95b003ff Origo
        }
791
#        eval {`/usr/bin/pkill -HUP -f $duser~ui_update`; 1;} or do {;};
792
    } or do {$e=1; $res .= "ERROR Problem writing to tasks pipe $@\n";};
793
    return 1;
794
};
795
796
sub action {
797
    my ($target, $action, $obj) = @_;
798
    my $res;
799
    my $func = ucfirst $action;
800
    # If a function named $action (with first letter uppercased) exists, call it and return the result
801
    if (defined &{$func}) {
802
        $res .= &{$func}($target, $action, $obj);
803
    }
804
    return $res;
805
}
806
807
sub privileged_action {
808
    my ($target, $action, $obj) = @_;
809
    return "Status=ERROR Your account does not have the necessary privileges\n" if ($isreadonly);
810
    return action($target, $action) if ($help);
811
    my $res;
812
    $obj = {} unless ($obj);
813
    $obj->{'console'} = 1 if ($console || $options{c});
814 2a63870a Christian Orellana
    $obj->{'baseurl'} =  $baseurl if ($baseurl);
815 95b003ff Origo
    my $client = Gearman::Client->new;
816
    $client->job_servers('127.0.0.1:4730');
817
    # Gearman server will try to call a method named "do_gear_$action"
818
    $res = $client->do_task(steamexec => freeze({package=>$package, tktuser=>$tktuser, user=>$user, target=>$target, action=>$action, args=>$obj}));
819
    $res = ${ $res };
820
    return $res;
821
}
822
823
sub privileged_action_async {
824
    my ($target, $action, $obj) = @_;
825
    return "Status=ERROR Your account does not have the necessary privileges\n" if ($isreadonly);
826
    return action($target, $action) if ($help);
827
    my $client = Gearman::Client->new;
828
    $client->job_servers('127.0.0.1:4730');
829
    my $tasks = $client->new_task_set;
830
    $obj = {} unless ($obj);
831
    $obj->{'console'} = 1 if ($console || $options{c});
832
    # Gearman server will try to call a method named "do_gear_$action"
833 a2e0bc7e hq
    if (scalar(keys %{$obj}) > 2) {
834 95b003ff Origo
        my $handle = $tasks->add_task(steamexec => freeze({package=>$package, tktuser=>$tktuser, user=>$user, target=>$target, action=>$action, args=>$obj}));
835
    } else {
836
        my $handle = $tasks->add_task(steamexec => freeze({package=>$package, tktuser=>$tktuser, user=>$user, target=>$target, action=>$action}));
837
    }
838
    my $regtarget = $register{$target};
839
    my $imgregtarget = $imagereg{$target};
840 d24d9a01 hq
    $uistatus = $regtarget->{status} || "$action".'ing';
841 95b003ff Origo
    $uistatus = 'cloning' if ($action eq 'clone');
842
    $uistatus = 'snapshotting' if ($action eq 'snapshot');
843
    $uistatus = 'unsnapping' if ($action eq 'unsnap');
844
    $uistatus = 'mastering' if ($action eq 'master');
845
    $uistatus = 'unmastering' if ($action eq 'unmaster');
846
    $uistatus = 'backingup' if ($action eq 'backup');
847
    $uistatus = 'restoring' if ($action eq 'restore');
848
    $uistatus = 'saving' if ($action eq 'save');
849
    $uistatus = 'venting' if ($action eq 'releasepressure');
850 04c16f26 hq
    $uistatus = 'injecting' if ($action eq 'inject');
851 95b003ff Origo
    my $name = $regtarget->{name} || $imgregtarget->{name};
852
    if ($action eq 'save') {
853
        if ($package eq 'images') {
854
            if ($obj->{status} eq 'new') {
855
                $obj->{status} = 'unused';
856
            }
857
            elsif ($obj->{regstoragepool} ne $obj->{storagepool}) {
858 d24d9a01 hq
                $obj->{'status'} = $uistatus = 'moving';
859 95b003ff Origo
            }
860
        }
861
        $postreply = to_json($obj, {pretty=>1});
862
        $postreply = encode('utf8', $postreply);
863
        $postreply =~ s/""/"--"/g;
864
        $postreply =~ s/null/"--"/g;
865
        $postreply =~ s/"notes" {0,1}: {0,1}"--"/"notes":""/g;
866
        $postreply =~ s/"installable" {0,1}: {0,1}"(true|false)"/"installable":$1/g;
867
        return $postreply;
868
    } else {
869
        return "Status=$uistatus OK $action $name (deferred)\n";
870
    }
871
}
872
873
sub do_gear_action {
874
    my ($target, $action ,$obj) = @_;
875
    $target = encode("iso-8859-1", $target); # MySQL uses Latin1 as default charset
876
    $action = $1 if ($action =~ /gear_(.+)/);
877
    my $res;
878
    return "This only works with elevated privileges\n" if ($>);
879 9d03439e hq
    if ($register{$target}
880
        || $action =~ /all$|save|^monitors|^packages|^changemonitoremail|^buildsystem|^removesystem|^updateaccountinfo|^updateengineinfo|^removeusersystems|^removeuserimages/
881 a93267ad hq
        || $action =~ /^updateamtinfo|^updatedownloads|^releasepressure|linkmaster$|activate$|engine$|^syncusers|^deletesystem|^getserverbackups|^listserverbackups|^fullstats|^listgpus|^getnextgpus/
882 14fd7cc5 hq
        || $action =~ /^zbackup|^updateallbtimes|^initializestorage|^liststoragedevices|^getbackupdevice|^getimagesdevice|^listbackupdevices|^listimagesdevices/
883 51e32e00 hq
        || $action =~ /^setstoragedevice|^updateui|configurecgroups|backup|sync_backup|^snapshot|^unsnap|downloadmaster|vent/
884 95b003ff Origo
        || ($action eq 'remove' && $package eq 'images' && $target =~ /\.master\.qcow2$/) # We allow removing master images by name only
885 d3805c61 hq
        || ($action eq 'remove' && $package eq 'images' && $target =~ /^(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})$/) # We allow removing images by uuid also
886 51e32e00 hq
        || ($action eq 'gettimezone')
887 95b003ff Origo
    ) {
888
        my $func = ucfirst $action;
889
        # If a function named $action (with first letter uppercased) exists, call it and return the result
890
        if (defined &{$func}) {
891
            if ($obj) {
892
                $console = $obj->{'console'} if ($obj->{'console'});
893
                $target = $obj->{uuid} if (!$target && $obj->{uuid}); # backwards compat with apps calling removesystem
894
                $res .= &{$func}($target, $action, $obj);
895
            } else {
896
                $res .= &{$func}($target, $action);
897
            }
898
        } else {
899
            $res .= "Status=ERROR Unable to $action $target - function not found in $package\n";
900
        }
901
    } else {
902
        $res .= "Status=ERROR Unable to $action $target - target not found in $package\n";
903
    }
904
    return $res;
905
}
906
907
sub preInit {
908
# Set global vars: $user, $tktuser, $curuuid and if applicable: $curdomuuid, $cursysuuid, $curimg
909
# Identify and validate user, read user prefs from DB
910 48fcda6b Origo
    unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username'}, $Stabile::dbopts)) ) {throw Error::Simple("Status=Error User register could not be  accessed")};
911 95b003ff Origo
912
    $user = $user || $Stabile::user || $ENV{'REMOTE_USER'};
913
    $user = 'irigo' if ($package eq 'steamexec');
914
    $remoteip = $ENV{'REMOTE_ADDR'};
915
    # If request is coming from a running server from an internal ip, identify user requesting access
916
    if (!$user && $remoteip && $remoteip =~ /^10\.\d+\.\d+\.\d+/) {
917 48fcda6b Origo
        unless ( tie(%networkreg,'Tie::DBI', Hash::Merge::merge({table=>'networks', CLOBBER=>3}, $Stabile::dbopts)) ) {throw Error::Simple("Status=Error Network register could not be accessed")};
918
        unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains', CLOBBER=>3}, $Stabile::dbopts)) ) {throw Error::Simple("Status=Error Domain register could not be accessed")};
919 95b003ff Origo
        my @regkeys = (tied %networkreg)->select_where("internalip = '$remoteip'");
920
        foreach my $k (@regkeys) {
921
            my $network = $networkreg{$k};
922
            my @domregkeys = (tied %domreg)->select_where("networkuuid1 = '$network->{uuid}'");
923
            my $dom = $domreg{$network->{'domains'}} || $domreg{$domregkeys[0]}; # Sometimes domains is lost in network - compensate
924
            # Request is coming from a running server from an internal ip - accept
925
            if ($network->{'internalip'} eq $remoteip) {
926
                $user = $network->{'user'};
927
                # my $dom = $domreg{$network->{'domains'}};
928
                if ($package eq 'networks') {
929
                    $curuuid = $network->{'uuid'};
930
                    $curdomuuid = $network->{'domains'};
931
                    $cursysuuid = $dom->{'system'};
932
                } elsif ($package eq 'images') {
933
                    $curimg = $dom->{'image'} unless ($curimg);
934
                } elsif ($package eq 'systems') {
935
                    $curuuid = $dom->{'system'} || $dom->{'uuid'} unless ($curuuid);
936
                    $cursysuuid = $dom->{'system'};
937
                    $curdomuuid = $dom->{'uuid'};
938
                } elsif ($package eq 'servers') {
939
                    $curuuid = $dom->{'uuid'} unless ($curuuid);
940
                    $cursysuuid = $dom->{'system'};
941
                }
942
                if (!$userreg{$user}->{'allowinternalapi'}) {
943
                    $user = ''; # Internal API access is not enabled, disallow access
944
                }
945
                last;
946
            }
947
        }
948
        untie %networkreg;
949
        untie %domreg;
950 705b5366 hq
    } else { # Check authorized referers to mitigate CSRF attacks. If no referer in ENV we let it pass to allow API access.
951
        if (-e "/etc/stabile/basereferers"
952
            && $ENV{HTTP_REFERER}
953
        ) {
954
            my $basereferers = `cat /etc/stabile/basereferers`;
955
            chomp $basereferers;
956
            my @baserefs = split(/\s+/, $basereferers);
957
            my $match = 0;
958
            foreach my $ref (@baserefs) {
959
                if ($ENV{HTTP_REFERER} =~ /$ref/) {
960
                    $match = 1;
961
                    last;
962
                }
963
            }
964
            $user = '' unless ($match);
965
        }
966 95b003ff Origo
    }
967
    $user = $1 if $user =~ /(.+)/; #untaint
968
    $tktuser = $user;
969
    $Stabile::tktuser = $tktuser;
970
971
    # Initalize CGI
972
    $Stabile::q = new CGI;
973
974
    # Load params
975
    %params = $Stabile::q->Vars;
976
    $uripath = URI::Escape::uri_unescape($ENV{'REQUEST_URI'});
977
    if ($options{s}) {
978
        $account = $options{s};
979
    } else {
980
        $account = $Stabile::q->cookie('steamaccount');
981
    }
982
    $user = 'guest' if (!$user && $params{'action'} eq 'help');
983
    die "No active user. Please authenticate or provide user through REMOTE_USER environment variable." unless ($user);
984
985
    my $u = $userreg{$user};
986
    my @accounts = split(/,\s*/, $u->{'accounts'}) if ($u->{'accounts'});
987
    my @accountsprivs = split(/,\s*/, $u->{'accountsprivileges'}) if ($u->{'accountsprivileges'});
988
    for my $i (0 .. $#accounts)
989
        { $ahash{$accounts[$i]} = $accountsprivs[$i] || 'r'; }
990
991
	$privileges = '';
992
    # User is requesting access to another account - check privs
993
    if ($account && $account ne $user) {
994
        if ($ahash{$account}) {
995
            $user = $account;
996
            $main::account = $account;
997
            # Only allow users whose base account is admin to get admin privs
998
            $ahash{$account} =~ s/a// unless ($userreg{$tktuser}->{'privileges'} =~ /a/);
999
            $privileges = $ahash{$account};
1000
            $u = $userreg{$account};
1001
        }
1002
    }
1003
1004
    $Stabile::user = $user;
1005
1006
    $defaultmemoryquota = $Stabile::config->get('MEMORY_QUOTA') + 0;
1007 a93267ad hq
    $defaultvmemoryquota = $Stabile::config->get('VMEMORY_QUOTA') + 0;
1008 95b003ff Origo
    $defaultstoragequota = $Stabile::config->get('STORAGE_QUOTA') + 0;
1009
    $defaultnodestoragequota = $Stabile::config->get('NODESTORAGE_QUOTA') + 0;
1010
    $defaultvcpuquota = $Stabile::config->get('VCPU_QUOTA') + 0;
1011 a93267ad hq
    $defaultvgpuquota = $Stabile::config->get('VGPU_QUOTA') + 0;
1012 95b003ff Origo
    $defaultexternalipquota = $Stabile::config->get('EXTERNAL_IP_QUOTA') + 0;
1013
    $defaultrxquota = $Stabile::config->get('RX_QUOTA') + 0;
1014
    $defaulttxquota = $Stabile::config->get('TX_QUOTA') + 0;
1015
1016
    # Read quotas and privileges from db
1017
    $Stabile::userstoragequota = 0+ $u->{'storagequota'} if ($u->{'storagequota'});
1018
    $Stabile::usernodestoragequota = 0+ $u->{'nodestoragequota'} if ($u->{'storagequota'});
1019 a2e0bc7e hq
    $Stabile::usermemoryquota = 0+ $u->{'memoryquota'} if ($u->{'memoryquota'});
1020 a93267ad hq
    $Stabile::usevrmemoryquota = 0+ $u->{'vmemoryquota'} if ($u->{'vmemoryquota'});
1021 a2e0bc7e hq
    $Stabile::uservcpuquota = 0+ $u->{'vcpuquota'} if ($u->{'vcpuquota'});
1022 a93267ad hq
    $Stabile::uservgpuquota = 0+ $u->{'vgpuquota'} if ($u->{'vgpuquota'});
1023 54401133 hq
    $Stabile::userexternalipquota = 0+ $u->{'externalipquota'} if ($u->{'externalipquota'});
1024
    $Stabile::userrxquota = 0+ $u->{'rxquota'} if ( $u->{'rxquota'});
1025
    $Stabile::usertxquota = 0+ $u->{'txquota'} if ($u->{'txquota'});
1026 95b003ff Origo
1027
    $billto = $u->{'billto'};
1028
    $Stabile::userprivileges = $u->{'privileges'};
1029
    $privileges = $Stabile::userprivileges if (!$privileges && $Stabile::userprivileges);
1030
    $isadmin = index($privileges,"a")!=-1;
1031
    $ismanager = index($privileges,"m")!=-1;
1032
    $isreadonly = index($privileges,"r")!=-1;
1033 d3805c61 hq
    $Stabile::preserveimagesonremove = index($privileges,"p")!=-1;
1034 95b003ff Origo
    $fulllist = $options{f} && $isadmin;
1035
    $fullupdate = $options{p} && $isadmin;
1036
1037 71b897d3 hq
    my $bto = $userreg{$billto};
1038
    my @bdnsdomains = split(/, ?/, $bto->{'dnsdomains'});
1039
    my @udnsdomains = split(/, ?/, $u->{'dnsdomains'});
1040 23748604 hq
    $dnsdomain = '' if ($dnsdomain eq '--'); # TODO - ugly
1041
    $udnsdomains[0] = '' if ($udnsdomains[0] eq '--');
1042
    $bdnsdomains[0] = '' if ($bdnsdomains[0] eq '--');
1043 45cc3024 hq
    $dnsdomain = $udnsdomains[0] || $bdnsdomains[0] || $dnsdomain; # override config value
1044
1045
    my $bstoreurl = $bto->{'appstoreurl'};
1046 23748604 hq
    $bstoreurl = '' if ($bstoreurl eq '--');
1047 45cc3024 hq
    my $ustoreurl = $u->{'appstoreurl'};
1048 23748604 hq
    $ustoreurl = '' if ($ustoreurl eq '--');
1049 45cc3024 hq
    $appstoreurl = $bstoreurl || $ustoreurl || $appstoreurl; # override config value
1050 71b897d3 hq
1051 95b003ff Origo
    $Stabile::sshcmd = $sshcmd;
1052
    $Stabile::disablesnat = $disablesnat;
1053
    $Stabile::privileges = $privileges;
1054
    $Stabile::isadmin = $isadmin;
1055
1056
    $storagepools = $u->{'storagepools'}; # Prioritized list of users storage pools as numbers, e.g. "0,2,1"
1057
    my $dbuser = $u->{'username'};
1058
    untie %userreg;
1059
1060
    # If params are passed in URI for a POST og PUT request, we try to parse them out
1061
     if (($ENV{'REQUEST_METHOD'} ne 'GET')  && !$isreadonly) {
1062
         $action = $1 if (!$action && $uripath =~ /action=(\w+)/);
1063
         if ($uripath =~ /$package(\.cgi)?\/(.+)$/ && !$isreadonly) {
1064
             my $uuid = $2;
1065
             if (!(%params) && !$curuuid && $uuid =~ /^\?/) {
1066
                 %params = split /[=&]/, substr($uuid,1);
1067
                 $curuuid = $params{uuid};
1068
             } else {
1069
                 $curuuid = $uuid;
1070
             }
1071
             $curuuid = $1 if ($curuuid =~ /\/(.+)/);
1072
         }
1073
     }
1074
1075
    # Parse out params from g option if called from cmdline
1076
    my $args = $options{g};
1077
    if ($args && !%params) {
1078
        my $obj = from_json( uri_unescape ($args));
1079 d3805c61 hq
        if ( ref($obj) eq 'HASH' && $obj->{items} ) {
1080
            %params = ();
1081
            $params{'POSTDATA'} = $args;
1082
        } elsif (ref($obj) eq 'HASH') {
1083 95b003ff Origo
            %params = %{$obj};
1084
        } else {
1085
            %params = {};
1086
            $params{'POSTDATA'} = $args;
1087
        }
1088
        $console = $obj->{'console'} if ($obj->{'console'});
1089
        $curuuid = $obj->{uuid} if (!$curuuid && $obj->{uuid}); # backwards compat with apps calling removesystem
1090
    }
1091
1092
    # Action may be via on command line switch -a
1093
    if (!$action) {
1094
        $action = $options{a};
1095
        if ($action) { # Set a few options if we are called from command line
1096
            $console = 1 unless ($options{v} && !$options{c});
1097
            $Data::Dumper::Varname = $package;
1098
            $Data::Dumper::Pair = ' : ';
1099
            $Data::Dumper::Terse = 1;
1100
            $Data::Dumper::Useqq = 1;
1101
        }
1102
    }
1103
    # Parse out $action - i.e. find out what action is requested
1104
    $action = $action || $params{'action'}; # $action may have been set above to 'remove' by DELETE request
1105
1106
    # Handling of action given as part of addressable API
1107
    # Special cases for systems, monitors, etc.
1108
    if (!$action && $uripath =~ /$package\/(.+)(\/|\?)/ && !$params{'path'}) {
1109
        $action = $1;
1110
        $action = $1 if ($action =~ /([^\/]+)\/(.*)/);
1111
    }
1112
    $curuuid = $curuuid || $params{'uuid'} || $params{'id'} || $params{'system'} || $params{'serveruuid'};
1113
    # Handling of target given as part of addressable API
1114
    #    if ($uripath =~ /$package(\.cgi)?\/($action\/)?(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})(:\w+)?/) {
1115
    if ($uripath =~ /$package\/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})(:\w+)?/) {
1116
        $curuuid = "$1$2";
1117
    } elsif ($package eq 'nodes' && $uripath =~ /$package\/(\w{12})(:\w+)?/) {
1118
        $curuuid = "$1$2";
1119
    }
1120
1121
    $action = lc $action;
1122
    if (!$params && $options{k}) {
1123
        $params{'keywords'} = URI::Escape::uri_unescape($options{k});
1124
        $console = 1 unless ($options{v} && !$options{c});
1125
    }
1126 d3d1a2d4 Origo
    $action = (($action)?$action.'_':'') . 'remove' if ($ENV{'REQUEST_METHOD'} eq 'DELETE' && $action ne 'remove');
1127 95b003ff Origo
    # -f should only set $fulllisting and not trigger any keyword actions
1128
    delete $params{'keywords'} if ($params{'keywords'} eq '-f');
1129
1130
    # Regular read - we send out JSON version of directory list
1131
    if (!$action && (!$ENV{'REQUEST_METHOD'} || $ENV{'REQUEST_METHOD'} eq 'GET')) {
1132
        if (!($package)) {
1133
            ; # If we get called as a library this is were we end - do nothing...
1134
        } elsif ($params{'keywords'}) {
1135
            ; # If param keywords is provided treat as a post
1136
        } else {
1137
            $action = 'list';
1138
        }
1139
    }
1140
1141
    ### Main security check
1142
    unless ($package eq 'pressurecontrol' || $dbuser || ($user eq 'common' && $action =~ /^updatebtime|^list/)) {throw Error::Simple("Status=Error $action: Unknown user $user [$remoteip]")};
1143
    if (index($privileges,"d")!=-1 && $action ne 'help') {throw Error::Simple("Status=Error Disabled user")};
1144
1145
    $curuuid = $curuuid || URI::Escape::uri_unescape($params{'uuid'}); # $curuuid may have been set above for DELETE requests
1146
    $curuuid = "" if ($curuuid eq "--");
1147
    $curuuid = $options{u} unless $curuuid;
1148
    if ($package eq 'images') {
1149
        $curimg = URI::Escape::uri_unescape($params{'image'} || $params{'path'}) unless ($action eq 'listfiles');
1150
        $curimg = "" if ($curimg eq "--");
1151
        $curimg = $1 if ($curimg =~ /(.*)\*$/); # Handle Dojo peculiarity
1152
        $curimg = URI::Escape::uri_unescape($options{i}) unless $curimg;
1153
        unless (tie(%imagereg,'Tie::DBI', Hash::Merge::merge({table=>'images', CLOBBER=>1}, $Stabile::dbopts)) ) {throw Error::Simple("Stroke=Error Image UUID register could not be accessed")};
1154
        if ($curimg && !$curuuid && $curimg =~ /(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/) {
1155
            $curuuid = $curimg;
1156
            $curimg = $imagereg{$curuuid}->{'path'} if ($imagereg{$curuuid});
1157
#        } elsif ($target && !$curimg && !$curuuid) {
1158
#            if ($target =~ /(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/) {
1159
#                $curuuid = $1;
1160
#                $curimg = $imagereg{$curuuid}->{'path'};
1161
#            } else {
1162
#                $curimg = $target;
1163
#            }
1164
        } elsif (!$curimg && $curuuid) {
1165
            $curimg = $imagereg{$curuuid}->{'path'} if ($imagereg{$curuuid});
1166
        }
1167
        untie %imagereg;
1168
    }
1169
}
1170
1171
sub process {
1172
    my $target = $params{'target'} || $options{t} ||  $curuuid;
1173
    # We may receive utf8 strings either from browser or command line - convert them to native Perl to avoid double encodings
1174
    utf8::decode($target) if ( $target =~ /[^\x00-\x7f]/ );# true if string contains any non-ascii character
1175
    my $uipath;
1176 d24d9a01 hq
#    my $uistatus;
1177 95b003ff Origo
# Special handling
1178
    if ($package eq 'images') {
1179
        $target = $curimg || $params{'path'} || $params{'image'} || $target unless ($target =~ /^\/.+/);
1180
        $params{'restorepath'} = $params{'path'} if ($action eq 'listfiles');
1181 2a63870a Christian Orellana
        $params{'baseurl'} = "https://$ENV{'HTTP_HOST'}/stabile" if ($action eq 'download' && $ENV{'HTTP_HOST'} && !($baseurl =~ /\./)); # send baseurl if configured value not valid
1182 95b003ff Origo
    } elsif ($package eq 'systems') {
1183
        $target = $params{'id'} || $target if ($action =~ /^monitors_/);
1184
    } elsif ($package eq 'nodes') {
1185
        $target = $target || $params{'mac'};
1186
    } elsif ($package eq 'users') {
1187
        $target = $target || $params{'username'};
1188
    }
1189
    # Named action - we got a request for an action
1190
    my $obj;
1191 d3805c61 hq
    if ($action && (defined &{"do_$action"}) &&
1192
        ($ENV{'REQUEST_METHOD'} ne 'POST' || $action eq 'upload' || $action eq 'restorefiles')
1193
        && !($params{"keywords"} || $params{"POSTDATA"})
1194
    ) {
1195 95b003ff Origo
        # If a function named do_$action (only lowercase allowed) exists, call it and print the result
1196
        if ($action =~ /^monitors/) {
1197
            if ($params{'PUTDATA'}) {
1198
                $obj = $params{'PUTDATA'};
1199
                $action = 'monitors_save' unless ($action =~ /monitors_.+/);
1200
            } else {
1201
                $obj = { action => $action, id => $target };
1202
            }
1203
        } else {
1204
            unless (%params) {
1205
                if ($package eq 'images' && $target =~ /^\//) {
1206
                    %params = ("path", $target);
1207
                    delete $params{"uuid"};
1208
                } else{
1209
                    %params = ("uuid", $target);
1210
                }
1211
            }
1212
            if ($curuuid || $target) {
1213
                $params{uuid} = $curuuid || $target unless ($params{uuid} || $params{path} || ($params{image} && $package eq 'images'));
1214
            }
1215
            $obj = getObj(\%params);
1216
        }
1217
        $obj->{'console'} = $console if ($console);
1218 2a63870a Christian Orellana
        $obj->{'baseurl'} = $params{baseurl} if ($params{baseurl});
1219 95b003ff Origo
    # Perform the action
1220
        $postreply = &{"do_$action"}($target, $action, $obj);
1221
        if (!$postreply) { # We expect some kind of reply
1222 6fdc8676 hq
            $postreply .= header('text/plain', '500 Internal Server Error because no reply') unless ($console);
1223 f222b89c hq
            $main::syslogit->($user, 'info', "Could not $action $target ($package)") unless ($action eq 'uuidlookup' || $action eq 'uuidshow');
1224 95b003ff Origo
        } elsif (! ($postreply =~ /^(Content-type|Status|Location):/i) ) {
1225
            if ($postreply =~ /Content-type:/) {
1226
                ;
1227
            } elsif (!$postreply || $postreply =~ /Status=/ || $postreply =~ /^</ || $postreply =~ /^\w/) {
1228
                $postreply = header('text/plain; charset=UTF8') . $postreply unless ($console);
1229
            } else {
1230
                $postreply = header('application/json; charset=UTF8') . $postreply unless ($console);
1231
            }
1232
        }
1233
        print "$postreply";
1234
1235
    } elsif (($params{'PUTDATA'} || $params{"keywords"} || $params{"POSTDATA"})  && !$isreadonly) {
1236
        # We got a save post with JSON. Look for interesting stuff and perform action or save
1237 2a63870a Christian Orellana
        my @json_array;
1238 95b003ff Origo
		if ($params{'PUTDATA'}) {
1239
		    my $json_text = $params{'PUTDATA'};
1240
            utf8::decode($json_text);
1241
            $json_text =~ s/\x/ /g;
1242
    		$json_text =~ s/\[\]/\"\"/g;
1243
		    @json_array = from_json($json_text);
1244
		} elsif ($params{"keywords"} || $params{"POSTDATA"}) {
1245
            my $json_text = $params{"keywords"} || $params{'POSTDATA'};
1246
            $json_text = uri_unescape($json_text);
1247
            utf8::decode($json_text);
1248
            $json_text =~ s/\x/ /g;
1249
            $json_text =~ s/\[\]/\"\"/g;
1250
            my $json_obj = from_json($json_text);
1251
            if (ref $json_obj eq 'ARRAY') {
1252
                @json_array = @$json_obj;
1253
            } elsif (ref $json_obj eq 'HASH') {
1254
                my %json_hash = %$json_obj;
1255
                my $json_array_ref = [\%json_hash];
1256
                if ($json_hash{"items"}) {
1257
                    $json_array_ref = $json_hash{"items"};
1258
                }
1259
                @json_array = @$json_array_ref;
1260
            }
1261 a93267ad hq
        }
1262 95b003ff Origo
        foreach (@json_array) {
1263
			my %h = %$_;
1264
			$console = 1 if $h{"console"};
1265
            my $objaction = $h{'action'} || $action;
1266
            $objaction = 'save' if (!$objaction || $objaction eq "--");
1267
            $h{'action'} = $objaction = $action.'_'.$objaction if ($action eq "monitors" || $action eq "packages"); # Allow sending e.g. disable action to monitors by calling monitors_disable
1268 2a63870a Christian Orellana
            $h{'action'} = $objaction if ($objaction && !$h{'action'});
1269 95b003ff Origo
            my $obj = getObj(\%h);
1270
            next unless $obj;
1271
            $obj->{'console'} = $console if ($console);
1272
        # Now build the requested action
1273
            my $objfunc = "do_$objaction";
1274
        # If a function named objfunc exists, call it
1275
            if (defined &$objfunc) {
1276
                $target = $h{'uuid'} || $h{'id'};
1277
                $uiuuid = $target;
1278
                my $targetimg = $imagereg{$target};
1279
        # Special handling
1280
                if ($package eq 'images') {
1281
                    $target = $targetimg->{'path'} || $h{'image'} || $h{'path'} || $target;
1282
                }
1283
        # Perform the action
1284 a2e0bc7e hq
                my $areply = &{$objfunc}($target, $objaction, $obj);
1285
                $postreply .= $areply unless ($postreply eq $areply); # $postreply has been set
1286
1287 95b003ff Origo
        # Special handling
1288
                if ($package eq 'images') {
1289
                    if ($h{'status'} eq 'new') {
1290
#                        $uistatus = 'new';
1291
#                        $uiuuid = ''; # Refresh entire view
1292
                    }
1293
                }
1294
                my $node = $nodereg{$mac};
1295
                my $updateEntry = {
1296
                    tab=>$tab,
1297
                    user=>$user,
1298
                    uuid=>$uiuuid,
1299
                    status=>$uistatus,
1300
                    mac=>$mac,
1301
                    macname=>$node->{'name'},
1302
                    displayip=>$uidisplayip,
1303
                    displayport=>$uidisplayport,
1304
                    type=>$uiupdatetype,
1305
                    message=>$postmsg
1306
                };
1307
                # Special handling
1308
                if ($package eq 'images') {
1309
                    $obj->{'uuid'} = '' if ($uistatus eq 'new');
1310
                    $uipath = $obj->{'path'};
1311
                    $updateEntry->{'path'} = $uipath;
1312
                    $uiname = $obj->{'name'};
1313
                }
1314
                if ($uiname) {
1315
                    $updateEntry->{'name'} = $uiname;
1316
                }
1317
                if ($uiuuid || $postmsg || $uistatus) {
1318
                    push (@updateList, $updateEntry);
1319
                }
1320
            } else {
1321
                $postreply .= "Status=ERROR Unknown $package action: $objaction\n";
1322
            }
1323
		}
1324 a2e0bc7e hq
        if ($postreply && ! ($postreply =~ /^(Content-type|Status|Location):/i) ) {
1325 95b003ff Origo
            if (!$postreply || $postreply =~ /Status=/) {
1326
                $postreply = header('text/plain; charset=UTF8') . $postreply unless ($console);
1327
            } else {
1328
                $postreply = header('application/json; charset=UTF8') . $postreply unless ($console);
1329
            }
1330
        }
1331
        print $postreply;
1332
    } else {
1333
        $postreply .= "Status=Error Unknown $ENV{'REQUEST_METHOD'} $package action: $action\n";
1334
        print header('text/html', '500 Internal Server Error') unless ($console);
1335
        print $postreply;
1336
	}
1337
    # Functions called via aliases to privileged_action or privileged_action_async cannot update $postmsg or $uistatus
1338
    # so updateUI must be called internally in these functions.
1339
    if (@updateList) {
1340
        $main::updateUI->(@updateList);
1341
    }
1342
}
1343
1344
1345
# Print list of available actions
1346
sub Help {
1347
    $help = 1;
1348
    no strict 'refs';
1349
    my %fdescriptions;
1350
    my %fmethods;
1351
    my %fparams;
1352
    my @fnames;
1353
1354
    my $res = header() unless ($console);
1355
    #    my $tempuuid = "484d7852-90d2-43f1-8bd6-e29e234848b0";
1356
    my $tempuuid = "";
1357
    unless ($console) {
1358
        $res .= <<END
1359
    <!DOCTYPE html>
1360
    <html>
1361
        <head>
1362
            <script src="https://ajax.googleapis.com/ajax/libs/jquery/3.1.0/jquery.min.js"></script>
1363
            <!-- script src="https://code.jquery.com/jquery-3.3.1.slim.min.js" integrity="sha384-q8i/X+965DzO0rT7abK41JStQIAqVgRVzpbzo5smXKp4YfRvH+8abtTE1Pi6jizo" crossorigin="anonymous"></script -->
1364
            <!-- script src="https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.14.3/umd/popper.min.js" integrity="sha384-ZMP7rVo3mIykV+2+9J3UJ46jBk0WLaUAdn689aCwoqbBJiSnjAK/l8WvCWPIPm49" crossorigin="anonymous"></script -->
1365
            <script src="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/js/bootstrap.min.js" integrity="sha384-ChfqqxuZUCnJSK3+MXmPNIyE6ZbWh2IMqE241rYiqJxyMiZ6OW/JmZQ5stwEULTy" crossorigin="anonymous"></script>
1366
            <link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.1.3/css/bootstrap.min.css" integrity="sha384-MCw98/SFnGE8fJT3GXwEOngsV7Zt27NXFoaoApmYm81iuXoPkFOJwJ8ERdknLPMO" crossorigin="anonymous">
1367
            <style>
1368
                .form-control {display: inline-block; width: auto; margin: 2px; }
1369
                input.form-control {width: 180px;}
1370
				pre {
1371
					overflow-x: auto;
1372
					white-space: pre-wrap;
1373
					white-space: -moz-pre-wrap;
1374
					white-space: -pre-wrap;
1375
					white-space: -o-pre-wrap;
1376
					word-wrap: break-word;
1377
				}
1378
            </style>
1379
        </head>
1380
        <body style="margin:1.25rem;">
1381
        <div>
1382
            <table style="width:100%;"><tr><td>
1383
            <select class="form-control" id="scopeaction" name="scopeaction" placeholder="action" onchange="data.scopeaction=this.value; dofields();" autocomplete="off"></select>
1384
            <span id="scopeinputs">
1385
            <input class="form-control" id="scopeuuid" name="scopeuuid" placeholder="uuid" onchange="data.scopedata.uuid=this.value; update();" value="$tempuuid" autocomplete="off" size="34">
1386
            </span>
1387
            <button class="btn btn-primary" href="#" onclick="doit();">Try it</button>
1388
            <pre>
1389
    \$.ajax({
1390
        url: "<span class='scopeurl'>/stabile/$package?uuid=$tempuuid&action=activate</span>",
1391
        type: "<span class='scopemethod'>GET</span>", <span id="dataspan" style="display:none;"><br />        data: "<span class="scopedata"></span>",</span>
1392
        success: function(result) {\$("#scoperesult").text(result);}
1393
    });
1394
            </pre>
1395
            </td><td width="50%"><textarea id="scoperesult" style="width:100%; height: 200px;"></textarea></td>
1396
            </tr>
1397
            </table>
1398
        </div>
1399
            <script>
1400
                data = {"scopemethod": "GET", "scopeaction": "activate", "scopeuuid": "$tempuuid", "scopeurl": "/stabile/$package?uuid=$tempuuid&action=activate"};
1401
                function doit() {
1402
                    var obj = {
1403
                        url: data.scopeurl,
1404
                        type: data.scopemethod,
1405
                        success: handleResult,
1406
                        error: handleResult
1407
                    }
1408
                    if (data.scopemethod != 'GET') obj.data = JSON.stringify(data.scopedata);
1409
                    \$.ajax(obj);
1410 27512919 Origo
                    \$("#scoperesult").text("");
1411 95b003ff Origo
                    return true;
1412
                    function handleResult(data, textStatus, jqXHR) {
1413
                        if (jqXHR == 'Unauthorized') {
1414
                            \$("#scoperesult").text(jqXHR + ": You must log in before you can call API methods.");
1415
                        } else if (jqXHR.responseText) {
1416
                            \$("#scoperesult").text(jqXHR.responseText);
1417
                        } else {
1418
                            \$("#scoperesult").text("No result received");
1419
                        }
1420
                    }
1421
                }
1422
                function dofields() {
1423
                    if (scopeparams[data.scopeaction].length==0) {
1424
                        \$("#scopeinputs").hide();
1425
                    } else {
1426
                        var fields = "";
1427
                        \$.each(scopeparams[data.scopeaction], function (i, item) {
1428
                            var itemname = "scope" + item;
1429
                            if (\$("#"+itemname).val()) data[itemname] = \$("#"+itemname).val();
1430
                            fields += '<input class="form-control" id="' + itemname + '" placeholder="' + item + '" value="' + ((data[itemname])?data[itemname]:'') + '" size="34" onchange="update();"> ';
1431
                        });
1432
                        \$("#scopeinputs").empty();
1433
                        \$("#scopeinputs").append(fields);
1434
                        \$("#scopeinputs").show();
1435
                    }
1436
                    update();
1437
                }
1438
                function update() {
1439
                    data.scopemethod = scopemethods[data.scopeaction];
1440
                    if (data.scopemethod == "POST") {
1441
                        \$("#dataspan").show();
1442
                        data.scopeurl = "/stabile/$package";
1443
                        data.scopedata = {"items": [{"action":data.scopeaction}]};
1444
                        \$.each(scopeparams[data.scopeaction], function (i, item) {
1445
                            var val = \$("#scope"+item).val();
1446
                            if (val) data.scopedata.items[0][item] = val;
1447
                         });
1448
                    } else if (data.scopemethod == "PUT") {
1449
                        \$("#dataspan").show();
1450
                        data.scopeurl = "/stabile/$package";
1451
                        data.scopedata = [{"action":data.scopeaction}];
1452
                        \$.each(scopeparams[data.scopeaction], function (i, item) {
1453
                            var val = \$("#scope"+item).val();
1454
                            if (val) data.scopedata[0][item] = val;
1455
                         });
1456
                    } else {
1457
                        \$("#dataspan").hide();
1458
                        data.scopeurl = "/stabile/$package?action="+data.scopeaction;
1459
                        \$.each(scopeparams[data.scopeaction], function (i, item) {
1460
                            var val = \$("#scope"+item).val();
1461
                            if (val) data.scopeurl += "&" + item + "=" + val;
1462
                        });
1463
                        data.scopedata = '';
1464
                    }
1465
                    \$(".scopemethod").text(data.scopemethod);
1466
                    \$(".scopeurl").text(data.scopeurl);
1467
                    \$(".scopedata").text(JSON.stringify(data.scopedata, null, ' ').replace(/\\n/g,'').replace(/  /g,''));
1468
                }
1469
                \$( document ).ready(function() {
1470
                    data.scopeaction=\$("#scopeaction").val(); dofields()
1471
                });
1472
END
1473
        ;
1474
        $res .= qq|var scopeparams = {};\n|;
1475
        $res .= qq|var scopemethods = {};\n|;
1476
        $res .= qq|var package="$package"\n|;
1477
    }
1478
    my @entries;
1479
    if ($package eq 'networks') {
1480
        @entries = sort keys %Stabile::Networks::;
1481
    } elsif ($package eq 'images') {
1482
        @entries = sort keys %Stabile::Images::;
1483
    } elsif ($package eq 'servers') {
1484
        @entries = sort keys %Stabile::Servers::;
1485
    } elsif ($package eq 'nodes') {
1486
        @entries = sort keys %Stabile::Nodes::;
1487
    } elsif ($package eq 'users') {
1488
        @entries = sort keys %Stabile::Users::;
1489
    } elsif ($package eq 'systems') {
1490
        @entries = sort keys %Stabile::Systems::;
1491
    }
1492
1493
    foreach my $entry (@entries) {
1494
        if (defined &{"$entry"} && $entry !~ /help/i && $entry =~ /^do_(.+)/) {
1495
            my $fname = $1;
1496
            # Ask function for help - $help is on
1497
            my $helptext = &{"$entry"}(0, $fname);
1498
            my @helplist = split(":", $helptext, 3);
1499
            chomp $helptext;
1500
            unless ($fname =~ /^gear_/) {
1501
                $fmethods{$fname} = $helplist[0];
1502
                $fparams{$fname} = $helplist[1];
1503
                $fdescriptions{$fname} = $helplist[2];
1504
                $fdescriptions{$fname} =~ s/\n// unless ($console);
1505
                $fdescriptions{$fname} =~ s/\n/\n<br>/g unless ($console);
1506
                my @plist = split(/, ?/, $fparams{$fname});
1507
                unless ($console) {
1508
                    $res .= qq|scopeparams["$fname"] = |.to_json(\@plist).";\n";
1509
                    $res .= qq|\$("#scopeaction").append(new Option("$fname", "$fname"));\n|;
1510
                    $res .= qq|scopemethods["$fname"] = "$helplist[0]";\n|;
1511
                }
1512
            }
1513
        }
1514
    }
1515
    @fnames = sort (keys %fdescriptions);
1516
1517
    unless ($console) {
1518
        $res .= "\n</script>\n";
1519
        $res .= <<END
1520
        <div class="table-responsive" style="margin-top:1.5rem; noheight: 65vh; overflow-y: scroll;">
1521
            <table class="table table-striped table-sm">
1522
              <thead>
1523
                <tr>
1524
                  <th>Name</th>
1525
                  <th>Method</th>
1526
                  <th>Parameters</th>
1527
                  <th style="width:60%;">Description</th>
1528
                </tr>
1529
              </thead>
1530
              <tbody>
1531
END
1532
        ;
1533
        foreach my $fname (@fnames) {
1534
            my $fp = ($fparams{$fname}) ? "$fparams{$fname}" : '';
1535
            $res .= <<END
1536
                    <tr>
1537
                      <td><a href="#" onclick="data.scopeaction=this.text; \$('#scopeaction option[value=$fname]').prop('selected', true); dofields();">$fname</a></td>
1538
                      <td>$fmethods{$fname}</td>
1539
                      <td>$fp</td>
1540
                      <td>$fdescriptions{$fname}</td>
1541
                    </tr>
1542
END
1543
            ;
1544
        }
1545
        $res .= <<END
1546
                </tbody>
1547
            </table>
1548
        </div>
1549
END
1550
        ;
1551
        $res .= qq|</body>\n</html>|;
1552
    } else {
1553
        foreach my $fname (@fnames) {
1554
            my $fp = ($fparams{$fname}) ? "[$fparams{$fname}]" : '';
1555
            $res .= <<END
1556
* $fname ($fmethods{$fname}) $fp $fdescriptions{$fname}
1557
END
1558
            ;
1559
        }
1560
    }
1561
1562
    return $res;
1563
}
1564
1565 8d7785ff Origo
sub getBackupSize {
1566
    my ($subdir, $img, $imguser) = @_; # $subdir, if specified, includes leading slash
1567
    $imguser = $imguser || $user;
1568
    my $backupsize = 0;
1569
    my @bdirs = ("$backupdir/$imguser$subdir/$img");
1570
    if ($backupdir =~ /^\/stabile-backup\//) { # ZFS backup is enabled - we need to scan more dirs
1571
        @bdirs = (
1572
            "/stabile-backup/*/$imguser$subdir/" . shell_esc_chars($img),
1573
            "/stabile-backup/*/.zfs/snapshot/*/$imguser$subdir/". shell_esc_chars($img)
1574
        );
1575
    }
1576
    foreach my $bdir (@bdirs) {
1577
        my $bdu = `/usr/bin/du -bs $bdir 2>/dev/null`;
1578
        my @blines = split("\n", $bdu);
1579
        # only count size from last snapshot
1580
        my $bline = pop @blines;
1581
#        foreach my $bline (@blines) {
1582
            $bline =~ /(\d+)\s+/;
1583
            $backupsize += $1;
1584
#        }
1585
    }
1586
    return $backupsize;
1587
}
1588
1589 95b003ff Origo
sub shell_esc_chars {
1590
    my $str = shift;
1591
    $str =~ s/([;<>\*\|`&\$!#\(\)\[\]\{\}:'" ])/\\$1/g;
1592
    return $str;
1593
}