Bahaaldin Al-amood wrote:
It is the same function in mics-utils.lib which was problematical with OpenCA:DB. I changed it again and test it with OpenCA::DB, mysql and postgresql. I hope that it is now fixed.I am using openca 0.9.1 rc7. when I go to view valid ca certs on the ca side I get an error message that says the document contain no data. I looked in the apache log file and I see this [Thu Nov 14 09:13:39 2002] [error] [client 127.0.0.1] DBD::Pg::st execute failed: ERROR: Unable to identify an operator '>' for types 'text' and 'integer' at /home/rootca-091/OpenCA/modules//perl5/OpenCA/DBI.pm line 3077., referer: http://box1777.pki.irm.vt.edu/~rootca-091/htdocs/ca/certs.html
Michael
--
-------------------------------------------------------------------
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
## Misc Utilities.
## only for testing the library
#use strict;
#my $query;
#my $config;
#my ($PRG, $VER);
sub configError {
my @keys = @_;
my $err = $keys[0];
my $errno = ( $keys[1] or "600" );
libDBAbort ();
print $query->start_html(-title=>gettext ("Administration Error"),
-BGCOLOR=>"#FFFFFF");
print "<CENTER><BR><HR WIDTH=80%><BR></CENTER>";
print "<OL><OL><H1><FONT COLOR=red>".gettext ("Error 690")."</FONT></H1>";
print "<OL> <B>".gettext ("Configuration Error")."</B>. $err.</OL></OL></OL>";
closePage();
die "Error Trapped: $err";
}
sub generalError {
my @keys = @_;
my $err = $keys[0];
my $errNo = $keys[1];
$errNo = 700 if ( not $errNo);
libDBAbort ();
print $query->start_html(-title=>gettext ("General Error"),
-BGCOLOR=>"#FFFFFF");
print "<CENTER><BR><HR WIDTH=80%><BR></CENTER>";
print "<OL><OL><H1><FONT COLOR=red>".i18nGettext ("Error __ERRNO__",
"__ERRNO__", $errNo)."</FONT></H1>";
print "<OL> <B>".gettext ("General Error")."</B>. $err.</OL></OL></OL>";
closePage();
die "General Error Trapped $errNo: $err";
}
sub getCopyRight {
my @keys = @_;
my $ret;
## Close the Table
$ret .= "<CENTER>";
$ret .= "© 1998-2002 by Massimiliano Pala and the OpenCA Group.";
$ret .= "<BR>$PRG - Version $VER";
$ret .= "</CENTER>\n";
return $ret;
}
sub closePage {
print "\n\n";
print "</PRE><CENTER><HR WIDTH=80%></CENTER>\n";
print "<FONT SIZE=\"+0\">";
print getCopyRight();
print "\n</BODY>\n";
print "</HTML>\n";
return;
}
sub success {
my @keys = @_;
my $num = $keys[0];
my $desc = $keys[1];
my $log = $keys[2];
my ($sheet, $form);
$sheet = $query->start_html(-title=>gettext ("Administration Success"),
-BGCOLOR=>"#FFFFFF");
$sheet .= "<BR><UL><HR WIDTH=\"90%\"></UL><BR></CENTER>";
$sheet .= "<CENTER><TABLE WIDTH=\"80%\" BORDER=0>";
$sheet .= "<TR><TD>";
$sheet .= "<H2><FONT COLOR=\"#335578\">$num</FONT></H2>";
$sheet .= "<B><FONT TYPE=\"Arial,Helvetica\" SIZE=+1>";
$sheet .= gettext ("Description")."</B>:</FONT><I> $desc</I>";
$sheet .= "</TD></TR>\n";
$sheet .= "</TABLE></CENTER><UL><HR WIDTH=\"90%\"></UL>";
if( $log ) {
$sheet .= "<BR>";
$sheet .= "<OL><UL><TT><FONT SIZE=\"-1\" COLOR=\"#445567\">";
$sheet .= "<PRE>$log";
$sheet .= "</PRE></FONT></TT></UL></OL><BR>\n";
$sheet .= "<UL><HR WIDTH=\"90%\"></UL>";
}
$sheet .= getCopyRight();
$sheet .= $query->end_html();
print "$sheet";
return 1;
}
sub getRequiredList {
## Returns required parameter SINGLE STRING VALUE
## this function simplifies the parameter access
## but returns only the first parameter
my @keys = @_;
my ($name, $tmp);
my $found = 0;
for $name (@keys) {
if( ($tmp = $config->getParam($name)) != undef ) {
## Parameter found
$found = 1;
last;
}
}
## Check for found value
if( $found == 0 ) {
configError( i18nGettext ("Missing Configuration Keyword(s) :
__KEYS__", "__KEYS__", @keys) );
}
return @{$tmp->{VALUES}};
}
sub getRequired {
## Returns required parameter SINGLE STRING VALUE
## this function simplifies the parameter access
## but returns only the first parameter
my $name = $_[0];
my $cnf = $_[1];
my $tmp;
if( not defined( $cnf)) {
$cnf = $config;
}
if( ($tmp = $cnf->getParam($name)) == undef ) {
## If there is an Error, just send the missing
## parameter error to the browser
configError( i18nGettext ("Missing Configuration Keyword : __KEY__",
"__KEY__", $name) );
}
## If all gone well we should have the value string in
## $ret and return it to the calling funcion;
my $ret = $tmp->{VALUES}->[0];
return $ret;
}
sub getCertStatusCRL {
## Get certificat Status. Please install the
## needed patch if you are using OpenSSL 0.9.3+
## Refer to documentation for more info.
my @keys = @_;
return undef unless $keys[0];
my $serial = $keys[0];
my $status = "Valid";
## Get Required Parameter
my $openssl = getRequired( 'openssl' );
my $crlDir = getRequired( 'CRLDir' );
## Build command for OpenSSL
my $crlCMD = "$openssl crl -noout -text -in $crlDir/cacrl.pem 2>&1";
open( CMD, "$crlCMD|" ) or configError( gettext ("CRL checking Error!") );
my $l;
while( $l = <CMD> ) {
if ($l =~ /Serial Number\:/) {
my ($serialno) =
( $l =~ /Serial Number:[\s]+([0-9A-Fa-f]+)/i );
if ($serialno eq $serial) {
my $tmpDate = <CMD>;
$tmpDate =~ s/Revocation Date: //i;
$status = i18nGettext ("Revoked on __DATE__",
"__DATE__", $tmpDate);
}
}
}
close(CMD);
return $status;
}
sub addEntry {
my $key = shift @_;
my $val = shift @_;
my $ret;
$ret = '<TR VALIGN=TOP BGCOLOR="#FFFFFF">'."\n";
$ret .= "<TD><B>$key</B></TD>";
$ret .= '<TD>'. "$val" . '</TD>';
$ret .= "</TR>";
}
sub parseIndexLine {
my @keys;
@keys = @_;
my %ret = {};
my ( $ser, $email, $dn, $cn, $ou, $c, $exp, $rev, $status, $unk );
my $line = $keys[0];
return unless $line;
( $status, $exp, $rev, $ser, $unk, $dn ) =
( $line =~ /^([\w]+)\s([\d]+)Z\s([\d]*)[Z]*\s([\w]+)\s([\w]*)\s(.*)/i );
( $email ) = ( $dn =~ /emailAddress=([^\/\n]+)/i );
( $cn ) = ( $dn =~ /CN=([^\/\n]+)/i );
( $ou ) = ( $dn =~ /OU=([^\/\n]+)/i );
( $c ) = ( $dn =~ /C=([^\/\n]+)/i );
if( $status eq "V" ) {
$status = gettext("Valid");
} else {
if ( $status eq "R" ) {
$status = gettext("Revoked");
} else {
if ( $status eq "E" ) {
$status = gettext("Expired");
} else {
$status = gettext("Unknown");
}
}
}
my $ret = { DN => $dn,
EMAIL => $email,
CN => $cn,
OU => $ou,
C => $c,
EXPIRATION => $exp,
REVOKATION => $rev,
STATUS => $status,
SERIAL => $ser };
return $ret;
}
sub save {
my $keys = { @_ };
my $fileName = $keys->{FILENAME};
my $data = $keys->{DATA};
return if ( ( not $data ) or ( not $fileName ) );
open ( FD, ">$fileName" ) or return;
print FD "$data";
close( FD );
return 1;
}
sub copyCerts {
## This routines simply copy the certificates from the
## $from ( 1st argument ) directory to the $dest (2nd
## arg) dir matching the $filter (3rd arg) filename
my @keys = @_;
my @certList;
my $retVal;
my $from = $keys[0];
my $dest = $keys[1];
my $filter = $keys[2];
my $fileName = "";
## If we did not passed the right arguments, than return
## without doing nothing...
return unless ( ( "$from" ne "") and ("$dest" ne "") );
if( "$filter" eq "" ) {
$filter = '.*';
}
##// Now Let's Open the Directory
opendir ( CERTS , "$from" ) or return undef;
@certList = grep(/$filter/, readdir( CERTS ) );
closedir( CERTS );
my $file;
foreach $file (@certList) {
my $origFile = "$from/$file";
my $destFile = "$dest/$file";
## We must read and then save the file because
##// the link/unlink doesn't work with multiple
## cross devices.
my $ret = $query->getFile( $origFile );
open( FD, ">$destFile" ) or print "ERROR: $?<BR>";
print FD "$ret";
close(FD);
$retVal .= "$file\n";
}
return $retVal;
}
sub libLoadCommand {
my $cmd = $_[0];
my $command = getRequired ('CgiCmdsPath')."/$cmd";
if( -e "$command" ) {
require "$command";
} else {
## No Valid Command has been given if you reach this point
generalError( i18nGettext ("Command __COMMAND__ Not Supported ( yet ?!? ).",
"__COMMAND__", $cmd) );
die "Cannot Find $cmd Command!";
}
}
sub libDoCommand {
$cmd = $_[0];
##// Let's get the commands directly from the cmds/ directory.
## The require will load and execute it
libLoadCommand ($cmd);
$cmd = "cmd".uc (substr ($cmd, 0, 1)).substr ($cmd, 1, length ($cmd)-1);
if (eval $cmd."()") {
libDBCommit();
}
}
sub libDBGetFirstItem {
my $datatype = $_[0];
if ($datatype =~ /CA_CERTIFICATE|CRL/i) {
## smallest digest of core-data
## FIXME: this is an ascii-specific hack
return $db->getNextItem (DATATYPE => $datatype, KEY=>".");
} else {
## impossible serial number
return $db->getNextItem (DATATYPE => $datatype, KEY=>-1);
}
}
sub libDBGetLastItem {
my $datatype = $_[0];
if ($datatype =~ /CA_CERTIFICATE|CRL/i) {
## biggest digest of core-data
## FIXME: this is an ascii-specific hack
## FIXME: used for lexical compare in OpenCA::DB and OpenCA::DBI
if (getRequired ('DBmodule') =~ /DBI/i)
{
return $db->getPrevItem (DATATYPE => $datatype, KEY=>"}");
} else {
return $db->getPrevItem (DATATYPE => $datatype);
}
} else {
## biggest serial number
## FIXME: this is a hardocded limitation for number of requests and
certificates
## FIXME: the maximum in defaultconfiguration is now 0xFFFFFF or
16.777.215
## FIXME: if you use a 64-bit machine and compiled perl in 64-bit-mode
then you can
## FIXME: simply use 8-byte integer
return $db->getPrevItem (DATATYPE => $datatype,
KEY=>hex('0xFFFFFFFF'));
}
}
sub clientFilledForm {
if ("$PASSWD" ne "$PASSWD2") {
generalError(gettext ("Two different pin inserted. Please go
<B><I>back</I></B> and correct the error."), 560 );
}
printFormTwo( FILENAME => $formFile2 );
return undef;
}
sub bpScanDir {
my $dir = $_[0];
my $sub = $_[1];
eval $sub." (\"$dir\");";
## get directories
opendir( DIR, $dir );
my @dirList = sort readdir( DIR );
closedir( DIR );
## check every directory
my $h;
foreach $h (@dirList) {
next if ($h eq ".");
next if ($h eq "..");
next if (not -d $dir."/".$h);
bpScanDir ($dir."/".$h, $sub);
}
}
sub i18nGettext {
my $i18n_string = gettext ($_[0]);
my $i = 1;
my $option;
my $value;
while ($_[$i]) {
$i18n_string =~ s/$_[$i]/$_[$i+1]/g;
$i += 2;
}
return $i18n_string;
}
sub libDBCommit {
if (getRequired ('DBmodule') =~ /DBI/i) {
return $db->commit();
}
}
sub libDBAbort {
if (getRequired ('DBmodule') =~ /DBI/i and $db) {
return $db->rollback();
}
}
1;
