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