--- Begin Message ---
Package: slapd
Version: 2.2.23-0.pre5
Severity: wishlist
Tags: patch
-- System Information:
Debian Release: 3.1
APT prefers unstable
APT policy: (500, 'unstable'), (1, 'experimental')
Architecture: i386 (i686)
Kernel: Linux 2.6.9-timotheus
Locale: LANG=C, [EMAIL PROTECTED]
Versions of packages slapd depends on:
ii coreutils [fileutils] 5.2.1-2 The GNU core utilities
ii debconf 1.4.38 Debian configuration management sy
ii fileutils 5.2.1-2 The GNU file management utilities
ii libc6 2.3.2.ds1-17 GNU C Library: Shared libraries an
ii libdb4.3 4.3.27-2 Berkeley v4.3 Database Libraries [
ii libiodbc2 3.52.2-3 iODBC Driver Manager
ii libldap-2.2-7 2.2.23-0.pre5 OpenLDAP libraries
ii libltdl3 1.5.6-2 A system independent dlopen wrappe
ii libperl5.8 5.8.4-2.3 Shared Perl library
ii libsasl2 2.1.19-1.3 Authentication abstraction library
ii libslp1 1.0.11-7 OpenSLP libraries
ii libssl0.9.7 0.9.7d-5 SSL shared libraries
ii libwrap0 7.6.dbs-6 Wietse Venema's TCP wrappers libra
ii perl [libmime-base64-perl] 5.8.4-2.3 Larry Wall's Practical Extraction
ii psmisc 21.5-1 Utilities that use the proc filesy
-- debconf information:
slapd/fix_directory: true
* shared/organization: schuldei.com
slapd/upgrade_slapcat_failure:
slapd/backend: BDB
* slapd/allow_ldap_v2: false
slapd/no_configuration: false
slapd/move_old_database: true
slapd/suffix_change: false
slapd/slave_databases_require_updateref:
slapd/autoconf_modules: true
* slapd/domain: schuldei.com
slapd/password_mismatch:
slapd/invalid_config: true
* slapd/upgrade_slapadd_failure:
slapd/purge_database: false
slapd/admin:
--- /usr/share/slapd/fix_ldif 2004-07-27 08:07:49.000000000 +0200
+++ fix_ldif.orig.pl 2004-08-18 22:43:57.000000000 +0200
@@ -2,6 +2,9 @@
# Copyright (c) Dave Horsfall.
# All rights reserved.
#
+# extended and rewritten by Andreas Schuldei
+# for debian(-edu)
+#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
@@ -113,9 +116,22 @@
use Data::Dumper;
use Getopt::Long;
use MIME::Base64;
+use strict;
+use diagnostics;
my $origDN = '.origDN'; # Attribute stores original DN
+# the command line options
+
+my ($opt_dump, $opt_fix, $opt_inheritance, $opt_suffix, $opt_write,
+ $opt_no_auth, $opt_org);
+
+# some big hashes
+my (%entries, %schema, @single);
+
+my $suffix;
+
+
&parse_options;
$opt_write = 1 if $opt_fix;
@@ -128,6 +144,7 @@
my $dn = shift @_;
# Check if base64 encoded
next if ! $dn =~ /^dn::? /i;
+ my $encoded;
if($dn =~ /^dn:: /i) {
$dn =~ s/dn:: (.*)/$1/;
$dn = decode_base64($dn);
@@ -155,16 +172,15 @@
# Extract the first component (the RDN)
# for later tests.
#
- ($rdn, undef) = split(/,/, $cdn);
- ($rdnattr, $rdnval) = split(/=/, $rdn);
+ my ( $rdn, undef ) = split ( /,/, $cdn );
+ my ( $rdnattr, $rdnval ) = split ( /=/, $rdn );
#
# Get the attributes/values.
# Attributes are low-cased.
#
- for (@_)
- {
- ($attr, $val) = split(/\s/, $_, 2); # In case of "::"
+ for (@_) {
+ my ( $attr, $val ) = split ( /\s/, $_, 2 ); # In case of "::"
$attr =~ s/://;
if ($attr =~ /:/) # Must be binary (base-64)
{
@@ -248,46 +264,150 @@
}
#
- # Check the objectclass inheritance.
+ # Check the objectclass inheritance and hirarcy.
#
if ($opt_inheritance) # Will soon be mandatory
{
- foreach my $i (@{$entries{$cdn}{"objectclass"}})
- {
+ my $obj_ref = objlist2hash( $entries{$cdn}{'objectclass'} );
+ $obj_ref->{top} = 1 # it might be that top is not there yet.
+ unless $obj_ref->{alias};
+
+ # remove unknown object classes
+ foreach my $i ( keys %$obj_ref ) {
next if $i eq "top"; # top is topless :-)
- if (!defined $sup{$i})
- {
+ unless ( $schema{objectclass}{$i} ) {
+ # check if objectclass is known in the first place
print STDERR "dn: $dn\nUnknown objectclass: \"$i\"";
if ($opt_fix)
{
print STDERR "; ignored";
- &remove($i, [EMAIL PROTECTED]"objectclass"}});
+ delete $obj_ref->{$i};
}
print STDERR "\n\n";
}
- if (defined $sup{$i} &&
- !&present($sup{$i}, [EMAIL PROTECTED]"objectclass"}}))
- {
- print STDERR "dn: $dn\nNo sup for \"$i\": \"$sup{$i}\"";
- if ($opt_fix)
- {
+ }
+
+ #
+ # check if we have one and only one structural
+ # object class and remove superfluous object classes.
+ #
+ my %structural_objectclasses;
+ foreach my $i ( keys %$obj_ref ) {
+ next if $i eq "top"; # top is topless :-)
+
+ if ( $schema{objectclass}{$i}{structural} ) {
+ $structural_objectclasses{$i}=1;
+ }
+ }
+ if (1 < scalar keys %structural_objectclasses ) {
+ print STDERR "dn: $dn\nMore then one structural objectclass:";
+ for my $structural_objectclass ( keys %structural_objectclasses ) {
+ print STDERR " \"$structural_objectclass\"";
+ }
+ print STDERR ".";
+ my $removable_objectclasses_ref =
+ resolve_structural_clash ( \%structural_objectclasses,
$entries{$cdn} );
+ if ($opt_fix) {
+ print STDERR " Removing ";
+ for my $obj_class ( @$removable_objectclasses_ref ) {
+ print STDERR " \"$obj_class\"";
+ delete $obj_ref->{$obj_class};
+ }
+ print STDERR ".\n\n";
+ }
+ }
+ #
+ # Now we find and add missing superior objectclasses
+ #
+ foreach my $i ( keys %$obj_ref ) {
+ next if $i eq "top"; # top is topless :-)
+ for my $sup ( @{ $schema{objectclass}{$i}{sup} } ) {
+ unless ( $obj_ref->{$sup} ) {
+ print STDERR "dn: $dn\nNo sup for \"$i\"";
+ if ($opt_fix) {
print STDERR "; inserted";
- push @{$entries{$cdn}{"objectclass"}}, $sup{$i};
+ $obj_ref->{$sup} = 1;
}
print STDERR "\n\n";
}
- } # each objectclass
- } # inheritance
+ }
+ }
#
- # Check required attributes.
- # Can't do in above loop, because the keys
- # may have changed from inserting new classes.
+ # see if all mandatory attributes are there
#
- foreach my $i (@{$entries{$cdn}{"objectclass"}})
- {
- &checkattrs($cdn, $i);
+ my %must;
+ for my $i ( keys %$obj_ref ) {
+ next if $i eq "top"; # top is topless :-)
+
+ for my $attrib_must ( @{ $schema{objectclass}{$i}{must} } ) {
+ $must{ $attrib_must } = 1;
+ }
+ }
+ my %must_missing;
+ MUST:
+ for my $i ( keys %must ) {
+ next if ($i eq "cn" or # there is no schema entry for cn!
+ $i eq "objectclass"); # or for objectclass
+ for my $name ( @{ $schema{attributetype}{$i}{names} } ) {
+ next MUST if $entries{$cdn}{$name};
+ }
+ $must_missing{$i} = 1;
+ }
+ for my $i ( keys %must_missing ) {
+ print STDERR "dn: $dn\nAttribut \"$i\": mandatory but missing";
+ if ($opt_fix) {
+ print STDERR "; inserted";
+ $entries{$cdn}{$i} = [ "" ]; # FIXME: figure out proper syntax
+ }
+ print STDERR "\n\n";
+ }
+
+ # see if any attributes are orphans
+ # everything is allowed with extensibleobject. skip this case
+ unless ( $obj_ref->{extensibleobject} ) {
+
+ my %attrib_all = %must;
+ foreach my $i ( keys %$obj_ref ) {
+
+ next if $i eq "top"; # top is topless :-)
+
+ for my $attrib_may ( @{ $schema{objectclass}{$i}{may} } ) {
+ $attrib_all{ $attrib_may } = 1;
+ }
+ }
+ my %attrib_orphan;
+ for my $attrib ( keys %{ $entries{$cdn} } ) {
+ next if ".origDN" eq $attrib or
+ "encoded" eq $attrib or
+ "objectclass" eq $attrib or
+ "creatorsname" eq $attrib or
+ "createtimestamp" eq $attrib or
+ "modifiersname" eq $attrib or
+ "modifytimestamp" eq $attrib or
+ "cdn" eq $attrib or
+ "dn" eq $attrib;
+ unless ( $attrib_all{ $attrib } ) {
+ $attrib_orphan{ $attrib } = 1;
+ }
+ }
+ for my $i ( keys %attrib_orphan ) {
+ print STDERR "dn: $dn\nAttribut \"$i\": is not part of
objectclasses";
+ for my $objclss ( keys %$obj_ref) {
+ print STDERR " \"$objclss\"";
+ }
+ if ($opt_fix) {
+ print STDERR "; removed";
+ delete $entries{$cdn}{$i};
}
+ print STDERR "\n\n";
+ }
+ } # extensibleobject.
+ # at this point we should have an entry with all needed sups, nicely
cleand up
+ objhash2list( $entries{$cdn}{objectclass} , $obj_ref ); # back to the
old format
+ } # inheritance
+
+
} # main loop
#
@@ -312,11 +432,16 @@
# Fix up the suffix dn if it's our mess, adding a structural objectclass.
if ($thisdn eq &canon($suffix)) {
- if (@{$entries{$thisdn}{'objectclass'}} == 1
- && lc $entries{$thisdn}{'objectclass'}[0] eq 'dcobject')
- {
- if (defined($opt_org))
+ my $obj_ref = objlist2hash( $entries{$thisdn}{'objectclass'} );
+ if ( ( 1 == keys %$obj_ref
+ and $obj_ref->{dcobject} )
+ or
+ ( 2 == keys %$obj_ref
+ and $obj_ref->{dcobject}
+ and $obj_ref->{top} )
+ )
{
+ if ( defined($opt_org) ) {
push(@{$entries{$thisdn}{'objectclass'}},
'organization');
push(@{$entries{$thisdn}{'o'}}, $opt_org);
} else {
@@ -361,34 +486,6 @@
}
#
-# Check required attributes.
-#
-sub checkattrs
-{
- (my $dn, $class) = @_;
- foreach my $attr (@{$reqd{lc $class}})
- {
- if (!defined @{$entries{$dn}{lc $attr}})
- {
- my $odn = $entries{$dn}{$origDN};
- print STDERR "dn: $odn\nMissing reqd \"$class\" attr \"$attr\"";
- if ($opt_fix)
- {
- # Quick hack for CI
- my $fix = "UNKNOWN";
- if ($attr eq "cn" && $fix ne "")
- {
- $fix = $entries{$dn}{"givenname"}[0];
- }
- push @{$entries{$dn}{$attr}}, $fix;
- print STDERR "; inserted \"$fix\"";
- }
- print STDERR "\n\n";
- }
- }
-}
-
-#
# Write an entry to standard output.
#
# Ought to wrap at 78 cols as well.
@@ -398,110 +495,35 @@
my ($dn) = @_;
my $odn = $entries{$dn}{$origDN};
if ($entries{$dn}{"encoded"} == 1) {
- $encoded = encode_base64($odn,"");
+ my $encoded = encode_base64( $odn, "" );
print "dn:: $encoded\n";
} else {
print "dn: $odn\n";
}
- foreach my $attr (keys %{$entries{$dn}})
- {
- next if $attr eq $origDN;
- foreach my $value (@{$entries{$dn}{$attr}})
- {
+ foreach my $attr ( keys %{ $entries{$dn} } ) {
+ next if $attr eq $origDN or $attr eq "encoded" ;
+ foreach my $value ( @{ $entries{$dn}{$attr} } ) {
print "$attr:";
- if ($attr =~ /userpassword/i
- || $value =~ /(^[ :]|[\x00-\x1f\x7f-\xff])/)
+
+ if ( defined $value and ( $attr =~ /userpassword/i
+ || $value =~ /(^[ :]|[\x00-\x1f\x7f-\xff])/ ) )
{
print ": ", &enmime($value, "");
}
- else
- {
+ elsif ( defined $value and "" ne $value) {
print " $value";
}
print "\n";
- }
- }
- print "\n";
-}
-#
-# Test for presence of element in list.
-#
-sub present
-{
- my ($element, $list) = @_;
- my $found = 0;
-
- foreach my $i (@$list)
- {
- if ($i eq $element)
- {
- $found = 1;
- last;
- }
- }
- return $found;
-}
-
-#
-# Remove specified element from list.
-# It's a unique element, but multiple
-# occurances will be removed. It will
-# change the order of the list.
-#
-sub remove
-{
- my ($element, $list) = @_;
-
- for (my $i = 0; $i < @$list; $i++)
- {
- if ($element eq @$list[$i])
- {
- @$list[$i] = @$list[$#$list];
- pop @$list;
}
}
+ print "\n";
}
-#
-# Initialise some stuff (automatically called).
-#
-sub INIT
-{
- #
- # Initialise the superior objectclasses.
- # Ought to get this from the schema.
- #
- $sup{"dcObject"} = "top";
- $sup{"inetOrgPerson"} = "organizationalPerson";
- $sup{"organizationalPerson"} = "person";
- $sup{"organizationalRole"} = "top";
- $sup{"organizationalUnit"} = "top";
- $sup{"person"} = "top";
- $sup{"posixAccount"} = "top";
- $sup{"room"} = "top";
- $sup{"simpleSecurityObject"} = "top";
+sub INIT {
- #
- # These are incomplete/wrong/WIP.
- #
- $sup{"ciAdministrator"} = "top";
- $sup{"ciApplication"} = "top";
- $sup{"ciEmployee"} = "inetOrgPerson";
- $sup{"ciLdapConfig"} = "top";
- $sup{"ciPrinter"} = "top";
- $sup{"ciServer"} = "top";
-
- #
- # Required attributes.
- #
- $reqd{"person"} = [ "sn", "cn" ]; # Special - can be autofixed
- $reqd{"ciadministrator"} = [ "uid", "userPassword" ];
- $reqd{"ciapplication"} = [ "ciApp", "ciAppType", "ciHost", "ciStatus",
"ciPortNum" ];
- $reqd{"ciemployee"} = [ "employeeNumber", "sn" ];
- $reqd{"cildapconfig"} = [ "ciHost" ];
- $reqd{"ciprinter"} = [ "ciPrinterName" ];
- $reqd{"ciserver"} = [ "name" ];
+ my $schema_ref = parse_schemas();
+ %schema = %$schema_ref;
#
# Single-value attributes.
@@ -624,3 +646,299 @@
}
return $res;
}
+
+sub read_config {
+ my ($file) = @_;
+
+ open CONFIG, "< $file" or die "can't open $file: $!";
+
+ my %config;
+ while ( <CONFIG> ) {
+ chomp;
+ s/\#.*//;
+ s/^\s+//;
+ s/\s+$//;
+ next unless length;
+ my ($var, $value) = split(/\s*=\s*/, $_, 2);
+ $config{$var} = $value;
+ }
+
+ close CONFIG;
+
+ return \%config;
+}
+
+sub read_slapd_config {
+ my ($file) = @_;
+
+ open CONFIG, "< $file" or die "can't open $file: $!";
+
+ my $seperator = $/; # save the seperator since it is non-standard
+ undef $/;
+ my $whole_file = <CONFIG>; # sluuuurp
+ $whole_file =~ s/\n(?!\n)\s+/ /g; # merge logical line as the ldap config
parser does
+ $/= $seperator; # restore the original line seperator;
+
+ my @whole_file = split (/\n/, $whole_file);
+
+
+ my %config;
+ while ( @whole_file ) {
+ $_ = pop @whole_file;
+ chomp;
+ s/\#.*//;
+ s/^\s+//;
+ s/\s+$//;
+ next unless length;
+ my ($var, $value) = split(/\s+/, $_, 2);
+ push @{ $config{$var} }, $value;
+
+ # this does not keep the order of the configuration easily
+ # accessable, which is bad for things like databases and
+ # suffixes but does not matter for the include lines of the
+ # schemas. With some efford one could pirce together the order
+ # by getting it from the order in the anonymous arrays.
+
+ }
+
+ close CONFIG;
+
+ return \%config;
+}
+
+sub extract_system_schemas {
+ my ($core_schema, $schema_raw_ref) = @_;
+
+ while ( $core_schema ) {
+ $core_schema =~ s/^.*?\n\# system schema\n\#(.*?\))(\n\n.*)$/$2/s;
+ last unless $1;
+ my $core_def = $1;
+ $core_def =~ s/\n(?!\n)\#\s+/ /g;
+ chomp $core_def;
+ $core_def =~s/^\s+//;
+ $core_def =~s/\s+$//;
+ next unless length $core_def;
+ push @$schema_raw_ref, "$core_def\n";
+ }
+}
+
+sub read_schema {
+ my ($file) = @_;
+
+ open SCHEMA, "< $file" or die "can't open $file: $!";
+
+ my $seperator = $/; # save the seperator since it is non-standard
+ undef $/;
+ my $whole_file = <SCHEMA>; # sluuuurp
+
+ my @schema_raw;
+ if ($file eq "/etc/ldap/schema/core.schema") {
+ # There are some system schema entries which are hard coded
+ # into openLdap. They are marked "system schema" in the
+ # core.schema. we try to detect them and remove the comments
+ # in front of those.
+ extract_system_schemas( $whole_file, [EMAIL PROTECTED]);
+
+ }
+
+ $whole_file =~ s/\n(?!\n)\s+/ /g;
+ # this is dubious, since we should watch not lines starting with
+ # whitespaces but balance the parantecies. but this works well.
+ $/= $seperator; # restore the original line seperator;
+
+
+ my @whole_file = split (/\n/, $whole_file);
+
+
+ while ( @whole_file ) {
+ $_ = pop @whole_file;
+ chomp;
+ s/\#.*//;
+ s/^\s+//;
+ s/\s+$//;
+ next unless length;
+ push @schema_raw, "$_\n";
+ }
+
+ close SCHEMA;
+ return [EMAIL PROTECTED];
+}
+
+
+sub find_slapd_config {
+
+ my $defaults = "/etc/default/slapd";
+ my $slapd_defaults_ref;
+
+ if ( -f $defaults ) {
+ $slapd_defaults_ref = read_config( $defaults );
+ }
+
+ unless ( $slapd_defaults_ref->{SLAPD_CONF} and
+ -f $slapd_defaults_ref->{SLAPD_CONF} )
+ {
+ $slapd_defaults_ref->{SLAPD_CONF} = "/etc/ldap/slapd.conf";
+ }
+
+ return $slapd_defaults_ref->{SLAPD_CONF};
+
+}
+
+sub parse_slapd_config {
+
+ my ($slapd_config_file) = @_;
+
+ my $slapd_config_href = read_slapd_config( $slapd_config_file );
+
+ return $slapd_config_href;
+}
+
+sub find_active_schemas {
+ my ($slapd_config_href) = @_;
+
+ return [EMAIL PROTECTED] $slapd_config_href->{include} };
+}
+sub preprocess_schemas {
+ my ( $schemas_list_ref ) = @_;
+
+ my @schemas_raw;
+
+ for my $file ( @{$schemas_list_ref} ) {
+ push @schemas_raw, @{ read_schema( $file ) };
+ }
+ return [EMAIL PROTECTED];
+}
+
+sub get_used_schemas {
+
+ my $slapd_config_path = find_slapd_config();
+ my $slapd_config_href = parse_slapd_config( $slapd_config_path );
+ my $schemas_list_aref = find_active_schemas( $slapd_config_href );
+ my $schemas_raw_aref = preprocess_schemas( $schemas_list_aref );
+ return $schemas_raw_aref;
+}
+
+sub parse_schemas {
+
+ my $schemas_raw_aref = get_used_schemas();
+
+ my %schema;
+ while ( @$schemas_raw_aref ) {
+ $_= pop @$schemas_raw_aref;
+ chomp;
+
+ #poor man`s parser
+
+ my ( $type ) =
+ /^(\w+)\s/;
+
+ my ( $structural ) =
+ /^.*\s(STRUCTURAL)\s.*$/;
+
+ my ( $auxiliary ) =
+ /^.*\s(AUXILIARY)\s.*$/;
+
+ my ( $description ) =
+ /^.*\s+DESC\s+\'([^\']+)\'.*$/;
+
+ my ( $syntax ) =
+ /^.*\s+SYNTAX\s+([\d\.\{\}]+).*$/;
+
+
+ my @names;
+ if ( /^.*\s+NAME\s+\(\s*\'([\w\s\']+)\'\s*\).*$/ ) {
+ @names = split(/\'\s+\'/, lc $1);
+ }
+ elsif ( /^.*\s+NAME\s+\'(\w+)\'\s.*$/ ) {
+ push @names, lc $1;
+ }
+
+ my @sup;
+ if ( /^.*\s+SUP\s+\(\s*([^\)]+?)\s*\).*$/ ) {
+ @sup = split(/\s*\$\s*/, lc $1);
+ }
+ elsif ( /^.*\s+SUP\s+(\w+)\s.*$/ ) {
+ push @sup, lc $1;
+ }
+
+ my @must;
+ if ( /^.*\s+MUST\s+\(\s*([^\)]+?)\s*\).*$/ ) {
+ @must = split(/\s*\$\s*/, lc $1);
+ }
+ elsif ( /^.*\s+MUST\s+(\w+)\s.*$/ ) {
+ push @must, lc $1 ;
+ }
+
+ my @may;
+ if ( /^.*\s+MAY\s+\(\s*([^\)]+?)\s*\).*$/ ) {
+ @may = split(/\s*\$\s*/, lc $1);
+ }
+ elsif ( /^.*\s+MAY\s+(\w+)\s.*$/ ) {
+ push @may, lc $1 ;
+ }
+
+ unless ($type eq "attributetype" or
+ $type eq "objectclass" or
+ @names )
+ {
+ print STDERR "$_\n";
+ }
+ else {
+ for my $name ( @names ) {
+ $name = lc $name;
+
+ $schema{$type}{$name}{names} = [EMAIL PROTECTED];
+ $schema{$type}{$name}{description}= $description
+ if $description;
+ $schema{$type}{$name}{syntax} = $syntax
+ if $syntax;
+ $schema{$type}{$name}{structural} = 1
+ if $structural;
+ $schema{$type}{$name}{auxiliary} = 1
+ if $auxiliary;
+ $schema{$type}{$name}{must} = [EMAIL PROTECTED]
+ if @must;
+ $schema{$type}{$name}{may} = [EMAIL PROTECTED]
+ if @may;
+ $schema{$type}{$name}{sup} = [EMAIL PROTECTED]
+ if @sup;
+ }
+ }
+ }
+ return \%schema;
+}
+
+sub objlist2hash {
+ my ($list_ref) = @_;
+
+ my %objectclass;
+ for my $objclass ( @$list_ref ) {
+ $objclass = lc $objclass;
+ $objectclass{$objclass } = 1;
+ }
+
+ return \%objectclass;
+}
+
+sub objhash2list {
+ my ($array_ref , $obj_hash_ref ) = @_;
+
+ @$array_ref = keys %$obj_hash_ref;
+}
+
+sub resolve_structural_clash {
+ my ( $structural_objectclasses_ref, $entry_ref ) = @_;
+
+ my @removable_objectclasses;
+
+ # remove automountmap
+ # i dont know good heuristics to decide which one i
+ # should remove, so this is hard coded.
+ # what other common cases are there?
+ if ($structural_objectclasses_ref->{automountmap} and
+ $structural_objectclasses_ref->{organizationalunit} and
+ 2 == keys %$structural_objectclasses_ref ) {
+ push @removable_objectclasses, "automountmap";
+ }
+ return [EMAIL PROTECTED];
+}
--- End Message ---
