package FS::part_export::domreg_opensrs;
-use vars qw(@ISA %info %options $conf);
+use vars qw(@ISA %info %options $conf $me $DEBUG);
use Tie::IxHash;
+use DateTime;
use FS::Record qw(qsearchs qsearch);
use FS::Conf;
use FS::part_export::null;
=cut
@ISA = qw(FS::part_export::null);
+$me = '[' . __PACKAGE__ . ']';
+$DEBUG = 1;
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/;
},
'masterdomain' => { label => 'Master domain at OpenSRS',
},
+ 'wait_for_pay' => { label => 'Do not provision until payment is received',
+ type => 'checkbox',
+ default => '0',
+ },
'debug_level' => { label => 'Net::OpenSRS debug level',
type => 'select',
options => [ 0, 1, 2, 3 ],
return 'live' if $self->machine eq "rr-n1-tor.opensrs.net";
return 'test' if $self->machine eq "horizon.opensrs.net";
undef;
+
}
=item _export_insert
return "Unknown domain action " . $svc_domain->action;
}
+sub _export_insert_on_payment {
+ my( $self, $svc_domain ) = ( shift, shift );
+ warn "$me:_export_insert_on_payment called\n" if $DEBUG;
+ return '' unless $self->option('wait_for_pay');
+
+ my $queue = new FS::queue {
+ 'svcnum' => $svc_domain->svcnum,
+ 'job' => 'FS::part_export::domreg_opensrs::renew_through',
+ };
+ $queue->insert( $self, $svc_domain ); #_export_insert with 'R' action?
+
+ return '';
+}
+
## Domain registration exports do nothing on replace. Mainly because we haven't decided what they should do.
#sub _export_replace {
# my( $self, $new, $old ) = (shift, shift, shift);
my $srs = $self->get_srs;
- my $cookie = $srs->get_cookie( $self->option('masterdomain') );
- if (!$cookie) {
- return "Unable to get cookie at OpenSRS: " . $srs->last_response();
- }
+# cookie not required for registration
+# my $cookie = $srs->get_cookie( $self->option('masterdomain') );
+# if (!$cookie) {
+# return "Unable to get cookie at OpenSRS: " . $srs->last_response();
+# }
# return "Domain registration not enabled" if !$self->option('register');
return $srs->last_response() if !$srs->register_domain( $svc_domain->domain, $c);
return ''; # Should only get here if renewal succeeded
}
+=item renew_through [ EPOCH_DATE ]
+
+Attempts to renew the domain through the specified date. If no date is
+provided it is gleaned from the associated cust_pkg bill date
+
+Like most export functions, returns an error message on failure or undef on success.
+
+=cut
+
+sub renew_through {
+ my ( $self, $svc_domain, $date ) = @_;
+
+ warn "$me: renew_through called\n" if $DEBUG;
+ eval "use Net::OpenSRS;";
+ return $@ if $@;
+
+ unless ( $date ) {
+ my $cust_pkg = $svc_domain->cust_svc->cust_pkg;
+ return "Can't renew: no date specified and domain is not in a package."
+ unless $cust_pkg;
+ $date = $cust_pkg->bill;
+ }
+
+ my $err = $self->is_supported_domain( $svc_domain );
+ return $err if $err;
+
+ warn "$me: checking status\n" if $DEBUG;
+ my $rv = $self->get_status($svc_domain);
+ return "Domain ". $svc_domain->domain. " is not renewable"
+ unless $rv->{expdate};
+
+ return "Can't parse expiration date for ". $svc_domain->domain
+ unless $rv->{expdate} =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/;
+
+ my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
+ my $exp = DateTime->new( year => $year,
+ month => $month,
+ day => $day,
+ hour => $hour,
+ minute => $minute,
+ second => $second,
+ time_zone => 'America/New_York',#timezone of opensrs
+ );
+
+ my $bill = DateTime->
+ from_epoch( 'epoch' => $date,
+ 'time_zone' => DateTime::TimeZone->new( name => 'local' ),
+ );
+
+ my $years = 0;
+ while ( DateTime->compare( $bill, $exp ) > 0 ) {
+ $years++;
+ $exp->add( 'years' => 1 );
+
+ return "Can't renew ". $svc_domain->domain. " for more than 10 years."
+ if $years > 10; #no infinite loop
+ }
+
+ warn "$me: renewing ". $svc_domain->domain. "for $years years\n" if $DEBUG;
+ my $srs = $self->get_srs;
+ $rv = $srs->make_request(
+ {
+ action => 'renew',
+ object => 'domain',
+ attributes => {
+ domain => $svc_domain->domain,
+ auto_renew => 0,
+ handle => 'process',
+ period => $years,
+ currentexpirationyear => $year,
+ }
+ }
+ );
+ return $rv->{response_text} unless $rv->{is_success};
+
+ return ''; # Should only get here if renewal succeeded
+}
+
=item revoke
Attempts to revoke the domain registration. Only succeeds if invoked during the OpenSRS
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use DateTime;
+use Date::Format;
+use Date::Parse;
+use Net::OpenSRS;
+use Net::Whois::Raw;
+use Data::Dumper;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearchs qsearch);
+use FS::Conf;
+use FS::svc_domain;
+use FS::part_pkg;
+use FS::part_export;
+
+my $exportnum = 1;
+my $pkgpart = 631;
+my $user = 'qis';
+
+adminsuidsetup $user;
+
+my $part_export = qsearchs('part_export' => { exportnum => $exportnum })
+ or die "can't find export $exportnum\n";
+
+my $srs = $part_export->get_srs;
+
+my $rv = $srs->make_request(
+ {
+ action => 'get_domains_by_expiredate',
+ object => 'domain',
+ attributes => {
+ exp_from => time2str('%Y-%m-%d', time() - 4*24*60*60),
+ exp_to => time2str('%Y-%m-%d', time() + 10*366*24*60*60),
+ limit => 10000,
+ }
+ }
+);
+
+die $rv->{response_text} unless $rv->{is_success};
+
+my %domains = map { $_->{name}, $_ } @{ $rv->{attributes}->{exp_domains} };
+
+# each is of form
+# {
+# 'f_let_expire' => 'N',
+# 'name' => 'wolfecpa.com',
+# 'f_auto_renew' => 'N',
+# 'expiredate' => '2017-09-16 04:00:00'
+# },
+
+foreach my $svc_domain ( $part_export->svc_x ) {
+ unless ( exists($domains{$svc_domain->domain}) ) {
+ warn $svc_domain->domain. " not at registrar. No action taken.\n";
+ next;
+ }
+
+ $domains{$svc_domain->domain}{seen} = 1;
+
+ unless ( $domains{$svc_domain->domain}{expiredate} =~
+ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})/ )
+ {
+ warn "Can't parse expiration date for ". $svc_domain->domain. " skipping\n";
+ next;
+ }
+
+ my ($year,$month,$day,$hour,$minute,$second) = ($1,$2,$3,$4,$5,$6);
+ my $exp = DateTime->new( year => $year,
+ month => $month,
+ day => $day,
+ hour => $hour,
+ minute => $minute,
+ second => $second,
+ time_zone => 'America/New_York',#timezone of opensrs
+ );
+ my $expiretime = $exp->epoch;
+
+ my $error = $part_export->is_supported_domain($svc_domain);
+ warn $error if $error;
+ $error = undef;
+
+ my $create = '';
+ my $whois = whois($svc_domain->domain);
+ $whois =~ /Record created on (\d{1,2}-\w{3}-\d{4})\./ && ($create = $1);
+ my $createtime = str2time($create);
+
+ unless ($createtime) {
+ $exp->subtract( 'years' => 1 );
+ $createtime = $exp->epoch;
+ }
+
+ my $new;
+ my $cust_svc = $svc_domain->cust_svc;
+ my $cust_pkg = $cust_svc->cust_pkg;
+ unless ($cust_pkg) {
+ warn $svc_domain->domain. " not linked to package. No action taken.\n";
+ next;
+ }
+
+ foreach my $pkg ( grep { $_->pkgpart == $pkgpart } $cust_pkg->cust_main->ncancelled_pkgs ) {
+ next if $pkg->cust_svc; # only handles simple 1 domain/package case
+ $cust_svc->pkgnum($pkg->pkgnum);
+ $error = $cust_svc->replace;
+ die "error linking to empty package: $error\n" if $error;
+ $cust_pkg = $pkg;
+ last;
+ }
+
+ unless ($cust_pkg->pkgpart == $pkgpart) {
+ $new = new FS::cust_pkg
+ { custnum => $cust_pkg->custnum, pkgpart => $pkgpart };
+ my $error = $new->insert;
+ die "error inserting package: $error\n" if $error;
+ $cust_svc->pkgnum($new->pkgnum);
+ $error = $cust_svc->replace;
+ die "error linking to new package: $error\n" if $error;
+ $cust_pkg = $new;
+ }
+
+ # set dates on package if it was empty?
+ $cust_pkg->bill($expiretime);
+ $cust_pkg->setup($createtime);
+ $error = $cust_pkg->replace;
+ die $error if $error;
+}
+
projects / freeside.git / commitdiff