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