#!/usr/bin/perl -w

package Debconf::DbDriver::LDAP2;
use strict;
use Debconf::Log qw(:all);
use Net::LDAP;
use Net::LDAP::Constant qw/LDAP_NO_SUCH_OBJECT/;
use base 'Debconf::DbDriver::Cache';

use fields qw(server port basedn binddn bindpasswd ds timelimit filter);

###################################################################
# Debconf-related functions

sub init {
	my $this = shift;

	$this->SUPER::init(@_);

	$this->error("No 'server' specified") unless exists $this->{server};
	$this->error("No 'basedn' specified") unless exists $this->{basedn};
	
	$this->{basedn} = [split /\s+/, $this->{basedn}];
	$this->{binddn} = '' unless exists $this->{binddn};
	$this->{port} = 389 unless exists $this->{port};
	$this->{timelimit} ||= 0;
	$this->{filter} ||= '(objectclass=debconfDbEntry)';

	$this->bind_ldap;
	return unless $this->{ds};

	debug "db $this->{name}" => "started; basedns are @{$this->{basedn}}";

	1
}

sub exists {
	my $this=shift;
	my $name=shift;

	if(!exists $this->{cache}{$name}) {
		$this->load($name);
		$this->{cache}{$name}||= undef
	}

	!!$this->{cache}{$name}
}

sub load {
	my $this=shift;
	my $name=shift;

	debug "db $this->{name}" => "loading $name";

        my $record = $this->search_ldap($name);
        return unless $record;

	$this->cacheadd($name, $record);

	1
}

sub save {
	my $this=shift;
	my $name=shift;
	my $data=shift;
	
	return if $this->{readonly} or not $this->accept($name);

	debug "db $this->{name}" => "saving $name (dn: ${\( $$data{ldap_dn} ? $$data{ldap_dn} : '' )})";

	$this->add_or_modify_ldap($name, $data)
}

sub remove {
	my $this=shift;
	my $name=shift;

	return if $this->{readonly} or not $this->accept($name);

	my $entry = $this->cached($name);
	my $dn = $entry ? $$entry{ldap_dn} : 'cn=' . $name . ',' . (${$this->{basedn}})[0];
	debug "db $this->{name}" => "removing $name (dn: $dn)";

	$this->delete_ldap($name)
}

sub shutdown {
	my $this = shift;
	
	$this->SUPER::shutdown(@_);
	
	$this->{ds}->unbind();

	1
}

###################################################################
# LDAP-related functions

sub bind_ldap {
	my $this=shift;
	
	debug "db $this->{name}" => "connecting to $this->{server}";

	$this->{ds} = Net::LDAP->new($this->{server}, port => $this->{port}, version => 3);
	if (! $this->{ds}) {
		$this->error("Unable to connect to LDAP server '$$this{server}'");
		return # if not fatal, give up anyway
	}
	
	my $ret;
	if (!($this->{binddn} && $this->{bindpasswd})) {
		debug "db $this->{name}" => "binding anonymously";
		$ret = $this->{ds}->bind;
	} else {
		debug "db $this->{name}" => "binding as $this->{binddn}";
		$ret = $this->{ds}->bind($this->{binddn}, password => $this->{bindpasswd});
	}
	if ($ret->code) {
		$this->error("Bind failed: ".$ret->error);
	}

	!!$this->{ds}
}

sub search_ldap {
	my $this = shift;
	my $name = shift;

	my $data;

	for my $basedn(@{$this->{basedn}}) {
		my $dn = 'cn=' . $name . ',' . $basedn;

		$data = $this->{ds}->search(
			base => $dn,
			sizelimit => 1,
			timelimit => $this->{timelimit},
			filter => $this->{filter},
		);

		if ($data->code and $data->code != LDAP_NO_SUCH_OBJECT) {
			use Data::Dumper;
			print(Dumper($data));
			$this->error("LDAP search for '$dn' failed: ".$data->error);
		}

		last if $data->entries;
	}

	return unless $data->entries;

	my $ldap_entries = $data->as_struct();

	my %debconf_entry = (
		owners => {},
		fields => {},
		variables => {},
		flags => {},
	);

	while(my($dn,$ldap_entry) = each %{$ldap_entries}) {
		$debconf_entry{ldap_dn} = $dn;
		while(my($attr,$values) = each %{$ldap_entry}) {
			next if $attr eq 'objectclass' or $attr eq 'cn';

			$attr =~ s/([a-z])([A-Z])/$1.'_'.lc($2)/ge;

			foreach my $val (@{$values}) {
				if ($attr eq 'owners') {
					$debconf_entry{owners}{$val}=1;
				} elsif ($attr eq 'flags') {
					$debconf_entry{flags}{$val}='true';
				} elsif ($attr eq 'variables') {
					my ($var, $value)=split(/\s*=\s*/, $val, 2);
					$debconf_entry{variables}{$var}=$value;
				} else {
					$val=~s/\\n/\n/g;
					$debconf_entry{fields}{$attr}=$val;
				}
			}
		}
		return \%debconf_entry
	}
}

sub add_or_modify_ldap {
	my $this = shift;
	my $name = shift;
	my $data = shift;

	# (my $entry_cn = $name) =~ s/([,+="<>#;])/\\$1/g;
	my $dn = $$data{ldap_dn} || 'cn=' . $name . ',' . (${$this->{basedn}})[0];

	my %modify_data;
	my $add_data = [
		'objectclass' => 'top',
		'objectclass' => 'debconfdbentry',
		'cn' => $name
	];

	my @fields = keys %{$$data{fields}};
	foreach my $field (@fields) {
		my $ldapname = $field;
		if ( $ldapname =~ s/_(\w)/uc($1)/ge ) {
			$$data{fields}{$ldapname} =  $$data{fields}{$field};
			delete $$data{fields}{$field};
		}
	}
	
	foreach my $field (keys %{$$data{fields}}) {
		next if ($$data{fields}{$field} eq '' && 
			 !($field eq 'value'));

		$modify_data{$field}= $$data{fields}{$field};
		push(@{$add_data}, $field);
		push(@{$add_data}, $$data{fields}{$field});
	}

	my @owners = keys %{$$data{owners}};
	debug "db $this->{name}" => "owners is ".join("  ", @owners);
	$modify_data{owners} = \@owners;
	push(@{$add_data}, 'owners');
	push(@{$add_data}, \@owners);
	
	my @flags = grep { $$data{flags}{$_} eq 'true' } keys %{$$data{flags}};
	if (@flags) {
		$modify_data{flags} = \@flags;
		push(@{$add_data}, 'flags');
		push(@{$add_data}, \@flags);
	}

	$modify_data{variables} = [];
	foreach my $var (keys %{$$data{variables}}) {
		my $variable = "$var=$$data{variables}{$var}";
		push (@{$modify_data{variables}}, $variable);
		push(@{$add_data}, 'variables');
		push(@{$add_data}, $variable);
	}
	
	my($ret, $op);
	if($this->exists($name)) {
		$op = 'modify';
		$ret = $this->{ds}->modify($dn, replace => \%modify_data)
	} else {
		$op = 'add';
		$ret = $this->{ds}->add($dn, attrs => $add_data)
	}
	if ($ret->code) {
		$this->error("LDAP $op for '$dn' failed: ".$ret->error. "(Error message is sometimes misleading. Did you bind with appropriate credentials?)");
	}
}

sub delete_ldap {
	my $this = shift;
	my $name = shift;

	my $entry = $this->cached($name);
	my $dn = $entry ? $$entry{ldap_dn} : 'cn=' . $name . ',' . (${$this->{basedn}})[0];

	my $ret = $this->{ds}->delete($dn);
	if ($ret->code) {
		$this->error("LDAP delete for '$dn' failed: ".$ret->error. "(Error message is sometimes misleading. Did you bind with appropriate credentials?)");
		return undef
	}

	1
}

1