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