use localized service labels in invoices, #71347
[freeside.git] / FS / FS / part_export / domreg_opensrs.pm
1 package FS::part_export::domreg_opensrs;
2
3 use vars qw(@ISA %info %options $conf $me $DEBUG);
4 use Tie::IxHash;
5 use DateTime;
6 use FS::Record qw(qsearchs qsearch);
7 use FS::Conf;
8 use FS::part_export::null;
9 use FS::svc_domain;
10 use FS::part_pkg;
11
12 =head1 NAME
13
14 FS::part_export::domreg_opensrs - Register or transfer domains with Tucows OpenSRS
15
16 =head1 DESCRIPTION
17
18 This module handles registering and transferring domains using a registration service provider (RSP) account
19 at Tucows OpenSRS, an ICANN-approved domain registrar.
20
21 As a part_export, this module can be designated for use with svc_domain services.  When the svc_domain object
22 is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending
23 on the setting of the svc_domain's action field.
24
25 =over 4
26
27 =item N - Register the domain
28
29 =item M - Transfer the domain
30
31 =item I - Ignore the domain for registration purposes
32
33 =back
34
35 This export uses Net::OpenSRS.  Registration and transfer attempts will fail unless Net::OpenSRS is installed
36 and LWP::UserAgent is able to make HTTPS posts.  You can turn on debugging messages and use the OpenSRS test
37 gateway when setting up this export.
38
39 =cut
40
41 @ISA = qw(FS::part_export::null);
42 $me = '[' .  __PACKAGE__ . ']';
43 $DEBUG = 0;
44
45 my @tldlist = qw/com net org biz info name mobi at be ca cc ch cn de dk es eu fr it mx nl tv uk us asn.au com.au id.au net.au org.au/;
46
47 tie %options, 'Tie::IxHash',
48   'username'     => { label => 'Reseller user name at OpenSRS',
49                       },
50   'privatekey'   => { label => 'Private key',
51                       },
52   'password'     => { label => 'Password for management account',
53                       },
54   'masterdomain' => { label => 'Master domain at OpenSRS',
55                       },
56   'wait_for_pay' => { label => 'Do not provision until payment is received',
57                       type => 'checkbox',
58                       default => '0',
59                     },
60   'debug_level'  => { label => 'Net::OpenSRS debug level',
61                       type => 'select',
62                       options => [ 0, 1, 2, 3 ],
63                       default => 0 },
64 #  'register'     => { label => 'Use for registration',
65 #                      type => 'checkbox',
66 #                      default => '1' },
67 #  'transfer'     => { label => 'Use for transfer',
68 #                      type => 'checkbox',
69 #                      default => '1' },
70   'tlds'         => { label => 'Use this export for these top-level domains (TLDs)',
71                       type => 'select',
72                       multi => 1,
73                       size => scalar(@tldlist),
74                       options => [ @tldlist ],
75                       default => 'com net org' },
76   'auoptions'    => { label => 'Enable AU-specific registration fields', 
77                       type => 'checkbox'
78                     },
79 ;
80
81 %info = (
82   'svc'     => 'svc_domain',
83   'desc'    => 'Domain registration via Tucows OpenSRS',
84   'options' => \%options,
85   'notes'   => <<'END'
86 Registers and transfers domains via the <a href="http://opensrs.com/">Tucows OpenSRS</a> registrar (using <a href="http://search.cpan.org/dist/Net-OpenSRS">Net::OpenSRS</a>).
87 All of the Net::OpenSRS restrictions apply:
88 <UL>
89   <LI>You must have a reseller account with Tucows.
90   <LI>You must add the public IP address of the Freeside server to the 'Script API allow' list in the OpenSRS web interface.
91   <LI>You must generate an API access key in the OpenSRS web interface and enter it below.
92   <LI>All domains are managed using the same user name and password, but you can create sub-accounts for clients.
93   <LI>The user name must be the same as your OpenSRS reseller ID.
94   <LI>You must enter a master domain that all other domains are associated with.  That domain must be registered through your OpenSRS account.
95 </UL>
96 Some top-level domains offered by OpenSRS have additional business rules not supported by this export. These TLDs cannot be registered or transfered with this export.
97 <BR><BR>Use these buttons for some useful presets:
98 <UL>
99   <LI>
100     <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick='
101       document.dummy.machine.value = "rr-n1-tor.opensrs.net";
102       this.form.machine.value = "rr-n1-tor.opensrs.net";
103     '>
104   <LI>
105     <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick='
106       document.dummy.machine.value = "horizon.opensrs.net";
107       this.form.machine.value = "horizon.opensrs.net";
108     '>
109 </UL>
110 END
111 );
112
113 install_callback FS::UID sub { 
114   $conf = new FS::Conf;
115 };
116
117 =head1 METHODS
118
119 =over 4
120
121 =item format_tel
122
123 Reformats a phone number according to registry rules.  Currently Freeside stores phone numbers
124 in NANPA format and the registry prefers "+CCC.NPANPXNNNN"
125
126 =cut
127
128 sub format_tel {
129   my $tel = shift;
130
131   #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})( x(\d+))?$/) {
132   if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) {
133     $tel = "+1.$1$2$3";
134 #    if $tel .= "$4" if $4;
135   }
136   return $tel;
137 }
138
139 =item gen_contact_info
140
141 Generates contact data for the domain based on the customer data.
142
143 Currently relies on Net::OpenSRS to format the telephone number for OpenSRS.
144
145 =cut
146
147 sub gen_contact_info
148 {
149   my ($co)=@_;
150
151   my @invoicing_list = $co->invoicing_list_emailonly;
152   if ( $conf->exists('emailinvoiceautoalways')
153        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
154        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
155     push @invoicing_list, $co->all_emails;
156   }
157
158   my $email = ($conf->exists('business-onlinepayment-email-override'))
159               ? $conf->config('business-onlinepayment-email-override')
160               : $invoicing_list[0];
161
162   my $c = {
163     firstname => $co->first,
164     lastname  => $co->last,
165     company   => $co->company,
166     address   => $co->address1,
167     city      => $co->city(),
168     state     => $co->state(),
169     zip       => $co->zip(),
170     country   => uc($co->country()),
171     email     => $email,
172     #phone     => format_tel($co->daytime()),
173     phone     => $co->daytime() || $co->night,
174   };
175   return $c;
176 }
177
178 =item validate_contact_info
179
180 Attempts to validate contact data for the domain based on OpenSRS rules.
181
182 Returns undef if the contact data is acceptable, an error message if the contact
183 data lacks one or more required fields.
184
185 =cut
186
187 sub validate_contact_info {
188   my $c = shift;
189
190   my %fields = (
191     firstname => "first name",
192     lastname => "last name",
193     address => "street address",
194     city => "city", 
195     state => "state",
196     zip => "ZIP/postal code",
197     country => "country",
198     email => "email address",
199     phone => "phone number",
200   );
201   my @err = ();
202   foreach (keys %fields) {
203     if (!defined($c->{$_}) || !$c->{$_}) {
204       push @err, $fields{$_};
205     }
206   }
207   if (scalar(@err) > 0) {
208     return "Contact information needs: " . join(', ', @err);
209   }
210   undef;
211 }
212
213 =item testmode
214
215 Returns the Net::OpenSRS-required test mode string based on whether the export
216 is configured to use the live or the test gateway.
217
218 =cut
219
220 sub testmode {
221   my $self = shift;
222
223   return 'live' if $self->machine eq "rr-n1-tor.opensrs.net";
224   return 'test' if $self->machine eq "horizon.opensrs.net";
225   undef;
226
227 }
228
229 =item _export_insert
230
231 Attempts to "export" the domain, i.e. register or transfer it if the user selected
232 that option when editing the domain.
233
234 Returns an error message on failure or undef on success.
235
236 May also return an error message if it cannot load the required Perl module Net::OpenSRS,
237 or if the domain is not registerable, or if insufficient data is provided in the customer
238 record to generate the required contact information to register or transfer the domain.
239
240 =cut
241
242 sub _export_insert {
243   my( $self, $svc_domain ) = ( shift, shift );
244
245   return if $svc_domain->action eq 'I';  # Ignoring registration, just doing DNS
246
247   if ($svc_domain->action eq 'N') {
248     return $self->register( $svc_domain );
249   } elsif ($svc_domain->action eq 'M') {
250     return $self->transfer( $svc_domain );
251   } 
252   return "Unknown domain action " . $svc_domain->action;
253 }
254
255 sub _export_insert_on_payment {
256   my( $self, $svc_domain ) = ( shift, shift );
257   warn "$me:_export_insert_on_payment called\n" if $DEBUG;
258   return '' unless $self->option('wait_for_pay');
259
260   my $queue = new FS::queue {
261     'svcnum' => $svc_domain->svcnum,
262     'job'    => 'FS::part_export::domreg_opensrs::renew_through',
263   };
264   $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action?
265 }
266
267 ## Domain registration exports do nothing on replace.  Mainly because we haven't decided what they should do.
268 #sub _export_replace {
269 #  my( $self, $new, $old ) = (shift, shift, shift);
270 #
271 #  return '';
272 #
273 #}
274
275 ## Domain registration exports do nothing on delete.  You're just removing the domain from Freeside, not the registry
276 #sub _export_delete {
277 #  my( $self, $svc_domain ) = ( shift, shift );
278 #
279 #  return '';
280 #}
281
282 =item is_supported_domain
283
284 Return undef if the domain name uses a TLD or SLD that is supported by this registrar.
285 Otherwise return an error message explaining what's wrong.
286
287 =cut
288
289 sub is_supported_domain {
290   my $self = shift;
291   my $svc_domain = shift;
292
293   # Get the TLD of the new domain
294   my @bits = split /\./, $svc_domain->domain;
295
296   return "Can't register subdomains: " . $svc_domain->domain 
297     if (scalar(@bits) != 2 && scalar(@bits) != 3);
298
299   my $tld = pop @bits;
300   my $sld = pop @bits;
301
302   # See if it's one this export supports
303   my @tlds = split /\s+/, $self->option('tlds');
304   @tlds =  map { s/\.//; $_ } @tlds;
305   return "Can't register top-level domain $tld, restricted to: " 
306             . $self->option('tlds') if ! grep { $_ eq $tld || $_ eq "$sld$tld" } @tlds;
307   return undef;
308 }
309
310 =item get_srs
311
312 =cut
313
314 sub get_srs {
315   my $self = shift;
316
317   my $srs = Net::OpenSRS->new();
318
319   $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log
320
321   $srs->environment( $self->testmode() );
322   $srs->set_key( $self->option('privatekey') );
323
324   $srs->set_manage_auth( $self->option('username'), $self->option('password') );
325   return $srs;
326 }
327
328 =item get_status
329
330 Returns a reference to a hashref containing information on the domain's status.  The keys
331 defined depend on the status.
332
333 'unregistered' means the domain is not registered.
334
335 Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state
336 of that operation.
337
338 Otherwise returns a value indicating if the domain can be managed through our reseller account.
339
340 =cut
341
342 sub get_status {
343   my ( $self, $svc_domain ) = @_;
344   my $rslt = {};
345
346   eval "use Net::OpenSRS;";
347   return $@ if $@;
348
349   my $srs = $self->get_srs;
350
351   if ($srs->is_available( $svc_domain->domain )) {
352     $rslt->{'unregistered'} = 1;
353   } else {
354     $rslt = $srs->check_transfer( $svc_domain->domain );
355     if (defined($rslt->{'reason'})) {
356       my $rv = $srs->make_request(
357         {
358           action     => 'belongs_to_rsp',
359           object     => 'domain',
360           attributes => {
361             domain => $svc_domain->domain
362           }
363         }
364       );
365       if ($rv) {
366         $self->_set_response;
367         if ( $rv->{attributes}->{'domain_expdate'} ) {
368           $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'};
369         }
370       }
371     }
372   }
373
374   return $rslt; # Success
375 }
376
377 =item register
378
379 Attempts to register the domain through the reseller account associated with this export.
380
381 Like most export functions, returns an error message on failure or undef on success.
382
383 =cut
384
385 sub register {
386   my ( $self, $svc_domain, $years ) = @_;
387
388   $years = 1 unless $years; #default to 1 year since we don't seem to pass it
389
390   return "Net::OpenSRS does not support period other than 1 year" if $years != 1;
391
392   eval "use Net::OpenSRS;";
393   return $@ if $@;
394
395   my $err = $self->is_supported_domain( $svc_domain );
396   return $err if $err;
397
398   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
399
400   my $c = gen_contact_info($cust_main);
401
402   if ( $svc_domain->domain =~ /\.au$/ ) {
403         $c->{'registrant_name'} = $svc_domain->au_registrant_name;
404         $c->{'eligibility_type'} = $svc_domain->au_eligibility_type;
405   }
406
407   $err = validate_contact_info($c);
408   return $err if $err;
409
410   my $srs = $self->get_srs;
411
412 #  cookie not required for registration
413 #  my $cookie = $srs->get_cookie( $self->option('masterdomain') );
414 #  if (!$cookie) {
415 #     return "Unable to get cookie at OpenSRS: " . $srs->last_response();
416 #  }
417
418 #  return "Domain registration not enabled" if !$self->option('register');
419   return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
420
421   return ''; # Should only get here if register succeeded
422 }
423
424 =item transfer
425
426 Attempts to transfer the domain into the reseller account associated with this export.
427
428 Like most export functions, returns an error message on failure or undef on success.
429
430 =cut
431
432 sub transfer {
433   my ( $self, $svc_domain ) = @_;
434
435   eval "use Net::OpenSRS;";
436   return $@ if $@;
437
438   my $err = $self->is_supported_domain( $svc_domain );
439   return $err if $err;
440
441   my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main;
442
443   my $c = gen_contact_info($cust_main);
444
445   $err = validate_contact_info($c);
446   return $err if $err;
447
448   my $srs = $self->get_srs;
449
450   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
451   if (!$cookie) {
452      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
453   }
454
455 #  return "Domain transfer not enabled" if !$self->option('transfer');
456   return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c);
457
458   return ''; # Should only get here if transfer succeeded
459 }
460
461 =item renew
462
463 Attempts to renew the domain for the specified number of years.
464
465 Like most export functions, returns an error message on failure or undef on success.
466
467 =cut
468
469 sub renew {
470   my ( $self, $svc_domain, $years ) = @_;
471
472   eval "use Net::OpenSRS;";
473   return $@ if $@;
474
475   my $err = $self->is_supported_domain( $svc_domain );
476   return $err if $err;
477
478   my $srs = $self->get_srs;
479
480   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
481   if (!$cookie) {
482      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
483   }
484
485 #  return "Domain renewal not enabled" if !$self->option('renew');
486   return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years );
487
488   return ''; # Should only get here if renewal succeeded
489 }
490
491 =item renew_through [ EPOCH_DATE ]
492
493 Attempts to renew the domain through the specified date.  If no date is
494 provided it is gleaned from the associated cust_pkg bill date
495
496 Like some export functions, dies on failure or returns undef on success.
497 It is always called from the queue.
498
499 =cut
500
501 sub renew_through {
502   my ( $self, $svc_domain, $date ) = @_;
503
504   warn "$me: renew_through called\n" if $DEBUG;
505   eval "use Net::OpenSRS;";
506   die $@ if $@;
507
508   unless ( $date ) {
509     my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
510     die "Can't renew: no date specified and domain is not in a package."
511       unless $cust_pkg;
512     $date = $cust_pkg->bill;
513   }
514
515   my $err = $self->is_supported_domain( $svc_domain );
516   die $err if $err;
517
518   warn "$me: checking status\n" if $DEBUG;
519   my $rv = $self->get_status($svc_domain);
520   die "Domain ". $svc_domain->domain. " is not renewable"
521     unless $rv->{expdate};
522
523   die "Can't parse expiration date for ". $svc_domain->domain
524     unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
525
526   my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
527   my $exp = DateTime->new( year   => $year,
528                            month  => $month,
529                            day    => $day,
530                            hour   => $hour,
531                            minute => $minute,
532                            second => $second,
533                            time_zone => 'America/New_York',#timezone of opensrs
534                          );
535
536   my $bill = DateTime->
537    from_epoch( 'epoch'     => $date,
538                'time_zone' => DateTime::TimeZone->new( name => 'local' ),
539   );
540
541   my $years = 0;
542   while ( DateTime->compare( $bill, $exp ) > 0 ) {
543     $years++;
544     $exp->add( 'years' => 1 );
545
546     die "Can't renew ". $svc_domain->domain. " for more than 10 years."
547       if $years > 10; #no infinite loop
548   }
549
550   return '' unless $years;
551
552   warn "$me: renewing ". $svc_domain->domain. " for $years years\n" if $DEBUG;
553   my $srs = $self->get_srs;
554   $rv = $srs->make_request(
555     {
556       action     => 'renew',
557       object     => 'domain',
558       attributes => {
559         domain                => $svc_domain->domain,
560         auto_renew            => 0,
561         handle                => 'process',
562         period                => $years,
563         currentexpirationyear => $year,
564       }
565     }
566   );
567   die $rv->{response_text} unless $rv->{is_success};
568
569   return ''; # Should only get here if renewal succeeded
570 }
571
572 =item revoke
573
574 Attempts to revoke the domain registration.  Only succeeds if invoked during the OpenSRS
575 grace period immediately after registration.
576
577 Like most export functions, returns an error message on failure or undef on success.
578
579 =cut
580
581 sub revoke {
582   my ( $self, $svc_domain ) = @_;
583
584   eval "use Net::OpenSRS;";
585   return $@ if $@;
586
587   my $err = $self->is_supported_domain( $svc_domain );
588   return $err if $err;
589
590   my $srs = $self->get_srs;
591
592   my $cookie = $srs->get_cookie( $self->option('masterdomain') );
593   if (!$cookie) {
594      return "Unable to get cookie at OpenSRS: " . $srs->last_response();
595   }
596
597 #  return "Domain registration revocation not enabled" if !$self->option('revoke');
598   return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain);
599
600   return ''; # Should only get here if transfer succeeded
601 }
602
603 =item registrar
604
605 Should return a full-blown object representing OpenSRS, but current just returns a hashref
606 containing the registrar name.
607
608 =cut
609
610 sub registrar {
611   return {
612         name => 'OpenSRS',
613   };
614 }
615
616 =back
617
618 =head1 SEE ALSO
619
620 L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>,
621 L<FS::Record>, schema.html from the base documentation.
622
623
624 =cut
625
626 1;
627