File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/Keygroup.pm
Criterion Covered Total %
statement 12 114 10.5
branch 0 40 0.0
condition 0 12 0.0
subroutine 4 16 25.0
pod 0 12 0.0
total 16 194 8.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EURid/DNSBE Keygroup EPP Extension
2             ##
3             ## Copyright (c) 2010,2013-2014 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::Protocol::EPP::Extensions::Keygroup;
16              
17 1     1   698 use strict;
  1         1  
  1         22  
18 1     1   2 use warnings;
  1         1  
  1         18  
19              
20 1     1   3 use Net::DRI::Util;
  1         0  
  1         13  
21 1     1   3 use Net::DRI::Exception;
  1         1  
  1         1250  
22              
23             ####################################################################################################
24              
25             sub register_commands
26             {
27 0     0 0   my ($class,$version)=@_;
28 0           my %tmp=( create => [ \&create, undef ],
29             check => [ \&check, \&check_parse ],
30             info => [ \&info, \&info_parse ],
31             delete => [ \&delete, undef ],
32             update => [ \&update, undef ],
33             );
34              
35 0           $tmp{check_multi}=$tmp{check};
36 0           return { 'keygroup' => \%tmp };
37             }
38              
39 0     0 0   sub capabilities_add { return ('keygroup_update','keys',['set']); }
40              
41             sub setup
42             {
43 0     0 0   my ($class,$po,$version)=@_;
44 0           $po->ns({ 'keygroup' => [ 'http://www.eurid.eu/xml/epp/keygroup-1.0','keygroup-1.0.xsd' ] });
45 0           return;
46             }
47              
48             sub build_command
49             {
50 0     0 0   my ($epp,$msg,$command,$names)=@_;
51              
52 0           my @gn;
53 0 0         foreach my $h ( grep { defined } (ref $names eq 'ARRAY')? @$names : ($names))
  0            
54             {
55 0 0 0       Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid Keygroup name: '.$h) unless (defined $h && length $h && ! ref $h && Net::DRI::Util::xml_is_token($h,1,100));
      0        
      0        
56 0           push @gn,$h;
57             }
58              
59 0 0         Net::DRI::Exception->die(1,'protocol/EPP',2,'Keygroup name needed') unless @gn;
60              
61 0           $msg->command([$command,'keygroup:'.$command,sprintf('xmlns:keygroup="%s" xsi:schemaLocation="%s %s"',$msg->nsattrs('keygroup'))]);
62 0           return map { ['keygroup:name',$_] } @gn;
  0            
63             }
64              
65             ## The hash keys names are modeled on those used for the secDNS extension.
66             sub format_key
67             {
68 0     0 0   my $e=shift;
69              
70 0           my @mk=grep { ! Net::DRI::Util::has_key($e,$_) } qw/keyTag flags protocol alg pubKey/;
  0            
71 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Attributes missing: '.join(@mk)) if @mk;
72 0 0         Net::DRI::Exception::usererr_invalid_parameters('keyTag must be 16-bit unsigned integer: '.$e->{keyTag}) unless Net::DRI::Util::verify_ushort($e->{keyTag});
73 0 0         Net::DRI::Exception::usererr_invalid_parameters('flags mut be a 16-bit unsigned integer: '.$e->{flags}) unless Net::DRI::Util::verify_ushort($e->{flags});
74 0 0         Net::DRI::Exception::usererr_invalid_parameters('protocol must be an unsigned byte: '.$e->{protocol}) unless Net::DRI::Util::verify_ubyte($e->{protocol});
75 0 0         Net::DRI::Exception::usererr_invalid_parameters('alg must be an unsigned byte: '.$e->{alg}) unless Net::DRI::Util::verify_ubyte($e->{alg});
76 0 0         Net::DRI::Exception::usererr_invalid_parameters('pubKey must be a non empty base64 string: '.$e->{pubKey}) unless Net::DRI::Util::verify_base64($e->{pubKey},1);
77              
78 0           my @c;
79 0           push @c,['keygroup:keyTag',$e->{keyTag}];
80 0           push @c,['keygroup:flags',$e->{flags}];
81 0           push @c,['keygroup:protocol',$e->{protocol}];
82 0           push @c,['keygroup:algorithm',$e->{alg}];
83 0           push @c,['keygroup:pubKey',$e->{pubKey}];
84              
85 0           return @c;
86             }
87              
88             ####################################################################################################
89             ########### Query commands
90              
91             sub check
92             {
93 0     0 0   my ($epp,$names)=@_;
94 0           my $mes=$epp->message();
95 0           my @d=build_command($epp,$mes,'check',$names);
96 0           $mes->command_body(\@d);
97 0           return;
98             }
99              
100             sub check_parse
101             {
102 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
103 0           my $mes=$po->message();
104 0 0         return unless $mes->is_success();
105              
106 0           my $ns=$mes->ns('keygroup');
107 0           my $chkdata=$mes->get_response($ns,'chkData');
108 0 0         return unless defined $chkdata;
109              
110 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($ns,'cd'))
111             {
112 0           foreach my $el (Net::DRI::Util::xml_list_children($cd))
113             {
114 0           my ($n,$c)=@$el;
115 0 0         if ($n eq 'name')
116             {
117 0           my $kg=$c->textContent();
118 0           $rinfo->{keygroup}->{$kg}->{exist}=1-Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail'));
119 0           $rinfo->{keygroup}->{$kg}->{action}='check';
120             }
121             }
122             }
123 0           return;
124             }
125              
126             sub info
127             {
128 0     0 0   my ($epp,$name)=@_;
129 0           my $mes=$epp->message();
130 0           my @d=build_command($epp,$mes,'info',$name);
131 0           $mes->command_body(\@d);
132 0           return;
133             }
134              
135             sub info_parse
136             {
137 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
138 0           my $mes=$po->message();
139 0 0         return unless $mes->is_success();
140              
141 0           my $ns=$mes->ns('keygroup');
142 0           my $infdata=$mes->get_response($ns,'infData');
143 0 0         return unless defined $infdata;
144              
145 0           my @k;
146 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
147             {
148 0           my ($name,$c)=@$el;
149 0 0         if ($name eq 'name')
    0          
150             {
151 0           $oname=$c->textContent();
152 0           $rinfo->{keygroup}->{$oname}->{exist}=1;
153 0           $rinfo->{keygroup}->{$oname}->{action}='info';
154             } elsif ($name eq 'key')
155             {
156 0           push @k,{ keyTag => Net::DRI::Util::xml_child_content($c,$ns,'keyTag'),
157             flags => Net::DRI::Util::xml_child_content($c,$ns,'flags'),
158             protocol =>Net::DRI::Util::xml_child_content($c,$ns,'protocol') ,
159             alg => Net::DRI::Util::xml_child_content($c,$ns,'algorithm'),
160             pubKey => Net::DRI::Util::xml_child_content($c,$ns,'pubKey'),
161             };
162             }
163             }
164              
165 0           $rinfo->{keygroup}->{$oname}->{'keys'}=\@k;
166 0           return;
167             }
168              
169             ############ Transform commands
170              
171             sub create
172             {
173 0     0 0   my ($epp,$name,$rd)=@_;
174 0           my $mes=$epp->message();
175 0           my @d=build_command($epp,$mes,'create',$name);
176 0 0         if (Net::DRI::Util::has_key($rd,'keys'))
177             {
178 0 0         Net::DRI::Exception::usererr_invalid_parameters('secdns key must be a ref array') unless ref $rd->{'keys'} eq 'ARRAY';
179 0           foreach my $k (@{$rd->{'keys'}})
  0            
180             {
181 0           push @d,['keygroup:key',format_key($k)];
182             }
183             }
184 0           $mes->command_body(\@d);
185 0           return;
186             }
187              
188             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
189             {
190 0     0 0   my ($epp,$name)=@_;
191 0           my $mes=$epp->message();
192 0           my @d=build_command($epp,$mes,'delete',$name);
193 0           $mes->command_body(\@d);
194 0           return;
195             }
196              
197             sub update
198             {
199 0     0 0   my ($epp,$name,$todo,$rd)=@_;
200 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
201              
202 0 0 0       if ((grep { ! /^(?:keys)$/ } $todo->types()) || (grep { ! /^(?:set)$/ } $todo->types('keys') ))
  0            
  0            
203             {
204 0           Net::DRI::Exception->die(0,'protocol/EPP',11,'Only keys set available for keygroup');
205             }
206              
207 0           my $mes=$epp->message();
208 0           my @d=build_command($epp,$mes,'update',$name);
209 0           foreach my $k (@{$todo->set('keys')})
  0            
210             {
211 0           push @d,['keygroup:key',format_key($k)];
212             }
213 0           $mes->command_body(\@d);
214 0           return;
215             }
216              
217             ####################################################################################################
218             1;
219              
220             __END__