1## Domain Registry Interface, Main entry point 2## 3## Copyright (c) 2005-2010 Patrick Mevzek <netdri@dotandco.com>. 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# 16#################################################################################################### 17 18package Net::DRI; 19 20use strict; 21use warnings; 22 23require UNIVERSAL::require; 24 25use Net::DRI::Cache; 26use Net::DRI::Registry; 27use Net::DRI::Util; 28use Net::DRI::Exception; 29 30use base qw(Class::Accessor::Chained::Fast Net::DRI::BaseClass); 31__PACKAGE__->mk_ro_accessors(qw/trid_factory logging cache/); 32 33our $AUTOLOAD; 34our $VERSION='0.96'; 35our $CVS_REVISION=do { my @r=(q$Revision: 1.38 $=~/\d+/g); sprintf("%d".".%02d" x $#r, @r); }; 36our $RUNNING_POE=(exists($INC{'POE.pm'}))? $POE::Kernel::poe_kernel : undef; 37 38=pod 39 40=head1 NAME 41 42Net::DRI - Interface to Domain Name Registries/Registrars/Resellers 43 44=head1 VERSION 45 46This documentation refers to Net::DRI version 0.95 47 48=head1 SYNOPSIS 49 50 use Net::DRI; 51 my $dri=Net::DRI->new({ cache_ttl => 10, trid_factory => ..., logging => .... }); 52 53 ... various operations ... 54 55 $dri->end(); 56 57=head1 DESCRIPTION 58 59Net::DRI is a Perl library to access services offered by domain name 60providers, such as registries or registrars. DRI stands for 61Domain Registration Interface and it aims to be 62for domain name registries/registrars/resellers what DBI is for databases: 63an abstraction over multiple providers, with multiple policies, transports 64and protocols all used through a uniform API. 65 66It is an object-oriented framework implementing RRP (RFC 2832/3632), 67EPP (core EPP in RFC 5730/5731/5732/5733/5734 aka STD69, extensions in 68RFC 3915/4114/4310/5076 and various extensions of ccTLDs/gTLDs 69- currently more than 30 TLDs are directly supported with extensions), 70RRI (.DE registration protocol), Whois, DAS (Domain Availability Service used by .BE, .EU, .AU, .NL), 71IRIS (RFC3981) DCHK (RFC5144) over LWZ (RFC4993) for .DE currently and XCP (RFC4992), 72.FR/.RE email and webservices interface, and resellers interface of some registrars 73(Gandi, OpenSRS, etc.). 74It has transports for connecting with UDP/TCP/TLS, HTTP/HTTPS, 75Web Services (XML-RPC and SOAP with/without WSDL), 76or SMTP-based registries/registrars. 77 78It is not limited to handling of domain names, it can be easily extended. 79For example, it supports ENUM registrations and validations, or DNSSEC provisioning. 80 81A shell is included for easy prototyping and debugging, see L<Net::DRI::Shell>. 82Caching and logging features are also included by default. 83 84Please see the included README file for full details. 85 86=head1 EXAMPLES 87 88Please see the C<eg/> subdirectory of the distribution, it contains various 89examples. Please also see all unit tests under C<t/>, they show all parts of the API. 90 91=head1 SUBROUTINES/METHODS 92 93After having used Net::DRI (which is the only module you should need to C<use> from 94this distribution), you create an object as instance of this class, 95and every operation will be carried through it. 96 97=head2 trid_factory() 98 99This is an accessor to the trid factory (code reference) used to generate client 100transaction identificators, that are useful for logging and asynchronous operations. 101 102During the C<new()> call, a C<trid_factory()> is initialized to a default safe value 103(being Net::DRI::Util::create_trid_1). 104 105You need to call this method only if you wish to use another function to generate transaction identificators. 106 107All other objects (registry profiles and transports) 108created after that will inherit this value. If you call again C<trid_factory()> 109the change will only apply to new objects (registry profiles and transports) created after the change, 110it will not apply to already existing objects (registry profiles and transports). 111 112=head2 logging() 113 114This is an accessor to the underlying Logging object. During the C<new()> call you can 115provide the object, or just a string ("null", "stderr", "files" or "syslog" which are the 116current logging modules available in Net::DRI), or a reference to an array 117with the first parameter a string (same as previously) and the second parameter a reference to 118an hash with data needed by the logging class used (see for example L<Net::DRI::Logging::Files>). 119 120If you want to log the application data (what is exchanged with remote server, such as EPP XML streams), 121you need to use logging level of 'notice', or higher. 122 123=head2 cache() 124 125This is an accessor to the underlying Cache object. See L<Net::DRI::Cache>. 126This object has a C<ttl()> method to access and change the current time to live 127for cached data. 128 129=head1 SUPPORT 130 131For now, support questions should be sent to: 132 133E<lt>netdri@dotandco.comE<gt> 134 135Please also see the SUPPORT file in the distribution. 136 137=head1 SEE ALSO 138 139L<http://www.dotandco.com/services/software/Net-DRI/> 140 141=head1 AUTHOR 142 143Patrick Mevzek, E<lt>netdri@dotandco.comE<gt> 144and various contributors (see Changes file and web page above) 145 146=head1 COPYRIGHT 147 148Copyright (c) 2005-2010 Patrick Mevzek <netdri@dotandco.com>. 149All rights reserved. 150 151=head1 LICENSE 152 153This program is free software; you can redistribute it and/or modify 154it under the terms of the GNU General Public License as published by 155the Free Software Foundation; either version 2 of the License, or 156(at your option) any later version. 157 158See the LICENSE file that comes with this distribution for more details. 159 160=cut 161 162#################################################################################################### 163 164sub new 165{ 166 my $class=shift; 167 my ($cachettl,$globaltimeout)=@_; ## old API and $globaltimeout never used 168 my $rh=(defined $cachettl && ( ref $cachettl eq 'HASH'))? $cachettl : { cache_ttl => $cachettl }; 169 170 my $self={ cache => Net::DRI::Cache->new((exists $rh->{cache_ttl} && defined $rh->{cache_ttl})? $rh->{cache_ttl} : 0), 171 global_timeout => $globaltimeout, 172 current_registry => undef, ## registry name (key of following hash) 173 registries => {}, ## registry name => Net::DRI::Registry object 174 tlds => {}, ## tld => [ registries name ] 175 time_created => time(), 176 trid_factory => (exists $rh->{trid_factory} && (ref $rh->{trid_factory} eq 'CODE'))? $rh->{trid_factory} : \&Net::DRI::Util::create_trid_1, 177 }; 178 179 my ($logname,@logdata); 180 if (exists $rh->{logging}) 181 { 182 if (ref $rh->{logging} eq 'ARRAY') 183 { 184 ($logname,@logdata)=@{$rh->{logging}}; 185 } else 186 { 187 $logname=$rh->{logging}; 188 } 189 } else 190 { 191 $logname='null'; 192 } 193 if ($logname !~ m/::/) { $logname='Net::DRI::Logging::'.ucfirst($logname); } 194 $logname->require() or Net::DRI::Exception::err_failed_load_module('DRI',$logname,$@); 195 $self->{logging}=$logname->new(@logdata); 196 197 bless($self,$class); 198 $self->logging()->setup_channel(__PACKAGE__,'core'); 199 $self->log_output('notice','core','Successfully created Net::DRI object with logging='.$logname); 200 return $self; 201} 202 203sub add_current_registry 204{ 205 my ($self,@p)=@_; 206 $self->add_registry(@p); 207 my $reg=$p[0]; 208 $reg='Net::DRI::DRD::'.$reg unless ($reg=~m/::/); 209 $self->target($reg->name()); 210 return $self; 211} 212 213sub add_registry 214{ 215 my ($self,$reg,@data)=@_; 216 Net::DRI::Exception::usererr_insufficient_parameters('add_registry needs a registry name') unless Net::DRI::Util::all_valid($reg); 217 $reg='Net::DRI::DRD::'.$reg unless ($reg=~m/::/); 218 $reg->require() or Net::DRI::Exception::err_failed_load_module('DRI',$reg,$@); 219 220 my $drd=$reg->new(@data); 221 Net::DRI::Exception->die(1,'DRI',9,'Failed to initialize registry '.$reg) unless ($drd && ref($drd)); 222 223 Net::DRI::Exception::err_method_not_implemented('name() in '.$reg) unless $drd->can('name'); 224 my $regname=$drd->name(); 225 Net::DRI::Exception->die(1,'DRI',10,'No dot allowed in registry name: '.$regname) unless (index($regname,'.')==-1); 226 Net::DRI::Exception->die(1,'DRI',11,'New registry name already in use') if (exists($self->{registries}->{$regname})); 227 228 my $ndr=Net::DRI::Registry->new($regname,$drd,$self->{cache},$self->{trid_factory},$self->{logging}); 229 $self->{registries}->{$regname}=$ndr; 230 231 Net::DRI::Exception::err_method_not_implemented('tlds() in '.$reg) unless $drd->can('tlds'); 232 foreach my $tld ($drd->tlds()) 233 { 234 $tld=lc($tld); 235 $self->{tlds}->{$tld}=[] unless exists($self->{tlds}->{$tld}); 236 push @{$self->{tlds}->{$tld}},$regname; 237 } 238 239 $self->log_output('notice','core','Successfully added registry "'.$regname.'"'); 240 return $self; 241} 242 243sub del_registry 244{ 245 my ($self,$name)=@_; 246 if (defined($name)) 247 { 248 err_registry_name_does_not_exist($name) unless (exists($self->{registries}->{$name})); 249 } else 250 { 251 err_no_current_registry() unless (defined($self->{current_registry})); 252 $name=$self->{current_registry}; 253 } 254 $self->{registries}->{$name}->end(); 255 delete($self->{registries}->{$name}); 256 $self->{current_registry}=undef if ($self->{current_registry} eq $name); 257 $self->log_output('notice','core','Successfully deleted registry "'.$name.'"'); 258 return $self; 259} 260 261#################################################################################################### 262 263sub err_no_current_registry { Net::DRI::Exception->die(0,'DRI',1,'No current registry available'); } 264sub err_registry_name_does_not_exist { Net::DRI::Exception->die(0,'DRI',2,'Registry name '.$_[0].' does not exist'); } 265 266#################################################################################################### 267## Accessor functions 268 269sub available_registries { return sort(keys(%{shift->{registries}})); } 270sub available_registries_profiles 271{ 272 my ($self,$full)=@_; 273 my %r; 274 foreach my $reg (keys(%{$self->{registries}})) 275 { 276 $r{$reg}=[ $self->{registries}->{$reg}->available_profiles($full) ]; 277 } 278 return \%r; 279} 280sub registry_name { return shift->{current_registry}; } 281 282sub registry 283{ 284 my ($self)=@_; 285 my $regname=$self->registry_name(); 286 err_no_current_registry() unless (defined($regname) && $regname); 287 err_registry_name_does_not_exist($regname) unless (exists($self->{registries}->{$regname})); 288 my $ndr=$self->{registries}->{$regname}; 289 return wantarray? ($regname,$ndr) : $ndr; 290} 291 292sub tld2reg 293{ 294 my ($self,$tld)=@_; 295 return unless defined($tld) && $tld; 296 $tld=lc($tld); 297 $tld=$1 if ($tld=~m/\.([a-z0-9]+)$/); 298 return unless exists($self->{tlds}->{$tld}); 299 my @t=@{$self->{tlds}->{$tld}}; 300 return @t; 301} 302 303sub installed_registries 304{ 305 return qw/AdamsNames AERO AFNIC AG ARNES ASIA AT AU BE BIZ BookMyName BR BZ CAT CentralNic CIRA CoCCA COOP CZ DENIC EURid Gandi GL HN IENUMAT IM INFO IRegistry IT LC LU ME MN MOBI NAME Nominet NO NU OpenSRS ORG OVH PL PRO PT SC SE SIDN SWITCH TRAVEL US VC VNDS WS/; 306} 307 308#################################################################################################### 309sub target 310{ 311 my ($self,$driver,$profile)=@_; 312 313 ## Try to convert if given a domain name or a tld instead of a driver's name 314 if (defined($driver) && !exists($self->{registries}->{$driver})) 315 { 316 my @t=$self->tld2reg($driver); 317 Net::DRI::Exception->die(0,'DRI',7,'Registry not found for domain name/TLD '.$driver) unless (@t==1); 318 $driver=$t[0]; 319 } 320 321 $driver=$self->registry_name() unless defined($driver); 322 err_registry_name_does_not_exist($driver) unless defined($driver) && $driver; 323 324 if (defined($profile)) 325 { 326 $self->{registries}->{$driver}->target($profile); 327 } 328 329 $self->{current_registry}=$driver; 330 return $self; 331} 332 333#################################################################################################### 334## The meat of everything 335## See Cookbook, page 468 336sub AUTOLOAD 337{ 338 my $self=shift; 339 my $attr=$AUTOLOAD; 340 $attr=~s/.*:://; 341 return unless $attr=~m/[^A-Z]/; ## skip DESTROY and all-cap methods 342 343 my ($name,$ndr)=$self->registry(); 344 Net::DRI::Exception::err_method_not_implemented($attr.' in '.$ndr) unless (ref($ndr) && $ndr->can($attr)); 345 $self->log_output('debug','core','Calling '.$attr.' from Net::DRI'); 346 return $ndr->$attr(@_); ## is goto beter here ? 347} 348 349sub end 350{ 351 my $self=shift; 352 while(my ($name,$v)=each(%{$self->{registries}})) 353 { 354 $v->end() if (ref($v) && $v->can('end')); 355 $self->log_output('notice','core','Successfully ended registry "'.$name.'"'); 356 $v={}; 357 } 358 $self->{tlds}={}; 359 $self->{registries}={}; 360 $self->{current_registry}=undef; 361 if (defined $self->{logging}) 362 { 363 $self->log_output('notice','core','Successfully ended Net::DRI object'); 364 $self->{logging}=undef; 365 } 366} 367 368sub DESTROY { my $self=shift; $self->end(); } 369 370#################################################################################################### 371 372package Net::DRI::TrapExceptions; 373 374use base qw/Net::DRI/; 375 376our $AUTOLOAD; 377 378## Some methods may die in Net::DRI, we specifically trap them 379sub add_registry { my $r; eval { $r=shift->SUPER::add_registry(@_); }; return $r unless $@; die(ref($@)? $@->as_string() : $@); } 380sub del_registry { my $r; eval { $r=shift->SUPER::del_registry(@_); }; return $r unless $@; die(ref($@)? $@->as_string() : $@); } 381sub registry { my @r; eval { @r=shift->SUPER::registry(@_); }; if (! $@) { return wantarray? @r : $r[0]; } die(ref($@)? $@->as_string() : $@); } 382sub target { my $r; eval { $r=shift->SUPER::target(@_); }; return $r unless $@; die(ref($@)? $@->as_string() : $@); } 383sub end { my $r; eval { $r=shift->SUPER::end(@_); }; return $r unless $@; die(ref($@)? $@->as_string() : $@); } 384 385sub AUTOLOAD 386{ 387 my $self=shift; 388 my @r; 389 $Net::DRI::AUTOLOAD=$AUTOLOAD; 390 eval { @r=$self->SUPER::AUTOLOAD(@_); }; 391 die(ref($@)? $@->as_string() : $@) if $@; 392 return wantarray? @r : $r[0]; 393} 394 395#################################################################################################### 3961; 397