lib/LiCoM/Group.pm

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