lib/LiCoM/Group.pm

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