lib/LiCoM/Person.pm

   1 package LiCoM::Person;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Net::LDAP;
   7 use Net::LDAP::Filter;
   8
   9 =head1 NAME
  10
  11 Person - High level interface for address books using an LDAP-backend.
  12
  13 =cut
  14
  15 our %Config =
  16 (
  17         base_dn         => undef
  18 );
  19
  20 our %ValidFields =
  21 (
  22         telephoneNumber                 => 1,
  23         facsimileTelephoneNumber        => 1,
  24         sn                              => 0,
  25         cn                              => 0,
  26         givenName                       => 0,
  27         homePhone                       => 1,
  28         homePostalAddress               => 1,
  29         labeledURI                      => 1,
  30         mail                            => 1,
  31         mobile                          => 1,
  32         o                               => 1
  33 );
  34
  35 our %ExternalNames =
  36 (
  37         officephone     => 'telephoneNumber',
  38         fax             => 'facsimileTelephoneNumber',
  39         lastname        => 'sn',
  40         name            => 'cn',
  41         firstname       => 'givenName',
  42         homephone       => 'homePhone',
  43         address         => 'homePostalAddress',
  44         uri             => 'labeledURI',
  45         mail            => 'mail',
  46         cellphone       => 'mobile',
  47         group           => 'o'
  48 );
  49
  50 our $Ldap;
  51
  52 return (1);
  53
  54 =head1 METHODS
  55
  56 =over 4
  57
  58 =item Person-E<gt>B<connect> (I<$server>, I<$bind_dn>, I<$password>, I<$base_dn>, [I<$port>])
  59
  60 Connects to the LDAP-Server given.
  61
  62 =cut
  63
  64 sub connect
  65 {
  66         my $pkg = shift;
  67         my %opts = @_;
  68
  69         my $bind_dn = $opts{'bind_dn'};
  70         my $base_dn = $opts{'base_dn'};
  71         my $uri     = $opts{'uri'};
  72         my $passwd  = $opts{'password'};
  73
  74         my $msg;
  75
  76         $Ldap = Net::LDAP->new ($uri);
  77
  78         $msg = $Ldap->bind ($bind_dn, password => $passwd);
  79         if ($msg->is_error ())
  80         {
  81                 warn ('LDAP bind failed: ' . $msg->error_text ());
  82                 return (0);
  83         }
  84
  85         $Config{'base_dn'} = $base_dn;
  86
  87         return (1);
  88 }
  89
  90 =item Person-E<gt>B<disconnect> ()
  91
  92 Disconnect from the LDAP-Server.
  93
  94 =cut
  95
  96 sub disconnect
  97 {
  98         $Ldap->unbind ();
  99         $Ldap = undef;
 100 }
 101
 102 =item Person-E<gt>B<new> (I<$ldap_entry>)
 103
 104 Created a new I<Person>-object from the passed I<Net::LDAP::Entry>-object.
 105
 106 =cut
 107
 108 sub new
 109 {
 110         my $pkg = shift;
 111         my $entry = shift;
 112         my $obj = {};
 113
 114         $obj->{'dn'} = $entry->dn ();
 115         $obj->{'ldap'} = $entry;
 116
 117         for (keys %ValidFields)
 118         {
 119                 my $key = $_;
 120                 $obj->{$key} = $entry->get_value ($key, asref => $ValidFields{$key});
 121         }
 122
 123         return (bless ($obj, $pkg));
 124 }
 125
 126 =item Person-E<gt>B<load> (I<$cn>)
 127
 128 Loads the given CN and returns the B<Person>-object.
 129
 130 =cut
 131
 132 sub load
 133 {
 134         my $pkg = shift;
 135         my $cn = shift;
 136
 137         my ($retval) = search ($pkg, [[cn => $cn]]);
 138
 139         if (!$retval)
 140         {
 141                 warn ("CN '$cn' could not be found");
 142                 return (undef);
 143         }
 144
 145         return ($retval);
 146 }
 147
 148 =item Person-E<gt>B<create> (B<lastname> =E<gt> I<$lastname>, B<firstname> =E<gt> I<$firstname>, ...)
 149
 150 Create a new I<Net::LDAP::Entry>-object and return it's corresponding
 151 I<Person>-object.
 152
 153 =cut
 154
 155 sub create
 156 {
 157         my $pkg = shift;
 158
 159         my %hash = @_;
 160         my $entry = Net::LDAP::Entry->new ();
 161         my $dn;
 162         my $ou;
 163
 164         $entry->add (objectClass => [qw(top organizationalUnit person organizationalPerson inetOrgPerson)]);
 165
 166         for (keys %hash)
 167         {
 168                 my $key = $_;
 169                 my $val = $hash{$key};
 170                 my $field = defined ($ExternalNames{$key}) ? $ExternalNames{$key} : $key;
 171
 172                 if (!defined ($ValidFields{$field}))
 173                 {
 174                         warn ("Invalid field $field");
 175                         next;
 176                 }
 177
 178                 if ($ValidFields{$field})
 179                 {
 180                         if (ref ($val) eq 'ARRAY')
 181                         {
 182                                 $entry->add ($field => [@$val]) if (@$val);
 183                         }
 184                         elsif (!ref ($val))
 185                         {
 186                                 $entry->add ($field => [$val]) if ($val);
 187                         }
 188                         else
 189                         {
 190                                 warn ("You cannot pass ref-type " . ref ($val));
 191                         }
 192                 }
 193                 else
 194                 {
 195                         my $temp;
 196                         if (ref ($val) eq 'ARRAY')
 197                         {
 198                                 $temp = $val->[0];
 199                         }
 200                         elsif (!ref ($val))
 201                         {
 202                                 $temp = $val;
 203                         }
 204                         else
 205                         {
 206                                 warn ("You cannot pass ref-type " . ref ($val));
 207                         }
 208
 209                         $entry->add ($field => $val) if (defined ($val) and $val);
 210                 }
 211         }
 212
 213         my $sn = $entry->get_value ('sn');
 214         my $gn = $entry->get_value ('givenName');
 215
 216         if (!defined ($sn) or !defined ($gn))
 217         {
 218                 warn ("sn or givenName not given");
 219                 return (undef);
 220         }
 221
 222         $dn = "cn=$sn $gn," . $Config{'base_dn'};
 223         ($ou) = $Config{'base_dn'} =~ m/\bou\s*=\s*([^,]+)/i;
 224
 225         $entry->add (cn => "$sn $gn", ou => $ou);
 226         $entry->dn ($dn);
 227
 228         print "<!--\n";
 229         $entry->dump (*STDOUT);
 230         print "-->\n";
 231
 232         $entry->changetype ('add');
 233         my $mesg = $entry->update ($Ldap);
 234
 235         if ($mesg->is_error ())
 236         {
 237                 warn ("Error while creating entry '$dn' on LDAP server: " . $mesg->error_text ());
 238                 return (undef);
 239         }
 240
 241         return (new ($pkg, $entry));
 242 }
 243
 244 =item Person-E<gt>B<search> (B<firstname> =E<gt> I<"Flor*">)
 245
 246 Search for the given patterns. Returns a list of I<Person>-objects.
 247
 248   @filter =
 249   (
 250     [
 251       [field => value], # OR
 252       [field => value]
 253     ], # AND
 254     ...
 255   );
 256
 257 =cut
 258
 259 sub search
 260 {
 261         my $pkg = shift;
 262
 263         my @patterns = @_;
 264         my @konjunct = ();
 265         my $filter;
 266
 267         my $mesg;
 268         my @retval = ();
 269
 270         for (@patterns)
 271         {
 272                 my $dj = $_;
 273                 my @disjunc = ();
 274
 275                 for (@$dj)
 276                 {
 277                         my $field = $_->[0];
 278                         my $value = $_->[1];
 279
 280                         $field = $ExternalNames{$field} if (defined ($ExternalNames{$field}));
 281                         if (!defined ($ValidFields{$field}))
 282                         {
 283                                 warn ("Not a valid field: $field");
 284                                 next;
 285                         }
 286
 287                         $value =~ s/([\(\)\\])/\\$1/g;
 288
 289                         push (@disjunc, "($field=$value)");
 290                 }
 291
 292                 if (@disjunc)
 293                 {
 294                         push (@konjunct, join ('', '(|', @disjunc, ')'));
 295                 }
 296         }
 297
 298         if (@konjunct)
 299         {
 300                 $filter = join ('', '(&(objectclass=inetOrgPerson)', @konjunct, ')');
 301         }
 302         else
 303         {
 304                 $filter = '(objectclass=inetOrgPerson)';
 305         }
 306
 307         #print STDERR "Debug: using filter: $filter";
 308
 309         $mesg = $Ldap->search
 310         (
 311                 base   => $Config{'base_dn'},
 312                 filter => $filter
 313         );
 314
 315         if ($mesg->is_error ())
 316         {
 317                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 318                 return (qw());
 319         }
 320
 321         for ($mesg->entries ())
 322         {
 323                 my $entry = $_;
 324                 my $obj = new ($pkg, $entry);
 325
 326                 push (@retval, $obj);
 327         }
 328
 329         return (@retval);
 330 }
 331
 332 =item I<$obj>-E<gt>B<delete> ()
 333
 334 Deletes the record.
 335
 336 =cut
 337
 338 sub delete
 339 {
 340         my $obj = shift;
 341         my $entry = $obj->{'ldap'};
 342
 343         $entry->changetype ('delete');
 344         $entry->delete ();
 345         $entry->update ($Ldap);
 346
 347         %$obj = ();
 348 }
 349
 350 =item I<$obj>-E<gt>B<lastname> ([I<$lastname>])
 351
 352 Get or set the lastname.
 353
 354 =cut
 355
 356 sub _update_dn
 357 {
 358         my $obj = shift;
 359         my $entry = $obj->{'ldap'};
 360         my $sn = $obj->{'sn'};
 361         my $gn = $obj->{'givenName'};
 362         my $cn = "$sn $gn";
 363         my $dn = "cn=$cn," . $Config{'base_dn'};
 364
 365         $obj->{'cn'} = $cn;
 366
 367         print STDERR "This is _update_dn, trying to set dn=$dn";
 368
 369         $entry->changetype ('modify');
 370         $entry->replace (sn => $sn, givenName => $gn, cn => $cn);
 371         $entry->update ($Ldap);
 372         $entry->dn ($dn);
 373         $entry->update ($Ldap);
 374 }
 375
 376 sub lastname
 377 {
 378         my $obj = shift;
 379
 380         if (@_)
 381         {
 382                 $obj->{'sn'} = shift;
 383                 _update_dn ($obj);
 384         }
 385
 386         return ($obj->{'sn'});
 387 }
 388
 389 =item I<$obj>-E<gt>B<firstname> ([I<$firstname>])
 390
 391 Get or set the firstname.
 392
 393 =cut
 394
 395 sub firstname
 396 {
 397         my $obj = shift;
 398
 399         if (@_)
 400         {
 401                 $obj->{'givenName'} = shift;
 402                 _update_dn ($obj);
 403         }
 404
 405         return ($obj->{'givenName'});
 406 }
 407
 408 =item I<$obj>-E<gt>B<name> ()
 409
 410 Returns the CN.
 411
 412 =cut
 413
 414 sub name
 415 {
 416         my $obj = shift;
 417         return ($obj->{'cn'});
 418 }
 419
 420 =item I<$obj>-E<gt>B<address> ([I<@address>])
 421
 422 =item I<$obj>-E<gt>B<homephone> ([I<@homephone>])
 423
 424 =item I<$obj>-E<gt>B<cellphone> ([I<@cellphone>])
 425
 426 =item I<$obj>-E<gt>B<officephone> ([I<@officephone>])
 427
 428 =item I<$obj>-E<gt>B<fax> ([I<@fax>])
 429
 430 =item I<$obj>-E<gt>B<mail> ([I<@mail>])
 431
 432 =item I<$obj>-E<gt>B<uri> ([I<@uri>])
 433
 434 =item I<$obj>-E<gt>B<group> ([I<@groups>])
 435
 436 Get or set the attribute.
 437
 438 =cut
 439
 440 sub AUTOLOAD
 441 {
 442         my $obj = shift;
 443         my @values = @_;
 444         my $field = $Person::AUTOLOAD;
 445
 446         return (undef) unless ($field);
 447
 448         $field =~ s/.*:://;
 449
 450         return (set ($obj, $field, @values ? [@values] : undef))
 451 }
 452
 453 sub get
 454 {
 455         my $obj = shift;
 456         my $field = shift;
 457
 458         return (set ($obj, $field, undef));
 459 }
 460
 461 sub set
 462 {
 463         my $obj = shift;
 464         my $field = shift;
 465         my $value = @_ ? shift : undef;
 466         my $entry = $obj->{'ldap'};
 467
 468         if (defined ($ExternalNames{$field}))
 469         {
 470                 $field = $ExternalNames{$field};
 471         }
 472         if (!defined ($ValidFields{$field}))
 473         {
 474                 return (undef);
 475         }
 476
 477         if (defined ($value))
 478         {
 479                 $entry->changetype ('modify');
 480
 481                 if ($ValidFields{$field})
 482                 {
 483                         $entry->replace ($field, [@$value]);
 484                         $obj->{$field} = $value;
 485                 }
 486                 else
 487                 {
 488                         splice (@$value, 1) if (scalar (@$value) > 1);
 489                         $entry->replace ($field, $value);
 490                         $obj->{$field} = $value->[0];
 491                 }
 492
 493                 $entry->update ($Ldap);
 494         }
 495
 496         $obj->{$field} = [] unless (defined ($obj->{$field}));
 497
 498         if (wantarray () and $ValidFields{$field})
 499         {
 500                 return (@{$obj->{$field}});
 501         }
 502         else
 503         {
 504                 return ($obj->{$field});
 505         }
 506 }
 507
 508 sub get_user
 509 {
 510         my $pkg = shift;
 511         my $dn = shift;
 512         my ($search) = $dn =~ m/cn\s*=\s*([^,]+)/i;
 513
 514         die unless ($search);
 515
 516         my $cn = '';
 517         my $id = '';
 518
 519         my $mesg = $Ldap->search
 520         (
 521                 base   => $Config{'base_dn'},
 522                 filter => "(cn=$search)"
 523         );
 524
 525         if ($mesg->is_error ())
 526         {
 527                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 528                 return ('');
 529         }
 530
 531         for ($mesg->entries ())
 532         {
 533                 my $e = $_;
 534                 my ($t_cn) = $e->get_value ('cn', asref => 0);
 535                 my ($t_id) = $e->get_value ('uid', asref => 0);
 536
 537                 if (!$id or $t_id)
 538                 {
 539                         $cn = $t_cn;
 540                         $id = $t_id;
 541                 }
 542         }
 543
 544         return ($cn, $id);
 545 }
 546
 547 sub password
 548 {
 549         my $obj = shift;
 550         my $entry = $obj->{'ldap'};
 551         my $pwd;
 552
 553         if (@_)
 554         {
 555                 $pwd = shift;
 556                 $entry->changetype ('modify');
 557                 $entry->replace (userPassword => $pwd);
 558                 $entry->update ($Ldap);
 559         }
 560
 561         $pwd = $entry->get_value ('userPassword');
 562 }
 563
 564 =back
 565
 566 =head1 AUTHOR
 567
 568 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 569
 570 =cut