1## Domain Registry Interface, .NO message extensions
2##
3## Copyright (c) 2008-2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>,
4##                    Trond Haugen E<lt>info@norid.noE<gt>
5##                    All rights reserved.
6##
7## This file is part of Net::DRI
8##
9## Net::DRI is free software; you can redistribute it and/or modify
10## it under the terms of the GNU General Public License as published by
11## the Free Software Foundation; either version 2 of the License, or
12## (at your option) any later version.
13##
14## See the LICENSE file that comes with this distribution for more details.
15#
16#
17#
18####################################################################################################
19
20package Net::DRI::Protocol::EPP::Extensions::NO::Message;
21
22use strict;
23use warnings;
24
25use Net::DRI::Util;
26use Net::DRI::Exception;
27use Net::DRI::Protocol::EPP::Core::Domain;
28use Net::DRI::Protocol::EPP::Extensions::NO::Contact;
29use Net::DRI::Protocol::EPP::Extensions::NO::Host;
30use Net::DRI::Protocol::EPP::Extensions::NO::Result;
31use Net::DRI::Protocol::EPP::Util;
32
33use DateTime::Format::ISO8601;
34
35our $VERSION = do { my @r = ( q$Revision: 1.5 $ =~ /\d+/gmx ); sprintf( "%d" . ".%02d" x $#r, @r ); };
36
37=pod
38
39=head1 NAME
40
41Net::DRI::Protocol::EPP::Extensions::NO::Message - .NO Mesage Extensions for Net::DRI
42
43=head1 DESCRIPTION
44
45Please see the README file for details.
46
47=head1 SUPPORT
48
49For now, support questions should be sent to:
50
51E<lt>netdri@dotandco.comE<gt>
52
53Please also see the SUPPORT file in the distribution.
54
55=head1 SEE ALSO
56
57E<lt>http://www.dotandco.com/services/software/Net-DRI/E<gt>
58
59=head1 AUTHOR
60
61Trond Haugen, E<lt>info@norid.noE<gt>
62
63=head1 COPYRIGHT
64
65Copyright (c) 2008-2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>,
66Trond Haugen E<lt>info@norid.noE<gt>
67All rights reserved.
68
69This program is free software; you can redistribute it and/or modify
70it under the terms of the GNU General Public License as published by
71the Free Software Foundation; either version 2 of the License, or
72(at your option) any later version.
73
74See the LICENSE file that comes with this distribution for more details.
75
76=cut
77
78################################################################################################
79
80sub register_commands {
81    my ( $class, $version ) = @_;
82
83    my %tmp = (
84        noretrieve => [ \&pollreq, \&parse_poll ],
85        nodelete   => [ \&pollack, \&Net::DRI::Protocol::EPP::Extensions::NO::Result::condition_parse ],
86    );
87
88    return { 'message' => \%tmp };
89}
90
91sub facet {
92    my ( $epp, $rd ) = @_;
93
94    return Net::DRI::Protocol::EPP::Extensions::NO::Host::build_facets( $epp, $rd );
95}
96
97sub pollack {
98    my ( $epp, $msgid, $rd ) = @_;
99
100    my $mes = $epp->message();
101    my $r = ( $mes->command( [ [ 'poll', { op => 'ack', msgID => $msgid } ] ] ) );
102
103    if (defined($rd->{facets}) && $rd->{facets}) {
104       $r = facet( $epp, $rd );
105    }
106    return $r;
107}
108
109sub pollreq {
110    my ( $epp, $rd ) = @_;
111
112    my $mes = $epp->message();
113
114    my $r = ( $mes->command( [ [ 'poll', { op => 'req' } ] ] ) );
115
116    if (defined($rd->{facets}) && $rd->{facets}) {
117       $r = facet( $epp, $rd );
118    }
119
120    return $r;
121}
122
123sub parse_resp_result
124{
125 my ($node, $NS, $rinfo, $msgid)=@_;
126
127 push @{$rinfo->{message}->{$msgid}->{results}},Net::DRI::Protocol::EPP::Util::parse_result($node,$NS,'no');
128 return;
129}
130
131sub transfer_resp_parse {
132 my ($trndata, $oname, $rinfo, $msgid)=@_;
133
134 return unless $trndata;
135
136 my $pd=DateTime::Format::ISO8601->new();
137 my $c=$trndata->getFirstChild();
138
139 while ($c) {
140
141  next unless ($c->nodeType() == 1); ## only for element nodes
142  my $name=$c->localname() || $c->nodeName();
143  next unless $name;
144
145  if ($name eq 'name') {
146   $oname=lc($c->getFirstChild()->getData());
147   $rinfo->{message}->{$msgid}->{domain}->{$oname}->{action}='transfer';
148
149   $rinfo->{message}->{$msgid}->{domain}->{$oname}->{exist}=1;
150  } elsif ($name=~m/^(trStatus|reID|acID)$/mx) {
151   $rinfo->{message}->{$msgid}->{domain}->{$oname}->{$1}=$c->getFirstChild()->getData() if ($c->getFirstChild());
152  } elsif ($name=~m/^(reDate|acDate|exDate)$/mx) {
153   $rinfo->{message}->{$msgid}->{domain}->{$oname}->{$1}=$pd->parse_datetime($c->getFirstChild()->getData());
154  }
155 } continue { $c=$c->getNextSibling(); }
156 return;
157}
158
159sub contact_resp_parse {
160 my ($credata, $oname, $rinfo, $msgid)=@_;
161
162 return unless $credata;
163
164 my $c=$credata->getFirstChild();
165
166 while ($c)
167 {
168  next unless ($c->nodeType() == 1); ## only for element nodes
169  my $name=$c->localname() || $c->nodeName();
170  if ($name eq 'id')
171  {
172   my $new=$c->getFirstChild()->getData();
173   $rinfo->{message}->{$msgid}->{contact}->{$oname}->{id}=$new if (defined($oname) && ($oname ne $new)); ## registry may give another id than the one we requested or not take ours into account at all !
174   $oname=$new;
175   $rinfo->{message}->{$msgid}->{contact}->{$oname}->{id}=$oname;
176   $rinfo->{message}->{$msgid}->{contact}->{$oname}->{action}='create';
177   $rinfo->{message}->{$msgid}->{contact}->{$oname}->{exist}=1;
178  } elsif ($name=~m/^(crDate)$/)
179  {
180   $rinfo->{message}->{$msgid}->{contact}->{$oname}->{$1}=DateTime::Format::ISO8601->new()->parse_datetime($c->getFirstChild()->getData());
181  }
182 } continue { $c=$c->getNextSibling(); }
183}
184
185## We take into account all parse functions, to be able to parse any result
186sub parse_poll {
187    my ( $po, $otype, $oaction, $oname, $rinfo ) = @_;
188    my $mes = $po->message();
189
190    my $eppNS = $mes->ns('_main');
191
192    # both message and results are defined by the same no-ext-result schema
193    my $NS = $mes->ns('no_result');
194
195    return unless $mes->is_success();
196    return if ( $mes->result_code() == 1300 );    # no messages in queue
197
198    my $msgid = $mes->msg_id();
199    $rinfo->{message}->{session}->{last_id} = $msgid;
200
201    ## Parse any message
202    my $mesdata = $mes->get_response('no_result','message');
203
204    $rinfo->{$otype}->{$oname}->{message} = $mesdata;
205    return unless $mesdata;
206
207    my ( $epp, $rep, $ext, $ctag, @conds, @tags );
208    my $command = $mesdata->getAttribute('type');
209
210    @tags = $mesdata->getElementsByTagNameNS( $NS, 'desc' );
211
212    # We supplement the standard top desc with our more detailed one
213    if (@tags && $tags[0]->getFirstChild() && $tags[0]->getFirstChild()->getData()) {
214       $rinfo->{message}->{$msgid}->{nocontent} = $tags[0]->getFirstChild()->getData();
215    }
216
217    #
218    # Now the data tag
219    @tags = $mesdata->getElementsByTagNameNS( $NS, 'data' );
220    return unless @tags;
221
222    my $data = $tags[0];
223
224    ##
225    # Inside a data we can have variants,
226    # a normal result block in the start, then an <entry ..>
227    # which is a sequence, the other is a late response which will contain
228    # a complete and ordinary EPP response, only delayed.
229
230    #
231    # Parse any ordinary result block(s)
232    #
233    foreach my $result ($data->getElementsByTagNameNS($eppNS,'result')) {
234	parse_resp_result($result, $eppNS, $rinfo, $msgid);
235    }
236
237    ###
238    # Parse entry
239    #
240    @tags = $data->getElementsByTagNameNS( $NS, 'entry' );
241
242    foreach my $entry (@tags) {
243        next unless ( defined( $entry->getAttribute('name') ) );
244
245        if ( $entry->getAttribute('name') eq 'objecttype' ) {
246            $rinfo->{message}->{$msgid}->{object_type}
247                = $entry->getFirstChild()->getData();
248        } elsif ( $entry->getAttribute('name') eq 'command' ) {
249            $rinfo->{message}->{$msgid}->{action}
250                = $entry->getFirstChild()->getData();
251        } elsif ( $entry->getAttribute('name') eq 'objectname' ) {
252            $rinfo->{message}->{$msgid}->{object_id}
253                = $entry->getFirstChild()->getData();
254        } elsif (
255            $entry->getAttribute('name') =~ /^(domain|contact|host)$/mx )
256        {
257            $rinfo->{message}->{$msgid}->{object_type} = $1;
258            $rinfo->{message}->{$msgid}->{object_id}
259                = $entry->getFirstChild()->getData();
260        }
261    }
262
263    $rinfo->{message}->{$msgid}->{action} ||= $command;
264
265    ###
266    # The various EPP late response messages can be encapsulated in the service message data.
267    # There may in principle be any type of object response, so we try to parse all variants
268    # We try to use our various parse methods, copy the data and copy the data from it
269    # into our message structure. The delete the source data to hopefully not
270    # contaminate anything.
271
272    ##
273    # inside a data and a late-responses, an inner TRID pair should exist.
274    # No more than one inner TRID pair is expected and handled
275    # In case more exist, the first one is used.
276    # Find the values and stash them in an $rinfo->{message}->{$msgid}->{trid} hash
277
278    if (my $trid=(($data->getElementsByTagNameNS($eppNS,'trID'))[0])) {
279       my $tmp=Net::DRI::Util::xml_child_content($trid,$eppNS,'clTRID');
280       $rinfo->{message}->{$msgid}->{trid}->{cltrid} = $tmp if defined($tmp);
281       $tmp = Net::DRI::Util::xml_child_content($trid,$eppNS,'svTRID');
282       $rinfo->{message}->{$msgid}->{trid}->{svtrid} = $tmp if defined($tmp);
283    }
284
285    # Parse any domain command late response data
286    if (my $infdata=$mes->get_response('domain','infData')) {
287       Net::DRI::Protocol::EPP::Core::Domain::info_parse($po,'domain','info',$oname,$rinfo);
288
289       if (defined($rinfo->{domain}) && $rinfo->{domain}) {
290           $rinfo->{message}->{$msgid}->{domain} = $rinfo->{domain};
291           delete($rinfo->{domain});
292       }
293    }
294
295    # Parse any domain transfer late response data
296    if (my $trndata = (($data->getElementsByTagNameNS($mes->ns('domain'), 'trnData'))[0])) {
297	transfer_resp_parse($trndata, $oname, $rinfo, $msgid);
298    }
299
300    # Parse any any contact create late response data
301    if (my $credata = (($data->getElementsByTagNameNS($mes->ns('contact'), 'creData'))[0])) {
302       contact_resp_parse($credata, $oname, $rinfo, $msgid);
303    }
304
305    # Parse any any contact info late response data
306    if (my $condata = $mes->get_extension('no_contact','infData')) {
307       Net::DRI::Protocol::EPP::Extensions::NO::Contact::parse_info($po,'contact', 'info',$oname,$rinfo);
308       if (defined($rinfo->{contact}) && $rinfo->{contact}) {
309           $rinfo->{message}->{$msgid}->{contact} = $rinfo->{contact};
310           delete ($rinfo->{contact});
311       }
312    }
313
314    # Parse any any host info late response data
315    if (my $condata = $mes->get_extension('no_host','infData')) {
316       Net::DRI::Protocol::EPP::Extensions::NO::Host::parse_info($po,'host','info',$oname,$rinfo);
317
318       if (defined($rinfo->{host}) && $rinfo->{host}) {
319           $rinfo->{message}->{$msgid}->{host} = $rinfo->{host};
320           delete($rinfo->{host});
321       }
322    }
323
324    # Parse any result extension conditions
325    my $innerepp=$data->getElementsByTagNameNS($eppNS,'epp')->shift();
326    my $condata;
327    if (defined($innerepp) && ($condata = $innerepp->getElementsByTagNameNS($NS,'conditions'))) {
328       Net::DRI::Protocol::EPP::Extensions::NO::Result::parse($mes,$otype,$oname,$rinfo,$condata->shift());
329
330       if ((defined($rinfo->{$otype}->{$oname}->{conditions})) &&
331           $rinfo->{$otype}->{$oname}->{conditions}) {
332           $rinfo->{message}->{$msgid}->{conditions} = $rinfo->{$otype}->{$oname}->{conditions};
333           #delete ($rinfo->{$otype}->{$oname}->{conditions});
334       }
335    }
336    return 1;
337}
338
339####################################################################################################
3401;
341