package HaCi::XMLRPC;

use strict;
use warnings;

use Frontier::RPC2;
use Data::Dumper;
use Encode;
use File::Basename;
use Digest::MD5 qw/md5_hex/;
use Time::HiRes qw/usleep/;

use HaCi::Conf;
use HaCi::HaCi;
use HaCi::Utils;
use HaCi::Mathematics;
use HaCi::Log qw/warnl debug/;

=head1 Class XMLRPC

This class provides a XML-RPC API for HaCi.

Basic usage:

	my $api         = new Frontier::Client(url => "http://$server/RPC2");
	my $session     = $api->call('login', [$user, $pass]);
	die 'Login failed!' unless $session;

	print Dumper($api->call($method, $session, @args));

	$api->call('logout', $session);

	exit 0;

=cut

my $aclCacheHandle	= undef;
my $netCacheHandle	= undef;
my $lockName		= undef;

$SIG{__DIE__}	= sub {&releaseLock($lockName) if defined $lockName};

my $methods	= {
	search										=> \&search,
	getFreeSubnets						=> \&getFreeSubnets,
	getFreeSubnetsFromSearch	=> \&getFreeSubnetsFromSearch,
	assignFreeSubnet					=> \&assignFreeSubnet,
	getSubnets								=> \&getSubnets,
	getNetworkDetails					=> \&getNetworkDetails,
	listRoots									=> \&listRoots,
	addRoot										=> \&addRoot,
	editRoot									=> \&editRoot,
	delRoot										=> \&delRoot,
	addNet										=> \&addNet,
	editNet										=> \&editNet,
	delNet										=> \&delNet,
	login											=> \&login,
	logout										=> \&logout,
};

sub handler {
	my $r						= shift;
	my $coder				= Frontier::RPC2->new();
	(my $workDir		= dirname( __FILE__ )) =~ s#/modules/HaCi##;
	&HaCi::Conf::init($workDir);

	my $content	= '';
	$r->read($content, $r->headers_in->get('Content-Length'));

	my $response	= '';
	eval {
		$response	= &serve($coder, $content);
	};
	if ($@) {
		$r->content_type("text/xml");
		$r->print(encode("UTF-8", $coder->encode_fault(1, 'Error: ' . $@)));
		return Apache2::Const::SERVER_ERROR;
	} else {
		#$r->content_type("application/json");
		$r->content_type("text/xml");
		$r->print(encode("UTF-8", $response));
		return Apache2::Const::OK;
	}
}

sub finalize {
	if (defined $netCacheHandle) {
		warn "Cannot set Cache (netCache-DB!)\n" unless $netCacheHandle->set('DB', $HaCi::HaCi::netCache->{DB});
		warn "Cannot set Cache (netCache-FILL!)\n" unless $netCacheHandle->set('FILL', $HaCi::HaCi::netCache->{FILL});
		warn "Cannot set Cache (netCache-NET!)\n" unless $netCacheHandle->set('NET', $HaCi::HaCi::netCache->{NET});
	}

	if (defined $aclCacheHandle) {
		warn "Cannot set Cache (aclCache!)\n" unless $aclCacheHandle->set('HASH', $HaCi::HaCi::aclCache);
	}
	$HaCi::HaCi::session->flush();
}

sub init {
	&HaCi::Utils::getConfig();

	($aclCacheHandle, $netCacheHandle)	= &HaCi::Utils::initCache();
	if (defined $netCacheHandle) {
		$HaCi::HaCi::netCache->{DB}		= $netCacheHandle->get('DB');
		$HaCi::HaCi::netCache->{NET}	= $netCacheHandle->get('NET');
		$HaCi::HaCi::netCache->{FILL}	= $netCacheHandle->get('FILL');
	} else {
		$HaCi::HaCi::netCache->{DB}		= {};
		$HaCi::HaCi::netCache->{NET}	= {};
		$HaCi::HaCi::netCache->{FILL}	= {};
	}
	$HaCi::HaCi::aclCache	= (defined $aclCacheHandle) ? $aclCacheHandle->get('HASH') : {};

	&HaCi::Utils::initTables();
}

sub serve {
	my $coder	= shift;
	my $xml		= shift;
	$xml		=~ s/(<\?XML\s+VERSION)/\L$1\E/;

	my $call;
	eval {
		$call	= $coder->decode($xml)
	};
	if ($@) {
		return $coder->encode_fault(1, "error decoding RPC.\n" . $@);
	}
	
	if ($call->{'type'} ne 'call') {
		return $coder->encode_fault(2,"expected RPC \`methodCall', got \`$call->{'type'}'\n");
	}

	my $method	= $call->{'method_name'};
	if (!defined $methods->{$method}) {
 		return $coder->encode_fault(3, "no such method \`$method'\n");
	}

	&init();
	return $coder->encode_fault(7, "error executing RPC \`$method'.\n" . join("\n", @{$HaCi::Conf::conf->{var}->{warnl}}))
		if $#{$HaCi::Conf::conf->{var}->{warnl}} > -1;

	my @values		= @{$call->{'value'}};
	my $authInfo	= shift @values;
	return $coder->encode_fault(7, "Authentication error: " . $HaCi::Conf::conf->{var}->{authenticationError}) unless &authenticate($authInfo);

  my $result;
	eval {
		$result	= &{$methods->{$method}}(@values);
	};
  if ($@) {
		return $coder->encode_fault(4, "error executing RPC \`$method'.\n" . $@);
	}
	
	my $response_xml = $coder->encode_response($result);

	&finalize();
	
	return $response_xml;
}

sub authenticate {
	my $authInfo	= shift;

	my $user				= undef;
	my $pass				= undef;
	my $sessionUser	= undef;
	my $bLogin			= 0;
	if (ref($authInfo) eq 'ARRAY') {
		&debug("Authentiating via username and password");
		$user									= ${$authInfo}[0];
		$pass									= ${$authInfo}[1];
		$HaCi::HaCi::session	= &HaCi::HaCi::getSession();
		$bLogin								= 1;
	}
	elsif (ref($authInfo) eq '') {
		&debug("Authentiating via sessionID: " . $authInfo);
		$HaCi::HaCi::session	= &HaCi::HaCi::getSession($authInfo);
		$sessionUser					= $HaCi::HaCi::session->param('username');
	}
	my $auth	= &HaCi::HaCi::authentication($user, $pass, $bLogin, $sessionUser);
	if ($auth) {
		&HaCi::Utils::getRights();
	}

	return $auth;
}

=over

=item login()

Login and return your session

 Params

 Returns
    - session        [string]    session token you can use for authentication

=cut

sub login {
	&debug("Login: return session id");
	return $HaCi::HaCi::session->id();
}

=item logout()

Logout

 Params

 Returns

=cut

sub logout {
	&debug("Logout: delete session");
	$HaCi::HaCi::session->delete();
	$HaCi::HaCi::session->flush();

	return 1;
}

=item search()

Search networks

 Params
    - search          [string]  string to search for
    - state           [string]  filter the result by that network state (ALLOCATED PA, ASSIGNED, ...)
    - exact           [string]  don't do a substring search
    - template name   [string]  filter the result by that template name
    - template query  [hash]    filter the result by defining special values for template entries (i.e.: {name => 'POOL1'})
    - root name       [string]  limit the search in that root
    - nrOfFreeSubs    [boolean] compute the number of free subnets in each found network
    - withDetails     [boolean] show details for found networks
    - tags            [string]  return only networks with this tags, seperate with spaces (i.e.: 'OR foo bar', 'AND foo bar')
 Returns
    - networks        [array]    array of found network blocks (hash)
                                 - netID
                                 - network
                                 - rootName
                                 - description
                                 - state
                                 - nrOfFreeSubs
 Example
    my $networks = search('Test', 'ASSIGNED', 0, 'DSL-POOL', {name => 'Pool1'}, 'DSL-Test-Pool-Root', 0);

=cut

sub search {
	my $searchStr		= shift || '';
	my $state				= shift || '';
	my $exact				= shift || 0;
	my $tmplName		= shift || '';
	my $tmplQuery		= shift || {};
	my $rootName		= shift || '';
	my $shNrOfFree	= shift || 0;
	my $withDetails	= shift || 0;
	my $tagsT				= shift || '';
	$tagsT					=~ s/^\s+//;
	$tagsT					=~ s/\s+$//;
	my @tags				= split(/\s+/, $tagsT);
	my $tagOp				= ($tagsT ne '') ? shift @tags : 0;
	if ($tagsT ne '' && scalar @tags == 0) {
		@tags		= ($tagOp);
		$tagOp	= 'OR';
	}

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('search');

	my $tmplID	= ($tmplName ne '') ? &HaCi::Utils::tmplName2ID($tmplName) : -1;
	unless (defined $tmplID) {
		&daw("No such Template found! ($tmplName)\n");
	}

	my $rootID	= ($rootName ne '') ? &HaCi::Utils::rootName2ID($rootName) : -1;
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}
	$rootID	= 0 if $rootID == -1;

	my $tmplBox	= {};
	if ($tmplID != -1) {
		foreach (keys %{$tmplQuery}) {
			my $key						= $_;
			my $value					= $tmplQuery->{$key};
			my $tmplEntryID		= &HaCi::Utils::tmplEntryDescr2EntryID($tmplID, $key);
			next unless defined $tmplEntryID;

			$tmplBox->{$tmplEntryID}	= $value;
		}
	}

	my $stateID	= -1;
	if ($state ne '') {
		$stateID	= &HaCi::Utils::networkStateName2ID($state);
		&daw("State not known! ($state)\nAvailable states: " . join(', ', map {$_->{name}} @{$HaCi::Conf::conf->{static}->{misc}->{networkstates}}) . "\n") unless $stateID;
	}

	my $networks	= &HaCi::Utils::search(
		$searchStr, 
		($exact) ? 0 : 1, 
		0, 
		$shNrOfFree, 
		$rootID, 
		$stateID,
		$tmplID, 
		$tmplBox,
		\@tags,
		$tagOp,
	);

	map {
		delete $_->{url};
		delete $_->{nrOfFreeSubs} unless $shNrOfFree;
		if ($withDetails) {
			my $orig				= $_;
			$_							= &getNetworkDetails($_->{rootName}, $_->{network});
			$_->{netID}			= $_->{ID};
			$_->{tmplName}	= &HaCi::Utils::tmplID2Name($_->{tmplID});
			$_->{rootName}	= $rootName;
			$_->{nrOfFreeSubs}	= $orig->{nrOfFreeSubs} if $shNrOfFree;
			delete $_->{ipv6ID};
			delete $_->{ID};
			delete $_->{tmplID};
			delete $_->{rootID};
		}
	} @{$networks};

	return $networks;
}

=item getFreeSubnets()

Find free subnets in a specified root and supernet and return the wanted amount of subnets

 Params
    - root name       [string]  search free subnets in that root
    - supernet        [network] search free subnets in that supernet (e.g. 192.168.0.0/24, 2001::/120)
    - cidr            [integer] specify the target cidr of your subnets (e.g. 30)
    - amount          [integer] how many subnets you want to get
 Returns
    - networks        [array]   array of free subnets found (hash)
                                - network
 Example
    my $freeSubnets = getFreeSubnets('Test root', '10.184.120.0/23', 32, 1);

=cut

sub getFreeSubnets {
	my $rootName	= shift;
	my $network		= shift;
	my $size			= shift || 0;
	my $amount		= shift || 0;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('search');
	&daw("You have to provide a root name!\n") unless $rootName;
	my $rootID	= &HaCi::Utils::rootName2ID($rootName);
	unless ($rootID) {
		&daw("No such Root found! ($rootName)\n");
		return;
	}

	&daw("You have to provide a network from which you want to get a free subnet!\n") unless $network;

	my $ipv6				= ($network =~ /:/) ? 1 : 0;
	my $networkDec  = ($ipv6) ? &HaCi::Mathematics::netv62Dec($network) : &HaCi::Mathematics::net2dec($network);
	my $ipv6ID			= ($ipv6) ? &HaCi::Utils::netv6Dec2ipv6ID($networkDec) : '';
	my $netID				= &HaCi::Utils::getNetID($rootID, $networkDec, $ipv6ID);

	unless ($netID) {
		&daw("No such network found! ($network)\n");
		return;
	}
	unless (&HaCi::Utils::checkNetACL($netID, 'r')) {
		&daw("Not enouph permissions to read this Network\n");
		return;
	}

	my @freeSubnets	= &HaCi::Utils::getFreeSubnets($netID, 0, $size, $amount || 1);
	return \@freeSubnets;
}

=item getFreeSubnetsFromSearch()

Search networks and return free subnets from them

 Params
    - search          [string]  string to search for
    - state           [string]  filter the result by that network state (ALLOCATED PA, ASSIGNED, ...)
    - exact           [string]  don't do a substring search
    - template name   [string]  filter the result by that template name
    - template query  [hash]    filter the result by defining special values for template entries (i.e.: {name => 'POOL1'})
    - root name       [string]  limit the search in that root
    - cidr            [integer] specify the target cidr of your subnets (e.g. 30)
    - amount          [integer] how many subnets you want to get
 Returns
    - networks        [array]   array of free subnets found (hash)
                                - network
                                - root name
 Example
    my $freeSubnets = getFreeSubnetsFromSearch('search me', '', 1, '', {}, 'Test-Root', 29, 3);

=cut

sub getFreeSubnetsFromSearch {
	my $searchStr	= shift || '';
	my $state			= shift || '';
	my $exact			= shift || 0;
	my $tmplName	= shift || '';
	my $tmplQuery	= shift || {};
	my $rootName	= shift || '';
	my $size			= shift || 0;
	my $amount		= shift || 0;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('search');
	&daw("You have to provide a search string!\n") unless $searchStr;

	my $tmplID	= ($tmplName ne '') ? &HaCi::Utils::tmplName2ID($tmplName) : -1;
	unless (defined $tmplID) {
		&daw("No such Template found! ($tmplName)\n");
	}

	my $rootID	= ($rootName ne '') ? &HaCi::Utils::rootName2ID($rootName) : -1;
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}
	$rootID	= 0 if $rootID == -1;

	my $tmplBox	= {};
	if ($tmplID > -1) {
		foreach (keys %{$tmplQuery}) {
			my $key						= $_;
			my $value					= $tmplQuery->{$key};
			my $tmplEntryID		= &HaCi::Utils::tmplEntryDescr2EntryID($tmplID, $key);
			next unless defined $tmplEntryID;

			$tmplBox->{$tmplEntryID}	= $value;
		}
	}

	my $stateID	= -1;
	if ($state ne '') {
		$stateID	= &HaCi::Utils::networkStateName2ID($state);
		&daw("State not known! ($state)\nAvailable states: " . join(', ', map {$_->{name}} @{$HaCi::Conf::conf->{static}->{misc}->{networkstates}}) . "\n") unless $stateID;
	}

	my $networks	= &HaCi::Utils::searchAndGetFreeSubnets(
		$searchStr, 
		($exact) ? 0 : 1, 
		0, 
		0, 
		$rootID, 
		$stateID,
		$tmplID, 
		$tmplBox, 
		$size, 
		$amount
	);

	map {
		delete $_->{url};
		delete $_->{dec};
		delete $_->{rootID};
	} @{$networks};

	return $networks;
}

=item listRoots()

Add a root to HaCi

 Params
 Returns
    - roots        [array]    array of found roots (hash)
                                 - ID
                                 - name
                                 - ipv6 (boolean)

=cut

sub listRoots {

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('showRoots');
	
	my $roots	= HaCi::Utils::getRoots();

	return $roots
}

=item addRoot()

Add a root to HaCi

 Params
    - root name       [string]  add a root with this name
    - description     [string]  description of the root
    - ipv6            [boolean] this root contains IPv6 networks
 Returns
    - success         [string] 0 on success, error-String at error

=cut

sub addRoot {
	my $rootName		= shift || '';
	my $descr				= shift || '';
	my $ipv6				= shift || 0;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('addRoot');

	my $success	= &HaCi::Utils::addRoot(
		$rootName,
		$descr,
		$ipv6,
	);

	my $error	= ($success) ? '' : "error adding a new root '$rootName': " . join("\n", @{$HaCi::Conf::conf->{var}->{warnl}}) . "\n";
	&warnl($error) if $error;

	return ($success) ? 0 : $error;
}

=item editRoot()

Edit an existing root

 Params
    - root name      [string]  edit this root
    - new root name  [string]  change root name
    - description    [string]  new description of the root
 Returns
    - success         [string] 0 on success, error-String at error

=cut

sub editRoot {
	my $rootName		= shift || '';
	my $newRootName	= shift || '';
	my $description	= shift || '';
	$newRootName		= $rootName if $newRootName eq '';

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('editRoot');
	&daw("No root name committed!\n") unless $rootName;

	my $rootID	= &HaCi::Utils::rootName2ID($rootName);
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}

	my $root			= &HaCi::Utils::getMaintInfosFromRoot($rootID);
	$description	= $root->{description} if $description eq '';

	my $success	= &HaCi::Utils::addRoot(
		$newRootName,
		$description,
		$root->{ipv6},
		$rootID,
		1,
	);

	my $error	= ($success) ? '' : "error while modifying this root '$rootName': " . join("\n", @{$HaCi::Conf::conf->{var}->{warnl}}) . "\n";
	&warnl($error) if $error;

	return ($success) ? 0 : $error;
}

=item delRoot()

Delete a root from HaCi

 Params
    - root name       [string]  remove the root
 Returns
    - success         [string] 0 on success, error-String at error

=cut

sub delRoot {
	my $rootName		= shift || '';

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('editRoot');
	&daw("No root name committed!\n") unless $rootName;

	my $rootID	= &HaCi::Utils::rootName2ID($rootName);
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}

	my $success	= &HaCi::Utils::delRoot($rootID);
	my $error		= ($success) ? '' : "error removing this root '$rootName': " . join("\n", @{$HaCi::Conf::conf->{var}->{warnl}}) . "\n";
	&warnl($error) if $error;

	return ($success) ? 0 : $error;
}

=item addNet()

Add a network to HaCi

 Params
    - root name       [string]  add the network to this root
    - network         [network] add this network (e.g. 192.168.0.1/32, 2001::dead:beef:0/125)
    - description     [string]  description of the network
    - state           [string]  state of the network (e.g. ALLOCATED PA, ASSIGNED, ...)
    - def subnet Size [integer] define a default subnet cidr size (e.g. 30)
    - template name   [string]  assign a template to the network
    - template values [hash]    pass template values (e.g. {hostname => 'abc.de', os => 'redhat'})
    - tags						[string]  add tags (seperate by comma)
 Returns
    - success         [string] 0 on success, error-String at error

=cut

sub addNet {
	my $rootName		= shift || '';
	my $network			= shift || '';
	my $descr				= shift || '';
	my $state				= shift || '';
	my $defSubSize	= shift || 0;
	my $tmplName		= shift || '';
	my $tmplValues	= shift || {};
	my $tags				= shift || '';
	my $isIPv4      = qr/(\d{1,3}\.){3}\d{1,3}/i;
	my $isIPv6      = qr/(((?=(?>.*?::)(?!.*::)))(::)?([0-9A-F]{1,4}::?){0,5}|([0-9A-F]{1,4}:){6})(\2([0-9A-F]{1,4}(::?|$)){0,2}|((25[0-5]|(2[0-4]|1[0-9]|[1-9])?[0-9])(\.|$)){4}|[0-9A-F]{1,4}:[0-9A-F]{1,4})(?<![^:]:)(?<!\.)\z/i;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('addNet');

	my ($ip, $cidr)	= split(/\//, $network);
	&daw("This '$ip' is not a valid ip address (i.e.: 1.2.3.4/30, 2001:dead:beaf::/66)\n") if $ip !~ /$isIPv4/ && $ip !~ /$isIPv6/;

	my $stateID	= 0;
	if ($state ne '') {
		$stateID	= &HaCi::Utils::networkStateName2ID($state);
		&daw("State not known! ($state)\nAvailable states: " . join(', ', map {$_->{name}} @{$HaCi::Conf::conf->{static}->{misc}->{networkstates}}) . "\n") unless $stateID;
	}

	my $tmplID	= ($tmplName ne '') ? &HaCi::Utils::tmplName2ID($tmplName) : -1;
	unless (defined $tmplID) {
		&daw("No such Template found! ($tmplName)\n");
	}
	my $rootID	= ($rootName ne '') ? &HaCi::Utils::rootName2ID($rootName) : -1;
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}
	$rootID	= 0 if $rootID == -1;

	my $tmplValueBox	= {};
	if ($tmplID != -1) {
		my $tmplEntries	= &HaCi::Utils::getTemplateEntries($tmplID, 0, 0, 1, 0, 1);
		foreach (keys %{$tmplEntries}) {
			my $id		= $_;
			my $name	= $tmplEntries->{$id};
			foreach (keys %{$tmplValues}) {
				if ($name eq $_) {
					$tmplValueBox->{$id}	= $tmplValues->{$_};
				}
			}
		}
	}

	my $success	= &HaCi::Utils::addNet(
		0,
		$rootID,
		$ip,
		$cidr,
		$descr,
		$stateID,
		$tmplID,
		$defSubSize,
		1,
		$tmplValueBox,
		0,
		$tags,
	);

	my $error	= ($success) ? '' : "error adding this new network '$ip/$cidr': " . join("\n", @{$HaCi::Conf::conf->{var}->{warnl}}) . "\n";
	&warnl($error) if $error;

	return ($success) ? 0 : $error;
}

=item editNet()

Edit an existing network

 Params
    - root name   [string]  edit the network in this root
    - network     [network] edit this network (e.g. 192.168.0.1/32, 2001::dead:beef:0/125)
    - changes     [hash]    changes (valid attributes are: network description state rootName defSubnetSize tmplName tmplValues)
                            e.g.:
                             {description => 'test_8'}
                             {network => '192.168.0.8/29', defSubnetSize=>30, state=>'FREE', rootName=>'larsux.de'}
 Returns
    - success         [string] 0 on success, error-String at error

=cut

sub editNet {
	my $rootName		= shift || '';
	my $network			= shift || '';
	my $changeData	= shift || {};
	my @keys				= qw(network description state rootName defSubnetSize tmplName tmplValues tags);

	my $isIPv4      = qr/(\d{1,3}\.){3}\d{1,3}/i;
	my $isIPv6      = qr/(((?=(?>.*?::)(?!.*::)))(::)?([0-9A-F]{1,4}::?){0,5}|([0-9A-F]{1,4}:){6})(\2([0-9A-F]{1,4}(::?|$)){0,2}|((25[0-5]|(2[0-4]|1[0-9]|[1-9])?[0-9])(\.|$)){4}|[0-9A-F]{1,4}:[0-9A-F]{1,4})(?<![^:]:)(?<!\.)\z/i;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('editNet');
	&daw("No root name committed!\n") unless $rootName;
	&daw("No network committed!\n") unless $network;
	&daw("The third parameter ('changeData') must be a hash!\n") unless ref($changeData) eq 'HASH';

	foreach (keys %{$changeData}) {
		my $key	= $_;
		unless (grep {/^$key$/} @keys) {
			&daw("Unknown change-attribute: '$key'. Valid attributes are: " . join(', ', @keys) . "\n");
		}
	}

	my $rootID	= &HaCi::Utils::rootName2ID($rootName);
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}

	my $newRootID	= $rootID;
	if (exists $changeData->{rootName}) {
		$newRootID	= &HaCi::Utils::rootName2ID($changeData->{rootName});
		unless ($newRootID) {
			&daw("No such root found! ($changeData->{rootName})\n");
		}
	}

	my $newNetwork				= (exists $changeData->{network}) ? $changeData->{network} : $network;
	my ($ip, $cidr)				= split(/\//, $network);
	my ($newIP, $newCIDR)	= split(/\//, $newNetwork);
	&daw("This '$ip' is not a valid ip address (i.e.: 1.2.3.4/30, 2001:dead:beaf::/66)\n") if $ip !~ /$isIPv4/ && $ip !~ /$isIPv6/;
	&daw("This '$newIP' is not a valid ip address (i.e.: 1.2.3.4/30, 2001:dead:beaf::/66)\n") if $newIP !~ /$isIPv4/ && $newIP !~ /$isIPv6/;

	my $ipv6				= ($network =~ /:/) ? 1 : 0;
	my $networkDec  = ($ipv6) ? &HaCi::Mathematics::netv62Dec($network) : &HaCi::Mathematics::net2dec($network);
	my $ipv6ID			= ($ipv6) ? &HaCi::Utils::netv6Dec2ipv6ID($networkDec) : '';
	my $netID				= &HaCi::Utils::getNetID($rootID, $networkDec, $ipv6ID);
	unless ($netID) {
		&daw("No such network found! ($network)\n");
		return;
	}
	my $netDetails	= &HaCi::Utils::getMaintInfosFromNet($netID);
	my $descr				= (exists $changeData->{description}) ? $changeData->{description} : $netDetails->{description};
	my $defSubSize	= (exists $changeData->{defSubnetSize}) ? $changeData->{defSubnetSize} : $netDetails->{defSubnetSize};
	my $tags				= (exists $changeData->{tags}) ? $changeData->{tags} : join(',', @{$netDetails->{tags}});

	my $stateID	= $netDetails->{state};
	if (exists $changeData->{state}) {
		$stateID	= &HaCi::Utils::networkStateName2ID($changeData->{state});
		&daw("State not known! ($changeData->{state})\nAvailable states: " . join(', ', map {$_->{name}} @{$HaCi::Conf::conf->{static}->{misc}->{networkstates}}) . "\n") unless $stateID;
	}

	my $tmplID	= (exists $changeData->{tmplName}) ? $changeData->{tmplName} : $netDetails->{tmplID};
	if (exists $changeData->{tmplName}) {
		$tmplID	= &HaCi::Utils::tmplName2ID($changeData->{tmplName});
		unless (defined $tmplID) {
			&daw("No such Template found! ($changeData->{tmplName})\n");
		}
	}

	my $tmplValueBox	= 0;
	if (exists $changeData->{tmplValues}) {
		$tmplValueBox	= {};
		die "Template values must be a hash\n" unless ref($changeData->{tmplValues}) eq 'HASH';
		my $tmplEntries	= &HaCi::Utils::getTemplateEntries($tmplID, 0, 0, 1, 0, 1);
		foreach (keys %{$tmplEntries}) {
			my $id		= $_;
			my $name	= $tmplEntries->{$id};
			foreach (keys %{$changeData->{tmplValues}}) {
				if ($name eq $_) {
					$tmplValueBox->{$id}	= $changeData->{tmplValues}->{$_};
				}
			}
		}
	}

	my $success	= &HaCi::Utils::addNet(
		$netID,
		$newRootID,
		$newIP,
		$newCIDR,
		$descr,
		$stateID,
		$tmplID,
		$defSubSize,
		1,
		$tmplValueBox,
		1,
		$tags,
	);

	my $error	= ($success) ? '' : "error while modifying this network '$ip/$cidr': " . join("\n", @{$HaCi::Conf::conf->{var}->{warnl}}) . "\n";
	&warnl($error) if $error;

	return ($success) ? 0 : $error;
}

=item delNet()

Delete a network from HaCi

 Params
    - root name       [string]  remove the netork from this root
    - network         [network] remove this network (e.g. 192.168.0.1/32, 2001::dead:beef:0/125)
    - network lock    [integer] lock network for X seconds
    - withSubnets     [boolean] also remve subnets
 Returns
    - success         [string] 0 on success, error-String at error

=cut

sub delNet {
	my $rootName			= shift || '';
	my $network				= shift || 0;
	my $networkLock		= shift || $HaCi::Conf::conf->{user}->{misc}->{dftnetworklock} || 0;
	my $bWithSubnets	= shift || 0;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('editNet');

	my $rootID	= ($rootName ne '') ? &HaCi::Utils::rootName2ID($rootName) : -1;
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}
	$rootID	= 0 if $rootID == -1;

	my $ipv6				= ($network =~ /:/) ? 1 : 0;
	my $networkDec  = ($ipv6) ? &HaCi::Mathematics::netv62Dec($network) : &HaCi::Mathematics::net2dec($network);
	my $ipv6ID			= ($ipv6) ? &HaCi::Utils::netv6Dec2ipv6ID($networkDec) : '';
	my $netID				= &HaCi::Utils::getNetID($rootID, $networkDec, $ipv6ID);

	unless ($netID) {
		&daw("No such network found! ($network)\n");
		return;
	}

	my $success	= &HaCi::Utils::delNet($netID, $bWithSubnets, 0, $networkLock);
	my $error	= ($success) ? '' : "error removing this new network '$network': " . join("\n", @{$HaCi::Conf::conf->{var}->{warnl}}) . "\n";
	&warnl($error) if $error;

	return ($success) ? 0 : $error;
}

=item assignFreeSubnet()

Find the next free subnet and assign it in one step

 Params
    - root name       [string]  search free subnets in that root
    - supernet        [network] search free subnets in that supernet (e.g. 192.168.0.0/24, 2001::/120)
    - cidr            [integer] specify the target cidr of your subnets (e.g. 30)
    - description     [string]  description of the network
    - state           [string]  state of the network (e.g. ALLOCATED PA, ASSIGNED, ...)
    - def subnet Size [integer] define a default subnet cidr size (e.g. 30)
    - template name   [string]  assign a template to the network
    - template values [hash]    pass template values (e.g. {hostname => 'abc.de', os => 'redhat'})
 Returns
    - network details [hash]    new network assigned:
                                - netID
                                - network
                                - modify date
                                - ipv6 (boolean)
                                - description
                                - state
                                - create from
                                - create date
                                - default subnet cidr size
                                - template name
                                - modify from

=cut

sub assignFreeSubnet {
	my $rootName			= shift;
	my $network				= shift;
	my $size					= shift || 0;
	my $descr					= shift || '';
	my $state					= shift || '';
	my $defSubSize		= shift || 0;
	my $tmplName			= shift || '';
	my $tmplValueBox	= shift || {};
	my $secondTry			= shift || 0;
	my $amount				= 1;

	&getLock($network);

	my $freeNetworks	= &getFreeSubnets($rootName, $network, $size, $amount);
	&daw("No free subnets found!\n") if scalar @{$freeNetworks} < 1;
	my $freeNet	= ${$freeNetworks}[0];

	if (my $error = &addNet($rootName, $freeNet, $descr, $state, $defSubSize, $tmplName, $tmplValueBox)) {
		if (($error =~ /allready exists/ || $error =~ /already exists/) && !$secondTry) { # retry one time
			&warnl("Network already exists! Retry one more time...");
			&releaseLock($network);
			usleep(rand(1000000));
			return &assignFreeSubnet($rootName, $network, $size, $descr, $state, $defSubSize, $tmplName, $tmplValueBox, 1);
		} else {
			&releaseLock($network);
			&daw($error);
		}
	} else {
		my $netDetails					= &getNetworkDetails($rootName, $freeNet);
		$netDetails->{netID} 		= $netDetails->{ID};
		$netDetails->{tmplName} = &HaCi::Utils::tmplID2Name($netDetails->{tmplID});
		$netDetails->{rootName} = $rootName;
		delete $netDetails->{ipv6ID};
		delete $netDetails->{ID};
		delete $netDetails->{tmplID};
		delete $netDetails->{rootID};

		&releaseLock($network);
		return $netDetails;
	}
}

=item getNetworkDetails()

Get details from a network in HaCi

 Params
    - root name       [string]  get details of a network in this root
    - network         [network] get details of this network (e.g. 192.168.0.1/32, 2001::dead:beef:0/125)
 Returns
    - network         [hash]    network details:
                                - netID
                                - network
                                - modify date
                                - ipv6 (boolean)
                                - description
                                - state
                                - create from
                                - create date
                                - default subnet cidr size
                                - template name
                                - modify from

=cut

sub getNetworkDetails {
	my $rootName	= shift;
	my $network		= shift;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('showNetDet');

	my $rootID	= ($rootName ne '') ? &HaCi::Utils::rootName2ID($rootName) : -1;
	unless ($rootID) {
		&daw("No such root found! ($rootName)\n");
	}
	$rootID	= 0 if $rootID == -1;

	my $ipv6				= ($network =~ /:/) ? 1 : 0;
	my $networkDec  = ($ipv6) ? &HaCi::Mathematics::netv62Dec($network) : &HaCi::Mathematics::net2dec($network);
	my $ipv6ID			= ($ipv6) ? &HaCi::Utils::netv6Dec2ipv6ID($networkDec) : '';
	my $netID				= &HaCi::Utils::getNetID($rootID, $networkDec, $ipv6ID);

	unless ($netID) {
		&daw("No such network found! ($network)\n");
		return;
	}

	my $netDetails	= &HaCi::Utils::getMaintInfosFromNet($netID);
	$netDetails->{network}	= $network;
	$netDetails->{state}		= &HaCi::Utils::networkStateID2Name($netDetails->{state});

	if ($netDetails->{tmplID}) {
		$netDetails->{templateValues}	= &HaCi::Utils::getTemplateData($netID, $netDetails->{tmplID}, 1);
		$netDetails->{template}				= &HaCi::Utils::tmplID2Name($netDetails->{tmplID});
	}

	return $netDetails;
}

sub daw {
	my $msg	= shift;

	&warnl($msg);
	die $msg;
}

sub getLock {
	my $name	= shift;
	my $fileName	= md5_hex($name) . '.lock';
	my $lockFile	= $HaCi::Conf::conf->{static}->{path}->{lockpath} . '/' . $fileName;

	my $waitCnter	= 5;
	while (-f $lockFile) {
		warn "Lockfile '$lockFile' for '$name' found. Waiting...\n";
		usleep(rand(1000000));
		last unless $waitCnter--;
	}

	if (-f $lockFile) {
		my $lockProc	= 'unkonwn';
		unless (open F, $lockFile) {
			warn "Cannot open lockfile '$lockFile' for reading: $!\n";
		} else {
			$lockProc	= <F>;
			close F;
		}
		warn "Locking prozess '$lockProc' seems to die. Overwriting lockfile '$lockFile'.\n";
	}

	open F, '>' . $lockFile or warn "Cannot open lockfile '$lockFile' for writing: $!\n";
	print F $$;
	close F;

	$lockName	= $name;
}

sub releaseLock {
	my $name	= shift;
	my $fileName	= md5_hex($name) . '.lock';
	my $lockFile	= $HaCi::Conf::conf->{static}->{path}->{lockpath} . '/' . $fileName;

	unlink $lockFile or warn "Cannot release lockfile '$lockFile': $!\n";

	$lockName	= undef;
}

=item getSubnets()

Get subnets from a root and optional from a supernet

 Params
    - root name       [string]  get subnets from this root
    - supernet        [network] get subnets from this network (e.g. 192.168.0.1/32, 2001::dead:beef:0/125)
 Returns
    - networks        [array]    array of found networks (hash)
                                 - netID
                                 - network
                                 - modify date
                                 - ipv6 (boolean)
                                 - description
                                 - state
                                 - create from
                                 - create date
                                 - default subnet cidr size
                                 - template name
                                 - modify from
 Example
    my $subnets = getSubnets('Test');
    my $subnets = getSubnets('Test', '192.168.0.0/24');

=cut
sub getSubnets {
	my $rootName	= shift;
	my $network		= shift || 0;

	&daw("Permission denied!\n") unless &HaCi::Utils::checkRight('showNets');
	&daw("You have to provide a root name!\n") unless $rootName;
	my $rootID	= &HaCi::Utils::rootName2ID($rootName);
	unless ($rootID) {
		&daw("No such Root found! ($rootName)\n");
		return;
	}
	my $ipv6	= &HaCi::Utils::rootID2ipv6($rootID);

	my @childs	= ();
	if ($network) {
		my $networkDec  = ($ipv6) ? &HaCi::Mathematics::netv62Dec($network) : &HaCi::Mathematics::net2dec($network);
		my $ipv6ID			= ($ipv6) ? &HaCi::Utils::netv6Dec2ipv6ID($networkDec) : '';
		my $netID				= &HaCi::Utils::getNetID($rootID, $networkDec, $ipv6ID);

		@childs	= &HaCi::Utils::getNetworkChilds($netID, 0, 0);
	} else {
		@childs	= &HaCi::Utils::getNetworkChilds($rootID, 1, 0);
	}

	my @childDetails	= map { 
		my $networkDec					= $_->{network};
		my $network							= ($ipv6) ? &HaCi::Mathematics::netv6Dec2net($networkDec) : &HaCi::Mathematics::dec2net($networkDec);
		my $netDetails					= &getNetworkDetails($rootName, $network);
		$netDetails->{netID} 		= $netDetails->{ID};
		$netDetails->{tmplName} = &HaCi::Utils::tmplID2Name($netDetails->{tmplID});
		$netDetails->{rootName} = $rootName;
		delete $netDetails->{ipv6ID};
		delete $netDetails->{ID};
		delete $netDetails->{tmplID};
		delete $netDetails->{rootID};

		$netDetails;
	} @childs;

	return \@childDetails;
}

=back

=cut

1;

# vim:ts=2:sts=2:sw=2