view release on metacpan or  search on metacpan

lib/WSRF/Lite.pm  view on Meta::CPAN

=item $WSRF::Constants::WSSG 

WS-ServiceGroup namespace.

=item $WSRF::Constants::WSBF 

WS-BaseFaults namespace.  

=item $WSRF::Constants::WSU 

WS-Security untility namespace.

=item $WSRF::Constants::WSSE 

WS-Security extension namespace.

=item $WSRF::Constants::WSA_ANON 

From the WS-Addressing specification, it is used to indicate
an anonymous return address. If you are using a request-response protocol like HTTP
which uses the same connection for the request and response you use this as the 
ReplyTo address in SOAP WS-Addressing header of the request.  

=back

=cut

#
# Where the named Sockets and ResourceProperty files are stored.
# User can overide these in the Container script.
$WSRF::Constants::SOCKETS_DIRECTORY = "/tmp/wsrf";
$WSRF::Constants::Data         = $WSRF::Constants::SOCKETS_DIRECTORY . "/data/";
$WSRF::Constants::ExternSocket = undef;
%WSRF::Constants::ModuleNamespaceMap = ();

#The set of namespaces used throughout.
#$WSRF::Constants::WSA  = 'http://www.w3.org/2005/03/addressing';
$WSRF::Constants::WSA = 'http://www.w3.org/2005/08/addressing';

#$WSRF::Constants::WSRL = 'http://www.ibm.com/xmlns/stdwip/web-services/WS-ResourceLifetime';
$WSRF::Constants::WSRL = 'http://docs.oasis-open.org/wsrf/rl-2';

#$WSRF::Constants::WSRP = 'http://www.ibm.com/xmlns/stdwip/web-services/WS-ResourceProperties';
$WSRF::Constants::WSRP = 'http://docs.oasis-open.org/wsrf/rp-2';

#$WSRF::Constants::WSSG = 'http://www.ibm.com/xmlns/stdwip/web-services/WS-ServiceGroup';
$WSRF::Constants::WSSG = 'http://docs.oasis-open.org/wsrf/sg-2';

#$WSRF::Constants::WSBF = 'http://www.ibm.com/xmlns/stdwip/web-services/WS-BaseFaults';
$WSRF::Constants::WSBF = 'http://docs.oasis-open.org/wsrf/bf-2';

$WSRF::Constants::WSU =
'http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd';
$WSRF::Constants::WSSE =
'http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd';

#$WSRF::Constants::WSA_ANON = $WSRF::Constants::WSA.'/role/anonymous';
$WSRF::Constants::WSA_ANON = $WSRF::Constants::WSA . '/anonymous';

$WSRF::Constants::DS = 'http://www.w3.org/2000/09/xmldsig#';

#===============================================================================
# We override SOAP::SOM to store the raw XML from a SOAP message - this class is
# used by the WSRF::Deserializer below. SOAP::Lite does not provide you with
# access to the raw XML of a SOAP message (It was on the SOAP::Lite TODO list)
# - here we override the SOAP::SOM module to provide access to the raw XML -
# we override the SOAP::Deserializer which returns the SOAP::SOM object to
# make sure that it actually keeps the XML

package WSRF::SOM;

=pod

=head1 WSRF::SOM

Extends SOAP::SOM with one extra method "raw_xml".

=head2 METHODS

=over

=item raw_xml

Returns the raw XML of a message, useful if you want to parse the message using some
other tool than provided with SOAP::Lite: 

  my $xml = $som->raw_xml;

=back

=cut

use strict;
use vars qw(@ISA);

@ISA = qw(SOAP::SOM);

# function to return raw XML
sub raw_xml {
	my $self = shift;
	return $self->{_xml};
}

#===============================================================================
# We override the SOAP::Serializer to store the raw XML of the SOAP message.
# Normally a SOAP::Lite service cannot access the raw XML of a request - this
# is sometimes useful for the Service developer who might want to use
# XML DOM instead of SOM. The Deserializer returns a WSRF::SOM object - wich
# we have defined above.
package WSRF::Deserializer;

=pod

=head1 WSRF::Deserializer

Overrides SOAP::Deserializer to return a WSRF::SOM object, which includes the raw XML 
of the message, from the deserialize method.

=head2 METHODS

lib/WSRF/Lite.pm  view on Meta::CPAN

		}
	}

	eval { require Crypt::OpenSSL::RSA };
	die "Failed to access class Crypt::OpenSSL::RSA: $@" if $@;

	my $key_file_name =
	  $ENV{HTTPS_KEY_FILE} ? $ENV{HTTPS_KEY_FILE} : die "No Private Key\n";
	open( PRIVKEY, $key_file_name )
	  || die("Could not open file $key_file_name");
	my $privkey = join "", <PRIVKEY>;
	close(PRIVKEY);
	Crypt::OpenSSL::RSA->new_private_key($privkey);
}

#returns the cert block between the begin and end delimiters
sub load_cert {

	if ( defined($WSRF::WSS::pub_key) ) {
		if ( ref($WSRF::WSS::pub_key) eq 'CODE' ) {
			return $WSRF::WSS::pub_key->();
		} else {
			return $WSRF::WSS::pub_key;
		}
	}

	my $cert_file_name =
	  $ENV{HTTPS_CERT_FILE} ? $ENV{HTTPS_CERT_FILE} : die "No Public Key\n";
	open( CERT, $cert_file_name )
	  || die("Could not open certificate file $cert_file_name");
	my $start = 0;
	my $cert  = "";
	while (<CERT>) {
		if ( !m/-----END CERTIFICATE-----/ && $start == 1 ) {
			$cert = $cert . $_;
		}
		if (/-----BEGIN CERTIFICATE-----/) {
			$start = 1;
		}
	}
	close(CERT);
	return $cert;
}

sub sign {
	my $envelope = shift;

	eval { require XML::LibXML };
	die "Failed to access class XML::LibXML: $@" if $@;
	eval { require MIME::Base64 };
	die "Failed to access class MIME::Base64: $@" if $@;

	#Get Certificate
	my $certificate = WSRF::WSS::load_cert();

	my $header = "";

	my $for_signing =
	    '<ds:SignedInfo xmlns:ds="' . $WSRF::Constants::DS . '">'
	  . '<ds:CanonicalizationMethod Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#" />'
	  . '<ds:SignatureMethod Algorithm="' . ($WSRF::WSS::algorithm eq 'sha256' ? 'http://www.w3.org/2001/04/xmldsig-more#rsa-sha256' : $WSRF::Constants::DS . 'rsa-sha1') . '"/>';

	#search through the envelope for things to sign
	foreach my $key ( keys(%WSRF::WSS::ID_Xpath) ) {
		next unless (defined $WSRF::WSS::ID_Xpath{$key});
		$for_signing .=
		  WSRF::WSS::make_token( $envelope, $WSRF::WSS::ID_Xpath{$key}, $key )
		  if defined( $WSRF::WSS::Sign{$key} );
		my $parser = XML::LibXML->new();
		my $doc    = $parser->parse_string($envelope);
		my $canon = undef;
		eval {$canon  = $doc->toStringEC14N( 0, $WSRF::WSS::ID_Xpath{$key}, [''] );};
		$header .= defined($canon) ? $canon : "";
	}

	$for_signing .=
	  WSRF::WSS::make_token( $envelope, $WSRF::WSS::body_xpath, $WSRF::WSS::ID{myBody}  )
	  if defined( $WSRF::WSS::Sign{Body} );

	#create a security token using the certificate
	my $sec_token =
'<wsse:BinarySecurityToken xmlns:wsse="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd" xmlns:wsu="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd" EncodingType="http://docs.oasis-o...
	  . $certificate
	  . '</wsse:BinarySecurityToken>';
	if (    defined( $WSRF::WSS::Sign{BinarySecurityToken} )
		 && defined($WSRF::WSS::sec_xpath) )
	{
		$for_signing .=
		  WSRF::WSS::make_token( $sec_token, $WSRF::WSS::sec_xpath,
								 $WSRF::WSS::ID{X509Token} );
	}

	#create a timestamp
	my $timestamp = '';
	if ( defined($WSRF::WSS::timestamp_xpath) ) {
		$timestamp =
'<wsu:Timestamp xmlns:wsu="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd" wsu:Id="' . $WSRF::WSS::ID{TimeStamp} . '">';
		$timestamp .=
		    '<wsu:Created>'
		  . WSRF::Time::ConvertEpochTimeToString(time)
		  . '</wsu:Created>';
		$timestamp .=
		    '<wsu:Expires>'
		  . WSRF::Time::ConvertEpochTimeToString( time + ($WSRF::TIME::EXPIRES_IN ? $WSRF::TIME::EXPIRES_IN : 60))
		  . '</wsu:Expires>';

		#$timestamp .= '<wsu:Created>2004-02-07T14:31:59Z</wsu:Created>';
		#$timestamp .= '<wsu:Expires>2006-02-07T14:36:59Z</wsu:Expires>';
		$timestamp .= '</wsu:Timestamp>';

		#canonicalize,digest + Base64 the timestamp
		$for_signing .=
		  WSRF::WSS::make_token( $timestamp, $WSRF::WSS::timestamp_xpath,
								 $WSRF::WSS::ID{TimeStamp} )
		  if defined( $WSRF::WSS::Sign{Timestamp} );
	}

	$for_signing .= '</ds:SignedInfo>';

	my $parser          = XML::LibXML->new();
	my $doc             = $parser->parse_string($for_signing);