1#!/usr/bin/perl -w 2## 3## Copyright (c) 2008-2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>, 4## Trond Haugen E<lt>info@norid.noE<gt> 5## All rights reserved. 6## 7## This program illustrate the usage of Net::DRI towards the .NO registry. 8## 9## This program is free software; you can redistribute it and/or modify 10## it under the terms of the GNU General Public License as published by 11## the Free Software Foundation; either version 2 of the License, or 12## (at your option) any later version. 13## 14## See the LICENSE file that comes with this distribution for more details. 15## 16## 17## 18## ----------------- 19## 20## What is this: A Net::DRI based command line client for .NO 21## 22## Note that it is developed for test purposes, not to be a complete client. 23## 24## The -p argument is expected to carry a %p parameter hash argument string 25## which can be eval'ed into a %p hash, like this for a host create operation: 26## -o host -c create -p "%p=(name=>'ns1.suniswanted.no',v4=>'123.234.123.12')" 27## 28## See POD section at the end for further details. 29## 30####### 31 32use strict; 33use Net::DRI; 34use DateTime::Duration; 35use Pod::Usage; 36use POSIX qw(locale_h); 37use Net::LibIDN ':all'; 38 39use Getopt::Std; 40 41use Data::Dumper; 42$Data::Dumper::Indent=1; 43 44use encoding "utf-8"; # assume utf-8 encoded argument input 45 46our $VERSION = '0.95.no'; 47our $SVN_VERSION = do { 48 my @r = ( q$Revision: 1.3 $ =~ /\d+/gxm ); 49 sprintf( "%d" . ".%02d" x $#r, @r ); 50}; 51 52# Format string for output of results 53my $F = " %-15s: %s\n"; 54 55# All possible dri object methods 56my @drim = ('id'); 57 58# All possible contact object methods 59my @cm = ( 60 61 # standard DRI methods 62 'loid', 'srid', 'id', 'roid', 'name', 'org', 'street', 63 'city', 'sp', 'pc', 'cc', 'email', 'voice', 'fax', 64 'auth', 'disclose', 65 66 # .no extra methods 67 'type', 'identity', 'mobilephone', 68 'organization', 'rolecontact', 'xemail', 'xdisclose', 'facets' 69); 70 71# args 72use vars qw($opt_c $opt_o $opt_h $opt_p $opt_f $opt_P $opt_S 73 $opt_L $opt_C $opt_W $opt_w); 74 75# Operations 76my %op = ( 77 'hello' => 1, 78 'create' => 1, 79 'update' => 1, 80 'delete' => 1, 81 'info' => 1, 82 'poll' => 1, 83 'check' => 1, 84 'renew' => 1, 85 'withdraw' => 1, 86 'transfer' => 1, 87 'transfer_query' => 1, 88 'transfer_cancel' => 1, 89 'transfer_execute' => 1, # extension command 90 91 # message operations 92 'waiting' => 1, 93 'count' => 1, 94 'retrieve' => 1, 95 96 # delete op is already defined 97 98); 99 100# Objects 101my %obj = ( 102 'contact' => 'contact', 103 'person' => 'contact', 104 'organization' => 'contact', 105 'role' => 'contact', 106 'host' => 'host', 107 'domain' => 'domain', 108 'message' => 'message', 109); 110 111# The possible facet keys must be registered here, the value part must be TRUE 112# in this hash for the facet to be activated 113my %facets = ( 114 'skip-dns-checks' => 1, 115 'skip-manual-review' => 1, 116 'ignore-exceptions-as-registrar' => 1, 117 'impersonate-registrar' => 1 118 ); 119 120# Hash to hold the EPP arguments 121my %p; 122 123&getopts("Lo:c:p:f:S:P:C:W:w:"); 124 125#server and port must be specified 126my $socktype = 'tcp'; 127die "No server specified" unless ($opt_S); 128die "No port specified" unless ($opt_P); 129die "No client id specified" unless ($opt_C); 130die "No password specified" unless ($opt_W); 131 132my $server = $opt_S; 133my $port = $opt_P; 134$socktype = 'ssl' if ($opt_L); 135 136my $clid = $opt_C; 137my $pass = $opt_W; 138 139my $newpass; 140$newpass = $opt_w if ($opt_w); 141 142unless ( $opt_c && $op{$opt_c} ) { 143 pexit("Specify a valid command"); 144} 145unless ( $opt_c eq 'hello' ) { 146 unless ( $opt_o && $obj{$opt_o} ) { 147 pexit("Specify a valid object type"); 148 } 149 unless ($opt_p) { 150 pexit("Specify a parameter string"); 151 } 152 153 #print "p: $opt_p \n"; 154 unless ( parse_params($opt_p) ) { 155 pexit("Specify a valid parameter string"); 156 } 157} 158 159if ($p{facets}) { 160 # verify that the facets are among the valid and registered ones 161 foreach my $fkey (keys(%{$p{facets}})) { 162 pexit("Invalid facet: '$fkey'") unless ($facets{$fkey}); 163 } 164} 165 166my $t1 = time(); 167 168my $logf = 'results-' . time() . '.log'; 169$logf = $opt_f if ($opt_f); 170open( my $fh, '>>', $logf ) || die $!; 171 172do_epp_operation( 173 $obj{$opt_o}, $opt_c, $clid, $pass, $newpass, 174 $socktype, $server, $port, $fh, %p 175); 176 177my $t2 = time(); 178 179print "\nTime used: ", $t2 - $t1, "secs\n"; 180 181############ 182# 183# S U B S 184# 185########### 186 187sub parse_params { 188 my $p = shift; 189 190 eval $opt_p; # assume a Data::Dumper syntax, read pars with eval! 191 192 if ($@) { 193 194 # eval has failed, $@ tells us why 195 pexit( "Eval failed, specify a valid parameter string, msg: " 196 . $@ 197 . "\n" ); 198 } 199 return 1; 200} 201 202sub do_epp_operation { 203 my ( $obj, $cmd, $clid, $pw, $newpw, $socktype, $server, $port, $fh, %p ) 204 = @_; 205 206 my $res = 1; 207 208 select($fh); 209 $|++; 210 select(STDOUT); 211 212 #print "Dumping XML exchange to $logf\n"; 213 214 my ( $dri, $rc ); 215 216 eval { 217 ( $dri, $rc ) 218 = init_reg_no( $clid, $pw, $newpw, $socktype, $server, $port, 219 $fh ); 220 do_command( $obj, $cmd, $dri, $rc, %p ); 221 }; 222 if ($@) { 223 print "\n\nAn EXCEPTION happened !\n"; 224 if ( ref($@) ) { 225 print "FAILURE: Error descriptions: ", ref($@), "\n"; 226 $@->print(); 227 print "\n"; 228 dump_conditions($dri); 229 } else { 230 print "FAILURE: No extra info: "; 231 print($@); 232 } 233 $res = 0; 234 } else { 235 print "\n\nSUCCESS"; 236 } 237 print "\n"; 238 239 # Important not to call dri->end too early, because condition date may be 240 # destroyed. 241 $dri->end(); 242 close($fh); 243 return $res; 244} 245 246sub pexit { 247 print shift, "\n\n"; # The error text supplied 248 pod2usage( 249 { -message => $0, 250 -exitval => 0 251 } 252 ); 253 return; 254} 255 256sub print_result { 257 my $dri = shift; 258 my $rc = shift; 259 260 print "\n", " result_code : ", $dri->result_code(), "\n", 261 " native_code : ", $dri->result_native_code(), "\n", 262 " result_message : ", $dri->result_message(), "\n", 263 " language : ", $dri->result_lang(), "\n\n"; 264 265 if ( $dri->can('result_is_pending') ) { 266 print " pending : ", $dri->result_is_pending(), "\n"; 267 } 268 if ( $dri->can('result_info') ) { 269 print "info : ", $dri->result_info(), "\n"; 270 } 271 if ( $dri->can('result_print') ) { 272 print "result_print: ", $dri->result_print(), "\n"; 273 } 274 if ( $dri->can('result_print_full') ) { 275 print "result_print_full: ", $dri->result_print_full(), "\n"; 276 } 277 if ($rc) { 278 print_rc_result($rc); 279 } 280 foreach my $w ( 281 'action', 'exist', 'trStatus', 'reID', 282 'reDate', 'acID', 'acDate', 'exDate' 283 ) 284 { 285 if ( my $v = $dri->get_info($w) ) { 286 printf "$F", $w, $v; 287 } 288 } 289 return 1; 290} 291 292sub print_rc_result { 293 my $rc = shift; 294 295 # Print rc-specific info, not found in $dri->result_*() 296 297 if ( $rc->can('is_pending') ) { 298 print "rcpending : ", $rc->is_pending(), "\n" 299 if ( $rc->is_pending() ); 300 } 301 if ( $rc->can('info') ) { 302 print "rcinfo : ", $rc->info(), "\n" if ( $rc->info() ); 303 } 304 305 my $F2 = " %-15s: %s%s\n"; 306 if ( $rc->can('trid') && $rc->trid() ) { 307 308 # trid seems to be returned as an array with two values 309 printf "$F2", 'trid', $rc->trid(); 310 } 311 return 1; 312} 313 314sub contact_object_as_string { 315 my ( $dri, $o, @om ) = @_; 316 317 return unless $o; 318 319 # Populate the loc-array values 320 # $ci->int2loc(); # hmm, if int2loc is called, it overwrites the 321 # localized data and destroys some of it 322 323 my $s = ""; 324 325 foreach my $m (@om) { 326 my $r; 327 328 if ( $o->can($m) ) { 329 if ( $m eq 'street' ) { 330 331 # Is an array up to 3 elements 332 $r = join ", ", @{ $o->$m }; 333 334 } elsif ( $m eq 'identity' ) { 335 $r = "type : " . $o->$m->{type} 336 if ( $o->$m && $o->$m->{type} ); 337 $r .= ", value: " . $o->$m->{value} 338 if ( $o->$m && $o->$m->{value} ); 339 340 } elsif ( $m eq 'xemail' || $m eq 'rolecontact' ) { 341 342 # Is an array up to n elements 343 $r = join ", ", @{ $o->$m } if ( $o->$m ); 344 } else { 345 my @va; 346 @va = $o->$m if ( $o->$m ); 347 foreach my $v (@va) { 348 if ( ref($v) && ( ref($v) ne 'SCALAR' ) ) { 349 350 # don't bother diving into it ... use a Dumper 351 $r .= sprintf Dumper $v; 352 } else { 353 $r .= $v if ($v); 354 } 355 } 356 } 357 $s .= sprintf "$F", $m, $r if ($r); 358 } else { 359 $s .= "-- method $m not possible \n"; 360 } 361 } 362 foreach my $i ( 'roid', 'crDate', 'upDate', 'clID', 'crID', 'upID' ) { 363 my $v = $dri->get_info($i); 364 $v = '-' unless $v; 365 $s .= sprintf "$F", $i, $v; 366 } 367 return $s; 368} 369 370sub host_object_as_string { 371 my ($dri) = @_; 372 373 my $s = ""; 374 my $hi = $dri->get_info('self'); 375 376 foreach my $m ( 'loid', 'count' ) { 377 my $v = '-'; 378 $v = $hi->$m if ( $hi->$m ); 379 $s .= sprintf "$F", $m, $v; 380 } 381 my @nms = $hi->get_names(); 382 $s .= sprintf "$F", 'names', @nms; 383 384 foreach my $n (@nms) { 385 my @d = $hi->get_details($n); 386 387 # ip-addresses are optional 388 my @v; 389 @v = @{ $d[1] } if ( @{ $d[1] } ); 390 @v = ("-") unless (@v); 391 $s .= sprintf "$F", 'v4 addresses', join( ", ", @v ); 392 393 @v = (); 394 @v = @{ $d[2] } if ( @{ $d[2] } ); 395 @v = ("-") unless (@v); 396 $s .= sprintf "$F", 'v6 addresses', join( ", ", @v ); 397 } 398 399 # contact is a scalar 400 401 my $ct = "-"; 402 if ( $ct = $dri->get_info('contact') ) { 403 $s .= sprintf "$F", 'contact', $ct; 404 } 405 foreach my $i ( 406 'roid', 'exDate', 'crDate', 'upDate', 407 'trDate', 'clID', 'crID', 'upID' 408 ) 409 { 410 my $v = $dri->get_info($i); 411 $v = '-' unless $v; 412 $s .= sprintf "$F", $i, $v; 413 } 414 return $s; 415} 416 417#You may use get_info with the following keys to get more information: 418# - ns : a Net::DRI::Data::Hosts object representing the nameservers of the 419# domain 420# - status : a Net::DRI::Data::StatusList object representing the current 421# status list of the domain queried 422# - exDate, crDate, upDate, trDate : DateTime objects representing the 423# expiration, creation, last update, and transfer date for the domain 424# queried 425# - clID, crID, upID : (strings) local registry ID of the current sponsoring 426# registrar, the registrar having created, and the registrar (or 427# registry) having last modified the domain queried 428 429sub domain_object_as_string { 430 my ($dri) = @_; 431 432 my $s = ""; 433 434 ## 435 # authInfo 436 # 437 $s .= sprintf "--- Auth info ---\n"; 438 my $au = $dri->get_info('auth'); 439 440 foreach my $i ( 441 'name', 'roid', 'exDate', 'crDate', 'upDate', 'trDate', 442 'clID', 'crID', 'upID' 443 ) 444 { 445 my $v = $dri->get_info($i); 446 $v = '-' unless $v; 447 $s .= sprintf "$F", $i, $v; 448 if ( $i eq 'name' ) { 449 450 # Also print the UTF-8 of an ACE 451 my $idn 452 = idn_to_unicode( $v, 'utf-8', IDNA_USE_STD3_ASCII_RULES ); 453 $s .= sprintf "$F", 'IDN-name', $idn; 454 } 455 456 } 457 ## 458 # name servers 459 # 460 $s .= sprintf "--- Name servers ---\n"; 461 my $ns = $dri->get_info('ns'); 462 463 my $v = '-'; 464 if ( ( $v = $ns->count() ) > 0 ) { 465 $s .= sprintf "$F", 'ns count', $v; 466 } 467 foreach my $n ( $ns->get_names() ) { 468 $s .= sprintf "$F", 'ns name', $n; 469 } 470 471 #################### 472 # Contacts 473 # 474 # contact is an array ref. 475 my $co = $dri->get_info('contact'); 476 477 $s .= sprintf "--- Contacts ---\n"; 478 479 foreach my $ct ( 'registrant', 'admin', 'tech' ) { 480 my @r = $co->get($ct); 481 $v = "-"; 482 foreach my $r (@r) { 483 $v = $r->srid if ( $r->srid ); 484 $s .= sprintf "$F", $ct, $v; 485 } 486 } 487 488 #################### 489 # Domain status 490 # 491 $s .= sprintf "--- Status summary ---\n"; 492 493 my $st = $dri->get_info('status'); 494 495 # domain status methods 496 my @dsm = ( 497 'is_active', 498 'is_published', 499 'is_pending', 500 'is_linked', 501 'can_update', 502 'can_transfer', 503 'can_delete', 504 'can_renew', 505 506 #'possible_no', # hmmm.. what's this for? 507 #'no' # hmmm.. what's this for? 508 509 ); 510 foreach my $ds (@dsm) { 511 $v = "-"; 512 $v = $st->$ds if ( $st->$ds ); 513 $s .= sprintf "$F", $ds, $v; 514 } 515 516 #### 517 # also dump all the detailed status values 518 my @ls = $st->list_status(); 519 520 $s .= sprintf "--- Flag details ---\n"; 521 foreach my $l (@ls) { 522 $s .= sprintf "$F", 'flag', $l; 523 } 524 return $s; 525} 526 527sub get_info_object_as_string { 528 my ( $o, @om ) = @_; 529 530 my $s = ""; 531 532 foreach my $m (@om) { 533 my $v = "-"; 534 535 if ( $o->get_info($m) ) { 536 $v = $o->get_info($m); 537 if ( $v && ref($v) && ( ref($v) ne 'SCALAR' ) ) { 538 539 # don't bother diving into it ... use a Dumper 540 $v = sprintf Dumper $v; 541 next; 542 } 543 $s .= sprintf "$F", $m, $v; 544 } else { 545 $s .= "-- method $m not possible \n"; 546 } 547 } 548 return $s; 549} 550 551sub init_reg_no { 552 my ( $clid, $pw, $newpw, $socktype, $server, $port, $fh ) = @_; 553 554 my $dri = Net::DRI->new( 555 { 556 cache_ttl => 10, 557 logging => ['files', 558 {output_directory => './', 559 output_filename=>$opt_f, 560 level=>'notice', 561 xml_indent=>1}] 562 } 563); 564 565 $dri->add_registry( 'NO', { clid => $clid } ); 566 567 my %pars = ( 568 defer => 0, 569 socktype => $socktype, 570 remote_host => $server || 'epp.test.norid.no', 571 remote_port => $port || 700, 572 protocol_connection => 'Net::DRI::Protocol::EPP::Connection', 573 protocol_version => 1, 574 client_login => $clid, 575 client_password => $pw, 576 ); 577 578 $pars{client_newpassword} = $newpw if ($newpw); 579 580 my $rc = $dri->target('NO')->add_current_profile( 581 'profile1', 582 'epp', 583 { %pars, }, 584 ); 585 586 ## Here we catch all errors during setup of transport, such as 587 ## authentication errors 588 die($rc) unless $rc->is_success(); 589 590 return ( $dri, $rc ); 591} 592 593sub do_command { 594 my ( $obj, $cmd, $dri, $rc, %p ) = @_; 595 596 use Data::Dumper; 597 $Data::Dumper::Indent = 1; 598 599 if ( $cmd eq 'hello' ) { 600 print "*** hello ***\n"; 601 602 # no objects in this case 603 604 $rc = $dri->process( 'session', 'noop', [] ); 605 die($rc) unless $rc->is_success(); ## Her 606 print "Hello was a success\n"; 607 exit 0; 608 } 609 610 print "*** Executing EPP command: $obj . $cmd ***\n"; 611 612 if ( $obj eq 'host' ) { 613 if ( $cmd eq 'check' ) { 614 print ".check ", $p{name}, "\n"; 615 $rc = $dri->host_check( $p{name}, { facets => $p{facets}} ); 616 print_result( $dri, $rc ); 617 die($rc) unless $rc->is_success(); 618 619 # For a host check, only an exist check is available in DRI 620 print "Host $p{name} ", 621 $dri->get_info('exist') ? "exists" : "do not exist"; 622 } 623 if ( $cmd eq 'info' ) { 624 my %a; 625 626 # host info can specify a sponsoringclientid 627 $a{sponsoringclientid} = $p{sponsoringclientid} if ( $p{sponsoringclientid} ); 628 629 $a{facets} = $p{facets} if ( $p{facets} ); 630 631 $rc = $dri->host_info( $p{name}, \%a ); 632 print_result( $dri, $rc ); 633 die($rc) unless $rc->is_success(); 634 635 print host_object_as_string($dri); 636 } 637 if ( $cmd eq 'create' ) { 638 639 # DRI 0.85 need to create the hosts objects directly .. 640 my $nso = $dri->local_object('hosts'); 641 642 $nso->add( $p{name}, $p{v4}, $p{v6} ); 643 $rc = $dri->host_create( $nso, { contact => $p{contact}, facets => $p{facets} } ); 644 645 print_result($dri); 646 die($rc) unless $rc->is_success(); 647 } 648 if ( $cmd eq 'update' ) { 649 ### 650 # We can change all params, name, ip-addresses and contact 651 # Proper add/del keys must be supplied by the user to do this 652 my $toc = $dri->local_object('changes'); 653 if ( $p{ipset} ) { 654 655 # add and del keys shall describe what to do 656 my ( $v4a, $v4d ); 657 $v4a = $p{ipset}{add}{v4} if ( $p{ipset}{add}{v4} ); 658 $v4d = $p{ipset}{del}{v4} if ( $p{ipset}{del}{v4} ); 659 $toc->add( 'ip', 660 $dri->local_object('hosts')->add( $p{name}, $v4a, [] ) ) 661 if ($v4a); 662 $toc->del( 'ip', 663 $dri->local_object('hosts')->add( $p{name}, $v4d, [] ) ) 664 if ($v4d); 665 } 666 667 # Update name if nname is specified 668 if ( $p{nname} && $p{nname} ne $p{name} ) { 669 670 # a new name is specified, insert it as a chg 671 $toc->set( 'name', $p{nname} ); 672 } 673 674 # 675 # Contact data 676 if ( defined( $p{contact} ) ) { 677 678 # add and del keys shall describe what to do 679 foreach my $s ( 'add', 'del' ) { 680 my $n = $p{contact}{$s}; 681 $toc->$s( 'contact', $n ) if ( defined($n) && $n ); 682 } 683 } 684 685 # Facets 686 if ( defined($p{facets}) ) { 687 $toc->set( 'facets', $p{facets} ); 688 } 689 690 $rc = $dri->host_update( $p{name}, $toc); 691 print_result($dri); 692 die($rc) unless $rc->is_success(); 693 } 694 if ( $cmd eq 'delete' ) { 695 $rc = $dri->host_delete( $p{name}, { facets => $p{facets} } ); 696 print_result($dri); 697 die($rc) unless $rc->is_success(); 698 } 699 } 700 701 if ( $obj eq 'contact' ) { 702 703 if ( $cmd eq 'check' ) { 704 my $co = $dri->local_object('contact')->new()->srid( $p{srid} ); 705 706 $rc = $dri->contact_check($co, { facets => $p{facets} } ); 707 print_result($dri); 708 709 die($rc) unless $rc->is_success(); 710 711 print "Contact $p{srid} ", 712 $dri->get_info('exist') ? " exists" : "do not exist"; 713 } 714 715 if ( $cmd eq 'info' ) { 716 my $co = $dri->local_object('contact')->new()->srid( $p{srid} ); 717 718 $rc = $dri->contact_info($co, { facets => $p{facets} } ); 719 720# print "Contact $p{srid} ", $dri->get_info('exist')?" exists":"do not exist"; 721 print_result($dri); 722 723 die($rc) unless $rc->is_success(); 724 725 my $o = $dri->get_info('self'); 726 727 print contact_object_as_string( $dri, $o, @cm ); 728 } 729 730 if ( $cmd eq 'create' ) { 731 my $co = $dri->local_object('contact')->new(); 732 733 # auth not supported for .NO contact 734 735 foreach my $m (@cm) { 736 737 #next if $m eq 'sp'; # Not supported by .NO today, 738 # but better to let server reject in case that changes 739 my $v = $p{$m}; 740 741 #print STDERR "ref $m: ", ref($p{$m}), "\n"; 742 $co->$m( $p{$m} ) if ( $p{$m} ); 743 } 744 $rc = $dri->contact_create($co); 745 746 print_result($dri); 747 748 die($rc) unless ( $rc->is_success() ); 749 750 #print contact_object_as_string($dri, $co, @cm); 751 752 print get_info_object_as_string( $dri, @drim ); 753 } 754 755 if ( $cmd eq 'update' ) { 756 ### 757 # We can change all params, name, ip-addresses and contact 758 # Proper add/del keys must be supplied by the user to do this 759 760 ######### 761 my $co = $dri->local_object('contact')->srid( $p{srid} ); 762 my $toc = $dri->local_object('changes'); 763 my $co2 = $dri->local_object('contact'); 764 765 foreach my $m (@cm) { 766 $co2->$m( $p{$m} ) if ( $p{$m} ); 767 } 768 $toc->set( 'info', $co2 ); 769 770 if ( $p{type} ) { 771 $toc->set( 'type', $p{type} ); 772 } 773 if ( $p{mobilephone} ) { 774 $toc->set( 'mobilephone', $p{mobilephone} ); 775 } 776 if ( $p{xdisclose} ) { 777 $toc->set( 'xdisclose', $p{xdisclose} ); 778 } 779 if ( $p{identity} ) { 780 $toc->set( 'identity', $p{identity} ); 781 } 782 # 783 # organization data 784 # 785 if ( $p{organization} ) { 786 787 # add and del keys shall describe what to do 788 foreach my $s ( 'add', 'del' ) { 789 my $n = $p{organization}{$s}; 790 $toc->$s( 'organization', $n ) if ( defined($n) && $n ); 791 } 792 } 793 794 # 795 # RoleContact data 796 # 797 if ( $p{rolecontact} ) { 798 799 # add and del keys shall describe what to do 800 foreach my $s ( 'add', 'del' ) { 801 my $n = $p{rolecontact}{$s}; 802 $toc->$s( 'rolecontact', $n ) if ( defined($n) && $n ); 803 } 804 } 805 806 # 807 # xemail data 808 # 809 if ( $p{xemail} ) { 810 # add and del keys shall describe what to do 811 foreach my $s ( 'add', 'del' ) { 812 my $n = $p{xemail}{$s}; 813 $toc->$s( 'xemail', $n ) if ( defined($n) && $n ); 814 } 815 } 816 817 # Facets 818 if ( defined($p{facets}) ) { 819 $toc->set( 'facets', $p{facets} ); 820 } 821 822 $rc = $dri->contact_update( $co, $toc ); 823 824 print_result($dri); 825 die($rc) unless $rc->is_success(); 826 } 827 828 if ( $cmd eq 'delete' ) { 829 my $co = $dri->local_object('contact')->new()->srid( $p{srid} ); 830 831 $rc = $dri->contact_delete($co, { facets => $p{facets} } ); 832 print_result($dri); 833 834 die($rc) unless $rc->is_success(); 835 836 # Do an info to verify the delete 837 print "Verifying delete by an info ....: \n"; 838 do_command( $obj, 'info', $dri, $rc, %p ); 839 } 840 } 841 842 if ( $obj eq 'domain' ) { 843 my ( $ace, $idn ); 844 845 # We accept input name as either an ace-name or an utf-8 846 if ( $p{name} ) { 847 $idn = lc( $p{name} ); 848 die "Cannot lower case domain name: $idn" unless ($idn); 849 850 $ace = idn_to_ascii( $idn, 'utf-8', IDNA_USE_STD3_ASCII_RULES ); 851 die "Cannot convert domain to ace" unless ($ace); 852 853 $idn = idn_to_unicode( $ace, 'utf-8', IDNA_USE_STD3_ASCII_RULES ); 854 die "Cannot convert domain to ace" unless ($ace); 855 856 undef $idn if ( $ace eq $idn ); 857 } else { 858 die "No domain name specified"; 859 } 860 861 #print "input name: $p{name}\n"; 862 #print "ace : $ace\n"; 863 #print "idn : $idn\n"; 864 865 die "Illegal domain name" unless ($ace); 866 867 if ( $cmd eq 'check' ) { 868 869 $rc = $dri->domain_check($ace, { facets => $p{facets} }); 870 871 print_rc_result($rc); 872 print_result($dri); 873 874 die($rc) unless $rc->is_success(); 875 876 print "Domain $p{name} ", 877 $dri->get_info('exist') ? " exists" : "do not exist"; 878 } 879 880 if ( $cmd eq 'info' ) { 881 $rc = $dri->domain_info($ace, { facets => $p{facets} }); 882 print_result($dri); 883 die($rc) unless $rc->is_success(); 884 885 print domain_object_as_string($dri); 886 } 887 888 if ( $cmd eq 'create' ) { 889 890 # 891 # A create is supported as follows: 892 # A domain name in 'name' 893 # A contact set in coset=>{billing=>'THO123', admin=>'TH2345P', ... 894 # A name server set in nsset=>{billing=>'THO123', admin=>'TH2345P', ... 895 # 896 my $cs = $dri->local_object('contactset'); 897 898 my $du; 899 if ( $p{duration} ) { 900 $du = DateTime::Duration->new( $p{duration} ); 901 die "Illegal duration value" unless ($du); 902 } 903 $cs->set( $dri->local_object('contact')->srid( $p{registrant} ), 904 'registrant' ) 905 if ( $p{registrant} ); 906 907 my $c; 908 if ( $c = $p{coset} ) { 909 910 # we have a contact set, DRI accepts multiple of each type, so we implement 911## that and let server policy decide if multiple can be accepted 912 913 my @acs; 914 my @ca; 915 foreach my $t ( 'admin', 'billing', 'tech' ) { 916 if ( $c->{$t} ) { 917 if ( ref( $c->{$t} ) eq 'ARRAY' ) { 918 @ca = @{ $c->{$t} }; 919 } else { 920 921 # A single scalar srid 922 push @ca, $c->{$t}; 923 } 924 foreach my $s (@ca) { 925 push @acs, 926 $dri->local_object('contact')->srid($s); 927 } 928 $cs->set( [@acs], $t ); 929 undef @ca; 930 undef @acs; 931 } 932 } 933 } 934 935 # see the DRI README doc. 936 # - domain_create() does a lot of checking and creating if the objects does 937 # not exist, 938 # - domain_create_only() has a simpler behaviour 939 # We use domain_create_only(), it's simplest 940 my $nso = $dri->local_object('hosts'); 941 if ( $p{nsset} ) { 942 if ( my @ns = @{ $p{nsset} } ) { 943 foreach my $n (@ns) { 944 $nso->add( $n, [], [] ); 945 } 946 } 947 } 948 $rc = $dri->domain_create( 949 $ace, 950 { pure_create => 1, ## this was previously achieved by using domain_create_only that is now deprecated 951 auth => { pw => $p{pw} }, 952 duration => $du, 953 contact => $cs, 954 ns => $nso, 955 facets => $p{facets}, 956 } 957 ); 958 print_result($dri); 959 die($rc) unless ( $rc->is_success() ); 960 } 961 962 if ( $cmd eq 'update' ) { 963 ### 964 # We can change most params, but not domain name or duration 965 # Proper add/del keys must be supplied by the user to do this 966 967 my $cs = $dri->local_object('contactset'); 968 my $toc = $dri->local_object('changes'); 969 970 $toc->set( 'registrant', 971 $dri->local_object('contact')->srid( $p{registrant} ), 972 'registrant' ) 973 if ( $p{registrant} ); 974 975 # Update is the only command where the status flags can be set/changed 976 # The flag values to use by the DRI user is the following (from Status.pm): 977 # my %s=('delete' => 'clientDeleteProhibited', 978 # 'renew' => 'clientRenewProhibited', 979 # 'update' => 'clientUpdateProhibited', 980 # 'transfer' => 'clientTransferProhibited', 981 # 'publish' => 'clientHold', 982 # ); 983 984 if ( $p{pw} ) { 985 $toc->set( 'auth', { pw => $p{pw} } ); 986 } 987 988 if ( my $s = $p{status} ) { 989 foreach my $op ( 'add', 'del' ) { 990 my $sl = $dri->local_object('status'); 991 992 # add and del keys shall describe what to do 993 994 my $a; 995 $a = $p{status}{$op} if ( $p{status}{$op} ); 996 997 # array or not 998 if ( ref($a) eq 'ARRAY' ) { 999 foreach my $m (@$a) { 1000 $sl->no($m); 1001 } 1002 } else { 1003 $sl->no($a); 1004 } 1005 $toc->$op( 'status', $sl ) or die "Invalid status value"; 1006 } 1007 } 1008 1009 if ( my $c = $p{coset} ) { 1010 1011 # we have a contact set, DRI accepts multiple of each type, so we implement 1012 # that and let server policy decide if multiple can be accepted 1013 1014 my @acs; 1015 my @ca; 1016 1017 # add and del keys shall describe what to do 1018 foreach my $op ( 'add', 'del' ) { 1019 $cs = $dri->local_object('contactset'); 1020 foreach my $r ( 'admin', 'billing', 'tech' ) { 1021 if ( my $v = $c->{$op}->{$r} ) { 1022 1023 if ( ref($v) eq 'ARRAY' ) { 1024 @ca = @{$v}; 1025 } else { 1026 1027 # A single scalar srid 1028 push @ca, $v; 1029 } 1030 foreach my $va (@ca) { 1031 push @acs, 1032 $dri->local_object('contact')->srid($va); 1033 } 1034 } 1035 $cs->set( [@acs], $r ); 1036 undef @ca; 1037 undef @acs; 1038 } 1039 $toc->$op( 'contact', $cs ); 1040 undef $cs; 1041 } 1042 } 1043 if ( $p{nsset} ) { 1044 foreach my $op ( 'add', 'del' ) { 1045 1046 # add and del keys shall describe what to do 1047 my $a; 1048 $a = $p{nsset}{$op} if ( $p{nsset}{$op} ); 1049 1050 # array or not 1051 if ( ref($a) eq 'ARRAY' ) { 1052 foreach my $m (@$a) { 1053 $toc->$op( 'ns', 1054 $dri->local_object('hosts')->add($m) ); 1055 } 1056 } else { 1057 $toc->$op( 'ns', 1058 $dri->local_object('hosts')->add($a) ); 1059 } 1060 } 1061 } 1062 # Facets 1063 if ( defined($p{facets}) ) { 1064 $toc->set( 'facets', $p{facets} ); 1065 } 1066 1067 $rc = $dri->domain_update( $ace, $toc ); 1068 print_result($dri); 1069 die($rc) unless $rc->is_success(); 1070 } 1071 if ( $cmd eq 'delete' ) { 1072 die 1073 "Cannot delete domain, rejected by DRI:domain_status_allows_delete()" 1074 unless ( $dri->domain_status_allows_delete($ace) ); 1075 1076 # pure_delete should suppress a domain_info() from being first performed 1077 # to check if the domain exists 1078 my %a=(pure_delete => 1); 1079 1080 $a{deletefromdns} = $p{deletefromdns} if $p{deletefromdns}; 1081 $a{deletefromregistry} = $p{deletefromregistry} if $p{deletefromregistry}; 1082 $a{facets} = $p{facets} if $p{facets}; 1083 1084 $rc = $dri->domain_delete( $ace, \%a ); 1085 1086 print_result($dri); 1087 die($rc) unless $rc->is_success(); 1088 } 1089 1090 if ( $cmd eq 'transfer_query' ) { 1091 my %a; 1092 $a{auth} = { pw => $p{pw} } if ( $p{pw} ); 1093 $a{facets} = $p{facets} if ( $p{facets} ); 1094 1095 $rc = $dri->domain_transfer_query( $ace, \%a ); 1096 print_rc_result($rc); 1097 print_result($dri); 1098 die($rc) unless $rc->is_success(); 1099 } 1100 1101 if ( $cmd eq 'transfer_cancel' ) { 1102 my %a; 1103 $a{auth} = { pw => $p{pw} } if ( $p{pw} ); 1104 $a{facets} = $p{facets} if ( $p{facets} ); 1105 1106 $rc = $dri->domain_transfer_stop( $ace, \%a ); 1107 print_rc_result($rc); 1108 print_result($dri); 1109 die($rc) unless $rc->is_success(); 1110 } 1111 1112 if ( $cmd eq 'transfer' ) { 1113 1114 # this is a transfer init operation. 1115 1116 my %a; 1117 $a{auth} = { pw => $p{pw} } if ( $p{pw} ); 1118 $a{facets} = $p{facets} if ( $p{facets} ); 1119 1120 # notify parameters 1121 if ( $p{notify} ) { 1122 1123 # Only one is accept 1124 $a{mobilephone} = $p{notify}{mobilephone} 1125 if ( $p{notify}{mobilephone} ); 1126 $a{email} = $p{notify}{email} if ( $p{notify}{email} ); 1127 } 1128 $rc = $dri->domain_transfer_start( $ace, \%a ); 1129 print_rc_result($rc); 1130 print_result($dri); 1131 die($rc) unless $rc->is_success(); 1132 } 1133 if ( $cmd eq 'transfer_execute' ) { 1134 my %a; 1135 $a{auth} = { pw => $p{pw} } if ( $p{pw} ); 1136 $a{token} = $p{token} if ( $p{token} ); 1137 $a{facets} = $p{facets} if ( $p{facets} ); 1138 1139 # require either a token or a pw 1140 unless ( exists( $p{token} ) && $p{token} || exists( $p{pw} ) ) { 1141 1142 die "Missing mandatory 'token' or 'pw' parameter in $cmd"; 1143 } 1144 my $du; 1145 if ( $p{duration} ) { 1146 $du = DateTime::Duration->new( $p{duration} ); 1147 die "Illegal duration value" unless ($du); 1148 $a{duration} = $du; 1149 } 1150 $rc = $dri->domain_transfer_execute( $ace, \%a ); 1151 print_rc_result($rc); 1152 print_result($dri); 1153 die($rc) unless $rc->is_success(); 1154 } 1155 1156 if ( $cmd eq 'renew' ) { 1157 my $du = undef; 1158 if ( $p{duration} ) { 1159 $du = DateTime::Duration->new( $p{duration} ); 1160 die "$0: Illegal duration value" unless ($du); 1161 } 1162 my $exp = undef; 1163 if ( $p{curexpiry} ) { 1164 my ( $y, $m, $d ) = split '-', $p{curexpiry}; 1165 $exp = DateTime->new( 1166 year => $y, 1167 month => $m, 1168 day => $d 1169 ); 1170 die "$0: Illegal curexpiry date " unless ($exp); 1171 } 1172 $rc = $dri->domain_renew( $ace, { duration => $du, current_expiration => $exp, facets => $p{facets} } ); 1173 print_rc_result($rc); 1174 print_result($dri); 1175 die($rc) unless $rc->is_success(); 1176 } 1177 1178 if ( $cmd eq 'withdraw' ) { 1179 1180 $rc = $dri->domain_withdraw($ace, { facets => $p{facets} } ); 1181 print_rc_result($rc); 1182 print_result($dri); 1183 die($rc) unless $rc->is_success(); 1184 } 1185 } # End of domain operations 1186 1187# Standardized EPP elements 1188my @epp = ( 1189 'id', 1190 'qdate', 1191 'msg', 1192 'content', 1193 'nocontent', # .NO specific content desc 1194 'lang', 1195 'object_type', 1196 'object_id', 1197 'action', 1198 'result', 1199 'trid', 1200 'svtrid', 1201 'date', 1202 ); 1203 1204# .NO conditions 1205my @noc = ( 1206 'msg', 1207 'code', 1208 'severity', 1209 'details' 1210 ); 1211 1212 my %m; 1213 1214 # Message / poll operations 1215 if ( $obj eq 'message' ) { 1216 1217 if ( $cmd eq 'waiting' ) { 1218 print "Poll: messages waiting: ", $dri->message_waiting({ facets => $p{facets} }), "\n"; 1219 } 1220 if ( $cmd eq 'count' ) { 1221 print "Poll: message count: ", $dri->message_count({ facets => $p{facets} }), "\n"; 1222 } 1223 if ( $cmd eq 'retrieve' ) { 1224 $rc = $dri->message_retrieve({ facets => $p{facets} }); 1225 1226 print_rc_result($rc); 1227 print_result($dri); 1228 1229 die($rc) unless $rc->is_success(); 1230 1231 if ( my $c = ($dri->message_count() > 0) ) { 1232 1233 # messages returned 1234 for ( my $i = 1; $i <= $c; $i++ ) { 1235 my $li = $dri->get_info('last_id'); 1236 1237 my ($qda, $lng, $cnt, $oty, $oid, 1238 $act, $res, $ctr, $str, $tr, $dat 1239 ); 1240 if ( defined($li) && $li) { 1241 foreach my $e (@epp) { 1242 my $v; 1243 $v = $dri->get_info( $e, 'message', $li ); 1244 1245 if (defined($v) && $v) { 1246 if ($e eq 'qdate') { 1247 # make the DateTime object a scalar time string 1248 $v = sprintf $v; 1249 } 1250 $m{$e} = $v; 1251 } 1252 } 1253 # .NO conditions 1254 my $c; 1255 $c = $dri->get_info( 'conditions', 'message', $li ); 1256 $m{conditions} = $c if ($c); 1257 } 1258 } 1259 } 1260 # Just dump the message elements 1261 print "message: ", Dumper \%m; 1262 } 1263 if ( $cmd eq 'delete' ) { 1264 if ( my $id = $p{id} ) { 1265 $rc = $dri->message_delete($id, { facets => $p{facets} }); 1266 print_rc_result($rc); 1267 print_result($dri); 1268 die($rc) unless $rc->is_success(); 1269 } else { 1270 print "Poll: No 'id' specified\n"; 1271 } 1272 } 1273 } 1274 return; 1275} 1276 1277sub dump_conditions { 1278 my $dri = shift; 1279 1280 # get the conditions array from $rinfo structure which is built by Result.pm 1281 # 1282 my $cd = $dri->get_info('conditions'); 1283 1284 #print "cd: ", Dumper $cd; 1285 foreach my $c (@$cd) { 1286 foreach my $i ( 'code', 'severity', 'msg', 'details' ) { 1287 my $v; 1288 $v = '-' unless ( $v = $c->{$i} ); 1289 printf "$F", $i, $v; 1290 } 1291 } 1292 return; 1293} 1294 1295#__END__ 1296 1297=pod 1298 1299=head1 NAME 1300 1301epp_client_no.pl - A command line client program using Net::DRI towards the 1302.NO EPP registry. 1303 1304=head1 DESCRIPTION 1305 1306The client supports creation and maintainance of host, contact and domain 1307objects for .NO. It supports various transfer operations, as well as poll 1308operation for the message queue. 1309 1310It was developed for testing of the .NO extensions to Net::DRI, but can 1311probably be used by users who are comfortable with a simple command line 1312interfaces. 1313 1314=head1 SYNOPSIS 1315 1316=head2 Command line 1317 1318B<perl epp_client_no.pl [Connect arguments] [Command arguments]> 1319 1320=head3 Arguments 1321 1322=over 1323 1324=item Mandatory connect arguments 1325 1326 -C: Client ID, your EPP registrar account name, typical regxxx, 1327 where xxx is a number 1328 -W: Account password, your EPP account password 1329 -S: Server name, the registry server 1330 -P: EPP server port 1331 1332=item Optional connect arguments 1333 1334 -f: Log file. The Net::DRI raw XML exchange will be dumped to this file 1335 -L: Use SSL connection 1336 -w: New account password, will be set in first EPP login 1337 1338=item Command arguments 1339 1340The command argument specify the EPP operation to perform: 1341 1342 -o: EPP object. 1343 One of contact, host, domain, message 1344 -c: EPP command. 1345 One of hello, create, update, info, delete, transfer, transfer_cancel, 1346 transfer_execute, count, waiting, retrieve 1347 -p: EPP parameter argument string, in a format that can be eval'ed into 1348 a hash, se parameter string examples below. 1349 1350=back 1351 1352=head3 About each EPP command sequence 1353 1354Each command will be performed as follows: 1355 1356 - Socket connect, session initiation, a greeting is returned 1357 - an EPP login, which will succeed if the connect arguments are correct, 1358 otherwise fail, 1359 a greeting is returned if login is OK 1360 - an EPP command, according to the specified command arguments 1361 - an EPP logout 1362 - Session termination 1363 1364=head3 A simple connect and greeting test 1365 1366Basic connect to an EPP server should give you a greeting back if successful. 1367A simple connect to an EPP server and port: 1368 1369Raw port (no SSL): 1370 1371 telnet <EPP server> <EPP port> 1372 1373Encrypted with SSL: 1374 1375 openssl s_client -host <EPP server> -port <EPP port> 1376 1377=head3 About logging and filtering of the log output 1378 1379Logging is useful for debugging purposes, 1380 1381A client side log can be activated by -f option, like: 1382 1383 '-f xx.log' 1384 1385Tail on the log-file in a separate window is nice then. Even nicer is to 1386filter the tail through the supplied xmlfilter.pl utility, which will wrap the 1387raw XML to a pretty-printed dump. 1388 1389The filters '-s' option will skip all the login/logout and greetings which 1390otherwise will dominate the outpot. 1391 1392 'tail -f xx.log | ./xmlfilter.pl -s' 1393 1394=head3 About authInfo 1395 1396Auth-info (pw) can be set and updated only for domain objects, and is 1397needed only for a transfer-execute. 1398 1399=head1 EPP commands and arguments 1400 1401=head2 Hello command 1402 1403=over 1404 1405=item Hello 1406 1407-c hello 1408 1409A greeting shall be returned, with the menu! 1410 1411=back 1412 1413=head2 Contact object commands 1414 1415=head3 Contact create 1416 1417A .NO contact can be one of three types, person, organization or role. 1418For each contact created, the type must be specified via the mandatory 1419type extension. 1420 1421=over 1422 1423=item 1 Organization contact 1424 1425-o contact -c create -p E<34>%p=(name=>'EXAMPLE FIRM AS', street=>['Example building','Example st. 23', '5 etg'], city=>'Trondheim', pc=>'7465', cc=>'NO', voice=>'+47.12345678', fax=>'+47.12345678x01', email=>'xml@example.no', type=>'organization', identity=>{type=>'organizationNumber', value=>'987654321'})E<34> 1426 1427=item 2 Person contact 1 affiliated with a company 1428 1429-o contact -c create -p E<34>%p=(name=>'Peter Example Olsen', street=>['First example building','Example st. 1'], city=>'Trondheim', pc=>'7465', cc=>'NO', voice=>'+47.22345671', mobilephone=>'+47.123456781', email=>'peter.xml@example.no', type=>'person', organization=>'EFA12O')E<34> 1430 1431=item 3 Person contact 2 not affiliated with a company 1432 1433-o contact -c create -p E<34>%p=(name=>'John Example Johnsen', street=>['Second example building','Example st. 2'], city=>'Trondheim', pc=>'7465', cc=>'NO', voice=>'+47.22345672', mobilephone=>'+47.123456782', email=>'john.xml@example.no', type=>'person')E<34> 1434 1435=item 4 Role contact with two contact end a secondary extra email address 1436 1437-o contact -c create -p E<34>%p=(name=>'Example hostmaster', street=>['Example building','Example st. 23', '5 floor'], city=>'Trondheim', pc=>'7465', cc=>'NO', voice=>'+47.12345678', fax=>'+47.12345678x01', mobilephone=>'+47.123456789', email=>'hostmaster@example.no', type=>'role', rolecontact=>['PEO1P', 'JEO2P'], xemail=>'xml@example.no')E<34> 1438 1439=back 1440 1441=head3 Contact update 1442 1443In this example, a role contact update is shown. 1444 1445=over 1446 1447=item Role contact update 1448 1449Update a role and add an org. affiliation and a new person affiliation, also 1450remove one of the existing person affiliations. 1451Also change some of the address information and the mobile phone number. Keep 1452the rest of the info. 1453 1454-o contact -c update -p E<34>%p=(srid=>'TOH12R', name=>'New name on Hostmaster', street=>['Changed example building','Changed Example st. 23', '5 floor'], city=>'Trondheim', pc=>'7465', cc=>'NO', mobilephone=>'+47.123433389', organization=>{add=>['TOH1O']}, rolecontact=>{add=>['TOH1P'], del=>['TOH1P']})E<34> 1455 1456=back 1457 1458=head3 Contact info 1459 1460If a 'srid' returned on a create is 'TOH169O', it means that the org. handle 1461has the value 'TOH169O-NORID'. Lets do an info on this handle. 1462 1463=over 1464 1465=item Info on an organization contact handle 1466 1467-o contact -c info -p E<34>%p=(srid=>'TOH169O')E<34> 1468 1469=back 1470 1471=head3 Contact check 1472 1473=over 1474 1475=item Check on an organization contact handle 1476 1477-o contact -c check -p E<34>%p=(srid=>'TOH169O')E<34> 1478 1479You may get an usupported command on this! 1480 1481=back 1482 1483=head3 Contact delete 1484 1485=over 1486 1487=item Delete on an organization contact handle 1488 1489-o contact -c delete -p E<34>%p=(srid=>'TOH169O')E<34> 1490 1491=back 1492 1493=head2 Host object commands 1494 1495=head3 Host create 1496 1497=over 1498 1499=item 1 Create an external name server 1500 1501An external name server is a non .NO name server. 1502 1503External name servers must be registered without any IP-addresses. 1504 1505-o host -c create -p E<34>%p=(name=>'ns1.example.com')E<34> 1506 1507=item 2 A .NO name server will require an ipv4-address 1508 1509-o host -c create -p E<34>%p=(name=>'ns1.test.no', v4=>'123.234.123.12')E<34> 1510 1511=item 3 A .NO name server also with an optional contact 1512 1513-o host -c create -p E<34>%p=(name=>'ns2.test.no', v4=>'123.234.123.12', contact=>'JEO50P')E<34> 1514 1515=item 4 Multiple ip-addresses, pass them as an array 1516 1517-o host -c create -p E<34>%p=(name=>'ns3.test.no', v4=>['123.234.123.12','129.123.23.23'])E<34> 1518 1519=item 5 A .NO name server with ipv6 address as well 1520 1521 Will probably be rejected by server policy: 1522 1523-o host -c create -p E<34>%p=(name=>'ns4.test.no', v4=>['123.234.123.12','129.123.23.23'], v6=>['2001:700:1:0:215:f2ff:fe3e:fe65'])E<34> 1524 1525=back 1526 1527=head3 Host info 1528 1529=over 1530 1531=item 1 Info on a sponsored host object 1532 1533-o host -c info -p E<34>%p=(name=>'ns1.suniswanted.no')E<34> 1534 1535=item 2 info on a host object sponsored (owned) by another registrar 1536 1537It is possible to query hosts sponsored by other registrars, but you need to 1538specify his registrar id by the 'sponsoringClientID'. 1539 1540-o host -c info -p E<34>%p=(name=>'ns1.suniswanted.no', sponsoringclientid=>'reg9998')E<34> 1541 1542=back 1543 1544=head3 Host check 1545 1546=over 1547 1548=item Check to see whether a host name is available or registered 1549 1550-o host -c check -p E<34>%p=(name=>'ns1.test.no')E<34> 1551 1552=back 1553 1554=head3 Host delete 1555 1556=over 1557 1558=item Delete a host 1559 1560-o host -c delete -p E<34>%p=(name=>'ns1.test.no')E<34> 1561 1562=back 1563 1564=head3 Host update 1565 1566=over 1567 1568=item 1 First create a host with two ip-addresses and a contact 1569 1570-o host -c create -p E<34>%p=(name=>'ns7.test.no', v4=>['123.234.123.100','129.123.23.23'], contact=>'TAH8P')E<34> 1571 1572=item 2 Do an info to verify 1573 1574-o host -c info -p E<34>%p=(name=>'ns7.test.no')E<34> 1575 1576=item 3 Now, change/update it 1577 1578 - The name is changed to a new name specified in key nname 1579 - 3 new ip-addresses are added, one of the existing is removed, thus 4 1580 ip-addresses shall be the final result 1581 - The contact is deleted and changed to another one. 1582 1583-o host -c update -p E<34>%p=(name=>'ns7.test.no', nname=>'ns8.test.no', ipset=>{add=>{v4=>['1.2.3.1','1.2.3.2','1.2.3.3']}, del=>{v4=>'123.234.123.100'}}, contact=>{del=>'TAH8P', add=>'EFA2P'})E<34> 1584 1585=back 1586 1587=head2 Domain object commands 1588 1589=head3 Domain check 1590 1591=over 1592 1593=item 1 Check to see whether a domain name is available or registered 1594 1595-o domain -c check -p E<34>%p=(name=>'test.no')E<34> 1596 1597=back 1598 1599=head3 Domain info 1600 1601=over 1602 1603=item 1 Do an info on an existing domain 1604 1605-o domain -c info -p E<34>%p=(name=>'test.no')E<34> 1606 1607=back 1608 1609=head3 Domain create 1610 1611=over 1612 1613=item Notes 1614 1615=over 1616 1617=item * on the domain create methods in Net::DRI 1618 1619A lot of domain create methods are offered by Net::DRI. 1620 1621The client uses one specific create method, namely the domain_create_only(). 1622 1623=over 1624 1625=item * domain_create_only() 1626 1627This method assumes that the contacts handles and the nameservers listed are 1628ALREADY created in the registry, and this is closest to Norid's datamodel. 1629Hence, the client uses this method. 1630 1631=item * domain_create() 1632 1633This is another method which is a very powerful Net::DRI method. 1634 1635This method will do the same as domain_create_only(), but will also accept and 1636handle full contacts and nameserver objects as parameters, meaning that it will 1637check and create various objects as an integral part of the command. 1638 1639Support for this variant is not added to the client. 1640 1641=back 1642 1643=item * on the duration syntax 1644 1645The duration parameter must specify one year to be accepted in create, due to 1646the period definition in lib/Net/DRI/DRD/NO.pm 1647 1648Duration syntax: 'duration=>{years=>1}' or 'duration=>{months=>12}' 1649 1650=back 1651 1652=item 1 Create a normal domain 1653 1654Create a single domain with a a registrant, a contact set with one type each, 1655and two existing name servers, which is the minimum for .no: 1656 1657-o domain -c create -p E<34>%p=(name=>'test.no', pw=>'', registrant=>'THO12O', coset=>{tech=>'THO23P', admin=>'TH2345P'}, nsset=>['ns1.sol.no', 'ns2.sol.no'])E<34> 1658 1659=item 2 Create an IDN domain 1660 1661Create a single IDN-domain with a duration of 12 months, a registrant, a 1662contact set with one type each, and two existing name servers, which is the 1663minimum for .NO. 1664 1665IDN domains are converted to the ACE-form (xn--...) by the client, and the 1666ACE-form is passed as the domain name to the registry. 1667 1668-o domain -c create -p E<34>%p=(name=>'test-���.no', pw=>'', duration=>{months=>12}, registrant=>'THO12O', coset=>{tech=>'THO23P', admin=>'TH2345P'}, nsset=>['ns1.sol.no', 'ns2.sol.no'])E<34> 1669 1670This should be accepted if the handles and name servers exist and the domain 1671don't. 1672 1673=back 1674 1675=over 1676 1677=item Some domain create variants supported by Net::DRI but rejected by .NO registry policy. 1678 1679A lot of variants will pass the DRI, but should be rejected by the registry 1680because of local policy. 1681 1682=over 1683 1684=item * Create a single domain with a pw and a contact set, no name servers 1685 1686-o domain -c create -p E<34>%p=(name=>'test.no', pw=>'xxx', registrant=>'THO12O', coset=>{tech=>'THO23P', admin=>'TH2345P'})E<34> 1687 1688=item * Create a single domain with a duration of 12 months, no contact set, but only a nameserver 1689 1690-o domain -c create -p E<34>%p=(name=>'test2.no', pw=>'', registrant=>'THO12O', nsset=>['ns1.sol.no', 'ns2.sol.no'])E<34> 1691 1692=item * Create a single domain with a duration of 12 months, no registrant, no contact set, but only a nameserver 1693 1694-o domain -c create -p E<34>%p=(name=>'test2.no', pw=>'', nsset=>['ns1.sol.no'])E<34> 1695 1696=item * Create a single domain with a a domain name only: 1697 1698-o domain -c create -p E<34>%p=(name=>'test2.no', pw=>'')E<34> 1699 1700=back 1701 1702=back 1703 1704=head3 Domain delete 1705 1706Delete domain, optionally specify the two optional Norid dates for removal 1707from DNS and registry: 1708 1709-o domain -c delete -p E<34>%p=(name=>'test.no', deletefromregistry=>'2008-02-27', deletefromdns=>'2008-01-15')E<34> 1710 1711=head3 Domain update 1712 1713The domain name cannot be changed, otherwise all parameters may be changed. 1714 1715=over 1716 1717=item 1 Update (change) some domain attributes 1718 1719 - registrant is changed 1720 - set authInfo to 'abc' 1721 - add and del on all the multiple objects, coset and nsset, which may be 1722 arrays or scalars 1723 1724-o domain -c update -p E<34>%p=(name=>'test.no', pw=>'abc', duration=>{months=>12}, registrant=>'TOH191O', coset=>{add=>{tech=>['TOH1P'], admin=>['TOH2P']}, del=>{tech=>['TOH1P'], admin=>['TOH2P', 'TOH3P']}}, nsset=>{add=>['ns1.sol.no', 'ns2.sol.no'], del=>'ns4.sol.no'})E<34> 1725 1726=item 2 Update of status flags 1727 1728Update is the only command where the status flags can be set/changed 1729 1730The flag values to use by the DRI user is the following (from Status.pm): 1731 1732 my %s=('delete' => 'clientDeleteProhibited', 1733 'renew' => 'clientRenewProhibited', 1734 'update' => 'clientUpdateProhibited', 1735 'transfer' => 'clientTransferProhibited', 1736 'publish' => 'clientHold'); 1737 1738Example update when a couple of flags are set, and two already set are removed: 1739 1740-o domain -c update -p E<34>%p=(name=>'test.no', status=>{add=>['delete','publish'], del=>['update', 'transfer']})E<34> 1741 1742=back 1743 1744=head3 Domain renew 1745 1746Rule from DRD.pm: we must have : curexp+duration < now + maxdelta 1747maxdelta = the permitted period which is 1 year (set in NO.pm). 1748 1749So basicly curexpiry must have a value between today (=now) and up to one year 1750ahead in time. Values outside that generates a DRI-error. 1751 1752=over 1753 1754=item 1 Renew with minimum parameters 1755 1756DRI requires curexpiry, which should match the expiry date of the domain being 1757renewed: 1758 1759-o domain -c renew -p E<34>%p=(name=>'�RE-pw-abc.no', curexpiry=>'2007-12-11')E<34> 1760 1761=item 2 Renew with max. parameters. We specify duration as well to two months 1762 1763-o domain -c renew -p E<34>%p=(name=>'�RE-pw-abc.no', curexpiry=>'2007-12-11', duration=>{months=>2})E<34> 1764 1765=back 1766 1767=head3 Domain withdraw 1768 1769This is a .NO specific extension command. 1770 1771Withdraw will transfer the domain to REG0, thus a registrar can push the 1772responsibility for a domain into the bucket. 1773 1774-o domain -c withdraw -p E<34>%p=(name=>'test.no')E<34> 1775 1776If the sponsor for a domain is REG0, any registrar can do a transfer on it to 1777take over the responsibility. 1778 1779=head2 Domain transfer commands 1780 1781Domain transfers are used if the registrant wants to change his registrar. He 1782must then ask a new registrar to transfer his domains from the current 1783registrar to the new one. 1784 1785=head3 authInfo is known, can use it in a direct 'transfer execute' 1786 1787If the registrant knows the authInfo, he passes it to the new registrar, who 1788can do a transfer 'op=execute' containing the authInfo, and the transfer will 1789be performed. 1790 1791 - The execute must be authorized by the token. 1792 - An optional duration can specify a renew period for the domain (1-12 months). 1793 1794-o domain -c transfer_execute -p E<34>%p=(name=>'test.no', pw=>'abc', duration=>{months=>'6'})E<34> 1795 1796If the password is correct, the domain should be transferred. 1797 1798=head3 authInfo not known, must request one-time token 1799 1800If the registrant does not know the authInfo, the new registrar must initiate a 1801transfer by sending a transfer request without authInfo. This will trig the 1802registry to generate a one-time password (a token) and send it to the 1803registrant, which in turn must pass the token to his new registrar. The new 1804registrar can then send a transfer execute containing the token, and then the 1805transfer will be performed. 1806 1807=over 1808 1809=item 1 Domain transfer request 1810 1811Initate a transfer request to ask for a token. The DRI-method used is 1812domain_transfer_start(). The token will be sent to the primary email address 1813registered on the registrant unless a special alternative address is selected. 1814 1815-o domain -c transfer -p E<34>%p=(name=>'test.no')E<34> 1816 1817Optionally, use the notify address to specify that the token shall be sent to 1818another email address. It must match one of the registered email addresses: 1819 1820-o domain -c transfer -p E<34>%p=(name=>'test.no', notify=>{email=>'xml@example.no'})E<34> 1821 1822Optionally, specify that the token shall be sent by SMS to a mobilePhone number 1823as notify address. It must match the registered mobilePhone number. 1824 1825-o domain -c transfer -p E<34>%p=(name=>'test.no', notify=>{mobilephone=>'+47123456789'})E<34> 1826 1827=item 2 Domain transfer query 1828 1829After a transfer request is received, the token is sent to the registrant. 1830Until a transfer execute is received the domain will remain in a pending state. 1831 1832The status of pending transfers can be queried. 1833 1834-o domain -c transfer_query -p E<34>%p=(name=>'test.no')E<34> 1835 1836=item 3 Cancel a pending transfer 1837 1838A pending transfer can be cancelled. The token will be deleted and the pending 1839state information will be restored to the normal state. 1840 1841-o domain -c transfer_cancel -p E<34>%p=(name=>'test.no') 1842 1843=item 4 Execute a pending transfer 1844 1845 - Execute must be authorized by the token. 1846 - An optional duration can specify a renew period for the domain (1-12 months). 1847 1848-o domain -c transfer_execute -p E<34>%p=(name=>'test.no', token=>'MySecretToken', duration=>{months=>'9'})E<34> 1849 1850If the token is correct, the domain should be transferred. 1851 1852=back 1853 1854 1855=head2 Polling the message queue 1856 1857=head3 Poll messages 1858 1859=over 1860 1861=item 1 message_waiting() 1862 1863This method performs a poll request and returns true if one or more messages 1864are waiting in the queue. 1865 1866-o message -c waiting -p E<34>%p=()E<34> 1867 1868=item 2 message_count() 1869 1870This method performs a poll request and returns the 'msgQ count' value from 1871the response, if any. 1872 1873-o message -c count -p E<34>%p=()E<34> 1874 1875=item 3 message_retrieve() 1876 1877This method performs a poll request, and with get_info() you can grab all the 1878message details. 1879 1880-o message -c retrieve -p E<34>%p=()E<34> 1881 1882=item 4 message_delete() 1883 1884This is the poll ack message, which will remove message (with id=12) from the 1885server message queue. 1886 1887-o message -c delete -p E<34>%p=(id=>12)E<34> 1888 1889=back 1890 1891=head2 Facets 1892 1893Facets are some special control attributes that can be used to 1894trig special behaviour by the registry when a transaction is received. 1895 1896By use of facets, a registrar can suppress certain checks and perform 1897actions on behalf of another registrar. The right do do such an 1898operation could be defined as a super registrar function. 1899 1900The facets are only available for a registrar account when the account 1901has been granted these special control rights by server configuration. 1902 1903Warning: 1904If facets are attempted set by a non-authorized registrar account, they 1905will be rejected. The registry may detect such abuse and apply prevailing 1906actions towards non-authorized registrars, so don't play with this 1907mechanism unless you know you have the rights to use a facet on your account. 1908 1909=head3 Facet keys, values and functionality 1910 1911Facets are key/value pairs and their names and syntax are decided by the registry. 1912 1913 1914=head3 Facets usage in commands 1915 1916Facets may be set for any EPP command. 1917 1918To add facets into the parameter string, use the following facet syntax 1919in the parameter string: 1920 1921 facets => { '<facet1>' => '<value1>', '<facet2>' => '<value2>', <facet3> => <value3>', ... } 1922 1923 1924=head1 COPYRIGHT 1925 1926Copyright (c) 2008-2010 UNINETT Norid AS, E<lt>http://www.norid.noE<gt>, 1927Trond Haugen E<lt>info@norid.noE<gt> 1928All rights reserved. 1929 1930This program is free software; you can redistribute it and/or modify 1931it under the terms of the GNU General Public License as published by 1932the Free Software Foundation; either version 2 of the License, or 1933(at your option) any later version. 1934 1935See the LICENSE file that comes with this distribution for more details. 1936 1937=head1 AUTHOR 1938 1939Trond Haugen, E<lt>info@norid.noE<gt> 1940 1941=cut 1942 1943