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