Nicholas Roussos wrote:
Hi again Michael,

I was able to import the CA certificate in LDAP if I skipped the email address part. By viewing the CA certificate, I used the option "Import to LDAP with modified DN". I then removed the email info from the DN and the certificate was imported successfully. So I created another CA certificate to test this, and I skipped the email address. Then when I transferred the data from CA to RA, for the first time after I initialized the RA database, the CA certificate was successfully imported and made available through the LDAP server.

Now I have an idea what's going wrong. It's the same problem like with serialNumber for user certificates. I attached an extended schema and a changed ldap-utils.lib.


Now, do you guys use the email address in the CA certificates?

I don't use the emailaddress in the subject (only in the subject alternative name).


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
## from RFC 2587
##
## pkiUser   OBJECT-CLASS   ::= {
##    SUBCLASS OF   { top}
##    KIND          auxiliary
##    MAY CONTAIN   {userCertificate}
##    ID    joint-iso-ccitt(2) ds(5) objectClass(6) pkiUser(21)}
##
## pkiCA   OBJECT-CLASS   ::= {
##    SUBCLASS OF   { top}
##    KIND          auxiliary
##    MAY CONTAIN   {cACertificate |
##                   certificateRevocationList |
##                   authorityRevocationList |
##                   crossCertificatePair }
##    ID    joint-iso-ccitt(2) ds(5) objectClass(6) pkiCA(22)}
##
## copied from Entrust because serialNumber is not manageable by standards
##
## uniquelyIdentifiedUser   OBJECT-CLASS   ::= {
##    SUBCLASS OF   { top}
##    KIND          auxiliary
##    MUST CONTAIN  {serialNumber }
##    ID    id-nsn-oc-uniquelyIdentifiedUser(1.2.840.113533.7.67.4)}
##
## copied from Entrust because emailAddress for CAs is not manageable by standards
##
## rfc822MailUser   OBJECT-CLASS   ::= {
##    SUBCLASS OF   { top}
##    KIND          auxiliary
##    MUST CONTAIN  {rfc822Mailbox }
##    ID    id-nsn-oc-rfc822MailUser(1.2.840.113533.7.67.7)}
##
## FIXME: should we add support for PKCS#9 emailAddress to?

objectclass ( 2.5.6.21 NAME 'pkiUser' SUP top AUXILIARY
        MAY ( userCertificate )
        )

objectclass ( 2.5.6.22 NAME 'pkiCA' SUP top AUXILIARY
        MAY ( cACertificate $ certificateRevocationList $ authorityRevocationList $ 
crossCertificatePair )
        )

objectclass ( 1.2.840.113533.7.67.4 NAME 'uniquelyIdentifiedUser' SUP top AUXILIARY
        MUST ( serialNumber )
        )

objectclass ( 1.2.840.113533.7.67.7 NAME 'rfc822MailUser' SUP top AUXILIARY
        MUST ( mail )
        )
## 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});
            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});
            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