sub
register_commands {
my
(
$class
,
$version
) =
@_
;
my
$domain
= {
info
=> [
undef
, \
&domain_parse
],
create
=> [
undef
, \
&domain_parse
],
update
=> [ \
&domain_update
, \
&domain_parse
],
transfer_request
=> [ \
&domain_transfer
, \
&domain_transfer_parse
],
notifyDelete
=> [
undef
, \
&delete_parse
],
};
my
$contact
= {
info
=> [
undef
, \
&contact_parse
],
create
=> [ \
&contact_create
,
undef
],
update
=> [ \
&contact_update
,
undef
],
transfer_request
=> [
undef
, \
&contact_transfer_parse
],
};
my
$host
= {
info
=> [
undef
, \
&host_parse
],
transfer_request
=> [
undef
, \
&host_transfer_parse
],
};
my
%session
=(
'connect'
=> [
undef
, \
&parse_greeting
],
'noop'
=> [
undef
, \
&parse_greeting
],
);
return
{
'domain'
=>
$domain
,
'contact'
=>
$contact
,
'host'
=>
$host
,
session
=> \
%session
};
}
sub
capabilities_add {
return
( [
'domain_update'
,
'client_delete'
, [
'set'
, ] ], );
}
sub
find_node
{
my
(
$mes
,
$nstag
,
$nodename
)=
@_
;
my
$node
=
$mes
->node_resdata();
return
unless
defined
$node
;
my
$ns
=
$mes
->ns(
$nstag
);
$ns
=
$nstag
unless
defined
$ns
&&
$ns
;
my
@tmp
=
$node
->getElementsByTagNameNS(
$ns
,
$nodename
);
return
unless
@tmp
;
return
$tmp
[0];
}
sub
get_notify {
my
$mes
=
shift
;
my
$ns
=
$mes
->ns(
'iis'
);
return
'create'
if
defined
find_node(
$mes
,
$ns
,
'createNotify'
);
return
'update'
if
defined
find_node(
$mes
,
$ns
,
'updateNotify'
);
return
'delete'
if
defined
find_node(
$mes
,
$ns
,
'deleteNotify'
);
return
'transfer'
if
defined
find_node(
$mes
,
$ns
,
'transferNotify'
);
return
;
}
sub
domain_parse {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$mes
=
$po
->message();
return
unless
$mes
->is_success();
return
if
( ( !
defined
$otype
) || (
$otype
ne
'domain'
) );
my
$notify
= get_notify(
$mes
);
$rinfo
->{domain}->{
$oname
}->{notify} =
$notify
if
defined
$notify
;
my
$infData
=
$mes
->get_extension(
$mes
->ns(
'iis'
),
'infData'
);
return
unless
defined
$infData
;
foreach
my
$el
(
$infData
->getElementsByTagNameNS(
$mes
->ns(
'iis'
),
'delDate'
) ) {
$rinfo
->{domain}->{
$oname
}->{delDate} =
$po
->parse_iso8601(
$el
->textContent() );
}
foreach
my
$el
(
$infData
->getElementsByTagNameNS(
$mes
->ns(
'iis'
),
'deactDate'
) ) {
$rinfo
->{domain}->{
$oname
}->{deactDate} =
$po
->parse_iso8601(
$el
->textContent() );
}
foreach
my
$el
(
$infData
->getElementsByTagNameNS(
$mes
->ns(
'iis'
),
'relDate'
) ) {
$rinfo
->{domain}->{
$oname
}->{relDate} =
$po
->parse_iso8601(
$el
->textContent() );
}
foreach
my
$el
(
$infData
->getElementsByTagNameNS(
$mes
->ns(
'iis'
),
'state'
) ) {
$rinfo
->{domain}->{
$oname
}->{state} =
$el
->textContent();
}
foreach
my
$el
(
$infData
->getElementsByTagNameNS(
$mes
->ns(
'iis'
),
'clientDelete'
) ) {
$rinfo
->{domain}->{
$oname
}->{clientDelete} =
$el
->textContent();
}
return
;
}
sub
contact_parse {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$mes
=
$po
->message();
return
unless
$mes
->is_success();
return
if
( ( !
defined
$otype
) || (
$otype
ne
'contact'
) );
my
$notify
= get_notify(
$mes
);
$rinfo
->{contact}->{
$oname
}->{notify} =
$notify
if
defined
$notify
;
my
$result
=
$mes
->get_extension(
$mes
->ns(
'iis'
),
'infData'
);
return
unless
defined
$result
;
foreach
my
$el
(
$result
->getElementsByTagNameNS(
$mes
->ns(
'iis'
),
'orgno'
) ) {
$rinfo
->{contact}->{
$oname
}->{self}->orgno(
$el
->textContent() );
}
foreach
my
$el
(
$result
->getElementsByTagNameNS(
$mes
->ns(
'iis'
),
'vatno'
) ) {
$rinfo
->{contact}->{
$oname
}->{self}->vatno(
$el
->textContent() );
}
return
;
}
sub
host_parse {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$mes
=
$po
->message();
return
unless
$mes
->is_success();
return
if
( ( !
defined
$otype
) || (
$otype
ne
'host'
) );
my
$notify
= get_notify(
$mes
);
$rinfo
->{host}->{
$oname
}->{notify} =
$notify
if
defined
$notify
;
return
;
}
sub
domain_transfer_parse {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$mes
=
$po
->message();
return
unless
$mes
->is_success();
my
$trndata
= find_node(
$mes
,
$mes
->ns(
'domain'
),
'infData'
);
$trndata
= find_node(
$mes
,
$mes
->ns(
'domain'
),
'trnData'
)
if
!
defined
(
$trndata
);
return
unless
defined
$trndata
;
foreach
my
$el
(Net::DRI::Util::xml_list_children(
$trndata
))
{
my
(
$name
,
$c
)=
@$el
;
if
(
$name
eq
'name'
) {
$oname
=
$c
->textContent();
$rinfo
->{domain}->{
$oname
}->{action} =
'transfer'
;
$rinfo
->{domain}->{
$oname
}->{exist} = 1;
}
elsif
(
$name
=~ m/^(trStatus|reID|acID)$/ ) {
$rinfo
->{domain}->{
$oname
}->{$1} =
$c
->textContent();
}
elsif
(
$name
=~ m/^(reDate|acDate|exDate)$/ ) {
$rinfo
->{domain}->{
$oname
}->{$1} =
$po
->parse_iso8601(
$c
->textContent() );
}
}
my
$notify
= get_notify(
$mes
,
'domain_transfer_parse'
);
$rinfo
->{domain}->{
$oname
}->{notify} =
$notify
if
defined
$notify
;
return
;
}
sub
host_transfer_parse {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$mes
=
$po
->message();
return
unless
$mes
->is_success();
my
$trndata
= find_node(
$mes
,
$mes
->ns(
'host'
),
'infData'
);
$trndata
= find_node(
$mes
,
$mes
->ns(
'host'
),
'trnData'
)
if
!
defined
(
$trndata
);
return
unless
defined
$trndata
;
foreach
my
$el
(Net::DRI::Util::xml_list_children(
$trndata
))
{
my
(
$name
,
$c
)=
@$el
;
if
(
$name
eq
'name'
) {
$oname
=
$c
->textContent();
$rinfo
->{host}->{
$oname
}->{action} =
'transfer'
;
$rinfo
->{host}->{
$oname
}->{exist} = 1;
}
elsif
(
$name
=~ m/^(trStatus|reID|acID)$/ ) {
$rinfo
->{host}->{
$oname
}->{$1} =
$c
->textContent();
}
elsif
(
$name
=~ m/^(reDate|acDate|exDate)$/ ) {
$rinfo
->{host}->{
$oname
}->{$1} =
$po
->parse_iso8601(
$c
->textContent() );
}
}
my
$notify
= get_notify(
$mes
);
$rinfo
->{host}->{
$oname
}->{notify} =
$notify
if
defined
$notify
;
return
;
}
sub
contact_transfer_parse {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$mes
=
$po
->message();
return
unless
$mes
->is_success();
my
$trndata
= find_node(
$mes
,
$mes
->ns(
'contact'
),
'infData'
);
$trndata
= find_node(
$mes
,
$mes
->ns(
'contact'
),
'trnData'
)
if
!
defined
(
$trndata
);
return
unless
defined
$trndata
;
foreach
my
$el
(Net::DRI::Util::xml_list_children(
$trndata
))
{
my
(
$name
,
$c
)=
@$el
;
if
(
$name
eq
'id'
) {
$oname
=
$c
->textContent();
$rinfo
->{contact}->{
$oname
}->{action} =
'transfer'
;
$rinfo
->{contact}->{
$oname
}->{exist} = 1;
}
elsif
(
$name
=~ m/^(trStatus|reID|acID)$/ ) {
$rinfo
->{contact}->{
$oname
}->{$1} =
$c
->textContent();
}
elsif
(
$name
=~ m/^(reDate|acDate|exDate)$/ ) {
$rinfo
->{contact}->{
$oname
}->{$1} =
$po
->parse_iso8601(
$c
->textContent() );
}
}
my
$notify
= get_notify(
$mes
);
$rinfo
->{contact}->{
$oname
}->{notify} =
$notify
if
defined
$notify
;
return
;
}
sub
delete_parse {
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
) =
@_
;
my
$nametag
;
my
$mes
=
$po
->message();
return
unless
$mes
->is_success();
my
$notify
= get_notify(
$mes
);
return
if
( ( !
defined
$notify
) || ( (
$notify
ne
'delete'
) && (
$notify
ne
'transfer'
) ) );
my
$host
= find_node(
$mes
,
$mes
->ns(
'host'
),
'name'
);
if
(
defined
$host
) {
$oname
=
$host
->textContent();
$otype
=
'host'
;
}
my
$contact
= find_node(
$mes
,
$mes
->ns(
'contact'
),
'id'
);
if
(
defined
$contact
) {
$oname
=
$contact
->textContent();
$otype
=
'contact'
;
}
my
$domain
= find_node(
$mes
,
$mes
->ns(
'domain'
),
'name'
);
if
(
defined
$domain
) {
$oname
=
$domain
->textContent();
$otype
=
'domain'
;
}
$rinfo
->{
$otype
}->{
$oname
}->{notify} =
$notify
;
$rinfo
->{
$otype
}->{
$oname
}->{action} =
$notify
;
$rinfo
->{
$otype
}->{
$oname
}->{exist} = 0;
return
;
}
sub
domain_update {
my
(
$epp
,
$domain
,
$rd
) =
@_
;
my
@data
= ();
if
(
exists
$rd
->{client_delete} ) {
Net::DRI::Exception::usererr_invalid_parameters(
"client_delete can only be '1' or '0'"
)
if
(
$rd
->{client_delete}[2] !~ /^(0|1)$/ );
push
@data
, [
'iis:clientDelete'
,
$rd
->{client_delete}[2] ];
}
return
unless
@data
;
$epp
->message()->command_extension(
'iis'
, [
'update'
,
@data
]);
return
;
}
sub
domain_transfer {
my
(
$epp
,
$domain
,
$rd
) =
@_
;
my
@data
= ();
push
@data
, [
'iis:ns'
,
map
{ [
'iis:hostObj'
,
$_
] }
$rd
->{ns}->get_names() ]
if
Net::DRI::Util::has_ns(
$rd
);
return
unless
@data
;
$epp
->message()->command_extension(
'iis'
, [
'transfer'
,
@data
]);
return
;
}
sub
contact_create {
my
(
$epp
,
$contact
,
$rd
) =
@_
;
my
@data
= ();
my
$orgno
;
$orgno
=
$rd
->{orgno}
if
exists
(
$rd
->{orgno} );
$orgno
=
$contact
->{orgno}
if
exists
(
$contact
->{orgno} );
$orgno
=
$contact
->orgno
if
$contact
->can(
'orgno'
);
Net::DRI::Exception::usererr_insufficient_parameters(
'Attribute orgno must exist'
)
unless
defined
$orgno
;
push
@data
, [
'iis:orgno'
,
$orgno
];
my
$vatno
;
$vatno
=
$rd
->{orgno}
if
exists
(
$rd
->{vatno} );
$vatno
=
$contact
->{vatno}
if
exists
(
$contact
->{vatno} );
$vatno
=
$contact
->vatno
if
$contact
->can(
'vatno'
);
if
(
exists
(
$rd
->{vatno} ) &&
$vatno
) {
push
@data
, [
'iis:vatno'
,
$vatno
];
}
return
unless
@data
;
$epp
->message()->command_extension(
'iis'
, [
'create'
,
@data
]);
return
;
}
sub
contact_update {
my
(
$epp
,
$contact
,
$rd
) =
@_
;
my
@data
= ();
my
$newc
=
$rd
->set(
'info'
);
return
unless
defined
$newc
&&
ref
$newc
;
Net::DRI::Exception::usererr_insufficient_parameters(
'Attribute orgno can not be updated'
)
if
exists
(
$newc
->{orgno} );
if
(
exists
(
$newc
->{vatno} ) &&
defined
$newc
->{vatno} ) {
push
@data
, [
'iis:vatno'
,
$newc
->{vatno} ];
}
return
unless
@data
;
$epp
->message()->command_extension(
'iis'
, [
'update'
,
@data
]);
return
;
}
sub
parse_greeting
{
my
(
$po
,
$otype
,
$oaction
,
$oname
,
$rinfo
)=
@_
;
my
$mes
=
$po
->message();
return
unless
defined
$mes
->node_greeting();
$po
->switch_to_highest_namespace_version(
'iis'
);
return
;
}
1;