misc-utils.lib

Perl写的CA认证程序

## Misc RAServer Utilities.

sub configError {
	my @keys = @_;
	my $err = $keys[0];
	my $errno = ( $keys[1] or "600" );

	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();
	exit(0);
}

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";

        return;
}

sub success {
        my @keys = @_;

        my $num = $keys[0];
        my $desc = $keys[1];

        my $sheet, $form;

        $sheet =  $query->start_html(-title=>"Administration Success",
                -BGCOLOR=>"#FFFFFF");
	$sheet .= "<CENTER><BR><HR WIDTH=\"80%\"><BR></CENTER>";
        $sheet .= "<CENTER><TABLE WIDTH=\"80%\" BORDER=0>";
        $sheet .= "<TR><TD>";
        $sheet .= "<H2><FONT COLOR=\"#336699\">Operation $num</FONT></H2>";
        $sheet .= "<B><FONT TYPE=\"Arial,Helvetica\" SIZE=+1>";
        $sheet .= "Description</B>:</FONT><I> $desc</I>";
	$sheet .= "</TD></TR>\n";
        $sheet .= "</TABLE><HR WIDTH=\"80%\">";
	$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 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 checkDisk {
        my @keys;
        my $req;
        @key = @_;

        print "<LI> Checking Disk presence .......... ";

        $ret=`/bin/volcheck -v /dev/diskette0`;

        if ( $? == 0 ) {
                print "Ok.</LI>\n";
                return;
        } else {
                print "Failed!</LI>\n";
                print "<FONT COLOR=RED>Reported Error:<BR>\n";
                print "<PRE>$ret\n\n</PRE></FONT>";
                closePage();
                exit 200;
        }

##        if ( "$ret" =~ m/\/dev\/diskette0 has media/ ) {
##                print "Ok.</LI>\n";
##                return;
##        } else {
##                print "<PRE>\n\nFailed!\n\n\t  Errore Riportato :";
##              print " Floppy non inserito!\n\n</PRE>";
##                print $ret;
##              closePage();
##              exit 200;
##        }
}

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;