lib/LiCoM/Group.pm

   1 package LiCoM::Group;
   2
   3 use strict;
   4 use warnings;
   5
   6 use LiCoM::Connection (qw($Ldap));
   7 use Net::LDAP;
   8 use Net::LDAP::Filter;
   9
  10 =head1 NAME
  11
  12 LiCoM::Group - High level group management.
  13
  14 =cut
  15
  16 return (1);
  17
  18 sub new
  19 {
  20         my $pkg = shift;
  21         my $entry = shift;
  22         my $obj = {};
  23
  24         $obj->{'name'}        = $entry->get_value ('cn', asref => 0);
  25         $obj->{'description'} = $entry->get_value ('description', asref => 0);
  26         $obj->{'members'}     = [map { m/cn=([^,]+)/i; $1; } ($entry->get_value ('member', asref => 0))];
  27         $obj->{'ldap'}        = $entry;
  28
  29         return (bless ($obj, $pkg));
  30 }
  31
  32 =head1 STATIC FUNCTIONS
  33
  34 =item LiCoM::Group-E<gt>B<load> (I<$cn>)
  35
  36 Loads and returns the group named I<$cn> or with a member named I<$cn>.
  37
  38 =cut
  39
  40 sub load
  41 {
  42         my $pkg = shift;
  43         my $name = shift;
  44         my $member_dn = 'cn=' . $name . ',' . $Config{'base_dn'};
  45         my @retval = ();
  46
  47         my $mesg = $Ldap->search
  48         (
  49                 base    => $Config{'base_dn'},
  50                 filter  => "(&(objectClass=groupOfNames)(|(cn=$name)(member=$member_dn)))"
  51         );
  52
  53         if ($mesg->is_error ())
  54         {
  55                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
  56                 return (undef);
  57         }
  58
  59         for ($mesg->entries ())
  60         {
  61                 my $entry = $_;
  62                 push (@retval, new ($pkg, $entry));
  63         }
  64
  65         return (@retval);
  66 }
  67
  68 =item LiCoM::Group-E<gt>B<create> (I<$name>, I<$description>, I<@members>)
  69
  70 Creates and returns a new group. At least one member has to be given to meet
  71 LDAP requirements.
  72
  73 =cut
  74
  75 sub create ($$$@)
  76 {
  77         my $pkg = shift;
  78         my $name = shift;
  79         my $desc = shift;
  80         my @members = @_;
  81         my $dn = "cn=$name," . $Config{'base_dn'};
  82
  83         my $entry = Net::LDAP::Entry->new ();
  84
  85         $entry->add (objectClass => [qw(top groupOfNames)]);
  86         $entry->add (cn => $name);
  87         $entry->add (member => [map { $_->get ('dn') } (@members)]);
  88         $entry->add (description => $desc);
  89         $entry->dn ($dn);
  90
  91         $entry->changetype ('add');
  92         my $mesg = $entry->update ($Ldap);
  93
  94         if ($mesg->is_error ())
  95         {
  96                 warn ("Error while creating entry '$dn' on LDAP server: " . $mesg->error_text ());
  97                 return (undef);
  98         }
  99
 100         return (new ($pkg, $entry));
 101 }
 102
 103 =item LiCoM::Group-E<gt>B<all> ()
 104
 105 Returns all group-objects found in the database.
 106
 107 =cut
 108
 109 sub all
 110 {
 111         my $pkg = shift;
 112         my @retval = ();
 113
 114         my $mesg = $Ldap->search
 115         (
 116                 base    => $Config{'base_dn'},
 117                 filter  => "(objectClass=groupOfNames)"
 118         );
 119
 120         if ($mesg->is_error ())
 121         {
 122                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 123                 return (qw());
 124         }
 125
 126         for ($mesg->entries ())
 127         {
 128                 my $entry = $_;
 129                 my $group = new ($pkg, $entry);
 130
 131                 push (@retval, $group);
 132         }
 133
 134         return (@retval);
 135 }
 136
 137 =back
 138
 139 =head1 METHODS
 140
 141 =item I<$obj>-E<gt>B<delete> ()
 142
 143 Deletes the group.
 144
 145 =cut
 146
 147 sub delete
 148 {
 149         my $obj = shift;
 150         my $entry = $obj->{'ldap'};
 151
 152         $entry->changetype ('delete');
 153         $entry->delete ();
 154         $entry->update ($Ldap);
 155
 156         %$obj = ();
 157 }
 158
 159 =item I<$obj>-E<gt>B<get_members> ()
 160
 161 Returns a list of all members.
 162
 163 =cut
 164
 165 sub get_members
 166 {
 167         my $obj = shift;
 168         return (@{$obj->{'members'}});
 169 }
 170
 171 =item I<$obj>-E<gt>B<add_members> (I<@cn>)
 172
 173 Adds the given I<@cn>s to the group, if they aren't already in the group.
 174
 175 =cut
 176
 177 sub add_members
 178 {
 179         my $obj = shift;
 180         my $entry = $obj->{'ldap'};
 181         my @new = @_;
 182         my @tmp;
 183
 184         for (@new)
 185         {
 186                 my $n = $_;
 187                 if (!grep { $_ eq $n } (@{$obj->{'members'}}))
 188                 {
 189                         push (@{$obj->{'members'}}, $n);
 190                 }
 191         }
 192
 193         _update_members ($obj);
 194 }
 195
 196 =item I<$obj>-E<gt>B<del_members> (I<@cn>)
 197
 198 Deletes the given I<@cn>s from the group. Automatically deletes the group if no
 199 members are left (to meet LDAP-standards, mostly..).
 200
 201 =cut
 202
 203 sub del_members
 204 {
 205         my $obj = shift;
 206         my $entry = $obj->{'ldap'};
 207         my @del = @_;
 208
 209         for (@del)
 210         {
 211                 my $d = $_;
 212                 @{$obj->{'members'}} = grep { $d ne $_ } (@{$obj->{'members'}});
 213         }
 214
 215         if (@{$obj->{'members'}})
 216         {
 217                 _update_members ($obj);
 218         }
 219         else
 220         {
 221                 LiCoM::Group::delete ($obj);
 222         }
 223 }
 224
 225 sub _update_members
 226 {
 227         my $obj = shift;
 228         my $entry = $obj->{'ldap'};
 229         my @tmp = map { 'cn=' . $_ . ',' . $Config{'base_dn'} } (@{$obj->{'members'}});
 230
 231         $entry->changetype ('modify');
 232         $entry->replace (member => \@tmp);
 233         $entry->update ($Ldap);
 234 }
 235
 236 =item I<$obj>-E<gt>B<name> ([I<$name>])
 237
 238 Sets the name if given. Returns the (new) name.
 239
 240 =cut
 241
 242 sub name
 243 {
 244         my $obj = shift;
 245
 246         if (@_)
 247         {
 248                 my $entry = $obj->{'ldap'};
 249                 $obj->{'name'} = shift;
 250
 251                 $entry->changetype ('modify');
 252                 $entry->replace (cn => $obj->{'name'});
 253                 $entry->update ($Ldap);
 254                 $entry->dn ('cn=' . $obj->{'name'} . ',' . $Config{'base_dn'});
 255                 $entry->update ($Ldap);
 256         }
 257
 258         return ($obj->{'name'});
 259 }
 260
 261 =item I<$obj>-E<gt>B<description> ([I<$description>])
 262
 263 Sets the description if given. Returns the (new) description.
 264
 265 =cut
 266
 267 sub description
 268 {
 269         my $obj = shift;
 270
 271         if (@_)
 272         {
 273                 my $entry = $obj->{'ldap'};
 274                 $obj->{'description'} = shift;
 275
 276                 $entry->changetype ('modify');
 277                 $entry->replace (description => $obj->{'description'});
 278                 $entry->update ($Ldap);
 279         }
 280
 281         return ($obj->{'description'});
 282 }
 283
 284
 285 =back
 286
 287 =head1 AUTHOR
 288
 289 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 290
 291 =cut