|
1
|
#!/usr/bin/perl
|
|
2
|
|
|
3
|
# All rights reserved and Copyright (c) 2020 Origo Systems ApS.
|
|
4
|
# This file is provided with no warranty, and is subject to the terms and conditions defined in the license file LICENSE.md.
|
|
5
|
# The license file is part of this source code package and its content is also available at:
|
|
6
|
# https://www.origo.io/info/stabiledocs/licensing/stabile-open-source-license
|
|
7
|
|
|
8
|
package Stabile::Networks;
|
|
9
|
|
|
10
|
use Error qw(:try);
|
|
11
|
use Data::Dumper;
|
|
12
|
use Time::Local;
|
|
13
|
use Time::HiRes qw( time );
|
|
14
|
use Data::UUID;
|
|
15
|
use Net::Netmask;
|
|
16
|
use Net::Ping;
|
|
17
|
use Proc::Daemon;
|
|
18
|
use File::Basename;
|
|
19
|
use List::Util qw(shuffle);
|
|
20
|
use lib dirname (__FILE__);
|
|
21
|
use Stabile;
|
|
22
|
|
|
23
|
($datanic, $extnic) = $main::getNics->();
|
|
24
|
$extsubnet = $Stabile::config->get('EXTERNAL_SUBNET_SIZE');
|
|
25
|
$proxynic = $Stabile::config->get('PROXY_NIC') || $extnic;
|
|
26
|
$proxyip = $Stabile::config->get('PROXY_IP');
|
|
27
|
$proxygw = $Stabile::config->get('PROXY_GW') || $proxyip;
|
|
28
|
$proxysubnet = $Stabile::config->get('PROXY_SUBNET_SIZE');
|
|
29
|
my $engineid = $Stabile::config->get('ENGINEID') || "";
|
|
30
|
$dodns = $Stabile::config->get('DO_DNS') || "";
|
|
31
|
$enginelinked = $Stabile::config->get('ENGINE_LINKED') || "";
|
|
32
|
|
|
33
|
my $tenders = $Stabile::config->get('STORAGE_POOLS_ADDRESS_PATHS');
|
|
34
|
@tenderlist = split(/,\s*/, $tenders);
|
|
35
|
my $tenderpaths = $Stabile::config->get('STORAGE_POOLS_LOCAL_PATHS') || "/mnt/stabile/images";
|
|
36
|
@tenderpathslist = split(/,\s*/, $tenderpaths);
|
|
37
|
my $tendernames = $Stabile::config->get('STORAGE_POOLS_NAMES') || "Standard storage";
|
|
38
|
@tendernameslist = split(/,\s*/, $tendernames);
|
|
39
|
$storagepools = $Stabile::config->get('STORAGE_POOLS_DEFAULTS') || "0";
|
|
40
|
|
|
41
|
$uiuuid;
|
|
42
|
$uistatus;
|
|
43
|
$help = 0; # If this is set, functions output help
|
|
44
|
|
|
45
|
#our %options=();
|
|
46
|
# -a action -h help -u uuid -m match pattern -f full list, i.e. all users
|
|
47
|
# -v verbose, include HTTP headers -s impersonate subaccount -t target [uuid or image]
|
|
48
|
# -g args to gearman task
|
|
49
|
#Getopt::Std::getopts("a:hfu:g:m:vs:t:", \%options);
|
|
50
|
|
|
51
|
try {
|
|
52
|
Init(); # Perform various initalization tasks
|
|
53
|
process() if ($package);
|
|
54
|
|
|
55
|
} catch Error with {
|
|
56
|
my $ex = shift;
|
|
57
|
print header('text/html', '500 Internal Server Error') unless ($console);
|
|
58
|
if ($ex->{-text}) {
|
|
59
|
print "Got error: ", $ex->{-text}, " on line ", $ex->{-line}, "\n";
|
|
60
|
} else {
|
|
61
|
print "Status=ERROR\n";
|
|
62
|
}
|
|
63
|
} finally {
|
|
64
|
};
|
|
65
|
|
|
66
|
1;
|
|
67
|
|
|
68
|
sub getObj {
|
|
69
|
my %h = %{@_[0]};
|
|
70
|
$console = 1 if $h{"console"};
|
|
71
|
$api = 1 if $h{"api"};
|
|
72
|
my $uuid = $h{"uuid"};
|
|
73
|
my $obj;
|
|
74
|
$action = $action || $h{'action'};
|
|
75
|
if (
|
|
76
|
$action =~ /^dns/
|
|
77
|
) {
|
|
78
|
$obj = \%h;
|
|
79
|
return $obj;
|
|
80
|
}
|
|
81
|
$uuid = $curuuid if ($uuid eq 'this');
|
|
82
|
if ($uuid =~ /(\d+\.\d+\.\d+\.\d+)/) { # ip addresses are unique across networks so we allow this
|
|
83
|
foreach my $val (values %register) {
|
|
84
|
if ($val->{'internalip'} eq $uuid || $val->{'externalip'} eq $uuid) {
|
|
85
|
$uuid = $val->{'uuid'};
|
|
86
|
last;
|
|
87
|
}
|
|
88
|
}
|
|
89
|
}
|
|
90
|
my $dbobj = $register{$uuid} || {};
|
|
91
|
my $status = $dbobj->{'status'} || $h{"status"}; # Trust db status if it exists
|
|
92
|
if ((!$uuid && $uuid ne '0') && (!$status || $status eq 'new') && ($action eq 'save')) {
|
|
93
|
my $ug = new Data::UUID;
|
|
94
|
$uuid = $ug->create_str();
|
|
95
|
$status = 'new';
|
|
96
|
};
|
|
97
|
return 0 unless ($uuid && length $uuid == 36);
|
|
98
|
|
|
99
|
$uiuuid = $uuid;
|
|
100
|
$uistatus = $dbobj->{'status'};
|
|
101
|
|
|
102
|
my $id = $h{"id"};
|
|
103
|
my $dbid = 0+$dbobj->{'id'};
|
|
104
|
if ($status eq 'new' || !$dbid) {
|
|
105
|
$id = getNextId($id) ;
|
|
106
|
} else {
|
|
107
|
$id = $dbid;
|
|
108
|
}
|
|
109
|
|
|
110
|
if ($id > 4095 || $id < 0 || ($id==0 && $uuid!=0) || ($id==1 && $uuid!=1)) {
|
|
111
|
$postreply .= "Status=ERROR Invalid new network id $id\n";
|
|
112
|
return;
|
|
113
|
}
|
|
114
|
my $name = $h{"name"} || $dbobj->{'name'};
|
|
115
|
my $internalip = $h{"internalip"} || $dbobj->{'internalip'};
|
|
116
|
if (!($internalip =~ /\d+\.\d+\.\d+\.\d+/)) {$internalip = ""};
|
|
117
|
my $externalip = $h{"externalip"} || $dbobj->{'externalip'};
|
|
118
|
my $ports = $h{"ports"} || $dbobj->{'ports'};
|
|
119
|
my $type = $h{"type"} || $dbobj->{'type'};
|
|
120
|
my $systems = $h{"systems"} || $dbobj->{'systems'};
|
|
121
|
my $force = $h{"force"};
|
|
122
|
my $reguser = $dbobj->{'user'};
|
|
123
|
# Sanity checks
|
|
124
|
if (
|
|
125
|
($name && length $name > 255)
|
|
126
|
|| ($ports && length $ports > 255)
|
|
127
|
|| ($type && !($type =~ /gateway|ipmapping|internalip|externalip|remoteip/))
|
|
128
|
) {
|
|
129
|
$postreply .= "Stroke=ERROR Bad network data: $name\n";
|
|
130
|
return;
|
|
131
|
}
|
|
132
|
# Security check
|
|
133
|
if (($user ne $reguser && index($privileges,"a")==-1 && $action ne 'save' ) ||
|
|
134
|
($reguser && $status eq "new"))
|
|
135
|
{
|
|
136
|
$postreply .= "Stroke=ERROR Bad user: $user, $action\n";
|
|
137
|
return;
|
|
138
|
}
|
|
139
|
|
|
140
|
if (!$type ||($type ne 'gateway' && $type ne 'internalip' && $type ne 'ipmapping' && $type ne 'externalip' && $type ne 'remoteip')) {
|
|
141
|
$type = "gateway";
|
|
142
|
if ($internalip && $internalip ne "--" && $externalip && $externalip ne "--") {$type = "ipmapping";}
|
|
143
|
elsif (($internalip && $internalip ne "--") || $status eq 'new') {$type = "internalip";}
|
|
144
|
elsif (($externalip && $externalip ne "--") || $status eq 'new') {$type = "externalip";}
|
|
145
|
}
|
|
146
|
|
|
147
|
my $obj = {
|
|
148
|
uuid => $uuid,
|
|
149
|
id => $id,
|
|
150
|
name => $name,
|
|
151
|
status => $status,
|
|
152
|
type => $type,
|
|
153
|
internalip => $internalip,
|
|
154
|
externalip => $externalip,
|
|
155
|
ports => $ports,
|
|
156
|
systems => $systems,
|
|
157
|
force => $force,
|
|
158
|
action => $h{"action"}
|
|
159
|
};
|
|
160
|
return $obj;
|
|
161
|
}
|
|
162
|
|
|
163
|
sub Init {
|
|
164
|
|
|
165
|
# Tie database tables to hashes
|
|
166
|
unless ( tie(%register,'Tie::DBI', Hash::Merge::merge({table=>'networks'}, $Stabile::dbopts)) ) {return "Unable to access network register"};
|
|
167
|
unless ( tie(%domreg,'Tie::DBI', Hash::Merge::merge({table=>'domains'}, $Stabile::dbopts)) ) {return "Unable to access domain register"};
|
|
168
|
|
|
169
|
# simplify globals initialized in Stabile.pm
|
|
170
|
$tktuser = $tktuser || $Stabile::tktuser;
|
|
171
|
$user = $user || $Stabile::user;
|
|
172
|
|
|
173
|
# Create aliases of functions
|
|
174
|
*header = \&CGI::header;
|
|
175
|
|
|
176
|
*Natall = \&Deactivateall;
|
|
177
|
*Stopall = \&Deactivateall;
|
|
178
|
*Restoreall = \&Activateall;
|
|
179
|
|
|
180
|
*do_save = \&Save;
|
|
181
|
*do_tablelist = \&do_list;
|
|
182
|
*do_jsonlist = \&do_list;
|
|
183
|
*do_listnetworks = \&do_list;
|
|
184
|
*do_this = \&do_list;
|
|
185
|
*do_help = \&action;
|
|
186
|
*do_remove = \&action;
|
|
187
|
|
|
188
|
*do_restoreall = \&privileged_action;
|
|
189
|
*do_activateall = \&privileged_action;
|
|
190
|
*do_deactivateall = \&privileged_action;
|
|
191
|
*do_natall = \&privileged_action;
|
|
192
|
*do_stopall = \&privileged_action;
|
|
193
|
*do_stop = \&privileged_action;
|
|
194
|
*do_activate = \&privileged_action;
|
|
195
|
*do_deactivate = \&privileged_action;
|
|
196
|
|
|
197
|
*do_gear_activate = \&do_gear_action;
|
|
198
|
*do_gear_deactivate = \&do_gear_action;
|
|
199
|
*do_gear_stop = \&do_gear_action;
|
|
200
|
*do_gear_activateall = \&do_gear_action;
|
|
201
|
*do_gear_restoreall = \&do_gear_action;
|
|
202
|
*do_gear_deactivateall = \&do_gear_action;
|
|
203
|
*do_gear_stopall = \&do_gear_action;
|
|
204
|
*do_gear_natall = \&do_gear_action;
|
|
205
|
|
|
206
|
$rx; # Global rx count in bytes
|
|
207
|
$tx; # Global tx count in bytes
|
|
208
|
$etcpath = "/etc/stabile/networks";
|
|
209
|
|
|
210
|
}
|
|
211
|
|
|
212
|
sub do_list {
|
|
213
|
my ($uuid, $action, $obj) = @_;
|
|
214
|
if ($help) {
|
|
215
|
return <<END
|
|
216
|
GET:uuid:
|
|
217
|
List networks current user has access to.
|
|
218
|
END
|
|
219
|
}
|
|
220
|
|
|
221
|
my $res;
|
|
222
|
my $filter;
|
|
223
|
my $statusfilter;
|
|
224
|
my $uuidfilter;
|
|
225
|
$uuid = $obj->{'uuid'} if ($obj->{'uuid'});
|
|
226
|
|
|
227
|
if ($curuuid && ($isadmin || $register{$curuuid}->{'user'} eq $user) && $uripath =~ /networks(\.cgi)?\/(\?|)(this)/) {
|
|
228
|
$uuidfilter = $curuuid;
|
|
229
|
} elsif ($uripath =~ /networks(\.cgi)?\/(\?|)(name|status)/) {
|
|
230
|
$filter = $3 if ($uripath =~ /networks(\.cgi)?\/.*name(:|=)(.+)/);
|
|
231
|
$statusfilter = $3 if ($uripath =~ /networks(\.cgi)?\/.*status(:|=)(\w+)/);
|
|
232
|
} elsif ($uripath =~ /networks(\.cgi)?\/(\w{8}-\w{4}-\w{4}-\w{4}-\w{12})/) {
|
|
233
|
$uuidfilter = $2;
|
|
234
|
} elsif ($uuid) {
|
|
235
|
$uuidfilter = $uuid;
|
|
236
|
}
|
|
237
|
$uuidfilter = $options{u} unless $uuidfilter;
|
|
238
|
$filter = $1 if ($filter =~ /(.*)\*/);
|
|
239
|
$statusfilter = '' if ($statusfilter eq '*');
|
|
240
|
|
|
241
|
my $curnetwork = URI::Escape::uri_unescape($params{'network'});
|
|
242
|
my $curnetwork1 = URI::Escape::uri_unescape($params{'network1'});
|
|
243
|
|
|
244
|
my $sysuuid;
|
|
245
|
if ($params{'system'}) {
|
|
246
|
$sysuuid = $params{'system'};
|
|
247
|
$sysuuid = $cursysuuid || $curdomuuid if ($params{'system'} eq 'this');
|
|
248
|
}
|
|
249
|
|
|
250
|
$res .= header('application/json') unless ($console || $action eq 'tablelist');
|
|
251
|
my @curregvalues;
|
|
252
|
|
|
253
|
updateBilling();
|
|
254
|
my @regkeys;
|
|
255
|
if ($fulllist) {
|
|
256
|
@regkeys = keys %register;
|
|
257
|
} elsif ($uuidfilter && $isadmin) {
|
|
258
|
@regkeys = (tied %register)->select_where("uuid = '$uuidfilter'");
|
|
259
|
} else {
|
|
260
|
@regkeys = (tied %register)->select_where("user = '$user' OR user = 'common'");
|
|
261
|
}
|
|
262
|
|
|
263
|
foreach my $k (@regkeys) {
|
|
264
|
my $valref = $register{$k};
|
|
265
|
my $uuid = $valref->{'uuid'};
|
|
266
|
my $dbuser = $valref->{'user'};
|
|
267
|
my $type = $valref->{'type'};
|
|
268
|
my $id = $valref->{'id'};
|
|
269
|
# Only list networks belonging to current user
|
|
270
|
if ($dbuser eq "common" || $user eq $dbuser || $fulllist || ($uuidfilter && $isadmin)) {
|
|
271
|
my $dom = $domreg{$valref->{'domains'}};
|
|
272
|
next unless (!$sysuuid || $dom->{'system'} eq $sysuuid || $valref->{'domains'} eq $sysuuid);
|
|
273
|
validateStatus($valref);
|
|
274
|
my %val = %{$valref}; # Deference and assign to new ass array, effectively cloning object
|
|
275
|
$val{'id'} += 0;
|
|
276
|
$val{'rx'} = $rx;
|
|
277
|
$val{'tx'} = $tx;
|
|
278
|
$val{'domainnames'} = decode('utf8', $val{'domainnames'});
|
|
279
|
if ($filter || $statusfilter || $uuidfilter) { # List filtered networks
|
|
280
|
my $fmatch;
|
|
281
|
my $smatch;
|
|
282
|
my $umatch;
|
|
283
|
$fmatch = 1 if (!$filter || $val{'name'}=~/$filter/i);
|
|
284
|
$smatch = 1 if (!$statusfilter || $statusfilter eq 'all'
|
|
285
|
|| $statusfilter eq $val{'status'}
|
|
286
|
);
|
|
287
|
$umatch = 1 if ($val{'uuid'} eq $uuidfilter);
|
|
288
|
if ($fmatch && $smatch && !$uuidfilter) {
|
|
289
|
push @curregvalues,\%val;
|
|
290
|
} elsif ($umatch) {
|
|
291
|
push @curregvalues,\%val;
|
|
292
|
last;
|
|
293
|
}
|
|
294
|
|
|
295
|
} elsif ($action eq "listnetworks") { # List available networks
|
|
296
|
if (($id>0 || index($privileges,"a")!=-1) && ((!$valref->{'domains'} && !$valref->{'systems'}) || $type eq 'gateway' || ($curnetwork eq $uuid && !$curnetwork1) || $curnetwork1 eq $uuid)) {
|
|
297
|
push @curregvalues,\%val;
|
|
298
|
}
|
|
299
|
} else {
|
|
300
|
push @curregvalues,\%val if ($id>0 || index($privileges,"a")!=-1);
|
|
301
|
}
|
|
302
|
}
|
|
303
|
}
|
|
304
|
|
|
305
|
# Sort @curregvalues
|
|
306
|
my $sort = 'status';
|
|
307
|
$sort = $2 if ($uripath =~ /sort\((\+|\-)(\S+)\)/);
|
|
308
|
my $reverse;
|
|
309
|
$reverse = 1 if ($1 eq '-');
|
|
310
|
if ($reverse) { # sort reverse
|
|
311
|
if ($sort =~ /id/) {
|
|
312
|
@curregvalues = (sort {$b->{$sort} <=> $a->{$sort}} @curregvalues); # Sort as number
|
|
313
|
} else {
|
|
314
|
@curregvalues = (sort {$b->{$sort} cmp $a->{$sort}} @curregvalues); # Sort as string
|
|
315
|
}
|
|
316
|
} else {
|
|
317
|
if ($sort =~ /id/) {
|
|
318
|
@curregvalues = (sort {$a->{$sort} <=> $b->{$sort}} @curregvalues); # Sort as number
|
|
319
|
} else {
|
|
320
|
@curregvalues = (sort {$a->{$sort} cmp $b->{$sort}} @curregvalues); # Sort as string
|
|
321
|
}
|
|
322
|
}
|
|
323
|
|
|
324
|
my %val = ("uuid", "--", "name", "--");
|
|
325
|
if ($curnetwork1) { # allow second network to be empty
|
|
326
|
push @curregvalues, \%val;
|
|
327
|
}
|
|
328
|
if ($action eq 'tablelist') {
|
|
329
|
$res .= header("text/plain") unless ($console);
|
|
330
|
my $t2 = Text::SimpleTable->new(36,20,10,5,10,14,14,7);
|
|
331
|
$t2->row('uuid', 'name', 'type', 'id', 'internalip', 'externalip', 'user', 'status');
|
|
332
|
$t2->hr;
|
|
333
|
my $pattern = $options{m};
|
|
334
|
foreach $rowref (@curregvalues){
|
|
335
|
if ($pattern) {
|
|
336
|
my $rowtext = $rowref->{'uuid'} . " " . $rowref->{'name'} . " " . $rowref->{'type'} . " " . $rowref->{'id'}
|
|
337
|
. " " . $rowref->{'internalip'} . " " . $rowref->{'externalip'} . " " . $rowref->{'user'} . " " . $rowref->{'status'};
|
|
338
|
$rowtext .= " " . $rowref->{'mac'} if ($isadmin);
|
|
339
|
next unless ($rowtext =~ /$pattern/i);
|
|
340
|
}
|
|
341
|
$t2->row($rowref->{'uuid'}, $rowref->{'name'}||'--', $rowref->{'type'}, $rowref->{'id'},
|
|
342
|
$rowref->{'internalip'}||'--', $rowref->{'externalip'}||'--', $rowref->{'user'}, $rowref->{'status'});
|
|
343
|
}
|
|
344
|
$res .= $t2->draw;
|
|
345
|
} elsif ($console && !$uuidfilter && $action ne 'jsonlist') {
|
|
346
|
$res .= Dumper(\@curregvalues);
|
|
347
|
} else {
|
|
348
|
my $json_text;
|
|
349
|
if ($uuidfilter) {
|
|
350
|
$json_text = to_json($curregvalues[0], {pretty => 1}) if (@curregvalues);
|
|
351
|
} else {
|
|
352
|
$json_text = to_json(\@curregvalues, {pretty => 1}) if (@curregvalues);
|
|
353
|
}
|
|
354
|
$json_text = "[]" unless $json_text;
|
|
355
|
$json_text =~ s/""/"--"/g;
|
|
356
|
$json_text =~ s/null/"--"/g;
|
|
357
|
$json_text =~ s/undef/"--"/g;
|
|
358
|
$json_text =~ s/\x/ /g;
|
|
359
|
$res .= qq|{"action": "$action", "identifier": "uuid", "label": "name", "items": | if ($action && $action ne 'jsonlist' && $action ne 'list' && !$uuidfilter);
|
|
360
|
$res .= $json_text;
|
|
361
|
$res .= qq|}| if ($action && $action ne 'jsonlist' && $action ne 'list' && !$uuidfilter);
|
|
362
|
# $res .= "JSON" if (action eq 'jsonlist');
|
|
363
|
}
|
|
364
|
return $res;
|
|
365
|
}
|
|
366
|
|
|
367
|
sub do_uuidlookup {
|
|
368
|
if ($help) {
|
|
369
|
return <<END
|
|
370
|
GET:uuid:
|
|
371
|
Simple action for looking up a uuid or part of a uuid and returning the complete uuid.
|
|
372
|
END
|
|
373
|
}
|
|
374
|
|
|
375
|
my $res;
|
|
376
|
$res .= header('text/plain') unless $console;
|
|
377
|
my $u = $options{u};
|
|
378
|
$u = $curuuid unless ($u || $u eq '0');
|
|
379
|
my $ruuid;
|
|
380
|
if ($u || $u eq '0') {
|
|
381
|
foreach my $uuid (keys %register) {
|
|
382
|
if (($register{$uuid}->{'user'} eq $user || $register{$uuid}->{'user'} eq 'common' || $fulllist)
|
|
383
|
&& ($uuid =~ /^$u/ || $register{$uuid}->{'name'} =~ /^$u/)) {
|
|
384
|
$ruuid = $uuid;
|
|
385
|
last;
|
|
386
|
}
|
|
387
|
}
|
|
388
|
if (!$ruuid && $isadmin) { # If no match and user is admin, do comprehensive lookup
|
|
389
|
foreach $uuid (keys %register) {
|
|
390
|
if ($uuid =~ /^$u/ || $register{$uuid}->{'name'} =~ /^$u/) {
|
|
391
|
$ruuid = $uuid;
|
|
392
|
last;
|
|
393
|
}
|
|
394
|
}
|
|
395
|
}
|
|
396
|
}
|
|
397
|
$res .= "$ruuid\n" if ($ruuid);
|
|
398
|
return $res;
|
|
399
|
}
|
|
400
|
|
|
401
|
sub do_uuidshow {
|
|
402
|
if ($help) {
|
|
403
|
return <<END
|
|
404
|
GET:uuid:
|
|
405
|
Simple action for showing a single network.
|
|
406
|
END
|
|
407
|
}
|
|
408
|
|
|
409
|
my $res;
|
|
410
|
$res .= header('application/json') unless $console;
|
|
411
|
my $u = $options{u};
|
|
412
|
$u = $curuuid unless ($u || $u eq '0');
|
|
413
|
if ($u || $u eq '0') {
|
|
414
|
foreach my $uuid (keys %register) {
|
|
415
|
if (($register{$uuid}->{'user'} eq $user || $register{$uuid}->{'user'} eq 'common' || index($privileges,"a")!=-1)
|
|
416
|
&& $uuid =~ /^$u/) {
|
|
417
|
my %hash = %{$register{$uuid}};
|
|
418
|
delete $hash{'action'};
|
|
419
|
delete $hash{'nextid'};
|
|
420
|
# my $dump = Dumper(\%hash);
|
|
421
|
my $dump = to_json(\%hash, {pretty=>1});
|
|
422
|
$dump =~ s/undef/"--"/g;
|
|
423
|
$res .= $dump;
|
|
424
|
last;
|
|
425
|
}
|
|
426
|
}
|
|
427
|
}
|
|
428
|
return $res;
|
|
429
|
}
|
|
430
|
|
|
431
|
sub do_updateui {
|
|
432
|
my ($uuid, $action) = @_;
|
|
433
|
if ($help) {
|
|
434
|
return <<END
|
|
435
|
GET:uuid:
|
|
436
|
Update the web UI for the given uuid (if user has web UI loaded).
|
|
437
|
END
|
|
438
|
}
|
|
439
|
|
|
440
|
my $res;
|
|
441
|
$res .= header('text/plain') unless $console;
|
|
442
|
if ($register{$uuid}) {
|
|
443
|
my $uistatus = $register{$uuid}->{'status'};
|
|
444
|
$main::updateUI->({tab=>"networks", user=>$user, uuid=>$uuid, status=>$uistatus});
|
|
445
|
$res .= "Status=OK Updated UI for $register{$uuid}->{'type'} $register{$uuid}->{'name'}: $uistatus";
|
|
446
|
} else {
|
|
447
|
$main::updateUI->({tab=>"networks", user=>$user});
|
|
448
|
$res .= "Status=OK Updated networks UI for $user";
|
|
449
|
}
|
|
450
|
return $res;
|
|
451
|
|
|
452
|
}
|
|
453
|
|
|
454
|
sub do_dnslist {
|
|
455
|
my ($uuid, $action) = @_;
|
|
456
|
if ($help) {
|
|
457
|
return <<END
|
|
458
|
GET:domain:
|
|
459
|
Lists entries in [domain] or if not specified, the default zone: $dnsdomain.
|
|
460
|
END
|
|
461
|
}
|
|
462
|
|
|
463
|
my $res = $main::dnsList->($engineid, $user, $params{'domain'});
|
|
464
|
return $res;
|
|
465
|
}
|
|
466
|
|
|
467
|
sub do_envdump {
|
|
468
|
my ($uuid, $action) = @_;
|
|
469
|
if ($help) {
|
|
470
|
return <<END
|
|
471
|
GET::
|
|
472
|
Dump environment variables
|
|
473
|
END
|
|
474
|
}
|
|
475
|
return to_json(\%ENV, {pretty=>1});
|
|
476
|
}
|
|
477
|
|
|
478
|
|
|
479
|
sub do_dnscreate {
|
|
480
|
my ($uuid, $action) = @_;
|
|
481
|
if ($help) {
|
|
482
|
return <<END
|
|
483
|
GET:name, value, type:
|
|
484
|
Create a DNS record in the the subdomain belonging to the user's default DNS domain.
|
|
485
|
<b>name</b> is a domain name in the Engine's zone. <b>value</b> is either an IP address for A records or a domain name for other. <b>[type]</b> is A, CNAME, TXT or MX.
|
|
486
|
END
|
|
487
|
}
|
|
488
|
|
|
489
|
my $res = $main::dnsCreate->($engineid, $params{'name'}, $params{'value'}, $params{'type'}, $user);
|
|
490
|
return $res;
|
|
491
|
}
|
|
492
|
|
|
493
|
sub do_dnsupdate {
|
|
494
|
my ($uuid, $action, $obj) = @_;
|
|
495
|
if ($help) {
|
|
496
|
return <<END
|
|
497
|
GET:name,value,type,oldname,oldvalue:
|
|
498
|
Updates CNAME records pointing to a A record with value 'value', to point to the new 'name' in the the default DNS domain.
|
|
499
|
END
|
|
500
|
}
|
|
501
|
|
|
502
|
my $res = $main::dnsUpdate->($engineid, $obj->{'name'}, $obj->{'value'}, $obj->{'type'}, $obj->{'oldname'}, $obj->{'oldvalue'}, $user);
|
|
503
|
return $res;
|
|
504
|
}
|
|
505
|
|
|
506
|
sub do_dnsclean {
|
|
507
|
my ($uuid, $action) = @_;
|
|
508
|
if ($help) {
|
|
509
|
return <<END
|
|
510
|
GET::
|
|
511
|
Remove this engines entries in $dnsdomain zone.
|
|
512
|
END
|
|
513
|
}
|
|
514
|
|
|
515
|
my $res;
|
|
516
|
$res .= header('text/plain') unless $console;
|
|
517
|
$res .= $main::dnsClean->($engineid, $user);
|
|
518
|
return $res;
|
|
519
|
}
|
|
520
|
|
|
521
|
sub do_dnscheck {
|
|
522
|
my ($uuid, $action) = @_;
|
|
523
|
if ($help) {
|
|
524
|
return <<END
|
|
525
|
GET:name:
|
|
526
|
Checks if a domain name (name[.subdomain]) is available, i.e. not registered,
|
|
527
|
where subdomain is the subdomain belonging to the the registering engine.
|
|
528
|
END
|
|
529
|
}
|
|
530
|
|
|
531
|
my $res;
|
|
532
|
$res .= header('text/plain') unless $console;
|
|
533
|
my $name = $params{'name'};
|
|
534
|
$name = $1 if ($name =~ /(.+)\.$dnsdomain$/);
|
|
535
|
if (!$enginelinked) {
|
|
536
|
$res .= "Status=ERROR You cannot create DNS records - your engine is not linked.\n";
|
|
537
|
} elsif ($name =~ /^\S+$/ && !(`host $name.$dnsdomain authns1.cabocomm.dk` =~ /has address/)
|
|
538
|
&& $name ne 'www'
|
|
539
|
&& $name ne 'mail'
|
|
540
|
&& $name ne 'info'
|
|
541
|
&& $name ne 'admin'
|
|
542
|
&& $name ne 'work'
|
|
543
|
&& $name ne 'io'
|
|
544
|
&& $name ne 'cloud'
|
|
545
|
&& $name ne 'compute'
|
|
546
|
&& $name ne 'sso'
|
|
547
|
&& $name !~ /valve/
|
|
548
|
) {
|
|
549
|
$res .= "Status=OK $name.$dnsdomain is available\n";
|
|
550
|
} else {
|
|
551
|
$res .= "Status=ERROR $name.$dnsdomain is not available\n";
|
|
552
|
}
|
|
553
|
return $res;
|
|
554
|
}
|
|
555
|
|
|
556
|
sub do_dnsdelete {
|
|
557
|
my ($uuid, $action) = @_;
|
|
558
|
if ($help) {
|
|
559
|
return <<END
|
|
560
|
GET:name, value, type:
|
|
561
|
Delete a DNS record in the configured zone.
|
|
562
|
END
|
|
563
|
}
|
|
564
|
|
|
565
|
my $res = $main::dnsDelete->($engineid, $params{'name'}, $params{'value'}, $params{'type'}, $user);
|
|
566
|
return $res;
|
|
567
|
}
|
|
568
|
|
|
569
|
sub do_getappstoreurl {
|
|
570
|
my ($uuid, $action) = @_;
|
|
571
|
if ($help) {
|
|
572
|
return <<END
|
|
573
|
GET::
|
|
574
|
Get URL to the app store belonging to engine or user (uverrides engine default).
|
|
575
|
END
|
|
576
|
}
|
|
577
|
|
|
578
|
my $res;
|
|
579
|
# $res .= header('application/json') unless $console;
|
|
580
|
# $res .= qq|{"url": "$appstoreurl"}\n|;
|
|
581
|
$res .= "$appstoreurl\n";
|
|
582
|
return $res;
|
|
583
|
}
|
|
584
|
|
|
585
|
sub do_listdnsdomains {
|
|
586
|
my ($uuid, $action) = @_;
|
|
587
|
if ($help) {
|
|
588
|
return <<END
|
|
589
|
GET::
|
|
590
|
Get the DNS domains current user has access to.
|
|
591
|
END
|
|
592
|
}
|
|
593
|
unless ( tie(%userreg,'Tie::DBI', Hash::Merge::merge({table=>'users', key=>'username', CLOBBER=>1}, $Stabile::dbopts)) ) {return 0};
|
|
594
|
my $billto = $userreg{$user}->{'billto'};
|
|
595
|
my $bdomains = ($userreg{$billto})?$userreg{$billto}->{'dnsdomains'}:'';
|
|
596
|
my $domains = ($enginelinked)?($userreg{$user}->{'dnsdomains'} || $bdomains || $dnsdomain) :'';
|
|
597
|
untie %userreg;
|
|
598
|
my @doms = split(/, ?/, $domains);
|
|
599
|
my $subdomain = ($enginelinked)?substr($engineid, 0, 8):'';
|
|
600
|
my $linked = ($enginelinked)?'true':'false';
|
|
601
|
my $res;
|
|
602
|
$res .= header('application/json') unless $console;
|
|
603
|
$res .= qq|{"domains": | . to_json(\@doms) . qq|, "subdomain": "$subdomain", "enginelinked": "$linked", "billto": "$billto", "user": "$user"}|;
|
|
604
|
return $res;
|
|
605
|
}
|
|
606
|
|
|
607
|
sub do_getdnsdomain {
|
|
608
|
my ($uuid, $action) = @_;
|
|
609
|
if ($help) {
|
|
610
|
return <<END
|
|
611
|
GET::
|
|
612
|
Get the default DNS domain and the subdomain this Engine registers entries in.
|
|
613
|
END
|
|
614
|
}
|
|
615
|
my $domain = ($enginelinked)?$dnsdomain:'';
|
|
616
|
my $subdomain = ($enginelinked)?substr($engineid, 0, 8):'';
|
|
617
|
my $linked = ($enginelinked)?'true':'false';
|
|
618
|
my $res;
|
|
619
|
$res .= header('application/json') unless $console;
|
|
620
|
$res .= qq|{"domain": "$domain", "subdomain": "$subdomain", "enginelinked": "$linked"}|;
|
|
621
|
return $res;
|
|
622
|
}
|
|
623
|
|
|
624
|
sub xmppsend {
|
|
625
|
my ($uuid, $action) = @_;
|
|
626
|
if ($help) {
|
|
627
|
return <<END
|
|
628
|
GET:to, msg:
|
|
629
|
Send out an xmpp alert.
|
|
630
|
END
|
|
631
|
}
|
|
632
|
if ($help) {
|
|
633
|
return <<END
|
|
634
|
Send out an xmpp alert
|
|
635
|
END
|
|
636
|
}
|
|
637
|
|
|
638
|
my $res;
|
|
639
|
$res .= header('text/plain') unless $console;
|
|
640
|
$res .= $main::xmppSend->($params{'to'}, $params{'msg'}, $engineid);
|
|
641
|
return $res;
|
|
642
|
}
|
|
643
|
|
|
644
|
# List available network types. Possibly limited by exhausted IP ranges.
|
|
645
|
sub do_listnetworktypes {
|
|
646
|
if ($help) {
|
|
647
|
return <<END
|
|
648
|
GET::
|
|
649
|
List available network types. Possibly limited by exhausted IP ranges.
|
|
650
|
END
|
|
651
|
}
|
|
652
|
|
|
653
|
my $res;
|
|
654
|
$res .= header('application/json') unless $console;
|
|
655
|
# Check if we have exhausted our IP ranges
|
|
656
|
my $intipavail = getNextInternalIP();
|
|
657
|
my $extipavail = getNextExternalIP();
|
|
658
|
my $arpipavail = getNextExternalIP('','',1);
|
|
659
|
my $json_text;
|
|
660
|
$json_text .= '{"type": "gateway", "name": "Gateway"}, ';
|
|
661
|
$json_text .= '{"type": "internalip", "name": "Internal IP"}, ' if ($intipavail);
|
|
662
|
unless (overQuotas()) {
|
|
663
|
$json_text .= '{"type": "ipmapping", "name": "IP mapping"}, ' if ($intipavail && $extipavail);
|
|
664
|
$json_text .= '{"type": "externalip", "name": "External IP"}, 'if ($arpipavail);
|
|
665
|
$json_text .= '{"type": "remoteip", "name": "Remote IP"}, 'if ($Stabile::remoteipenabled);
|
|
666
|
}
|
|
667
|
$json_text = substr($json_text,0,-2);
|
|
668
|
$res .= '{"identifier": "type", "label": "name", "items": [' . $json_text . ']}';
|
|
669
|
return $res;
|
|
670
|
}
|
|
671
|
|
|
672
|
# Simple action for removing all networks belonging to a user
|
|
673
|
sub do_removeusernetworks {
|
|
674
|
my ($uuid, $action) = @_;
|
|
675
|
if ($help) {
|
|
676
|
return <<END
|
|
677
|
GET:username:
|
|
678
|
Remove all networks belonging to a user.
|
|
679
|
END
|
|
680
|
}
|
|
681
|
my $username = shift;
|
|
682
|
return unless ($username && ($isadmin || $user eq $username) && !$isreadonly);
|
|
683
|
$user = $username;
|
|
684
|
my $res;
|
|
685
|
$res .= header('text/plain') unless $console;
|
|
686
|
if ($readonly) {
|
|
687
|
$postreply .= "Status=ERROR Not allowed\n";
|
|
688
|
} else {
|
|
689
|
Removeusernetworks($user);
|
|
690
|
}
|
|
691
|
$res .= $postreply || "Status=OK Nothing to remove\n";
|
|
692
|
return $res;
|
|
693
|
}
|
|
694
|
|
|
695
|
# Activate all networks. If restoreall (e.g. after reboot) is called, we only activate networks which have entries in /etc/stabile/network
|
|
696
|
sub Activateall {
|
|
697
|
my ($nouuid, $action) = @_;
|
|
698
|
if ($help) {
|
|
699
|
return <<END
|
|
700
|
GET::
|
|
701
|
Tries to activate all networks. If called as restoreall by an admin, will try to restore all user's networks to saved state, e.g. after a reboot.
|
|
702
|
END
|
|
703
|
}
|
|
704
|
my @regkeys;
|
|
705
|
if (($action eq "restoreall" || $fulllist) && index($privileges,"a")!=-1) { # Only an administrator is allowed to do this
|
|
706
|
@regkeys = keys %register;
|
|
707
|
} else {
|
|
708
|
@regkeys = (tied %register)->select_where("user='$user'");
|
|
709
|
}
|
|
710
|
my $i = 0;
|
|
711
|
if (!$isreadonly) {
|
|
712
|
foreach my $key (@regkeys) {
|
|
713
|
my $valref = $register{$key};
|
|
714
|
my $uuid = $valref->{'uuid'};
|
|
715
|
my $type = $valref->{'type'};
|
|
716
|
my $id = $valref->{'id'};
|
|
717
|
my $name = $valref->{'name'};
|
|
718
|
my $internalip = $valref->{'internalip'};
|
|
719
|
my $externalip = $valref->{'externalip'};
|
|
720
|
if ($id!=0 && $id!=1 && $id<4095) {
|
|
721
|
my $caction = "nat";
|
|
722
|
if (-e "$etcpath/dhcp-hosts-$id") {
|
|
723
|
if ($action eq "restoreall" && $isadmin) { # If restoring, only activate previously active networks
|
|
724
|
my $hosts;
|
|
725
|
$hosts = lc `/bin/cat $etcpath/dhcp-hosts-$id` if (-e "$etcpath/dhcp-hosts-$id");
|
|
726
|
$caction = "activate" if ($hosts =~ /($internalip|$externalip)/);
|
|
727
|
} elsif ($action eq "activateall") {
|
|
728
|
$caction = "activate";
|
|
729
|
}
|
|
730
|
# TODO: investigate why this is necessary - if we don't do it, networks are not activated
|
|
731
|
$user = $valref->{'user'};
|
|
732
|
do_list($uuid, 'list');
|
|
733
|
|
|
734
|
my $res = Activate($uuid, $caction);
|
|
735
|
if ($res =~ /\w+=(\w+) / ) {
|
|
736
|
$register{$uuid}->{'status'} = $1 unless (uc $1 eq 'ERROR');
|
|
737
|
$i ++ unless (uc $1 eq 'ERROR');
|
|
738
|
} else {
|
|
739
|
$postreply .= "Status=ERROR Cannot $caction $type $name $uuid: $res\n";
|
|
740
|
}
|
|
741
|
}
|
|
742
|
} else {
|
|
743
|
$postreply .= "Status=ERROR Cannot $action $type $name\n" unless ($id==0 || $id==1);
|
|
744
|
}
|
|
745
|
}
|
|
746
|
} else {
|
|
747
|
$postreply .= "Status=ERROR Problem activating all networks\n";
|
|
748
|
}
|
|
749
|
if ($postreply =~/Status=ERROR /) {
|
|
750
|
$postreply = header('text/plain', '500 Internal Server Error') . $postreply unless $console;
|
|
751
|
}
|
|
752
|
$postreply .= "Status=OK activated $i networks\n";
|
|
753
|
$main::updateUI->({tab=>"networks", user=>$user});
|
|
754
|
updateBilling("$action $user");
|
|
755
|
return $postreply;
|
|
756
|
}
|
|
757
|
|
|
758
|
# Deactivate all networks
|
|
759
|
sub Deactivateall {
|
|
760
|
my ($nouuid, $action) = @_;
|
|
761
|
if ($help) {
|
|
762
|
return <<END
|
|
763
|
GET::
|
|
764
|
Tries to deactivate all networks. May also be called as natall or stopall.
|
|
765
|
END
|
|
766
|
}
|
|
767
|
|
|
768
|
my @regkeys;
|
|
769
|
if ($fulllist && index($privileges,"a")!=-1) { # Only an administrator is allowed to do this
|
|
770
|
@regkeys = keys %register;
|
|
771
|
} else {
|
|
772
|
@regkeys = (tied %register)->select_where("user='$user'");
|
|
773
|
}
|
|
774
|
if (!$isreadonly) {
|
|
775
|
my %ids;
|
|
776
|
foreach my $key (@regkeys) {
|
|
777
|
my $valref = $register{$key};
|
|
778
|
my $uuid = $valref->{'uuid'};
|
|
779
|
my $type = $valref->{'type'};
|
|
780
|
my $id = $valref->{'id'};
|
|
781
|
my $name = $valref->{'name'};
|
|
782
|
if ($id!=0 && $id!=1 && $id<4095) {
|
|
783
|
if (-e "$etcpath/dhcp-hosts-$id") {
|
|
784
|
my $caction = "deactivate";
|
|
785
|
my $result;
|
|
786
|
if ($action eq "stopall") {
|
|
787
|
$caction = "stop";
|
|
788
|
# Stop also deactivates all networks with same id, so only do this once for each id
|
|
789
|
if ($ids{$id}) {
|
|
790
|
$result = $valref->{'status'};
|
|
791
|
} else {
|
|
792
|
$result = Stop($id, $caction);
|
|
793
|
}
|
|
794
|
$ids{$id} = 1;
|
|
795
|
} else {
|
|
796
|
my $res = Deactivate($uuid, $caction);
|
|
797
|
if ($res =~ /\w+=(\w+) /) {
|
|
798
|
$register{$uuid}->{'status'} = $1;
|
|
799
|
} else {
|
|
800
|
$postreply .= "Status=ERROR Cannot $caction $type $name $uuid: $res\n";
|
|
801
|
}
|
|
802
|
}
|
|
803
|
if ($result =~ /\w+=(.\w+) /) {
|
|
804
|
$register{$uuid}->{'status'} = $uistatus = $1;
|
|
805
|
$uiuuid = $uuid;
|
|
806
|
$postreply .= "Status=OK $caction $type $name $uuid\n";
|
|
807
|
$main::syslogit->($user, "info", "$caction network $uuid ($id) ");
|
|
808
|
}
|
|
809
|
}
|
|
810
|
} else {
|
|
811
|
$postreply .= "Status=ERROR Cannot $action $type $name\n" unless ($id==0 || $id==1);
|
|
812
|
}
|
|
813
|
}
|
|
814
|
} else {
|
|
815
|
$postreply .= "Status=ERROR Problem deactivating all networks\n";
|
|
816
|
}
|
|
817
|
if ($postreply =~/Status=ERROR /) {
|
|
818
|
$res = header('text/plain', '500 Internal Server Error') unless $console;
|
|
819
|
} else {
|
|
820
|
$res = header('text/plain') unless $console;
|
|
821
|
}
|
|
822
|
$main::updateUI->({tab=>"networks", user=>$user});
|
|
823
|
updateBilling("$action $user");
|
|
824
|
return $postreply;
|
|
825
|
}
|
|
826
|
|
|
827
|
sub do_updatebilling {
|
|
828
|
my ($uuid, $action) = @_;
|
|
829
|
if ($help) {
|
|
830
|
return <<END
|
|
831
|
GET:uuid:
|
|
832
|
Update network billing for current user.
|
|
833
|
END
|
|
834
|
}
|
|
835
|
|
|
836
|
my $res;
|
|
837
|
$res .= header('text/plain') unless $console;
|
|
838
|
if ($isreadonly) {
|
|
839
|
$res .= "Status=ERROR Not updating network billing for $user\n";
|
|
840
|
} else {
|
|
841
|
updateBilling("updatebilling $user");
|
|
842
|
$res .= "Status=OK Updated network billing for $user\n";
|
|
843
|
}
|
|
844
|
return $res;
|
|
845
|
}
|
|
846
|
|
|
847
|
# Print list of available actions on objects
|
|
848
|
sub do_plainhelp {
|
|
849
|
my $res;
|
|
850
|
$res .= header('text/plain') unless $console;
|
|
851
|
$res .= <<END
|
|
852
|
* new [type="ipmapping|internalip|externalip|gateway", name="name"]: Creates a new network
|
|
853
|
* activate: Activates a network. If gateway is down it is brought up.
|
|
854
|
* stop: Stops the gateway, effectively stopping network communcation with the outside.
|
|
855
|
* deactivate: Deactivates a network. Removes the associated internal IP address from the DHCP service.
|
|
856
|
* delete: Deletes a network. Use with care. Network can not be in use.
|
|
857
|
|
|
858
|
END
|
|
859
|
;
|
|
860
|
}
|
|
861
|
|
|
862
|
sub addDHCPAddress {
|
|
863
|
my $id = shift;
|
|
864
|
my $uuid = shift;
|
|
865
|
my $dhcpip = shift;
|
|
866
|
my $gateway = shift;
|
|
867
|
my $mac = lc shift;
|
|
868
|
my $isexternal = !($dhcpip =~ /^10\./);
|
|
869
|
my $options;
|
|
870
|
my $interface = "br$id"; #,$extnic.$id
|
|
871
|
$options = "--strict-order --bind-interfaces --except-interface=lo --interface=$interface " .
|
|
872
|
($proxyip?"--dhcp-range=tag:external,$proxyip,static ":"") .
|
|
873
|
"--pid-file=/var/run/stabile-$id.pid --dhcp-hostsfile=$etcpath/dhcp-hosts-$id --dhcp-range=tag:internal,$gateway,static " .
|
|
874
|
"--dhcp-optsfile=$etcpath/dhcp-options-$id --port=0 --log-dhcp";
|
|
875
|
|
|
876
|
my $running;
|
|
877
|
my $error;
|
|
878
|
my $psid;
|
|
879
|
return "Status=ERROR Empty mac or ip when configuing dhcp for $name" unless ($mac && $dhcpip);
|
|
880
|
|
|
881
|
eval {
|
|
882
|
$psid = `/bin/cat /var/run/stabile-$id.pid` if (-e "/var/run/stabile-$id.pid");
|
|
883
|
chomp $psid;
|
|
884
|
$running = -e "/proc/$psid" if ($psid);
|
|
885
|
# `/bin/ps p $psid` =~ /$psid/
|
|
886
|
# `/bin/ps ax | /bin/grep stabile-$id.pid | /usr/bin/wc -l`; 1;} or do
|
|
887
|
1;
|
|
888
|
} or do {$error .= "Status=ERROR Problem configuring dhcp for $name $@\n";};
|
|
889
|
|
|
890
|
if (-e "$etcpath/dhcp-hosts-$id") {
|
|
891
|
open(TEMP1, "<$etcpath/dhcp-hosts-$id") || ($error .= "Status=ERROR Problem reading dhcp hosts\n");
|
|
892
|
open(TEMP2, ">$etcpath/dhcp-hosts-$id.new") || ($error .= "Status=ERROR Problem writing dhcp hosts $etcpath/dhcp-hosts-$id.new\n");
|
|
893
|
while (<TEMP1>) {
|
|
894
|
my $line = $_;
|
|
895
|
print TEMP2 $line unless (($mac && $line =~ /^$mac/i) || ($line & $line =~ /.+,$dhcpip/));
|
|
896
|
}
|
|
897
|
print TEMP2 "$mac," . (($isexternal)?"set:external,":"set:internal,") . "$dhcpip\n";
|
|
898
|
close(TEMP1);
|
|
899
|
close(TEMP2);
|
|
900
|
rename("$etcpath/dhcp-hosts-$id", "$etcpath/dhcp-hosts-$id.old") || ($error .= "Status=ERROR Problem writing dhcp hosts\n");
|
|
901
|
rename("$etcpath/dhcp-hosts-$id.new", "$etcpath/dhcp-hosts-$id") || ($error .= "Status=ERROR Problem writing dhcp hosts\n");
|
|
902
|
} else {
|
|
903
|
open(TEMP1, ">$etcpath/dhcp-hosts-$id") || ($error .= "Status=ERROR Problem writing dhcp options\n");
|
|
904
|
print TEMP1 "$mac,$dhcpip\n";
|
|
905
|
close (TEMP1);
|
|
906
|
}
|
|
907
|
|
|
908
|
# unless (-e "$etcpath/dhcp-options-$id") {
|
|
909
|
my $block = new Net::Netmask("$proxygw/$proxysubnet");
|
|
910
|
my $proxymask = $block->mask();
|
|
911
|
open(TEMP1, ">$etcpath/dhcp-options-$id") || ($error .= "Status=ERROR Problem writing dhcp options\n");
|
|
912
|
|
|
913
|
# Turns out the VM's gateway has to be $proxyip and not $proxygw in our proxyarp setup
|
|
914
|
print TEMP1 <<END;
|
|
915
|
tag:external,option:router,$proxyip
|
|
916
|
tag:external,option:netmask,$proxymask
|
|
917
|
tag:external,option:dns-server,$proxyip
|
|
918
|
tag:internal,option:router,$gateway
|
|
919
|
tag:internal,option:netmask,255.255.255.0
|
|
920
|
tag:internal,option:dns-server,$gateway
|
|
921
|
option:dns-server,1.1.1.1
|
|
922
|
END
|
|
923
|
|
|
924
|
close (TEMP1);
|
|
925
|
# }
|
|
926
|
|
|
927
|
if ($running) {
|
|
928
|
$main::syslogit->($user, 'info', "HUPing dnsmasq 1: $id");
|
|
929
|
eval {`/usr/bin/pkill -HUP -f "stabile-$id.pid"`; 1;} or do {$error .= "Status=ERROR Problem configuring dhcp for $name $@\n";};
|
|
930
|
} else {
|
|
931
|
eval {`/usr/sbin/dnsmasq $options`;1;} or do {$error .= "Status=ERROR Problem configuring dhcp for $name $@\n";};
|
|
932
|
}
|
|
933
|
# Allow access to DHCP service
|
|
934
|
`iptables -D INPUT -i br$id -p udp -m udp --dport 67 -j ACCEPT`;
|
|
935
|
`iptables -I INPUT -i br$id -p udp -m udp --dport 67 -j ACCEPT`;
|
|
936
|
# Allow access to DNS service
|
|
937
|
`iptables -D INPUT -i br$id -p udp -m udp --dport 53 -j ACCEPT`;
|
|
938
|
`iptables -I INPUT -i br$id -p udp -m udp --dport 53 -j ACCEPT`;
|
|
939
|
`iptables -D INPUT -i br$id -p tcp -m tcp --dport 53 -j ACCEPT`;
|
|
940
|
`iptables -I INPUT -i br$id -p tcp -m tcp --dport 53 -j ACCEPT`;
|
|
941
|
|
|
942
|
return $error?$error:"OK";
|
|
943
|
}
|
|
944
|
|
|
945
|
sub removeDHCPAddress {
|
|
946
|
my $id = shift;
|
|
947
|
my $uuid = shift;
|
|
948
|
my $dhcpip = shift;
|
|
949
|
my $mac;
|
|
950
|
$mac = lc $domreg{$uuid}->{'nicmac1'} if ($domreg{$uuid});
|
|
951
|
my $isexternal = ($dhcpip =~ /^10\./);
|
|
952
|
my $running;
|
|
953
|
my $error;
|
|
954
|
my $psid;
|
|
955
|
return "Status=ERROR Empty mac or ip when configuring dhcp for $name" unless ($mac || $dhcpip);
|
|
956
|
|
|
957
|
eval {
|
|
958
|
$psid = `/bin/cat /var/run/stabile-$id.pid` if (-e "/var/run/stabile-$id.pid");
|
|
959
|
chomp $psid;
|
|
960
|
$running = -e "/proc/$psid" if ($psid);
|
|
961
|
1;
|
|
962
|
} or do {$error .= "Status=ERROR Problem deconfiguring dhcp for $name $@\n";};
|
|
963
|
|
|
964
|
my $keepup;
|
|
965
|
if (-e "$etcpath/dhcp-hosts-$id") {
|
|
966
|
open(TEMP1, "<$etcpath/dhcp-hosts-$id") || ($error .= "Status=ERROR Problem reading dhcp hosts\n");
|
|
967
|
open(TEMP2, ">$etcpath/dhcp-hosts-$id.new") || ($error .= "Status=ERROR Problem writing dhcp hosts\n");
|
|
968
|
while (<TEMP1>) {
|
|
969
|
my $line = $_; chomp $line;
|
|
970
|
if ($line && $line =~ /(.+),.+,($dhcpip)/) { # Release and remove this mac/ip from lease file
|
|
971
|
$main::syslogit->($user, 'info', "Releasing dhcp lease: br$id $dhcpip $1");
|
|
972
|
`/usr/bin/dhcp_release br$id $dhcpip $1`;
|
|
973
|
} elsif ($mac && $line =~ /^$mac/i) {
|
|
974
|
# If we find a stale assigment to the mac we are removing, remove this also
|
|
975
|
$main::syslogit->($user, 'info', "Releasing stale dhcp lease: br$id $dhcpip $mac");
|
|
976
|
`/usr/bin/dhcp_release br$id $dhcpip $mac`;
|
|
977
|
} else {
|
|
978
|
# Keep all other leases, and keep up the daemon if any leases found
|
|
979
|
print TEMP2 "$line\n";
|
|
980
|
$keepup = 1 if $line;
|
|
981
|
}
|
|
982
|
}
|
|
983
|
close(TEMP1);
|
|
984
|
close(TEMP2);
|
|
985
|
rename("$etcpath/dhcp-hosts-$id", "$etcpath/dhcp-hosts-$id.old") || ($error .= "Status=ERROR Problem writing dhcp hosts\n");
|
|
986
|
rename("$etcpath/dhcp-hosts-$id.new", "$etcpath/dhcp-hosts-$id") || ($error .= "Status=ERROR Problem writing dhcp hosts\n");
|
|
987
|
}
|
|
988
|
|
|
989
|
if ($keepup) {
|
|
990
|
if ($running) {
|
|
991
|
$main::syslogit->($user, 'info', "HUPing dnsmasq 2: $id");
|
|
992
|
eval {`/usr/bin/pkill -HUP -f "stabile-$id.pid"`; 1;} or do {$error .= "Status=ERROR Problem configuring dhcp for $name $@\n";};
|
|
993
|
}
|
|
994
|
} else {
|
|
995
|
unlink "$etcpath/dhcp-options-$id" if (-e "$etcpath/dhcp-options-$id");
|
|
996
|
if ($running) {
|
|
997
|
# Disallow access to DHCP service
|
|
998
|
`iptables -D INPUT -i br$id -p udp -m udp --dport 67 -j ACCEPT`;
|
|
999
|
# Disallow access to DNS service
|
|
1000
|
`iptables -D INPUT -i br$id -p udp -m udp --dport 53 -j ACCEPT`;
|
|
1001
|
`iptables -D INPUT -i br$id -p tcp -m tcp --dport 53 -j ACCEPT`;
|
|
1002
|
# Take down dhcp server
|
|
1003
|
$main::syslogit->($user, 'info', "Killing dnsmasq 3: $id");
|
|
1004
|
eval {`/usr/bin/pkill -f "stabile-$id.pid"`; 1;} or do {$error .= "Status=ERROR Problem configuring dhcp for $name $@\n";};
|
|
1005
|
}
|
|
1006
|
}
|
|
1007
|
|
|
1008
|
return $error?$error:"OK";
|
|
1009
|
}
|
|
1010
|
|
|
1011
|
# Helper function
|
|
1012
|
sub save {
|
|
1013
|
my ($id, $uuid, $name, $status, $type, $internalip, $externalip, $ports, $buildsystem, $username) = @_;
|
|
1014
|
my $obj = {
|
|
1015
|
id => $id,
|
|
1016
|
uuid => $uuid,
|
|
1017
|
name => $name,
|
|
1018
|
status => $status,
|
|
1019
|
type => $type,
|
|
1020
|
internalip => $internalip,
|
|
1021
|
externalip => $externalip,
|
|
1022
|
ports => $ports,
|
|
1023
|
buildsystem => $buildsystem,
|
|
1024
|
username => $username
|
|
1025
|
};
|
|
1026
|
return Save($uuid, 'save', $obj);
|
|
1027
|
}
|
|
1028
|
|
|
1029
|
sub Save {
|
|
1030
|
my ($uuid, $action, $obj) = @_;
|
|
1031
|
if ($help) {
|
|
1032
|
return <<END
|
|
1033
|
POST:uuid, id, name, internalip, externalip, ports, type, systems, activate:
|
|
1034
|
To save a collection of networks you either PUT or POST a JSON array to the main endpoint with objects representing the networks with the changes you want.
|
|
1035
|
Depending on your privileges not all changes are permitted. If you save without specifying a uuid, a new network is created.
|
|
1036
|
For now, [activate] only has effect when creating a new connection with a linked system/server.
|
|
1037
|
END
|
|
1038
|
}
|
|
1039
|
$uuid = $obj->{'uuid'} if ($obj->{'uuid'});
|
|
1040
|
my $regnet = $register{$uuid};
|
|
1041
|
my $id = $obj->{id};
|
|
1042
|
my $name = $obj->{name};
|
|
1043
|
my $status = $obj->{status};
|
|
1044
|
my $type = $obj->{type} || $regnet->{type};
|
|
1045
|
my $internalip = $obj->{internalip};
|
|
1046
|
my $externalip = $obj->{externalip};
|
|
1047
|
my $ports = $obj->{ports};
|
|
1048
|
my $buildsystem = $obj->{buildsystem};
|
|
1049
|
my $username = $obj->{username};
|
|
1050
|
my $systems = $obj->{systems}; # Optionally link this network to a system
|
|
1051
|
|
|
1052
|
$postreply = "" if ($buildsystem);
|
|
1053
|
$username = $user unless ($username);
|
|
1054
|
|
|
1055
|
$status = $regnet->{'status'} || $status; # Trust db status if it exists
|
|
1056
|
if ((!$uuid && $uuid ne '0') && $status eq 'new') {
|
|
1057
|
my $ug = new Data::UUID;
|
|
1058
|
$uuid = $ug->create_str();
|
|
1059
|
};
|
|
1060
|
if ($status eq 'new') {
|
|
1061
|
$name = 'New Connection' unless ($name);
|
|
1062
|
}
|
|
1063
|
unless ($uuid && length $uuid == 36) {
|
|
1064
|
$postreply .= "Status=Error Invalid uuid $uuid\n";
|
|
1065
|
return $postreply;
|
|
1066
|
}
|
|
1067
|
my $systemnames = $regnet->{'systemnames'};
|
|
1068
|
|
|
1069
|
my $dbid = 0+$regnet->{'id'};
|
|
1070
|
if ($status eq 'new' || !$dbid) {
|
|
1071
|
$id = getNextId($id) ;
|
|
1072
|
} else {
|
|
1073
|
$id = $dbid;
|
|
1074
|
}
|
|
1075
|
if ($id > 4095 || $id < 0 || ($id==0 && $uuid!=0 && $isadmin) || ($id==1 && $uuid!=1 && $isadmin)) {
|
|
1076
|
$postreply .= "Status=ERROR Invalid network id $id\n";
|
|
1077
|
return $postreply;
|
|
1078
|
}
|
|
1079
|
$name = $name || $regnet->{'name'};
|
|
1080
|
$internalip = $internalip || $regnet->{'internalip'};
|
|
1081
|
if (!($internalip =~ /\d+\.\d+\.\d+\.\d+/)) {$internalip = ''};
|
|
1082
|
$externalip = $externalip || $regnet->{'externalip'};
|
|
1083
|
$ports = $ports || $regnet->{'ports'};
|
|
1084
|
my $reguser = $regnet->{'user'};
|
|
1085
|
# Sanity checks
|
|
1086
|
if (
|
|
1087
|
($name && length $name > 255)
|
|
1088
|
|| ($ports && length $ports > 255)
|
|
1089
|
|| ($type && !($type =~ /gateway|ipmapping|internalip|externalip|remoteip/))
|
|
1090
|
) {
|
|
1091
|
$postreply .= "Stroke=ERROR Bad data: $name, $ports, $type\n";
|
|
1092
|
return $postreply;
|
|
1093
|
}
|
|
1094
|
# Security check
|
|
1095
|
if (($reguser && $username ne $reguser && !$isadmin ) ||
|
|
1096
|
($reguser && $status eq "new"))
|
|
1097
|
{
|
|
1098
|
$postreply .= "Status=Error Bad user: $username ($status)\n";
|
|
1099
|
return $postreply;
|
|
1100
|
}
|
|
1101
|
# Check if remoteip is enabled
|
|
1102
|
if ($type eq 'remoteip' && !$Stabile::remoteipenabled) {
|
|
1103
|
$postreply .= "Status=Error remoteip is not enabled on this engine\n";
|
|
1104
|
return $postreply;
|
|
1105
|
}
|
|
1106
|
my $hit = 0;
|
|
1107
|
# Check if user is allowed to use network
|
|
1108
|
my @regvalues = values %register;
|
|
1109
|
foreach my $val (@regvalues) {
|
|
1110
|
$dbid = $val->{"id"};
|
|
1111
|
$dbuser = $val->{"user"};
|
|
1112
|
if ($dbid == $id && $username ne $dbuser && $dbuser ne "common") {
|
|
1113
|
$hit = 1;
|
|
1114
|
last;
|
|
1115
|
}
|
|
1116
|
}
|
|
1117
|
if ($hit && !$isadmin) { # Network is nogo (unless you are an admin)
|
|
1118
|
$postreply .= "Status=ERROR Network id $id not available\n";
|
|
1119
|
return $postreply;
|
|
1120
|
} elsif (!$type) {
|
|
1121
|
$postreply .= "Status=ERROR Network must have a type\n";
|
|
1122
|
return $postreply;
|
|
1123
|
} elsif ($status eq 'down' || $status eq 'new' || $status eq 'nat') {
|
|
1124
|
# Check if network has been modified or is new
|
|
1125
|
if ($regnet->{'id'} ne $id ||
|
|
1126
|
$regnet->{'name'} ne $name ||
|
|
1127
|
$regnet->{'type'} ne $type ||
|
|
1128
|
$regnet->{'internalip'} ne $internalip ||
|
|
1129
|
$regnet->{'externalip'} ne $externalip ||
|
|
1130
|
$regnet->{'systems'} ne $systems ||
|
|
1131
|
$regnet->{'ports'} ne $ports)
|
|
1132
|
{
|
|
1133
|
if ($type eq "externalip") {
|
|
1134
|
$internalip = "--";
|
|
1135
|
$externalip = getNextExternalIP($externalip, $uuid, 1);
|
|
1136
|
if (!$externalip) {
|
|
1137
|
$postreply .= "Status=ERROR Unable to allocate external proxy IP for $name\n";
|
|
1138
|
$externalip = "--";
|
|
1139
|
$internalip = getNextInternalIP($internalip, $uuid, $id);
|
|
1140
|
$type = "internalip";
|
|
1141
|
} else {
|
|
1142
|
$postreply .= "Status=OK Allocated external IP: $externalip UUID: $uuid\n" unless ($regnet->{'externalip'} eq $externalip);
|
|
1143
|
if ($dodns) {
|
|
1144
|
$main::dnsCreate->($engineid, $externalip, $externalip, 'A', $user);
|
|
1145
|
}
|
|
1146
|
}
|
|
1147
|
|
|
1148
|
} elsif ($type eq "ipmapping") {
|
|
1149
|
$externalip = getNextExternalIP($externalip, $uuid);
|
|
1150
|
if (!$externalip) {
|
|
1151
|
$postreply .= "Status=ERROR Unable to allocate external IP for $name\n";
|
|
1152
|
$externalip = "--";
|
|
1153
|
$type = "internalip";
|
|
1154
|
} else {
|
|
1155
|
$postreply .= "Status=OK Allocated external IP: $externalip\n" unless ($regnet->{'externalip'} eq $externalip);
|
|
1156
|
if ($dodns) {
|
|
1157
|
$postreply .= "Status=OK Trying to register DNS ";
|
|
1158
|
$main::dnsCreate->($engineid, $externalip, $externalip, 'A', $user);
|
|
1159
|
}
|
|
1160
|
}
|
|
1161
|
$internalip = getNextInternalIP($internalip, $uuid, $id);
|
|
1162
|
if (!$internalip) {
|
|
1163
|
$postreply .= "Status=ERROR Unable to allocate internal IP for $name\n";
|
|
1164
|
$internalip = "--";
|
|
1165
|
$type = "gateway";
|
|
1166
|
} else {
|
|
1167
|
$postreply .= "Status=OK Allocated internal IP: $internalip for $name\n" unless ($regnet->{'internalip'} eq $internalip);
|
|
1168
|
}
|
|
1169
|
|
|
1170
|
} elsif ($type eq "remoteip") {
|
|
1171
|
# Check if engine user has been created
|
|
1172
|
my $uid = `id -u irigo-$Stabile::engineuser`; chomp $uid;
|
|
1173
|
if (!$uid) {
|
|
1174
|
$postreply .= "Status=ERROR Local engine user irigo-$Stabile::engineuser has not been created.\n";
|
|
1175
|
$postmsg = "ERROR Local engine user irigo-$Stabile::engineuser has not been created";
|
|
1176
|
} else {
|
|
1177
|
if (!(-e "/home/irigo-$Stabile::engineuser/.ssh/id_rsa.pub")) { # Generate ssh keys if they don't exist
|
|
1178
|
`sudo -u irigo-$Stabile::engineuser ssh-keygen -t rsa -b 4096 -N '' -f "/home/irigo-$Stabile::engineuser/.ssh/id_rsa" -C $Stabile::engineuser`;
|
|
1179
|
my $pubkey = `cat "/home/irigo-$Stabile::engineuser/.ssh/id_rsa.pub"`;
|
|
1180
|
chomp $pubkey;
|
|
1181
|
# Upload public key to origo registry
|
|
1182
|
$postreply .= $main::postToOrigo->($engineid, 'uploadpubkey', $pubkey, 'pubkey');
|
|
1183
|
}
|
|
1184
|
$internalip = getNextInternalIP($internalip, $uuid, $id);
|
|
1185
|
if (!$internalip) {
|
|
1186
|
$postreply .= "Status=ERROR Unable to allocate internal IP for $name\n";
|
|
1187
|
$internalip = "--";
|
|
1188
|
$type = "gateway";
|
|
1189
|
} else {
|
|
1190
|
$postreply .= "Status=OK Allocated internal IP: $internalip for $name\n" unless ($regnet->{'internalip'} eq $internalip);
|
|
1191
|
}
|
|
1192
|
$externalip = getNextRemoteIP($internalip) unless ($externalip && $externalip ne '--' && $regnet->{'externalip'} eq $externalip);
|
|
1193
|
if (!$externalip) {
|
|
1194
|
$postreply .= "Status=ERROR Unable to allocate remote IP $externalip for $name\n";
|
|
1195
|
$postmsg = "Unable to allocate remote IP $externalip for $name";
|
|
1196
|
$externalip = "--";
|
|
1197
|
$type = "internalip";
|
|
1198
|
} else {
|
|
1199
|
$postreply .= "Status=OK Acquired remote IP: $externalip\n" unless ($regnet->{'externalip'} eq $externalip);
|
|
1200
|
if ($dodns) {
|
|
1201
|
$postreply .= "Status=OK Trying to register DNS ";
|
|
1202
|
$main::dnsCreate->($engineid, $externalip, $externalip, 'A', $user);
|
|
1203
|
}
|
|
1204
|
}
|
|
1205
|
}
|
|
1206
|
$ports = "80,443,10001" if ($ports eq '--' || $ports eq '');
|
|
1207
|
|
|
1208
|
} elsif ($type eq "internalip") {
|
|
1209
|
$externalip = "--";
|
|
1210
|
$ports = "--";
|
|
1211
|
my $ointip = $internalip;
|
|
1212
|
$internalip = getNextInternalIP($internalip, $uuid, $id);
|
|
1213
|
if (!$internalip) {
|
|
1214
|
$postreply .= "Status=ERROR Unable to allocate internal IP $internalip ($id, $uuid, $ointip) for $name\n";
|
|
1215
|
$internalip = "--";
|
|
1216
|
$type = "gateway";
|
|
1217
|
} else {
|
|
1218
|
$postreply .= "Status=OK Allocated internal IP: $internalip for $name\n" unless ($regnet->{'internalip'} eq $internalip);
|
|
1219
|
}
|
|
1220
|
|
|
1221
|
} elsif ($type eq "gateway") {
|
|
1222
|
# $internalip = "--";
|
|
1223
|
# $externalip = "--";
|
|
1224
|
# $ports = "--";
|
|
1225
|
} else {
|
|
1226
|
$postreply .= "Status=ERROR Network must have a valid type\n";
|
|
1227
|
return $postreply;
|
|
1228
|
}
|
|
1229
|
# Validate ports
|
|
1230
|
my @portslist = split(/, ?| /, $ports);
|
|
1231
|
if ($ports ne "--") {
|
|
1232
|
foreach my $port (@portslist) {
|
|
1233
|
my $p = $port; # Make a copy of var
|
|
1234
|
if ($p =~ /(\d+\.\d+\.\d+\.\d+):(\d+)/) {
|
|
1235
|
$p = $2;
|
|
1236
|
};
|
|
1237
|
$p = 0 unless ($p =~ /\d+/);
|
|
1238
|
if ($p<1 || $p>65535) {
|
|
1239
|
$postreply .= "Status=ERROR Invalid port mapping for $name\n";
|
|
1240
|
$postmsg = "Invalid port mapping";
|
|
1241
|
if ($type eq "remoteip") {
|
|
1242
|
@portslist = (80,443,10001);
|
|
1243
|
} else {
|
|
1244
|
$ports = "--";
|
|
1245
|
}
|
|
1246
|
last;
|
|
1247
|
}
|
|
1248
|
}
|
|
1249
|
}
|
|
1250
|
if ($ports ne "--") {
|
|
1251
|
$ports = join(',', @portslist);
|
|
1252
|
}
|
|
1253
|
if ($systems ne $regnet->{'systems'}) {
|
|
1254
|
my $regsystems = $regnet->{'systems'};
|
|
1255
|
unless (tie(%sysreg,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access systems register"}|; return $res;};
|
|
1256
|
|
|
1257
|
# Remove existing link to system
|
|
1258
|
if ($sysreg{$regsystems}) {
|
|
1259
|
$sysreg{$regsystems}->{'networkuuids'} =~ s/$uuid,? ?//;
|
|
1260
|
$sysreg{$regsystems}->{'networknames'} = s/$regnet->{'name'},? ?//;
|
|
1261
|
} elsif ($domreg{$regsystems}) {
|
|
1262
|
$domreg{$regsystems}->{'networkuuids'} =~ s/$uuid,? ?//;
|
|
1263
|
$domreg{$regsystems}->{'networknames'} = s/$regnet->{'name'},? ?//;
|
|
1264
|
}
|
|
1265
|
if ($systems) {
|
|
1266
|
if ($sysreg{$systems}) { # Add new link to system
|
|
1267
|
$sysreg{$systems}->{'networkuuids'} .= (($sysreg{$systems}->{'networkuuids'}) ? ',' : '') . $uuid;
|
|
1268
|
$sysreg{$systems}->{'networknames'} .= (($sysreg{$systems}->{'networknames'}) ? ',' : '') . $name;
|
|
1269
|
$systemnames = $sysreg{$systems}->{'name'};
|
|
1270
|
} elsif ($domreg{$systems}) {
|
|
1271
|
$domreg{$systems}->{'networkuuids'} .= (($domreg{$systems}->{'networkuuids'}) ? ',' : '') . $uuid;
|
|
1272
|
$domreg{$systems}->{'networknames'} .= (($domreg{$systems}->{'networknames'}) ? ',' : '') . $name;
|
|
1273
|
$systemnames = $domreg{$systems}->{'name'};
|
|
1274
|
} else {
|
|
1275
|
$systems = '';
|
|
1276
|
}
|
|
1277
|
}
|
|
1278
|
tied(%sysreg)->commit;
|
|
1279
|
untie(%sysreg);
|
|
1280
|
}
|
|
1281
|
|
|
1282
|
$register{$uuid} = {
|
|
1283
|
uuid=>$uuid,
|
|
1284
|
user=>$username,
|
|
1285
|
id=>$id,
|
|
1286
|
name=>$name,
|
|
1287
|
internalip=>$internalip,
|
|
1288
|
externalip=>$externalip,
|
|
1289
|
ports=>$ports,
|
|
1290
|
type=>$type,
|
|
1291
|
systems=>$systems,
|
|
1292
|
systemnames=>$systemnames,
|
|
1293
|
action=>""
|
|
1294
|
};
|
|
1295
|
my $res = tied(%register)->commit;
|
|
1296
|
my $obj = $register{$uuid};
|
|
1297
|
$postreply .= "Status=OK Network $register{$uuid}->{'name'} saved: $uuid\n";
|
|
1298
|
$postreply .= "Status=OK uuid: $uuid\n" if ($console && $status eq 'new');
|
|
1299
|
if ($status eq 'new') {
|
|
1300
|
validateStatus($register{$uuid});
|
|
1301
|
$postmsg = "Created connection $name";
|
|
1302
|
$uiupdatetype = "update";
|
|
1303
|
}
|
|
1304
|
updateBilling("allocate $externalip") if (($type eq "ipmapping" || $type eq "externalip" || $type eq "remoteip") && $externalip && $externalip ne "--");
|
|
1305
|
|
|
1306
|
} else {
|
|
1307
|
$postreply = "Status=OK Network $uuid ($id) unchanged\n";
|
|
1308
|
}
|
|
1309
|
|
|
1310
|
if ($params{'PUTDATA'}) {
|
|
1311
|
my %jitem = %{$register{$uuid}};
|
|
1312
|
my $json_text = to_json(\%jitem);
|
|
1313
|
$json_text =~ s/null/"--"/g;
|
|
1314
|
$json_text =~ s/""/"--"/g;
|
|
1315
|
$postreply = $json_text;
|
|
1316
|
$postmsg = $postmsg || "OK, updated network $name";
|
|
1317
|
}
|
|
1318
|
return $postreply;
|
|
1319
|
|
|
1320
|
} else {
|
|
1321
|
$internalip = '--' unless ($internalip);
|
|
1322
|
$externalip = '--' unless ($externalip);
|
|
1323
|
if ($id ne $regnet->{'id'} ||
|
|
1324
|
$internalip ne $regnet->{'internalip'} || $externalip ne $regnet->{'externalip'}) {
|
|
1325
|
return "Status=ERROR Cannot modify active network: $uuid\n";
|
|
1326
|
} elsif ($name ne $regnet->{'name'}) {
|
|
1327
|
$register{$uuid}->{'name'} = $name;
|
|
1328
|
$postreply .= "Status=OK Network \"$register{$uuid}->{'name'}\" saved: $uuid\n";
|
|
1329
|
if ($params{'PUTDATA'}) {
|
|
1330
|
my %jitem = %{$register{$uuid}};
|
|
1331
|
my $json_text = to_json(\%jitem);
|
|
1332
|
$json_text =~ s/null/"--"/g;
|
|
1333
|
$postreply = $json_text;
|
|
1334
|
$postmsg = "OK, updated network $name";
|
|
1335
|
}
|
|
1336
|
} else {
|
|
1337
|
$postreply .= "Status=OK Nothing to save\n";
|
|
1338
|
if ($params{'PUTDATA'}) {
|
|
1339
|
my %jitem = %{$register{$uuid}};
|
|
1340
|
my $json_text = to_json(\%jitem);
|
|
1341
|
$json_text =~ s/null/"--"/g;
|
|
1342
|
$postreply = $json_text;
|
|
1343
|
}
|
|
1344
|
}
|
|
1345
|
}
|
|
1346
|
return $postreply;
|
|
1347
|
}
|
|
1348
|
|
|
1349
|
sub Activate {
|
|
1350
|
my ($uuid, $action, $obj) = @_;
|
|
1351
|
if ($help) {
|
|
1352
|
return <<END
|
|
1353
|
GET:uuid:
|
|
1354
|
Activate a network which must be in status down or nat.
|
|
1355
|
END
|
|
1356
|
}
|
|
1357
|
$uuid = $obj->{'uuid'} if ($obj->{'uuid'});
|
|
1358
|
$action = 'activate' || $action;
|
|
1359
|
my $regnet = $register{$uuid};
|
|
1360
|
my $id = $regnet->{'id'};
|
|
1361
|
my $name = $regnet->{'name'};
|
|
1362
|
my $type = $regnet->{'type'};
|
|
1363
|
my $status = $regnet->{'status'};
|
|
1364
|
my $domains = $regnet->{'domains'};
|
|
1365
|
my $systems = $regnet->{'systems'};
|
|
1366
|
my $internalip = $regnet->{'internalip'};
|
|
1367
|
my $externalip = $regnet->{'externalip'};
|
|
1368
|
my $ports = $regnet->{'ports'};
|
|
1369
|
my $idleft = ($id>99)?(substr $id,0,-2)+0 : 0;
|
|
1370
|
my $idright = (substr $id,-2) + 0;
|
|
1371
|
my $interfaces = `/sbin/ifconfig`;
|
|
1372
|
my $dom = $domreg{$domains};
|
|
1373
|
my $nicindex = ($dom->{'networkuuid1'} eq $uuid)?1:
|
|
1374
|
($dom->{'networkuuid2'} eq $uuid)?2:
|
|
1375
|
($dom->{'networkuuid3'} eq $uuid)?3:
|
|
1376
|
0;
|
|
1377
|
my $nicmac = $dom->{"nicmac$nicindex"};
|
|
1378
|
my $e;
|
|
1379
|
|
|
1380
|
if (!$id || $id==0 || $id==1 || $id>4095) {
|
|
1381
|
$postreply .= "Status=ERROR Invalid ID activating $type\n";
|
|
1382
|
return $postreply;
|
|
1383
|
} elsif (overQuotas()) { # Enforce quotas
|
|
1384
|
$postreply .= "Status=ERROR Over quota activating $type " . overQuotas() . "\n";
|
|
1385
|
return $postreply;
|
|
1386
|
} elsif (($status ne 'down' && $status ne 'nat')) {
|
|
1387
|
$postreply .= "Status=ERROR Cannot activate $type $name (current status is: $status)\n";
|
|
1388
|
return $postreply;
|
|
1389
|
}
|
|
1390
|
|
|
1391
|
# Check if vlan with $id is created and doing nat, if not create it and create the gateway
|
|
1392
|
unless (-e "/proc/net/vlan/$datanic.$id") {
|
|
1393
|
eval {`/sbin/vconfig add $datanic $id`;} or do {$e=1; $postreply .= "Status=ERROR Problem adding vlan $datanic.$id $@\n"; return $postreply;};
|
|
1394
|
eval {`/sbin/ifconfig $datanic.$id up`;}# or do {$e=1; $postreply .= "Status=ERROR Problem activating vlan $datanic.$id $@\n"; return $postreply;};
|
|
1395
|
}
|
|
1396
|
# if (!($interfaces =~ m/$datanic\.$id /)) {
|
|
1397
|
if (!($interfaces =~ m/br$id /)) {
|
|
1398
|
# check if gw is created locally
|
|
1399
|
unless (`arping -C1 -c2 -D -I $datanic.$id 10.$idleft.$idright.1` =~ /reply from/) { # check if gw is created on another engine
|
|
1400
|
# Create gw
|
|
1401
|
# eval {`/sbin/ifconfig $datanic.$id 10.$idleft.$idright.1 netmask 255.255.255.0 broadcast 10.$idleft.$idright.255 up`; 1;} or do {
|
|
1402
|
# $e=1; $postreply .= "Status=ERROR $@\n"; return $postreply;
|
|
1403
|
# };
|
|
1404
|
# To support local instances on valve, gw is now created as a bridge
|
|
1405
|
eval {`/sbin/brctl addbr br$id`; 1;} or do {$e=1; $postreply .= "Status=ERROR $@\n"; return $postreply; };
|
|
1406
|
eval {`/sbin/brctl addif br$id $datanic.$id`; 1;} or do {$e=1; $postreply .= "Status=ERROR $@\n"; return $postreply; };
|
|
1407
|
eval {`/sbin/ifconfig br$id 10.$idleft.$idright.1/24 up`; 1;} or do {
|
|
1408
|
$e=1; $postreply .= "Status=ERROR $@\n"; return $postreply; }
|
|
1409
|
} else {
|
|
1410
|
$postreply .= "Status=OK GW is active on another Engine, assuming this is OK\n";
|
|
1411
|
}
|
|
1412
|
}
|
|
1413
|
my $astatus = "nat" unless ($e);
|
|
1414
|
`/usr/bin/touch $etcpath/dhcp-hosts-$id` unless (-e "$etcpath/dhcp-hosts-$id");
|
|
1415
|
if ($action eq "activate") { #} && $domains) {
|
|
1416
|
if ($type eq "internalip" || $type eq "ipmapping" || $type eq "remoteip") {
|
|
1417
|
# Configure internal dhcp server
|
|
1418
|
if ($domains) {
|
|
1419
|
my $result = addDHCPAddress($id, $domains, $internalip, "10.$idleft.$idright.1", $nicmac);
|
|
1420
|
if ($result eq "OK") {
|
|
1421
|
$astatus = "up" if ($type eq "internalip");
|
|
1422
|
} else {
|
|
1423
|
$e = 1;
|
|
1424
|
$postreply .= "$result\n";
|
|
1425
|
}
|
|
1426
|
}
|
|
1427
|
|
|
1428
|
# Also export storage pools to user's network
|
|
1429
|
my @spl = split(/,\s*/, $storagepools);
|
|
1430
|
my $reloadnfs;
|
|
1431
|
my $uid = `id -u irigo-$user`; chomp $uid;
|
|
1432
|
$uid = `id -u nobody` unless ($uid =~ /\d+/); chomp $uid;
|
|
1433
|
my $gid = `id -g irigo-$user`; chomp $gid;
|
|
1434
|
$gid = `id -g nobody` unless ($gid =~ /\d+/); chomp $gid;
|
|
1435
|
|
|
1436
|
# We are dealing with multiple upstream routes - configure local routing
|
|
1437
|
if ($proxynic && $proxynic ne $extnic) {
|
|
1438
|
if (-e "/etc/iproute2/rt_tables" && !grep(/1 proxyarp/, `cat /etc/iproute2/rt_tables`)) {
|
|
1439
|
`/bin/echo "1 proxyarp" >> /etc/iproute2/rt_tables`;
|
|
1440
|
}
|
|
1441
|
if (!grep(/$datanic\.$id/, `/sbin/ip route show table proxyarp`)) {
|
|
1442
|
`/sbin/ip route add "10.$idleft.$idright.0/24" dev $datanic.$id table proxyarp`;
|
|
1443
|
}
|
|
1444
|
}
|
|
1445
|
|
|
1446
|
# Manuipulate NFS exports and related disk quotas.
|
|
1447
|
# Not needed for externalip's since they dont have access to the internal 10.x.x.x address space
|
|
1448
|
foreach my $p (@spl) {
|
|
1449
|
if ($tenderlist[$p] && $tenderpathslist[$p]) {
|
|
1450
|
my $fuelpath = $tenderpathslist[$p] . "/$user/fuel";
|
|
1451
|
unless (-e $fuelpath) {
|
|
1452
|
if ($tenderlist[$p] eq 'local') { # We only support fuel on local tender for now
|
|
1453
|
`mkdir "$fuelpath"`;
|
|
1454
|
`chmod 777 "$fuelpath"`;
|
|
1455
|
}
|
|
1456
|
}
|
|
1457
|
if ($tenderlist[$p] eq "local") {
|
|
1458
|
`chown irigo-$user:irigo-$user "$fuelpath"`;
|
|
1459
|
my $mpoint = `df -P "$fuelpath" | tail -1 | cut -d' ' -f 1`;
|
|
1460
|
chomp $mpoint;
|
|
1461
|
my $storagequota = $Stabile::userstoragequota;
|
|
1462
|
if (!$storagequota) {
|
|
1463
|
$storagequota = $Stabile::config->get('STORAGE_QUOTA');
|
|
1464
|
}
|
|
1465
|
my $nfsquota = $storagequota * 1024 ; # quota is in MB
|
|
1466
|
$nfsquota = 0 if ($nfsquota < 0); # quota of -1 means no limit
|
|
1467
|
`setquota -u irigo-$user $nfsquota $nfsquota 0 0 "$mpoint"` if (-e "$mntpoint");
|
|
1468
|
if (!(`grep "$fuelpath 10\.$idleft\.$idright" /etc/exports`) && -e $fuelpath) {
|
|
1469
|
`echo "$fuelpath 10.$idleft.$idright.0/255.255.255.0(sync,no_subtree_check,all_squash,rw,anonuid=$uid,anongid=$gid)" >> /etc/exports`;
|
|
1470
|
$reloadnfs = 1;
|
|
1471
|
}
|
|
1472
|
}
|
|
1473
|
}
|
|
1474
|
}
|
|
1475
|
`/usr/sbin/exportfs -r` if ($reloadnfs); #Reexport nfs shares
|
|
1476
|
|
|
1477
|
} elsif ($type eq "externalip") {
|
|
1478
|
# A proxy is needed to route traffic, don't go any further if not configured
|
|
1479
|
if ($proxyip) {
|
|
1480
|
# Set up proxy
|
|
1481
|
if (!($interfaces =~ m/$proxyip/ && $interfaces =~ m/br$id:proxy/)) {
|
|
1482
|
eval {`/sbin/ifconfig br$id:proxy $proxyip/$proxysubnet up`; 1;}
|
|
1483
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up proxy arp gw $proxyip on br$id:proxy $@\n";};
|
|
1484
|
eval {`/sbin/ifconfig $proxynic:proxy $proxyip/$proxysubnet up`; 1;}
|
|
1485
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up proxy arp gw $proxynic $@\n";};
|
|
1486
|
}
|
|
1487
|
my $result = "OK";
|
|
1488
|
# Configure dhcp server
|
|
1489
|
if ($domains) {
|
|
1490
|
$result = addDHCPAddress($id, $domains, $externalip, "10.$idleft.$idright.1", $nicmac) if ($domains);
|
|
1491
|
if ($result eq "OK") {
|
|
1492
|
;
|
|
1493
|
} else {
|
|
1494
|
$e = 1;
|
|
1495
|
$postreply .= "$result\n";
|
|
1496
|
}
|
|
1497
|
}
|
|
1498
|
} else {
|
|
1499
|
$postreply .= "Status=ERROR Cannot set up external IP without Proxy ARP gateway\n";
|
|
1500
|
}
|
|
1501
|
}
|
|
1502
|
|
|
1503
|
# Handle routing with Iptables
|
|
1504
|
if ($type eq "ipmapping" || $type eq "internalip" || $type eq "remoteip") {
|
|
1505
|
`iptables -I FORWARD -d $internalip -m state --state ESTABLISHED,RELATED -j RETURN`;
|
|
1506
|
}
|
|
1507
|
# Check if external ip exists and routing configured, if not create and configure it
|
|
1508
|
if ($type eq "ipmapping") {
|
|
1509
|
if ($internalip && $internalip ne "--" && $externalip && $externalip ne "--" && !($interfaces =~ m/$externalip /g)) { # the space is important
|
|
1510
|
$externalip =~ /\d+\.\d+\.(\d+)\.(\d+)/;
|
|
1511
|
my $ipend = "$1$2"; # Linux NIC names are limited to 15 chars - we will have to find a way to support long NIC names and bigger than /24 subnets
|
|
1512
|
$ipend = $2 if (length("$extnic:$id-$ipend")>15);
|
|
1513
|
eval {`/sbin/ifconfig $extnic:$id-$ipend $externalip/$extsubnet up`; 1;}
|
|
1514
|
or do {$e=1; $postreply .= "Status=ERROR Problem adding interface $extnic:$id-$ipend $@\n";};
|
|
1515
|
unless (`ip addr show dev $extnic` =~ /$externalip/) {
|
|
1516
|
$e=10;
|
|
1517
|
$postreply .= "Status=ERROR Problem adding interface $extnic:$id-$ipend\n";
|
|
1518
|
}
|
|
1519
|
# `/sbin/iptables -A POSTROUTING -t nat -s $internalip -j LOG --log-prefix "SNAT-POST"`;
|
|
1520
|
# `/sbin/iptables -A INPUT -t nat -s $internalip -j LOG --log-prefix "SNAT-INPUT"`;
|
|
1521
|
# `/sbin/iptables -A OUTPUT -t nat -s $internalip -j LOG --log-prefix "SNAT-OUTPUT"`;
|
|
1522
|
# `/sbin/iptables -A PREROUTING -t nat -s $internalip -j LOG --log-prefix "SNAT-PRE"`;
|
|
1523
|
if ($ports && $ports ne "--") { # Port mapping is defined
|
|
1524
|
my @portslist = split(/, ?| /, $ports);
|
|
1525
|
foreach my $port (@portslist) {
|
|
1526
|
my $ipfilter;
|
|
1527
|
if ($port =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(\/\d+)?:(\d+)/) {
|
|
1528
|
my $portip = "$1.$2.$3.$4$5";
|
|
1529
|
$port = $6;
|
|
1530
|
$ipfilter = "-s $portip";
|
|
1531
|
} else {
|
|
1532
|
$port = 0 unless ($port =~ /\d+/);
|
|
1533
|
}
|
|
1534
|
if ($port<1 || $port>65535) {
|
|
1535
|
$postreply .= "Status=ERROR Invalid port mapping for $name\n";
|
|
1536
|
$ports = "--";
|
|
1537
|
last;
|
|
1538
|
}
|
|
1539
|
if ($port>1 || $port<65535) {
|
|
1540
|
# DNAT externalip -> internalip
|
|
1541
|
eval {`/sbin/iptables -A PREROUTING -t nat -p tcp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`; 1;}
|
|
1542
|
or do {$e=2; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1543
|
eval {`/sbin/iptables -A PREROUTING -t nat -p udp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`; 1;}
|
|
1544
|
or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1545
|
# PREROUTING is not parsed for packets coming from local host...
|
|
1546
|
eval {`/sbin/iptables -A OUTPUT -t nat -p tcp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`; 1;}
|
|
1547
|
or do {$e=2; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1548
|
eval {`/sbin/iptables -A OUTPUT -t nat -p udp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`; 1;}
|
|
1549
|
or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1550
|
# Allow access to ipmapped internal ip on $port
|
|
1551
|
`iptables -I FORWARD -d $internalip -p tcp --dport $port -j RETURN`;
|
|
1552
|
`iptables -I FORWARD -d $internalip -p udp --dport $port -j RETURN`;
|
|
1553
|
}
|
|
1554
|
}
|
|
1555
|
eval {`/sbin/iptables -D INPUT -d $externalip -j DROP`; 1;} # Drop traffic to all other ports
|
|
1556
|
or do {$e=5; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1557
|
eval {`/sbin/iptables -A INPUT -d $externalip -j DROP`; 1;} # Drop traffic to all other ports
|
|
1558
|
or do {$e=6; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1559
|
} else {
|
|
1560
|
# DNAT externalip -> internalip coming from outside , --in-interface $extnic
|
|
1561
|
eval {`/sbin/iptables -A PREROUTING -t nat -d $externalip -j DNAT --to $internalip`; 1;}
|
|
1562
|
or do {$e=7; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1563
|
# PREROUTING is not parsed for packets coming from local host...
|
|
1564
|
eval {`/sbin/iptables -A OUTPUT -t nat -d $externalip -j DNAT --to $internalip`; 1;}
|
|
1565
|
or do {$e=7; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1566
|
# Allow blanket access to ipmapped internal ip
|
|
1567
|
`iptables -I FORWARD -d $internalip -j RETURN`;
|
|
1568
|
}
|
|
1569
|
# We masquerade packets going to internalip from externalip to avoid confusion
|
|
1570
|
#eval {`/sbin/iptables -A POSTROUTING -t nat --out-interface br$id -s $externalip -j MASQUERADE`; 1;}
|
|
1571
|
# or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1572
|
|
|
1573
|
# Masquerade packets from internal ip's not going to our own subnet
|
|
1574
|
# `/sbin/iptables -D POSTROUTING -t nat --out-interface br$id ! -d 10.$idleft.$idright.0/24 -j MASQUERADE`;
|
|
1575
|
#eval {`/sbin/iptables -A POSTROUTING -t nat --out-interface br$id ! -d 10.$idleft.$idright.0/24 -j MASQUERADE`; 1;}
|
|
1576
|
# or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1577
|
|
|
1578
|
# When receiving packet from client, if it's been routed, and outgoing interface is the external interface, SNAT.
|
|
1579
|
unless ($Stabile::disablesnat) {
|
|
1580
|
eval {`/sbin/iptables -A POSTROUTING -t nat -s $internalip ! -d 10.$idleft.$idright.0/24 -j SNAT --to-source $externalip`; 1; }
|
|
1581
|
or do {$e=4; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1582
|
# eval {`/sbin/iptables -A POSTROUTING -t nat -s $internalip -j SNAT --to-source $externalip`; 1; }
|
|
1583
|
# or do {$e=4; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1584
|
eval {`/sbin/iptables -I INPUT -t nat -s $internalip ! -d 10.$idleft.$idright.0/24 -j SNAT --to-source $externalip`; 1; }
|
|
1585
|
or do {$e=4; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1586
|
# eval {`/sbin/iptables -I INPUT -t nat -s $internalip -j SNAT --to-source $externalip`; 1; }
|
|
1587
|
# or do {$e=4; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1588
|
}
|
|
1589
|
if ($e) {
|
|
1590
|
$main::syslogit->($user, 'info', "Problem $action network $uuid ($name, $id): $@");
|
|
1591
|
} else {
|
|
1592
|
$astatus = "up"
|
|
1593
|
}
|
|
1594
|
}
|
|
1595
|
} elsif ($type eq "remoteip") {
|
|
1596
|
if ($Stabile::remoteipenabled && -e "/home/irigo-$Stabile::engineuser/.ssh/id_rsa") {
|
|
1597
|
# First activate the ip on remoteipprovider
|
|
1598
|
my $res = $main::postToOrigo->($engineid, 'activateremoteip', "$externalip:$internalip", 'remotelocalip');
|
|
1599
|
my $res_obj = JSON::from_json($res);
|
|
1600
|
my $pid = '--';
|
|
1601
|
my @remoteports = (80, 443, 10001);
|
|
1602
|
my $rports;
|
|
1603
|
if ($ports && $ports ne "--") {
|
|
1604
|
# Port mapping is defined
|
|
1605
|
my @portslist = split(/, ?| /, $ports);
|
|
1606
|
@remoteports = ();
|
|
1607
|
foreach my $port (@portslist) {
|
|
1608
|
if ($port =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(\/\d+)?:(\d+)/) {
|
|
1609
|
my $portip = "$1.$2.$3.$4$5";
|
|
1610
|
$port = $6;
|
|
1611
|
} else {
|
|
1612
|
$port = 0 unless ($port =~ /\d+/);
|
|
1613
|
}
|
|
1614
|
if ($port < 1 || $port > 65535) {
|
|
1615
|
$postreply .= "Status=ERROR Invalid port mapping for $name\n";
|
|
1616
|
$ports = "--";
|
|
1617
|
last;
|
|
1618
|
}
|
|
1619
|
if ($port > 1 || $port < 65535) {
|
|
1620
|
push @remoteports, $port;
|
|
1621
|
}
|
|
1622
|
}
|
|
1623
|
}
|
|
1624
|
foreach my $port (@remoteports) {
|
|
1625
|
$rports .= "-R $externalip:$port:$internalip:$port ";
|
|
1626
|
}
|
|
1627
|
if ($res_obj->{status} eq 'OK') {
|
|
1628
|
# my $cmd = qq|ssh -fN -i /home/irigo-$Stabile::engineuser/.ssh/id_rsa -o "StrictHostKeyChecking=no" -o "UserKnownHostsFile=/dev/null" -o "ExitOnForwardFailure=yes" -R $externalip:10001:$internalip:10001 -R $externalip:80:$internalip:80 -R $externalip:443:$internalip:443 $Stabile::remoteipprovider|;
|
|
1629
|
my $cmd = qq|ssh -fN -i /home/irigo-$Stabile::engineuser/.ssh/id_rsa -o "StrictHostKeyChecking=no" -o "UserKnownHostsFile=/dev/null" -o "ExitOnForwardFailure=yes" $rports $Stabile::remoteipprovider|;
|
|
1630
|
eval {
|
|
1631
|
my $daemon = Proc::Daemon->new(
|
|
1632
|
work_dir => '/home/irigo-o@origo.io',
|
|
1633
|
exec_command => "$cmd"
|
|
1634
|
) or do {$postreply .= "Status=ERROR $@";};
|
|
1635
|
$pid = $daemon->Init();
|
|
1636
|
$main::syslogit->($user, "info", "Activating remote ip $externalip at $Stabile::remoteipprovider for $Stabile::engineuser, pid=$pid");
|
|
1637
|
1;
|
|
1638
|
} or do {$e=4; $postreply .= "Status=ERROR Problem activating remote ip $@\n";};
|
|
1639
|
# sleep 1;
|
|
1640
|
} else {
|
|
1641
|
$postreply .= "Status=Error $res_obj->{message}\n";
|
|
1642
|
}
|
|
1643
|
if ($e || !(-e "/proc/$pid")) {
|
|
1644
|
$main::syslogit->($user, 'info', "Problem $action network $uuid ($e, $name, $id): $@");
|
|
1645
|
$astatus = $status;
|
|
1646
|
$postreply .= "Status=OK Waiting to establish remote connetion\n";
|
|
1647
|
} else {
|
|
1648
|
$astatus = "up"
|
|
1649
|
}
|
|
1650
|
}
|
|
1651
|
} elsif ($type eq "externalip") {
|
|
1652
|
my $route = `/sbin/ip route`;
|
|
1653
|
my $tables = `/sbin/iptables -L -n`;
|
|
1654
|
|
|
1655
|
# Allow external IP send packets out
|
|
1656
|
`/sbin/iptables -D FORWARD --in-interface br$id -s $externalip -j RETURN`;
|
|
1657
|
`/sbin/iptables -I FORWARD --in-interface br$id -s $externalip -j RETURN`;
|
|
1658
|
|
|
1659
|
# We are dealing with multiple upstream routes - configure local routing
|
|
1660
|
if ($proxynic && ($proxynic ne $extnic)) {
|
|
1661
|
if (-e "/etc/iproute2/rt_tables" && !grep(/1 proxyarp/, `cat /etc/iproute2/rt_tables`)) {
|
|
1662
|
`/bin/echo "1 proxyarp" >> /etc/iproute2/rt_tables`;
|
|
1663
|
}
|
|
1664
|
if (!grep(/$proxygw/, `/sbin/ip route show table proxyarp`)) {
|
|
1665
|
`/sbin/ip route del default dev $proxynic table proxyarp`; # delete first in case proxygw has changed
|
|
1666
|
`/sbin/ip route add default via $proxygw dev $proxynic table proxyarp`;
|
|
1667
|
}
|
|
1668
|
if (!grep(/proxyarp/, `/sbin/ip rule show`)) {
|
|
1669
|
`/sbin/ip rule add to $proxygw/$proxysubnet table main`;
|
|
1670
|
`/sbin/ip rule add from $proxygw/$proxysubnet table proxyarp`;
|
|
1671
|
}
|
|
1672
|
my $proxyroute = `/sbin/ip route show table proxyarp`;
|
|
1673
|
# `/sbin/ip route add $externalip/32 dev $datanic.$id:proxy src $proxyip table proxyarp` unless ($proxyroute =~ /$externalip/);
|
|
1674
|
`/sbin/ip route add $externalip/32 dev br$id:proxy src $proxyip table proxyarp` unless ($proxyroute =~ /$externalip/);
|
|
1675
|
}
|
|
1676
|
eval {`/bin/echo 1 > /proc/sys/net/ipv4/conf/$datanic.$id/proxy_arp`; 1;}
|
|
1677
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up proxy arp $@\n";};
|
|
1678
|
eval {`/bin/echo 1 > /proc/sys/net/ipv4/conf/$proxynic/proxy_arp`; 1;}
|
|
1679
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up proxy arp $@\n";};
|
|
1680
|
eval {`/sbin/ip route add $externalip/32 dev br$id:proxy src $proxyip` unless ($route =~ /$externalip/); 1;}
|
|
1681
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up proxy arp $@\n";};
|
|
1682
|
|
|
1683
|
eval {`/sbin/iptables -D FORWARD -i $proxynic -d $externalip -m state --state ESTABLISHED,RELATED -j RETURN`; 1;}
|
|
1684
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1685
|
eval {`/sbin/iptables -A FORWARD -i $proxynic -d $externalip -m state --state ESTABLISHED,RELATED -j RETURN`; 1;}
|
|
1686
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1687
|
|
|
1688
|
|
|
1689
|
eval {`/sbin/iptables -D FORWARD -i $proxynic -d $externalip -j REJECT` if
|
|
1690
|
($tables =~ /REJECT .+ all .+ $externalip/); 1;}
|
|
1691
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1692
|
|
|
1693
|
if ($ports && $ports ne "--") {
|
|
1694
|
my @portslist = split(/, ?| /, $ports);
|
|
1695
|
foreach $port (@portslist) {
|
|
1696
|
my $ipfilter;
|
|
1697
|
if ($port =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(\/\d+)?:(\d+)/) {
|
|
1698
|
my $portip = "$1.$2.$3.$4$5";
|
|
1699
|
$port = $6;
|
|
1700
|
$ipfilter = "-s $portip";
|
|
1701
|
} else {
|
|
1702
|
$port = 0 unless ($port =~ /\d+/);
|
|
1703
|
}
|
|
1704
|
if ($port<1 || $port>65535) {
|
|
1705
|
$postreply .= "Status=ERROR Invalid port mapping for $name\n";
|
|
1706
|
$ports = "--";
|
|
1707
|
last;
|
|
1708
|
}
|
|
1709
|
|
|
1710
|
if ($port>1 && $port<65535 && $port!=67) { # Disallow setting up a dhcp server
|
|
1711
|
eval {`/sbin/iptables -A FORWARD -p tcp -i $proxynic $portfilter -d $externalip --dport $port -j RETURN`; 1;}
|
|
1712
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1713
|
eval {`/sbin/iptables -A FORWARD -p udp -i $proxynic $portfilter -d $externalip --dport $port -j RETURN`; 1;}
|
|
1714
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1715
|
}
|
|
1716
|
}
|
|
1717
|
eval {`/sbin/iptables -D FORWARD -i $proxynic -d $externalip -j REJECT`; 1;} # Drop traffic to all other ports
|
|
1718
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1719
|
eval {`/sbin/iptables -A FORWARD -i $proxynic -d $externalip -j REJECT`; 1;} # Drop traffic to all other ports
|
|
1720
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1721
|
} else {
|
|
1722
|
# First allow everything else to this ip
|
|
1723
|
eval {`/sbin/iptables -D FORWARD -i $proxynic -d $externalip -j RETURN`; 1;}
|
|
1724
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1725
|
eval {`/sbin/iptables -A FORWARD -i $proxynic -d $externalip -j RETURN`; 1;}
|
|
1726
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1727
|
# Then disallow setting up a dhcp server
|
|
1728
|
eval {`/sbin/iptables -D FORWARD -p udp -i $proxynic -d $externalip --dport 67 -j REJECT`; 1;}
|
|
1729
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1730
|
eval {`/sbin/iptables -A FORWARD -p udp -i $proxynic -d $externalip --dport 67 -j REJECT`; 1;}
|
|
1731
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1732
|
}
|
|
1733
|
}
|
|
1734
|
}
|
|
1735
|
|
|
1736
|
# Allow all inter-VLAN communication
|
|
1737
|
`iptables -D FORWARD --in-interface br$id --out-interface br$id -j RETURN 2>/dev/null`;
|
|
1738
|
`iptables -I FORWARD --in-interface br$id --out-interface br$id -j RETURN`;
|
|
1739
|
# Disallow any access to vlan except mapped from external NIC i.e. ipmappings
|
|
1740
|
`iptables -D FORWARD ! --in-interface $extnic --out-interface br$id -j DROP 2>/dev/null`;
|
|
1741
|
`iptables -A FORWARD ! --in-interface $extnic --out-interface br$id -j DROP`;
|
|
1742
|
|
|
1743
|
# Only forward packets coming from subnet assigned to vlan unless we are setting up a gateway on the proxy nic and the proxy nic is on a vlan
|
|
1744
|
# `/sbin/iptables --delete FORWARD --in-interface $datanic.$id ! -s 10.$idleft.$idright.0/24 -j DROP`;
|
|
1745
|
unless ($proxynic eq "$datanic.$id") {
|
|
1746
|
# `/sbin/iptables --append FORWARD --in-interface $datanic.$id ! -s 10.$idleft.$idright.0/24 -j DROP`;
|
|
1747
|
}
|
|
1748
|
|
|
1749
|
# Enable nat'ing
|
|
1750
|
eval {
|
|
1751
|
#my $masq = `/sbin/iptables -L -n -t nat`;
|
|
1752
|
# if (!($masq =~ "MASQUERADE.+all.+--.+0\.0\.0\.0/0")) {
|
|
1753
|
`/sbin/iptables -D POSTROUTING -t nat --out-interface $extnic -s 10.0.0.0/8 -j MASQUERADE`;
|
|
1754
|
`/sbin/iptables -A POSTROUTING -t nat --out-interface $extnic -s 10.0.0.0/8 -j MASQUERADE`;
|
|
1755
|
# Christian's dev environment
|
|
1756
|
# my $interfaces = `/sbin/ifconfig`;
|
|
1757
|
# if ($interfaces =~ m/ppp0/) {
|
|
1758
|
# `/sbin/iptables --table nat --append POSTROUTING --out-interface ppp0 -s 10.0.0.0/8 -j MASQUERADE`;
|
|
1759
|
# }
|
|
1760
|
# };
|
|
1761
|
1;
|
|
1762
|
} or do {print "Unable to enable masquerading: $@\n";};
|
|
1763
|
|
|
1764
|
$uistatus = ($e)?"":validateStatus($register{$uuid});
|
|
1765
|
if ($uistatus && $uistatus ne 'down' && $uistatus ne 'nat') {
|
|
1766
|
$uiuuid = $uuid;
|
|
1767
|
$postreply .= "Status=$uistatus OK $action $type $name\n";
|
|
1768
|
} else {
|
|
1769
|
$postreply .= "Status=ERROR Cannot $action $type $name ($uistatus)\n";
|
|
1770
|
}
|
|
1771
|
$main::syslogit->($user, 'info', "$action network $uuid ($name, $id) -> $uistatus");
|
|
1772
|
updateBilling("$uistatus $uuid ($id)");
|
|
1773
|
# $main::updateUI->({tab=>"networks", user=>$user, uuid=>$uiuuid, status=>$uistatus}) if ($uistatus);
|
|
1774
|
return $postreply;
|
|
1775
|
}
|
|
1776
|
|
|
1777
|
sub Removeusernetworks {
|
|
1778
|
my $username = shift;
|
|
1779
|
return unless (($isadmin || $user eq $username) && !$isreadonly);
|
|
1780
|
$user = $username;
|
|
1781
|
foreach my $uuid (keys %register) {
|
|
1782
|
if ($register{$uuid}->{'user'} eq $user) {
|
|
1783
|
$postreply .= "Removing network $register{$uuid}->{'name'}, $uuid" . ($console?'':'<br>') . "\n";
|
|
1784
|
Deactivate($uuid);
|
|
1785
|
Remove($uuid, 'remove');
|
|
1786
|
}
|
|
1787
|
}
|
|
1788
|
}
|
|
1789
|
|
|
1790
|
sub Remove {
|
|
1791
|
my ($uuid, $action, $obj) = @_;
|
|
1792
|
if ($help) {
|
|
1793
|
return <<END
|
|
1794
|
DELETE:uuid,force:
|
|
1795
|
Delete a network which must be in status down or nat and should not be used by any servers, or linked to any stacks.
|
|
1796
|
May also be called with endpoints "/stabile/[uuid]" or "/stabile?uuid=[uuid]"
|
|
1797
|
Set [force] to remove even if linked to a system.
|
|
1798
|
END
|
|
1799
|
}
|
|
1800
|
$uuid = $obj->{'uuid'} if ($curuuid && $obj->{'uuid'}); # we are called from a VM with an ip address as target
|
|
1801
|
my $force = $obj->{'force'};
|
|
1802
|
( my $domains, my $domainnames ) = getDomains($uuid);
|
|
1803
|
( my $systems, my $systemnames ) = getSystems($uuid);
|
|
1804
|
|
|
1805
|
if ($register{$uuid}) {
|
|
1806
|
my $id = $register{$uuid}->{'id'};
|
|
1807
|
my $name = $register{$uuid}->{'name'};
|
|
1808
|
utf8::decode($name);
|
|
1809
|
my $status = $register{$uuid}->{'status'};
|
|
1810
|
my $type = $register{$uuid}->{'type'};
|
|
1811
|
my $internalip = $register{$uuid}->{'internalip'};
|
|
1812
|
my $externalip = $register{$uuid}->{'externalip'};
|
|
1813
|
|
|
1814
|
my @regvalues = values %register;
|
|
1815
|
if (
|
|
1816
|
$id!=0 && $id!=1 && (!$domains || $domains eq '--')
|
|
1817
|
&& ((!$systems || $systems eq '--' || $force)
|
|
1818
|
# allow internalip's to be removed if active and only linked, i.e. not providing dhcp
|
|
1819
|
|| ($status eq 'down' || $status eq 'new' || $status eq 'nat' || ($type eq 'internalip' && $systems && $systems ne '--')))
|
|
1820
|
) {
|
|
1821
|
# Deconfigure internal dhcp server and DNS
|
|
1822
|
if ($type eq "internalip") {
|
|
1823
|
my $result = removeDHCPAddress($id, $domains, $internalip);
|
|
1824
|
$postreply .= "$result\n" unless $result eq "OK";
|
|
1825
|
} elsif ($type eq "ipmapping") {
|
|
1826
|
my $result = removeDHCPAddress($id, $domains, $internalip);
|
|
1827
|
$postreply .= "$result\n" unless $result eq "OK";
|
|
1828
|
if ($dodns) {
|
|
1829
|
$main::dnsDelete->($engineid, $externalip) if ($enginelinked);
|
|
1830
|
}
|
|
1831
|
} elsif ($type eq "externalip" || $type eq "remoteip") {
|
|
1832
|
my $result = removeDHCPAddress($id, $domains, $externalip);
|
|
1833
|
$postreply .= "$result\n" unless $result eq "OK";
|
|
1834
|
if ($dodns) {
|
|
1835
|
$main::dnsDelete->($engineid, $externalip) if ($enginelinked);
|
|
1836
|
}
|
|
1837
|
# Deactivate the ip on remoteipprovider
|
|
1838
|
my $res = $main::postToOrigo->($engineid, 'removeremoteip', "$externalip", 'remoteip');
|
|
1839
|
my $res_obj = JSON::from_json($res);
|
|
1840
|
if ($res_obj->{status} ne 'OK') {
|
|
1841
|
$postreply .= "Status=OK There was a problem removing the remote IP\n";
|
|
1842
|
}
|
|
1843
|
}
|
|
1844
|
if ($status eq 'nat') {
|
|
1845
|
# Check if last network in vlan. If so take it down
|
|
1846
|
my $notlast;
|
|
1847
|
foreach my $val (@regvalues) {
|
|
1848
|
if ($val->{'user'} eq $user && $val->{'id'} == $id) {
|
|
1849
|
$notlast = 1;
|
|
1850
|
}
|
|
1851
|
}
|
|
1852
|
if (!$notlast) {
|
|
1853
|
eval {`/sbin/ifconfig $datanic.$id down`; 1;} or do {;};
|
|
1854
|
eval {`/sbin/vconfig rem $datanic.$id`; 1;} or do {;};
|
|
1855
|
}
|
|
1856
|
}
|
|
1857
|
|
|
1858
|
unless (tie(%sysreg,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access systems register"}|; return $res;};
|
|
1859
|
if ($sysreg{$systems}) { # Remove existing link to system
|
|
1860
|
$sysreg{$systems}->{'networkuuids'} =~ s/$uuid,?//;
|
|
1861
|
$sysreg{$systems}->{'networknames'} = s/$name,?//;
|
|
1862
|
}
|
|
1863
|
tied(%sysreg)->commit;
|
|
1864
|
untie(%sysreg);
|
|
1865
|
|
|
1866
|
|
|
1867
|
delete $register{$uuid};
|
|
1868
|
tied(%register)->commit;
|
|
1869
|
updateBilling("delete $val->{'externalip'}") if ($type eq "ipmapping");
|
|
1870
|
$main::syslogit->($user, "info", "Deleted network $uuid ($id)");
|
|
1871
|
$postreply = "[]" || $postreply;
|
|
1872
|
$main::updateUI->({tab=>"networks", user=>$user, type=>"update"});
|
|
1873
|
} else {
|
|
1874
|
$postreply .= "Status=ERROR Cannot remove $uuid which is $status. Cannot delete network 0,1 or a network which is active or in use.\n";
|
|
1875
|
$main::updateUI->({tab=>"networks", user=>$user, message=>"Cannot remove a network which is active, linked or in use."});
|
|
1876
|
}
|
|
1877
|
} else {
|
|
1878
|
$postreply .= "Status=ERROR Network $uuid $ipaddress not found\n";
|
|
1879
|
}
|
|
1880
|
return $postreply;
|
|
1881
|
}
|
|
1882
|
|
|
1883
|
sub Deactivate {
|
|
1884
|
my ($uuid, $action, $obj) = @_;
|
|
1885
|
|
|
1886
|
if ($help) {
|
|
1887
|
return <<END
|
|
1888
|
GET:uuid:
|
|
1889
|
Deactivate a network which must be in status up.
|
|
1890
|
END
|
|
1891
|
}
|
|
1892
|
$uuid = $obj->{'uuid'} if ($obj->{'uuid'});
|
|
1893
|
|
|
1894
|
unless ($register{$uuid}) {
|
|
1895
|
$postreply .= "Status=ERROR Connection with uuid $uuid not found\n";
|
|
1896
|
return $postreply;
|
|
1897
|
}
|
|
1898
|
my $regnet = $register{$uuid};
|
|
1899
|
|
|
1900
|
$action = $action || 'deactivate';
|
|
1901
|
( my $domains, my $domainnames ) = getDomains($uuid);
|
|
1902
|
my $interfaces = `/sbin/ifconfig`;
|
|
1903
|
|
|
1904
|
my $id = $regnet->{'id'};
|
|
1905
|
my $name = $regnet->{'name'};
|
|
1906
|
my $type = $regnet->{'type'};
|
|
1907
|
my $internalip = $regnet->{'internalip'};
|
|
1908
|
my $externalip = $regnet->{'externalip'};
|
|
1909
|
my $ports = $regnet->{'ports'};
|
|
1910
|
|
|
1911
|
if ($id!=0 && $id!=1 && $status ne 'down') {
|
|
1912
|
# If gateway is created, take it down along with all user's networks
|
|
1913
|
if ($action eq "stop") {
|
|
1914
|
my $res = Stop($id, $action);
|
|
1915
|
if ($res) {
|
|
1916
|
unlink "$etcpath/dhcp-hosts-$id" if (-e "$etcpath/dhcp-hosts-$id");
|
|
1917
|
};
|
|
1918
|
}
|
|
1919
|
} else {
|
|
1920
|
$postreply .= "Status=ERROR Cannot $action network $name\n";
|
|
1921
|
return $postreply;
|
|
1922
|
}
|
|
1923
|
|
|
1924
|
my $idleft = ($id>99)?(substr $id,0,-2)+0 : 0;
|
|
1925
|
my $idright = (substr $id,-2) + 0;
|
|
1926
|
my $e = 0;
|
|
1927
|
my $duprules = 0;
|
|
1928
|
|
|
1929
|
if ($type eq "ipmapping" || $type eq "internalip" || $type eq "remoteip") {
|
|
1930
|
`iptables -D FORWARD -d $internalip -m state --state ESTABLISHED,RELATED -j RETURN`;
|
|
1931
|
}
|
|
1932
|
if ($type eq "ipmapping") {
|
|
1933
|
# Check if external ip exists and take it down if so
|
|
1934
|
if ($internalip && $internalip ne "--" && $externalip && $externalip ne "--" && ($interfaces =~ m/$externalip/g)) {
|
|
1935
|
$externalip =~ /\d+\.\d+\.(\d+)\.(\d+)/;
|
|
1936
|
my $ipend = "$1$2"; # Linux NIC names are limited to 15 chars - we will have to find a way to support long NIC names and bigger than /24 subnets
|
|
1937
|
$ipend = $2 if (length("$extnic:$id-$ipend")>15);
|
|
1938
|
eval {`/sbin/ifconfig $extnic:$id-$ipend down`; 1;} or do {$e=1; $postreply .= "Status=ERROR $@\n";};
|
|
1939
|
|
|
1940
|
if ($ports && $ports ne "--") { # Port mapping is defined
|
|
1941
|
my @portslist = split(/, ?| /, $ports);
|
|
1942
|
foreach my $port (@portslist) {
|
|
1943
|
my $ipfilter;
|
|
1944
|
if ($port =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(\/\d+)?:(\d+)/) {
|
|
1945
|
my $portip = "$1.$2.$3.$4$5";
|
|
1946
|
$port = $6;
|
|
1947
|
$ipfilter = "-s $portip";
|
|
1948
|
} else {
|
|
1949
|
$port = 0 unless ($port =~ /\d+/);
|
|
1950
|
}
|
|
1951
|
if ($port<1 || $port>65535) {
|
|
1952
|
$postreply .= "Status=ERROR Invalid port mapping for $name\n";
|
|
1953
|
$ports = "--";
|
|
1954
|
last;
|
|
1955
|
}
|
|
1956
|
# Remove DNAT rules
|
|
1957
|
if ($port>1 || $port<65535) {
|
|
1958
|
# repeat for good measure
|
|
1959
|
for (my $di=0; $di < 10; $di++) {
|
|
1960
|
$duprules = 0;
|
|
1961
|
eval {$duprules++ if (`/sbin/iptables -D PREROUTING -t nat -p tcp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`); 1;}
|
|
1962
|
or do {$postreply .= "Status=ERROR $@\n"; $e=1};
|
|
1963
|
eval {$duprules++ if (`/sbin/iptables -D PREROUTING -t nat -p udp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`); 1;}
|
|
1964
|
or do {$postreply .= "Status=ERROR $@\n"; $e=1};
|
|
1965
|
eval {$duprules++ if (`/sbin/iptables -D OUTPUT -t nat -p tcp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`); 1;}
|
|
1966
|
or do {$postreply .= "Status=ERROR $@\n"; $e=1};
|
|
1967
|
eval {$duprules++ if (`/sbin/iptables -D OUTPUT -t nat -p udp $ipfilter -d $externalip --dport $port -j DNAT --to $internalip`); 1;}
|
|
1968
|
or do {$postreply .= "Status=ERROR $@\n"; $e=1};
|
|
1969
|
eval {$duprules++ if (`/sbin/iptables -D POSTROUTING -t nat --out-interface br$id -s $externalip -j MASQUERADE`); 1;}
|
|
1970
|
or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1971
|
# Remove access to ipmapped internal ip on $port
|
|
1972
|
eval {$duprules++ if (`/sbin/iptables -D FORWARD -d $internalip -p udp --dport $port -j RETURN`); 1;}
|
|
1973
|
or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1974
|
eval {$duprules++ if (`/sbin/iptables -D FORWARD -d $internalip -p tcp --dport $port -j RETURN`); 1;}
|
|
1975
|
or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1976
|
last if ($duprules >6);
|
|
1977
|
}
|
|
1978
|
}
|
|
1979
|
}
|
|
1980
|
# Remove SNAT rules
|
|
1981
|
# repeat for good measure
|
|
1982
|
for (my $di=0; $di < 10; $di++) {
|
|
1983
|
$duprules = 0;
|
|
1984
|
eval {$duprules++ if (`/sbin/iptables -D POSTROUTING -t nat -s $internalip ! -d 10.$idleft.$idright.0/24 -j SNAT --to-source $externalip`); 1; }
|
|
1985
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1986
|
last if ($duprules);
|
|
1987
|
}
|
|
1988
|
# Remove rule to drop traffic to all other ports
|
|
1989
|
eval {`/sbin/iptables -D INPUT -d $externalip -j DROP`; 1;}
|
|
1990
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
1991
|
} else {
|
|
1992
|
# Remove DNAT rules
|
|
1993
|
# repeat for good measure
|
|
1994
|
for (my $di=0; $di < 10; $di++) {
|
|
1995
|
$duprules = 0;
|
|
1996
|
eval {$duprules++ if (`/sbin/iptables -D PREROUTING -t nat -d $externalip -j DNAT --to $internalip`); 1;}
|
|
1997
|
or do {$postreply .= "Status=ERROR $@\n"; $e=1};
|
|
1998
|
eval {$duprules++ if (`/sbin/iptables -D OUTPUT -t nat -d $externalip -j DNAT --to $internalip`); 1;}
|
|
1999
|
or do {$postreply .= "Status=ERROR $@\n"; $e=1};
|
|
2000
|
last if ($duprules >1);
|
|
2001
|
}
|
|
2002
|
# Remove blanket access to ipmapped internal ip
|
|
2003
|
`iptables -D FORWARD -d $internalip -j RETURN`;
|
|
2004
|
}
|
|
2005
|
# Remove SNAT and MASQUERADE rules
|
|
2006
|
# repeat for good measure
|
|
2007
|
for (my $di=0; $di < 10; $di++) {
|
|
2008
|
$duprules = 0;
|
|
2009
|
# eval {$duprules++ if (`/sbin/iptables -D POSTROUTING -t nat --out-interface br$id -s $externalip -j MASQUERADE`); 1;}
|
|
2010
|
# or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2011
|
eval {$duprules++ if (`/sbin/iptables -D POSTROUTING -t nat --out-interface br$id ! -d 10.$idleft.$idright.0/24 -j MASQUERADE`); 1;}
|
|
2012
|
or do {$e=3; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2013
|
|
|
2014
|
eval {$duprules++ if (`/sbin/iptables -D POSTROUTING -t nat -s $internalip ! -d 10.$idleft.$idright.0/24 -j SNAT --to-source $externalip`); 1; }
|
|
2015
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2016
|
# eval {$duprules++ if (`/sbin/iptables -D POSTROUTING -t nat -s $internalip -j SNAT --to-source $externalip`); 1; }
|
|
2017
|
# or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2018
|
eval {$duprules++ if (`/sbin/iptables -D INPUT -t nat -s $internalip ! -d 10.$idleft.$idright.0/24 -j SNAT --to-source $externalip`); 1; }
|
|
2019
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2020
|
# eval {$duprules++ if (`/sbin/iptables -D INPUT -t nat -s $internalip -j SNAT --to-source $externalip`); 1; }
|
|
2021
|
# or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2022
|
# eval {$duprules++ if (`/sbin/iptables -D INPUT -t nat -s $internalip ! -d 10.$idleft.$idright.0/24 -j SNAT --to-source $externalip`); 1; }
|
|
2023
|
# or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2024
|
# eval {$duprules++ if (`/sbin/iptables -D INPUT -t nat -s $internalip -j SNAT --to-source $externalip`); 1; }
|
|
2025
|
# or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2026
|
last if ($duprules >1);
|
|
2027
|
}
|
|
2028
|
# `/sbin/iptables -D POSTROUTING -t nat -s $internalip -j LOG --log-prefix "SNAT-POST"`;
|
|
2029
|
# `/sbin/iptables -D INPUT -t nat -s $internalip -j LOG --log-prefix "SNAT-INPUT"`;
|
|
2030
|
# `/sbin/iptables -D OUTPUT -t nat -s $internalip -j LOG --log-prefix "SNAT-OUTPUT"`;
|
|
2031
|
# `/sbin/iptables -D PREROUTING -t nat -s $internalip -j LOG --log-prefix "SNAT-PRE"`;
|
|
2032
|
}
|
|
2033
|
} elsif ($type eq "remoteip") {
|
|
2034
|
`pkill -f 'R $externalip'`;
|
|
2035
|
# Deactivate the ip on remoteipprovider
|
|
2036
|
my $res = $main::postToOrigo->($engineid, 'deactivateremoteip', "$externalip", 'remoteip');
|
|
2037
|
my $res_obj = JSON::from_json($res);
|
|
2038
|
if ($res_obj->{status} ne 'OK') {
|
|
2039
|
$postreply .= "Status=OK There was a problem deactivating the remote IP\n";
|
|
2040
|
}
|
|
2041
|
} elsif ($type eq "externalip") {
|
|
2042
|
if ($externalip && $externalip ne "--") {
|
|
2043
|
# We are dealing with multiple upstream routes - configure local routing
|
|
2044
|
if ($proxynic && $proxynic ne $extnic) {
|
|
2045
|
my $proxyroute = `/sbin/ip route show table proxyarp`;
|
|
2046
|
`/sbin/ip route del $externalip/32 dev br$id:proxy src $proxyip table proxyarp` if ($proxyroute =~ /$externalip/);
|
|
2047
|
}
|
|
2048
|
|
|
2049
|
eval {`/sbin/ip route del $externalip/32 dev br$id:proxy`; 1;}
|
|
2050
|
or do {$e=1; $postreply .= "Status=ERROR Problem deconfiguring proxy arp $@\n";};
|
|
2051
|
|
|
2052
|
if ($ports && $ports ne "--") {
|
|
2053
|
my @portslist = split(/, ?| /, $ports);
|
|
2054
|
foreach my $port (@portslist) {
|
|
2055
|
my $ipfilter;
|
|
2056
|
if ($port =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(\/\d+)?:(\d+)/) {
|
|
2057
|
my $portip = "$1.$2.$3.$4$5";
|
|
2058
|
$port = $6;
|
|
2059
|
$ipfilter = "-s $portip";
|
|
2060
|
} else {
|
|
2061
|
$port = 0 unless ($port =~ /\d+/);
|
|
2062
|
}
|
|
2063
|
if ($port<1 || $port>65535) {
|
|
2064
|
$postreply .= "Status=ERROR Invalid port mapping for $name\n";
|
|
2065
|
$ports = "--";
|
|
2066
|
last;
|
|
2067
|
}
|
|
2068
|
|
|
2069
|
if ($port>1 || $port<65535) {
|
|
2070
|
# repeat for good measure
|
|
2071
|
for (my $di=0; $di < 10; $di++) {
|
|
2072
|
$duprules = 0;
|
|
2073
|
eval {$duprules++ if (`/sbin/iptables -D FORWARD -p tcp -i $proxynic $ipfilter -d $externalip --dport $port -j RETURN`); 1;}
|
|
2074
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2075
|
eval {$duprules++ if (`/sbin/iptables -D FORWARD -p udp -i $proxynic $ipfilter -d $externalip --dport $port -j RETURN`); 1;}
|
|
2076
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2077
|
last if ($duprules > 1);
|
|
2078
|
}
|
|
2079
|
}
|
|
2080
|
}
|
|
2081
|
}
|
|
2082
|
# Remove rule to allow forwarding from $externalip
|
|
2083
|
`/sbin/iptables --delete FORWARD --in-interface br$id -s $externalip -j RETURN`;
|
|
2084
|
# Remove rule to disallow setting up a dhcp server
|
|
2085
|
eval {`/sbin/iptables -D FORWARD -p udp -i $proxynic -d $externalip --dport 67 -j REJECT`; 1;}
|
|
2086
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2087
|
# Leave outgoing connectivity - not
|
|
2088
|
eval {`/sbin/iptables -D FORWARD -i $proxynic -d $externalip -m state --state ESTABLISHED,RELATED -j RETURN`; 1;}
|
|
2089
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2090
|
eval {`/sbin/iptables -D FORWARD -i $proxynic -d $externalip -j RETURN`; 1;}
|
|
2091
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2092
|
# No need to reject - we reject all per default to the subnet
|
|
2093
|
eval {`/sbin/iptables -D FORWARD -i $proxynic -d $externalip -j REJECT`; 1;}
|
|
2094
|
or do {$e=1; $postreply .= "Status=ERROR Problem setting up routing $@\n";};
|
|
2095
|
}
|
|
2096
|
}
|
|
2097
|
# Deconfigure internal dhcp server
|
|
2098
|
if ($type eq "internalip" || $type eq "ipmapping" || $type eq "remoteip") {
|
|
2099
|
my $result = removeDHCPAddress($id, $domains, $internalip);
|
|
2100
|
if ($result ne "OK") {
|
|
2101
|
$e=1;
|
|
2102
|
$postreply .= "$result\n";
|
|
2103
|
}
|
|
2104
|
} elsif ($type eq "externalip" && $domains) {
|
|
2105
|
my $result = removeDHCPAddress($id, $domains, $externalip);
|
|
2106
|
if ($result ne "OK") {
|
|
2107
|
$e=1;
|
|
2108
|
$postreply .= "$result\n";
|
|
2109
|
}
|
|
2110
|
}
|
|
2111
|
$uistatus = ($e)?"":validateStatus($register{$uuid});
|
|
2112
|
if ($uistatus) {
|
|
2113
|
$uiuuid = $uuid;
|
|
2114
|
$postreply .= "Status=$uistatus OK $action $type $name: $uistatus\n";
|
|
2115
|
} else {
|
|
2116
|
$postreply .= "Status=ERROR Cannot $action $type $name: $uistatus\n";
|
|
2117
|
}
|
|
2118
|
$main::syslogit->($user, 'info', "$action network $uuid ($name, $id) -> $uistatus");
|
|
2119
|
updateBilling("$uistatus $uuid ($id)");
|
|
2120
|
# $main::updateUI->({tab=>"networks", user=>$user, uuid=>$uiuuid, status=>$uistatus}) if ($uistatus);
|
|
2121
|
return $postreply;
|
|
2122
|
}
|
|
2123
|
|
|
2124
|
sub Stop {
|
|
2125
|
my ($id, $action) = @_;
|
|
2126
|
# Check if we were passed a uuid
|
|
2127
|
if ($id =~ /\-/ && $register{$id} && ($register{$id}->{'user'} eq $user || $isadmin)) {
|
|
2128
|
$id = $register{$id}->{'id'}
|
|
2129
|
}
|
|
2130
|
if ($help) {
|
|
2131
|
return <<END
|
|
2132
|
GET:uuid:
|
|
2133
|
Stops a network by removing gateway. Network must be in status up or nat.
|
|
2134
|
END
|
|
2135
|
}
|
|
2136
|
|
|
2137
|
my $idleft = ($id>99)?(substr $id,0,-2)+0 : 0;
|
|
2138
|
my $idright = (substr $id,-2) + 0;
|
|
2139
|
my $e = 0;
|
|
2140
|
# First deactivate all user's networks with same id
|
|
2141
|
my @regkeys = (tied %register)->select_where("user = '$user'");
|
|
2142
|
foreach my $key (@regkeys) {
|
|
2143
|
my $valref = $register{$key};
|
|
2144
|
my $cuuid = $valref->{'uuid'};
|
|
2145
|
my $ctype = $valref->{'type'};
|
|
2146
|
my $cdbuser = $valref->{'user'};
|
|
2147
|
my $cid = $valref->{'id'};
|
|
2148
|
# Only list networks belonging to current user
|
|
2149
|
if ($user eq $cdbuser && $id eq $cid && $ctype ne "gateway") {
|
|
2150
|
if ($ctype eq "internalip" || $ctype eq "ipmapping" || $ctype eq "externalip") {
|
|
2151
|
my $result = Deactivate($cuuid, 'deactivate');
|
|
2152
|
if ($result =~ /\w+=ERROR (.+)/i) {
|
|
2153
|
$e = $1;
|
|
2154
|
}
|
|
2155
|
}
|
|
2156
|
}
|
|
2157
|
}
|
|
2158
|
my $interfaces = `/sbin/ifconfig br$id`;
|
|
2159
|
# Only take down interface and vlan if gateway IP is active on interface
|
|
2160
|
if ($e) {
|
|
2161
|
$postreply .= "Status=Error Not taking down gateway, got an error: $e\n"
|
|
2162
|
# } elsif ($interfaces =~ /^$datanic\.$id.+\n.+inet .+10\.$idleft\.$idright\.1/
|
|
2163
|
} elsif ($interfaces =~ /10\.$idleft\.$idright\.1/
|
|
2164
|
&& !$e) {
|
|
2165
|
eval {`/sbin/brctl delif br$id $datanic.$id`; 1;} or do {$e=1;};
|
|
2166
|
eval {`/sbin/ifconfig br$id down`; 1;} or do {$e=1;};
|
|
2167
|
eval {`/sbin/ifconfig $datanic.$id down`; 1;} or do {$e=1;};
|
|
2168
|
eval {`/sbin/vconfig rem $datanic.$id`; 1;} or do {$e=1;};
|
|
2169
|
} else {
|
|
2170
|
$postreply .= "Status=Error Not taking down interface, gateway 10.$idleft.$idright.1 is not active on interface br$id - $interfaces.\n"
|
|
2171
|
}
|
|
2172
|
# Remove rule to only forward packets coming from subnet assigned to vlan
|
|
2173
|
# `/sbin/iptables --delete FORWARD --in-interface $datanic.$id ! -s 10.$idleft.$idright.0/24 -j DROP`;
|
|
2174
|
|
|
2175
|
$uistatus = ($e)?$uistatus:"down";
|
|
2176
|
if ($uistatus eq 'down') {
|
|
2177
|
$uiuuid = $uuid;
|
|
2178
|
$postreply .= "Status=$uistatus OK $action gateway: $uistatus\n";
|
|
2179
|
} else {
|
|
2180
|
$postreply .= "Status=Error Cannot $action $type $name: $uistatus\n";
|
|
2181
|
}
|
|
2182
|
return $postreply;
|
|
2183
|
}
|
|
2184
|
|
|
2185
|
sub getDomains {
|
|
2186
|
my $uuid = shift;
|
|
2187
|
my $domains;
|
|
2188
|
my $domainnames;
|
|
2189
|
my @domregvalues = values %domreg;
|
|
2190
|
foreach my $domval (@domregvalues) {
|
|
2191
|
if (($domval->{'networkuuid1'} eq $uuid || $domval->{'networkuuid2'} eq $uuid || $domval->{'networkuuid3'} eq $uuid)
|
|
2192
|
&& $domval->{'user'} eq $user) {
|
|
2193
|
$domains .= $domval->{'uuid'} . ", ";
|
|
2194
|
$domainnames .= $domval->{'name'} . ", ";
|
|
2195
|
}
|
|
2196
|
}
|
|
2197
|
$domains = substr $domains, 0, -2;
|
|
2198
|
$domainnames = substr $domainnames, 0, -2;
|
|
2199
|
return ($domains, $domainnames);
|
|
2200
|
}
|
|
2201
|
|
|
2202
|
sub getSystems {
|
|
2203
|
my $uuid = shift;
|
|
2204
|
my $systems;
|
|
2205
|
my $systemnames;
|
|
2206
|
unless (tie(%sysreg,'Tie::DBI', Hash::Merge::merge({table=>'systems'}, $Stabile::dbopts)) ) {$res .= qq|{"status": "Error": "message": "Unable to access systems register"}|; return $res;};
|
|
2207
|
my @sysregvalues = values %sysreg;
|
|
2208
|
foreach my $sysval (@sysregvalues) {
|
|
2209
|
my $networkuuids = $sysval->{'networkuuids'};
|
|
2210
|
if ($networkuuids =~ /$uuid/ && $sysval->{'user'} eq $user) {
|
|
2211
|
$systems = $sysval->{'uuid'};
|
|
2212
|
$systemnames = $sysval->{'name'};
|
|
2213
|
last;
|
|
2214
|
}
|
|
2215
|
}
|
|
2216
|
unless ($systems) {
|
|
2217
|
my @sysregvalues = values %domreg;
|
|
2218
|
foreach my $sysval (@sysregvalues) {
|
|
2219
|
my $networkuuids = $sysval->{'networkuuids'};
|
|
2220
|
if ($networkuuids =~ /$uuid/ && $sysval->{'user'} eq $user) {
|
|
2221
|
$systems = $sysval->{'uuid'};
|
|
2222
|
$systemnames = $sysval->{'name'};
|
|
2223
|
last;
|
|
2224
|
}
|
|
2225
|
}
|
|
2226
|
}
|
|
2227
|
return ($systems, $systemnames);
|
|
2228
|
}
|
|
2229
|
|
|
2230
|
sub getNextId {
|
|
2231
|
# Find the next available vlan id
|
|
2232
|
my $reqid = shift;
|
|
2233
|
my $username = shift;
|
|
2234
|
$username = $user unless ($username);
|
|
2235
|
my $nextid = 1;
|
|
2236
|
my $vlanstart = $Stabile::config->get('VLAN_RANGE_START');
|
|
2237
|
my $vlanend = $Stabile::config->get('VLAN_RANGE_END');
|
|
2238
|
|
|
2239
|
if ($reqid eq 0 || $reqid == 1) {
|
|
2240
|
return $requid;
|
|
2241
|
} elsif ($reqid && ($reqid > $vlanend || $reqid < $vlanstart)) {
|
|
2242
|
return -1 unless ($isadmin);
|
|
2243
|
}
|
|
2244
|
|
|
2245
|
$reqid = $reqid + 0;
|
|
2246
|
|
|
2247
|
my %ids;
|
|
2248
|
# First check if the user has an existing vlan, if so use the first we find as default value
|
|
2249
|
my @regvalues = values %register;
|
|
2250
|
@regvalues = (sort {$a->{id} <=> $b->{id}} @regvalues);
|
|
2251
|
foreach my $val (@regvalues) { # Traverse all id's in use
|
|
2252
|
my $id = 0 + $val->{'id'};
|
|
2253
|
my $dbuser = $val->{'user'};
|
|
2254
|
if ($id > 1) {
|
|
2255
|
if ($username eq $dbuser) { # If a specific id was requested map all id's
|
|
2256
|
if (!$reqid) {# If no specific id was asked for, stop now, and use the user's first one
|
|
2257
|
$nextid = $id;
|
|
2258
|
last;
|
|
2259
|
}
|
|
2260
|
} else {
|
|
2261
|
$ids{$id} = 1; # Mark this id as used (by another user)
|
|
2262
|
}
|
|
2263
|
}
|
|
2264
|
}
|
|
2265
|
if ($nextid>1) {
|
|
2266
|
return $nextid;
|
|
2267
|
} elsif ($reqid) {
|
|
2268
|
if (!$ids{$reqid} || $isadmin) { # If an admin is requesting id used by another, assume he knows what he is doing
|
|
2269
|
$nextid = $reqid; # Safe to use
|
|
2270
|
} else {
|
|
2271
|
$nextid = -1; # Id already in use by another
|
|
2272
|
}
|
|
2273
|
} elsif ($nextid == 1) { # This user is not currently using any vlan's, find the first free one
|
|
2274
|
for ($n=$vlanstart; $n<$vlanend; $n++) {
|
|
2275
|
if (!$ids{$n}) { # Don't return an id used (by another user)
|
|
2276
|
$nextid = $n;
|
|
2277
|
last;
|
|
2278
|
}
|
|
2279
|
}
|
|
2280
|
}
|
|
2281
|
return $nextid;
|
|
2282
|
}
|
|
2283
|
|
|
2284
|
sub getNextRemoteIP {
|
|
2285
|
my $internalip = shift;
|
|
2286
|
my $nextip = "";
|
|
2287
|
my $oc = overQuotas(1);
|
|
2288
|
if ($oc) { # Enforce quotas
|
|
2289
|
$postreply .= "Status=ERROR Over quota allocating external IP\n";
|
|
2290
|
} else {
|
|
2291
|
my $res = $main::postToOrigo->($engineid, 'provisionremoteip', $internalip, 'internalip');
|
|
2292
|
my $res_obj = JSON::from_json($res);
|
|
2293
|
$nextip = $res_obj->{remoteip} if ($res_obj->{remoteip});
|
|
2294
|
}
|
|
2295
|
$postreply .= "Status=ERROR No more ($oc) remote IPs available\n" unless ($nextip);
|
|
2296
|
return $nextip;
|
|
2297
|
|
|
2298
|
}
|
|
2299
|
sub getNextExternalIP {
|
|
2300
|
# Find the next available IP
|
|
2301
|
my $extip = shift;
|
|
2302
|
my $extuuid = shift;
|
|
2303
|
my $proxyarp = shift; # Are we trying to assign a proxy arp's external IP?
|
|
2304
|
$extip = "" if ($extip eq "--");
|
|
2305
|
|
|
2306
|
my $extipstart;
|
|
2307
|
my $extipend;
|
|
2308
|
|
|
2309
|
if ($proxyarp) {
|
|
2310
|
$extipstart = $Stabile::config->get('PROXY_IP_RANGE_START');
|
|
2311
|
$extipend = $Stabile::config->get('PROXY_IP_RANGE_END');
|
|
2312
|
} else {
|
|
2313
|
$extipstart = $Stabile::config->get('EXTERNAL_IP_RANGE_START');
|
|
2314
|
$extipend = $Stabile::config->get('EXTERNAL_IP_RANGE_END');
|
|
2315
|
}
|
|
2316
|
|
|
2317
|
return "" unless ($extipstart && $extipend);
|
|
2318
|
|
|
2319
|
my $interfaces = `/sbin/ifconfig`;
|
|
2320
|
# $interfaces =~ m/eth0 .+\n.+inet addr:(\d+\.\d+\.\d+)\.(\d+)/;
|
|
2321
|
$extipstart =~ m/(\d+\.\d+\.\d+)\.(\d+)/;
|
|
2322
|
my $bnet1 = $1;
|
|
2323
|
my $bhost1 = $2+0;
|
|
2324
|
$extipend =~ m/(\d+\.\d+\.\d+)\.(\d+)/;
|
|
2325
|
my $bnet2 = $1;
|
|
2326
|
my $bhost2 = $2+0;
|
|
2327
|
my $nextip = "";
|
|
2328
|
if ($bnet1 ne $bnet2) {
|
|
2329
|
print "Status=ERROR Only 1 class C subnet is supported for $name\n";
|
|
2330
|
return "";
|
|
2331
|
}
|
|
2332
|
my %ids;
|
|
2333
|
# First create map of IP's reserved by other servers in DB
|
|
2334
|
my @regvalues = values %register;
|
|
2335
|
foreach my $val (@regvalues) {
|
|
2336
|
my $ip = $val->{'externalip'};
|
|
2337
|
# $ip =~ m/(\d+\.\d+\.\d+)\.(\d+)/;
|
|
2338
|
# my $id = $2;
|
|
2339
|
$ids{$ip} = $val->{'uuid'} unless ($extuuid eq $val->{'uuid'});
|
|
2340
|
}
|
|
2341
|
my $oc = overQuotas(1);
|
|
2342
|
if ($oc) { # Enforce quotas
|
|
2343
|
$postreply .= "Status=ERROR Over quota allocating external IP\n";
|
|
2344
|
} elsif ($extip && $extip =~ m/($bnet1)\.(\d+)/ && $2>=$bhost1 && $2<$bhost2) {
|
|
2345
|
# An external ip was supplied - check if it's free and ok
|
|
2346
|
if (!$ids{$extip} && !($interfaces =~ m/$extip.+\n.+inet addr:$extip/) && $extip=~/$bnet$\.(\d)/) {
|
|
2347
|
$nextip = $extip;
|
|
2348
|
}
|
|
2349
|
} else {
|
|
2350
|
# Find random IP not reserved, and check it is not in use (for other purposes)
|
|
2351
|
my @bhosts = ($bhost1..$bhost2);
|
|
2352
|
my @rbhosts = shuffle @bhosts;
|
|
2353
|
for ($n=0; $n<$bhost2-$bhost1; $n++) {
|
|
2354
|
my $nb = $rbhosts[$n];
|
|
2355
|
if (!$ids{"$bnet1.$nb"}) {
|
|
2356
|
if (!($interfaces =~ m/$extip.+\n.+inet addr:$bnet1\.$nb/)) {
|
|
2357
|
$nextip = "$bnet1.$nb";
|
|
2358
|
last;
|
|
2359
|
}
|
|
2360
|
}
|
|
2361
|
}
|
|
2362
|
}
|
|
2363
|
$postreply .= "Status=ERROR No more ($oc) external IPs available\n" unless ($nextip);
|
|
2364
|
return $nextip;
|
|
2365
|
}
|
|
2366
|
|
|
2367
|
sub ip2domain {
|
|
2368
|
my $ip = shift;
|
|
2369
|
my $ruuid;
|
|
2370
|
if ($ip) {
|
|
2371
|
my @regkeys = (tied %register)->select_where("internalip = '$ip' OR externalip = '$ip'");
|
|
2372
|
foreach my $k (@regkeys) {
|
|
2373
|
my $valref = $register{$k};
|
|
2374
|
if ($valref->{'internalip'} eq $ip || $valref->{'externalip'} eq $ip) {
|
|
2375
|
$ruuid = $valref->{'domains'};
|
|
2376
|
last;
|
|
2377
|
}
|
|
2378
|
}
|
|
2379
|
}
|
|
2380
|
return $ruuid;
|
|
2381
|
}
|
|
2382
|
|
|
2383
|
sub getNextInternalIP {
|
|
2384
|
my $intip = shift;
|
|
2385
|
my $uuid = shift;
|
|
2386
|
my $id = shift;
|
|
2387
|
my $username = shift;
|
|
2388
|
$username = $user unless ($username);
|
|
2389
|
my $nextip = "";
|
|
2390
|
my $intipnum;
|
|
2391
|
my $subnet;
|
|
2392
|
my %ids;
|
|
2393
|
my $ping = Net::Ping->new();
|
|
2394
|
|
|
2395
|
$id = getNextId() unless ($id);
|
|
2396
|
my $idleft = ($id>99)?(substr $id,0,-2)+0 : 0;
|
|
2397
|
my $idright = (substr $id,-2) + 0;
|
|
2398
|
$intip = "10.$idleft.$idright.0" if (!$intip || $intip eq '--');
|
|
2399
|
|
|
2400
|
return '' unless ($intip =~ m/(\d+\.\d+\.\d+)\.(\d+)/ );
|
|
2401
|
$subnet = $1;
|
|
2402
|
$intipnum = $2;
|
|
2403
|
|
|
2404
|
# First create hash of IP's reserved by other servers in DB
|
|
2405
|
my @regvalues = values %register;
|
|
2406
|
foreach my $val (@regvalues) {
|
|
2407
|
if ($val->{'user'} eq $username) {
|
|
2408
|
my $ip = $val->{'internalip'} ;
|
|
2409
|
$ids{$ip} = $val->{'uuid'};
|
|
2410
|
}
|
|
2411
|
}
|
|
2412
|
|
|
2413
|
if ($intipnum && $intipnum>1 && $intipnum<255) {
|
|
2414
|
# An internal ip was supplied - check if it's free, if not keep the ip already registered in the db
|
|
2415
|
if (!$ids{$intip}
|
|
2416
|
# && !($ping->ping($intip, 0.1)) # 0.1 secs timeout, check if ip is in use, possibly on another engine
|
|
2417
|
&& !(`arping -C1 -c2 -D -I $datanic.$id $intip` =~ /reply from/) # check if ip is created on another engine
|
|
2418
|
) {
|
|
2419
|
$nextip = $intip;
|
|
2420
|
} else {
|
|
2421
|
$nextip = $register{$uuid}->{'internalip'}
|
|
2422
|
}
|
|
2423
|
} else {
|
|
2424
|
# Find first IP not reserved
|
|
2425
|
for ($n=2; $n<255; $n++) {
|
|
2426
|
if (!$ids{"$subnet.$n"}
|
|
2427
|
# TODO: The arping check takes too long - two networks created by the same user can too easily be assigned the same IP's
|
|
2428
|
# && !(`arping -f -c2 -D -I $datanic.$id $subnet.$n` =~ /reply from/) # check if ip is created on another engine
|
|
2429
|
) {
|
|
2430
|
$nextip = "$subnet.$n";
|
|
2431
|
last;
|
|
2432
|
}
|
|
2433
|
}
|
|
2434
|
}
|
|
2435
|
$postreply .= "Status=ERROR No more internal IPs available\n" if (!$nextip);
|
|
2436
|
return $nextip;
|
|
2437
|
}
|
|
2438
|
|
|
2439
|
sub validateStatus {
|
|
2440
|
my $valref = shift;
|
|
2441
|
|
|
2442
|
# my $interfaces = `/sbin/ifconfig`;
|
|
2443
|
my $uuid = $valref->{'uuid'};
|
|
2444
|
my $type = $valref->{'type'};
|
|
2445
|
my $id = $valref->{'id'};
|
|
2446
|
my $idleft = ($id>99)?(substr $id,0,-2)+0 : 0;
|
|
2447
|
my $idright = (substr $id,-2) + 0;
|
|
2448
|
|
|
2449
|
( $valref->{'domains'}, $valref->{'domainnames'} ) = getDomains($uuid);
|
|
2450
|
my ( $systems, $systemnames ) = getSystems($uuid);
|
|
2451
|
my $extip = $valref->{'externalip'};
|
|
2452
|
my $intip = $valref->{'internalip'};
|
|
2453
|
|
|
2454
|
if ($type eq "gateway") {
|
|
2455
|
$valref->{'internalip'} = "10.$idleft.$idright.1" if ($id>1);
|
|
2456
|
} else {
|
|
2457
|
if ($intip && $intip ne "--" && $extip && $extip ne "--") {
|
|
2458
|
$type = "ipmapping" unless ($type eq 'remoteip');
|
|
2459
|
} elsif ($intip && $intip ne "--") {
|
|
2460
|
$type = "internalip";
|
|
2461
|
} elsif ($extip && $extip ne "--") {
|
|
2462
|
$type = "externalip";
|
|
2463
|
} else {
|
|
2464
|
$type = "gateway";
|
|
2465
|
}
|
|
2466
|
$valref->{'type'} = $type;
|
|
2467
|
}
|
|
2468
|
|
|
2469
|
$valref->{'status'} = "down";
|
|
2470
|
my $nat;
|
|
2471
|
if ($id == 0 || $id == 1) {
|
|
2472
|
$valref->{'status'} = "nat";
|
|
2473
|
# Check if vlan $id is created (and doing nat)
|
|
2474
|
# } elsif ($interfaces =~ m/$datanic\.$id.+\n.+10\.$idleft\.$idright\.1/) {
|
|
2475
|
} elsif (-e "/proc/net/vlan/$datanic.$id") {
|
|
2476
|
$nat = 1;
|
|
2477
|
}
|
|
2478
|
|
|
2479
|
if ($type eq "internalip" || $type eq "ipmapping" || $type eq "remoteip") {
|
|
2480
|
$valref->{'status'} = "nat" if ($nat);
|
|
2481
|
my $dhcprunning;
|
|
2482
|
my $dhcpconfigured;
|
|
2483
|
eval {
|
|
2484
|
my $psid;
|
|
2485
|
$psid = `/bin/cat /var/run/stabile-$id.pid` if (-e "/var/run/stabile-$id.pid");
|
|
2486
|
chomp $psid;
|
|
2487
|
$dhcprunning = -e "/proc/$psid" if ($psid);
|
|
2488
|
my $dhcphosts;
|
|
2489
|
$dhcphosts = lc `/bin/cat $etcpath/dhcp-hosts-$id` if (-e "$etcpath/dhcp-hosts-$id");
|
|
2490
|
$dhcpconfigured = ($dhcphosts =~ /$intip/);
|
|
2491
|
1;
|
|
2492
|
} or do {;};
|
|
2493
|
|
|
2494
|
if ($type eq "internalip" || $type eq "remoteip") {
|
|
2495
|
# Check if external ip has been created and dhcp is ok
|
|
2496
|
if ($nat && (($dhcprunning && $dhcpconfigured) || $systems)) {
|
|
2497
|
if ($type eq "remoteip") {
|
|
2498
|
if (`pgrep -f 'ssh .* $externalip'`) {
|
|
2499
|
$valref->{'status'} = "up";
|
|
2500
|
}
|
|
2501
|
} else {
|
|
2502
|
$valref->{'status'} = "up";
|
|
2503
|
}
|
|
2504
|
}
|
|
2505
|
} elsif ($type eq "ipmapping") {
|
|
2506
|
# Check if external ip has been created, dhcp is ok and vlan interface is created
|
|
2507
|
# An ipmapping linked to a system is considered up if external interface exists
|
|
2508
|
# Update: It appears that ip addresses on virtual interfaces are periodically lost for some reason
|
|
2509
|
# the interface however still responds to the ip address if iptables rules referencing this exists
|
|
2510
|
# so we have relaxed the up requirement
|
|
2511
|
if ($nat
|
|
2512
|
# && $interfaces =~ m/$extip/ # interfaces seem to drop out of sight after while even if still active
|
|
2513
|
&& (($dhcprunning && $dhcpconfigured) || $systems)) {
|
|
2514
|
$valref->{'status'} = "up";
|
|
2515
|
}
|
|
2516
|
}
|
|
2517
|
|
|
2518
|
} elsif ($type eq "externalip") {
|
|
2519
|
my $dhcprunning;
|
|
2520
|
my $dhcpconfigured;
|
|
2521
|
eval {
|
|
2522
|
my $psid;
|
|
2523
|
$psid = `/bin/cat /var/run/stabile-$id.pid` if (-e "/var/run/stabile-$id.pid");
|
|
2524
|
chomp $psid;
|
|
2525
|
$dhcprunning = -e "/proc/$psid" if ($psid);
|
|
2526
|
my $dhcphosts;
|
|
2527
|
$dhcphosts = `/bin/cat $etcpath/dhcp-hosts-$id` if (-e "$etcpath/dhcp-hosts-$id");
|
|
2528
|
$dhcpconfigured = ($dhcphosts =~ /$extip/);
|
|
2529
|
1;
|
|
2530
|
} or do {;};
|
|
2531
|
|
|
2532
|
my $vproxy = `/bin/cat /proc/sys/net/ipv4/conf/$datanic.$id/proxy_arp`; chomp $vproxy;
|
|
2533
|
my $eproxy = `/bin/cat /proc/sys/net/ipv4/conf/$proxynic/proxy_arp`; chomp $eproxy;
|
|
2534
|
my $proute = `/sbin/ip route | grep "$extip dev"`; chomp $proute;
|
|
2535
|
if ($vproxy && $eproxy && $proute) {
|
|
2536
|
if ((($dhcprunning && $dhcpconfigured) || $systems)) {
|
|
2537
|
$valref->{'status'} = "up";
|
|
2538
|
} elsif (!$valref->{'domains'}) {
|
|
2539
|
$valref->{'status'} = "nat";
|
|
2540
|
}
|
|
2541
|
} else {
|
|
2542
|
#print "$vproxy && $eproxy && $proute && $dhcprunning && $dhcpconfigured :: $extip\n";
|
|
2543
|
}
|
|
2544
|
|
|
2545
|
} elsif ($type eq "gateway") {
|
|
2546
|
if ($nat || $id == 0 || $id == 1) {$valref->{'status'} = "up";}
|
|
2547
|
}
|
|
2548
|
return $valref->{'status'};
|
|
2549
|
}
|
|
2550
|
|
|
2551
|
sub trim{
|
|
2552
|
my $string = shift;
|
|
2553
|
$string =~ s/^\s+|\s+$//g;
|
|
2554
|
return $string;
|
|
2555
|
}
|
|
2556
|
|
|
2557
|
sub overQuotas {
|
|
2558
|
my $reqips = shift; # number of new ip's we are asking for
|
|
2559
|
my $usedexternalips = 0;
|
|
2560
|
my $overquota = 0;
|
|
2561
|
return $overquota if ($Stabile::userprivileges =~ /a/); # Don't enforce quotas for admins
|
|
2562
|
|
|
2563
|
my $externalipquota = $Stabile::userexternalipquota;
|
|
2564
|
if (!$externalipquota) {
|
|
2565
|
$externalipquota = $Stabile::config->get('EXTERNAL_IP_QUOTA');
|
|
2566
|
}
|
|
2567
|
|
|
2568
|
my $rxquota = $Stabile::userrxquota;
|
|
2569
|
if (!$rxquota) {
|
|
2570
|
$rxquota = $Stabile::config->get('RX_QUOTA');
|
|
2571
|
}
|
|
2572
|
|
|
2573
|
my $txquota = $Stabile::usertxquota;
|
|
2574
|
if (!$txquota) {
|
|
2575
|
$txquota = $Stabile::config->get('TX_QUOTA');
|
|
2576
|
}
|
|
2577
|
|
|
2578
|
my @regkeys = (tied %register)->select_where("user = '$user'");
|
|
2579
|
foreach my $k (@regkeys) {
|
|
2580
|
my $val = $register{$k};
|
|
2581
|
if ($val->{'user'} eq $user && $val->{'externalip'} && $val->{'externalip'} ne "--" ) {
|
|
2582
|
$usedexternalips += 1;
|
|
2583
|
}
|
|
2584
|
}
|
|
2585
|
if ((($usedexternalips + $reqips) > $externalipquota) && $externalipquota > 0) { # -1 means no quota
|
|
2586
|
$overquota = $usedexternalips;
|
|
2587
|
} elsif ($rx > $rxquota*1024 && $rxquota > 0) {
|
|
2588
|
$overquota = -1;
|
|
2589
|
} elsif ($tx > $txquota*1024 && $txquota > 0) {
|
|
2590
|
$overquota = -2;
|
|
2591
|
}
|
|
2592
|
return $overquota;
|
|
2593
|
}
|
|
2594
|
|
|
2595
|
sub updateBilling {
|
|
2596
|
my $event = shift;
|
|
2597
|
my %billing;
|
|
2598
|
my @regkeys = (tied %register)->select_where("user = '$user' or user = 'common'") unless ($fulllist);
|
|
2599
|
foreach my $k (@regkeys) {
|
|
2600
|
my $valref = $register{$k};
|
|
2601
|
my %val = %{$valref}; # Deference and assign to new array, effectively cloning object
|
|
2602
|
if ($val{'user'} eq $user && ($val{'type'} eq 'ipmapping' || $val{'type'} eq 'externalip') && $val{'externalip'} ne '--') {
|
|
2603
|
$billing{$val{'id'}}->{'externalip'} += 1;
|
|
2604
|
}
|
|
2605
|
}
|
|
2606
|
|
|
2607
|
my %billingreg;
|
|
2608
|
my $monthtimestamp = timelocal(0,0,0,1,$mon,$year); #$sec,$min,$hour,$mday,$mon,$year
|
|
2609
|
|
|
2610
|
unless ( tie(%billingreg,'Tie::DBI', Hash::Merge::merge({table=>'billing_networks', key=>'useridtime'}, $Stabile::dbopts)) ) {return "Unable to access billing register"};
|
|
2611
|
|
|
2612
|
my $rx_bytes_total = 0;
|
|
2613
|
my $tx_bytes_total = 0;
|
|
2614
|
|
|
2615
|
my $prevmonth = $month-1;
|
|
2616
|
my $prevyear = $year;
|
|
2617
|
if ($prevmonth == 0) {$prevmonth=12; $prevyear--;};
|
|
2618
|
$prevmonth = substr("0" . $prevmonth, -2);
|
|
2619
|
my $prev_rx_bytes_total = 0;
|
|
2620
|
my $prev_tx_bytes_total = 0;
|
|
2621
|
|
|
2622
|
foreach my $id (keys %billing) {
|
|
2623
|
my $b = $billing{$id};
|
|
2624
|
my $externalip = $b->{'externalip'};
|
|
2625
|
my $externalipavg = 0;
|
|
2626
|
my $startexternalipavg = 0;
|
|
2627
|
my $starttimestamp = $current_time;
|
|
2628
|
my $rx_bytes = 0;
|
|
2629
|
my $tx_bytes = 0;
|
|
2630
|
# my $rx_stats = "/sys/class/net/$datanic.$id/statistics/rx_bytes";
|
|
2631
|
# my $tx_stats = "/sys/class/net/$datanic.$id/statistics/tx_bytes";
|
|
2632
|
my $rx_stats = "/sys/class/net/br$id/statistics/rx_bytes";
|
|
2633
|
my $tx_stats = "/sys/class/net/br$id/statistics/tx_bytes";
|
|
2634
|
$rx_bytes = `/bin/cat $rx_stats` if (-e $rx_stats);
|
|
2635
|
chomp $rx_bytes;
|
|
2636
|
$tx_bytes = `/bin/cat $tx_stats` if (-e $tx_stats);
|
|
2637
|
chomp $tx_bytes;
|
|
2638
|
|
|
2639
|
if ($current_time - $monthtimestamp < 4*3600) {
|
|
2640
|
$starttimestamp = $monthtimestamp;
|
|
2641
|
$externalipavg = $externalip;
|
|
2642
|
$startexternalipavg = $externalip;
|
|
2643
|
}
|
|
2644
|
|
|
2645
|
my $bill = $billingreg{"$user-$id-$year-$month"};
|
|
2646
|
my $regrx_bytes = $bill->{'rx'};
|
|
2647
|
my $regtx_bytes = $bill->{'tx'};
|
|
2648
|
$rx_bytes += $regrx_bytes if ($regrx_bytes > $rx_bytes); # Network interface was reloaded
|
|
2649
|
$tx_bytes += $regtx_bytes if ($regtx_bytes > $tx_bytes); # Network interface was reloaded
|
|
2650
|
|
|
2651
|
# Update timestamp and averages on existing row
|
|
2652
|
if ($billingreg{"$user-$id-$year-$month"}) {
|
|
2653
|
$startexternalipavg = $bill->{'startexternalipavg'};
|
|
2654
|
$starttimestamp = $bill->{'starttimestamp'};
|
|
2655
|
|
|
2656
|
$externalipavg = ($startexternalipavg*($starttimestamp - $monthtimestamp) + $externalip*($current_time - $starttimestamp)) /
|
|
2657
|
($current_time - $monthtimestamp);
|
|
2658
|
|
|
2659
|
$billingreg{"$user-$id-$year-$month"}->{'externalip'} = $externalip;
|
|
2660
|
$billingreg{"$user-$id-$year-$month"}->{'externalipavg'} = $externalipavg;
|
|
2661
|
$billingreg{"$user-$id-$year-$month"}->{'timestamp'} = $current_time;
|
|
2662
|
$billingreg{"$user-$id-$year-$month"}->{'rx'} = $rx_bytes;
|
|
2663
|
$billingreg{"$user-$id-$year-$month"}->{'tx'} = $tx_bytes;
|
|
2664
|
}
|
|
2665
|
|
|
2666
|
# No row found or something happened which justifies writing a new row
|
|
2667
|
if (!$billingreg{"$user-$id-$year-$month"}
|
|
2668
|
|| ($b->{'externalip'} != $bill->{'externalip'})
|
|
2669
|
) {
|
|
2670
|
|
|
2671
|
my $inc = 0;
|
|
2672
|
if ($billingreg{"$user-$id-$year-$month"}) {
|
|
2673
|
$startexternalipavg = $externalipavg;
|
|
2674
|
$starttimestamp = $current_time;
|
|
2675
|
$inc = $bill->{'inc'};
|
|
2676
|
}
|
|
2677
|
# Write a new row
|
|
2678
|
$billingreg{"$user-$id-$year-$month"} = {
|
|
2679
|
externalip=>$externalip+0,
|
|
2680
|
externalipavg=>$externalipavg,
|
|
2681
|
startexternalipavg=>$startexternalipavg,
|
|
2682
|
timestamp=>$current_time,
|
|
2683
|
starttimestamp=>$starttimestamp,
|
|
2684
|
event=>$event,
|
|
2685
|
inc=>$inc+1,
|
|
2686
|
rx=>$rx_bytes,
|
|
2687
|
tx=>$tx_bytes
|
|
2688
|
};
|
|
2689
|
}
|
|
2690
|
|
|
2691
|
$rx_bytes_total += $rx_bytes;
|
|
2692
|
$tx_bytes_total += $tx_bytes;
|
|
2693
|
my $prevbill = $billingreg{"$user-$id-$prevyear-$prevmonth"};
|
|
2694
|
$prev_rx_bytes_total += $prevbill->{'rx'};
|
|
2695
|
$prev_tx_bytes_total += $prevbill->{'tx'};
|
|
2696
|
}
|
|
2697
|
untie %billingreg;
|
|
2698
|
$rx = ($rx_bytes_total>$prev_rx_bytes_total)?$rx_bytes_total - $prev_rx_bytes_total:$rx_bytes_total;
|
|
2699
|
$tx = ($tx_bytes_total>$prev_tx_bytes_total)?$tx_bytes_total - $prev_tx_bytes_total:$tx_bytes_total;
|
|
2700
|
my $oq = overQuotas();
|
|
2701
|
if ($oq && $oq<0) {
|
|
2702
|
foreach my $id (keys %billing) {
|
|
2703
|
$main::syslogit->($user, 'info', "$user over rx/tx quota ($oq) stopping network $id");
|
|
2704
|
Stop($id, 'stop');
|
|
2705
|
}
|
|
2706
|
}
|
|
2707
|
}
|
|
2708
|
|
|
2709
|
sub Bit2netmask {
|
|
2710
|
my $netbit = shift;
|
|
2711
|
my $_bit = ( 2 ** (32 - $netbit) ) - 1;
|
|
2712
|
my ($full_mask) = unpack( "N", pack( "C4", split(/./, '255.255.255.255') ) );
|
|
2713
|
my $netmask = join( '.', unpack( "C4", pack( "N", ( $full_mask ^ $_bit ) ) ) );
|
|
2714
|
return $netmask;
|
|
2715
|
}
|