Ok, here is the attachment.
--
-------------------------------------------------------------------
Michael Bell Email (private): [EMAIL PROTECTED]
Rechenzentrum - Datacenter Email: [EMAIL PROTECTED]
Humboldt-University of Berlin Tel.: +49 (0)30-2093 2482
Unter den Linden 6 Fax: +49 (0)30-2093 2959
10099 Berlin
Germany http://www.openca.org
## RA Server Management Utility
## (c) 1999 by Massimiliano Pala
## 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!
## only for testing the library
# use strict;
#my $db;
#my $query;
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( "File $filename not found!");
}
$tmp = $query->getFile( "$filename");
if( $tmp eq "" ) {
success( "Last Import file was empty.");
}
@certsList = split( "\n", $tmp );
my $table = $query->buildRefs ( ELEMENTS =>, MAXITEMS =>);
$table .= $query->startTable (COLS=>[ "Cert.-No.",
"DN",
"adding dn",
"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\">".
"ERROR [$serID] : can't get certificate" .
" from dB!\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, "success");
} else {
push (@line, "Error : ".$ret->{CODE});
}
} else {
push (@line, "operation not performed");
}
$table .= $query->addTableLine ( DATA => [ @line ]);
}
$table .= $query->endTable;
print $table;
return "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;
}
## check the type of the attribute
$obj = $keys->{CERTIFICATE};
return if ( not $obj );
## get the needed data
my $cert_dn = $obj->getParsed ()->{DN};
my $cert_cn = $obj->getParsed ()->{DN_HASH}->{CN}[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);
## here we could perform some operations with the data
## sn is not the real sn sometimes but you can find
## the person via a search with a wildcard
my $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 "LDAP [$serID]: Connection Refused by server!\n";
print "</FONT><BR>\n";
return;
};
## Let's bind for a predetermined User
$ret = LDAP_bind( LDAP => $ldap );
if( not $ret->{STATUS} ) {
print "Failed in Bind: " . $ret->{CODE} . "\n";
LDAP_disconnect( LDAP => $ldap );
return $ret->{CODE};
};
## build the array from the LDAP root
my $basedn = getRequired ('basedn');
my @basedn_array = ();
my $h_attribute;
while ($basedn) {
## get the last element
$h_attribute = $basedn;
$basedn =~ s/^[^,]*,//;
$h_attribute = substr ($h_attribute,
0,
length ($h_attribute) - length ($basedn));
if ( not $h_attribute ) {
$h_attribute = $basedn;
$basedn = "";
}
$h_attribute =~ s/,//;
$h_attribute =~ s/(^ )|( $)//g;
print "element of baseDN: ".$h_attribute."<br>\n" if ($DEBUG);
if ($h_attribute =~ /^\s*ou\s*=.*$/i) {
$ou_array [$ou_counter] = $h_attribute;
$ou_array [$ou_counter] =~ s/^\s*ou\s*=\s*//i;
$ou_counter++;
}
push (@basedn_array, $h_attribute);
}
## build the array from the DN
my $h_dn = $cert_dn;
my @dn_array = ();
my $h_attribute;
while ($h_dn) {
## get the last element
$h_attribute = $h_dn;
$h_dn =~ s/^[^\/,]*[\/,]//;
$h_attribute = substr ($h_attribute,
0,
length ($h_attribute) - length ($h_dn));
if ( not $h_attribute ) {
$h_attribute = $h_dn;
$h_dn = "";
}
$h_attribute =~ s/\///;
$h_attribute =~ s/,//;
$h_attribute =~ s/(^ )|( $)//g;
print "element of the inserted DN: ".$h_attribute."<br>\n" if ($DEBUG);
push (@dn_array, $h_attribute);
}
## verify that the root in the DN is ok
print "Checking RootDN of Certificate ...<br>\n" if ($DEBUG);
print "Inserted DN\t\t\tBaseDN<br>\n" if ($DEBUG);
while (scalar (@basedn_array) and scalar (@dn_array)) {
my $h_basedn = pop (@basedn_array);
my $h_dn = pop (@dn_array);
my $h_basedn_attribute = $h_basedn;
my $h_dn_attribute = $h_dn;
## remove the =
$h_basedn =~ s/.*=//;
$h_dn =~ s/.*=//;
$h_basedn_attribute =~ s/=.*//;
$h_dn_attribute =~ s/=.*//;
print "h_basedn: ". $h_basedn. "<br>\n" if ($DEBUG);
print "h_dn: ". $h_dn. "<br>\n" if ($DEBUG);
print "h_basedn_attribute: ".$h_basedn_attribute."<br>\n" if ($DEBUG);
print "h_dn_attribute: ". $h_dn_attribute. "<br>\n" if ($DEBUG);
## this dn cannot be added under the root-dn
if ( ($h_basedn !~ /^$h_dn$/i) or
($h_basedn_attribute !~ /^$h_dn_attribute$/i)
) {
print "dn conflicts with basedn<br>\n" if ($DEBUG);
LDAP_disconnect ( $ldap );
return { STATUS => 0 ,
DESC => "Error ( dn conflicts with basedn )",
CODE => -1 };
}
}
## add an empty string to create the basedn if necessary
push @dn_array, "";
## dn which should be inserted is shorter then the root-dn
print "Checking the length of the DN of the Certificate ...<br>\n" if ($DEBUG);
if ( scalar (@basedn_array) ) {
LDAP_disconnect ( $ldap );
return { STATUS => 0 ,
DESC => "Error ( dn is shorter then basedn )",
CODE => -2 };
}
## if dn == basedn then their is no error because this can
## be the CA-dn
return { STATUS => 1, CODE => 0, DESC => "Success" }
if (!scalar (@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 = getRequired ('basedn');
my $actual_element;
my $use_ldap_add = 0;
while (scalar (@dn_array)) {
$actual_element = pop @dn_array;
if ($actual_element =~ /^\s*ou\s*=.*$/i) {
$ou_array [$ou_counter] = $actual_element;
$ou_array [$ou_counter] =~ s/^\s*ou\s*=\s*//i;
$ou_counter++;
}
## prepare the needed strings
if ($actual_element) {
## protection against basedn
$add_dn = $actual_element.",".$add_dn;
}
print "Try to add $add_dn ...<br>\n" if ($DEBUG);
## check that the entry 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 @attr;
if ($add_dn =~ /^\s*(cn|dc|sn|email|emailAddress|serialNumber)\s*=.*$/i) {
if ($obj->getParsed()->{IS_CA}) {
push @attr, 'objectclass' => [ 'top',
'organization',
'certificationAuthority'
];
push @attr, 'o' => $cert_o if ($cert_o);
push @attr, 'st' => $cert_st if ($cert_st and $add_dn =~ /\s*st\s*=/i);
push @attr, 'l' => $cert_l if ($cert_l and $add_dn =~ /\s*l\s*=/i);
push @attr, 'authorityRevocationList;binary' => '';
push @attr, 'certificateRevocationList;binary' => '';
push @attr, 'cACertificate;binary' => '';
} else {
return undef if (not $cert_sn or not $cert_cn);
push @attr, 'objectclass' => [ 'top',
'person',
'organizationalPerson',
'inetOrgPerson'
];
push @attr, 'cn' => $cert_cn;
if ($add_dn =~ /^\s*sn\s*=.*$/i) {
my $sn = $add_dn;
$sn =~ s/,.*$//g;
$sn =~ s/^.*=//;
push @attr, 'sn' => $sn;
} else {
push @attr, 'sn' => $cert_sn;
}
push @attr, 'ou' => [ @ou_array ] if (scalar @ou_array);
push @attr, 'o' => $cert_o if ($cert_o);
push @attr, 'mail' => $cert_email if ($cert_email);
push @attr, 'st' => $cert_st if ($cert_st and $add_dn =~ /\s*st\s*=/i);
push @attr, 'l' => $cert_l if ($cert_l and $add_dn =~ /\s*l\s*=/i);
}
} elsif ($add_dn =~ /^\s*ou\s*=.*$/i) {
return undef if (not scalar @ou_array);
push @attr, 'ou' => [ @ou_array ];
push @attr, 'authorityRevocationList;binary' => '';
push @attr, 'certificateRevocationList;binary' => '';
push @attr, 'cACertificate;binary' => '';
push @attr, 'objectclass' => [ 'top',
'organizationalUnit',
'certificationAuthority'
];
push @attr, 'st' => $cert_st if ($cert_st and $add_dn =~ /\s*st\s*=/i);
push @attr, 'l' => $cert_l if ($cert_l and $add_dn =~ /\s*l\s*=/i);
} elsif ($add_dn =~ /^\s*o\s*=.*$/i) {
return undef if (not $cert_o);
push @attr, 'o' => $cert_o;
push @attr, 'authorityRevocationList;binary' => '';
push @attr, 'certificateRevocationList;binary' => '';
push @attr, 'cACertificate;binary' => '';
push @attr, 'objectclass' => [ 'top',
'organization',
'certificationAuthority'
];
push @attr, 'st' => $cert_st if ($cert_st and $add_dn =~ /\s*st\s*=/i);
push @attr, 'l' => $cert_l if ($cert_l and $add_dn =~ /\s*l\s*=/i);
} elsif ($add_dn =~ /^\s*c\s*=.*$/i) {
return undef if (not $cert_c);
push @attr, 'c' => $cert_c;
push @attr, 'objectclass' => [ 'top',
'country'
];
} elsif ($add_dn =~ /^\s*st\s*=.*$/i) {
return undef if (not $cert_st);
push @attr, 'st' => $cert_st;
push @attr, 'objectclass' => [ 'top',
'locality'
];
} elsif ($add_dn =~ /^\s*l\s*=.*$/i) {
return undef if (not $cert_l);
push @attr, 'st' => $cert_l;
push @attr, 'objectclass' => [ 'top',
'locality'
];
} else {
return undef;
}
print "Attributes for the insertion:<br>\n" if ($DEBUG);
for (my $h=0; $h < scalar @attr; $h+=2) {
print "$attr[$h] = $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 => [ @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->code ) {
## print "<FONT COLOR=\"Red\">";
## print "Error Adding DN [$serID]: " . $ldapadd_result->code ."<BR>\n";
## print "</FONT>";
LDAP_disconnect ( $ldap );
return { STATUS => 0 ,
DESC => "Error ( code " .
$ldapadd_result->code . " )",
CODE => $ldapadd_result->code };
}
}
LDAP_disconnect ( $ldap );
return { STATUS => 1, CODE => 0, DESC => "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 $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 if ( not $obj );
## set output mode
$noprint = $keys->{NOPRINT};
$noprint = 0 if ($DEBUG);
## Initializing Connection to LDAP Server
if ( not ( $ldap = LDAP_connect() )) {
return;
}
## Let's bind for a predetermined User
$ret = LDAP_bind( LDAP => $ldap );
if ( not $ret->{STATUS} ) {
LDAP_disconnect ( LDAP => $ldap );
return;
}
## 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);
## 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 "Search for the attribute failed.\n";
}
my $code;
if ($mesg) {
$code = $mesg->code;
} else {
$code = 1;
}
LDAP_disconnect( LDAP => $ldap );
return { STATUS => 0 , CODE => $code };
}
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;
$i--;
}
}
}
## insert into ldap
print "Starting LDAP-modify: dn is ".$dn."<br>\n" if ($DEBUG);
$mesg = $ldap->modify ($dn, replace => {$attr => [ @values ] });
if( $mesg->code ) {
$txt = "Unknown Error ( " . $mesg->code . " )";
if (!$noprint) {
print "$txt\n";
}
LDAP_disconnect( LDAP => $ldap );
return { STATUS => 0 , CODE => $mesg->code };
} else {
$txt = "Attribute successfully inserted."
}
LDAP_disconnect( LDAP => $ldap );
if (!$noprint) {
# print "LDAP Result [$serID]: Success ( " . $mesg->code ." )<BR>\n";
print "Success (".$txt.")\n";
}
return { STATUS => 1,
DESC => "Success (".$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 if ( not $obj );
## set output mode
$noprint = $keys->{NOPRINT};
$noprint = 0 if ($DEBUG);
## Initializing Connection to LDAP Server
if ( not ( $ldap = LDAP_connect() )) {
return;
}
## Let's bind for a predetermined User
$ret = LDAP_bind( LDAP => $ldap );
if ( not $ret->{STATUS} ) {
LDAP_disconnect ( LDAP => $ldap );
return;
}
## 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 or not $mesg->count ) {
## search failed
if (!$noprint) {
print "Search for the attribute failed.\n";
}
my $code;
if ($mesg) {
$code = $mesg->code;
} else {
$code = 1;
}
LDAP_disconnect( LDAP => $ldap );
return { STATUS => 0 , CODE => $code };
}
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;
$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;
$i--;
}
}
$entry->replace ( $attr => [ @values ] );
}
## doens't work
## if ( (not scalar @values) and
## ($attr !~ /userCertificate/i)
## ) {
## ## possible object class violation
## ## remove certificationAuthority
##
## print "delete CA to avoid objectclass violation ...<br>\n" if ($DEBUG);
##
## @values = $entry->get_value ('objectclass');
## @values = sort @values;
## for (my $i=1; $i < scalar @values; $i++) {
## if ($values[$i] =~ /certificationAuthority/i) {
## splice @values, $i;
## $i--;
## }
## }
## $entry->replace ( objectclass => [ @values ] );
## }
## update ldap
print "Starting LDAP-modify: dn is ".$dn."<br>\n" if ($DEBUG);
$mesg = $entry->update ($ldap);
if( $mesg->code ) {
$txt = "Unknown Error ( " . $mesg->code . " )";
if (!$noprint) {
print "$txt\n";
}
LDAP_disconnect( LDAP => $ldap );
return { STATUS => 0 , CODE => $mesg->code };
} else {
$txt = "Attribute successfully deleted."
}
LDAP_disconnect( LDAP => $ldap );
if (!$noprint) {
# print "LDAP Result [$serID]: Success ( " . $mesg->code ." )<BR>\n";
print "Success (".$txt.")\n";
}
return { STATUS => 1,
DESC => "Success (".$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 "LDAP [$serID]: Connection Refused by server!\n";
print "</FONT><BR>\n";
return;
};
## Let's bind for a predetermined User
$ret = LDAP_bind( LDAP => $ldap );
if( not $ret->{STATUS} ) {
print "Failed in Bind: " . $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, $ldapUsr, $ldapBase, $ldaplim,
$ldapPwd, $filter, @attrs, $ret );
## Initializing Connection to LDAP Server
$ldapSrv = getRequired( 'ldapserver' );
$port = getRequired('ldapport');
$ldaplim = getRequired('ldaplimit');
## 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 );
return if( not $ldap );
return $ldap;
}
sub LDAP_disconnect {
my $keys => {@_};
my $ldap = $keys->{LDAP};
return {STATUS => 0 } if ( not $ldap );
$ldap->unbind;
return {STATUS => 1};
}
sub LDAP_bind {
my $keys = {@_};
## 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 { STATUS => 0, CODE => $mesg->code };
};
return { STATUS => 1 };
}
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_update_crl {
}
sub LDAP_update_ca {
}
sub LDAP_update_single_ca {
}
sub LDAP_update_certs {
}
sub LDAP_update_authority {
}
sub LDAP_update_all {
}
sub LDAP_add_all_cas {
}
sub LDAP_add_certs {
}
sub LDAP_add_cert {
}
sub LDAP_add_new_certs {
}
sub LDAP_remove_certs {
}
sub LDAP_remove_cert {
}
1;
