<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl
# This file was preprocessed, do not edit!


package Debconf::DbDriver::LDAP;
use warnings;
use strict;
use Debconf::Log qw(:all);
use Net::LDAP;
use base 'Debconf::DbDriver::Cache';


use fields qw(server port basedn binddn bindpasswd exists keybykey ds accept_attribute reject_attribute);


sub binddb {
	my $this=shift;

	$this-&gt;error("No server specified") unless exists $this-&gt;{server};
	$this-&gt;error("No Base DN specified") unless exists $this-&gt;{basedn};

	$this-&gt;{binddn} = "" unless exists $this-&gt;{binddn};
	$this-&gt;{port} = 389 unless exists $this-&gt;{port};

	debug "db $this-&gt;{name}" =&gt; "talking to $this-&gt;{server}, data under $this-&gt;{basedn}";

	$this-&gt;{ds} = Net::LDAP-&gt;new($this-&gt;{server}, port =&gt; $this-&gt;{port}, version =&gt; 3);
	if (! $this-&gt;{ds}) {
		$this-&gt;error("Unable to connect to LDAP server");
		return; # if not fatal, give up anyway
	}

	my $rv = "";
	if (!($this-&gt;{binddn} &amp;&amp; $this-&gt;{bindpasswd})) {
		debug "db $this-&gt;{name}" =&gt; "binding anonymously; hope that's OK";
		$rv = $this-&gt;{ds}-&gt;bind;
	} else {
		debug "db $this-&gt;{name}" =&gt; "binding as $this-&gt;{binddn}";
		$rv = $this-&gt;{ds}-&gt;bind($this-&gt;{binddn}, password =&gt; $this-&gt;{bindpasswd});
	}
	if ($rv-&gt;code) {
		$this-&gt;error("Bind Failed: ".$rv-&gt;error);
	}

	return $this-&gt;{ds};
}


sub init {
	my $this = shift;

	$this-&gt;SUPER::init(@_);

	$this-&gt;binddb;
	return unless $this-&gt;{ds};

	$this-&gt;{exists} = {};

	if ($this-&gt;{keybykey}) {
		debug "db $this-&gt;{name}" =&gt; "will get database data key by key";
	}
	else {
		debug "db $this-&gt;{name}" =&gt; "getting database data";
		my $data = $this-&gt;{ds}-&gt;search(base =&gt; $this-&gt;{basedn}, sizelimit =&gt; 0, timelimit =&gt; 0, filter =&gt; "(objectclass=debconfDbEntry)");
		if ($data-&gt;code) {
			$this-&gt;error("Search failed: ".$data-&gt;error);
		}

		my $records = $data-&gt;as_struct();
		debug "db $this-&gt;{name}" =&gt; "Read ".$data-&gt;count()." entries";

		$this-&gt;parse_records($records);

		$this-&gt;{ds}-&gt;unbind;
	}
}


sub shutdown
{
	my $this = shift;

	return if $this-&gt;{readonly};

	if (grep { $this-&gt;{dirty}-&gt;{$_} } keys %{$this-&gt;{cache}}) {
		debug "db $this-&gt;{name}" =&gt; "saving changes";
	} else {
		debug "db $this-&gt;{name}" =&gt; "no database changes, not saving";
		return 1;
	}

	unless ($this-&gt;{keybykey}) {
		$this-&gt;binddb;
		return unless $this-&gt;{ds};
	}

	foreach my $item (keys %{$this-&gt;{cache}}) {
		next unless defined $this-&gt;{cache}-&gt;{$item};  # skip deleted
		next unless $this-&gt;{dirty}-&gt;{$item};	# skip unchanged
		(my $entry_cn = $item) =~ s/([,+="&lt;&gt;#;])/\\$1/g;
		my $entry_dn = "cn=$entry_cn,$this-&gt;{basedn}";
		debug "db $this-&gt;{name}" =&gt; "writing out to $entry_dn";

		my %data = %{$this-&gt;{cache}-&gt;{$item}};
		my %modify_data;
		my $add_data = [ 'objectclass' =&gt; 'top',
				'objectclass' =&gt; 'debconfdbentry',
				'cn' =&gt; $item
		];

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

		foreach my $field (keys %{$data{fields}}) {
			next if ($data{fields}-&gt;{$field} eq '' &amp;&amp;
				 !($field eq 'value'));
			if ((exists $this-&gt;{accept_attribute} &amp;&amp;
				 $field !~ /$this-&gt;{accept_attribute}/) or
				(exists $this-&gt;{reject_attribute} &amp;&amp;
				 $field =~ /$this-&gt;{reject_attribute}/)) {
				debug "db $item" =&gt; "reject $field";
				next;
			}

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

		my @owners = keys %{$data{owners}};
		debug "db $this-&gt;{name}" =&gt; "owners is ".join("  ", @owners);
		$modify_data{owners} = \@owners;
		push(@{$add_data}, 'owners');
		push(@{$add_data}, \@owners);

		my @flags = grep { $data{flags}-&gt;{$_} 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}-&gt;{$var}";
			push (@{$modify_data{variables}}, $variable);
			push(@{$add_data}, 'variables');
			push(@{$add_data}, $variable);
		}

		my $rv="";
		if ($this-&gt;{exists}-&gt;{$item}) {
			$rv = $this-&gt;{ds}-&gt;modify($entry_dn, replace =&gt; \%modify_data);
		} else {
			$rv = $this-&gt;{ds}-&gt;add($entry_dn, attrs =&gt; $add_data);
		}
		if ($rv-&gt;code) {
			$this-&gt;error("Modify failed: ".$rv-&gt;error);
		}
	}

	$this-&gt;{ds}-&gt;unbind();

	$this-&gt;SUPER::shutdown(@_);
}


sub load {
	my $this = shift;
	return unless $this-&gt;{keybykey};
	my $entry_cn = shift;

	my $records = $this-&gt;get_key($entry_cn);
	return unless $records;

	debug "db $this-&gt;{name}" =&gt; "Read entry for $entry_cn";

	$this-&gt;parse_records($records);
}


sub remove {
	return 1;
}


sub save {
	return 1;
}


sub get_key {
	my $this = shift;
	return unless $this-&gt;{keybykey};
	my $entry_cn = shift;

	my $data = $this-&gt;{ds}-&gt;search(
		base =&gt; 'cn=' . $entry_cn . ',' . $this-&gt;{basedn},
		sizelimit =&gt; 0,
		timelimit =&gt; 0,
		filter =&gt; "(objectclass=debconfDbEntry)");

	if ($data-&gt;code) {
		$this-&gt;error("Search failed: ".$data-&gt;error);
	}

	return unless $data-&gt;entries;
	$data-&gt;as_struct();
}

sub parse_records {
	my $this = shift;
	my $records = shift;

	foreach my $dn (keys %{$records}) {
		my $entry = $records-&gt;{$dn};
		debug "db $this-&gt;{name}" =&gt; "Reading data from $dn";
		my %ret = (owners =&gt; {},
			fields =&gt; {},
			variables =&gt; {},
			flags =&gt; {},
		);
		my $name = "";

		foreach my $attr (keys %{$entry}) {
			if ($attr eq 'objectclass') {
				next;
			}
			my $values = $entry-&gt;{$attr};

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

			debug "db $this-&gt;{name}" =&gt; "Setting data for $attr";
			foreach my $val (@{$values}) {
				debug "db $this-&gt;{name}" =&gt; "$attr = $val";
				if ($attr eq 'owners') {
					$ret{owners}-&gt;{$val}=1;
				} elsif ($attr eq 'flags') {
					$ret{flags}-&gt;{$val}='true';
				} elsif ($attr eq 'cn') {
					$name = $val;
				} elsif ($attr eq 'variables') {
					my ($var, $value)=split(/\s*=\s*/, $val, 2);
					$ret{variables}-&gt;{$var}=$value;
				} else {
					$val=~s/\\n/\n/g;
					$ret{fields}-&gt;{$attr}=$val;
				}
			}
		}

		$this-&gt;{cache}-&gt;{$name} = \%ret;
		$this-&gt;{exists}-&gt;{$name} = 1;
	}
}


1
</pre></body></html>