=head1 DESCRIPTION

This file contains subroutines for editing netgroups - adding, removing netgroups and adding and removing triples in a netgroup.

=cut

use Net::LDAP;
use Net::LDAP::Entry;
use strict;
use vars qw($ldap %in %config %text);

# Connect to LDAP server.

=head2 ldap_connect

Connects to the LDAP server.
Takes the hostname of the server as the one and only argument.
Note that it opens a TLS-connection, so the hostname has to match the hostname in the certificate!

Example:
ldap_connect($server);

=cut

sub ldap_connect {
    my $server = shift;

    return $ldap if($ldap);

    # Take a look at bug 404 if this doesn't work
    $ldap = Net::LDAP->new($server,version => '3') || &error("Cannot connect to LDAP server '$server'");
    my $result = $ldap->start_tls(verify => 'none');
    die "LDAP Error: " . $result->error() if $result->code();

}

=head2 ldap_netgroups_get

Takes a basedn as the one and only argument.
Returns an array of all netgroups in that basedn.

Example:
@netgroups = ldap_netgroups_get($basedn);

=cut

# Get all Netgroups in a given domain $basedn.
sub ldap_netgroups_get($){
    my ($basedn) = @_;

    my $mesg = $ldap->search (base   => "ou=Netgroup,$basedn",
			      filter => "objectClass=nisNetgroup",
                              );
    return $mesg->all_entries();
}

=head2 ldap_netgroup_get_by_name

Takes a basedn and cn as argument.
Returns an array of all netgroups with that name. (Although there should only be one)

Example:
$netgroup = (ldap_netgroup_get_by_name({ basedn => $basedn, cn => $cn}))[0];

=cut

# Get all Netgroups in a given domain $basedn.
sub ldap_netgroup_get_by_name {
    my $args = shift;

    return $ldap->search(base   => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn})->all_entries();
}

=head2 ldap_netgroup_exists

Returns true if a netgroup in the basedn with the cn exists.

Example:
if(ldap_netgroup_exists({ basedn => $basedn, cn => $cn })) {
...
}

=cut

# Returns true if the group $gidNumber exists in domain $basedn.

sub ldap_netgroup_exists {
    my $args = shift;
    ldap_connect($config{'server'}, $config{'rootdn'} ) unless($ldap);
    return $ldap->search(base   => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn})->count();
}

=head2 ldap_netgroup_add

Given a basedn, cn and rootpassword and -dn, it creates a new netgroup.

Example:
ldap_netgroup_add({ basedn => $basedn, cn => $cn, rootdn => $rootdn, rootpw => $rootpw});

=cut


sub ldap_netgroup_add
{
    my $args = shift;

    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    my $entry = Net::LDAP::Entry->new();
    $entry->dn("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn});
    $entry->add(
                objectclass => ['top','nisNetgroup'],
                cn => $args->{cn}
    );

    return $entry->update($ldap);
}

=head2 ldap_netgroup_delete

Given basedn, cn, rootdn and -pw, it deletes the netgroup.

Example:
ldap_netgroup_delete({ basedn => $basedn, cn => $cn, rootdn => $rootdn, rootpw => $rootpw});

=cut

sub ldap_netgroup_delete
{
    my $args = shift;
    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    return $ldap->delete("cn=" . $args->{cn} . ",ou=Netgroup,". $args->{basedn});
}

=head2 ldap_netgroup_rmtriple

Given basedn, cn, triple, rootdn and -pw, it removes the triple from the netgroup.

Example:
ldap_netgroup_rmtriple({ basedn => $basedn, cn => $cn, triples => $triplearrayref, rootdn => $rootdn, rootpw => $rootpw});

=cut

sub ldap_netgroup_rmtriple
{
    my $args = shift;

    $ldap->bind($args->{rootdn}, password => $args->{rootpw});

    # Removing a triple means removing everything and then adding those who shouldn't been deleted back again.
    # Just removing or adding one triple simply doesn't work. :-(

    # Get the existing triples.
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn});

    my $entry = ( $mesg->entries )[0];
    my @triples =  $entry->get_value('nisNetgroupTriple');

    # XXX
    # Remove $triple from @triples -- can this be done in a more efficiently?
    my @newtriples;
    for (@triples) {
        my $triple = quotemeta($_); #If not, the ()-es in the triple string will be interpreted as sub expressions.
    	push(@newtriples, $_) unless( grep(/^$triple$/, @{$args->{triples}}) );
    }
    # XXX
    
    my @changes;
    push(@changes, add => [ nisNetgroupTriple => \@newtriples ]) if($newtriples[0]);

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn},
    	changes => [ 
		delete => [ nisNetgroupTriple => [] ],
		@changes,
	]
    );
}

=head2 ldap_netgroup_addtriple

Given basedn, cn, triple, rootdn and rootpw, it adds one or more triples to the netgroup.
It does so by deleting and then readding, as just adding or removing one triple doesn't work.

Example:
ldap_netgroup_addtriple({ basedn => $basedn, cn => $cn, triples => $triplearrayref, rootdn => $rootdn, rootpw => $rootpw});

=cut

sub ldap_netgroup_addtriple
{
    my $args = shift;
    my @changes;

    #Get existing triples.
    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn}, filter => "cn=" . $args->{cn});
    
    my $entry = ( $mesg->entries )[0];
    my @existing_triples =  $entry->get_value('nisNetgroupTriple');

    #@triples is still only the old values.
    #If old triples exist, we want to delete them first.
    
    push(@changes, delete => [ nisNetgroupTriple => [] ]) and push(@{$args->{triples}}, @existing_triples) if( $existing_triples[0] );

    # Deleting or adding one at a time doesn't work for some reason, so we must add and delete all
    # entries simultaneously
    push(@changes, add => [ nisNetgroupTriple => $args->{triples} ] ) if( $args->{triples}->[0] );

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn}, changes => \@changes);
}

sub ldap_netgroup_addsubgroup
{
    my $args = shift;


    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn}, filter => "cn=" . $args->{cn});

    my $entry = ( $mesg->entries )[0];
    my @existing_subgroups =  $entry->get_value('memberNisNetgroup');

    my @changes;
    push(@changes, delete => [ memberNisNetgroup => [] ]) if( $existing_subgroups[0] );
    push(@changes, add => [ memberNisNetgroup => $args->{subgroups} ] ) if( $args->{subgroups}->[0] );

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn}, changes => \@changes);
}

sub ldap_netgroup_rmsubgroup
{
    my $args = shift;

    $ldap->bind($args->{rootdn}, password => $args->{rootpw});

    # Removing a triple means removing everything and then adding those who shouldn't been deleted back again.
    # Just removing or adding one triple simply doesn't work. :-(

    # Get the existing triples.
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn});

    my $entry = ( $mesg->entries )[0];
    my @existing_subgroups =  $entry->get_value('memberNisNetgroup');

    my @subgroups;
    for (@existing_subgroups) {
        my $subgroup = quotemeta($_); 
    	push(@subgroups, $_) unless( grep(/^$subgroup$/, @{$args->{subgroups}}) );
    }

    my @changes;

    push(@changes, add => [ memberNisNetgroup => \@subgroups ]) if($subgroups[0]);

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn},
    	changes => [ 
		delete => [ memberNisNetgroup => [] ],
		@changes,
	]
    );
}
=head2 create

This subroutine takes no arguments, but uses the global values given by webmin. (Ugly, but it's the Webmin Way(tm)).
It does some sanity checks on the input given and creates the group if everything is okay.

Example:
create();

=cut

sub create {
    if ( !$in{group} !~ /\W/ && length( $in{group} ) < 9 ) {
        if ( $in{group} =~ /\W/ ) {
            Error( $text{invalid_chars} );
        }
        if ( length( $in{group} ) < 9 ) {
            Error( $text{invalid_length} );
        }
        new_form(%in);
    }
    else {
        if ( ldap_netgroup_exists({ basedn => $config{basedn}, cn => $in{group} }) ) {
            Error( $text{exists} );
        }
        else {
            my $result = ldap_add_netgroup({ basedn => $config{basedn}, cn => $in{group}, rootdn => $config{rootdn}, rootpw => $in{password}});

            if ( $result->code() ) {
                Error( $text{ldap_failed}, $result );
            }
            else {
                print "$text{created}<br>";
            }
        }
    }
}

=head1 AUTHOR

Alex Brasetvik

=cut

1;