diff --git a/MANIFEST b/MANIFEST index 3032b0b1..2f704cc4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -45,6 +45,7 @@ lib/Net/DRI/Data/Contact/JOBS.pm lib/Net/DRI/Data/Contact/JP.pm lib/Net/DRI/Data/Contact/LU.pm lib/Net/DRI/Data/Contact/LV.pm +lib/Net/DRI/Data/Contact/NameAction.pm lib/Net/DRI/Data/Contact/Neustar.pm lib/Net/DRI/Data/Contact/NO.pm lib/Net/DRI/Data/Contact/Nominet.pm @@ -127,6 +128,7 @@ lib/Net/DRI/DRD/IRegistry.pm lib/Net/DRI/DRD/ISPAPI.pm lib/Net/DRI/DRD/KNET.pm lib/Net/DRI/DRD/LVRegistry.pm +lib/Net/DRI/DRD/NameAction.pm lib/Net/DRI/DRD/NASK.pm lib/Net/DRI/DRD/Neustar/IN.pm lib/Net/DRI/DRD/Neustar/Narwhal.pm @@ -509,6 +511,10 @@ lib/Net/DRI/Protocol/IRIS/LWZ.pm lib/Net/DRI/Protocol/IRIS/Message.pm lib/Net/DRI/Protocol/IRIS/XCP.pm lib/Net/DRI/Protocol/Message.pm +lib/Net/DRI/Protocol/NameAction.pm +lib/Net/DRI/Protocol/NameAction/Connection.pm +lib/Net/DRI/Protocol/NameAction/Domain.pm +lib/Net/DRI/Protocol/NameAction/Message.pm lib/Net/DRI/Protocol/OpenSRS/XCP.pm lib/Net/DRI/Protocol/OpenSRS/XCP/Account.pm lib/Net/DRI/Protocol/OpenSRS/XCP/Connection.pm @@ -739,6 +745,7 @@ t/Net/DRI/Protocol/EPP/Extensions/ZACR.t t/Net/DRI/Protocol/EPP/Message.t t/Net/DRI/Protocol/EPP/OnlyLocalExtensions.t t/Net/DRI/Protocol/Message.t +t/Net/DRI/Protocol/NameAction.t t/Net/DRI/Protocol/OpenSRS/XCP.t t/Net/DRI/Protocol/ResultStatus.t t/Net/DRI/Protocol/RRI.t diff --git a/lib/Net/DRI/DRD/NameAction.pm b/lib/Net/DRI/DRD/NameAction.pm new file mode 100644 index 00000000..1dce8c05 --- /dev/null +++ b/lib/Net/DRI/DRD/NameAction.pm @@ -0,0 +1,193 @@ +## Domain Registry Interface, NameAction Registry Driver +## +## Copyright (c) 2022 Paulo Castanheira . All rights reserved. +## +## This file is part of Net::DRI +## +## Net::DRI is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## See the LICENSE file that comes with this distribution for more details. +#################################################################################################### + +package Net::DRI::DRD::NameAction; + +use strict; +use warnings; + +use base qw/Net::DRI::DRD/; + +use DateTime::Duration; +use Net::DRI::Util; + +=pod + +=head1 NAME + +Net::DRI::DRD::NameAction - NameAction Registry driver for Net::DRI + +=head1 DESCRIPTION + +Please see the README file for details. + +=head1 SUPPORT + +For now, support questions should be sent to: + +Epaulo.s.castanheira@gmail.comE + +Please also see the SUPPORT file in the distribution. + +=head1 SEE ALSO + +Ehttp://www.dotandco.com/services/software/Net-DRI/E + +=head1 AUTHOR + +Paulo Castanheira, Epaulo.s.castanheira@gmail.comE + +=head1 COPYRIGHT + +Copyright (c) 2022 Paulo Castanheira . +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +See the LICENSE file that comes with this distribution for more details. + +=cut + +#################################################################################################### + +sub new +{ + my $class=shift; + my $self=$class->SUPER::new(@_); + return $self; +} + +sub periods { return map { DateTime::Duration->new(years => $_) } (1..10); } +sub name { return 'NameAction'; } +sub tlds { + my @tlds = qw/ae aero ag ai al am app ar art as asia at attorney aw az ba bb be bg bh bi bike biz bo bs by bz ca cam cc cd ch ci cl cloud club cm cn co com company coop cr cu cv cz de diamonds digital dj dk dm do domains dz ec edu ee equipment es eu farm fashion fi film fit fm fo fr futbol ga gd ge gf gg gi gl global gp gq gr group gs gt guru gy hk hn hr ht hu id in info international investments io ir is it jewelry jo jobs jp ki kn kr kz la lat law lawyer lc legal li life link lk love lt ltda lu lv ly ma madrid market marketing md me mg mk mn mobi moda mp mq ms mt museum mx my name net network ni nl no online org pa pe pet ph pk pl pr pro pt pw qa racing ro rocks rs ru rw sc sd se services sg shop si site sk ski sm sn solutions soy sr st store su support sv sx systems tc tech technology tel tg tienda tj tk tl tn to tools top trade travel tt tv tw ua uk uno us uy vacations vc vg vi vin vn watch website wedding win wine ws xxx/; + + my @ag = map {"$_.ag"} qw/co com net/; + my @ai = map {"$_.ai"} qw/com net/; + my @al = map {"$_.al"} qw/com/; + my @ao = map {"$_.ao"} qw/co it/; + my @ar = map {"$_.ar"} qw/com int net org tur/; + my @at = map {"$_.at"} qw/co/; + my @au = map {"$_.au"} qw/com/; + my @aw = map {"$_.aw"} qw/com/; + my @az = map {"$_.az"} qw/com/; + my @ba = map {"$_.ba"} qw/co/; + my @bd = map {"$_.bd"} qw/com/; + my @bh = map {"$_.bh"} qw/com/; + my @bo = map {"$_.bo"} qw/com int net org/; + my @br = map {"$_.br"} qw/abc adm adv agr aju am aparecida app arq art b belem bhz bib blog boavista bsb campinas caxias cim cnt com contagem coz cuiaba curitiba des det dev eco emp enf eng esp etc far flog floripa fm fortal foz geo goiania gru imb ind inf jab jampa jdf joinville log londrina macapa maceio manaus maringa med natal net niteroi odo ong org osasco palmas poa ppg pro psi radio rec recife rep ribeirao rio riobranco salvador sampa saobernardo seg sjc slz sorocaba srv tec teo the tmp tur tv udi vix vlog wiki/; + my @bs = map {"$_.bs"} qw/com net org/; + my @bw = map {"$_.bw"} qw/co/; + my @bz = map {"$_.bz"} qw/com net/; + my @ci = map {"$_.ci"} qw/co/; + my @cn = map {"$_.cn"} qw/bj com net org/; + my @co = map {"$_.co"} qw/com edu net nom org/; + my @com = map {"$_.com"} qw/br cn us/; + my @cr = map {"$_.cr"} qw/co fi or/; + my @cu = map {"$_.cu"} qw/com net/; + my @cv = map {"$_.cv"} qw/com/; + my @cw = map {"$_.cw"} qw/com/; + my @cy = map {"$_.cy"} qw/com/; + my @de = map {"$_.de"} qw/com/; + my @dk = map {"$_.dk"} qw/co/; + my @dm = map {"$_.dm"} qw/co/; + my @do = map {"$_.do"} qw/com net org web/; + my @dz = map {"$_.dz"} qw/com/; + my @ec = map {"$_.ec"} qw/com fin info net org/; + my @ee = map {"$_.ee"} qw/co/; + my @eg = map {"$_.eg"} qw/com/; + my @es = map {"$_.es"} qw/com/; + my @fj = map {"$_.fj"} qw/com/; + my @ge = map {"$_.ge"} qw/com/; + my @gh = map {"$_.gh"} qw/com/; + my @gn = map {"$_.gn"} qw/com/; + my @gp = map {"$_.gp"} qw/com/; + my @gr = map {"$_.gr"} qw/com/; + my @gt = map {"$_.gt"} qw/com ind net org/; + my @gy = map {"$_.gy"} qw/co com net/; + my @hk = map {"$_.hk"} qw/com/; + my @hn = map {"$_.hn"} qw/com net org/; + my @hr = map {"$_.hr"} qw/com/; + my @hu = map {"$_.hu"} qw/co/; + my @id = map {"$_.id"} qw/co web/; + my @il = map {"$_.il"} qw/co/; + my @in = map {"$_.in"} qw/co net/; + my @ir = map {"$_.ir"} qw/co/; + my @it = map {"$_.it"} qw/co/; + my @jm = map {"$_.jm"} qw/com net org/; + my @jo = map {"$_.jo"} qw/com/; + my @jp = map {"$_.jp"} qw/co gr ne/; + my @ke = map {"$_.ke"} qw/co info/; + my @ki = map {"$_.ki"} qw/com/; + my @kn = map {"$_.kn"} qw/co com net org/; + my @kr = map {"$_.kr"} qw/co ne or/; + my @kw = map {"$_.kw"} qw/com/; + my @ly = map {"$_.ly"} qw/com/; + my @ma = map {"$_.ma"} qw/co/; + my @mk = map {"$_.mk"} qw/com/; + my @mt = map {"$_.mt"} qw/com/; + my @mx = map {"$_.mx"} qw/com org/; + my @my = map {"$_.my"} qw/com/; + my @mz = map {"$_.mz"} qw/co/; + my @na = map {"$_.na"} qw/com/; + my @ng = map {"$_.ng"} qw/com/; + my @ni = map {"$_.ni"} qw/ac biz co com edu in info int net nom org pp web/; + my @nl = map {"$_.nl"} qw/co/; + my @no = map {"$_.no"} qw/co/; + my @nz = map {"$_.nz"} qw/co/; + my @om = map {"$_.om"} qw/co com/; + my @pa = map {"$_.pa"} qw/com org/; + my @pe = map {"$_.pe"} qw/com net nom org/; + my @pk = map {"$_.pk"} qw/com/; + my @pl = map {"$_.pl"} qw/com/; + my @pr = map {"$_.pr"} qw/com net org/; + my @pt = map {"$_.pt"} qw/co com/; + my @py = map {"$_.py"} qw/com coop net org/; + my @qa = map {"$_.qa"} qw/com/; + my @ro = map {"$_.ro"} qw/co com/; + my @ru = map {"$_.ru"} qw/com net org/; + my @sg = map {"$_.sg"} qw/com/; + my @sn = map {"$_.sn"} qw/com/; + my @sv = map {"$_.sv"} qw/com org/; + my @th = map {"$_.th"} qw/co/; + my @tr = map {"$_.tr"} qw/com/; + my @tt = map {"$_.tt"} qw/biz co com info name net org pro/; + my @tw = map {"$_.tw"} qw/com/; + my @ua = map {"$_.ua"} qw/co com/; + my @uk = map {"$_.uk"} qw/co org/; + my @uy = map {"$_.uy"} qw/com edu net org/; + my @uz = map {"$_.uz"} qw/co/; + my @ve = map {"$_.ve"} qw/arts co com firm info int net nom org rec store web/; + my @vi = map {"$_.vi"} qw/co com net/; + my @vn = map {"$_.vn"} qw/com/; + my @za = map {"$_.za"} qw/co/; + + return @tlds,@ag,@ai,@al,@ao,@ar,@at,@au,@aw,@az,@ba,@bd,@bh,@bo,@br,@bs,@bw,@bz,@ci,@cn,@co,@com,@cr,@cu,@cv,@cw,@cy,@de,@dk,@dm,@do,@dz,@ec,@ee,@eg,@es,@fj,@ge,@gh,@gn,@gp,@gr,@gt,@gy,@hk,@hn,@hr,@hu,@id,@il,@in,@ir,@it,@jm,@jo,@jp,@ke,@ki,@kn,@kr,@kw,@ly,@ma,@mk,@mt,@mx,@my,@mz,@na,@ng,@ni,@nl,@no,@nz,@om,@pa,@pe,@pk,@pl,@pr,@pt,@py,@qa,@ro,@ru,@sg,@sn,@sv,@th,@tr,@tt,@tw,@ua,@uk,@uy,@uz,@ve,@vi,@vn,@za; +} +sub object_types { return ('domain'); } +sub profile_types { return qw/nameaction/; } + +sub transport_protocol_default +{ + my ($self,$type)=@_; + + return ('Net::DRI::Transport::HTTP',{},'Net::DRI::Protocol::NameAction',{}) if $type eq 'nameaction'; + return; +} + +#################################################################################################### +1; diff --git a/lib/Net/DRI/Data/Contact/NameAction.pm b/lib/Net/DRI/Data/Contact/NameAction.pm new file mode 100644 index 00000000..b3aa4877 --- /dev/null +++ b/lib/Net/DRI/Data/Contact/NameAction.pm @@ -0,0 +1,118 @@ +## Domain Registry Interface, Handling of contact data for NameAction +## +## Copyright (c) 2022 Paulo Castanheira . All rights reserved. +## +## This file is part of Net::DRI +## +## Net::DRI is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## See the LICENSE file that comes with this distribution for more details. +#################################################################################################### + +package Net::DRI::Data::Contact::NameAction; + +use strict; +use warnings; + +use base qw/Net::DRI::Data::Contact/; + +__PACKAGE__->register_attributes(); + +=pod + +=head1 NAME + +Net::DRI::Data::Contact::NameAction - Handle NameAction contact data for Net::DRI + +=head1 DESCRIPTION + +This subclass of Net::DRI::Data::Contact adds validation for +NameAction specific data. + +=head1 SUPPORT + +For now, support questions should be sent to: + +Epaulo.s.castanheira@gmail.comE + +Please also see the SUPPORT file in the distribution. + +=head1 SEE ALSO + +http://www.dotandco.com/services/software/Net-DRI/ + +=head1 AUTHOR + +Paulo Castanheira Epaulo.s.castanheira@gmail.comE + +=head1 COPYRIGHT + +Copyright (c) 2022 Paulo Castanheira . +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +See the LICENSE file that comes with this distribution for more details. + +=cut + +#################################################################################################### + +sub validate +{ + my ($self,$change)=@_; + $change||=0; + my @errs; + + if (!$change) + { + my @missing=grep { my $r=scalar $self->$_(); (defined $r && length $r)? 0 : 1 } qw/name org city cc pc voice email/; + Net::DRI::Exception::usererr_insufficient_parameters('Mandatory contact information missing: '.join('/',@missing)) if @missing; + } + + push @errs,'name' if ($self->name() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,1,255) } ($self->name())); + push @errs,'org' if ($self->org() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,undef,255) } ($self->org())); + + my @rs=($self->street()); + foreach my $i (0,1) + { + next unless defined $rs[$i]; + push @errs,'street' if ((ref($rs[$i]) ne 'ARRAY') || (@{$rs[$i]} > 3) || (grep { !Net::DRI::Util::xml_is_normalizedstring($_,undef,255) } @{$rs[$i]})); + } + + push @errs,'city' if ($self->city() && grep { !Net::DRI::Util::xml_is_normalizedstring($_,1,255) } ($self->city())); + push @errs,'pc' if ($self->pc() && grep { !Net::DRI::Util::xml_is_token($_,undef,16) } ($self->pc())); + push @errs,'cc' if ($self->cc() && grep { !Net::DRI::Util::xml_is_token($_,2,2) } ($self->cc())); + push @errs,'cc' if ($self->cc() && grep { !exists($Net::DRI::Util::CCA2{uc($_)}) } ($self->cc())); + + push @errs,'voice' if ($self->voice() && ! ($self->voice()=~m/^[0-9]{1,3}\.[0-9]{1,14}(?:x\d+)?$/)); + push @errs,'email' if ($self->email() && ! (Net::DRI::Util::xml_is_token($self->email(),1,undef) && Email::Valid->rfc822($self->email()))); + + ## Nothing checked for disclose + + Net::DRI::Exception::usererr_invalid_parameters('Invalid contact information: '.join('/',@errs)) if @errs; + + return 1; ## everything ok. +} + +#sub init +#{ +# my ($self,$what,$ndr)=@_; +# +# if ($what eq 'create') +# { +# $self->srid('auto') unless defined($self->srid()); ## we can not choose the ID +# my $a=$self->auth(); +# $self->auth({pw=>''}) unless ($a && (ref($a) eq 'HASH') && exists($a->{pw})); +# } +# return; +#} + +#################################################################################################### +1; diff --git a/lib/Net/DRI/Protocol/NameAction.pm b/lib/Net/DRI/Protocol/NameAction.pm new file mode 100644 index 00000000..7600be82 --- /dev/null +++ b/lib/Net/DRI/Protocol/NameAction.pm @@ -0,0 +1,94 @@ +## Domain Registry Interface, NameAction Protocol +## +## Copyright (c) 2022 Paulo Castanheira . All rights reserved. +## +## This file is part of Net::DRI +## +## Net::DRI is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## See the LICENSE file that comes with this distribution for more details. +#################################################################################################### + +package Net::DRI::Protocol::NameAction;; + +use strict; +use warnings; + +use base qw(Net::DRI::Protocol); + +use Net::DRI::Protocol::NameAction::Message; +use Net::DRI::Data::Contact::NameAction; +use Net::DRI::Protocol::NameAction::Status; + +=pod + +=head1 NAME + +Net::DRI::Protocol::NameAction - NameAction Protocol for Net::DRI + +=head1 DESCRIPTION + +Please see the README file for details. + +=head1 SUPPORT + +For now, support questions should be sent to: + +Epaulo.s.castanheira@gmail.comE + +Please also see the SUPPORT file in the distribution. + +=head1 AUTHOR + +Paulo Castanheira, Epaulo.s.castanheira@gmail.comE + +=head1 COPYRIGHT + +Copyright (c) 2022 Paulo Castanheira . +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +See the LICENSE file that comes with this distribution for more details. + +=cut + +#################################################################################################### + +sub new +{ + my ($c,$ctx,$rp)=@_; + my $drd=$ctx->{registry}->driver(); + my $self=$c->SUPER::new($ctx); + $self->name('nameaction'); + $self->version('1.0.4'); + $self->factories('message',sub { return Net::DRI::Protocol::NameAction::Message->new(); }); + $self->factories('contact',sub { return Net::DRI::Data::Contact::NameAction->new(); }); + $self->factories('status',sub { return Net::DRI::Protocol::NameAction::Status->new(); }); + $self->capabilities('domain_update','contact',['set']); + $self->capabilities('domain_update','ns',['set']); + $self->_load($rp); + return $self; +} + +sub _load +{ + my ($self,$rp)=@_; + my @class=map { 'Net::DRI::Protocol::NameAction::'.$_ } (qw/Domain/); + return $self->SUPER::_load(@class); +} + +sub transport_default +{ + my ($self)=@_; + return (protocol_connection => 'Net::DRI::Protocol::NameAction::Connection', protocol_version => '1.0'); +} + +#################################################################################################### +1; diff --git a/lib/Net/DRI/Protocol/NameAction/Connection.pm b/lib/Net/DRI/Protocol/NameAction/Connection.pm new file mode 100644 index 00000000..4776a728 --- /dev/null +++ b/lib/Net/DRI/Protocol/NameAction/Connection.pm @@ -0,0 +1,111 @@ +## Domain Registry Interface, NameAction Connection handling +## +## Copyright (c) 2022 Paulo Castanheira . All rights reserved. +## +## This file is part of Net::DRI +## +## Net::DRI is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## See the LICENSE file that comes with this distribution for more details. +#################################################################################################### + +package Net::DRI::Protocol::NameAction::Connection; + +use strict; +use warnings; + +use Digest::MD5 (); +use HTTP::Request (); +use URI; + +use Net::DRI::Util; +use Net::DRI::Exception; +use Net::DRI::Data::Raw; +use Net::DRI::Protocol::ResultStatus; + +=pod + +=head1 NAME + +Net::DRI::Protocol::NameAction::Connection - NameAction Connection handling for Net::DRI + +=head1 DESCRIPTION + +Please see the README file for details. + +=head1 SUPPORT + +For now, support questions should be sent to: + +Epaulo.s.castanheira@gmail.comE + +Please also see the SUPPORT file in the distribution. + +=head1 AUTHOR + +Paulo Castanheira, Epaulo.s.castanheira@gmail.comE + +=head1 COPYRIGHT + +Copyright (c) 2022 Paulo Castanheira . +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +See the LICENSE file that comes with this distribution for more details. + +=cut + +#################################################################################################### + +sub init +{ + my ($class,$to)=@_; + my $t=$to->transport_data(); + foreach my $p (qw/client_login client_password remote_url/) + { + Net::DRI::Exception::usererr_insufficient_parameters($p.' must be defined') unless (exists($t->{$p}) && $t->{$p}); + } + return; +} + +## From Protocol Message object to something suitable for transport (various types) +sub write_message +{ + my ($class,$to,$msg)=@_; + my $url = build_url(@_); + my $req=HTTP::Request->new('POST',$url); + $req->header('Content-Type','text/xml'); + $req->content(''); + return $req; +} + +sub build_url +{ + my ($class,$to,$msg)=@_; + my $t=$to->transport_data(); + + my $uri = URI->new($t->{remote_url}); + $uri->query_form( User => $t->{client_login}, + Pass => $t->{client_password}, + @{$msg->command()} + ); + return $uri->as_string(); +} + +## From transport (various types) to Net::DRI::Data::Raw object (which will be parsed inside Protocol::reaction) +sub read_data +{ + my ($class,$to,$res)=@_; + die(Net::DRI::Protocol::ResultStatus->new_error('COMMAND_FAILED_CLOSING',sprintf('Got unsuccessfull HTTP response: %d %s',$res->code(),$res->message()),'en')) unless $res->is_success(); + return Net::DRI::Data::Raw->new_from_xmlstring($res->decoded_content()); +} + +#################################################################################################### +1; diff --git a/lib/Net/DRI/Protocol/NameAction/Domain.pm b/lib/Net/DRI/Protocol/NameAction/Domain.pm new file mode 100644 index 00000000..4815c07e --- /dev/null +++ b/lib/Net/DRI/Protocol/NameAction/Domain.pm @@ -0,0 +1,385 @@ +## Domain Registry Interface, NameAction Domain commands +## +## Copyright (c) 2022 Paulo Castanheira . All rights reserved. +## +## This file is part of Net::DRI +## +## Net::DRI is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## See the LICENSE file that comes with this distribution for more details. +#################################################################################################### + +package Net::DRI::Protocol::NameAction::Domain; + +use strict; +use warnings; + +use Net::DRI::Exception; +use Net::DRI::Util; +use URI; + +=pod + +=head1 NAME + +Net::DRI::Protocol::NameAction::Domain - NameAction Domain commands for Net::DRI + +=head1 DESCRIPTION + +Please see the README file for details. + +=head1 SUPPORT + +For now, support questions should be sent to: + +Epaulo.s.castanheira@gmail.comE + +Please also see the SUPPORT file in the distribution. + +=head1 AUTHOR + +Paulo Castanheira, Epaulo.s.castanheira@gmail.comE + +=head1 COPYRIGHT + +Copyright (c) 2022 Paulo Castanheira . +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +See the LICENSE file that comes with this distribution for more details. + +=cut + +#################################################################################################### + +sub register_commands +{ + my ($class,$version)=@_; + my %tmp=( + check => [\&check, \&parse ], + create => [ \&create, \&parse ], + renew => [ \&renew, \&parse ], + update => [\&update, \&parse], # Modify + transfer_request => [ \&transfer_request, \&parse ], + trade_request => [ \&trade_request, \&parse ], + delete => [ \&delete, \&parse ], + info => [\&info, \&info_parse ], + ); + + return { 'domain' => \%tmp }; +} + +sub check +{ + my ($nma,$domain,$rd)=@_; + my $msg=$nma->message(); + my @attrs; + push @attrs,_build_domain($domain); + my $cmd = _build_command($msg,'check',\@attrs); + $msg->command($cmd); + return; +} + +sub parse +{ + my ($nma,$otype,$oaction,$oname,$rinfo)=@_; + my $mes=$nma->message(); + return unless $mes->is_success(); + +#use Data::Dumper;print Dumper( $mes); + $rinfo->{domain}->{$oname}->{action}=$oaction; + $rinfo->{domain}->{$oname}->{exist}=$oaction eq 'check'?($mes->response_code() ? 0 : 1):1; + return; +} + + + +sub create +{ + my ($nma,$domain,$rd)=@_; + my @attrs; + push @attrs,_build_domain($domain); + + Net::DRI::Exception::usererr_insufficient_parameters('duration is mandatory') unless Net::DRI::Util::has_duration($rd); + push @attrs, _build_duration($rd->{duration}->years()); + + Net::DRI::Exception::usererr_insufficient_parameters('contacts are mandatory') unless Net::DRI::Util::has_contact($rd); + foreach my $type (qw/registrant admin tech/) + { + my $co=$rd->{contact}->get($type); + Net::DRI::Exception::usererr_insufficient_parameters($type . ' contact is mandatory') unless Net::DRI::Util::isa_contact($co); + push @attrs,_build_contact($co,$type); + } + + Net::DRI::Exception::usererr_insufficient_parameters('at least 2 nameservers are mandatory') unless Net::DRI::Util::isa_hosts($rd->{ns}) && $rd->{ns}->count()>=2; # Name servers are optional; if present must be >=2 + push @attrs, _build_all_ns($rd->{ns}); + + if ( exists $rd->{info_pl} ) { + push @attrs,_build_info_pl( $rd->{info_pl} ); + } + + my $msg=$nma->message(); + my $cmd = _build_command($msg,'create',\@attrs); + $msg->command($cmd); + return; +} + +sub renew +{ + my ($nma,$domain,$rd)=@_; + my @attrs; + + push @attrs,_build_domain($domain); + + Net::DRI::Exception::usererr_insufficient_parameters('duration is mandatory') unless Net::DRI::Util::has_duration($rd); + push @attrs, _build_duration($rd->{duration}->years()); + + my $msg=$nma->message(); + my $cmd = _build_command($msg,'renew',\@attrs); + $msg->command($cmd); + return; +} + +sub update +{ + my ($nma,$domain,$rd)=@_; + my @attrs; + + push @attrs,_build_domain($domain); + + Net::DRI::Exception::usererr_invalid_parameters($rd.' must be a non empty Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($rd); + my $cs=$rd->set('contact'); + Net::DRI::Exception::usererr_invalid_parameters('contact changes for set must be a Net::DRI::Data::ContactSet') unless defined($cs) && Net::DRI::Util::isa_contactset($cs); + + foreach my $type (qw/registrant admin tech/) + { + my $co=$cs->get($type); + next if !$co; + Net::DRI::Exception::usererr_insufficient_parameters($co.' is not a '.$type.' contact') unless Net::DRI::Util::isa_contact($co); + push @attrs,_build_contact($co,$type); + } + + if ( my $ns=$rd->set('ns') ) + { + Net::DRI::Exception::usererr_invalid_parameters('ns changes for set must be a Net::DRI::Data::Hosts object') unless Net::DRI::Util::isa_hosts($ns); + push @attrs, _build_all_ns($ns); + } + + my $msg=$nma->message(); + my $cmd = _build_command($msg,'modify',\@attrs); + $msg->command($cmd); + return; +} + +sub info +{ + my ($nma,$domain,$rd)=@_; + my @attrs; + + push @attrs,_build_domain($domain); + + my $msg=$nma->message(); + my $cmd = _build_command($msg,'info',\@attrs); + $msg->command($cmd); + return; +} + +sub info_parse +{ + my ($nma,$otype,$oaction,$oname,$rinfo)=@_; + my $mes=$nma->message(); + return unless $mes->is_success(); + + $rinfo->{domain}->{$oname}->{action}=$oaction; + $rinfo->{domain}->{$oname}->{exist}=$mes->response_code() == 1000 ? 1 : 0; + + my $ra = $mes->response_attributes(); + my $cts=$ra->{contacts}; + if (defined($cts) && ref($cts) && keys(%$cts)) + { + my $cs=$nma->create_local_object('contactset'); + foreach my $type (keys %$cts) { + my $c=$nma->create_local_object('contact'); + $c->name($cts->{$type}); + $cs->add($c,$type); + } + $rinfo->{domain}->{$oname}->{contact}=$cs; + } + + my $ns=$ra->{hosts}; + if (defined($ns) && ref($ns) && @$ns) + { + my $nso=$nma->create_local_object('hosts'); + foreach my $h (@$ns) + { + $nso->add($h->[0],[$h->[1]]); + } + $rinfo->{domain}->{$oname}->{ns}=$nso; + } + + my $strp=$nma->build_strptime_parser(pattern => '%F %T'); + $rinfo->{domain}->{$oname}->{exDate}=$strp->parse_datetime($ra->{expiry_date}); + $rinfo->{domain}->{$oname}->{status}=$nma->create_local_object('status')->add($ra->{status}); +} + +sub delete +{ + my ($nma,$domain,$rd)=@_; + my @attrs; + + push @attrs,_build_domain($domain); + + my $msg=$nma->message(); + my $cmd = _build_command($msg,'delete',\@attrs); + $msg->command($cmd); + return; +} + +sub transfer_request +{ + my ($nma,$domain,$rd)=@_; + my @attrs; + + push @attrs,_build_type('management'); + push @attrs,_build_domain($domain); + + if (Net::DRI::Util::has_auth($rd)) { + Net::DRI::Exception::usererr_insufficient_parameters('registrant contact is mandatory') unless Net::DRI::Util::has_key($rd->{auth},'pw'); + push @attrs, _build_auth($rd->{auth}{pw}); + } + + my $msg=$nma->message(); + my $cmd = _build_command($msg,'transfer',\@attrs); + $msg->command($cmd); + return; +} + + +sub trade_request +{ + my ($nma,$domain,$rd)=@_; + my @attrs; + + push @attrs,_build_type('owner'); + push @attrs,_build_domain($domain); + + Net::DRI::Exception::usererr_insufficient_parameters('registrant contact is mandatory') unless Net::DRI::Util::has_contact($rd) && Net::DRI::Util::isa_contact($rd->{contact}->get('registrant')); + + foreach my $type (qw/registrant admin tech/) + { + my $co=$rd->{contact}->get($type); + next if !$co; + Net::DRI::Exception::usererr_insufficient_parameters($co.' is not a '.$type.' contact') unless Net::DRI::Util::isa_contact($co); + push @attrs,_build_contact($co,$type); + } + + if ( Net::DRI::Util::has_ns($rd) ) + { + push @attrs, _build_all_ns($rd->{ns}); + } + + my $msg=$nma->message(); + my $cmd = _build_command($msg,'transfer',\@attrs); + $msg->command($cmd); + return; +} + +sub _build_domain +{ + my ($domain) = @_; + Net::DRI::Exception->die(1,'NameAction/Domain',2,'Domain name needed') unless $domain; #FIXME check is domain + + my ($sdl, $tld) = ($domain =~ /^([^\.]+)\.(.+)$/); + return ( 'SLD' => $sdl, + 'TLD' => $tld + ); +} + +sub _build_command +{ + my ($mes,$action,$attrs) = @_; + + my @fragments = ( 'Command' => ucfirst($action)); + push @fragments, @$attrs if defined $attrs && ref $attrs eq 'ARRAY'; + return \@fragments +} + + + +sub _build_contact { + my ($contact,$type) = @_; + + $contact->validate(); + + my $add_ref = $contact->street(); + Net::DRI::Exception::usererr_insufficient_parameters('at least 1 line of address is needed') unless $add_ref && ref($add_ref) eq 'ARRAY' && @$add_ref && $add_ref->[0]; + + my @fragments = ( + ucfirst($type).'Name' => scalar($contact->name()), + ucfirst($type).'Organization' => scalar($contact->org()), + ucfirst($type).'Address' => join(' ', grep {$_} @$add_ref), + ucfirst($type).'City' => scalar($contact->city()), + ucfirst($type).'CountryCode' => scalar($contact->cc()), + ucfirst($type).'PostalCode' => scalar($contact->pc()), + ucfirst($type).'Phone' => $contact->voice(), + ucfirst($type).'Email' => $contact->email(), + ); + + return @fragments; +} + +sub _build_all_ns +{ + my ($ns)=@_; + + Net::DRI::Exception::usererr_insufficient_parameters('max 6 nameservers exceeded') unless $ns->count()<=6; + + my (@hostnames,@ipv4); + for (my $i = 1; $i <= $ns->count(); $i++) { # Net:DRI name server list starts at 1. + my ($hostname, $ipv4) = $ns->get_details($i); + + Net::DRI::Exception::usererr_insufficient_parameters("invalid host $1 hostname") unless Net::DRI::Util::is_hostname($hostname); + Net::DRI::Exception::usererr_insufficient_parameters("invalid host $1 ipv4") unless Net::DRI::Util::is_ipv4($ipv4->[0]); + push @hostnames, ('NS'.$i => $hostname); + + push @ipv4, ('IP'.$i => $ipv4->[0]) ; + } + + return @hostnames, @ipv4; +} + +sub _build_duration +{ + my ($years) = @_; + return ( Year => $years); +} + +sub _build_info_pl +{ + my ($info_pl) = @_; + return ( InfoPL => $info_pl ); +} + + +sub _build_auth +{ + my ($auth) = @_; + return ( AuthCode => $auth ); +} + +sub _build_type +{ + my ($type) = @_; + Net::DRI::Exception::usererr_insufficient_parameters('type must be owner/management') unless grep {/^$type$/} qw/owner management/; + return (Type => ucfirst($type)); +} + +#################################################################################################### +1; diff --git a/lib/Net/DRI/Protocol/NameAction/Message.pm b/lib/Net/DRI/Protocol/NameAction/Message.pm new file mode 100644 index 00000000..a51c8d42 --- /dev/null +++ b/lib/Net/DRI/Protocol/NameAction/Message.pm @@ -0,0 +1,187 @@ +## Domain Registry Interface, NameAction Message +## +## Copyright (c) 2022 Paulo Castanheira . All rights reserved. +## +## This file is part of Net::DRI +## +## Net::DRI is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## See the LICENSE file that comes with this distribution for more details. +#################################################################################################### + +package Net::DRI::Protocol::NameAction::Message; + +use strict; +use warnings; + +use XML::LibXML (); +use URI; + +use Net::DRI::Protocol::ResultStatus; +use Net::DRI::Exception; +use Net::DRI::Util; + +use base qw(Class::Accessor::Chained::Fast Net::DRI::Protocol::Message); +__PACKAGE__->mk_accessors(qw(version client_auth command command_attributes response_code response_text response_command response_attributes response_is_success)); + +=pod + +=head1 NAME + +Net::DRI::Protocol::NameAction::Message - NameAction Message for Net::DRI + +=head1 DESCRIPTION + +Please see the README file for details. + +=head1 SUPPORT + +For now, support questions should be sent to: + +Enetdri@dotandco.comE + +Please also see the SUPPORT file in the distribution. + +=head1 SEE ALSO + +Ehttp://www.dotandco.com/services/software/Net-DRI/E + +=head1 AUTHOR + +Paulo Castanheira, Epaulo.s.castanheira@gmail.comE + +=head1 COPYRIGHT + +Copyright (c) 2022 Paulo Castanheira . +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +See the LICENSE file that comes with this distribution for more details. + +=cut + +#################################################################################################### + +sub new +{ + my ($class,$trid)=@_; + my $self={ results => [], command => {}}; + bless($self,$class); + + $self->version('1.04'); + return $self; +} + +sub result_status +{ + my $self=shift; + return Net::DRI::Protocol::ResultStatus->new_success($self->response_text()) if $self->response_is_success(); + my $code=$self->response_code(); + return Net::DRI::Protocol::ResultStatus->new('nameaction',$code,$code,$self->response_is_success(),$self->response_text(),'en'); +} + +sub is_success { return shift->response_is_success(); } +sub as_string { + my $self=shift; + my $uri = URI->new(); + $uri->query_form($self->{command}); + return $uri->query(); +} + +sub parse +{ + my ($self,$dr,$rinfo,$otype,$oaction,$msgsent)=@_; + $self->command($msgsent->command()); ## Copy over for reference from message sent + + my $parser=XML::LibXML->new(); + my $doc=$parser->parse_string($dr->as_string()); + + my $root=$doc->getDocumentElement(); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, root element is not "nck" but '.$root->getName()) unless ($root->getName() eq 'nck'); + + my $resp = $root->getElementsByTagName('response'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "response" node below root, found '.$resp->size()) unless ($resp->size()==1); + + my $error = $resp->get_node(1)->getChildrenByTagName('error'); + if ( $error->size() ) + { + my $code = $error->get_node(1)->getChildrenByTagName('code'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "code" node below "error", found '.$code->size()) unless ($code->size()==1); + $self->response_code($code->get_node(0)->textContent()); + + my $msg = $error->get_node(1)->getChildrenByTagName('message'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "message" node below "error", found '.$msg->size()) unless ($code->size()==1); + $self->response_text($msg->get_node(0)->textContent()); + + $self->response_is_success(0); + return; + } + + my $cmd = $resp->get_node(1)->getChildrenByTagName('command'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "command" node below "response", found '.$cmd->size()) unless ($cmd->size()==1); + $self->response_command($cmd->get_node(0)->textContent()); + + my $val = $resp->get_node(1)->getChildrenByTagName('value'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "value" node below "response", found '.$val->size()) unless ($val->size()==1); + $self->response_code($val->get_node(0)->textContent()); + + my $msg=$root->getElementsByTagName('message'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "message" node below root, found '.$msg->size()) unless ($msg->size()==1); + + if ( $oaction ne 'info' ) { + $self->response_text($msg->get_node(0)->textContent()); + } + else + { + my $details = $msg->get_node(1)->getChildrenByTagName('details'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "details" node below "message", found '.$details->size()) unless ($details->size()==1); + + my $conts_tag = $details->get_node(1)->getChildrenByTagName('contacts'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "contacts" node below "details", found '.$conts_tag->size()) unless ($conts_tag->size()==1); + my $conts = $conts_tag->get_node(1)->getChildrenByTagName('*'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected at least one contact node below "contacts", found '.$conts->size()) unless ($conts->size()>=1); + my %contacts; + foreach my $cont ($conts->get_nodelist()) { + $contacts{$cont->nodeName()} = $cont->textContent(); + } + + my $hosts_tag = $details->get_node(1)->getChildrenByTagName('hosts'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "hosts" node below "details", found '.$hosts_tag->size()) unless ($hosts_tag->size()==1); + my $hosts = $hosts_tag->get_node(1)->getChildrenByTagName('*'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected at least one host node below "hosts", found '.$hosts->size()) unless ($hosts->size()>=1); + my @hosts = (); + foreach my $node ($hosts->get_nodelist()) { + my ($what,$index) = $node->nodeName() =~ /^(\w+)(\d)$/; + if ( $what eq 'ns' ) { + $hosts[$index] = [$node->textContent()]; + } else { #IP + $hosts[$index][1] = $node->textContent(); + } + } + + my $exp_date = $details->get_node(1)->getChildrenByTagName('expirydate'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "expirydate" node below "details", found '.$exp_date->size()) unless ($exp_date->size()==1); + + my $status = $details->get_node(1)->getChildrenByTagName('status'); + Net::DRI::Exception->die(0,'protocol/NameAction',1,'Unsuccessful parse, expected one "status" node below "details", found '.$status->size()) unless ($status->size()==1); + + $self->response_attributes({ contacts => \%contacts, + hosts => \@hosts, + expiry_date => $exp_date->get_node(0)->textContent(), + status => $status->get_node(0)->textContent() + }); + } + + $self->response_is_success(1); + return; +} + +#################################################################################################### +1; diff --git a/lib/Net/DRI/Protocol/NameAction/Status.pm b/lib/Net/DRI/Protocol/NameAction/Status.pm new file mode 100644 index 00000000..739b5d7d --- /dev/null +++ b/lib/Net/DRI/Protocol/NameAction/Status.pm @@ -0,0 +1,81 @@ +## Domain Registry Interface, NameAction Status +## +## Copyright (c) 2022 Paulo Castanheira . All rights reserved. +## +## This file is part of Net::DRI +## +## Net::DRI is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## See the LICENSE file that comes with this distribution for more details. +######################################################################################### + +package Net::DRI::Protocol::NameAction::Status; + +use base qw!Net::DRI::Data::StatusList!; + +use strict; +use warnings; + +use Net::DRI::Exception; + +=pod + +=head1 NAME + +Net::DRI::Protocol::NameAction::Status - NameAction Status for Net::DRI + +=head1 DESCRIPTION + +Please see the README file for details. + +=head1 SUPPORT + +For now, support questions should be sent to: + +Epaulo.s.castanheira@gmail.comE + +Please also see the SUPPORT file in the distribution. + +=head1 AUTHOR + +Paulo Castanheira, Epaulo.s.castanheira@gmail.comE + +=head1 COPYRIGHT + +Copyright (c) 2022 Paulo Castanheira . +All rights reserved. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +See the LICENSE file that comes with this distribution for more details. + +=cut + +####################################################################################### + +sub new +{ + my ($class,$msg)=@_; + my $self=$class->SUPER::new('nameaction','1.0.4'); + return $self unless defined $msg; + Net::DRI::Exception::err_invalid_parameters('new() expects a ref array') unless ref $msg eq 'ARRAY'; + $self->add(@$msg); + return $self; + +} + +sub is_active { return shift->has_any('Registered'); } +sub is_pending { return shift->has_any('In Process'); } +sub can_update { return !shift->is_pending(); } +sub can_transfer { return !shift->is_pending(); } +sub can_delete { return !shift->is_pending(); } +sub can_renew { return !shift->is_pending(); } + +####################################################################################### +1; diff --git a/t/0_load_mandatory.t b/t/0_load_mandatory.t index ff77bf69..a500a761 100755 --- a/t/0_load_mandatory.t +++ b/t/0_load_mandatory.t @@ -2,7 +2,7 @@ use strict; use warnings; -use Test::More tests => 551; +use Test::More tests => 557; BEGIN { use_ok('Net::DRI'); @@ -34,6 +34,7 @@ use_ok('Net::DRI::Data::Contact::JOBS'); use_ok('Net::DRI::Data::Contact::JP'); use_ok('Net::DRI::Data::Contact::LU'); use_ok('Net::DRI::Data::Contact::LV'); +use_ok('Net::DRI::Data::Contact::NameAction'); use_ok('Net::DRI::Data::Contact::NominetMMX'); use_ok('Net::DRI::Data::Contact::Neustar'); use_ok('Net::DRI::Data::Contact::NO'); @@ -114,6 +115,7 @@ use_ok('Net::DRI::DRD::IRegistry'); use_ok('Net::DRI::DRD::ISPAPI'); use_ok('Net::DRI::DRD::KNET'); use_ok('Net::DRI::DRD::LVRegistry'); +use_ok('Net::DRI::DRD::NameAction'); use_ok('Net::DRI::DRD::NASK'); use_ok('Net::DRI::DRD::Neustar::IN'); use_ok('Net::DRI::DRD::Neustar::Narwhal'); @@ -491,6 +493,10 @@ use_ok('Net::DRI::Protocol::IRIS::LWZ'); use_ok('Net::DRI::Protocol::IRIS::Message'); use_ok('Net::DRI::Protocol::IRIS::XCP'); use_ok('Net::DRI::Protocol::Message'); +use_ok('Net::DRI::Protocol::NameAction'); +use_ok('Net::DRI::Protocol::NameAction::Connection'); +use_ok('Net::DRI::Protocol::NameAction::Domain'); +use_ok('Net::DRI::Protocol::NameAction::Message'); use_ok('Net::DRI::Protocol::OpenSRS::XCP'); use_ok('Net::DRI::Protocol::OpenSRS::XCP::Account'); use_ok('Net::DRI::Protocol::OpenSRS::XCP::Connection'); diff --git a/t/Net/DRI/Protocol/NameAction.t b/t/Net/DRI/Protocol/NameAction.t new file mode 100755 index 00000000..7440e31a --- /dev/null +++ b/t/Net/DRI/Protocol/NameAction.t @@ -0,0 +1,302 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Net::DRI; +use Net::DRI::Data::Raw; +use Net::DRI::Protocol::NameAction::Connection; +use DateTime::Duration; +use DateTime; +use Test::More tests => 37; +eval { no warnings; require Test::LongString; Test::LongString->import(max => 100); $Test::LongString::Context=50; }; +if ( $@ ) { no strict 'refs'; *{'main::is_string'}=\&main::is; } + +our ($R1,$R2); + +sub mysend { my ($transport,$count,$msg,$ctx)=@_; + *{Net::DRI::Transport::Dummy::transport_data} = sub { return {remote_url => 'https://ncktest.nameaction.com/interface', + client_login => 'ncktest', + client_password => 'ncktest'}}; + $R1 = Net::DRI::Protocol::NameAction::Connection->build_url($transport,$msg); + return 1; +} +sub myrecv { return Net::DRI::Data::Raw->new_from_string($R2); } + +my $dri=Net::DRI::TrapExceptions->new({cache_ttl => -1}); +$dri->add_registry('NameAction'); +$dri->target('NameAction')->add_current_profile('p1','nameaction',{f_send=>\&mysend,f_recv=>\&myrecv});; + +my ($r,$rc,$rd,$ns,$cs); + +$r = "https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Check&SLD=nameaction&TLD=cl"; + +$R2 = <<'EOF'; + + + check + 1 + + + Domain nameaction.cl is available + + +EOF + +$rc=$dri->domain_check('nameaction.cl'); +is($R1,$r,'domain_check build'); +is($rc->is_success(),1,'domain_check is_success'); +is($dri->get_info('action'),'check','domain_check get_info(action)'); +is($dri->get_info('exist'),0,'domain_check get_info(exist)'); + + +### Create + +$r='https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Create&SLD=nameaction&TLD=cl&Year=2&RegistrantName=JohnDoe&RegistrantOrganization=NameAction+DomainLA&RegistrantAddress=1156+HighStreet&RegistrantCity=California&RegistrantCountryCode=US&RegistrantPostalCode=95064&RegistrantPhone=1.1234567&RegistrantEmail=j.doe%40nameaction.com&AdminName=JohnDoe&AdminOrganization=NameAction+DomainLA&AdminAddress=1156+HighStreet&AdminCity=California&AdminCountryCode=US&AdminPostalCode=95064&AdminPhone=1.1234567&AdminEmail=j.doe%40nameaction.com&TechName=JohnDoe&TechOrganization=NameAction+DomainLA&TechAddress=1156+HighStreet&TechCity=California&TechCountryCode=US&TechPostalCode=95064&TechPhone=1.1234567&TechEmail=j.doe%40nameaction.com&NS1=ns1.nameaction.com&NS2=ns2.nameaction.com&IP1=200.27.54.210&IP2=200.27.54.211&InfoPL=55555555-5'; + +$R2 = <<'EOF'; + + + create + 1000 + + + Request to Create the domain nameaction.cl was successfully received for 2 year(s). (Cost USD$95.0) + + +EOF + +$cs=$dri->local_object('contactset'); +my $co=$dri->local_object('contact'); +isa_ok($co,'Net::DRI::Data::Contact::NameAction','local_object(contact)'); + +$co->name('JohnDoe'); +$co->org('NameAction DomainLA'); +$co->street(['1156 HighStreet','','']); +$co->city('California'); +$co->pc('95064'); +$co->cc('US'); +$co->voice('1.1234567'); +$co->email('j.doe@nameaction.com'); + +$cs->set($co,'registrant'); +$cs->set($co,'admin'); +$cs->set($co,'tech'); + +$ns = $dri->local_object('hosts')->set(['ns1.nameaction.com','200.27.54.210'],['ns2.nameaction.com','200.27.54.211']); + +$rc = $dri->domain_create('nameaction.cl',{ pure_create =>1, + duration => DateTime::Duration->new(years=>2), + ns => $ns, + contact => $cs, + info_pl => '55555555-5' + }); + +is_string($R1,$r,'domain_create build'); +is($rc->is_success(),1,'domain_create is_success'); +is($dri->get_info('action'),'create','domain_create get_info(action)'); +is($dri->get_info('exist'),1,'domain_create get_info(exist)'); + +### Renew + +$r="https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Renew&SLD=nameaction&TLD=cl&Year=2"; + +$R2 = <<'EOF'; + + + renew + 1000 + + + Request to Renew the domain nameaction.cl was successfully received for 2 year(s). (Cost USD$80.0) + + +EOF + +$rc = $dri->domain_renew('nameaction.cl',{duration => DateTime::Duration->new(years=>2)}); +is($rc->is_success(),1,'domain_renew is_success'); +is($R1,$r,'domain_renew build'); +is($dri->get_info('action'),'renew','domain_renew get_info(action)'); +is($dri->get_info('exist'),1,'domain_renew get_info(exist)'); + +### Update + +$r="https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Modify&SLD=nameaction&TLD=cl&RegistrantName=JohnDoe&RegistrantOrganization=NameAction+DomainLA&RegistrantAddress=1156+HighStreet&RegistrantCity=California&RegistrantCountryCode=US&RegistrantPostalCode=95064&RegistrantPhone=1.1234567&RegistrantEmail=j.doe%40nameaction.com&AdminName=JohnDoe&AdminOrganization=NameAction+DomainLA&AdminAddress=1156+HighStreet&AdminCity=California&AdminCountryCode=US&AdminPostalCode=95064&AdminPhone=1.1234567&AdminEmail=j.doe%40nameaction.com&NS1=ns1.nameaction.com&NS2=ns2.nameaction.com&IP1=200.27.54.210&IP2=200.27.54.211"; + +$R2 = <<'EOF'; + + + modify + 1000 + + + Domain nameaction.cl successfully modified + + +EOF + +$cs=$dri->local_object('contactset'); +$co=$dri->local_object('contact'); +$co->name('JohnDoe'); +$co->org('NameAction DomainLA'); +$co->street(['1156 HighStreet','','']); +$co->city('California'); +$co->pc('95064'); +$co->cc('US'); +$co->voice('1.1234567'); +$co->email('j.doe@nameaction.com'); + +$cs->set($co,'registrant'); +$cs->set($co,'admin'); + +my $toc=$dri->local_object('changes'); +$toc->set('ns',$ns); +$toc->set('contact',$cs); + +$rc = $dri->domain_update('nameaction.cl',$toc); +is_string($R1,$r,'domain_update build'); +is($rc->is_success(),1,'domain_update is_success'); +is($dri->get_info('action'),'update','domain_update get_info(action)'); +is($dri->get_info('exist'),1,'domain_update get_info(exist)'); + +### Domain Info Error + +$r= "https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Info&SLD=nameaction&TLD=cl"; + +$R2 = <<'EOF'; + + + + 2311 + Domains are not associated with this account + + + +EOF + +$rc = $dri->domain_info('nameaction.cl'); +is_string($R1,$r,'domain_info build'); +is($rc->is_success(),0,'domain_info error'); + +### Domain Specific Info + +$r= "https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Info&SLD=nameaction&TLD=cl"; + +$R2 = <<'EOF'; + + + Info + 1000 + + +
+ nameaction.cl + + NameAction Domain LA + John Doe + John Doe + + + ns1.nameaction.com + 200.27.54.210 + ns2.nameaction.com + 200.27.54.211 + + 2012-02-13 00:00:00 + Registered +
+ + +EOF + +$rc = $dri->domain_info('nameaction.cl'); +is_string($R1,$r,'domain_info build'); +is($rc->is_success(),1,'domain_info is_success'); +my $s=$dri->get_info('contact'); +isa_ok($s,'Net::DRI::Data::ContactSet','domain_info get_info(contact)'); +is_deeply([$s->types()],['admin','registrant','tech'],'domain_info get_info(contact) types'); +isa_ok($co,'Net::DRI::Data::Contact::NameAction','domain_info get_info(contact)'); +is($s->get('registrant')->name(),'NameAction Domain LA','domain_info get_info(contact) registrant name'); +is($s->get('admin')->name(),'John Doe','domain_info get_info(contact) admin name'); +is($s->get('tech')->name(),'John Doe','domain_info get_info(contact) tech name'); +my $dh=$dri->get_info('ns'); +isa_ok($dh,'Net::DRI::Data::Hosts','domain_info get_info(subordinate_hosts)'); +my @c=$dh->get_names(); +is_deeply(\@c,['ns1.nameaction.com','ns2.nameaction.com'],'domain_info get_info(host) get_names'); +is($dri->get_info('exDate'),'2012-02-13T00:00:00','domain_info get_info(exDate) value'); +is_deeply([$dri->get_info('status')->list_status()],['Registered'],'domain_info get_info(status) list'); + +### Domain Info Error + +$r= "https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Delete&SLD=nameaction&TLD=cl"; + +$R2 = <<'EOF'; + + + delete + 1000 + + + Request to Delete the domain nameaction.cl successfully received + + +EOF + +$rc = $dri->domain_delete('nameaction.cl', { pure_delete => 1 }); +is_string($R1,$r,'domain_delete build'); +is($rc->is_success(),1,'domain_delete is_success'); + +### Transfer + +$r= 'https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Transfer&Type=Management&SLD=nameaction&TLD=cl&AuthCode=ABC1234'; + +$R2 = <<'EOF'; + + + transfer + 1000 + + + Request to Transfer the domain nameaction.cl successfully received + + +EOF + +$rc = $dri->domain_transfer_start('nameaction.cl', {auth=>{pw=>'ABC1234'}}); +is_string($R1,$r,'domain_transfer build'); +is($rc->is_success(),1,'domain_transfer is_success'); + +### Trade + +$r= 'https://ncktest.nameaction.com/interface?User=ncktest&Pass=ncktest&Command=Transfer&Type=Owner&SLD=nameaction&TLD=cl&RegistrantName=John+Doe&RegistrantOrganization=NameAction+Domain+LA&RegistrantAddress=1156+High+Street&RegistrantCity=California&RegistrantCountryCode=US&RegistrantPostalCode=95064&RegistrantPhone=1.1234567&RegistrantEmail=j.doe%40nameaction.com'; + +$R2 = <<'EOF'; + + + transfer + 1000 + + + Request to Transfer the domain nameaction.cl successfully received + + +EOF + +$cs=$dri->local_object('contactset'); +$co=$dri->local_object('contact'); +$co->name('John Doe'); +$co->org('NameAction Domain LA'); +$co->street(['1156 High Street','','']); +$co->city('California'); +$co->pc('95064'); +$co->cc('US'); +$co->voice('1.1234567'); +$co->email('j.doe@nameaction.com'); + +$cs->set($co,'registrant'); + +$rc = $dri->domain_trade_start('nameaction.cl', { contact => $cs }); +is_string($R1,$r,'domain_trade build'); +is($rc->is_success(),1,'domain_trade is_success'); + +exit 0; \ No newline at end of file