Grich, Ondrej wrote:
Hello,

Having problem with importing certificates to LDAP. Server certificates
are issued with DNS fqdn in Subject Alternative Name. I'm using Openldap
2.0.x. It seems, that openldap does not get no value for attribute
"mail".  Excerpt from openldap debug follows:

-->Openldap debug start
.....
send_ldap_result: 21::mail: value #0 invalid per syntax
send_ldap_response: msgid=5 tag=105 err=21
ber_flush: 47 bytes to sd 7
  0000:  30 2d 02 01 05 69 28 0a  01 15 04 00 04 21 6d 61
0-...i(......!ma
  0010:  69 6c 3a 20 76 61 6c 75  65 20 23 30 20 69 6e 76   il: value #0
inv
  0020:  61 6c 69 64 20 70 65 72  20 73 79 6e 74 61 78      alid per
syntax
ldap_write: want=47, written=47
  0000:  30 2d 02 01 05 69 28 0a  01 15 04 00 04 21 6d 61
0-...i(......!ma
  0010:  69 6c 3a 20 76 61 6c 75  65 20 23 30 20 69 6e 76   il: value #0
inv
  0020:  61 6c 69 64 20 70 65 72  20 73 79 6e 74 61 78      alid per
syntax
conn=12 op=4 RESULT tag=105 err=21 text=mail: value #0 invalid per
syntax
.....
<---end

My configuration:
openca 0.9.1.3
With options:
serialnumber in DN set to NO
Emailaddress in DN set to NO


I know, that with last option set to YES everything works fine.

Anyone faced & solved this issue?

I attached a changed version of our LDAP library. Please try it and send a report what happens. I found a really small mistake but perhaps this breaks the syntax. If it fixes your problem then we can issue the next minor release.


Michael
--
-------------------------------------------------------------------
Michael Bell                   Email: [EMAIL PROTECTED]
ZE Computer- und Medienservice            Tel.: +49 (0)30-2093 2482
(Computing Centre)                        Fax:  +49 (0)30-2093 2704
Humboldt-University of Berlin
Unter den Linden 6
10099 Berlin                   Email (private): [EMAIL PROTECTED]
Germany                                       http://www.openca.org
## RA Server Management Utility 
## (c) 1999-2002 by Massimiliano Pala
## (c) 2002-2003 by Michael Bell
## All Rights Reserved
##
## Project Information:
##
##      Current Version ..................... $VER
##      Project Started on .................. 17/12/1998
##      Last Modified on .................... 30/03/2001
##      Project Closed on ................... n/a
##
## Program currently tested with OpenLDAP v.1.2 on Linux, Solaris
## and Sleepycat DB.
##
## DISC CLAIMER: THIS SOFTWARE IS GIVEN AS IS WITHOUT ANY WARRANTIES
## ABOUT ANY DAMAGE DERIVED BY THE USE ( CORRECT OR NOT ) OF THIS
## SOFTWARE. THE AUTHOR IS THEREFORE NOT RESPONSABLE IN ANY WAY OF
## DAMAGES RELATED IN ANY WAY TO THIS OR SUPPORTED SOFTWARE AS WELL.
##
## If you want to contact me (the author) please use the e-mail
## addresses listed below. Do not esitate in reporting bugs, enhancement
## or anything seems useful in developing this software:
##
##      [EMAIL PROTECTED]
##      [EMAIL PROTECTED]
##      [EMAIL PROTECTED]
##

## Thank you for using this software, and remember that Open Projects
## are the future of mankind. Do not sleep, partecipate to world wide
## efforts to make life easier for all!

use X500::DN;

sub addCertsUsers {
  my $keys = { @_ };

  ## Reserved Variables
  my ( @certsList );
  my ( $filename, $tmp, $ID, $cert, $ldap, $ret );

  ## Get Required parameter
  my $certDir = getRequired( 'CertDir' );

  ## Debugging info
  my $DEBUG = 0;
  if ($keys->{DEBUG}) {
        $DEBUG = 1;
  }

  ##// This file has the latest imported certificate's serials
  $filename = "$certDir/lastImport.txt";

  ##// Let's open the lastImport.txt
  if( not -e "$filename" ) {
    configError( i18nGettext ("File __FILE__ not found!", "__FILE__", $filename));
  }

  $tmp = $tools->getFile( "$filename");

  if( $tmp eq "" ) {
    success( gettext ("Last Import file was empty."));
  }

  @certsList = split( "\n", $tmp );

  my $table = $query->buildRefs ( ELEMENTS =>, MAXITEMS =>);
  $table .= $query->startTable (COLS=>[ gettext ("Cert.-No."),
                                          gettext ("DN"),
                                          gettext ("adding dn"),
                                          gettext ("adding certificate") ],
                              WIDTH=>"100%",
                              TITLE_BGCOLOR=>"#DDCCFF");

  foreach $ID (@certsList) {

    my @line = ();

    my ( $filter, $serID, $parsed, $ret, $entry );
    ( $serID ) = ( $ID =~ /([a-f0-9]+)/i );

    ##// Let's be sure it is in the right format
    $serID = uc( $serID );
    $serID = "0$serID" if( length($serID) % 2 );

    my $cert = $db->getItem ( DATATYPE => "VALID_CERTIFICATE",
                              KEY => $serID );

    if( not $cert ) {
      $table .= $query->addTableLine( DATA => [
                    "<FONT COLOR=\"Red\">".
                    i18nGettext ("ERROR [__CERT_SERIAL__] : can't get certificate from 
dB!",
                                 "__CERT_SERIAL__", $serID).
                                 "\n</FONT>" ] );
      next;
    }

    $parsed = $cert->getParsed();

    push ( @line, $serID, $parsed->{DN});
    $ret = addLDAPobject ( CERTIFICATE=>$cert );

    my $text;
    $text .= "<FONT COLOR=\"Red\">" if ( not $ret->{STATUS} );
    $text .= $ret->{DESC};
    $text .= "</FONT>" if ( not $ret->{STATUS} );
    push ( @line, $text);

    if( $ret->{STATUS} ) {
      $ret = addLDAPattribute ( CERTIFICATE => $cert , NOPRINT => "true");

      if ($ret->{STATUS}) {
        push (@line, gettext ("success"));
      } else {
        push (@line, i18nGettext ("Error : __ERRNO__", "__ERRNO__", $ret->{CODE}));
      }
    } else {
      push (@line, gettext ("operation not performed"));
    }

    $table .= $query->addTableLine ( DATA => [ @line ]);

  }

  $table .= $query->endTable;
  print $table;

  return gettext ("Ok.");
}

sub addLDAPobject {

  ######################################################
  ## only certs makes sense because a CRL can only be ##
  ## produced if a valid CA-cert exists               ##
  ######################################################

  my $keys = { @_ };
  my ( $obj, $parsed, $serID, $ldap, $ldapadd_result, $ret, $dn, $cn, $sn, $email );

  my $DEBUG = 0;
  if ($keys->{DEBUG}) {
        $DEBUG = 1;
  }
  print "Started addLDAPobject ...<br>\n" if ($DEBUG);

  ## check the type of the attribute
  $obj   = $keys->{CERTIFICATE};
  return { STATUS => 0, CODE => -1, DESC => gettext ("No object specified.") } if ( 
not $obj );
  print "    certificate present ...<br>\n" if ($DEBUG);

  ## get the needed data
  my $cert_dn    = $obj->getParsed ()->{DN};
  my $cert_cn    = $obj->getParsed ()->{DN_HASH}->{CN}[0];
  my $cert_sn    = $obj->getParsed ()->{DN_HASH}->{SN}[0];
  my $cert_serID = $obj->getParsed ()->{SERIAL};
  my $cert_email = $obj->getParsed ()->{EMAILADDRESS};
  my $cert_ou    = $obj->getParsed ()->{DN_HASH}->{OU};
  my $cert_o     = $obj->getParsed ()->{DN_HASH}->{O}[0];
  my $cert_l     = $obj->getParsed ()->{DN_HASH}->{L}[0];
  my $cert_st    = $obj->getParsed ()->{DN_HASH}->{ST}[0];
  my $cert_c     = $obj->getParsed ()->{DN_HASH}->{C}[0];

  ## debugging
  print "Information of the Object:<br>\n" if ($DEBUG);
  print "dn    ".$cert_dn."<br>\n" if ($DEBUG);
  print "cn    ".$cert_cn."<br>\n" if ($DEBUG);
  print "serID ".$cert_serID."<br>\n" if ($DEBUG);
  print "email ".$cert_email."<br>\n" if ($DEBUG);
  print "ou    ".$cert_ou."<br>\n" if ($DEBUG);
  print "o     ".$cert_o."<br>\n" if ($DEBUG);
  print "l     ".$cert_l."<br>\n" if ($DEBUG);
  print "st    ".$cert_st."<br>\n" if ($DEBUG);
  print "c     ".$cert_c."<br>\n" if ($DEBUG);
  print "End of the information of the Object.<br>\n" if ($DEBUG);

  ## if cn is not present but email is then we calculate a cn
  $cert_cn = $cert_sn if (not $cert_cn and $cert_sn);
  if (not $cert_cn and $cert_email) {
      $cert_cn = $cert_email;
      $cert_cn =~ s/[EMAIL PROTECTED]//;
      $cert_cn =~ s/\./ /;
  }

  ## sn is not the real sn sometimes but you can find
  ## the person via a search with a wildcard
  if (not $cert_sn and $cert_cn) {
      $cert_sn = $cert_cn;
      $cert_sn =~ s/\s*$//;
      $cert_sn =~ s/^[^ ]* //;
  }

  my $ou_counter = 0;
  my @ou_array   = ();

  ## Get the Connection to the Server
  if ( not ( $ldap = LDAP_connect() )) {
    ## print "<FONT COLOR=\"Red\">";
    ## print i18nGettext ("LDAP [__CERT_SERIAL__]: Connection Refused by server!", 
"__CERT_SERIAL__", $cert_serID)."\n";
    ## print "</FONT><BR>\n";

    print "Connection refused by server." if ($DEBUG);
    return { STATUS => 0, CODE => -3, DESC => gettext ("Connection refused by 
server.") };
  };

  ##// Let's bind for a predetermined User
  $ret = LDAP_bind( LDAP => $ldap );
  if( $ret->is_error ) {
    my $msg = i18nGettext ("LDAP-bind failed: __ERRVAL__",
                           "__ERRVAL__", $ret->error) ;
    LDAP_disconnect( LDAP => $ldap );
    print "Cannot bind to server." if ($DEBUG);
    return { STATUS => 0, CODE => $ret->code, DESC => $msg };
  };

  my $dn_object     = LDAP_getDN ($obj->getParsed ()->{DN}, $DEBUG);
  my $suffix_object = LDAP_getSuffix ($dn_object, $DEBUG);
  if (not $suffix_object)
  {
      print "dn conflicts with basedn(s)<br>\n" if ($DEBUG);
      LDAP_disconnect ( $ldap );
      return { STATUS => 0 , 
               DESC => gettext ("Distinguished name conflicts with basedn(s)."),
               CODE => -4 };
  }
  ## add an empty string to create the basedn if necessary
  my @dn_array = reverse LDAP_getPath ($dn_object, $suffix_object, $DEBUG);
  push @dn_array, ["",""];

  ## setup the tree for the DN
  ## attention only the last ldapadd must be successful !!!
  print "Building the missing nodes of the LDAP-tree ...<br>\n" if ($DEBUG);
  my $add_dn = $suffix_object->getRFC2253String;
  my $actual_element;
  my $use_ldap_add = 0;
  ## stores information which is available at this hierarchy level
  my %attributes;
  undef %attributes;
  while (scalar (@dn_array)) {

    $actual_element = pop @dn_array;

    ## setup ou-array
    ## FIXME: this looks for me like a hack; michael bell
    if ($actual_element->[0] =~ /^\s*ou\s*$/i) {
      $ou_array [$ou_counter] = $actual_element->[1];
      $ou_counter++;
    }

    ## prepare the needed strings
    if ($actual_element->[0]) {
        ## protection against basedn
        $add_dn = $actual_element->[0]."=".
                  $actual_element->[1].",".$add_dn;
    } else {
        ## servers suffix
        $actual_element->[0] = $add_dn;
        $actual_element->[0] =~ s/,.*$//;
        $actual_element->[1] = $actual_element->[0];
        $actual_element->[0] =~ s/=.*$//;
        $actual_element->[1] =~ s/^[^=]*=//;
    }

    ## add the attribute to the known attribute values
    if (exists $attributes{$actual_element->[0]})
    {
        $attributes{lc $actual_element->[0]}[scalar @{$attributes{lc 
$actual_element->[0]}}] = $actual_element->[1];
        $attributes{mail}[scalar @{$attributes{mail}}] = $actual_element->[1]
            if ($actual_element->[0] =~ /mail/i);
    } else {
        $attributes{lc $actual_element->[0]}[0] = $actual_element->[1];
        $attributes{mail}[0] = $actual_element->[1]
            if ($actual_element->[0] =~ /mail/i);
    }

    if ($DEBUG)
    {
        print "Try to add $add_dn ...<br>\n";
        print "attribute: $actual_element->[0]<br>\n";
        print "value: $actual_element->[1]<br>\n";
    }

    ## check that the entry does not exist in the LDAP-tree
    print "LDAP Schema DN: ".$add_dn."<br>\n" if ($DEBUG);
    my $ldap_schema = $ldap->schema (dn => $add_dn);
    ## I stop the insertion because of a searcherror too
    if ( not $ldap_schema ) {
      print "node doesn't exist<br>\n" if ($DEBUG);
    } elsif (not $ldap_schema->error() ) {
      ## node/leaf exists
      print "node exists<br>\n" if ($DEBUG);
      next;
    } else {
      print "something is going wrong --> node doesn't exist?<br>\n" if ($DEBUG);
      print "LDAP Schema-Code ".$ldap_schema->error()."<br>\n" if ($DEBUG);
    }
    $use_ldap_add = 1;

    ## insert the different types
    ##// attention: I don't insert here a CA!!!
    ## this most be done otherwise because I cannot declare
    ## any o and ou to be a (sub)CA
    my @ldap_attr = ();

    ## build objectclass
    ## check for schema violations
    my @objectclass = ();
    push @objectclass, 'top';
    
    if ($actual_element->[0] =~ /^\s*(cn|sn|email|emailAddress)\s*$/i) {
        $attributes{cn}[0] = $cert_cn if (not $attributes{cn});
        if (not $attributes{cn}[0])
        {
            ## schema violation
            LDAP_disconnect ( $ldap );
            return { STATUS => 0 , 
                     DESC => gettext ("The common name is not specified but required 
for this objectclass."),
                     CODE => -110 };
        }
        ## if it is a ca-cert or a not complete subject
        ## then it is an organizationalRole
        if ($obj->getParsed()->{IS_CA} or scalar (@dn_array)) {
            push @objectclass, 'organizationalRole';
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'st', \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'l',  \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'ou', \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'cn', \%attributes);
            if ($attributes{mail})
            {
                push @objectclass, 'rfc822MailUser';
                @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'mail', 
\%attributes);
            }
        } else {
            push @objectclass, 'person';
            push @objectclass, 'organizationalPerson';
            push @objectclass, 'inetOrgPerson';
            $attributes{sn}[0]   = $cert_sn    if (not $attributes{sn});
            $attributes{mail}[0] = $cert_email if (not $attributes{mail} and 
$cert_email);
            if (not $attributes{sn}[0])
            {
                ## schema violation
                LDAP_disconnect ( $ldap );
                return { STATUS => 0 , 
                         DESC => gettext ("The surname is not specified but required 
for this objectclass."),
                         CODE => -120 };
            }
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'o',    \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'st',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'l',    \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'ou',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'cn',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'sn',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'mail', \%attributes);
        }
    } elsif ($actual_element->[0] =~ /^\s*dc\s*$/i) {
        push @objectclass, 'dcObject';
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'dc', \%attributes);
    } elsif ($actual_element->[0] =~ /^\s*serialNumber\s*$/i) {
        $attributes{cn}[0] = $cert_cn if (not $attributes{cn});
        if (not $attributes{cn}[0])
        {
            ## schema violation
            LDAP_disconnect ( $ldap );
            return { STATUS => 0 , 
                     DESC => gettext ("The common name is not specified but required 
for this objectclass."),
                     CODE => -130 };
        }
        if ($obj->getParsed()->{IS_CA} or scalar (@dn_array)) {
            push @objectclass, 'device';
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'o',  \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'l',  \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'ou', \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'cn', \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'serialNumber', 
\%attributes);
        } else {
            push @objectclass, 'person';
            push @objectclass, 'organizationalPerson';
            push @objectclass, 'inetOrgPerson';
            push @objectclass, 'uniquelyIdentifiedUser';
            $attributes{sn}[0]   = $cert_sn    if (not $attributes{sn});
            $attributes{mail}[0] = $cert_email if (not $attributes{mail} and 
$cert_email);
            if (not $attributes{sn}[0])
            {
                ## schema violation
                LDAP_disconnect ( $ldap );
                return { STATUS => 0 , 
                         DESC => gettext ("The surname is not specified but required 
for this objectclass."),
                         CODE => -140 };
            }
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'o',    \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'st',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'l',    \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'ou',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'cn',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'sn',   \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'mail', \%attributes);
            @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'serialNumber', 
\%attributes);
        }
    } elsif ($actual_element->[0] =~ /^\s*ou\s*$/i) {
        push @objectclass, 'organizationalUnit';
        if (not $attributes{ou})
        {
            ## schema violation
            LDAP_disconnect ( $ldap );
            return { STATUS => 0 , 
                     DESC => gettext ("The organizational unit is not specified but 
required for this objectclass."),
                     CODE => -150 };
        }
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'st', \%attributes);
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'l',  \%attributes);
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'ou', \%attributes);
    } elsif ($actual_element->[0] =~ /^\s*o\s*$/i) {
        push @objectclass, 'organization';
        if (not $attributes{o})
        {
            ## schema violation
            LDAP_disconnect ( $ldap );
            return { STATUS => 0 , 
                     DESC => gettext ("The organization is not specified but required 
for this objectclass."),
                     CODE => -160 };
        }
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'o',  \%attributes);
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'st', \%attributes);
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'l',  \%attributes);
    } elsif ($actual_element->[0] =~ /^\s*c\s*$/i) {
        push @objectclass, 'country';
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'c', \%attributes);
    } elsif ($actual_element->[0] =~ /^\s*(st|l)\s*$/i) {
        push @objectclass, 'locality';
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'st', \%attributes);
        @ldap_attr = LDAP_pushAttribute ([EMAIL PROTECTED], 'l',  \%attributes);
    } else {
        LDAP_disconnect ( $ldap );
        return { STATUS => 0 , 
                 DESC => gettext ("The attribute is unknown to OpenCA's ldap-code. 
Please report to [EMAIL PROTECTED]"),
                 CODE => -199 };
    }

    ## FIXME: this hack is not clean but safe
    ## if ($obj->getParsed()->{IS_CA}) {
    ##     push @objectclass, 'pkiCA';
    ## } else {
    ##     push @objectclass, 'pkiUser';
    ## }
    push @objectclass, 'pkiCA';
    push @objectclass, 'pkiUser';
    push @ldap_attr, 'objectclass' => [ @objectclass ];

    print "Attributes for the insertion:<br>\n" if ($DEBUG);
    for (my $h=0; $h < scalar @ldap_attr; $h+=2) {
      print "$ldap_attr[$h] = $ldap_attr[$h+1]<br>\n" if ($DEBUG);
    }
    print "Must setup a CA-cert<br>\n" if ($DEBUG and $obj->getParsed()->{IS_CA});
    print "Must setup a normal cert<br>\n" if ($DEBUG and not 
$obj->getParsed()->{IS_CA});

    $ldapadd_result = $ldap->add ( $add_dn , attr => [ @ldap_attr ] );
    print "The resultcode of the nodeinsertion was ".
          $ldapadd_result->code.".<br>\n" if ($DEBUG);
    last if ($ldapadd_result->code);
  }

  if ($use_ldap_add) {
    if( $ldapadd_result->is_error ) {
      ## print "<FONT COLOR=\"Red\">";
      ## print "Error Adding DN [$serID]: " . $ldapadd_result->code ."<BR>\n";
      ## print "</FONT>";
      LDAP_disconnect ( $ldap );
      return { STATUS => 0 , 
               DESC => i18nGettext ("LDAP-add failed: __ERRVAL__",
                                    "__ERRVAL__", $ldapadd_result->error),
               CODE => $ldapadd_result->code };
    }
  }

  LDAP_disconnect ( $ldap );
  return { STATUS => 1, CODE => 0, DESC => gettext("Success") };
}

## this function add certificates and CRLs to the directory
sub addLDAPattribute {
  my $keys = { @_ };
  my $obj;
  my $ret;
  my $ldap;
  my $noprint;
  my $dn;
  my $attr;
  my $txt;
  my @values;
  my @mails;

  my $DEBUG = 0;
  if ($keys->{DEBUG}) {
        $DEBUG = 1;
  }

  ## check the type of the attribute
  if ( $keys->{CERTIFICATE} ) {
    $obj = $keys->{CERTIFICATE};
    $attr = "userCertificate";
  } elsif ( $keys->{AUTHORITY_CERTIFICATE} ) {
    $obj = $keys->{AUTHORITY_CERTIFICATE};
    $attr = "cACertificate";
  } elsif ( $keys->{CRL} ) {
    $obj = $keys->{CRL};
    $attr = "certificateRevocationList";
  } elsif ( $keys->{AUTHORITY_CRL} ) {
    $obj = $keys->{AUTHORITY_CRL};
    $attr = "authorityRevocationList";
  }
  $attr .= ";binary";
  return { STATUS => 0, CODE => -1, DESC => "No object specified." } if ( not $obj );

  ## set output mode
  $noprint = $keys->{NOPRINT};
  $noprint = 0 if ($DEBUG);

  ## Initializing Connection to LDAP Server
  if ( not ( $ldap = LDAP_connect() )) {
    return { STATUS => 0, CODE => -3, DESC => gettext ("Connection refused by 
server.") };
  }

  ##// Let's bind for a predetermined User
  $ret = LDAP_bind( LDAP => $ldap );
  if ( $ret->is_error ) {
    my $msg = i18nGettext ("LDAP-bind failed: __ERRVAL__",
                           "__ERRVAL__", $ret->error) ;
    LDAP_disconnect( LDAP => $ldap );
    return { STATUS => 0, CODE => $ret->code, DESC => $msg };
  }

  ## get dn
  if ( $attr =~ /RevocationList/i ) {
    $dn = $obj->getParsed()->{ISSUER};
  } else { # certificates
    $dn = $obj->getParsed()->{DN};
  }
  $dn =~ s/\//,/g;
  $dn =~ s/^ *,* *//g;
  ## fix problems with big letters
  $dn =~ s/email=/email=/i;
  $dn =~ s/cn=/cn=/i;
  $dn =~ s/c=/c=/i;
  $dn =~ s/ou=/ou=/i;
  $dn =~ s/o=/o=/i;
  $dn =~ s/st=/st=/i;
  $dn =~ s/l=/l=/i;

  ## $serID = $cert->getSerial();
  print "addLDAPattribute: DN= ".$dn."<br>\n" if ($DEBUG);
  print "attr: ".$attr."<br>\n" if ($DEBUG);

  ###########################
  ## build the crypto-data ##
  ###########################

  ## search the attribute
  my $search_filter = "($attr=*)";
  print "LDAP Searchfilter: ".$search_filter."<br>\n" if ($DEBUG);
  my $mesg = $ldap->search (
               base => $dn,
               scope => "base",
               filter => $search_filter);
  print "LDAP Search Mesg-Code ".$mesg->code."<br>\n" if ($DEBUG);
  print "LDAP Search Mesg-Count ".$mesg->count."<br>\n" if ($DEBUG);

  ## I stop the insertion because of a searcherror too
  if ( not $mesg or $mesg->code ) {
    ## search failed
    if (!$noprint)  {
      print gettext("Search for the attribute failed.")."\n";
    }
    my $code, $msg;
    if ($mesg) {
      $code = $mesg->code;
      $msg  = $mesg->error;
    } else {
      $code = -4;
      $msg  = gettext ("LDAP-search failed but the function returned no 
message-object.");
    }
    LDAP_disconnect( LDAP => $ldap );
    return { STATUS => 0 , CODE => $code, DESC => $msg };
  }

  if ( not $mesg->count or ($attr =~ /RevocationList/i)) {
    ## attribute not present now
    @values = ($obj->getDER());
  } else {

    ## we can get only one entry because scope is set to "base"

    ## load values
    @values = $mesg->entry (0)->get_value ( $attr);
    push @values, $obj->getDER();

    ## remove doubles
    @values = sort @values;
    for (my $i=1; $i < scalar @values; $i++) {
      if ($values[$i] eq $values[$i-1]) {
        splice @values, $i, 1;
        $i--;
      }
    }

  }

  ##############################
  ## build the emailaddresses ##
  ##############################

  ## search the attribute
  $search_filter = "(mail=*)";
  print "LDAP Searchfilter: ".$search_filter."<br>\n" if ($DEBUG);
  $mesg = $ldap->search (
               base => $dn,
               scope => "base",
               filter => $search_filter);
  print "LDAP Search Mesg-Code ".$mesg->code."<br>\n" if ($DEBUG);
  print "LDAP Search Mesg-Count ".$mesg->count."<br>\n" if ($DEBUG);

  ## I stop the insertion because of a searcherror too
  if ( not $mesg or $mesg->code ) {
    ## search failed
    if (!$noprint)  {
      print gettext("Search for the attribute mail failed.")."\n";
    }
    my $code, $msg;
    if ($mesg) {
      $code = $mesg->code;
      $msg  = $mesg->error;
    } else {
      $code = -4;
      $msg  = gettext ("LDAP-search failed but the function returned no 
message-object.");
    }
    LDAP_disconnect( LDAP => $ldap );
    return { STATUS => 0 , CODE => $code, DESC => $msg };
  }

  @mails = ();
  if ($attr =~ /userCertificate/i) {
    if ( not $mesg->count ) {
      push @mails, $obj->getParsed()->{EMAILADDRESS} if 
($obj->getParsed()->{EMAILADDRESS});
    } else {
      @mails = $mesg->entry (0)->get_value ("mail");
      @mails = () if ((scalar @mails == 1) and not $mails[0]);
     
      my $email = $obj->getParsed()->{EMAILADDRESS};
      foreach my $h (@mails) {
        if ($h =~ /$email/i) {
          $email = "";
          last;
        }
      }
      if ($email) {
        push @mails, $obj->getParsed()->{EMAILADDRESS};
      }
    }
  }

  ## insert into ldap

  print "Starting LDAP-modify: dn is ".$dn."<br>\n" if ($DEBUG);
  if (scalar @mails) {
    print "fixing mail too<br>\n" if ($DEBUG);
    $mesg = $ldap->modify ($dn, changes => [
                                    replace => [$attr  => [ @values ]],
              ##                      replace => ['mail' => [ @mails  ]]
                                        ]);
  } else {
    $mesg = $ldap->modify ($dn, changes => [
                                    replace => [$attr => [ @values ]]
                                        ]);
  }

  if( $mesg->code ) { 
 
    $txt = i18nGettext ("Error __ERRNO__: __ERRVAL__",
                        "__ERRNO__", $mesg->code,
                        "__ERRVAL__", $mesg->error);

    if (!$noprint)  {
      print "$txt\n";
    }
    LDAP_disconnect( LDAP => $ldap );
    return { STATUS => 0 , CODE => $mesg->code, DESC => $mesg->error };
  }

  $txt = gettext("Attribute successfully inserted.");
  LDAP_disconnect( LDAP => $ldap );
  if (!$noprint) {
    print i18nGettext ("Success (__MESSAGE__)", "__MESSAGE__", $txt)."\n";
  }
  return { STATUS => 1, 
           DESC => i18nGettext ("Success (__MESSAGE__)", "__MESSAGE__", $txt),
           CODE => 0 };
}

## this function add certificates and CRLs to the directory
sub deleteLDAPattribute {
  my $keys = { @_ };
  my $obj;
  my $ret;
  my $ldap;
  my $noprint;
  my $dn;
  my $attr;
  my $txt;
  my @values;

  my $DEBUG = 0;
  if ($keys->{DEBUG}) {
        $DEBUG = 1;
  }

  ## check the type of the attribute
  if ( $keys->{CERTIFICATE} ) {
    $obj = $keys->{CERTIFICATE};
    $attr = "userCertificate";
  } elsif ( $keys->{AUTHORITY_CERTIFICATE} ) {
    $obj = $keys->{AUTHORITY_CERTIFICATE};
    $attr = "cACertificate";
  } elsif ( $keys->{CRL} ) {
    $obj = $keys->{CRL};
    $attr = "certificateRevocationList";
  } elsif ( $keys->{AUTHORITY_CRL} ) {
    $obj = $keys->{AUTHORITY_CRL};
    $attr = "authorityRevocationList";
  }
  $attr .= ";binary";
  return { STATUS => 0, CODE => -1, DESC => "No object specified." } if ( not $obj );

  ## set output mode
  $noprint = $keys->{NOPRINT};
  $noprint = 0 if ($DEBUG);

  ## Initializing Connection to LDAP Server
  if ( not ( $ldap = LDAP_connect() )) {
    return { STATUS => 0, CODE => -3, DESC => gettext ("Connection refused by 
server.") };
  }

  ##// Let's bind for a predetermined User
  $ret = LDAP_bind( LDAP => $ldap );
  if ( $ret->is_error ) {
    my $msg = i18nGettext ("LDAP-bind failed: __ERRVAL__",
                           "__ERRVAL__", $ret->error) ;
    LDAP_disconnect( LDAP => $ldap );
    return { STATUS => 0, CODE => $ret->code, DESC => $msg };
  }

  ## get dn
  if ( $attr =~ /RevocationList/i ) {
    $dn = $obj->getParsed()->{ISSUER};
  } else { # certificates
    $dn = $obj->getParsed()->{DN};
  }
  $dn =~ s/\//,/g;
  $dn =~ s/^ *,* *//g;
  ## fix problems with big letters
  $dn =~ s/email=/email=/i;
  $dn =~ s/cn=/cn=/i;
  $dn =~ s/c=/c=/i;
  $dn =~ s/ou=/ou=/i;
  $dn =~ s/o=/o=/i;
  $dn =~ s/st=/st=/i;
  $dn =~ s/l=/l=/i;

  ## $serID = $cert->getSerial();
  print "deleteLDAPattribute: DN= ".$dn."<br>\n" if ($DEBUG);
  print "attr: ".$attr."<br>\n" if ($DEBUG);

  ## search the attribute
  my $search_filter = "($attr=*)";
  print "LDAP Searchfilter: ".$search_filter."<br>\n" if ($DEBUG);
  my $mesg = $ldap->search (
               base => $dn,
               scope => "base",
               filter => $search_filter);
  print "LDAP Search Mesg-Code ".$mesg->code."<br>\n" if ($DEBUG);
  print "LDAP Search Mesg-Count ".$mesg->count."<br>\n" if ($DEBUG);

  ## I stop the insertion because of a searcherror too
  if ( not $mesg or $mesg->code ) {
    ## search failed
    if (!$noprint)  {
      print gettext("Search for the attribute failed.")."\n";
    }
    my $code, $msg;
    if ($mesg) {
      $code = $mesg->code;
      $msg  = $mesg->error;
    } else {
      $code = -4;
      $msg  = gettext ("LDAP-search failed but the function returned no 
message-object.");
    }
    LDAP_disconnect( LDAP => $ldap );
    return { STATUS => 0 , CODE => $code, DESC => $msg };
  }

  my $entry = $mesg->entry (0);
  if ( $attr =~ /RevocationList/i ) {
    ## attribute not present now
    @values = ();
    $entry->replace ( $attr => [ @values ] );
  } else {

    ## we can get only one entry because scope is set to "base"a

    ## load values
    @values = $entry->get_value ( $attr);

    ## remove doubles
    @values = sort @values;
    for (my $i=1; $i < scalar @values; $i++) {
      if ($values[$i] eq $values[$i-1]) {
        splice @values, $i, 1;
        $i--;
      }
    }

    ## remove the specified object
    @values = sort @values;
    for (my $i=0; $i < scalar @values; $i++) {
      if ($values[$i] eq $obj->getDER()) {
        splice @values, $i, 1;
        $i--;
      }
    }
    $entry->replace ( $attr => [ @values ] );
  }

  ## update ldap

  print "Starting LDAP-modify: dn is ".$dn."<br>\n" if ($DEBUG);
  $mesg = $entry->update ($ldap); 

  if( $mesg->code ) { 
 
    $txt = i18nGettext ("Unknown Error ( __ERRNO__ )", "__ERRNO__", $mesg->code);

    if (!$noprint)  {
      print "$txt\n";
    }
    LDAP_disconnect( LDAP => $ldap );
    return { STATUS => 0 , CODE => $mesg->code, DESC => $mesg->error };
  }

  $txt = gettext ("Attribute successfully deleted.");
  LDAP_disconnect( LDAP => $ldap );
  if (!$noprint) {
    print i18nGettext ("Success (__MESSAGE__)", "__MESSAGE__", $txt)."\n";
  }
  return { STATUS => 1, 
           DESC => i18nGettext ("Success (__MESSAGE__)", "__MESSAGE__", $txt),
           CODE => 0 };
}

sub LDAPsearch {

        my $keys = { @_ };
        my ( $mseg, $ldap, $limit, $ldapBase, $serID, $filter, $ret );
        
        $filter = $keys->{FILTER};
        $serID  = $keys->{SERIAL};

        return if ( not $filter );

        ## Get required configuration keys
        $ldapBase = getRequired( 'basedn' );

        ## Initializing Connection to LDAP Server
        if ( not ( $ldap = LDAP_connect() )) {
                print "<FONT COLOR=\"Red\">";
                print i18nGettext ("LDAP [__CERT_SERIAL__]: Connection Refused by 
server!", "__CERT_SERIAL__", $serID)."\n";
                print "</FONT><BR>\n";

                return;
        };

        ##// Let's bind for a predetermined User
        $ret = LDAP_bind( LDAP => $ldap );
        if( $ret->is_error ) {
                print i18nGettext ("Failed in Bind: __ERRNO__", "__ERRNO__", 
$ret->{CODE}) . "\n";
                LDAP_disconnect( LDAP => $ldap );
                return $ret->{CODE};
        };

        my $mesg = $ldap->search ( base => "$ldapBase",
                                filter => "$filter" );

        if ( $mesg->code ) {
                LDAP_disconnect( LDAP => $ldap );
                return;
        }

        return { COUNT => $mesg->count, ENTRIES => $mesg->entries };
};


sub LDAP_connect {

    my $keys = { @_ };
    my ( $ldap, $ldapSrv, $port, $ldapVersion);

    ## Initializing Connection to LDAP Server
    $ldapSrv     = getRequired('ldapserver'); 
    $port        = getRequired('ldapport');
    $ldapVersion = getRequired('ldapversion');

    ## if no initialization found, get defaults
    $port   = 389 if (not $port);

    ## Get the Connection to the Server
    $ldap = Net::LDAP->new ($ldapSrv, 
                            port    => $port,
                            async   => 0,
                            version => $ldapVersion );

    return undef if( not $ldap );

    return $ldap;
}

sub LDAP_disconnect {

        my $keys => [EMAIL PROTECTED];

        my $ldap = $keys->{LDAP};

        return {STATUS => 0 } if ( not $ldap );
        $ldap->unbind;

        return {STATUS => 1};
}

sub LDAP_bind {

    my $keys = [EMAIL PROTECTED];

    ## Get Required Parameters
    my $ldapUsr  = getRequired('ldaproot');
    my $ldapPwd  = getRequired('ldappwd');

    ## Get ldap passed ref
    my $ldap = $keys->{LDAP};

    ## Return if no object passed
    return if( not $ldap );

    ## Try to bind to selected user
    my $mesg = $ldap->bind( "$ldapUsr", 'password' => "$ldapPwd" );

    ## if got an error, return it
    if ( $mesg->code ) {
        LDAP_disconnect( LDAP => $ldap );
    }

    return $mesg;
}

sub LDAP_get_crl {
        ## determine the newest CRL

        my $keys = { @_ };
        my $DEBUG = 0;
        if ($keys->{DEBUG}) {
                $DEBUG = 1;
        }

        print "ldap-utils.lib: LDAP_get_crl: try to determine the newest CRL<br>\n"
                if ($DEBUG);

        my @list = $db->searchItems ( DATATYPE => "CRL" );
        my $newest_crl = undef;
        my $newest_timestamp = 0;
        foreach my $h (@list) {
                my $timestamp = $cryptoShell->getNumericDate 
($h->getParsed()->{LAST_UPDATE});
                print "ldap-utils.lib: LDAP_get_crl: check date $timestamp<br>\n"
                        if ($DEBUG);
                if ($newest_timestamp < $timestamp) {
                        if ($DEBUG) {
                                print "ldap-utils.lib: LDAP_get_crl: newer crl 
found<br>\n";
                                print "ldap-utils.lib: LDAP_get_crl: timestamp: 
$timestamp<br>\n";
                                print "ldap-utils.lib: LDAP_get_crl: 
crl:<br>\n".$h."<br>\n";
                        }
                        $newest_timestamp = $timestamp;
                        $newest_crl = $h;
                }
        }
        print "ldap-utils.lib: LDAP_get_crl: return newest crl<br>\n" if ($DEBUG);
        return $newest_crl;
}

sub LDAP_get_ca {
        ## determine the newest CA-cert

        my $keys = { @_ };
        my $DEBUG = 0;
        if ($keys->{DEBUG}) {
                $DEBUG = 1;
        }

        print "ldap-utils.lib: LDAP_get_ca: try to determine the newest CA-cert<br>\n"
                if ($DEBUG);

        my @list = $db->searchItems ( DATATYPE => "CA_CERTIFICATE" );
        my $newest_ca = undef;
        my $newest_notbefore = 0;
        foreach my $h (@list) {
                my $notbefore = $cryptoShell->getNumericDate 
($h->getParsed()->{NOTBEFORE});
                print "ldap-utils.lib: LDAP_get_ca: check NOTBEFORE $notbefore<br>\n"
                        if ($DEBUG);
                if ($newest_notbefore < $notbefore) {
                        if ($DEBUG) {
                                print "ldap-utils.lib: LDAP_get_ca: newer ca-cert 
found<br>\n";
                                print "ldap-utils.lib: LDAP_get_ca: notbefore: 
$notbefore<br>\n";
                                print "ldap-utils.lib: LDAP_get_ca: 
ca:<br>\n".$h."<br>\n";
                        }
                        $newest_notbefore = $notbefore;
                        $newest_ca = $h;
                }
        }
        print "ldap-utils.lib: LDAP_get_ca: return newest ca<br>\n" if ($DEBUG);
        return $newest_ca;
}

sub LDAP_getDN {

    ## first argument must be the DN
    return undef if (not $_[0]);
    my $DEBUG = $_[1];
    print "LDAP_getDN called<br>\n" if ($DEBUG);
    print "LDAP_getDN: dn: ".$_[0]."<br>\n" if ($DEBUG);

    ## parse dn
    my $dn = X500::DN->ParseRFC2253 ($_[0]);
    return undef if (not $dn);
    ## has problems but we do not support multivalued attributes
    return undef if ($dn->hasMultivaluedRDNs());

    print "LDAP_getDN successfully finished<br>\n" if ($DEBUG);
    return $dn;
}

sub LDAP_getSuffix {

    my $dn = $_[0];
    my $DEBUG = $_[1];
    print "LDAP_getSuffix called<br>\n" if ($DEBUG);

    my @suffix_list = getRequiredList ('basedn');

    my $suffix_dn;
    foreach my $suffix (@suffix_list)
    {
        $suffix_dn = LDAP_getDN ($suffix, $DEBUG);
        return undef if (not $suffix_dn);

        my $res = LDAP_cmpDN ($dn, $suffix_dn, $DEBUG);
        last if (defined $res and $res >= 0);
        undef $suffix_dn;
    }

    print "LDAP_getSuffix successfully finished<br>\n" if ($DEBUG);
    return $suffix_dn;
}

sub LDAP_cmpDN {

    my $dn_1 = $_[0];
    my $dn_2 = $_[1];
    my $DEBUG = $_[2];
    print "LDAP_cmpDN called<br>\n" if ($DEBUG);

    my @rdn_list_1 = $dn_1->getRDNs;
    my @rdn_list_2 = $dn_2->getRDNs;

    my $length = scalar @rdn_list_1;
    $length = scalar @rdn_list_2 if (scalar @rdn_list_1 > scalar @rdn_list_2);

    print "LDAP_cmpDN: looping<br>\n" if ($DEBUG);
    for (my $i=0; $i < $length; $i++)
    {
        ## we do not support multivalued attributes
        my @type_1 = $rdn_list_1[$i]->getAttributeTypes;
        my @type_2 = $rdn_list_2[$i]->getAttributeTypes;

        my $value_1 = $rdn_list_1[$i]->getAttributeValue ($type_1[0]);
        my $value_2 = $rdn_list_2[$i]->getAttributeValue ($type_2[0]);

        ## normalization
        $type_1[0] = lc $type_1[0];
        $type_2[0] = lc $type_2[0];
        $value_1   = lc $value_1;
        $value_2   = lc $value_2;

        ## compare types
        return undef if ($type_1[0] ne $type_2[0]);
        return undef if ($value_1   ne $value_2);
    }
    print "LDAP_cmpDN successfully finished<br>\n" if ($DEBUG);
    return 0  if (scalar @rdn_list_1 == scalar @rdn_list_2);
    return -1 if (scalar @rdn_list_1 <  scalar @rdn_list_2);
    return 1;
}

sub LDAP_getPath {

    my @node   = $_[0]->getRDNs;
    my @suffix = $_[1]->getRDNs;
    my $DEBUG = $_[2];
    print "LDAP_getPath called<br>\n" if ($DEBUG);

    my @path = ();
    for (my $i=scalar @suffix; $i < scalar @node; $i++)
    {
        ## we do not support multivalued attributes
        push @path, [($node[$i]->getAttributeTypes)[0],
                     $node[$i]->getAttributeValue (
                         ($node[$i]->getAttributeTypes)[0]
                                                  )
                    ];
    }
    print "LDAP_getPath successfully finished<br>\n" if ($DEBUG);
    return @path;
}

sub LDAP_pushAttribute
{
    my $DEBUG = 0;

    my @ldap_array = @ { $_[0] };
    my $attribute  = $_[1];
    my $attr_hash  = $_[2];

    if ($DEBUG)
    {
        print "LDAP_pushAttribute: before attribute handling<br>\n";
        foreach my $h (@ldap_array)
        {
            print "LDAP_pushAttribute: ldap_array: $h<br>\n";
        }
        foreach my $h (keys %{$attr_hash})
        {
            print "LDAP_pushAttribute: attr_hash: $h=$attr_hash->{$h}<br>\n";
        }
    }
    if (exists $attr_hash->{lc $attribute}) {
        print "LDAP_pushAttribute: attribute $attribute exists in hash<br>\n"
            if ($DEBUG);
        if (scalar @{$attr_hash->{lc $attribute}} == 1) {
            push @ldap_array, $attribute => $attr_hash->{lc $attribute}[0];
        } else {
            push @ldap_array, $attribute => [ @{$attr_hash->{lc $attribute}}];
        }
    }
    if ($DEBUG)
    {
        print "LDAP_pushAttribute: after attribute handling<br>\n";
        print "LDAP_pushAttribute: attribute=$attribute<br>\n";
        if (exists $attr_hash->{lc $attribute})
        {
            foreach my $h (@{$attr_hash->{lc $attribute}})
            {
                print "LDAP_pushAttribute: value=$h<br>\n";
            }
        }
        foreach my $h (@ldap_array)
        {
            print "LDAP_pushAttribute: ldap: $h<br>\n";
        }
        foreach my $h (keys %{$attr_hash})
        {
            print "LDAP_pushAttribute: attr_hash: $h=$attr_hash->{$h}<br>\n";
        }
    }
    return @ldap_array;
}

1;

Reply via email to