Net::LDAP::Class::Group::POSIX - group class for POSIX LDAP schema

 # create a subclass for your local LDAP
 package MyLDAPGroup;
 use base qw( Net::LDAP::Class::Group::POSIX );

 __PACKAGE__->metadata->setup(
     base_dn             => 'dc=mycompany,dc=com',
    attributes          => __PACKAGE__->POSIX_attributes,
    unique_attributes   => __PACKAGE__->POSIX_unique_attributes,
 );

 1;

 # then use your class
 my $ldap = get_and_bind_LDAP_object(); # you write this

 use MyLDAPGroup;
 my $group = MyLDAPGroup->new( ldap => $ldap, cn   => 'foobar' );
 $group->read_or_create;
 for my $user ($group->users) {
     printf("user %s in group %s\n", $user, $group);
 }

    perldoc Net::LDAP::Class

package Net::LDAP::Class::Group::POSIX;
use strict;
use warnings;
use Carp;
use base qw( Net::LDAP::Class::Group );

our $VERSION = '0.26';

my $RESERVED_GID = 999999;    # used when renaming groups

# see http://www.ietf.org/rfc/rfc2307.txt

sub POSIX_attributes {

    # these attributes refer to the posixGroup object
    # which SUPER::read() will refer to.
    return [
        qw(
            cn gidNumber memberUid
            )
    ];

}

sub POSIX_unique_attributes {
    return [qw( cn gidNumber )];
}

sub read {
    my $self = shift;
    $self->SUPER::read( base_dn => 'ou=Group,' . $self->base_dn, @_ )
        or return;

    my $name = $self->cn;

    # double check that organizational unit exists too
    if (!$self->find(
            base_dn => 'ou=People,' . $self->base_dn,
            scope   => 'sub',
            filter  => "(ou=$name)"
        )
        )
    {
        croak
            "fatal LDAP error: posixGroup $name found but no matching organizational unit";
    }

    return $self;
}

sub action_for_create {
    my $self = shift;
    my %opts = @_;
    my $name = delete $opts{cn} || $self->cn
        or croak "cn required to create()";
    my $gid = delete $opts{gidNumber} || $self->gidNumber
        or croak "gidNumber required to create()";
    my @actions = (

        add => [

            # first the posixGroup
            {   dn   => "cn=$name,ou=Group," . $self->base_dn,
                attr => [
                    objectClass => [ 'top', 'posixGroup' ],
                    cn          => $name,
                    gidNumber   => $gid,
                ],
            },

            # second the organizational unit
            {   dn   => "ou=$name,ou=People," . $self->base_dn,
                attr => [
                    objectClass => [ 'top', 'organizationalUnit' ],
                    ou          => $name
                ],
            },
        ]
    );

    # special case of passing in '0' (zero) means do not
    # create actions for memberUid.
    my $memberUid = delete $opts{memberUid};
    if ( !defined $memberUid ) {
        $memberUid = $self->memberUid;
    }
    if ( defined $memberUid and ref $memberUid and @$memberUid ) {
        push(
            @actions,
            update => {
                search => [
                    base   => "ou=Group," . $self->base_dn,
                    scope  => "sub",
                    filter => "(cn=$name)"
                ],
                replace => { memberUid => $memberUid },
            }
        );
    }
    elsif ( defined $memberUid and !ref $memberUid and $memberUid ne '0' ) {
        push(
            @actions,
            update => {
                search => [
                    base   => "ou=Group," . $self->base_dn,
                    scope  => "sub",
                    filter => "(cn=$name)"
                ],
                replace => { memberUid => [$memberUid] },
            }
        );
    }

    return @actions;

}

sub action_for_update {
    my $self = shift;
    my %opts = @_;

    if ( !grep { exists $self->{_was_set}->{$_} } @{ $self->attributes } ) {
        warn "no attributes have changed for group $self. Skipping update().";
        return 1;
    }

    my @actions;

    # change gid alone is easy.
    if ( exists $self->{_was_set}->{gidNumber}
        and !exists $self->{_was_set}->{cn} )
    {

        push(
            @actions,
            update => {
                search => [
                    base   => "ou=Group," . $self->base_dn,
                    scope  => "sub",
                    filter => "(cn=" . $self->cn . ")"
                ],
                replace => { gidNumber => $self->gidNumber },
            }
        );

    }

    # changing name, not as easy.
    if ( exists $self->{_was_set}->{cn} ) {

        my $class = ref($self) || $self;

        my $old_name = $self->{_was_set}->{cn}->{old};
        my $new_name = $self->{_was_set}->{cn}->{new};
        if ( $self->debug ) {
            warn "renaming group $old_name to $new_name\n";
        }

        my $oldgroup
            = $class->new( ldap => $self->ldap, cn => $old_name )->read
            or croak "can't find $old_name in LDAP";

        my $new_gid
            = exists $self->{_was_set}->{gidNumber}
            ? $self->{_was_set}->{gidNumber}->{new}
            : $self->gidNumber;

        # LDAP schema requires we rename existing group
        # because we can't delete a non-leaf entry.

        # first, change gid of existing group so we don't get conflicts.
        push(
            @actions,
            update => {
                search => [
                    base   => "ou=Group," . $self->base_dn,
                    scope  => "sub",
                    filter => "(cn=$old_name)"
                ],
                replace => { gidNumber => $RESERVED_GID },
            }
        );

        # second, create the new group
        my $primary_users   = $oldgroup->fetch_primary_users;
        my $secondary_users = $oldgroup->fetch_secondary_users;

        if ( $self->debug ) {
            warn "rename group for $self primary users: "
                . join( ", ", @$primary_users );
            warn "rename group for $self secondary users: "
                . join( ", ", @$secondary_users );
        }

        my $newgroup = $class->new(
            ldap      => $self->ldap,
            cn        => $new_name,
            gidNumber => $self->gidNumber,
            memberUid => [ map {"$_"} @$secondary_users ],
        );
        push( @actions, $newgroup->action_for_create );

        # third, update the gid for any users for whom
        # $old_group is the primary group.
        # primary users need their gid and dn set in 2 steps
        for my $user (@$primary_users) {

            my $uid = $user->uid;

            push(
                @actions,
                update => [
                    {   search => [
                            base   => "ou=People," . $user->base_dn,
                            scope  => "sub",
                            filter => "(uid=$uid)",
                            attrs  => $user->attributes,
                        ],
                        replace => { gidNumber => $new_gid }
                    },
                    {   dn => {
                            'newrdn'       => "uid=$uid",
                            'deleteoldrdn' => 1,
                            'newsuperior'  => "ou=$newgroup,ou=People,"
                                . $self->base_dn,
                        },
                        search => [
                            base   => "ou=People," . $self->base_dn,
                            scope  => "sub",
                            filter => "(uid=$uid)",
                            attrs  => $self->attributes,
                        ],
                    }
                ],
            );

        }

        # fourth and finally, delete the original group
        push(
            @actions,
            $self->action_for_delete(
                gidNumber  => $RESERVED_GID,
                cn         => $old_name,
                skip_check => 1,
            )
        );

    }

    return @actions;
}

sub action_for_delete {
    my $self = shift;
    my %opts = @_;
    my $name = delete $opts{cn} || $self->cn;

    if ( !$name ) {
        croak "cn required to delete a Group";
    }

    # even if called a class method, we need an object
    # in order to find users, etc.
    my $group = ref($self) ? $self : $self->new( cn => $name )->read;
    if ( !$group ) {
        croak "no such Group to delete: $name";
    }

    unless ( $opts{skip_check} ) {

        # set since users() will require it
        $group->cn($name);

        # clear first so we re-read from the db
        $group->clear_primary_users;
        $group->clear_secondary_users;

        if ( scalar @{ $group->users } ) {
            croak
                "cannot delete Group $group -- it still has members: [primary] "
                . join( ", ", map {"$_"} @{ $group->primary_users } )
                . " [secondary] "
                . join( ", ", map {"$_"} @{ $group->secondary_users } );
        }

    }

    my @actions = (
        {   search => [
                base   => 'ou=People,' . $group->base_dn,
                scope  => 'sub',
                filter => "(ou=$name)",
                attrs  => $group->attributes,
            ],
        },
        {   search => [
                base   => "ou=Group," . $group->base_dn,
                scope  => "sub",
                filter => "(cn=$name)",
                attrs  => $group->attributes,
            ],
        },

    );

    return ( delete => \@actions );
}

sub fetch_primary_users {
    my $self       = shift;
    my $user_class = $self->user_class or croak "user_class() required";
    my $name       = $self->cn;
    my @u          = $user_class->find(
        base_dn => "ou=$name,ou=People," . $self->base_dn,
        scope   => "sub",
        filter  => "(objectClass=posixAccount)",
        ldap    => $self->ldap,
    );
    return wantarray ? @u : \@u;
}

sub primary_users_iterator {
    my $self       = shift;
    my $user_class = $self->user_class or croak "user_class required";
    my $name       = $self->cn || $self->read->cn;
    return Net::LDAP::Class::Iterator->new(
        class   => $user_class,
        base_dn => "ou=$name,ou=People," . $self->base_dn,
        filter  => "(objectClass=posixAccount)",
        ldap    => $self->ldap,
        @_
    );
}

# changed to using iterator to avoid surprises for large groups.
sub fetch_secondary_users {
    my $self = shift;
    my @users;
    my $iter = $self->secondary_users_iterator;
    while ( my $u = $iter->next ) {
        push @users, $u;
    }
    return wantarray ? @users : \@users;
}

sub secondary_users_iterator {
    my $self       = shift;
    my $user_class = $self->user_class or croak "user_class required";
    my $ldap       = $self->ldap or croak "ldap required";
    $self->read;    # make sure we have latest memberUid list
    my @uids = $self->memberUid;

    return Net::LDAP::Class::SimpleIterator->new(
        code => sub {
            my $uid = shift @uids or return undef;
            return $user_class->new( ldap => $ldap, uid => $uid )->read;
        }
    );
}

sub gid {
    my $self = shift;
    $self->gidNumber(@_);
}

1;

__END__