# $Id: $

=head1 NAME

Mail::Vacation::LDAP - handler for specific methods 

=head1 DESCRIPTION

perl implementation of vacation program, authorisation and control via LDAP

=cut

package Mail::Vacation::LDAP;

=head1 SYNOPSIS

See L<Mail::Vacation>

=head1 ABSTRACT

Perl implementation of the vacation mail handling program, using LDAP as the authentication and control protocol.

=head1 NOTES

Configure this instance in the 'conf/ldap.conf' file

=head1 SCRIPTS

=over 4

=item ldap.pl

ldap script expecting running ldap server with appropriate entries - as per config file

=item ldap.cgi

browse ldap entries via web server

todo: modify entries

=cut

use 5.00;
use strict;
use warnings;
use vars qw(@ISA $VERSION $DEBUG);
$| = 1;

our $VERSION = '0.02';
our $DEBUG   = $Mail::Vacation::DEBUG || 0;
# $Mail::Vacation::DEBUG = $DEBUG;

=head1 SEE ALSO

See also L<Mail::Vacation>

=cut

use Carp qw(croak);
use Data::Dumper;
use Date::Manip;
use DB_File;
use Mail::Vacation;
use Net::LDAP;
use Tie::File;

@ISA = qw(Mail::Vacation);

=head2 EXPORT

None by default.

#=cut

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );

=cut

#	Check for ldap server
#
#	$o_vac->_configure($configfile);

sub _configure {
	my $self   = shift;
	my $config = shift || '';

	$self = $self->SUPER::_configure($config);

	if ($self) {
		my $o_conf = $self->_config;
		unless ($o_conf->server =~ /^([a-z][\w.]+)$/io) {
			$self = $self->_error("no server given: ".Dumper($o_conf));
		}
	}	

	return $self;
}

#	Returns current ldap handler object
#
#	$o_ldap = $o_vac->_ldap;

sub _ldap {
	my $self = shift;
	
	my $o_ldap = $self->{_handler} || '';
	unless (ref($o_ldap)) {
		$self = $self->_error("invalid ldap object($o_ldap) - not started or perhaps disconnected?");
	}

	return $o_ldap;
}

#	Connect and bind to the ldap server from the configuration file
#
#	$o_vac->start;

sub start {
	my $self = shift;

	$self = $self->SUPER::start();

	if (ref($self)) { 
		$self->finish if $self->{_connected};
		my $server = $self->_config->server;
		my %options = $self->_config->hash('server_options');
		my $o_ldap = $self->{_handler} = Net::LDAP->new($server, %options) || "no ldap server?";
		unless (ref($o_ldap)) {
			$self = $self->_error("can't connect to $o_ldap with options: ".Dumper(\%options));
		} else {
			$self->_log("connected to running server($server)"); 
			my %bindings = $self->_config->hash('bind_options');
			my $o_msg = $o_ldap->bind(%bindings);
			if ($o_msg->code) {
				$self = $self->_error("failed to bind: ".$o_msg->error);
			} else {
				$self->{_connected}++;
				$self->_log("bound to server($server)"); 
			}
		}
	}

	return $self;	
}

#	Retrieve the users requested attribute=value pairs data in hashref/s
#
#	($userdata) = $o_vac->_retrieve('filter' => '(cn=common_name)');
#
#	@hash_refs  = $o_vac->_retrieve(%search_parameters);

sub _retrieve {
	my $self  = shift;
	my %pars  = @_;
	my @hret  = ();
	my $i_fnd = 0;

	unless (keys %pars >= 1 && defined($pars{filter}) && $pars{filter} =~ /.+/o) {
		$self->_error("missing required search parameters: ".Dumper(\%pars));
	} else {
		my $o_ldap = $self->_ldap;
		if ($o_ldap) {
			my $o_msg = $o_ldap->search(%pars);
			if ($o_msg->code) {
				$self->_error("LDAP search failure: ".$o_msg->error.' via: '.Dumper(\%pars));
			} else {
				unless ($o_msg->count) {
					$self->_error("no LDAP entries for %pars");
				} else {
					$i_fnd++;
					my $i_entries = my @entries = $o_msg->entries;				
					$self->_log("found $i_entries entry/ies");
					foreach my $o_entry (@entries) {
						my %attrs = ();
						foreach my $attr ($o_entry->attributes) {	
							my $val = $o_entry->get_value($attr) || '';
							$attrs{$attr} = $val;
						}
						push(@hret, \%attrs);
					}
				}
			}
		}
	}

	return @hret;
}

#	Returns message whether or not this mail addressee is on ldap vacation.
#   Also returns array ref of forwarding email addresses, if applicable.
#
#	($from, $message, \@fwd) = $o_vac->_onvacation([h_test]);

sub _onvacation {
	my $self  = shift;
	my $h_test= shift || ''; # unsupported
	my $msg   = '';
	my @fwd   = ();
		
	my $from = $self->_mailfrom();#$o_int);

	my %env  = $self->_config->hash('env');
	my $user = $ENV{$env{user}} || '';
	unless ($user =~ /\w+/o) {
		$self = $self->_error("missing required user address($user) from mail");
	} else {
		my $testflag =  $self->_config->testflag;
		my %attrs    =  $self->_config->hash('attributes');
		my %options  = ($self->_config->hash('search_options'), 'attrs' => [values %attrs]);
		$options{'filter'} =~ s/($attrs{userkey})=\%s/$1=$user/;
		# filter	(&(canTakeAVacation=1)(uid=%s))
		my ($h_data) = ($testflag == 1 && ref($h_test) eq 'HASH') ? $h_test : $self->_retrieve(%options);
		unless (ref($h_data)) {
			$self = $self->_error("no data found for user($user)");
		} else {
			my $i_invac = $self->_invacation($h_data);
			if ($i_invac == 1) {
				my $fromaddr = $attrs{from}   || ''; # key
				$from = $$h_data{$fromaddr}   || '';
				my $message = $attrs{message} || ''; # key
				$msg = $$h_data{$message}     || $attrs{default_message} || '';
				$msg =~ s/\015?\012/\n/gmos; # crlf
				unless ($from =~ /\w+/o && $msg =~ /(.+)/mos) {
					$self->_log("$user has no from address($from) and/or $message data($msg)");
				} else {
					$self = $self->_log("found vacation from($from) and message chars(@{[length($msg)]})");
				}
				my @forward = (ref($attrs{forward}) eq 'ARRAY') ? @{$attrs{forward}} : $attrs{forward} || ''; # key
				my @fwd = ();
				foreach my $forward (@forward) {
					my $addr = $$h_data{$forward} || '';
					push(@fwd, $addr) if $addr;
				}
				unless (@fwd >= 1) {
					$self->_log("$user has no forwarding(@forward) data(@fwd)");
				} else {
					$self = $self->_log("found vacation forward(@forward) data(@fwd)");
				}
			}
		}
	}

	return ($from, $msg, \@fwd);
}

#	unbind from server
#
#	$o_vac->finish;

sub finish {
	my $self = shift;

	$self = $self->SUPER::finish();

	my $o_ldap = $self->_ldap; 
	if (ref($o_ldap)) {
		my $server = $self->_config->server;
		unless ($o_ldap->unbind) {
			$self = $self->_log("can't unbind from $o_ldap server($server)");	
		} else {
			$self->{_ldap} = undef;
			$self->{_connected}--;
			$self->_log("unbound from server($server)"); 
		}
	}

	return $self;	
}

#	close connection

sub DESTROY {
	my $self = shift;

	$self->finish($self->{_server});
}

=head1 AUTHOR

Richard Foley, E<lt>richard.foley@rfi.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2002 by Richard Foley

Sponsered by Octogon Gmbh, Feldafing, Germany

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut

1;