File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/Nominet/Notifications.pm
Criterion Covered Total %
statement 12 119 10.0
branch 0 72 0.0
condition 0 18 0.0
subroutine 4 11 36.3
pod 0 7 0.0
total 16 227 7.0


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .UK EPP Notifications
2             ##
3             ## Copyright (c) 2008,2009,2013,2015 Patrick Mevzek . All rights reserved.
4             ## (c) 2013 Michael Holloway . All rights reserved.
5             ##
6             ## This file is part of Net::DRI
7             ##
8             ## Net::DRI is free software; you can redistribute it and/or modify
9             ## it under the terms of the GNU General Public License as published by
10             ## the Free Software Foundation; either version 2 of the License, or
11             ## (at your option) any later version.
12             ##
13             ## See the LICENSE file that comes with this distribution for more details.
14             ####################################################################################################
15              
16             package Net::DRI::Protocol::EPP::Extensions::Nominet::Notifications;
17              
18 1     1   948 use strict;
  1         2  
  1         32  
19 1     1   4 use warnings;
  1         2  
  1         23  
20              
21 1     1   4 use Net::DRI::Util;
  1         1  
  1         18  
22 1     1   4 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         1369  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::EPP::Extensions::Nominet::Notifications - .UK EPP Notifications for Net::DRI
29              
30             =head1 DESCRIPTION
31              
32             Please see the README file for details.
33              
34             =head1 SUPPORT
35              
36             For now, support questions should be sent to:
37              
38             Enetdri@dotandco.comE
39              
40             Please also see the SUPPORT file in the distribution.
41              
42             =head1 SEE ALSO
43              
44             Ehttp://www.dotandco.com/services/software/Net-DRI/E
45              
46             =head1 AUTHOR
47              
48             Patrick Mevzek, Enetdri@dotandco.comE
49              
50             =head1 COPYRIGHT
51              
52             Copyright (c) 2008,2009,2013,2015 Patrick Mevzek .
53             (c) 2013 Michael Holloway .
54             All rights reserved.
55              
56             This program is free software; you can redistribute it and/or modify
57             it under the terms of the GNU General Public License as published by
58             the Free Software Foundation; either version 2 of the License, or
59             (at your option) any later version.
60              
61             See the LICENSE file that comes with this distribution for more details.
62              
63             =cut
64              
65             ####################################################################################################
66              
67             sub register_commands
68             {
69 0     0 0   my %tmp=( notification => [ undef, \&parse ] );
70 0           return { 'message' => \%tmp };
71             }
72              
73             ####################################################################################################
74              
75             # Contact::info_parse fails so we do a small parse here and create the contact object
76             sub parse_contact
77             {
78 0     0 0   my ($po,$data,$ns,$rinfo) = @_;
79 0 0         return unless $data;
80 0           my $nsc=$po->message()->ns('contact');
81 0           my $id = Net::DRI::Util::xml_child_content($data,$ns,'id');
82 0 0         return unless $id;
83 0           my $cont = $po->create_local_object('contact')->srid($id);
84 0           my $pi = {};
85 0           Net::DRI::Protocol::EPP::Util::parse_postalinfo($po,$data->getChildrenByTagNameNS($ns,'postalInfo')->shift(),$pi);
86 0           foreach ($cont->attributes()) {
87 0 0         next if $_ eq 'srid';
88 0           $cont->$_(Net::DRI::Util::xml_child_content($data,$ns,$_));
89 0 0         $cont->$_($pi->{$_}) if $pi->{$_};
90             }
91 0           return $cont;
92             }
93              
94             sub parse_domainlist
95             {
96 0     0 0   my ($po,$data,$ns,$rinfo) = @_;
97 0 0         return unless $data;
98 0           my @d;
99 0 0         return unless my $dl = $data->getChildrenByTagNameNS($ns,'domainListData')->shift();
100 0           foreach my $el (Net::DRI::Util::xml_list_children($dl))
101             {
102 0           my ($name,$c)=@$el;
103 0 0         push @d,$c->textContent() if $name eq 'domainName';
104             }
105 0           return \@d;
106             }
107              
108             sub parse_rcdomainlist
109             {
110 0     0 0   my ($po,$data,$ns,$rinfo) = @_;
111 0 0         return unless $data;
112 0           my $mes = $po->message();
113 0           my $nsd=$mes->ns('domain');
114 0 0         return unless my $dl =$data->getChildrenByTagNameNS($ns,'domainListData')->shift();
115 0           my (@d,$clid);
116 0           foreach my $d ($dl->getChildrenByTagNameNS($nsd,'infData'))
117             {
118 0           push @d,Net::DRI::Util::xml_child_content($d,$nsd,'name');
119 0           $clid=Net::DRI::Util::xml_child_content($d,$nsd,'clID');
120             ## TODO : parse other keys, using Domain::info_parse stuff extracted into some sort of parse_infdata
121             }
122 0           return ($clid,\@d);
123             }
124              
125             sub parse_hostlist
126             {
127 0     0 0   my ($po,$data,$ns,$rinfo) = @_;
128 0 0         return unless $data;
129 0           my @h;
130 0 0         return unless my $hl = $data->getChildrenByTagNameNS($ns,'hostListData')->shift();
131 0           foreach my $el (Net::DRI::Util::xml_list_children($hl))
132             {
133 0           my ($name,$c)=@$el;
134 0 0         next unless $name eq 'hostObj';
135 0           my $ho = $c->textContent();
136 0           $ho =~ s/\.$//; # remove trailing .
137 0           push @h,$ho;
138             }
139 0           return \@h;
140             }
141              
142             ####################################################################################################
143              
144             sub parse
145             {
146 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
147 0           my $mes=$po->message();
148 0 0         return unless $mes->is_success();
149 0           my $msgid=$oname=$mes->msg_id();
150 0 0 0       return unless (defined($msgid) && $msgid);
151              
152 0           my ($n,$nsstr,$data);
153 0           my %actions=(
154             hosts_cancelled => { n=>'hostCancData' },
155             contact_deleted => { n=>'contactDelData' },
156             registrar_change => { n=> 'rcData'}, # also handshake_request, changed later
157             registrant_change=> { n=> 'trnData'},
158             registrant_change_auth_request => { n=> 'trnAuthData'}, # should probably be dealt with as a handshake_request, but no change of Tag
159             domains_released => { n=> 'relData'}, # also handshake_rejected, changed later
160             domains_suspended => { n=> 'suspData'},
161             cancelled => { n=> 'cancData', ot=>'domain'},
162             fail => { n=> 'domainFailData', ot=>'domain'},
163             poor_quality => { n=> 'processData'},
164             abuse => { n=> 'infData', ns=>'nom-abuse-feed'},
165             #info => { n=> 'infData', ns =>'contact', ot => 'contact'},# this is processed correctly by contact::info_parse so dont need to do anything here
166             #create => {n => 'creData', ns => 'domain', 'ot => 'domain'}, # this is processed correctly by domain::create_parse so dont need to do anything here
167             );
168              
169 0           while (my ($ac, $nd) = each(%actions))
170             {
171 0           $n = $nd->{n};
172 0 0         $nsstr = ($nd->{ns})?$nd->{ns}:'std-notifications';
173 0 0         $otype = ($nd->{ot}) ? ($nd->{ot}):'message';
174 0 0 0       next unless ( ($data=$mes->get_response($nsstr,$n)) && (my $ns=$mes->ns($nsstr)));
175              
176             # abuse feed seems to come from an old Nominet EPP schema and has to be treated differently - this is likely to change some day
177 0 0         if ($ac eq 'abuse')
178             {
179 0           $oaction = $rinfo->{$otype}->{$oname}->{action}=$ac;
180 0           foreach my $f (qw/key activity source hostname url date ip nameserver dnsAdmin target wholeDomain/)
181 0           { $rinfo->{$otype}->{$oname}->{$f}=Net::DRI::Util::xml_child_content($data,$ns,$f); }
182 0           return;
183             }
184              
185             # set oname/exist for domain
186 0 0         if ($otype eq 'domain')
187             {
188 0           $oname=Net::DRI::Util::xml_child_content($data,$ns,'domainName');
189 0           $rinfo->{$otype}->{$oname}->{exist}=0;
190             }
191              
192             # action
193 0           $oaction = $rinfo->{$otype}->{$oname}->{action}=$ac;
194              
195             # plain text fields
196 0           $rinfo->{$otype}->{$oname}->{orig}=Net::DRI::Util::xml_child_content($data,$ns,'orig');
197 0           $rinfo->{$otype}->{$oname}->{reason}=Net::DRI::Util::xml_child_content($data,$ns,'reason');
198 0           $rinfo->{$otype}->{$oname}->{registrar_to}=Net::DRI::Util::xml_child_content($data,$ns,'registrarTag');
199 0           $rinfo->{$otype}->{$oname}->{contact} = Net::DRI::Util::xml_child_content($data,$ns,'contactId');
200 0           $rinfo->{$otype}->{$oname}->{account_from}=Net::DRI::Util::xml_child_content($data,$ns,'oldAccountId');
201 0           $rinfo->{$otype}->{$oname}->{account_to}=Net::DRI::Util::xml_child_content($data,$ns,'accountId');
202 0           $rinfo->{$otype}->{$oname}->{process_type} = Net::DRI::Util::xml_child_content($data,$ns,'processType');
203 0 0         $rinfo->{$otype}->{$oname}->{poor_quality_stage}=$data->getAttribute('stage') if $data->hasAttribute('stage');
204 0           $rinfo->{$otype}->{$oname}->{case_id}=Net::DRI::Util::xml_child_content($data,$ns,'caseId');
205              
206              
207             # relData (release/handshake rejected has account data)
208 0 0 0       if (($n eq 'relData') && (my $acid=$data->getChildrenByTagNameNS($ns,'accountId')->shift()))
209             {
210 0           $rinfo->{$otype}->{$oname}->{account_id}=$acid->textContent();
211 0 0         $rinfo->{$otype}->{$oname}->{action}='handshake_rejected' unless $acid->hasAttribute('moved'); # NOT VERIFIED - but since we don't have the message content we cant determine the action here
212 0 0         $rinfo->{$otype}->{$oname}->{account_moved}=$acid->getAttribute('moved') eq 'Y'? 1 : 0 if $acid->hasAttribute('moved');
    0          
213 0           $rinfo->{$otype}->{$oname}->{registrar_from}=Net::DRI::Util::xml_child_content($data,$ns,'from');
214             }
215              
216             # if casId then this is a handshake_request
217 0 0 0       if ( ($n eq 'rcData') && ($data->getChildrenByTagNameNS($ns,'caseId')->size()) )
218             {
219 0           $rinfo->{$otype}->{$oname}->{action}='handshake_request';
220 0           $rinfo->{$otype}->{$oname}->{case_id}=Net::DRI::Util::xml_child_content($data,$ns,'caseId');
221             }
222             # rcData return different data structures
223 0 0         ($rinfo->{$otype}->{$oname}->{registrar_from},$rinfo->{$otype}->{$oname}->{domains}) = parse_rcdomainlist($po,$data,$ns,$rinfo) if ($n eq 'rcData');
224              
225             # domain / host lists
226 0 0         $rinfo->{$otype}->{$oname}->{domains}=parse_domainlist($po,$data,$ns,$rinfo) unless ($n eq 'rcData');
227 0           $rinfo->{$otype}->{$oname}->{hosts}=parse_hostlist($po,$data,$ns,$rinfo);
228              
229             # contact data
230 0           my $nsc=$mes->ns('contact');
231 0 0         if (my $cont=parse_contact($po,$data->getChildrenByTagNameNS($nsc,'infData')->shift(),$nsc,$rinfo))
232             {
233 0           $rinfo->{$otype}->{$oname}->{contact}=$cont->srid();
234 0 0         $rinfo->{$otype}->{$oname}->{contact_data}=$cont if $n eq 'rcData';
235 0 0         $rinfo->{message}->{$msgid}->{poor_quality_account}=$cont if $n eq 'processData';
236             }
237              
238             # dates
239 0           my $d;
240 0 0 0       if ( ($d=$data->getChildrenByTagNameNS($ns,'cancelDate')) && ($d->size()) )
241             {
242 0 0         $rinfo->{$otype}->{$msgid}->{poor_quality_cancel}=$po->parse_iso8601($d->get_node(1)->textContent()) if $oaction eq 'poor_quality';
243 0           $rinfo->{$otype}->{$msgid}->{cancel_date}=$po->parse_iso8601($d->get_node(1)->textContent());
244             }
245 0 0 0       if ( ($d=$data->getChildrenByTagNameNS($ns,'suspendDate')) && ($d->size()) )
246             {
247 0           $rinfo->{$otype}->{$msgid}->{poor_quality_suspend}=$po->parse_iso8601($d->get_node(1)->textContent());
248             }
249              
250             # cleanup
251 0           my %onames = %{$rinfo->{$otype}->{$oname}};
  0            
252 0           foreach ( keys %onames)
253             {
254 0 0         delete $rinfo->{$otype}->{$oname}->{$_} unless defined $rinfo->{$otype}->{$oname}->{$_};
255             }
256             }
257 0           return;
258             }
259              
260              
261             sub ammed_account
262             {
263 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
264 0           my $mes=$po->message();
265 0 0         return unless $mes->is_success();
266 0           my $infdata=$mes->get_response('nom-abuse-feed','infData');
267 0 0         return unless defined $infdata;
268 0           return;
269             }
270              
271             ####################################################################################################
272             1;