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 all groups with a member named
  38 I<$cn>.
  39
  40 =cut
  41
  42 sub load
  43 {
  44         my $pkg = shift;
  45         my $name = shift;
  46         my $obj;
  47
  48         my $mesg = $Ldap->search
  49         (
  50                 base    => get_config ('base_dn'),
  51                 filter  => "(&(objectClass=groupOfNames)(cn=$name))"
  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                 $obj = new ($pkg, $entry);
  64                 last;
  65         }
  66
  67         return ($obj);
  68 }
  69
  70 sub load_by_member
  71 {
  72         my $pkg = shift;
  73         my $cn = shift;
  74         my $dn = _cn_to_dn ($cn);
  75         my @retval = ();
  76
  77         my $mesg = $Ldap->search
  78         (
  79                 base    => get_config ('base_dn'),
  80                 filter  => "(&(objectClass=groupOfNames)(member=$dn))"
  81         );
  82
  83         if ($mesg->is_error ())
  84         {
  85                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
  86                 return (undef);
  87         }
  88
  89         for ($mesg->entries ())
  90         {
  91                 my $entry = $_;
  92                 push (@retval, new ($pkg, $entry));
  93         }
  94
  95         return (@retval);
  96 }
  97
  98
  99 =item LiCoM::Group-E<gt>B<create> (I<$name>, I<$description>, I<@member_cns>)
 100
 101 Creates and returns a new group. At least one member has to be given to meet
 102 LDAP requirements. I<@members> is an array of CNs.
 103
 104 =cut
 105
 106 sub create ($$$@)
 107 {
 108         my $pkg = shift;
 109         my $name = shift;
 110         my $desc = shift;
 111         my @members = @_;
 112         my $dn = _cn_to_dn ($name);
 113         my ($ou) = get_config ('base_dn') =~ m/\bou\s*=\s*([^,]+)/i;
 114
 115         my $entry = Net::LDAP::Entry->new ();
 116
 117         $entry->add (objectClass => [qw(top groupOfNames)]);
 118         $entry->add (ou => $ou);
 119         $entry->add (cn => $name);
 120         $entry->add (member => [map { _cn_to_dn ($_) } (@members)]);
 121         $entry->add (description => $desc);
 122         $entry->dn ($dn);
 123
 124         $entry->changetype ('add');
 125         my $mesg = $entry->update ($Ldap);
 126
 127         if ($mesg->is_error ())
 128         {
 129                 warn ("Error while creating entry '$dn' on LDAP server: " . $mesg->error_text ());
 130                 return (undef);
 131         }
 132
 133         return (new ($pkg, $entry));
 134 }
 135
 136 =item LiCoM::Group-E<gt>B<all> ()
 137
 138 Returns all group-objects found in the database.
 139
 140 =cut
 141
 142 sub all
 143 {
 144         my $pkg = shift;
 145         my @retval = ();
 146
 147         my $mesg = $Ldap->search
 148         (
 149                 base    => get_config ('base_dn'),
 150                 filter  => "(objectClass=groupOfNames)"
 151         );
 152
 153         if ($mesg->is_error ())
 154         {
 155                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 156                 return (qw());
 157         }
 158
 159         for ($mesg->entries ())
 160         {
 161                 my $entry = $_;
 162                 my $group = new ($pkg, $entry);
 163
 164                 push (@retval, $group);
 165         }
 166
 167         return (@retval);
 168 }
 169
 170 =back
 171
 172 =head1 METHODS
 173
 174 =item I<$obj>-E<gt>B<delete> ()
 175
 176 Deletes the group.
 177
 178 =cut
 179
 180 sub delete
 181 {
 182         my $obj = shift;
 183         my $entry = $obj->{'ldap'};
 184
 185         $entry->changetype ('delete');
 186         $entry->delete ();
 187         $entry->update ($Ldap);
 188
 189         %$obj = ();
 190 }
 191
 192 =item I<$obj>-E<gt>B<get_members> ()
 193
 194 Returns a list of all members.
 195
 196 =cut
 197
 198 sub get_members
 199 {
 200         my $obj = shift;
 201         return (@{$obj->{'members'}});
 202 }
 203
 204 =item I<$obj>-E<gt>B<add_members> (I<@cn>)
 205
 206 Adds the given I<@cn>s to the group, if they aren't already in the group.
 207
 208 =cut
 209
 210 sub add_members
 211 {
 212         my $obj = shift;
 213         my $entry = $obj->{'ldap'};
 214         my @new = @_;
 215         my @tmp;
 216
 217         for (@new)
 218         {
 219                 my $n = $_;
 220                 if (!grep { $_ eq $n } (@{$obj->{'members'}}))
 221                 {
 222                         push (@{$obj->{'members'}}, $n);
 223                 }
 224         }
 225
 226         _update_members ($obj);
 227 }
 228
 229 =item I<$obj>-E<gt>B<del_members> (I<@cn>)
 230
 231 Deletes the given I<@cn>s from the group. Automatically deletes the group if no
 232 members are left (to meet LDAP-standards, mostly..).
 233
 234 =cut
 235
 236 sub del_members
 237 {
 238         my $obj = shift;
 239         my $entry = $obj->{'ldap'};
 240         my @del = @_;
 241
 242         for (@del)
 243         {
 244                 my $d = $_;
 245                 @{$obj->{'members'}} = grep { $d ne $_ } (@{$obj->{'members'}});
 246         }
 247
 248         if (@{$obj->{'members'}})
 249         {
 250                 _update_members ($obj);
 251         }
 252         else
 253         {
 254                 LiCoM::Group::delete ($obj);
 255         }
 256 }
 257
 258 =item I<$obj>-E<gt>B<name> ([I<$name>])
 259
 260 Sets the name if given. Returns the (new) name.
 261
 262 =cut
 263
 264 sub name
 265 {
 266         my $obj = shift;
 267
 268         if (@_)
 269         {
 270                 my $entry = $obj->{'ldap'};
 271                 $obj->{'name'} = shift;
 272
 273                 $entry->changetype ('modify');
 274                 $entry->replace (cn => $obj->{'name'});
 275                 $entry->update ($Ldap);
 276                 $entry->dn (_cn_to_dn ($obj->{'name'}));
 277                 $entry->update ($Ldap);
 278         }
 279
 280         return ($obj->{'name'});
 281 }
 282
 283 =item I<$obj>-E<gt>B<description> ([I<$description>])
 284
 285 Sets the description if given. Returns the (new) description.
 286
 287 =cut
 288
 289 sub description
 290 {
 291         my $obj = shift;
 292
 293         if (@_)
 294         {
 295                 my $entry = $obj->{'ldap'};
 296                 $obj->{'description'} = shift;
 297
 298                 $entry->changetype ('modify');
 299                 $entry->replace (description => $obj->{'description'});
 300                 $entry->update ($Ldap);
 301         }
 302
 303         return ($obj->{'description'});
 304 }
 305
 306 sub _cn_to_dn
 307 {
 308         my $cn = shift;
 309         my $base_dn = get_config ('base_dn') or die;
 310
 311         return ('cn=' . $cn . ',' . $base_dn);
 312 }
 313
 314 sub _update_members
 315 {
 316         my $obj = shift;
 317         my $entry = $obj->{'ldap'};
 318         my @tmp = map { _cn_to_dn ($_); } (@{$obj->{'members'}});
 319
 320         $entry->changetype ('modify');
 321         $entry->replace (member => \@tmp);
 322         $entry->update ($Ldap);
 323 }
 324
 325 =back
 326
 327 =head1 AUTHOR
 328
 329 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 330
 331 =cut