File Coverage

blib/lib/DMTF/WSMan.pm

Criterion	Covered	Total	%
statement	21	191	10.9
branch	0	60	0.0
condition	0	6	0.0
subroutine	7	22	31.8
pod	9	9	100.0
total	37	288	12.8

package DMTF::WSMan;

use warnings;
use strict;

use version;
our $VERSION = qv('0.05');
use LWP;
use LWP::Authen::Digest;
use Data::UUID;
use Carp;

# Module implementation here
# We make our own specialization of LWP::UserAgent that
# uses the correct user ID and password
{
    package DMTF::WSMan::PRIVATE::RequestAgent;
    our @ISA = qw(LWP::UserAgent);

    sub new
    {
		my $class=shift;
		my $awo=shift;
		my $self = LWP::UserAgent::new($class, @_);
		$self->{ASSOCIATED_WSMAN_OBJECT}=$awo;
		return($self);
    }

    sub get_basic_credentials
    {
		my $self=shift;
		return($self->{ASSOCIATED_WSMAN_OBJECT}{Context}{user},$self->{ASSOCIATED_WSMAN_OBJECT}{Context}{pass});
    }
}

sub new
{
	my $self={};
	$self->{CLASS} = shift;
	my %args=@_;
	$self->{Context} = {
		user=>'Administrator',
		# password
		# host
		port=>623,
		protocol=>'http',
		xmlns=>{
			soap=>{prefix=>'s', uri=>'http://www.w3.org/2003/05/soap-envelope'},
			addressing=>{prefix=>'a', uri=>'http://schemas.xmlsoap.org/ws/2004/08/addressing'},
			enumeration=>{prefix=>'n', uri=>'http://schemas.xmlsoap.org/ws/2004/09/enumeration'},
			wsman=>{prefix=>'w', uri=>'http://schemas.dmtf.org/wbem/wsman/1/wsman.xsd'},
			cim=>{prefix=>'c', uri=>'http://schemas.dmtf.org/wbem/wsman/1/cimbinding.xsd'}
		}
	};
	$self->{Context}{user} = $args{user} if(defined $args{user});
	$self->{Context}{port} = $args{port} if(defined $args{port});
	$self->{Context}{protocol} = $args{protocol} if(defined $args{protocol});
	$self->{Context}{pass} = $args{pass} if(defined $args{pass});
	$self->{Context}{host} = $args{host} if(defined $args{host});
	$self->{RA} = DMTF::WSMan::PRIVATE::RequestAgent->new($self, keep_alive=>1);
	$self->{challenge_str}=undef;
	$self->{UUID} = Data::UUID->new();
	bless($self, $self->{CLASS});
	return($self);
}

sub invoke
{
	my $self=shift;
	my %args=@_;
	if(!defined $args{epr}) {
		carp "No EPR specified";
		return;
	}
	my $postdata;

	if(defined $args{method}) {
		$postdata=$self->_genheaders($args{epr}{ResourceURI}."/".$args{method},$args{epr});
	}
	else {
		$postdata=$self->_genheaders($args{epr}{ResourceURI},$args{epr});
	}
	$postdata .= "<$self->{Context}{xmlns}{soap}{prefix}:Body>";
	$postdata .= $args{body};
	$postdata .= "{Context}{xmlns}{soap}{prefix}:Body>{Context}{xmlns}{soap}{prefix}:Envelope>";

	my $res = $self->_request($postdata);
	return $res->content;
}

sub put
{
	my $self=shift;
	my %args=@_;
	if(!defined $args{epr}) {
		carp('No EPR specified');
		return;
	}

	my $postdata=$self->_genheaders('http://schemas.xmlsoap.org/ws/2004/09/transfer/Put',$args{epr});
	$postdata .= "<$self->{Context}{xmlns}{soap}{prefix}:Body>".$args{body}."{Context}{xmlns}{soap}{prefix}:Body>{Context}{xmlns}{soap}{prefix}:Envelope>";

	my $res = $self->_request($postdata);
	return $res->content;
}

sub create
{
	my $self=shift;
	my %args=@_;
	if(!defined $args{epr}) {
		carp('No EPR specified');
		return;
	}

	my $postdata=$self->_genheaders('http://schemas.xmlsoap.org/ws/2004/09/transfer/Create',$args{epr});
	$postdata .= "<$self->{Context}{xmlns}{soap}{prefix}:Body>".$args{body}."{Context}{xmlns}{soap}{prefix}:Body>{Context}{xmlns}{soap}{prefix}:Envelope>";

	my $res = $self->_request($postdata);
	return $res->content;
}

sub get
{
	my $self=shift;
	my %args=@_;
	if(!defined $args{epr}) {
		carp('No EPR specified');
		return;
	}
	my $postdata=$self->_genheaders('http://schemas.xmlsoap.org/ws/2004/09/transfer/Get',$args{epr});
	$postdata .= <
  <$self->{Context}{xmlns}{soap}{prefix}:Body/>
{Context}{xmlns}{soap}{prefix}:Envelope>
ENDOFREQUEST

	my $res = $self->_request($postdata);
	return($res->content);
}

sub delete
{
	my $self=shift;
	my %args=@_;
	if(!defined $args{epr}) {
		carp('No EPR specified');
		return;
	}
	my $postdata=$self->_genheaders('http://schemas.xmlsoap.org/ws/2004/09/transfer/Delete',$args{epr});
	$postdata .= <
  <$self->{Context}{xmlns}{soap}{prefix}:Body/>
{Context}{xmlns}{soap}{prefix}:Envelope>
ENDOFREQUEST

	my $res = $self->_request($postdata);
	return($res->content);
}

sub enumerate
{
	my $self=shift;
	my %args=@_;
	if(!defined $args{epr}) {
		carp('No EPR specified');
		return;
	}

	$args{mode} = 'EnumerateObjectAndEPR' if(!defined $args{mode});
	$args{filter} = '' if(!defined $args{filter});
	my $cnt;
	my $results='';

	my $postdata=$self->_genheaders('http://schemas.xmlsoap.org/ws/2004/09/enumeration/Enumerate',$args{epr});
	$postdata.=<
  <$self->{Context}{xmlns}{soap}{prefix}:Body>
    <$self->{Context}{xmlns}{enumeration}{prefix}:Enumerate>
      <$self->{Context}{xmlns}{wsman}{prefix}:OptimizeEnumeration/>
      <$self->{Context}{xmlns}{wsman}{prefix}:MaxElements>10000{Context}{xmlns}{wsman}{prefix}:MaxElements>
      <$self->{Context}{xmlns}{wsman}{prefix}:EnumerationMode>$args{mode}{Context}{xmlns}{wsman}{prefix}:EnumerationMode>$args{filter}
    {Context}{xmlns}{enumeration}{prefix}:Enumerate>
  {Context}{xmlns}{soap}{prefix}:Body>
{Context}{xmlns}{soap}{prefix}:Envelope>
ENDOFREQUEST

	my $res = $self->_request($postdata);
	if($res->content=~/EnumerationContext(?:\s+[^>]*)?>([^<]*)
		$cnt=$1;
	}
	$results .= $res->content;
	undef $cnt if($res->content=~/<[^:>]+:EndOfSequence[\s\/>]/s);

	while(defined $cnt) {
		$postdata=$self->_genheaders('http://schemas.xmlsoap.org/ws/2004/09/enumeration/Pull',$args{epr});
		$postdata.=<
  <$self->{Context}{xmlns}{soap}{prefix}:Body>
	<$self->{Context}{xmlns}{enumeration}{prefix}:Pull>
	  <$self->{Context}{xmlns}{enumeration}{prefix}:EnumerationContext>$cnt{Context}{xmlns}{enumeration}{prefix}:EnumerationContext>
	  <$self->{Context}{xmlns}{enumeration}{prefix}:MaxElements>10000{Context}{xmlns}{enumeration}{prefix}:MaxElements>
	{Context}{xmlns}{enumeration}{prefix}:Pull>
  {Context}{xmlns}{soap}{prefix}:Body>
{Context}{xmlns}{soap}{prefix}:Envelope>
ENDOFREQUEST

		$res = $self->_request($postdata);
		if($res->content=~/EnumerationContext(?:\s+[^>]*)?>([^<]*)
			$cnt=$1;
		}
		else {
			undef $cnt;
		}
		undef $cnt if($res->content=~/<[^:>]+:EndOfSequence[\s\/>]/s);
		# TODO: Normalize namespaces
		$results .= $res->content;
	}

	return($results);
}


###################
# Utility methods #
###################

sub get_selectorset_xml
{
	my $self=shift;
	my $epr=shift;
	my $selectorset='';

	if(defined $epr->{SelectorSet}) {
		$selectorset = "    <$self->{Context}{xmlns}{wsman}{prefix}:SelectorSet>\n";
		foreach my $name (keys %{$epr->{SelectorSet}}) {
			$selectorset .= "      <$self->{Context}{xmlns}{wsman}{prefix}:Selector Name=\"$name\">";
			if(ref($epr->{SelectorSet}{$name}) eq 'HASH') {
				$selectorset .= $self->epr_to_xml($epr->{SelectorSet}{$name});
			}
			else {
				$selectorset .= _XML_escape($epr->{SelectorSet}{$name});
			}
			$selectorset .= "{Context}{xmlns}{wsman}{prefix}:Selector>\n";
		}
		$selectorset .= "    {Context}{xmlns}{wsman}{prefix}:SelectorSet>\n";
	}
	$selectorset = "\n$selectorset" if($selectorset ne '');

	return $selectorset;
}

sub epr_to_xml
{
	my $self=shift;
	my $epr=shift;
	my $selectorset=$self->get_selectorset_xml($epr);

return <
			<$self->{Context}{xmlns}{addressing}{prefix}:EndpointReference>
				<$self->{Context}{xmlns}{addressing}{prefix}:Address>http://$self->{Context}{host}:$self->{Context}{port}/wsman{Context}{xmlns}{addressing}{prefix}:Address>
				<$self->{Context}{xmlns}{addressing}{prefix}:ReferenceParameters>
					<$self->{Context}{xmlns}{wsman}{prefix}:ResourceURI>$epr->{ResourceURI}{Context}{xmlns}{wsman}{prefix}:ResourceURI>
$selectorset
				{Context}{xmlns}{addressing}{prefix}:ReferenceParameters>
			{Context}{xmlns}{addressing}{prefix}:EndpointReference>
EOF
}

################
# Non-exported #
################
sub _XML_escape
{
	my $val=shift;
	$val=~s/&/&/g;
	$val=~s/
	$val=~s/"/"/g;
	$val=~s/'/'/g;
	return $val;
}

sub _request
{
	my $self=shift;
	my $postdata=shift;

	my $req = HTTP::Request->new(POST => $self->{Context}{protocol}."://$self->{Context}{host}:$self->{Context}{port}/wsman");
	$req->header('Content-Type', 'application/soap+xml;charset=UTF-8');
	$req->header('Content-Length', length $postdata);  # Not really needed
	$req->content($postdata);
	return $self->_authenticated_request($req);
}

sub _genheaders
{
	my $self=shift;
	my $action=shift;
	my $epr=shift;
	my $selectorset=$self->get_selectorset_xml($epr);

	my $postdata="<$self->{Context}{xmlns}{soap}{prefix}:Envelope";
	foreach my $ns (keys %{$self->{Context}{xmlns}}) {
		$postdata .= "\n      xmlns:$self->{Context}{xmlns}{$ns}{prefix}=\"$self->{Context}{xmlns}{$ns}{uri}\"";
	}
	$postdata .= ">\n";
	my $uuid=$self->{UUID}->create_str();
	$postdata .= <
  <$self->{Context}{xmlns}{soap}{prefix}:Header>
    <$self->{Context}{xmlns}{addressing}{prefix}:To>$self->{Context}{protocol}://$self->{Context}{host}:$self->{Context}{port}/wsman{Context}{xmlns}{addressing}{prefix}:To>
    <$self->{Context}{xmlns}{wsman}{prefix}:ResourceURI s:mustUnderstand="true">$epr->{ResourceURI}{Context}{xmlns}{wsman}{prefix}:ResourceURI>
    <$self->{Context}{xmlns}{addressing}{prefix}:ReplyTo>
      <$self->{Context}{xmlns}{addressing}{prefix}:Address $self->{Context}{xmlns}{soap}{prefix}:mustUnderstand="true">http://schemas.xmlsoap.org/ws/2004/08/addressing/role/anonymous{Context}{xmlns}{addressing}{prefix}:Address>
    {Context}{xmlns}{addressing}{prefix}:ReplyTo>
    <$self->{Context}{xmlns}{addressing}{prefix}:Action $self->{Context}{xmlns}{soap}{prefix}:mustUnderstand="true">$action{Context}{xmlns}{addressing}{prefix}:Action>
    <$self->{Context}{xmlns}{addressing}{prefix}:MessageID>uuid:$uuid{Context}{xmlns}{addressing}{prefix}:MessageID>$selectorset
  {Context}{xmlns}{soap}{prefix}:Header>
ENDOFREQUEST
	return($postdata);
}

sub _authenticated_request
{
	my $self=shift;
	my $req=shift;

	if(defined $self->{challenge_str}) {
		my $challenge=$self->{challenge_str};

		$challenge =~ tr/,/;/;  # "," is used to separate auth-params!!
		($challenge) = HTTP::Headers::Util::split_header_words($challenge);
		$challenge = { @$challenge };  # make rest into a hash
		for (keys %$challenge) {       # make sure all keys are lower case
			$challenge->{lc $_} = delete $challenge->{$_};
		}
		my $res;
		if(exists $challenge->{digest}) {
			$res=LWP::Authen::Digest->authenticate($self->{RA}, undef, $challenge, undef, $req, undef, undef);
		}
		elsif(exists $challenge->{basic}) {
			$res=LWP::Authen::Basic->authenticate($self->{RA}, undef, $challenge, undef, $req, undef, undef);
		}
		else {
			$res=$self->{RA}->request($req);
		}
		if($res->code == 401) {
			$self->{challenge_str}=$res->www_authenticate;
			$res=$self->_authenticated_request($req);
			if($res->code == 200) {
				return($res);
			}
			else {
				print "!!!! Unable to authenticate!\n";
			}
		}
		$self->{challenge_str}=$res->previous->www_authenticate if(defined $res->previous && $res->code==200);
		return($res);
	}
	my $res=$self->{RA}->request($req);
	if($res->code == 501) {
		if($res->message =~ /SSLeay/) {
			print "SSL support requires Crypt::SSLeay to be installed.\n";
			print "Use the command \"ppm install http://theoryx5.uwinnipeg.ca/ppms/Crypt-SSLeay.ppd\"\n";
		}
	}
	$self->{challenge_str}=$res->previous->www_authenticate if(defined $res->previous && $res->code==200);
	return($res);
}

1; # Magic true value required at end of module
__END__