GeniXML.pm.in 20.5 KB
Newer Older
1 2 3
#!/usr/bin/perl -w
#
# GENIPUBLIC-COPYRIGHT
4
# Copyright (c) 2010-2012 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13
# All rights reserved.
#
package GeniXML;

use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA = "Exporter";
14
@EXPORT = qw(Parse ParseFile GetXmlVersion IsVersion0 FindNodes FindNodesNS
15
FindFirst FindElement FindAttr GetNodeByVirtualId GetLinkByVirtualId
16
IsLanNode IsLocalNode IsTunnel GetExpires GetBandwidth GetIp GetVnodeId
17
GetNodeId GetVirtualId GetInterfaceId GetInterfaceNodeId GetSliverId
18
GetManagerId GetColocate GetSubnodeOf GetStartupCommand GetTarball
19
GetVirtualizationType SetVirtualizationSubtype GetVirtualizationSubtype
Jonathon Duerig's avatar
Jonathon Duerig committed
20
GetExclusive SetExclusive GetLinkManager SetText GetText Serialize
21 22
CreateDocument AddElement RemoveChild PolicyExists GetMask
GetDiskImage);
23 24 25

use English;
use XML::LibXML;
26 27
use XML::LibXML::XPathContext;
use XML::LibXML::NodeList;
28
use GeniHRN;
29
use GeniUtil;
30 31
use Carp qw(cluck carp);

32
use vars qw($RSPEC_0_1 $RSPEC_0_2 $RSPEC_2 $RSPEC_3
33
            $RSPEC_0_1_NS $RSPEC_0_2_NS $RSPEC_2_NS
34
            $EMULAB_NS $XSI_NS $STITCH_NS $SHAREDVLAN_NS
35 36
            $REQUEST_2_URL $MANIFEST_2_URL
            $REQUEST_3_URL $MANIFEST_3_URL);
37
$RSPEC_0_1 = "0.1";
Jonathon Duerig's avatar
Jonathon Duerig committed
38
$RSPEC_0_2 = "0.2";
Jonathon Duerig's avatar
Jonathon Duerig committed
39
$RSPEC_2 = "2";
40
$RSPEC_3 = "3";
41

42 43 44
our $RSPEC_0_1_NS = "http://www.protogeni.net/resources/rspec/0.1";
our $RSPEC_0_2_NS = "http://www.protogeni.net/resources/rspec/0.2";
our $RSPEC_2_NS = "http://www.protogeni.net/resources/rspec/2";
45
our $RSPEC_3_NS = "http://www.geni.net/resources/rspec/3";
46 47 48
our $EMULAB_NS = "http://www.protogeni.net/resources/rspec/ext/emulab/1";
our $XSI_NS = "http://www.w3.org/2001/XMLSchema-instance";
our $STITCH_NS = "http://hpn.east.isi.edu/rspec/ext/stitch/0.1/";
49
our $SHAREDVLAN_NS = "http://www.protogeni.net/resources/rspec/ext/emulab/1";
50

51 52 53 54
$REQUEST_2_URL = "http://www.protogeni.net/resources/rspec/2/request.xsd";
$MANIFEST_2_URL = "http://www.protogeni.net/resources/rspec/2/manifest.xsd";
$REQUEST_3_URL = "http://www.geni.net/resources/rspec/3/request.xsd";
$MANIFEST_3_URL = "http://www.geni.net/resources/rspec/3/manifest.xsd";
55

56 57 58 59
# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";

60 61 62
# Name Space stuff
my $DELAY_NS = "http://www.protogeni.net/resources/rspec/ext/delay/1";

63 64 65 66 67 68 69 70 71 72 73
# Returns the document element by parsing a given string. If the
# string fails to parse, returns undefined.
sub Parse($)
{
    my ($xml) = @_;
    my $parser = XML::LibXML->new;
    my $doc;
    eval {
        $doc = $parser->parse_string($xml);
    };
    if ($@) {
74
	carp("Failed to parse xml string: $@\nXML: $xml\n\n");
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
	return undef;
    } else {
	return $doc->documentElement();
    }
}

sub ParseFile($)
{
    my ($file) = @_;
    my $parser = XML::LibXML->new;
    my $doc;
    eval {
        $doc = $parser->parse_file($file);
    };
    if ($@) {
90
	carp("Failed to parse xml string: $@");
91 92 93 94 95 96
	return undef;
    } else {
	return $doc->documentElement();
    }
}

97
# Determines the rspec version of a node by examining is namespace URI
98
sub GetXmlVersion($)
99 100
{
    my ($node) = @_;
101
    my $result = undef;
102 103
    my $ns = $node->namespaceURI();
    if (defined($ns)) {
104
	if ($ns =~ /protogeni.net\/resources\/rspec\/0.1$/) {
105
	    $result = $RSPEC_0_1;
106
	} elsif ($ns =~ /protogeni.net\/resources\/rspec\/0.2$/) {
Jonathon Duerig's avatar
Jonathon Duerig committed
107
	    $result = $RSPEC_0_2;
108
	} elsif ($ns =~ /protogeni.net\/resources\/rspec\/2$/) {
109
	    $result = $RSPEC_2;
110 111
	} elsif ($ns =~ /geni.net\/resources\/rspec\/3$/) {
	    $result = $RSPEC_3;
112 113 114 115 116 117 118 119
	} else {
	    carp("Unknown rspec namespace: " . $ns);
	    $result = $RSPEC_0_1;
	}
    }
    return $result;
}

Jonathon Duerig's avatar
Jonathon Duerig committed
120 121
sub IsVersion0($)
{
122 123 124
    my $version = GetXmlVersion($_[0]);
    return defined($version)
	&& ($version eq $RSPEC_0_1 || $version eq $RSPEC_0_2);
Jonathon Duerig's avatar
Jonathon Duerig committed
125 126
}

127 128 129 130 131 132 133 134 135 136 137 138
# Returns a NodeList for a given XPath using a given node as
# context. 'n' is defined to be the prefix for the namespace of the
# node.
sub FindNodes($$)
{
    my ($path, $node) = @_;
    my $result = undef;
    my $ns = undef;
    eval {
	my $xc = XML::LibXML::XPathContext->new();
	$ns = $node->namespaceURI();
	if (defined($ns)) {
139
	    $xc->registerNs('n', $ns);
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
	} else {
	    $path =~ s/\bn://g;
	}
	$result = $xc->findnodes($path, $node);
    };
    if ($@) {
	if (! defined($ns)) {
	    $ns = "undefined";
	}
        cluck "Failed to find nodes using XPath path='$path', ns='$ns': $@\n";
	return XML::LibXML::NodeList->new();
    } else {
	return $result;
    }
}

156 157 158 159 160 161
# Returns a NodeList for a given XPath using a given namespace as
# context. 'n' is defined to be the prefix for the given namespace.
sub FindNodesNS($$$)
{
    my ($path, $node, $nsURI) = @_;
    my $result = undef;
162 163
    return XML::LibXML::NodeList->new()
        if (!defined($node));
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
    eval { 
  my $xc = XML::LibXML::XPathContext->new();
  if (defined($nsURI)) {
      $xc->registerNs('n', $nsURI);
  } else {
      $path =~ s/\bn://g;
  }
  $result = $xc->findnodes($path, $node);
    };
    if ($@) {
  if (! defined($nsURI)) {
      $nsURI = "undefined";
  }
        cluck "Failed to find nodes using XPath path='$path', nsURI='$nsURI': $@\n";        
  return XML::LibXML::NodeList->new();
    } else { 
  return $result;
    } 
}


185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
# Returns the first Node which matches a given XPath against a given
# node. If that node is not of the specified type, returns
# undefined. Works like FindNodes.
sub FindNodeType($$$)
{
    my ($path, $node, $type) = @_;
    my $result = FindNodes($path, $node)->pop();
    if (defined($result) && $result->nodeType() != $type) {
	$result = undef;
    }
    return $result;
}

# Returns the first Node which matches a given XPath.
sub FindFirst($$)
{
    my ($path, $node) = @_;
    return FindNodes($path, $node)->pop();
}

# Returns the first Element which matches a given XPath.
sub FindElement($$)
{
    my ($path, $node) = @_;
    return FindNodeType($path, $node, XML_ELEMENT_NODE);
}

# Returns the first Attribute which matches a given XPath.
sub FindAttr($$)
{
    my ($path, $node) = @_;
    return FindNodeType($path, $node, XML_ATTRIBUTE_NODE);
}

219 220 221 222 223
sub GetElementByVirtualId($$$)
{
    my ($name, $type, $node) = @_;
    my @list = FindNodes('n:'.$type.'[@virtual_id = "'.$name.'"]',
			 $node)->get_nodelist();
224 225 226 227 228 229 230 231
    if (scalar(@list) == 0) {
	@list = FindNodes('n:'.$type.'[@nickname = "'.$name.'"]',
			  $node)->get_nodelist();
    }
    if (scalar(@list) == 0) {
	@list = FindNodes('n:'.$type.'[@client_id = "'.$name.'"]',
			  $node)->get_nodelist();
    }
232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
    my $result = undef;
    if (scalar(@list) > 0)
    {
	$result = $list[0];
    }
    if (scalar(@list) > 1)
    {
	cluck("WARNING: Multiple $type with virtual_id $name found");
    }
    return $result;
}

sub GetNodeByVirtualId($$)
{
    my ($name, $node) = @_;
    return GetElementByVirtualId($name, 'node', $node);
}

sub GetLinkByVirtualId($$)
{
    my ($name, $node) = @_;
    return GetElementByVirtualId($name, 'link', $node);    
}

256 257 258 259 260 261
# Returns true if a given XML Node is an RSpec node and is of type lan
sub IsLanNode($)
{
    my ($node) = @_;
    my $result = 0;
    if (defined($node) && $node->localname() eq "node") {
262
	foreach my $lan (FindNodes("n:hardware_type",
263
				   $node)->get_nodelist()) {
264
	    my $typeName = GetFirstText($lan, "type_name", "name");
265
	    if (defined($typeName) && $typeName eq "lan") {
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281
		$result = 1;
		last;
	    }
	}
    }
    return $result;
}

# Returns true if a given XML Node is an RSpec node and either has
# the current CM as a 'component_manager_urn' or
# 'component_manager_uuid or no component_manager defined.
sub IsLocalNode($)
{
    my ($node) = @_;
    my $result = 0;
    if (defined($node) && $node->localname() eq "node") {
282
	my $manager_uuid  = GetManagerId($node);
283 284 285 286 287 288 289 290 291 292
	if (! defined($manager_uuid) ||
	    GeniHRN::Equal($manager_uuid, $ENV{'MYURN'}) ||
	    $manager_uuid eq $ENV{'MYUUID'}) {

	    $result = 1;
	}
    }
    return $result;
}

Jonathon Duerig's avatar
Jonathon Duerig committed
293 294 295 296 297 298 299 300
sub IsTunnel($)
{
    my ($link) = @_;
    my $result = 0;
    if (IsVersion0($link)) {
	my $link_type = GetText("link_type", $link);
	$result = (defined($link_type) && $link_type eq "tunnel");
    } else {
301
	my @types = FindNodes("n:link_type", $link)->get_nodelist();
Jonathon Duerig's avatar
Jonathon Duerig committed
302 303
	foreach my $current (@types) {
	    my $name = GetText("name", $current);
304
	    if (defined($name) && $name eq "gre-tunnel") {
Jonathon Duerig's avatar
Jonathon Duerig committed
305 306 307 308 309 310 311 312 313 314 315
		$result = 1;
		last;
	    }
	}
    }
    return $result;
}

sub GetExpires($)
{
    my ($node) = @_;
316
    return GetFirstText($node, "valid_until", "expires");
Jonathon Duerig's avatar
Jonathon Duerig committed
317 318 319 320 321 322 323 324 325 326 327 328
}

sub SetExpires($$)
{
    my ($node, $arg) = @_;
    if (IsVersion0($node)) {
	SetText("valid_until", $node, $arg);
    } else {
	SetText("expires", $node, $arg);
    }
}

329 330 331 332 333 334 335 336
sub GetBandwidth($)
{
    my ($link) = @_;
    my $result = undef;
    if (IsVersion0($link)) {
	$result = GeniXML::GetText("bandwidth", $link);
    } else {
	my $prop = FindFirst("n:property", $link);
337 338 339
	if (defined($prop)) {
	    $result = GeniXML::GetText("capacity", $prop);
	}
340 341 342 343
    }
    return $result;
}

344
sub GetMask($$)
345 346 347 348 349 350
{
    my ($ifaceref, $node) = @_;
    my $result = undef;
    if (IsVersion0($ifaceref)) {
	$result = GetText("tunnel_ip", $ifaceref);
    } else {
351 352 353 354 355 356 357
	my $id = GetInterfaceId($ifaceref);
	my @ifaces = FindNodes("n:interface", $node)->get_nodelist();
	foreach my $iface (@ifaces) {
	    my $testid = GetInterfaceId($iface);
	    if (defined($id) && defined($testid) && $testid eq $id) {
		my $ip = FindFirst("n:ip", $iface);
		if (defined($ip)) {
358
		    $result = GetFirstText($ip, "netmask", "mask");
359 360 361 362 363 364 365 366 367 368 369 370
		}
		last;
	    }
	}
    }
    return $result;
}

sub GetIp($$)
{
    my ($ifaceref, $node) = @_;
    my $result = undef;
371 372 373
    if (IsVersion0($ifaceref)) {
	$result = GetText("tunnel_ip", $ifaceref);
    } else {
374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389
	my $id = GetInterfaceId($ifaceref);
	my @ifaces = FindNodes("n:interface", $node)->get_nodelist();
	foreach my $iface (@ifaces) {
	    my $testid = GetInterfaceId($iface);
	    if (defined($id) && defined($testid) && $testid eq $id) {
		my $ip = FindFirst("n:ip", $iface);
		if (defined($ip)) {
		    $result = GetText("address", $ip);
		}
		last;
	    }
	}
    }
    return $result;
}

390 391 392 393 394 395 396 397
# Returns the vnode id in the emulab extension or failing that the component_id
sub GetVnodeId($)
{
    my ($node) = @_;
    my $result = undef;
    if (IsVersion0($node)) {
	$result = GetNodeId($node);
    } else {
398
	my $vnoderef = GeniXML::FindNodesNS("n:vnode", $node,
399 400 401 402 403 404 405 406 407 408 409
					    $EMULAB_NS)->pop();
	if (defined($vnoderef)) {
	    $result = GetText("name", $vnoderef);
	}
	if (! defined($result)) {
	    $result = GetNodeId($node);
	}
    }
    return $result;
}

410 411 412 413
# Returns the uuid or urn of an RSpec node or undef if it is not a node.
sub GetNodeId($)
{
    my ($node) = @_;
414 415
    my $result = GetFirstText($node, "component_urn", "component_id",
			      "component_uuid", "uuid");
416
    if (defined($result) && $result eq "") {
417 418 419
	$result = undef;
    }
    return $result;
420 421 422 423 424
}

sub GetVirtualId($)
{
    my ($node) = @_;
425 426 427 428 429 430 431 432 433 434 435 436 437 438
    return GetFirstText($node, "virtual_id", "nickname", "client_id");
}

sub GetInterfaceId($)
{
    my ($node) = @_;
    return GetFirstText($node, "virtual_interface_id", "iface_name",
			"client_id", "virtual_port_id", "virtual_id");
}

sub GetInterfaceNodeId($)
{
    my ($node) = @_;
    return GetFirstText($node, "virtual_node_id", "node_nickname");
439 440
}

441 442 443
sub GetSliverId($)
{
    my ($node) = @_;
444
    return GetFirstText($node, "sliver_urn", "sliver_id");
445 446
}

447 448 449
sub GetManagerId($)
{
    my ($node) = @_;
450 451 452
    my $result = GetFirstText($node, "component_manager_urn",
			      "component_manager_id",
			      "component_manager_uuid");
453
    if (defined($result) && $result eq "") {
454 455 456
	$result = undef;
    }
    return $result;
457 458
}

Jonathon Duerig's avatar
Jonathon Duerig committed
459 460 461
sub GetColocate($)
{
    my ($node) = @_;
462
    my $result = GetFirstText($node, "colocate", "phys_nickname");
Jonathon Duerig's avatar
Jonathon Duerig committed
463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483
    return $result;
}

sub GetSubnodeOf($)
{
    my ($node) = @_;
    my $result = undef;
    if (IsVersion0($node)) {
	$result = GetText("subnode_of", $node);
    } else {
	my @relations = FindNodes("n:relation", $node)->get_nodelist();
	foreach my $current (@relations) {
	    if (GetText("type", $current) == "subnode_of") {
		$result = GetText("client_id", $current);
		last;
	    }
	}
    }
    return $result;
}

484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519
sub GetServices($)
{
    my ($node) = @_;
    my @result = ();
    my @services = FindNodes("n:services", $node)->get_nodelist();

    foreach my $service (@services) {
	foreach my $current ($service->childNodes()) {
	    my $item;
	    my $type = $current->nodeName();
	
	    if ($type eq "execute") {
		$type = "execute";
		my $cmd  = GetText("command", $current);
		my $shell= GetText("shell", $current);
		$item = {"type"   => $type,
			 "cmd"    => $cmd,
			 "shell"  => $shell};
	    }
	    elsif ($type eq "install") {
		$type = "install";
		my $dir = GetText("install_path", $current);
		my $url = GetText("url", $current);
		$item = {"type"   => $type,
			 "dir"    => $dir,
			 "url"    => $url};
	    }
	    else {
		next;
	    }
	    push(@result, $item);
	}
    }
    return @result;
}

520 521 522 523 524 525 526 527
sub GetStartupCommand($)
{
    my ($node) = @_;
    my $result = undef;
    if (IsVersion0($node)) {
        $result = GetText("startup_command", $node);
    } else {
	my $execute = FindFirst("n:services/n:execute", $node);
528 529 530
	if (defined($execute)) {
	    $result = GetText("command", $execute);
	}
531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556
    }
    return $result;
}

sub GetTarball($)
{
    my ($node) = @_;
    my $result = undef;
    if (IsVersion0($node)) {
        $result = GetText("tarfiles", $node);
    } else {
	$result = "";
	my @tarlist = FindNodes("n:services/n:install",
				$node)->get_nodelist();
	foreach my $current (@tarlist) {
	    my $url = GetText("url", $current);
	    my $install = GetText("install_path", $current);
	    if (defined($url) && defined($install)) {
		# TODO: Make sure url/install don't have semicolons or spaces
		# TODO: Flag an error if either one is not defined
		if ($result ne "") {
		    $result .= ";";
		}
		$result .= $install . " " . $url;
	    }
	}
557
	if (defined($result) && $result eq "") {
558 559 560 561 562 563
	    $result = undef;
	}
    }
    return $result;
}

Jonathon Duerig's avatar
Jonathon Duerig committed
564 565 566 567 568 569 570 571 572 573
sub GetVirtualizationType($)
{
    my ($node) = @_;
    my $result = "emulab-vnode";
    if (IsVersion0($node)) {
	$result = GetText("virtualization_type", $node);
    }
    return $result;
}

574
sub SetVirtualizationSubtype($$)
Jonathon Duerig's avatar
Jonathon Duerig committed
575 576 577 578
{
    my ($node, $arg) = @_;
    my $result = 1;
    if (IsVersion0($node)) {
579 580 581 582 583 584 585
	$result = SetText("virtualization_subtype", $node, $arg);
    } else {
	my $type = FindFirst("n:sliver_type", $node);
	if (! defined($type)) {
	    $type = AddElement("sliver_type", $node);
	}
	SetText("name", $type, $arg);
Jonathon Duerig's avatar
Jonathon Duerig committed
586 587 588 589 590 591 592 593 594
    }
    return $result;
}

sub GetVirtualizationSubtype($)
{
    my ($node) = @_;
    my $result = undef;
    if (IsVersion0($node)) {
595
	$result = GetText("virtualization_subtype", $node);
Jonathon Duerig's avatar
Jonathon Duerig committed
596
    } else {
597
	my $type = FindFirst("n:sliver_type", $node);
598 599 600
	if (defined($type)) {
	    $result = GetText("name", $type);
	}
Jonathon Duerig's avatar
Jonathon Duerig committed
601 602 603 604
    }
    return $result;
}

605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
sub GetDiskImage($)
{
    my ($node) = @_;
    my $result = undef;
    if (IsVersion0($node)) {
	$result = FindFirst("n:disk_image", $node);
    } else {
	my $type = FindFirst("n:sliver_type", $node);
	if (defined($type)) {
	    $result = FindFirst("n:disk_image", $type);
	}
    }
    return $result;
}

Jonathon Duerig's avatar
Jonathon Duerig committed
620 621 622 623 624 625 626 627 628 629 630
sub GetExclusive($)
{
    my ($node) = @_;
    my $exclusive = GetText("exclusive", $node);
    my $result = $exclusive;
    if (defined($exclusive) && ! IsVersion0($node)) {
	$result = ($exclusive eq "true");
    }
    return $result;
}

631
sub SetExclusive($$)
Jonathon Duerig's avatar
Jonathon Duerig committed
632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649
{
    my ($node, $arg) = @_;
    my $result = 1;
    if (IsVersion0($node)) {
	$result = SetText("exclusive", $node, $arg);
    } else {
	my $textArg = "false";
	if ($arg) {
	    $textArg = "true";
	}
	$result = SetText("exclusive", $node, $textArg);
    }
    return $result;
}

sub GetLinkManager($)
{
    my ($link) = @_;
650
    return GetFirstText($link, "id", "name");
Jonathon Duerig's avatar
Jonathon Duerig committed
651 652
}

653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670
sub GetDelayPipes($)
{
    my ($node) = @_;
    my @result = ();
    
    if (! IsVersion0($node)) {
	my $type = FindFirst("n:sliver_type", $node);
	if (defined($type)) {
	    my $name = GetText("name", $type);
	    if (defined($name) && $name eq "delay") {
		@result = FindNodesNS("n:sliver_type_shaping/n:pipe", $type,
				      $DELAY_NS)->get_nodelist();
	    }
	}
    }
    return @result;
}

671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688
sub GetSharedLanName($)
{
    my ($iface) = @_;

    if (! IsVersion0($iface)) {
	my $interface_name = FindNodesNS("vlan:link_shared_vlan", $iface,
					 $SHAREDVLAN_NS)->pop();

	if (defined($interface_name)) {
	    my $name = GetText("name", $interface_name);
	    if (defined($name) and $name ne "") {
		return $name;
	    }
	}
    }
    return undef;
}

689 690 691 692 693 694 695 696 697
# Takes an attribute/element name, *NOT AN XPATH* and a node and sets
# the text of that node to a particular value. If the node is an
# attribute, the value is set. If it is an element with just a text
# node child, that node is replaced.
# Returns 1 on success and 0 on failure.
sub SetText($$$)
{
    my ($name, $node, $text) = @_;
    my $result = 0;
698 699 700 701
    my $child = FindFirst('@n:'.$name, $node);
    if (! defined($child)) {
	$child = FindFirst('@'.$name, $node);
    }
702 703 704 705
    if (defined($child)) {
	if ($child->nodeType() == XML_ATTRIBUTE_NODE) {
	    $child->setValue($text);
	    $result = 1;
706 707
	}
    } else {
708
	$child = FindFirst('n:'.$name, $node);
709
	if (defined($child)) {
710 711 712 713 714 715 716 717
	    my @grand = $child->childNodes();
	    if (scalar(@grand) == 1
		&& $grand[0]->nodeType() == XML_TEXT_NODE) {
		$grand[0]->setData($text);
		$result = 1;
	    } elsif (scalar(@grand) == 0
		     && $child->nodeType() == XML_ELEMENT_NODE) {
		$child->appendText($text);
718
		$result = 1;
719
	    }
720
	} elsif ($node->nodeType() == XML_ELEMENT_NODE) {
721 722
	    my $ns = $node->namespaceURI();
	    if (defined($ns)) {
723 724 725
# TODO: Submit bug report for the library. This call is bugged.
#		$node->setAttributeNS($ns, "rs:$name", $text);
		$node->setAttribute($name, $text);
726 727 728
	    } else {
		$node->setAttribute($name, $text);
	    }
729
	    $result = 1;
730 731 732 733 734
	}
    }
    return $result;
}

735 736
# Get the text contents of a child of a node with a particular
# name. This can be either an attribute or an element.
737 738
sub GetText($$)
{
739
    my ($name, $node) = @_;
740
    my $result = undef;
741 742 743 744
    my $child = FindFirst('@n:'.$name, $node);
    if (! defined($child)) {
	$child = FindFirst('@'.$name, $node);
    }
745 746 747
    if (! defined($child)) {
	$child = FindFirst('n:'.$name, $node);
    }
748 749 750 751 752 753
    if (defined($child)) {
	$result = $child->textContent();
    }
    return $result;
}

754 755 756 757 758 759 760 761
# Run GetText serially using the initial argument as an XML node
# reference and the remaining arguments as names and return the first
# defined result. Returns undefined if there are no names or if all
# GetText calls return undefined.
sub GetFirstText($@)
{
    my $node = shift(@_);
    my $result = undef;
762
    foreach my $name (@_) {
763 764 765 766 767 768 769 770
	$result = GetText($name, $node);
	if (defined($result)) {
	    last;
	}
    }
    return $result;
}

771 772
# Converts the XML representation of a node to a UTF-8 string and
# outputs it as a complete XML document.
773
sub Serialize($;$)
774
{
775 776
    my ($node, $format) = @_;
    $format = 0 if (!defined($format));
777
    my $newnode = $node->cloneNode(1);
778
    return $newnode->toString($format);
779 780 781 782
}

# Create a new XML document with a given namespace URI and document
# element name.
783 784 785 786
sub CreateDocument($$)
{
    my ($ns, $name) = @_;
    my $doc = XML::LibXML::Document->createDocument("1.0", "UTF-8");
787
    my $root = $doc->createElementNS($ns, "$name");
788 789
    $doc->setDocumentElement($root);
    return $doc;
790 791
}

792 793
# Add a new element to a node. The new element will have the given
# name and be otherwise empty.
794
sub AddElement($$;$)
795
{
796 797 798 799 800
    my ($name, $node, $namespace) = @_;
    my $ns = $namespace;
    if (! defined($namespace)) {
	$ns = $node->namespaceURI();
    }
801 802
    my $child = $node->addNewChild($ns, "rs:$name");
    return $child;
803 804
}

805 806
# Remove a node with a given name from a node. It will be removed
# whether it is an attribute or an element. The name is not an xpath.
807 808 809 810 811 812 813 814 815 816 817 818
sub RemoveChild($$)
{
    my ($name, $node) = @_;
    my $child = FindFirst('@n:'.$name, $node);
    if (! defined($child)) {
	$child = FindFirst('n:'.$name, $node);
    }
    if (defined($child)) {
	$node->removeChild($child);
    }
}

819 820 821 822 823 824
# Replaces a node (oldnode) with a copy of another node (newnode)
sub ReplaceNode($$)
{
    my ($oldnode, $newnode) = @_;
    my $copy = $newnode->cloneNode(1);
    $oldnode->replaceNode($copy);
825
    return $copy;
826 827
}

828 829 830 831
# checks for the existense of policy in extensions of the given
# credential.
sub PolicyExists($$)
{
832 833
    my ($policy, $credential) = @_;
    my $exists = 0;
834

835 836 837 838 839 840
    return 0
        if (!ref($credential) or !defined($policy));
    my $extensions_elem = $credential->extensions();
    return 0
        if (!defined($extensions_elem));
    my $policies = GeniXML::FindNodesNS("//n:policy_exceptions/*",
841
          $extensions_elem, $GeniUtil::EXTENSIONS_NS);
842 843 844 845 846 847
    foreach my $epolicy ($policies->get_nodelist) {
        if ($policy eq $epolicy->string_value) {
            $exists = 1;
            last;
        }      
    }       
848
  
849
    return $exists;
850 851
}

852 853
# _Always_ make sure that this 1 is at the end of the file...
1;