1# configuration for ldap 2 3package Net::LDAP::Config; 4 5use strict; 6use Exporter; 7use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $AUTOLOAD $CONFIG); 8 9=head1 NAME 10 11Net::LDAP::Config - a simple wrapper for maintaining info related to LDAP 12connections 13 14=head1 SYNOPSIS 15 16 my $config = Net::LDAP::Config->new('source' => 'default'); 17 $config->clauth(); # CLI authentation 18 $config->bind( 19 'dn' => $dn, 20 'password' => $password 21 ); # normal authentation 22 23=head1 DESCRIPTION 24 25B<Net::LDAP::Config> is a wrapper module originally written 26for B<ldapsh> but which is useful for much more. It's not very well 27documented just yet, but here are the main uses: 28 29=head1 CONFIG FILE 30 31The config file is a simple INI-style format. There is one special section, 32B<main>, and the only option it recognizes is B<default>, for specifying 33the default source. Any other sections specify an LDAP source. 34 35For example: 36 [ldap] 37 servers: ldap1.domain.com,ldap2.domain.com 38 base: dc=domain,dc=com 39 ssl: require 40 41 [main] 42 default: ldap 43 44A main config file is looked for in /etc/ldapsh_config and 45/usr/local/etc/ldapsh_config, and then in the user's home directory, either 46in the file specified by $LDAP_CONFIG or ~/.ldapsh_config. 47 48=head1 CLI AUTHENTICATION 49 50If you are building an interactive script, you'll want to use this method: 51 52create the configuration object, which basically pulls the server 53configuration from the config file 54 my $config = Net::LDAP::Config->new('source' => 'mysource'); 55 56and then get all of the necessary info 57this caches ldap UIDs in ~/.ldapuids 58 59 $config->clauth(); 60 61=head1 NORMAL AUTHENTICATION 62 63This is where you collect the DN and password and auth normally: 64 65 my $config = Net::LDAP::Config->new('source' => 'mysource'); 66 $config->bind( 67 'dn' => $dn, 68 'password' => $password 69 ); # normal authentation 70 71If you don't want to authenticate, use B<connect>: 72 73 my $config = Net::LDAP::Config->new('source' => 'mysource'); 74 $config->connect(); 75 76Yes, it sucks that there's a difference. I'm still trying 77to clean up the API. 78 79You should probably just use B<bind>, as it behaves well 80either with or without auth information. 81 82=head1 ENVIRONMENT VARIABLES 83 84Here are the environment variables that B<Net::LDAP::Config> uses: 85 86=over 4 87 88=item LDAP_UIDFILE 89 90The file in which to store LDAP DN's. Defaults to ~/.ldapuids. 91This file is maintained automatically by B<Net::LDAP::Config>, although 92you can modify it if you like -- it just caches the searched-for DN 93so you don't have to specify your username each time. 94 95Feel free to recommend a different design. 96 97=item LDAP_CONFIG 98 99A user-specific config file; over-rides any information in the central 100file. Defaults to ~/.ldapsh_config. 101 102=back 103 104=head1 FUNCTIONS 105 106=over 4 107 108=cut 109 110#--------------------------------------------------------------- 111#--------------------------------------------------------------- 112# Code that everyone will use 113 114#----------------------------------------------------------------- 115# debug 116 117=item debug 118 119Can be used to turn debugging on (debug("on")) or off (debug("off")), 120otherwise prints on STDERR anything passed to it if debugging is 121currently on. 122 123=cut 124 125sub debug { 126 if ($_[0]) { 127 $_[0] =~ /^on$/i and do { 128 warn "turning debug on\n"; 129 $Net::LDAP::DEBUG = 1; 130 return; 131 }; 132 $_[0] =~ /^off$/i and do { 133 warn "turning debug off\n"; 134 $Net::LDAP::DEBUG = 0; 135 return; 136 }; 137 } else { 138 return $Net::LDAP::DEBUG || 0; 139 } 140 unless ($Net::LDAP::DEBUG) { return; } 141 if (@_) { 142 warn "$0: @_\n"; 143 } 144 return 1; 145} 146# debug 147#----------------------------------------------------------------- 148 149#----------------------------------------------------------------- 150# error 151 152=item error 153 154Used to store and report errors on the shell. Any arguments 155passed to B<error> are joined into a single error message and 156returned as an error any time B<error> is called. 157 158EXAMPLE 159 160=over 4 161 162if ( error() ) { warn error("There was a problem"); } 163else { dostuff(); } 164 165if (error()) { die error(); } 166 167=back 168 169=cut 170 171sub error { 172 if (@_) { 173 $Net::LDAP::ERROR = join(' ', @_) . "\n"; 174 } 175 176 if ($Net::LDAP::ERROR) { 177 return $Net::LDAP::ERROR; 178 } else { 179 return; 180 } 181} 182# error 183#----------------------------------------------------------------- 184 185#--------------------------------------------------------------- 186#--------------------------------------------------------------- 187# Code related to command-line stuff 188 189use strict; 190use Exporter; 191 192use vars qw($UIDFILE @ISA @EXPORT $VERSION); 193 194@ISA = qw(Exporter); 195@EXPORT = qw( 196 CLIauth 197); 198$VERSION = 2.00; 199 200$UIDFILE = $ENV{'LDAP_UIDFILE'} || glob("~/.ldapuids"); 201 202#----------------------------------------------------------------- 203#----------------------------------------------------------------- 204 205#----------------------------------------------------------------- 206# CLIauth 207 208# command-line authentication routine 209sub CLIauth { 210 debug("Entering CLIauth"); 211 use Term::ReadKey; 212 use Net::LDAP; 213 214 #my ($pass,$dn,$uid,$UIDFILE,$active,$tmp,$server,$base,$tmpdn,$line); 215 #my (%hash,$config->ldap'},$results,%args,$default); 216 217 my (%args,$config,@clist,$tmp,$source,$var,$results,$active,$uid); 218 my (%dns); 219 220 if (@_) { 221 $config = Net::LDAP::Config->new(@_) or die "Could not retrieve config\n"; 222 } 223 224 # now we either have a server list or a defined source 225 # now we need to try to get the user's login 226 227 # retrieve the uids 228 my (%uids,%cuids); 229 %uids = getUids(); 230 231 # cache the existing uids, for later comparison, so we don't rewrite 232 # the file unless it's changed 233 %cuids = %uids; 234 235 unless ($config->dn()) { 236 if ($config->source()) { 237 debug("source is " . $config->source()); 238 if (exists $uids{$config->source()}) { 239 $config->dn($uids{$config->source()}); 240 } 241 } 242 243 debug("looking in servers for uid"); 244 if ($config->servers()) { 245 foreach (@{ $config->servers() }) { 246 if (exists $uids{$_} and $uids{$_}) { 247 debug("uid from $_"); 248 $config->dn($uids{$_}); 249 last; 250 } 251 } 252 } 253 } 254 255 # see if they passed one and not the other... 256 if (! $config->dn() && $config->uid()) { 257 $config->dn($config->uid()); 258 } 259 260 print $config->dn(), "\n"; 261 262 # this tells whether they are piping to us or have an interactive session 263 if (-t STDIN) { 264 $active = '1'; 265 } else { 266 $active = '0'; 267 } 268 269 # no point in prompting if it's not interactive 270 if ($active) { 271 open INPUT, "/dev/tty"; 272 open OUTPUT, ">/dev/tty"; 273 while (! $config->dn()) { 274 print OUTPUT "Username: "; 275 #$uid = <INPUT>; 276 #chomp $uid; 277 $tmp = <INPUT>; 278 chomp $tmp; 279 $config->dn($tmp); 280 } 281 282 while (! $config->password()) { 283 print OUTPUT "password: "; 284 285 ReadMode('noecho'); 286 $tmp = <INPUT>; 287 chomp $tmp; 288 $config->password($tmp); 289 ReadMode('normal'); 290 print OUTPUT "\n"; 291 } 292 293 # if $config->uid() and $config->dn() disagree see if they want to overwrite .uid 294 if ( 295 $config->uid() && 296 ($config->dn() ne $config->uid()) && 297 ($UIDFILE && -f $UIDFILE) 298 ) { 299 print OUTPUT "Overwrite $UIDFILE? (y/[n]) "; 300 chomp ($tmp = <INPUT>); 301 } 302 close INPUT; 303 close OUTPUT; 304 } else { 305 if (! ( $config->dn() && $config->password()) ) { 306 error("You must provide both a uid and a password."); 307 exit(1); 308 } 309 } 310 311 #unless ($config->dn() =~ /^uid=/) 312 unless ($config->dn() =~ /^[a-z]+=/) { 313 debug("dn not found..."); 314 $config->connect() or 315 error("Could not connect to LDAP server " . $config->{'servers'}[0]), return; 316 317 $config->filter("(uid=" . $config->dn() . ")"); 318 $results = $config->search(); 319 320 $results->code and error("CLIauth: ", $results->error()), return; 321 322 if (my $entry = $results->pop_entry) { 323 $config->dn($entry->dn() ); 324 } else { 325 error("CLIauth: Could not find user" . $config->dn()); 326 return; 327 } 328 } 329 330 my $ldap; 331 until ($ldap = $config->ldap()) { 332 debug("have all the info now..."); 333 $config->connect() or 334 error("Could not connect to LDAP server " . $config->server()) && return; 335 } 336 337 $results = $ldap->bind($config->dn(),'password' => $config->password()); 338 $results->code and 339 error("Invalid username (" . $config->dn(). ") or password.") && return; 340 341 $config->ldap($ldap); 342 # now we have successfully connected, so we know we have a valid DN 343 # let's set it everywhere we can 344 if ($config->source()) { 345 #debug("setting uid for source"); 346 $uids{$config->source()} = $config->dn(); 347 } 348 349 foreach (@{ $config->servers() }) { 350 #debug("setting uid for $_"); 351 $uids{$_} = $config->dn(); 352 } 353 354 # if they want to overwrite, or if they don't have the file, try to create it 355 if ( 356 ( 357 ( 358 ( $tmp && 359 ($tmp =~ /^y/) 360 ) || 361 (! -f $UIDFILE) 362 ) && 363 $< != 0 364 ) || 365 join("", sort %uids) ne join("", sort %cuids) 366 ) 367 { 368 debug("writing uids"); 369 writeUids(%uids); 370 } 371 372 return $config; 373} 374# CLIauth 375#----------------------------------------------------------------- 376 377#----------------------------------------------------------------- 378# getUids 379sub getUids { 380 my (%uids,$line); 381 if ($ENV{'HOME'}) { 382 if (-f $UIDFILE) { 383 open UID, "$UIDFILE" or do { 384 error("Cannot read $UIDFILE; ignoring"); 385 next; 386 }; 387 while ($line = <UID>) { 388 my ($tmp1, $tmp2) = split /: /, $line; 389 chomp $tmp2; 390 $uids{$tmp1} = $tmp2; 391 } 392 close UID; 393 } 394 } 395 396 return %uids; 397} 398# getUids 399#----------------------------------------------------------------- 400 401#----------------------------------------------------------------- 402# writeUids 403sub writeUids { 404 my %uids = @_; 405 406 if (open UID, "> $UIDFILE") { 407 foreach (keys %uids) { 408 print UID "$_: $uids{$_}\n"; 409 } 410 close UID; 411 } else { 412 error("Cannot overwrite $UIDFILE; skipping."); 413 return; 414 } 415} 416# writeUids 417#----------------------------------------------------------------- 418 419#--------------------------------------------------------------- 420#--------------------------------------------------------------- 421 422#--------------------------------------------------------------- 423#--------------------------------------------------------------- 424# stuff related to actually connecting to the server 425 426#----------------------------------------------------------------- 427# multiConnect 428 429=item multiConnect 430 431Connects to the first viable ldap server from a list or reference to 432a list. 433 434=cut 435 436sub multiConnect { 437 use Net::LDAP; 438 debug("entering multiConnect"); 439 my ($ldap,@list,$host,%args,$sslcan,$ssl,$config,$source); 440 441 if (ref $_[0] and ref $_[0] eq 'Net::LDAP::Config') { 442 $config = shift; 443 } else { 444 %args = @_; 445 446 # okay, see if we have a valid config... 447 $config = Net::LDAP::Config->new(%args) or die "Invalid config.\n"; 448 } 449 450 #map {print "$_ => $args{$_}\n"; } keys %args; 451 452 unless ($config->servers() ) { 453 $config->error("Failed to acquire a list of servers."); 454 return; 455 } 456 457 @list = @{ $config->servers() }; 458 unless (@list) { error("No server list") && return; } 459 debug("server list is [@list]"); 460 461 unless ($config->ssl()) { 462 $config->ssl('none'); 463 } 464 465 if (eval { require Net::LDAPS; } and ! $@) 466 { 467 debug("ssl capable"); 468 $sslcan = 1; 469 } else { 470 # nothing... 471 } 472 473 for ($config->ssl) { 474 /require/i and do { 475 unless ($sslcan) { 476 error("ssl is required but not possible"); 477 return; 478 } 479 $ssl = 1; 480 next; 481 }; 482 /prefer/i and do { 483 if ($sslcan) { 484 $ssl = 1; 485 } 486 next; 487 }; 488 /none/i and do { 489 $ssl = 0; 490 next; 491 }; 492 if ($sslcan) { $ssl = 1; } 493 } 494 #debug("ssl is $ssl"); 495 496 while (@list and ! $ldap) { 497 $host = shift @list; 498 if ($ssl and $sslcan) { 499 debug("using ssl"); 500 $ldap = Net::LDAPS->new($host,) or next; 501 } else { 502 $ldap = Net::LDAP->new($host,) or next; 503 } 504 } 505 if ($ldap) { 506 $config->ldap($ldap); 507 return $config; 508=begin comment 509 if (wantarray) 510 { 511 return (%$config); 512 } 513 else 514 { 515 return $ldap; 516 } 517=cut 518 } else { 519 return; 520 } 521} 522 523# multiConnect 524#----------------------------------------------------------------- 525 526#----------------------------------------------------------------- 527# servers 528 529=item servers 530 531Allows developers to pick from a list of configured hosts, 532or to get the list. 533 534=cut 535 536sub serverlist { 537 unless ($Net::LDAP::Config::SERVERS) { 538 die "Net::LDAP::Connect is not configured yet; either edit the 539file manually, or run Net::LDAP::Connect::config.\n"; 540 } 541 542 my (@return,$server); 543 544 foreach $server (@_) { 545 if (exists $Net::LDAP::Config::SERVERS->{$server} ) { 546 push @return, $Net::LDAP::Config::SERVERS->{$server}; 547 } 548 } 549 if (@return) { 550 if (wantarray) { 551 return @return; 552 } else { 553 return shift @return; 554 } 555 } else { 556 if (wantarray) { 557 return keys %$Net::LDAP::Config::SERVERS; 558 } 559 } 560} 561# servers 562#----------------------------------------------------------------- 563 564#--------------------------------------------------------------- 565#--------------------------------------------------------------- 566# and here's the actual config code 567 568#--------------------------------------------------------------- 569# AUTOLOAD 570# until i see a reason to do it otherwise, I'm just going to autoload 571# everything... 572sub AUTOLOAD { 573 my $func = &_compile; 574 goto &$func; 575} 576# AUTOLOAD 577#--------------------------------------------------------------- 578 579#--------------------------------------------------------------- 580# _compile 581sub _compile { 582 use vars qw($TEXT); 583 584 $TEXT ||= 585q[ 586 my $config = shift; 587 if (@_) { 588 $config->{$var} = shift; 589 } 590 591 if (wantarray and ref $config->{$var} eq 'ARRAY') { 592 return @{ $config->{$var} }; 593 } elsif (wantarray and ref $config->{$var} eq 'HASH') { 594 return %{ $config->{$var} }; 595 } else { 596 return $config->{$var}; 597 } 598]; 599 600 my ($func,$pack,$func_name); 601 $func = $AUTOLOAD; 602 $func=~/(.+)::([^:]+)$/; 603 ($pack,$func_name) = ($1,$2); 604 605 if ($pack ne 'Net::LDAP::Config') { 606 die "Cannot AUTOLOAD outside of Net::LDAP::Config\n"; 607 } 608 609 eval 610"sub $func_name 611{ 612 my \$var = '$func_name'; 613 $TEXT 614}"; 615 616 return $func_name; 617} 618# _compile 619#--------------------------------------------------------------- 620 621#--------------------------------------------------------------- 622# bind 623sub bind { 624 my $obj = shift; 625 626 my $ldap; 627 unless ($ldap = $obj->ldap()) { 628 $obj->connect() or die "Could not connect to LDAP\n"; 629 $ldap = $obj->ldap(); 630 } 631 632 my %args; 633 634 if (@_) { 635 %args = @_; 636 } 637 638 unless ($obj->anonymous()) { 639 if (my $dn = $obj->dn()) { 640 $args{'dn'} ||= $dn; 641 } 642 if (my $password = $obj->password()) { 643 $args{'password'} ||= $password; 644 } 645 } 646 647 $obj->{'bind'}++; 648 return $obj->ldap()->bind(%args); 649} 650# bind 651#--------------------------------------------------------------- 652 653#--------------------------------------------------------------- 654# clauth 655sub clauth { 656 my $obj = shift; 657 $obj->debug("calling CLIauth"); 658 659 my $config = CLIauth($obj) || die error(); 660 661 662 $obj->debug("config is $config"); 663 $obj->{'connected'}++; 664 return $config; 665} 666# clauth 667#--------------------------------------------------------------- 668 669#--------------------------------------------------------------- 670# connect 671sub connect { 672 my $obj = shift; 673 $obj->debug("calling multiConnect"); 674 675 if (my $config = multiConnect($obj)) { 676 $obj->debug("config is $config"); 677 $obj->{'connected'}++; 678 return $config; 679 } else { 680 warn $config->error, "\n"; 681 exit; 682 } 683 684} 685# connect 686#--------------------------------------------------------------- 687 688#--------------------------------------------------------------- 689sub loadconfig { 690 my ($config,$ref) = @_; 691 692 unless (-e $config) { 693 die "You must create the config, currently set to: \n\t$config\n"; 694 } 695 696 open CONFIG, $config or 697 die "Could not open $config: $!\n"; 698 699 my ($group,$lineno); 700 while (my $line = <CONFIG>) { 701 $lineno++; 702 for ($line) { 703 /^#/ and do { 704 next; 705 }; 706 /^\s*$/ and do { 707 next; 708 }; 709 /^\[*(.+)\]/ and do { 710 $group = $1; 711 next; 712 }; 713 /^([^:]+):\s+(.+)/ and do { 714 unless ($group) { 715 die "Invalid line at line $lineno:\n$line"; 716 } 717 #warn "setting $1 to [$2] in $group\n"; 718 $ref->{$group}->{$1} = $2; 719 next; 720 }; 721 die "Invalid line in $config at line $lineno:\n$line"; 722 } 723 } 724 close CONFIG; 725} 726# loadconfig 727#--------------------------------------------------------------- 728 729#--------------------------------------------------------------- 730sub init { 731 # currently if all of these exist, they'll all be loaded; that's 732 # probably okay... 733 734 # the possible main configs 735 my @mains; 736 if ($_[0]) { 737 push @mains, $_[0]; 738 } 739 push @mains, "/etc/ldapsh_config", "/usr/local/etc/ldapsh_config"; 740 741 # the possible personal configs 742 my @personals; 743 if ($_[0]) { 744 push @personals, $_[0]; 745 } 746 push @personals, glob("~/.ldapsh_config"); 747 748 my %hash; 749 my $loaded = 0; 750 foreach my $config (@mains, @personals) { 751 next unless $config; 752 if (-e $config) { 753 debug "loading $config\n"; 754 loadconfig($config,\%hash); 755 $loaded++; 756 } else { 757 debug "No file $config\n"; 758 } 759 } 760 761 unless ($loaded) { 762 warn "Could not find a configuration file. Please create one of:\n\t" . 763 join("\n\t",@mains,@personals) . "\n"; 764 exit(14); 765 } 766 767 # set up our default source 768 if (exists $hash{'main'} and exists $hash{'main'}->{'default'}) { 769 my $default = $hash{'main'}->{'default'}; 770 debug "default is $default\n"; 771 unless (exists $hash{$default}) { 772 die "Could not find default source '$default'\n"; 773 } 774 $hash{'default'} = $hash{$default}; 775 } 776 777 delete $hash{'main'}; 778 779 # now fix the server stuff 780 foreach my $source (keys %hash) { 781 next if $source eq 'default'; 782 my $servers = $hash{$source}->{'server'} || 783 $hash{$source}->{'servers'} || 784 ""; 785 786 delete $hash{$source}->{'server'}; 787 delete $hash{$source}->{'servers'}; 788 my (@servers,$pattern); 789 if ($servers =~ /\s/) { 790 @servers = split /\s/, $servers; 791 } elsif ($servers =~ /,/) { 792 @servers = split /,/, $servers; 793 } else { 794 # this should only be one server 795 push @servers, $servers; 796 #@servers = ($servers); 797 } 798 unless (@servers) { 799 warn "No servers defined for source '$source'; skipping\n"; 800 delete $hash{$source}; 801 next; 802 } 803 804 $hash{$source}->{'servers'} = \@servers; 805 } 806 807 # this still just feels like a big hack, but that's probably okay... 808 $Net::LDAP::Config::SOURCES = \%hash; 809 810 return \%hash; 811} 812# init 813#--------------------------------------------------------------- 814 815#--------------------------------------------------------------- 816# ldapsearch 817sub ldapsearch { 818 my $obj = shift; 819 unless ($obj->ldap()) { 820 return; 821 } 822 823 return $obj->ldap()->search(@_); 824} 825# ldapsearch 826#--------------------------------------------------------------- 827 828#--------------------------------------------------------------- 829# new 830# build our new config, based on either what is configured in 831# the Sources modules, or what is passed in 832sub new { 833 my $class = shift; 834 if (ref $_[0] eq 'Net::LDAP::Config') { 835 return shift @_; 836 } 837 my $config = {}; 838 bless $config, $class; 839 840 my ($source,%args,$var); 841 %args = @_; 842 843 # pull in the config file 844 # this is what allows us to specify a different config file 845 unless ($Net::LDAP::Config::SOURCES) { 846 my @initargs; 847 if (exists $args{'config'}) { 848 push @initargs, $args{'config'}; 849 } 850 init(@initargs); 851 } 852 853 use subs; 854 # first pull in anything from the basic config 855 if ($args{'source'}) { 856 $source = $Net::LDAP::Config::SOURCES->{$args{'source'}} or die 857"Source '$args{source}' could not be found. Please configure 858Net::LDAP::Sources appropriately.\n"; 859 860 # we just want to call the init for all known routines 861 # it should be set up so that the variables stored also 862 # have routines with the same name 863 foreach $var (keys %$source) { 864 #print "working on $var\n"; 865 my $value = eval { $config->$var($source->{$var}); }; 866 #print "value is $value from $source->{$var}\n"; 867 if ($@) { 868 die "Option '$var' not valid.\n"; 869 } 870 } 871 } 872 873 # then do any overrides based on stuff passed in 874 foreach $var (keys %args) { 875 eval { $config->$var($args{$var}); }; 876 if ($@) { 877 die "Option '$var' not valid.\n"; 878 } 879 } 880 881 #if ($args{'bind') { 882 # $config->bind(); 883 #} 884 # okay, at this point, we theoretically have a complete 885 # config 886 return $config; 887} 888# new 889#--------------------------------------------------------------- 890 891#--------------------------------------------------------------- 892# search 893sub search { 894 my $obj = shift; 895 unless ($obj->ldap()) { 896 $obj->connect(); 897 } 898 899 my %args = @_; 900 901 my %hash; 902 903 # we actually want to allow a null search base 904 $hash{'base'} = $args{'base'} || $obj->base() || ""; 905 #unless ($hash{'base'} = $args{'base'} || $obj->base()) { 906 # warn "LDAP Search base is unset\n"; 907 # return; 908 #} 909 910 unless ($hash{'filter'} = $args{'filter'} || $obj->filter()) { 911 warn "LDAP Search filter is unset\n"; 912 return; 913 } 914 915 unless ($hash{'attrs'} = $args{'attrs'} || $obj->attrs()) { 916 delete $hash{'attrs'}; 917 } 918 919 return $obj->ldapsearch(%hash); 920} 921# search 922#--------------------------------------------------------------- 923 924# $Id: Config.pm,v 1.4 2004/07/26 22:33:08 luke Exp $ 925 9261; 927