diff options
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm')
| -rw-r--r-- | beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm | 263 |
1 files changed, 263 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm new file mode 100644 index 0000000..f2664f6 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/DbDriver/LDAP.pm @@ -0,0 +1,263 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::DbDriver::LDAP; +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->error("No server specified") unless exists $this->{server}; + $this->error("No Base DN specified") unless exists $this->{basedn}; + + $this->{binddn} = "" unless exists $this->{binddn}; + $this->{port} = 389 unless exists $this->{port}; + + debug "db $this->{name}" => "talking to $this->{server}, data under $this->{basedn}"; + + $this->{ds} = Net::LDAP->new($this->{server}, port => $this->{port}, version => 3); + if (! $this->{ds}) { + $this->error("Unable to connect to LDAP server"); + return; # if not fatal, give up anyway + } + + my $rv = ""; + if (!($this->{binddn} && $this->{bindpasswd})) { + debug "db $this->{name}" => "binding anonymously; hope that's OK"; + $rv = $this->{ds}->bind; + } else { + debug "db $this->{name}" => "binding as $this->{binddn}"; + $rv = $this->{ds}->bind($this->{binddn}, password => $this->{bindpasswd}); + } + if ($rv->code) { + $this->error("Bind Failed: ".$rv->error); + } + + return $this->{ds}; +} + + +sub init { + my $this = shift; + + $this->SUPER::init(@_); + + $this->binddb; + return unless $this->{ds}; + + $this->{exists} = {}; + + if ($this->{keybykey}) { + debug "db $this->{name}" => "will get database data key by key"; + } + else { + debug "db $this->{name}" => "getting database data"; + my $data = $this->{ds}->search(base => $this->{basedn}, sizelimit => 0, timelimit => 0, filter => "(objectclass=debconfDbEntry)"); + if ($data->code) { + $this->error("Search failed: ".$data->error); + } + + my $records = $data->as_struct(); + debug "db $this->{name}" => "Read ".$data->count()." entries"; + + $this->parse_records($records); + + $this->{ds}->unbind; + } +} + + +sub shutdown +{ + my $this = shift; + + return if $this->{readonly}; + + if (grep $this->{dirty}->{$_}, keys %{$this->{cache}}) { + debug "db $this->{name}" => "saving changes"; + } else { + debug "db $this->{name}" => "no database changes, not saving"; + return 1; + } + + unless ($this->{keybykey}) { + $this->binddb; + return unless $this->{ds}; + } + + foreach my $item (keys %{$this->{cache}}) { + next unless defined $this->{cache}->{$item}; # skip deleted + next unless $this->{dirty}->{$item}; # skip unchanged + (my $entry_cn = $item) =~ s/([,+="<>#;])/\\$1/g; + my $entry_dn = "cn=$entry_cn,$this->{basedn}"; + debug "db $this->{name}" => "writing out to $entry_dn"; + + my %data = %{$this->{cache}->{$item}}; + my %modify_data; + my $add_data = [ 'objectclass' => 'top', + 'objectclass' => 'debconfdbentry', + 'cn' => $item + ]; + + 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')); + if ((exists $this->{accept_attribute} && + $field !~ /$this->{accept_attribute}/) or + (exists $this->{reject_attribute} && + $field =~ /$this->{reject_attribute}/)) { + debug "db $item" => "reject $field"; + next; + } + + $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 $rv=""; + if ($this->{exists}->{$item}) { + $rv = $this->{ds}->modify($entry_dn, replace => \%modify_data); + } else { + $rv = $this->{ds}->add($entry_dn, attrs => $add_data); + } + if ($rv->code) { + $this->error("Modify failed: ".$rv->error); + } + } + + $this->{ds}->unbind(); + + $this->SUPER::shutdown(@_); +} + + +sub load { + my $this = shift; + return unless $this->{keybykey}; + my $entry_cn = shift; + + my $records = $this->get_key($entry_cn); + return unless $records; + + debug "db $this->{name}" => "Read entry for $entry_cn"; + + $this->parse_records($records); +} + + +sub remove { + return 1; +} + + +sub save { + return 1; +} + + +sub get_key { + my $this = shift; + return unless $this->{keybykey}; + my $entry_cn = shift; + + my $data = $this->{ds}->search( + base => 'cn=' . $entry_cn . ',' . $this->{basedn}, + sizelimit => 0, + timelimit => 0, + filter => "(objectclass=debconfDbEntry)"); + + if ($data->code) { + $this->error("Search failed: ".$data->error); + } + + return unless $data->entries; + $data->as_struct(); +} + +sub parse_records { + my $this = shift; + my $records = shift; + + foreach my $dn (keys %{$records}) { + my $entry = $records->{$dn}; + debug "db $this->{name}" => "Reading data from $dn"; + my %ret = (owners => {}, + fields => {}, + variables => {}, + flags => {}, + ); + my $name = ""; + + foreach my $attr (keys %{$entry}) { + if ($attr eq 'objectclass') { + next; + } + my $values = $entry->{$attr}; + + $attr =~ s/([a-z])([A-Z])/$1.'_'.lc($2)/ge; + + debug "db $this->{name}" => "Setting data for $attr"; + foreach my $val (@{$values}) { + debug "db $this->{name}" => "$attr = $val"; + if ($attr eq 'owners') { + $ret{owners}->{$val}=1; + } elsif ($attr eq 'flags') { + $ret{flags}->{$val}='true'; + } elsif ($attr eq 'cn') { + $name = $val; + } elsif ($attr eq 'variables') { + my ($var, $value)=split(/\s*=\s*/, $val, 2); + $ret{variables}->{$var}=$value; + } else { + $val=~s/\\n/\n/g; + $ret{fields}->{$attr}=$val; + } + } + } + + $this->{cache}->{$name} = \%ret; + $this->{exists}->{$name} = 1; + } +} + + +1 |