misc-utils.lib

Perl写的CA认证程序

## Misc CA Utilities.

sub buildRefs {
        my @keys = @_;
        my $ret, $i;

	my $query    = $keys[0];
	my $maxItems = $keys[2];

	$maxItems = 30 if( not $maxItems );

	my $rows     = (($query->param('rows')) or (int $keys[1] / $maxItems));
        my $current  = int $query->param('viewFrom') / $maxItems;

        my $title = "<DIV ALIGN=\"RIGHT\"><FONT SIZE=\"-1\">Extra References ";

        for( $i = 0; $i <= $rows ; $i++ ) {
                my $from = $i * $maxItems;
                my $to   = $from + $maxItems;

                if ( $i != $current ) {
                        $query->param( -name=>"rows",     -value=>"$rows" );
                        $query->param( -name=>"viewFrom", -value=>"$from" );
                        $query->param( -name=>"viewTo",   -value=>"$to" );

                        my $link = $query->self_url();
                        $title .= "&nbsp; <a href=\"$link\">$i</a> ";
                } else {
                        $title .= "&nbsp; $i ";
                }
        }
	$title .= "</FONT></DIV>";

        $ret = $query->startTable( COLS=>[ "$title" ],
                               TITLE_BGCOLOR=>"#EEEEF1",
                               TABLE_BGCOLOR=>"#000000" );

        $ret .= $query->endTable();

        return $ret;
}

sub configError {
	my @keys = @_;
	my $err = $keys[0];

	print $query->start_html(-title=>"Administration Error",
		-BGCOLOR=>"#FFFFFF");
	print "<CENTER><BR><HR WIDTH=80%><BR></CENTER>";
	print "<OL><OL><H1><FONT COLOR=red>Error 690 </FONT></H1>";
	print "<OL> <B>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);

	print $query->start_html(-title=>"General Error",
		-BGCOLOR=>"#FFFFFF");
	print "<CENTER><BR><HR WIDTH=80%><BR></CENTER>";
	print "<OL><OL><H1><FONT COLOR=red>Error $errNo </FONT></H1>";
	print "<OL> <B>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 .= "&copy; 1998-2001 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 "<CENTER>&copy; 1998/1999 by Massimiliano Pala";
	## print " and the OpenCA Group</CENTER></FONT>\n";

	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=>"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 .= "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( "Missing Configuration Keyword(s) : @keys" );
	}

	$ret = $tmp->{VALUES}->[0];
	return $ret;
}

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( "Missing Configuration Keyword : $name" );
	}

	## If all gone well we should have the value string in
	## $ret and return it to the calling funcion;

	$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( "CRL checking Error!" );
        while( $l = <CMD> ) {
		if ($l =~ /Serial Number\:/) {
                	($serialno) =
                        	( $l =~ /Serial Number:[\s]+([0-9A-Fa-f]+)/i );
                        if ($serialno eq $serialn) {
                                my $tmpDate = <CMD>;
                                $tmpDate =~ s/Revocation Date: //i;
                                $status = "Revoked on $tmpDate";
                                break;
                        }
                }
        }
        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 startLogPage {
	my $title = shift;
	my $ret;

	$title = "Proceeding" if ( not $title );

	$ret = $query->start_html(-title=>"Requests Exporting Page",
					-BGCOLOR=>"#FFFFFF",
					-TEXT=>"#445599" );

        $ret .=  "<CENTER>";
        $ret .=  "<FONT SIZE=\"+3\">";
        $ret .=  "<B>$title</B></FONT><BR>\n";
        $ret .=  "<FONT SIZE=\"+1\">";
        $ret .=  "(Please wait until operation completes)</FONT><BR>\n";
        $ret .=  "<HR WIDTH=80%>";

	return $ret;
}


sub closeLogPage {

	my $ret;

	$ret = "<HR WIDTH=\"80%\"></CENTER>";
	$ret .= getCopyRight();

	$ret .= $query->end_html();

	return $ret;
}

sub parseIndexLine {
        my @keys;
        @keys = @_;
        my %ret = {};
        my $ser, $email, $cn, $exp, $rev, $status;

        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 =~ /Email=([^\/\n]+)/i );
        ( $cn )    = ( $dn =~ /CN=([^\/\n]+)/i );
        ( $ou )    = ( $dn =~ /OU=([^\/\n]+)/i );
        ( $c )     = ( $dn =~ /C=([^\/\n]+)/i );

        if( $status eq "V" ) {
                $status = "Valid";
        } else {
                if ( $status eq "R" ) {
                        $status = "Revoked";
                } else {
                        if ( $status eq "E" ) {
                                $status = "Expired";
                        } else {
                                $status = "Unknown";
                        }
                }
        }
        $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 @certsList;
        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 );

        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.

                $ret = $query->getFile( $origFile );
                open( FD, ">$destFile" ) or print "ERROR: $?<BR>";
                        print FD "$ret";
                close(FD);
                $retVal .= "$file\n";
        }

        return $retVal;
}

1;