## OpenCA::REQ
##
## Copyright (C) 1998-1999 Massimiliano Pala (madwolf@openca.org)
## All rights reserved.
##
## This library is free for commercial and non-commercial use as long as
## the following conditions are aheared to.  The following conditions
## apply to all code found in this distribution, be it the RC4, RSA,
## lhash, DES, etc., code; not just the SSL code.  The documentation
## included with this distribution is covered by the same copyright terms
## 
## // Copyright remains Massimiliano Pala's, and as such any Copyright notices
## in the code are not to be removed.
## If this package is used in a product, Massimiliano Pala should be given
## attribution as the author of the parts of the library used.
## This can be in the form of a textual message at program startup or
## in documentation (online or textual) provided with the package.
## 
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following conditions
## are met:
## 1. Redistributions of source code must retain the copyright
##    notice, this list of conditions and the following disclaimer.
## 2. Redistributions in binary form must reproduce the above copyright
##    notice, this list of conditions and the following disclaimer in the
##    documentation and/or other materials provided with the distribution.
## 3. All advertising materials mentioning features or use of this software
##    must display the following acknowledgement:
## //   "This product includes OpenCA software written by Massimiliano Pala
## //    (madwolf@openca.org) and the OpenCA Group (www.openca.org)"
## 4. If you include any Windows specific code (or a derivative thereof) from 
##    some directory (application code) you must include an acknowledgement:
##    "This product includes OpenCA software (www.openca.org)"
## 
## THIS SOFTWARE IS PROVIDED BY OPENCA DEVELOPERS ``AS IS'' AND
## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
## ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
## FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
## SUCH DAMAGE.
## 
## The licence and distribution terms for any publically available version or
## derivative of this code cannot be changed.  i.e. this code cannot simply be
## copied and put under another distribution licence
## [including the GNU Public Licence.]
##

## moduleerrorcode is 72
##
## functions:
##
## new		11
## init		12
## getParsed	21
## getHeader	31
## getSignature	32
## getKey	33
## getBody	34
## getRawHeader	35
## parseReq	13
## getTXT	41
## getPEM	42
## getDER	43
## getItem	51
## getSerial	52
## setParams    61

use strict;
use Digest::MD5;
use X500::DN;

package OpenCA::REQ;

our ($errno, $errval);

($OpenCA::REQ::VERSION = '$Revision: 1.6 $' )=~ s/(?:^.*: (\d+))|(?:\s+\$$)/defined $1?"0\.9":""/eg;

my %params = (
	req            => undef,
	item           => undef,
	pemREQ         => undef,
	derREQ         => undef,
	txtREQ         => undef,
	spkacREQ       => undef,
	revokeREQ      => undef,
	parsedSPKAC    => undef,
	parsedCRR      => undef,
	parsedItem     => undef,
	backend        => undef,
	beginHeader    => undef,
	endHeader      => undef,
	beginSignature => undef,
	endSignature   => undef,
	beginKey       => undef,
	endKey         => undef,
	beginAttribute => undef,
	endAttribute   => undef,
	reqFormat      => undef,
);

sub setError {
	my $self = shift;

	if (scalar (@_) == 4) {
		my $keys = { @_ };
		$errval = $keys->{ERRVAL};
		$errno  = $keys->{ERRNO};
	} else {
		$errno  = $_[0];
		$errval = $_[1];
	}

	## support for: return $self->setError (1234, "Something fails.") if (not $xyz);
	return undef;
}

sub new {
	my $that = shift;
	my $class = ref($that) || $that;

	my $self = {
		%params,
	};

        bless $self, $class;

	$self->{beginHeader} 	= "-----BEGIN HEADER-----";
	$self->{endHeader} 	= "-----END HEADER-----";
	$self->{beginSignature} = "-----BEGIN PKCS7-----";
	$self->{endSignature} 	= "-----END PKCS7-----";
	$self->{beginKey}	= "-----BEGIN .*PRIVATE KEY-----";
	$self->{endKey} 	= "-----END .*PRIVATE KEY-----";
	$self->{beginAttribute}	= "-----BEGIN ATTRIBUTE-----";
	$self->{endAttribute}	= "-----END ATTRIBUTE-----";
	$self->{reqFormat}      = "";

        my $keys = { @_ };
        my ( $infile, $keyfile, $tmp );

        $self->{req}       = $keys->{DATA};
        $self->{reqFormat} = ( $keys->{FORMAT} or $keys->{INFORM} );

        $self->{backend}    = $keys->{SHELL};
        $self->{gettext}    = $keys->{GETTEXT};
        $infile     = $keys->{INFILE};
	$keyfile    = $keys->{KEYFILE};
	
	return $self->setError (7211010, "OpenCA::REQ->new: The translation function is not specified.")
            if (not $self->{gettext});
	return $self->setError (7211011,
            $self->{gettext} ("OpenCA::REQ->new: The backend is not specified."))
            if (not $self->{backend});

	if( $keyfile ) {
		if ( not defined $self->{reqFormat} or not $self->{reqFormat} ) {
			$self->{reqFormat} = "PEM";
		}
		$self->{req} = $self->{backend}->genReq( 
				  KEYFILE=>$keys->{KEYFILE},
				  DN=>$keys->{DN},
				  SUBJECT=>$keys->{SUBJECT},
				  OUTFORM=>$self->{reqFormat},
				  PASSWD=>$keys->{PASSWD} );

		return $self->setError (7211021,
			   $self->{gettext} ("OpenCA::REQ->new: Cannot create new request. Backend fails with errorcode __ERRNO__. __ERRVAL__",
                                             "__ERRNO__", $OpenCA::OpenSSL::errno,
			                     "__ERRVAL__", $OpenCA::OpenSSL::errval))
			if ( not $self->{req} );
	}

	if( $infile ) {
                $self->{req} = "";

                open(FD, "<$infile" ) or
			return $self->setError (7211031,
			           $self->{gettext} ("OpenCA::REQ->new: Cannot open infile __FILENAME__ for reading.",
                                                     "__FILENAME__", $infile));
                while ( $tmp = <FD> ) {
                        $self->{req} .= $tmp;
                }
                close(FD);

		return $self->setError (7211033,
                           $self->{gettext} ("Cannot read request from infile __FILENAME__.",
                                             "__FILENAME__", $infile))
			if( not $self->{req});
        }

	if( not (defined($self->{reqFormat})) or ($self->{reqFormat} eq "")) {
		if( ( $self->{req} ) and ( $self->{req} =~ /SPKAC\s*=\s*/g ) ){
			$self->{reqFormat} = "SPKAC";
		} elsif (($self->{req}) and ($self->{req} =~ 
					/REVOKE_CERTIFICATE_SERIAL\s*=\s*/g)){
                	$self->{reqFormat} = "CRR";
		} else {
                	$self->{reqFormat} = "PEM";
		}
        }

        if ( $self->{req} ne "" ) {
		$self->{item} = $self->{req};

                if ( not $self->init( REQ=>$self->{req},
                                          FORMAT=>$self->{reqFormat})) {
			return $self->setError (7211041,
			           $self->{gettext} ("OpenCA::REQ->new: Cannot initialize request (__ERRNO__). __ERRVAL__",
                                                     "__ERRNO__", $errno,
                                                     "__ERRVAL__", $errval));
                }

        }

        return $self;
}

sub init {
        my $self = shift;
        my $keys = { @_ };

        $self->{reqFormat} 	= $keys->{FORMAT};
	$self->{req}		= $self->getBody( REQUEST=> $keys->{REQ});

	if (not $self->{req}) {
       		$self->{parsedItem} = $self->parseReq( REQ=>$keys->{REQ},
						FORMAT=>$self->{reqFormat} );
		return $self->setError (7212011,
                           $self->{gettext} ("OpenCA::REQ->init: Cannot parse request (__ERRNO__). __ERRVAL__",
                                             "__ERRNO__", $errno,
                                             "__ERRVAL__", $errval))
			if (not $self->{parsedItem});
	} elsif( $self->{reqFormat} !~ /SPKAC|CRR/i ) {
		$self->{pemREQ} = "";
		$self->{derREQ} = "";
		$self->{txtREQ} = "";

		$self->{parsedItem} = $self->parseReq( REQ=>$keys->{REQ},
						FORMAT=>$self->{reqFormat} );
		return $self->setError (7212024,
                           $self->{gettext} ("OpenCA::REQ->init: Cannot parse request (__ERRNO__). __ERRVAL__",
                                             "__ERRNO__", $errno,
                                             "__ERRVAL__", $errval))
			if (not $self->{parsedItem});
	} else {

		if ( $self->{reqFormat} =~ /SPKAC/ ) {
			$self->{spkacREQ} = $self->{req};
        		$self->{parsedSPKAC}=$self->parseReq( REQ=>$keys->{REQ},
							FORMAT=>"SPKAC" );
			$self->{parsedItem} = $self->{parsedSPKAC};

			return $self->setError (7212026,
                           $self->{gettext} ("OpenCA::REQ->init: Cannot parse request (__ERRNO__). __ERRVAL__",
                                             "__ERRNO__", $errno,
                                             "__ERRVAL__", $errval))
				if( not $self->{parsedSPKAC} );

		} elsif ( $self->{reqFormat} =~ /CRR/ ) {
			$self->{revokeREQ} = $self->{req};
        		$self->{parsedCRR}=
				$self->parseReq( REQ=>$keys->{REQ},
					FORMAT=>"CRR" );
			$self->{parsedItem} = $self->{parsedCRR};

			return $self->setError (7212031,
                           $self->{gettext} ("OpenCA::REQ->init: Cannot parse request (__ERRNO__). __ERRVAL__",
                                             "__ERRNO__", $errno,
                                             "__ERRVAL__", $errval))
				if( not $self->{parsedCRR} );
		} else {
			return $self->setError (7212041,
                                   $self->{gettext} ("OpenCA::REQ->init: Unknown request's format."));
		}
	}

        return 1;
}

sub getParsed {
        my $self = shift;

	if( $self->{reqFormat} =~ /SPKAC/i ) {
		return $self->setError (7221011,
                           $self->{gettext} ("OpenCA::REQ->getParsed: SPKAC-request was not parsed."))
			if( not $self->{parsedSPKAC} );
		return $self->{parsedSPKAC};
	} elsif( $self->{reqFormat} =~ /CRR/i ) {
		return $self->setError (7221013,
                           $self->{gettext} ("OpenCA::REQ->getParsed: CRR was not parsed."))
			if( not $self->{parsedCRR} );
		return $self->{parsedCRR};
	} else {
        	return $self->setError (7221014,
                           $self->{gettext} ("OpenCA::REQ->getParsed: Request was not parsed."))
			if ( not $self->{parsedItem} );
        	return $self->{parsedItem};
	}
}

sub getHeader {
	my $self = shift;
	my $keys = { @_ };
	my $req = $keys->{REQUEST};

	my ( $txt, $ret, $i, $key, $val );

	my $beginHeader = $self->{beginHeader};
	my $endHeader = $self->{endHeader};
	my $beginAttribute = $self->{beginAttribute};
	my $endAttribute = $self->{endAttribute};

	if( ($txt) = ( $req =~ /$beginHeader\s*\n([\s\S\n]+)\n$endHeader/) ) {
                my $active_multirow = undef;

		$active_multirow = 0;
		$key = "";
		foreach $i ( split ( /\s*\n/, $txt ) ) {
                        if ($active_multirow) {
                          ## multirow
                          if ($i =~ /^$endAttribute$/) {
                            ## end of multirow
                            $active_multirow = 0;
                          } else {
                            $ret->{$key} .= "\n" if ($ret->{$key});
                            ## additional data
                            $ret->{$key} .= $i;
                          }
                        } elsif ($i =~ /^$beginAttribute$/) {
                          ## begin of multirow
                          $active_multirow = 1;
                        } else {
                          ## no multirow 
                          ## if multirow then $ret->{key} is initially empty)
			  ## fix CR
			  $i =~ s/\s*\r$//;
			  $i =~ s/\s*=\s*/=/;
			  ( $key, $val ) = ( $i =~ /^([^=]*)\s*=\s*(.*)\s*/ );
			  $ret->{$key} = $val;
			  ## fix old requests
			  if ($key eq "SUBJ") {
				$ret->{SUBJECT} = $val;
			  }
                        }

		}
	}

	# foreach $i ( keys %$ret ) {
	# 	print STDERR "REQ::getHeader()->$i => " . $ret->{$i} . "\n";
	# }

	return $ret;
}

sub getRawHeader {
	my $self = shift;
	my $keys = { @_ };
	my $req = $keys->{REQUEST};

	my $beginHeader	= $self->{beginHeader};
	my $endHeader 	= $self->{endHeader};

	my ( $ret ) = ( $req =~ /($beginHeader[\S\s\n]+$endHeader)/ );
	return $ret;
}

sub getSignature {
	my $self = shift;
	my $keys = { @_ };
	my $req = $keys->{REQUEST};
	return $self->getParsed()->{SIGNATURE} if (not $req);

	my $beginSig 	= $self->{beginSignature};
	my $endSig 	= $self->{endSignature};

	my ( $ret ) = ( $req =~ /($beginSig[\S\s\n]+$endSig)/ );
	return $ret;
}

sub getKey {
	my $self = shift;
	my $keys = { @_ };
	my $req = $keys->{REQUEST};

	my $beginKey 	= $self->{beginKey};
	my $endKey 	= $self->{endKey};

	if ( not $req ) {
		$req = $self->{item};
	}

	my ( $ret ) = ( $req =~ /($beginKey[\S\s\n]+$endKey)/ );
	return $ret;
}

sub getBody {
	my $self = shift;
	my $keys = { @_ };

	my $ret = $keys->{REQUEST};
	return $self->{req} if (not $ret);

	my $beginHeader 	= $self->{beginHeader};
	my $endHeader 		= $self->{endHeader};

	my $beginSig 		= $self->{beginSignature};
	my $endSig 		= $self->{endSignature};

	my $beginKey 		= $self->{beginKey};
	my $endKey 		= $self->{endKey};

	## Let us throw away text between the two headers, included
	$ret =~ s/($beginHeader[\S\s\n]+$endHeader\n*)//;

	## Let us throw away text between the two headers, included
	$ret =~ s/($beginSig[\S\s\n]+$endSig)//;

	## Let us throw away text between the two headers, included
	$ret =~ s/($beginKey[\S\s\n]+$endKey)//;

	## Let us throw away leading and trailing nonse
	## this is important for signature handling
	$ret =~ s/^[\r\n]*//s;
	$ret =~ s/[\r\n]*$//s;

	return $ret;
}

sub parseReq {
	my $self = shift;
	my $keys = { @_ };

	my $fullReq = $keys->{REQ};
	my $format  = $keys->{FORMAT};

	my @dnList = ();
	my @exts = ();

	my ( $ret, $tmp, $key, $val, $tmpOU, $ra, $textReq );

	return $self->setError (7213011,
                   $self->{gettext} ("There is no complete request available."))
		if (not $fullReq);

	## timing test
	
	#my $start;
	#use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
	#$start = [gettimeofday];
	#$self->{DEBUG_SPEED} = 1;

	$ret->{SIGNATURE}         = $self->getSignature ( REQUEST=>$fullReq );
	$ret->{PRIVKEY}           = $self->getKey       ( REQUEST=>$fullReq );
	$ret->{HEADER}            = $self->getHeader    ( REQUEST=>$fullReq );
	$ret->{RAWHEADER}         = $self->getRawHeader ( REQUEST=>$fullReq );
	$ret->{BODY}              = $self->getBody      ( REQUEST=>$fullReq );
	$ret->{ITEM}              = $self->{item};

	#print "OpenCA::REQ->parseReq: split_time_1=".tv_interval($start)."<br>\n"
	#	if ($self->{DEBUG_SPEED});

	if (not $ret->{BODY}) {
		## this must be a request with TYPE == HEADER
		print $self->{gettext} ("OpenCA::REQ->parseReq: This is a HEADER only.")."<br>\n"
                    if ($self->{DEBUG});

		if ( not $ret->{HEADER} ) {
			return $self->setError (7213015,
				   $self->{gettext} ("OpenCA::REQ->init: The request has no body."));
		}
		if ( not $ret->{HEADER}->{TYPE} =~ /HEADER/i ) {
			return $self->setError (7213016,
				   $self->{gettext} ("OpenCA::REQ->init: The request has no body and has not the type HEADER."));
		}

		$ret->{TYPE}  = "HEADER";
		$ret->{DN} = $ret->{HEADER}->{SUBJECT};
	} else {

		$textReq = $ret->{BODY};

		print "OpenCA::REQ->parseReq: FORMAT: $format<br>\n" if ($self->{DEBUG});

		## if ( $format !~ /CRR/ ) {
		if ( uc $format ne "CRR" ) {
			## Get Attributes from openssl directly
			my @attrlist;
			if ( $format =~ /SPKAC/i ) {
				@attrlist = ( "PUBKEY", "KEYSIZE", "PUBKEY_ALGORITHM", "EXPONENT", "MODULUS",
				              "SIGNATURE_ALGORITHM" );
			} else {
				@attrlist = ( "DN", "VERSION", "SIGNATURE_ALGORITHM",
				              "PUBKEY", "KEYSIZE", "PUBKEY_ALGORITHM", "EXPONENT", "MODULUS", "EXTENSIONS" );
			}
			#print "OpenCA::REQ->parseReq: split_time_1_4=".tv_interval($start)."<br>\n"
			#	if ($self->{DEBUG_SPEED});
			my $attrs = $self->{backend}->getReqAttribute( DATA=>$ret->{BODY}. "\n",
						 ATTRIBUTE_LIST=>\@attrlist, INFORM=>$format );
			#print "OpenCA::REQ->parseReq: split_time_1_5=".tv_interval($start)."<br>\n"
			#	if ($self->{DEBUG_SPEED});

			$ret->{PLAIN_EXTENSIONS} = $attrs->{EXTENSIONS};
			$ret->{OPENSSL_EXTENSIONS} = {};
			delete $attrs->{EXTENSIONS};

			# parse extensions
			my @lines = split(/\n/, $ret->{PLAIN_EXTENSIONS});
			my $i = 0;
			while($i < scalar(@lines)) {
			    if($lines[$i] =~ /^\s*([^:]+):\s*(?:critical|)\s*$/i) {
				my ($val, $key);
				$key = $1;
				$ret->{OPENSSL_EXTENSIONS}->{$key} = [];
				$i++;
				while(exists $lines[$i] and $lines[$i] !~ /^\s*[^:]+:\s*(?:critical|)\s*$/ && $i < scalar(@lines)) {
				    $val = $lines[$i];
				    $val =~ s/^\s+//;
				    $val =~ s/\s+$//;
				    $i++;
				    next if $val =~ /^$/;
				    push(@{$ret->{OPENSSL_EXTENSIONS}->{$key}}, $val);
				}
			    } else {
				## FIXME: can this ever happen?
				$i++;
			    }
			}
			
			if ($self->{DEBUG}) {
			    print "OpenCA::REQ->parseReq: show all extensions and their values<br>\n";
			    while(my ($key, $val) = each(%{$ret->{OPENSSL_EXTENSIONS}})) {
				print "OpenCA::REQ->parseReq: found extension: $key<br>\n";
				print "OpenCA::REQ->parseReq: with value(s):       $_<br>\n" foreach(@{$val});
			    }
			}


			foreach (keys %$attrs ) {
				$ret->{$_} = $attrs->{$_};
				if ($self->{DEBUG}) {
					print "OpenCA::REQ->parseReq: ATTRIBUTE: ".$_."<br>\n";
					print "OpenCA::REQ->parseReq: VALUE: ".$ret->{$_}."<br>\n";
				}
			}
		}

		if( exists $ret->{PUBKEY} ) {
			my $md5 = new Digest::MD5;
			$md5->add( $ret->{PUBKEY} );
			$ret->{KEY_DIGEST} = $md5->hexdigest();
		}

		if ( $format =~ /SPKAC/i ) {
			## Specific for SPKAC requests...
			my ( @reqLines );

			@reqLines = split( /\n/ , $textReq );
			for $tmp (@reqLines) {

				$tmp =~ s/\r$//;

				my ($key,$val)=($tmp =~ /([\w]+)\s*=\s*(.*)\s*/ );
				## this is a bug at minimum for emailAddress
				## $key = uc( $key );

				if ($key ne "") {
					if ($key =~ /SPKAC/i) {
						$ret->{SPKAC} = $val;
					} else {
						$ret->{DN} .= ", " if ($ret->{DN});
						$ret->{DN} .= $key."=".$val;
					}
				}

			}

			## Now retrieve the SPKAC crypto infos...
			$textReq=$self->{backend}->SPKAC( SPKAC=>$textReq);

			$ret->{VERSION} 	= 1;
			$ret->{TYPE}  = 'SPKAC';
		} elsif( $format =~ /CRR/i ) {
			## Specific for CRRs...
			my ( @reqLines );

			@reqLines = split( /\n/ , $textReq );
			for $tmp (@reqLines) {

				$tmp =~ s/\r$//;

				($key,$val)=($tmp =~ /([\w]+)\s*=\s*(.*)\s*/ );
				$key = uc( $key );

				$ret->{$key} = $val;
			}

			$ret->{VERSION} = 1 if ( not exists $ret->{VERSION});

			$ret->{TYPE}  		= 'CRR';
			$ret->{HEADER}->{TYPE} 	= $ret->{TYPE};

			$ret->{REVOKE_CERTIFICATE_DN} =~ s/^\///;
			$ret->{REVOKE_CERTIFICATE_DN} =~ s/\/([A-Za-z0-9\-]+)=/, $1=/g;

			## allow automatic parsing
			$ret->{DN} = $ret->{REVOKE_CERTIFICATE_DN};

			$ret->{REASON} = $ret->{REVOKE_REASON};
			$ret->{REVOKE_REASON} = $ret->{REVOKE_REASON};
		} else {
			$ret->{DN} =~ s/\,\s*$//;
			if( exists $ret->{HEADER}->{TYPE} ) {
				$ret->{TYPE} = $ret->{HEADER}->{TYPE};
			} else {
				$ret->{TYPE}  		= 'PKCS#10';
			}
		}
	}

	#print "OpenCA::REQ->parseReq: split_time_2=".tv_interval($start)."<br>\n"
	#	if ($self->{DEBUG_SPEED});

	## load the differnt parts of the DN into DN_HASH
	my $fixed_dn;
	my $rdn;
	if ($ret->{HEADER}->{SUBJECT}) {
		print "OpenCA::REQ->parseReq: SUBJECT: ".$ret->{HEADER}->{SUBJECT}."<br>\n" if ($self->{DEBUG});
		$fixed_dn = $ret->{HEADER}->{SUBJECT};
	} else {
		print "OpenCA::REQ->parseReq: DN: ".$ret->{DN}."<br>\n" if ($self->{DEBUG});
		$fixed_dn = $ret->{DN};
	}

	## OpenSSL includes a bug in -nameopt RFC2253
	## = signs are not escaped if they are normal values
	my $i = 0;
	my $now = "name";
	while ($i < length ($fixed_dn))
	{
		if (substr ($fixed_dn, $i, 1) eq '\\')
		{
			$i++;
		} elsif (substr ($fixed_dn, $i, 1) eq '=') {
			if ($now =~ /value/)
			{
				## OpenSSL forgets to escape =
				$fixed_dn = substr ($fixed_dn, 0, $i)."\\".substr ($fixed_dn, $i);
				$i++;
			} else {
				$now = "value";
			}
		} elsif (substr ($fixed_dn, $i, 1) =~ /[,+]/) {
			$now = "name";
		}
		$i++;
	}

	#print "OpenCA::REQ->parseReq: split_time_3=".tv_interval($start)."<br>\n"
	#	if ($self->{DEBUG_SPEED});

	if ($fixed_dn =~ /[\\+]/) {
		$fixed_dn =~ s/\w+=\s*\,//g;
                $fixed_dn =~ s/\w+=\s*$//;
		my $x500_dn = X500::DN->ParseRFC2253 ($fixed_dn);
		foreach $rdn ($x500_dn->getRDNs()) {
			next if ($rdn->isMultivalued());
			my @attr_types = $rdn->getAttributeTypes();
			my $type  = $attr_types[0];
			my $value = $rdn->getAttributeValue ($type);
			push (@{$ret->{DN_HASH}->{uc($type)}}, $value);
			print "OpenCA::REQ->parseReq: DN_HASH: $type=$value<br>\n" if ($self->{DEBUG});
		}
	} else {
		my @rdns = split /,/, $fixed_dn;
		foreach $rdn (@rdns) {
			my ($type, $value) = split /=/, $rdn;
			$type =~ s/^\s*//;
			$type =~ s/\s*$//;
			$value =~ s/^\s*//;
			$value =~ s/\s*$//;
			push (@{$ret->{DN_HASH}->{uc($type)}}, $value);
			print "OpenCA::REQ->parseReq: DN_HASH: $type=$value<br>\n" if ($self->{DEBUG});
		}
	}

	#print "OpenCA::REQ->parseReq: split_time_4=".tv_interval($start)."<br>\n"
	#	if ($self->{DEBUG_SPEED});

	## show DN to check conformance to RFC 2253
	if ($self->{DEBUG}) {
		print "OpenCA::REQ->parseReq: TYPE: ".$ret->{TYPE}."<br>\n";
		print "OpenCA::REQ->parseReq: DN: ".$ret->{DN}."<br>\n";
	}

	## set emailaddress

	$ret->{EMAILADDRESSES} = [ $self->get_emails ($ret) ];
	$ret->{EMAILADDRESS} = $ret->{EMAILADDRESSES}->[0];

	if ($self->{DEBUG}) {
		print "OpenCA::REQ->parseReq: SUBJECT_ALT_NAME: ".$ret->{HEADER}->{SUBJECT_ALT_NAME}."<br>\n";
		print "OpenCA::REQ->parseReq: EMAILADDRESS: ".$ret->{EMAILADDRESS}."<br>\n";
	}

	if (exists $ret->{HEADER}->{TYPE} and $ret->{HEADER}->{TYPE} !~ /HEADER/) {
		## Common Request Parsing ...
		$ret->{PK_ALGORITHM}  = $ret->{PUBKEY_ALGORITHM};
		$ret->{SIG_ALGORITHM} = $ret->{SIGNATURE_ALGORITHM};
		$ret->{TYPE} .= " with PKCS#7 Signature" if ( $ret->{SIGNATURE} );
	}

	## timing test

	#if ($self->{DEBUG_SPEED})
	#{
	#	print "OpenCA::REQ->parseReq: split_time_last=".tv_interval($start)."<br>\n";
	#	$errno += tv_interval ( $start );
	#	print "OpenCA::REQ->parseReq: total_time=".$errno."<br>\n";
	#}

	return $ret;
}

sub getTXT {
	my $self = shift;
	my $ret;

	if( $self->{reqFormat} =~ /SPKAC/i ) {
		return $self->setError (7241011,
                           $self->{gettext} ("OpenCA::REQ->getTXT: The request should be in SPKAC-format but there is no SPKAC-request."))
			if( not $self->{spkacREQ} );

		$ret =  $self->{req} . 
			$self->{backend}->SPKAC( SPKAC => $self->{spkacREQ} );
		return $ret;
	} elsif( $self->{reqFormat} =~ /CRR/i ) {
		return	$self->setError (7241013,
                            $self->{gettext} ("OpenCA::REQ->getTXT: The request should be a CRR but there is no such request."))
			if( not $self->{revokeREQ} );

		$ret =  $self->{req};
		return $ret;
	} else {
		if (not $self->{txtREQ}) {
			$self->{txtREQ} = $self->{backend}->dataConvert(
			         DATA=>$self->{req},
			         DATATYPE=>"REQUEST",
			         INFORM=>$self->{reqFormat},
			         OUTFORM=>"TXT" );
			return $self->setError (7241021,
                                   $self->{gettext} ("OpenCA::REQ->init: Cannot convert request to TXT-format (__ERRNO__). __ERRVAL__",
                                                     "__ERRNO__", $OpenCA::OpenSSL::errno,
                                                     "__ERRVAL__", $OpenCA::OpenSSL::errval))
				if (not $self->{txtREQ});
		}

		return $self->setError (7241015,
                           $self->{gettext} ("OpenCA::REQ->getTXT: The request should be a TXT-request but there is no TXT-request."))
			if ( not $self->{txtREQ} );
		return $self->{txtREQ};
	}
}

sub getPEM {
	my $self = shift;
	my $ret;

	return $self->setError (7242011,
                   $self->{gettext} ("OpenCA::REQ->getPEM: The request is in SPKAC-format and not in PEM-format."))
		if( $self->{reqFormat} =~ /SPKAC/i );
	return $self->setError (7242013,
                   $self->{gettext} ("OpenCA::REQ->getPEM: The request is a CRR."))
		if( $self->{reqFormat} =~ /CRR/i );

	if ( $self->{reqFormat} eq 'PEM' ) {
		$self->{req} .= "\n" if ($self->{req} !~ /\n$/);
		return $self->{req};
	}
	if (not $self->{pemREQ}) {
    	$self->{pemREQ} = $self->{backend}->dataConvert( 
		       DATA=>$self->{req},
		       DATATYPE=>"REQUEST",
		       INFORM=>$self->{reqFormat},
		       OUTFORM=>"PEM" );
		return $self->setError (7242021,
                           $self->{gettext} ("OpenCA::REQ->getPEM: Cannot convert request to PEM-format (__ERRNO__). __ERRVAL__",
                                             "__ERRNO__", $OpenCA::OpenSSL::errno,
                                             "__ERRVAL__", $OpenCA::OpenSSL::errval))
			if (not $self->{pemREQ});
	}

	return $self->setError (7242015,
                   $self->{gettext} ("OpenCA::REQ->getPEM: The request is not available in PEM-format."))
		if ( not $self->{pemREQ} );

	return $self->{pemREQ};
}

sub getDER {
	my $self = shift;
	my $ret;

	return $self->setError (7243011,
                   $self->{gettext} ("OpenCA::REQ->getDER: The request is in SPKAC-format and not in DER-format."))
		if( $self->{reqFormat} =~ /SPKAC/i );
	return $self->setError (7243013,
                   $self->{gettext} ("OpenCA::REQ->getDER: The request is a CRR."))
		if( $self->{reqFormat} =~ /CRR/i );

	if ( $self->{reqFormat} eq 'DER' ) {
		return $self->{req};
	}
	if (not $self->{derREQ}) {
		$self->{derREQ} = $self->{backend}->dataConvert( 
		       DATA=>$self->{req},
		       DATATYPE=>"REQUEST",
		       INFORM=>$self->{reqFormat},
		       OUTFORM=>"DER" );
		return $self->setError (7243021,
                           $self->{gettext} ("OpenCA::REQ->getDER: Cannot convert request to DER-format (__ERRNO__). __ERRVAL__",
                                             "__ERRNO__", $OpenCA::OpenSSL::errno,
                                             "__ERRVAL__", $OpenCA::OpenSSL::errval))
			if (not $self->{derREQ});
	}

	return $self->setError (7243015,
                   $self->{gettext} ("OpenCA::REQ->getDER: The request is not available in DER-format."))
		if ( not $self->{derREQ} );

	return $self->{derREQ};
}

sub getItem {
	my $self = shift;

	return $self->getParsed()->{ITEM};
}

sub getSerial {
	my $self = shift;

	my $ret = $self->getParsed()->{HEADER}->{SERIAL};
        if (not defined $ret) {
		## old requests
		$ret = $self->getParsed()->{SERIAL};
	}

	return $ret;
}

sub setParams {

	my $self = shift;
	my $params = { @_ };
	my $key;

	foreach $key ( keys %{$params} ) {
		## we should place the parameters here
	}

	return 1;
}

## by michael bell to support signature in the header
## 1) works actually only with PEM because automatical
## transformation to DER etc. is a high risc
## for a failure
## 2) please submit only one attribute
sub setHeaderAttribute {

  my $self = shift;
  my $keys = { @_ };

  my $beginHeader = $self->{beginHeader};
  my $endHeader = $self->{endHeader};
  my $beginAttribute = $self->{beginAttribute};
  my $endAttribute = $self->{endAttribute};

  ## check format to be PEM
  return $self->setError (7251011,
             $self->{gettext} ("OpenCA::REQ->setHeaderAttribute: The request is not in PEM-format."))
	if ($self->{reqFormat} !~ /^PEM|CRR|SPKAC$/i);
  print $self->{gettext} ("REQ->setHeaderAttribute: correct format - PEM")."<br>\n" if ($self->{DEBUG});

  ## check for header
  if ($self->{item} !~ /$beginHeader/) {
    ## create header
    $self->{item} = $beginHeader."\n".$endHeader."\n".$self->{item};
  }

  for my $attribute (keys %{$keys}) {

    # print STDERR "REQ->setHeaderAttribute: $attribute:=".
    # 					$keys->{$attribute}."<br>\n";

	next if ( not $attribute );

    ## insert into item
    ## find last position in header
    ## enter attributename
    ## check fo multirow
    if ($keys->{$attribute} =~ /\n/) {
      ## multirow
      $self->{item} =~ s/${endHeader}/${attribute}=\n${beginAttribute}\n$keys->{$attribute}\n${endAttribute}\n${endHeader}/;
    } else {
	# print STDERR "REQ::setHeaderAttribute::Setting $attribute = " .
	# 		$keys->{$attribute} . "\n" if ( $self->{DEBUG} );

      	## Delete old attribute
	if ( $self->getParsed()->{HEADER}->{$attribute} ) {
      		$self->{item} =~ s/($attribute[^\n]+\n)//;
	}

      ## single row
      $self->{item} =~ s/${endHeader}/${attribute} = $keys->{$attribute}\n${endHeader}/;
      # print STDERR "REQ::NEW HEADER\n".$self->{item}."\n";
    }

  }

  ## if you call init then all information is lost !!!
  return $self->setError (7251021,
             $self->{gettext} ("OpenCA::REQ->setHeaderAttribute: Cannot re-initialize the request (__ERRNO__). __ERRVAL__",
                               "__ERRNO__", $errno,
                               "__ERRVAL__", $errval))
  	if (not $self->init ( REQ => $self->{item},
                    FORMAT      => $self->{reqFormat}));

  return 1;
}

sub getStatus {
    my $self = shift;
    return $self->{STATUS};
}

sub setStatus {
	my $self = shift;
	my $status = shift;

	my $status_update = undef;
	my $now = gmtime;

	## Handles special fields like SUSPENDED_AFTER, REVOKED_AFTER, etc.
	$status =~ s/\_.*//;
	if (($self->{STATUS} ne $status) and ($status !~ /NEW|PENDING/)) {
		$status_update = $status . "_AFTER";
		if( $self->getParsed()->{HEADER}->{$status_update} eq "" ) {
			$self->setHeaderAttribute ( $status_update => $now );
		}
		# $self->{$status_update} = $now;
	}

	if ( $self->{reqFormat} =~ /CRR/ ) {
		$self->{DATATYPE} = $status . "_CRR";
	} else {
		$self->{DATATYPE} = $status . "_REQUEST";
	}
	$self->{STATUS} = $status;

	return $self->getStatus();
}

sub get_emails {
    my $self = shift;
    my $parsed = $self->getParsed();
    $parsed = shift if ($_[0]);

    my @emails = ();

    ## extract emails from subject alt name

    if ( $parsed->{HEADER}->{SUBJECT_ALT_NAME} ) {
        my @subjectAltNames = split (/,\s*/, $parsed->{HEADER}->{SUBJECT_ALT_NAME});
        foreach my $h (@subjectAltNames) {
            next if ($h !~ /^\s*email(|\.[0-9]+)[:=]/is);
            $h =~ s/^\s*email(|\.[0-9]+)[:=]//i;
            push (@emails, $h);
        }
    }

    ## extract emails from subject

    if (exists $parsed->{DN_HASH}->{EMAILADDRESS})
    {
        foreach my $mail (@{$parsed->{DN_HASH}->{EMAILADDRESS}})
        {
            push @emails, $mail;
        }
    }

    return @emails;
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

OpenCA::REQ - Perl extension to easily manage Cert REQUESTs

=head1 SYNOPSIS

  use OpenCA::REQ;

=head1 DESCRIPTION

Sorry, no help available. The REQ module is capable of importing
request like this:

	-----BEGIN HEADER-----
	VAR = NAME
	VAR = NAME
	...
	-----END HEADER-----
	(real request text here)
	-----BEGIN PKCS7-----
	(pkcs#7 signature here
	-----END PKCS7-----

The Real request text can be a request in every form ( DER|PEM ) or
textual (called SPKAC|CRR datatype). The syntax of the latters
is VAR = NAME on each line (just like the HEADER section).

=head1 AUTHOR

Massimiliano Pala <madwolf@openca.org>

=head1 SEE ALSO

OpenCA::OpenSSL, OpenCA::X509, OpenCA::CRL, OpenCA::Configuration,
OpenCA::TRIStateCGI, OpenCA::Tools

=cut
