getcert

Perl写的CA认证程序

#!/usr/bin/perl 

## Get the User Certificate
## (c) 1998 by Massimiliano Pala - Ver 2.1
## All Rights Reserved

## Version Information
$VER = '2.1.01';
$PRG = 'Certificates Send over HTTP';

## Let's get parameters
my $key       = ( $query->param('key') || $query->param('serial') );
my $dataType  = ( $query->param('dataType') || "VALID_CERTIFICATE" );

## Certificates directory
my $errPage  = getRequired( 'getIDErrForm' );
my $tmpdir   = getRequired( 'tempdir' );

## Error if the certificate is not present in DBMS
if ( not ($cert = $db->getItem(DATATYPE=>$dataType,
			    KEY=>$key )) ) {
	sendPage( $errPage );
}

## Get User Agent
my $agent = $query->user_agent();

if ( $agent =~ /MSIE/ ) {
	sendCertIE( $key, $cert, $tmpdir );
} else {
	sendCertMozilla( $key, $cert );
}

exit 0;

## Subroutines Section : expecially there is room for
## the erro page transmitting.

sub sendPage {
	my @keys;
	@keys = @_ ;
	$filename = $keys[0];

	print "Content-type: text/html\n\n";
	print $query->getFile( "$filename" );

	exit 0;
}


sub sendCertMozilla {
	my $key = shift;
	my $cert = shift;

	my $mimetype = "Content-type: application/x-x509-user-cert\n\n";
	my $bgcert = '-----BEGIN CERTIFICATE-----';
	my $endcert = '-----END CERTIFICATE-----';

	print $mimetype;
	print $cert->getPEM();

	exit 0;
}

sub sendCertIE {
	my $key = shift;
	my $cert = shift;
	my $tmpdir = shift;

	my $cacert = getRequired( "PEMcacert" );
	my $iePage = getRequired( 'getID_IE_Page' );

	my $page = $tools->getFile( $iePage );

	my $tmpfile = "$tmpdir/${$}_cert.pem";
	my $pkcs7data = "";

	$cryptoShell->dataConvert( DATA=>$cert->getPEM(), DATATYPE=>"CERTIFICATE",
			OUTFILE=>"$tmpfile" );
	$pkcs7data = $cryptoShell->crl2pkcs7(CERTSLIST=>["$cacert","$tmpfile"]);
	$pkcs7data =~ s/-----BEGIN PKCS7-----\n//;
	$pkcs7data =~ s/\n-----END PKCS7-----\n*//;

	unlink( "$tmpfile" );

	$page =~ s/\@pkcs7cert\@/$pkcs7data/g;

	print "Content-type: text/html\n\n";
	print "$page";
	
	exit 0;
}