1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 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 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304
|
package Net::EPP::Frame;
use Carp;
use Net::EPP::Frame::Command;
use Net::EPP::Frame::Greeting;
use Net::EPP::Frame::Hello;
use Net::EPP::Frame::ObjectSpec;
use Net::EPP::Frame::Response;
use POSIX qw(strftime);
use XML::LibXML;
use base qw(XML::LibXML::Document);
use vars qw($EPP_URN);
use strict;
our $EPP_URN = 'urn:ietf:params:xml:ns:epp-1.0';
=pod
=head1 NAME
Net::EPP::Frame - An EPP XML frame system built on top of L<XML::LibXML>.
=head1 SYNOPSIS
#!/usr/bin/perl
use Net::EPP::Client;
use Net::EPP::Frame;
use Net::EPP::ObjectSpec;
use Digest::MD5 qw(md5_hex);
use Time::HiRes qw(time);
use strict;
#
# establish a connection to an EPP server:
#
my $epp = Net::EPP::Client->new(
host => 'epp.registry.tld',
port => 700,
ssl => 1,
dom => 1,
);
my $greeting = $epp->connect;
#
# log in:
#
my $login = Net::EPP::Frame::Command::Login->new;
$login->clID->appendText($userid);
$login->pw->appendText($passwd);
#
# set the client transaction ID:
#
$login->clTRID->appendText(md5_hex(Time::HiRes::time().$$));
#
# check the response from the log in:
#
my $answer = $epp->request($login);
my $result = ($answer->getElementsByTagName('result'))[0];
if ($result->getAttribute('code') != 1000) {
die("Login failed!");
}
#
# OK, let's do a domain name check:
#
my $check = Net::EPP::Frame::Command::Check->new;
#
# get the spec from L<Net::EPP::Frame::ObjectSpec>:
#
my @spec = Net::EPP::Frame::ObjectSpec->spec('domain');
#
# create a domain object using the spec:
#
my $domain = $check->addObject(@spec);
#
# set the domain name we want to check:
#
my $name = $check->createElement('domain:name');
$name->appendText('example.tld');
#
# set the client transaction ID:
#
$check->clTRID->appendText(md5_hex(time().$$));
#
# assemble the frame:
#
$domain->addChild($name);
#
# send the request:
#
my $answer = $epp->request($check);
# and so on...
=head1 DESCRIPTION
The L<Extensible Provisioning Protocol
(EPP)|https://www.rfc-editor.org/info/std69> uses XML documents called "frames"
send data to and from clients and servers.
This module implements a subclass of the L<XML::LibXML::Document> module that
simplifies the process of creation of these frames. It is designed to be used
alongside the L<Net::EPP::Client> and L<Net::EPP::Simple> modules, but could
also be used on the server side.
=head1 OBJECT HIERARCHY
L<XML::LibXML::Node>
+----L<XML::LibXML::Document>
+----L<Net::EPP::Frame>
=head1 USAGE
As a rule, you will not need to create C<Net::EPP::Frame> objects directly.
Instead, you should use one of the subclasses included with the distribution.
The subclasses all inherit from C<Net::EPP::Frame>.
C<Net::EPP::Frame> is itself a subclass of L<XML::LibXML::Document> so all the
methods available from that class are also available to instances of
C<Net::EPP::Frame>.
The available subclasses of C<Net::EPP::Frame> exist to add any additional
elements required by the EPP specification. For example, the E<lt>loginE<gt>
frame must contain the E<lt>clIDE<gt> and E<lt>pwE<gt> frames, so when you
create a new L<Net::EPP::Frame::Command::Login> object, you get these already
defined.
These classes also have convenience methods, so for the above example, you can
call the C<$login-E<gt>clID> and C<$login-E<gt>pw> methods to get the
L<XML::LibXML::Node> objects correesponding to those elements.
=head2 RATIONALE
You could just as easily construct your EPP frames from templates or just lots
of C<printf()> calls. But using a programmatic approach such as this strongly
couples the validity of your XML to the validity of your program. If the
process by which your XML is built is broken, I<your program won't run>. This
has to be a win.
=cut
sub new {
my ($package, $type) = @_;
if (!$type) {
my @parts = split(/::/, $package);
$type = lc(pop(@parts));
}
if ($type !~ /^(hello|greeting|command|response)$/) {
croak("'type' parameter to Net::EPP::Frame::new() must be one of: hello, greeting, command, response ('$type' given).");
return undef;
}
my $self = $package->SUPER::new('1.0', 'UTF-8');
bless($self, $package);
my $epp = $self->createElementNS($EPP_URN, 'epp');
$self->addChild($epp);
my $el = $self->createElement($type);
$epp->addChild($el);
$self->_addExtraElements;
return $self;
}
sub _addExtraElements {
}
=pod
=head1 ADDITIONAL METHODS
my $str = $frame->formatTimeStamp($timestamp);
This method returns a scalar in the required format (defined in RFC 3339). This
is a convenience method.
=cut
sub formatTimeStamp {
my ($self, $stamp) = @_;
return strftime('%Y-%m-%dT%H:%M:%S.0Z', gmtime($stamp));
}
=pod
my $node = $frame->getNode($id);
my $node = $frame->getNode($ns, $id);
This is another convenience method. It uses C<$id> with the
I<getElementsByTagName()> method to get a list of nodes with that element name,
and simply returns the first L<XML::LibXML::Element> from the list.
If C<$ns> is provided, then I<getElementsByTagNameNS()> is used.
=cut
sub getNode {
my ($self, @args) = @_;
if (scalar(@args) == 2) {
return ($self->getElementsByTagNameNS(@args))[0];
} elsif (scalar(@args) == 1) {
return ($self->getElementsByTagName($args[0]))[0];
} else {
croak('Invalid number of arguments to getNode()');
}
}
=pod
my $binary = $frame->header;
Returns a scalar containing the frame length packed into binary. This is
only useful for low-level protocol stuff.
=cut
sub header {
my $self = shift;
return pack('N', length($self->toString) + 4);
}
=pod
my $data = $frame->frame;
Returns a scalar containing the frame header (see the I<header()> method
above) concatenated with the XML frame itself. This is only useful for
low-level protocol stuff.
=cut
sub frame {
my $self = shift;
return $self->header . $self->toString;
}
=pod
=head1 AVAILABLE SUBCLASSES
=over
=item * L<Net::EPP::Frame>, the base class
=item * L<Net::EPP::Frame::Command>, for EPP client command frames
=item * L<Net::EPP::Frame::Command::Check>, for EPP E<lt>checkE<gt> client commands
=item * L<Net::EPP::Frame::Command::Create>, for EPP E<lt>createE<gt> client commands
=item * L<Net::EPP::Frame::Command::Delete>, for EPP E<lt>deleteE<gt> client commands
=item * L<Net::EPP::Frame::Command::Info>, for EPP E<lt>infoE<gt> client commands
=item * L<Net::EPP::Frame::Command::Login>, for EPP E<lt>loginE<gt> client commands
=item * L<Net::EPP::Frame::Command::Logout>, for EPP E<lt>logoutE<gt> client commands
=item * L<Net::EPP::Frame::Command::Poll>, for EPP E<lt>pollE<gt> client commands
=item * L<Net::EPP::Frame::Command::Renew>, for EPP E<lt>renewE<gt> client commands
=item * L<Net::EPP::Frame::Command::Transfer>, for EPP E<lt>transferE<gt> client commands
=item * L<Net::EPP::Frame::Command::Update>, for E<lt>updateE<gt> client commands
=item * L<Net::EPP::Frame::Greeting>, for EPP server greetings
=item * L<Net::EPP::Frame::Hello>, for EPP client greetings
=item * L<Net::EPP::Frame::Response>, for EPP server response frames
=back
Each subclass has its own subclasses for various objects, for example L<Net::EPP::Frame::Command::Check::Domain> creates a C<E<lt>checkE<gt>> frame for domain names.
Coverage for all combinations of command and object type is not complete, but work is ongoing.
=head1 COPYRIGHT
This module is (c) 2008 - 2023 CentralNic Ltd and 2024 Gavin Brown. This module
is free software; you can redistribute it and/or modify it under the same terms
as Perl itself.
=cut
1;
|