view release on metacpan or  search on metacpan

lib/DMTF/WSMan.pm  view on Meta::CPAN

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 .= "</$self->{Context}{xmlns}{wsman}{prefix}:Selector>\n";
		}
		$selectorset .= "    </$self->{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 <<EOF;
			<$self->{Context}{xmlns}{addressing}{prefix}:EndpointReference>
				<$self->{Context}{xmlns}{addressing}{prefix}:Address>http://$self->{Context}{host}:$self->{Context}{port}/wsman</$self->{Context}{xmlns}{addressing}{prefix}:Address>
				<$self->{Context}{xmlns}{addressing}{prefix}:ReferenceParameters>
					<$self->{Context}{xmlns}{wsman}{prefix}:ResourceURI>$epr->{ResourceURI}</$self->{Context}{xmlns}{wsman}{prefix}:ResourceURI>
$selectorset
				</$self->{Context}{xmlns}{addressing}{prefix}:ReferenceParameters>
			</$self->{Context}{xmlns}{addressing}{prefix}:EndpointReference>
EOF
}

################
# Non-exported #
################
sub _XML_escape
{
	my $val=shift;
	$val=~s/&/&amp;/g;
	$val=~s/</&lt;/g;
	$val=~s/"/&quot;/g;
	$val=~s/'/&apos;/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 .= <<ENDOFREQUEST;
  <$self->{Context}{xmlns}{soap}{prefix}:Header>
    <$self->{Context}{xmlns}{addressing}{prefix}:To>$self->{Context}{protocol}://$self->{Context}{host}:$self->{Context}{port}/wsman</$self->{Context}{xmlns}{addressing}{prefix}:To>
    <$self->{Context}{xmlns}{wsman}{prefix}:ResourceURI s:mustUnderstand="true">$epr->{ResourceURI}</$self->{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</$self->{Context}{xmlns}{addressing}{prefix}:Address>
    </$self->{Context}{xmlns}{addressing}{prefix}:ReplyTo>
    <$self->{Context}{xmlns}{addressing}{prefix}:Action $self->{Context}{xmlns}{soap}{prefix}:mustUnderstand="true">$action</$self->{Context}{xmlns}{addressing}{prefix}:Action>
    <$self->{Context}{xmlns}{addressing}{prefix}:MessageID>uuid:$uuid</$self->{Context}{xmlns}{addressing}{prefix}:MessageID>$selectorset
  </$self->{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);