ril.pl

Perl写的CA认证程序

#!/usr/bin/perl

## Certificates List Manager - Version 0.02.
## (c) 1998 by Massimiliano Pala
## All rights Reserved.

require 5.001;
push (@INC, "lib/" );

## Uses the OpenCA::Configuration module by Massimiliano Pala
## to load the configuration file
use OpenCA::Configuration;
use OpenCA::TRIStateCGI;

## Build a Configuration Object
my $config = new OpenCA::Configuration;

## Define the Configuration Name
my $CONFIG = 'conf/public.conf';

## Load the Configuration file (read and parse)
if( $config->loadCfg( $CONFIG ) == undef ) {
        print "Content-type: text/html\n\n";
        configError( "Unable to load configuration file (request.cnf)!");
}

## Now it's time to get the parameters passed over the web
my $query  = new OpenCA::TRIStateCGI;

## Flush the Output stream
$|=1;

print "Content-type: text/html\n\n";

## Variables Definition
my $rilDir  = getRequired( 'certsdir' );
my $basedoc = getRequired( 'rilbasedoc' );
my $getID_url = '/cgi-bin/getID?type=email';
my @rilList;

## Get the Directory Listing in the @rilList List Variable
opendir ( CERTS , "$rilDir" );
	@rilList = sort grep( /[0-9A-F]+\.pem/, readdir( CERTS ) );
closedir( CERTS );

## @rilList2 = sort numerically @rilList;
## my @rilList2 = sort @rilList;

## Get the base Page ( got in $page variable )
open ( FD, "$basedoc" ) || configError ( "File not Found : $basedoc" );
while( $temp = <FD> ) {
	$page .= $temp;
};

close ( FD );

## Create base Table and Date to substitute in the $page
## at the '$table' and '$aggiornamento' we find in the 
## $page variable ( read from the $basedoc file )
$aggiornamento = `date`;
chop( $aggiornamento );

$table = createTable();

## Process all Files
foreach $file ( @rilList ) {
	$table .= addFile( "$file", "$rilDir" ) . "\n";
}

## Close the Table
$table .= "</TABLE>\n\n";
$table .= "<!--- End of the Generated Table ---!>";

## Substitute the Variables in the $page
$page = subVars( $page, '$aggiornamento', $aggiornamento );
$page = subVars( $page, '$table', $table );

print "$page";

exit 0;

## Subroutines Section:
## ====================
##
## Main subroutines are the createTable wich creates the base
## Table with the main row ( with Descriptions ), the addFile
## wich adds a Row with the file description and date of 
## creations and so on, and the subVars ehich substitutes
## the variables name contained in the $page var with their
## correct values.

sub createTable {
	my @keys;
        my $ret;
        @keys = @_; 

	## No parameters needed
	$ret  = "\n".'<!--- Table Generated by rilCert.pl (c) 1998 by Massimiliano Pala ---!>'."\n";
	$ret .= '<TABLE BORDER=0 CELLSPACING=5 CELLPADDING=2 WIDTH="640" BGCOLOR="#FFFFFF" NOSAVE >'."\n";
	$ret .= '<TR BGCOLOR="#DDCCFF" NOSAVE>'."\n";
	$ret .= '<TD NOSAVE><B>Ser</B></TD>'."\n";
	$ret .= '<TD><B>User</B></TD>'."\n";
	$ret .= '<TD><B>Issued</B></TD>'."\n";
	$ret .= '<TD><B>E-Mail</B></TD>'."\n";
	$ret .= '</TR>'."\n";

	return $ret;
}

sub addFile {
	my @keys = @_;
        my @filestats;
	my ( $ret, $cert, $subject );

	my $fileName = $keys[0];
	my $dir = $keys[1];

        open( FD , "$dir/$fileName" ) || return;
        	@filestats = stat ( FD );
		while ( $line = <FD> ) {
			$cert .= $line;
		};
        close ( FD );

	( $subject )  = ( $cert =~ /Subject([^\n]+)/i );
	( $num )      = ( $fileName =~ /([\d\w]+)/ );
	( $titolare ) = ( $subject =~ /CN\=([^\/,]+)/i );
	( $email )    = ( $subject =~ /EMAIL\=([^\/,]+)/i );
	( $created )  = ( $cert =~ /Not Before: ([^\n]+)/i );

        @T = localtime($filestats[9]);
        ## $created = sprintf("%d/%d/%d",$T[3],$T[4]+1,$T[5]);

	$ret .= '<TR BGCOLOR="#FFFFFF" NOSAVE>'."\n";
	$ret .= '<TD>'. "<A HREF=\"$getID_url&serial=". "$num";
	$ret .= "\" ALT=\"Download Cert\">$num</A>".'</TD>' ;
	## $ret .= "$fileName". "\" ALT=\"Download Cert\">$num</A>".'</TD>' ;
	$ret .= '<TD>'. "$titolare" . '</TD>';
	$ret .= '<TD>'. "$created" . '</TD>';
	$ret .= '<TD>'. "<A HREF=\"mailto:$email\">$email</A>" . '</TD>';

	return $ret;
}

sub subVars {
	my @keys;
        my $ret;
        @keys = @_; 

	$pageVar = $keys[0];
	$varName = $keys[1];
	$var	 = $keys[2];

	$match = "\\$varName";
        $pageVar =~ s/$match/$var/g;

	return $pageVar;
}

sub numerically {
	( $w ) = ( $a =~ /([0-9]+)/ );
	( $e ) = ( $b =~ /([0-9]+)/ );
	$w <=> $e;
}

sub getRequired {

        ## Returns required parameter SINGLE STRING VALUE
        ## this function simplifies the parameter access
        ## but returns only the first parameter

        my $name = @_[0];
        my $tmp;

        if( ($tmp = $config->getParam($name)) == undef ) {

                ## If there is an Error, just send the missing
                ## parameter error to the browser
                configError( "Missing Configuration Keyword : $dir" );
        }

        ## 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 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();

}