lib/Person.pm

   1 package 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]);
 183                         }
 184                         elsif (!ref ($val))
 185                         {
 186                                 $entry->add ($field => [$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 =cut
 249
 250 sub search
 251 {
 252         my $pkg = shift;
 253         my %patterns = @_;
 254         my %filter = ();
 255         my $filter = '(objectclass=inetOrgPerson)';
 256         my $mesg;
 257         my @retval = ();
 258
 259         for (keys %patterns)
 260         {
 261                 my $key = $_;
 262                 my $val = $patterns{$key};
 263
 264                 $key = $ExternalNames{$key} if (defined ($ExternalNames{$key}));
 265                 if (!defined ($ValidFields{$key}))
 266                 {
 267                         warn ("Not a valid field: $key");
 268                         next;
 269                 }
 270
 271                 $filter{$key} = $val;
 272         }
 273
 274         if (%filter)
 275         {
 276                 if (scalar (keys %filter) == 1)
 277                 {
 278                         my ($key) = keys (%filter);
 279                         my $val = $filter{$key};
 280                         $filter = "(& $filter ($key=$val))";
 281                 }
 282                 else
 283                 {
 284                         my $tmp = join (' ', map { '(' . $_ . '=' . $filter->{$_} . ')' } (keys (%$filter)));
 285                         $filter = "(& $filter (| $tmp))";
 286                 }
 287         }
 288
 289         $mesg = $Ldap->search
 290         (
 291                 base   => $Config{'base_dn'},
 292                 filter => $filter
 293         );
 294
 295         if ($mesg->is_error ())
 296         {
 297                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 298                 return (qw());
 299         }
 300
 301         for ($mesg->entries ())
 302         {
 303                 my $entry = $_;
 304                 my $obj = new ($pkg, $entry);
 305
 306                 push (@retval, $obj);
 307         }
 308
 309         return (@retval);
 310 }
 311
 312 =item I<$obj>-E<gt>B<delete> ()
 313
 314 Deletes the record.
 315
 316 =cut
 317
 318 sub delete
 319 {
 320         my $obj = shift;
 321         my $entry = $obj->{'ldap'};
 322
 323         $entry->changetype ('delete');
 324         $entry->delete ();
 325         $entry->update ($Ldap);
 326
 327         %$obj = ();
 328 }
 329
 330 =item I<$obj>-E<gt>B<lastname> ([I<$lastname>])
 331
 332 Get or set the lastname.
 333
 334 =cut
 335
 336 sub _update_dn
 337 {
 338         my $obj = shift;
 339         my $entry = $obj->{'ldap'};
 340         my $sn = $obj->{'sn'};
 341         my $gn = $obj->{'givenName'};
 342         my $cn = "$sn $gn";
 343         my $dn = "cn=$cn," . $Config{'base_dn'};
 344
 345         $obj->{'cn'} = $cn;
 346
 347         $entry->changetype ('modify');
 348         $entry->replace (sn => $sn, givenName => $gn, cn => $cn);
 349         $entry->dn ($dn);
 350         $entry->update ($Ldap);
 351 }
 352
 353 sub lastname
 354 {
 355         my $obj = shift;
 356
 357         if (@_)
 358         {
 359                 $obj->{'sn'} = shift;
 360                 _update_dn ($obj);
 361         }
 362
 363         return ($obj->{'sn'});
 364 }
 365
 366 =item I<$obj>-E<gt>B<firstname> ([I<$firstname>])
 367
 368 Get or set the firstname.
 369
 370 =cut
 371
 372 sub firstname
 373 {
 374         my $obj = shift;
 375
 376         if (@_)
 377         {
 378                 $obj->{'givenName'} = shift;
 379                 _update_dn ($obj);
 380         }
 381
 382         return ($obj->{'givenName'});
 383 }
 384
 385 =item I<$obj>-E<gt>B<name> ()
 386
 387 Returns the CN.
 388
 389 =cut
 390
 391 sub name
 392 {
 393         my $obj = shift;
 394         return ($obj->{'cn'});
 395 }
 396
 397 =item I<$obj>-E<gt>B<address> ([I<@address>])
 398
 399 =item I<$obj>-E<gt>B<homephone> ([I<@homephone>])
 400
 401 =item I<$obj>-E<gt>B<cellphone> ([I<@cellphone>])
 402
 403 =item I<$obj>-E<gt>B<officephone> ([I<@officephone>])
 404
 405 =item I<$obj>-E<gt>B<fax> ([I<@fax>])
 406
 407 =item I<$obj>-E<gt>B<mail> ([I<@mail>])
 408
 409 =item I<$obj>-E<gt>B<uri> ([I<@uri>])
 410
 411 =item I<$obj>-E<gt>B<group> ([I<@groups>])
 412
 413 Get or set the attribute.
 414
 415 =cut
 416
 417 sub AUTOLOAD
 418 {
 419         my $obj = shift;
 420         my @values = @_;
 421         my $field = $Person::AUTOLOAD;
 422         $field =~ s/.*:://;
 423
 424         return (set ($obj, $field, @values ? [@values] : undef))
 425 }
 426
 427 sub get
 428 {
 429         my $obj = shift;
 430         my $field = shift;
 431
 432         return (set ($obj, $field, undef));
 433 }
 434
 435 sub set
 436 {
 437         my $obj = shift;
 438         my $field = shift;
 439         my $value = @_ ? shift : undef;
 440         my $entry = $obj->{'ldap'};
 441
 442         if (defined ($ExternalNames{$field}))
 443         {
 444                 $field = $ExternalNames{$field};
 445         }
 446         if (!defined ($ValidFields{$field}))
 447         {
 448                 return (undef);
 449         }
 450
 451         if (defined ($value))
 452         {
 453                 $entry->changetype ('modify');
 454
 455                 if ($ValidFields{$field})
 456                 {
 457                         $entry->replace ($field, [@$value]);
 458                         $obj->{$field} = $value;
 459                 }
 460                 else
 461                 {
 462                         splice (@$value, 1) if (scalar (@$value) > 1);
 463                         $entry->replace ($field, $value);
 464                         $obj->{$field} = $value->[0];
 465                 }
 466
 467                 $entry->update ($Ldap);
 468         }
 469
 470         $obj->{$field} = [] unless (defined ($obj->{$field}));
 471
 472         if (wantarray () and $ValidFields{$field})
 473         {
 474                 return (@{$obj->{$field}});
 475         }
 476         else
 477         {
 478                 return ($obj->{$field});
 479         }
 480 }
 481
 482 sub get_user
 483 {
 484         my $pkg = shift;
 485         my $dn = shift;
 486         my ($search) = $dn =~ m/cn\s*=\s*([^,]+)/i;
 487
 488         die unless ($search);
 489
 490         my $cn = '';
 491         my $id = '';
 492
 493         my $mesg = $Ldap->search
 494         (
 495                 base   => $Config{'base_dn'},
 496                 filter => "(cn=$search)"
 497         );
 498
 499         if ($mesg->is_error ())
 500         {
 501                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 502                 return ('');
 503         }
 504
 505         for ($mesg->entries ())
 506         {
 507                 my $e = $_;
 508                 my ($t_cn) = $e->get_value ('cn', asref => 0);
 509                 my ($t_id) = $e->get_value ('uid', asref => 0);
 510
 511                 print STDERR "LDAP result: $t_cn, $t_id";
 512
 513                 if (!$id or $t_id)
 514                 {
 515                         $cn = $t_cn;
 516                         $id = $t_id;
 517                 }
 518         }
 519
 520         return ($cn, $id);
 521 }
 522
 523 =back
 524
 525 =head1 AUTHOR
 526
 527 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 528
 529 =cut