diff options
Diffstat (limited to 'FS/FS/part_export')
| -rw-r--r-- | FS/FS/part_export/acct_plesk.pm | 2 | ||||
| -rw-r--r-- | FS/FS/part_export/amazon_ec2.pm | 169 | ||||
| -rw-r--r-- | FS/FS/part_export/domreg_net_dri.pm | 614 | ||||
| -rw-r--r-- | FS/FS/part_export/domreg_opensrs.pm | 512 | ||||
| -rw-r--r-- | FS/FS/part_export/globalpops_voip.pm | 2 | ||||
| -rw-r--r-- | FS/FS/part_export/netsapiens.pm | 308 | ||||
| -rw-r--r-- | FS/FS/part_export/prizm.pm | 12 | ||||
| -rw-r--r-- | FS/FS/part_export/shellcommands.pm | 71 | ||||
| -rw-r--r-- | FS/FS/part_export/shellcommands_withdomain.pm | 26 | ||||
| -rw-r--r-- | FS/FS/part_export/www_plesk.pm | 2 |
10 files changed, 1701 insertions, 17 deletions
diff --git a/FS/FS/part_export/acct_plesk.pm b/FS/FS/part_export/acct_plesk.pm index 1be820a..d8d70a3 100644 --- a/FS/FS/part_export/acct_plesk.pm +++ b/FS/FS/part_export/acct_plesk.pm @@ -23,7 +23,7 @@ Real-time export to <a href="http://www.swsoft.com/">Plesk</a> managed server. Requires installation of <a href="http://search.cpan.org/dist/Net-Plesk">Net::Plesk</a> -from CPAN. +from CPAN and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:acct_plesk.pm">configuration</a>. END ); diff --git a/FS/FS/part_export/amazon_ec2.pm b/FS/FS/part_export/amazon_ec2.pm new file mode 100644 index 0000000..0e65ca0 --- /dev/null +++ b/FS/FS/part_export/amazon_ec2.pm @@ -0,0 +1,169 @@ +package FS::part_export::amazon_ec2; + +use base qw( FS::part_export ); + +use vars qw(@ISA %info $replace_ok_kludge); +use Tie::IxHash; +use FS::Record qw( qsearchs ); +use FS::svc_external; + +tie my %options, 'Tie::IxHash', + 'access_key' => { label => 'AWS access key', }, + 'secret_key' => { label => 'AWS secret key', }, + 'ami' => { label => 'AMI', 'default' => 'ami-ff46a796', }, + 'keyname' => { label => 'Keypair name', }, + #option to turn off (or on) ip address allocation +; + +%info = ( + 'svc' => 'svc_external', + 'desc' => + 'Export to Amazon EC2', + 'options' => \%options, + 'notes' => <<'END' +Create instances in the Amazon EC2 (Elastic compute cloud). Install +Net::Amazon::EC2 perl module. Advisable to set svc_external-skip_manual config +option. +END +); + +$replace_ok_kludge = 0; + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc_external) = (shift, shift); + $err_or_queue = $self->amazon_ec2_queue( $svc_external->svcnum, 'insert', + $svc_external->svcnum, + $self->option('ami'), + $self->option('keyname'), + ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return '' if $replace_ok_kludge; + return "can't change instance id or IP address"; + #$err_or_queue = $self->amazon_ec2_queue( $new->svcnum, + # 'replace', $new->username, $new->_password ); + #ref($err_or_queue) ? '' : $err_or_queue; +} + +sub _export_delete { + my( $self, $svc_external ) = (shift, shift); + my( $instance_id, $ip ) = split(/:/, $svc_external->title ); + $err_or_queue = $self->amazon_ec2_queue( $svc_external->svcnum, 'delete', + $instance_id, + $ip, + ); + ref($err_or_queue) ? '' : $err_or_queue; +} + +#these three are optional +# fallback for svc_acct will change and restore password +#sub _export_suspend { +# my( $self, $svc_something ) = (shift, shift); +# $err_or_queue = $self->amazon_ec2_queue( $svc_something->svcnum, +# 'suspend', $svc_something->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +#} +# +#sub _export_unsuspend { +# my( $self, $svc_something ) = (shift, shift); +# $err_or_queue = $self->amazon_ec2_queue( $svc_something->svcnum, +# 'unsuspend', $svc_something->username ); +# ref($err_or_queue) ? '' : $err_or_queue; +#} + +sub export_links { + my($self, $svc_external, $arrayref) = (shift, shift, shift); + my( $instance_id, $ip ) = split(/:/, $svc_external->title ); + + push @$arrayref, qq!<A HREF="http://$ip/">http://$ip/</A>!; + ''; +} + +### + +#a good idea to queue anything that could fail or take any time +sub amazon_ec2_queue { + my( $self, $svcnum, $method ) = (shift, shift, shift); + my $queue = new FS::queue { + 'svcnum' => $svcnum, + 'job' => "FS::part_export::amazon_ec2::amazon_ec2_$method", + }; + $queue->insert( $self->option('access_key'), + $self->option('secret_key'), + @_ + ) + or $queue; +} + +sub amazon_ec2_new { + my( $access_key, $secret_key, @rest ) = @_; + + eval 'use Net::Amazon::EC2;'; + die $@ if $@; + + my $ec2 = new Net::Amazon::EC2 'AWSAccessKeyId' => $access_key, + 'SecretAccessKey' => $secret_key; + + ( $ec2, @rest ); +} + +sub amazon_ec2_insert { #subroutine, not method + my( $ec2, $svcnum, $ami, $keyname ) = amazon_ec2_new(@_); + + my $reservation_info = $ec2->run_instances( 'ImageId' => $ami, + 'KeyName' => $keyname, + 'MinCount' => 1, + 'MaxCount' => 1, + ); + + my $instance_id = $reservation_info->instances_set->[0]->instance_id; + + my $ip = $ec2->allocate_address + or die "can't allocate address"; + $ec2->associate_address('InstanceId' => $instance_id, + 'PublicIp' => $ip, + ) + or die "can't assocate IP address $ip with instance $instance_id"; + + my $svc_external = qsearchs('svc_external', { 'svcnum' => $svcnum } ) + or die "can't find svc_external.svcnum $svcnum\n"; + + $svc_external->title("$instance_id:$ip"); + + local($replace_ok_kludge) = 1; + my $error = $svc_external->replace; + die $error if $error; + +} + +#sub amazon_ec2_replace { #subroutine, not method +#} + +sub amazon_ec2_delete { #subroutine, not method + my( $ec2, $id, $ip ) = amazon_ec2_new(@_); + + my $instance_id = sprintf('i-%x', $id); + $ec2->disassociate_address('PublicIp'=>$ip) + or die "can't dissassocate $ip"; + + $ec2->release_address('PublicIp'=>$ip) + or die "can't release $ip"; + + my $result = $ec2->terminate_instances('InstanceId'=>$instance_id); + #check for instance_id match or something? + +} + +#sub amazon_ec2_suspend { #subroutine, not method +#} + +#sub amazon_ec2_unsuspend { #subroutine, not method +#} + +1; + diff --git a/FS/FS/part_export/domreg_net_dri.pm b/FS/FS/part_export/domreg_net_dri.pm new file mode 100644 index 0000000..bf01602 --- /dev/null +++ b/FS/FS/part_export/domreg_net_dri.pm @@ -0,0 +1,614 @@ +package FS::part_export::domreg_net_dri; + +use vars qw(@ISA %info %options $conf); +use Tie::IxHash; +use FS::part_export::null; + +=head1 NAME + +FS::part_export::domreg_net_dri - Register or transfer domains with Net::DRI + +=head1 DESCRIPTION + +This module handles registering and transferring domains with select registrars or registries supported +by L<Net::DRI>. + +As a part_export, this module can be designated for use with svc_domain services. When the svc_domain object +is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending +on the setting of the svc_domain's action field. Further operations can be performed from the View Domain screen. + +Logging information is written to the Freeside log folder. + +For correct operation you must add name/value pairs to the protcol and transport options fields. The setttings +depend on the domain registry driver (DRD) selected. + +=over 4 + +=item N - Register the domain + +=item M - Transfer the domain + +=item I - Ignore the domain for registration purposes + +=back + +=cut + +@ISA = qw(FS::part_export::null); + +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/; + +my $opensrs_protocol_opts=<<'END'; +username= +password= +auto_renew=0 +affiliate_id= +reseller_id= +END + +my $opensrs_transport_opts=<<'END'; +client_login= +client_password= +END + +tie %options, 'Tie::IxHash', + 'drd' => { label => 'Domain Registry Driver (DRD)', + type => 'select', + options => [ qw/BookMyName CentralNic Gandi OpenSRS OVH VNDS/ ], + default => 'OpenSRS' }, + 'log_level' => { label => 'Logging', + type => 'select', + options => [ qw/debug info notice warning error critical alert emergency/ ], + default => 'warning' }, + 'protocol_opts' => { + label => 'Protocol Options', + type => 'textarea', + default => $opensrs_protocol_opts, + }, + 'transport_opts' => { + label => 'Transport Options', + type => 'textarea', + default => $opensrs_transport_opts, + }, +# 'register' => { label => 'Use for registration', +# type => 'checkbox', +# default => '1' }, +# 'transfer' => { label => 'Use for transfer', +# type => 'checkbox', +# default => '1' }, +# 'delete' => { label => 'Use for deletion', +# type => 'checkbox', +# default => '1' }, +# 'renew' => { label => 'Use for renewals', +# type => 'checkbox', +# default => '1' }, + 'tlds' => { label => 'Use this export for these top-level domains (TLDs)', + type => 'select', + multi => 1, + size => scalar(@tldlist), + options => [ @tldlist ], + default => 'com net org' }, +; + +my $opensrs_protocol_defaults = $opensrs_protocol_opts; +$opensrs_protocol_defaults =~ s|\n|\\n|g; + +my $opensrs_transport_defaults = $opensrs_transport_opts; +$opensrs_transport_defaults =~ s|\n|\\n|g; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Domain registration via Net::DRI', + 'options' => \%options, + 'notes' => <<"END" +Registers and transfers domains via a Net::DRI registrar or registry. +<a href="http://search.cpan.org/search?dist=Net-DRI">Net::DRI</a> +must be installed. You must have an account at the selected registrar/registry. +<BR /> +Some top-level domains have additional business rules not supported by this export. These TLDs cannot be registered or transfered with this export. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick=' + document.dummy.machine.value = "rr-n1-tor.opensrs.net"; + this.form.machine.value = "rr-n1-tor.opensrs.net"; + '> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick=' + document.dummy.machine.value = "horizon.opensrs.net"; + this.form.machine.value = "horizon.opensrs.net"; + '> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS protocol/transport options" onClick=' + this.form.protocol_opts.value = "$opensrs_protocol_defaults"; + this.form.transport_opts.value = "$opensrs_transport_defaults"; + '> +</UL> +END +); + +install_callback FS::UID sub { + $conf = new FS::Conf; +}; + +#sub rebless { shift; } + +# experiment: want the status of these right away, so no queueing + +sub _export_insert { + my( $self, $svc_domain ) = ( shift, shift ); + + return if $svc_domain->action eq 'I'; # Ignoring registration, just doing DNS + + if ($svc_domain->action eq 'N') { + return $self->register( $svc_domain ); + } elsif ($svc_domain->action eq 'M') { + return $self->transfer( $svc_domain ); + } + return "Unknown domain action " . $svc_domain->action; +} + +=item get_portfolio_credentials + +Returns, in list context, the user name and password for the domain portfolio. + +This is currently specified via the username and password keys in the protocol options. + +=cut + +sub get_portfolio_credentials { + my $self = shift; + + my %opts = $self->get_protocol_options(); + return ($opts{username}, $opts{password}); +} + +=item format_tel + +Reformats a phone number according to registry rules. Currently Freeside stores phone numbers +in NANPA format and most registries prefer "+CCC.NPANPXNNNN" + +=cut + +sub format_tel { + my $tel = shift; + + #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})\s*(x\s*(\d+))?$/) { + if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) { + $tel = "+1.$1$2$3"; # TBD: other country codes +# if $tel .= "$4" if $4; + } + return $tel; +} + +sub gen_contact_set { + my ($self, $dri, $cust_main) = @_; + + my @invoicing_list = $cust_main->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $cust_main->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $cs=$dri->local_object('contactset'); + my $co=$dri->local_object('contact'); + + my ($user, $pass) = $self->get_portfolio_credentials(); + + $co->srid($user); # Portfolio user name for OpenSRS? + $co->auth($pass); # Portfolio password for OpenSRS? + + $co->firstname($cust_main->first); + $co->name($cust_main->last); + $co->org($cust_main->company || '-'); + $co->street([$cust_main->address1, $cust_main->address2]); + $co->city($cust_main->city); + $co->sp($cust_main->state); + $co->pc($cust_main->zip); + $co->cc($cust_main->country); + $co->voice(format_tel($cust_main->daytime())); + $co->email($email); + + $cs->set($co, 'registrant'); + $cs->set($co, 'admin'); + $cs->set($co, 'billing'); + + return $cs; +} + +=item validate_contact_set + +Attempts to validate contact data for the domain based on OpenSRS rules. + +Returns undef if the contact data is acceptable, an error message if the contact +data lacks one or more required fields. + +=cut + +sub validate_contact_set { + my $c = shift; + + my %fields = ( + firstname => "first name", + name => "last name", + street => "street address", + city => "city", + sp => "state", + pc => "ZIP/postal code", + cc => "country", + email => "email address", + voice => "phone number", + ); + my @err = (); + foreach my $which (qw/registrant admin billing/) { + my $co = $c->get($which); + foreach (keys %fields) { + if (!$co->$_()) { + push @err, $fields{$_}; + } + } + } + if (scalar(@err) > 0) { + return "Contact information needs: " . join(', ', @err); + } + undef; +} + +#sub _export_replace { +# my( $self, $new, $old ) = (shift, shift, shift); +# +# return ''; +# +#} + +## Domain registration exports do nothing on delete. You're just removing the domain from Freeside, not the registry +#sub _export_delete { +# my( $self, $www ) = ( shift, shift ); +# +# return ''; +#} + +=item split_textarea_options + +Split textarea contents into lines, split lines on =, and then trim the results; + +=cut + +sub split_textarea_options { + my ($self, $optname) = @_; + my %opts = map { + my ($key, $value) = split /=/, $_; + $key =~ s/^\s*//; + $key =~ s/\s*$//; + $value =~ s/^\s*//; + $value =~ s/\s*$//; + $key => $value } split /\n/, $self->option($optname); + %opts; +} + +=item get_protocol_options + +Return a hash of protocol options + +=cut + +sub get_protocol_options { + my $self = shift; + my %opts = $self->split_textarea_options('protocol_opts'); + if ($self->machine =~ /opensrs\.net/) { + my %topts = $self->get_transport_options; + $opts{reseller_id} = $topts{client_login}; + } + %opts; +} + +=item get_transport_options + +Return a hash of transport options + +=cut + +sub get_transport_options { + my $self = shift; + my %opts = $self->split_textarea_options('transport_opts'); + $opts{remote_url} = "https://" . $self->machine . ":55443/resellers" if $self->machine =~ /opensrs\.net/; + %opts; +} + +=item is_supported_domain + +Return undef if the domain name uses a TLD or SLD that is supported by this registrar. +Otherwise return an error message explaining what's wrong. + +=cut + +sub is_supported_domain { + my $self = shift; + my $svc_domain = shift; + + # Get the TLD of the new domain + my @bits = split /\./, $svc_domain->domain; + + return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2; + + my $tld = pop @bits; + + # See if it's one this export supports + my @tlds = split /\s+/, $self->option('tlds'); + @tlds = map { s/\.//; $_ } @tlds; + return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds; + return undef; +} + +=item get_dri + +=cut + +sub get_dri { + my $self = shift; + my $dri; + +# return $self->{dri} if $self->{dri}; #!!!TBD!!! connection caching. + + eval "use Net::DRI 0.95;"; + return $@ if $@; + +# $dri=Net::DRI->new(...) to create the global object. Save the result, + + eval { + #$dri = Net::DRI::TrapExceptions->new(10); + $dri = Net::DRI->new({logging => [ 'files', { output_directory => '%%%FREESIDE_LOG%%%' } ]}); #!!!TBD!!! + $dri->logging->level( $self->option('log_level') ); + $dri->add_registry( $self->option('drd') ); + my $protocol; + $protocol = 'xcp' if $self->option('drd') eq 'OpenSRS'; + + $dri->target( $self->option('drd') )->add_current_profile($self->option('drd') . '1', +# 'Net::DRI::Protocol::' . $self->option('protocol_type'), +# $self->option('protocol_type'), +# 'xcp', #TBD!!!! + $protocol, # Implies transport +# 'Net::DRI::Transport::' . $self->option('transport_type'), + { $self->get_transport_options() }, +# [ $self->get_protocol_options() ] + ); + }; + return $@ if $@; + + $self->{dri} = $dri; + return $dri; +} + +=item get_status + +Returns a reference to a hashref containing information on the domain's status. The keys +defined depend on the status. + +'unregistered' means the domain is not registered. + +Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state +of that operation. + +Otherwise returns a value indicating if the domain can be managed through our reseller account. + +=cut + +sub get_status { + my ( $self, $svc_domain ) = @_; + my $rc; + my $rslt = {}; + + my $dri = $self->get_dri; + + if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')) { + $rslt->{'message'} = $dri->as_string; + return $rslt; + } + eval { + $rc = $dri->domain_check( $svc_domain->domain ); + if (!$rc->is_success()) { + # Problem accessing the registry/registrar + $rslt->{'message'} = $rc->message; + } elsif (!$dri->get_info('exist')) { + # Domain is not registered + $rslt->{'unregistered'} = 1; + } else { + $rc = $dri->domain_transfer_query( $svc_domain->domain ); + if ($rc->is_success() && $dri->get_info('status')) { + # Transfer in progress + $rslt->{status} = $dri->get_info('status'); + $rslt->{contact_email} = $dri->get_info('request_address'); + $rslt->{last_update_time} = $dri->get_info('unixtime'); + } elsif ($dri->get_info('reason')) { + $rslt->{'reason'} = $dri->get_info('reason'); + # Domain is not being transferred... + $rc = $dri->domain_info( $svc_domain->domain, { $self->get_protocol_options() } ); + if ($rc->is_success() && $dri->get_info('exDate')) { + $rslt->{'expdate'} = $dri->get_info('exDate'); + } + } else { + $rslt->{status} = 'Unknown'; + } + } + }; +# rslt->{'message'} = $@->as_string if $@; + if ($@) { + $rslt->{'message'} = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->as_string : $@->message; + } + + return $rslt; # Success +} + +=item register + +Attempts to register the domain through the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub register { + my ( $self, $svc_domain, $years ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception. + +# Call methods + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $cs = $self->gen_contact_set($dri, $cust_main); + + $err = validate_contact_set($cs); + return $err if $err; + +# !!!TBD!!! add custom name servers when supported; add ns => $ns to hash passed to domain_create + + $res = $dri->domain_create($svc_domain->domain, { $self->get_protocol_options(), pure_create => 1, contact => $cs, duration => DateTime::Duration->new(years => $years) }); + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item transfer + +Attempts to transfer the domain into the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub transfer { + my ( $self, $svc_domain ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + +# $dri=Net::DRI->new(...) to create the global object. Save the result, + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception + +# Call methods + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $cs = $self->gen_contact_set($dri, $cust_main); + + $err = validate_contact_set($cs); + return $err if $err; + +# !!!TBD!!! add custom name servers when supported; add ns => $ns to hash passed to domain_transfer_start + + $res = $dri->domain_transfer_start($svc_domain->domain, { $self->get_protocol_options(), contact => $cs }); + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item renew + +Attempts to renew the domain for the specified number of years. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub renew { + my ( $self, $svc_domain, $years ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception + my $expdate; + my $res = $dri->domain_info( $svc_domain->domain, { $self->get_protocol_options() } ); + if ($res->is_success() && $dri->get_info('exDate')) { + $expdate = $dri->get_info('exDate'); + +# return "Domain renewal not enabled" if !$self->option('renew'); + $res = $dri->domain_renew( $svc_domain->domain, { $self->get_protocol_options(), duration => DateTime::Duration->new(years => $years), current_expiration => $expdate }); + } + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item revoke + +Attempts to revoke the domain registration. Only succeeds if invoked during the DRI +grace period immediately after registration. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub revoke { + my ( $self, $svc_domain ) = @_; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $dri = $self->get_dri; + return $dri->as_string if (UNIVERSAL::isa($dri, 'Net::DRI::Exception')); + + eval { # All $dri methods can throw an exception + +# return "Domain registration revocation not enabled" if !$self->option('revoke'); + my $res = $dri->domain_delete( $svc_domain->domain, { $self->get_protocol_options(), domain => $svc_domain->domain, pure_delete => 1 }); + $err = $res->is_success ? '' : $res->message; + }; + if ($@) { + $err = (UNIVERSAL::isa($@, 'Net::DRI::Exception')) ? $@->msg : $@->message; + } + + return $err; +} + +=item registrar + +Should return a full-blown object representing the Net::DRI DRD, but current just returns a hashref +containing the registrar name. + +=cut + +sub registrar { + my $self = shift; + return { + name => $self->option('drd'), + }; +} + +=head1 SEE ALSO + +L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>, +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/part_export/domreg_opensrs.pm b/FS/FS/part_export/domreg_opensrs.pm new file mode 100644 index 0000000..1799ed0 --- /dev/null +++ b/FS/FS/part_export/domreg_opensrs.pm @@ -0,0 +1,512 @@ +package FS::part_export::domreg_opensrs; + +use vars qw(@ISA %info %options $conf); +use Tie::IxHash; +use FS::Record qw(qsearchs qsearch); +use FS::Conf; +use FS::part_export::null; +use FS::svc_domain; +use FS::part_pkg; + +=head1 NAME + +FS::part_export::domreg_opensrs - Register or transfer domains with Tucows OpenSRS + +=head1 DESCRIPTION + +This module handles registering and transferring domains using a registration service provider (RSP) account +at Tucows OpenSRS, an ICANN-approved domain registrar. + +As a part_export, this module can be designated for use with svc_domain services. When the svc_domain object +is inserted into the Freeside database, registration or transferring of the domain may be initiated, depending +on the setting of the svc_domain's action field. + +=over 4 + +=item N - Register the domain + +=item M - Transfer the domain + +=item I - Ignore the domain for registration purposes + +=back + +This export uses Net::OpenSRS. Registration and transfer attempts will fail unless Net::OpenSRS is installed +and LWP::UserAgent is able to make HTTPS posts. You can turn on debugging messages and use the OpenSRS test +gateway when setting up this export. + +=cut + +@ISA = qw(FS::part_export::null); + +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/; + +tie %options, 'Tie::IxHash', + 'username' => { label => 'Reseller user name at OpenSRS', + }, + 'privatekey' => { label => 'Private key', + }, + 'password' => { label => 'Password for management account', + }, + 'masterdomain' => { label => 'Master domain at OpenSRS', + }, + 'debug_level' => { label => 'Net::OpenSRS debug level', + type => 'select', + options => [ 0, 1, 2, 3 ], + default => 0 }, +# 'register' => { label => 'Use for registration', +# type => 'checkbox', +# default => '1' }, +# 'transfer' => { label => 'Use for transfer', +# type => 'checkbox', +# default => '1' }, + 'tlds' => { label => 'Use this export for these top-level domains (TLDs)', + type => 'select', + multi => 1, + size => scalar(@tldlist), + options => [ @tldlist ], + default => 'com net org' }, +; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Domain registration via Tucows OpenSRS', + 'options' => \%options, + 'notes' => <<'END' +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>). +All of the Net::OpenSRS restrictions apply: +<UL> + <LI>You must have a reseller account with Tucows. + <LI>You must add the public IP address of the Freeside server to the 'Script API allow' list in the OpenSRS web interface. + <LI>You must generate an API access key in the OpenSRS web interface and enter it below. + <LI>All domains are managed using the same user name and password, but you can create sub-accounts for clients. + <LI>The user name must be the same as your OpenSRS reseller ID. + <LI>You must enter a master domain that all other domains are associated with. That domain must be registered through your OpenSRS account. +</UL> +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. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Live System (rr-n1-tor.opensrs.net)" onClick=' + document.dummy.machine.value = "rr-n1-tor.opensrs.net"; + this.form.machine.value = "rr-n1-tor.opensrs.net"; + '> + <LI> + <INPUT TYPE="button" VALUE="OpenSRS Test System (horizon.opensrs.net)" onClick=' + document.dummy.machine.value = "horizon.opensrs.net"; + this.form.machine.value = "horizon.opensrs.net"; + '> +</UL> +END +); + +install_callback FS::UID sub { + $conf = new FS::Conf; +}; + +=head1 METHODS + +=over 4 + +=item format_tel + +Reformats a phone number according to registry rules. Currently Freeside stores phone numbers +in NANPA format and the registry prefers "+CCC.NPANPXNNNN" + +=cut + +sub format_tel { + my $tel = shift; + + #if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})( x(\d+))?$/) { + if ($tel =~ /^(\d{3})-(\d{3})-(\d{4})$/) { + $tel = "+1.$1$2$3"; +# if $tel .= "$4" if $4; + } + return $tel; +} + +=item gen_contact_info + +Generates contact data for the domain based on the customer data. + +Currently relies on Net::OpenSRS to format the telephone number for OpenSRS. + +=cut + +sub gen_contact_info +{ + my ($co)=@_; + + my @invoicing_list = $co->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $co->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $c = { + firstname => $co->first, + lastname => $co->last, + company => $co->company, + address => $co->address1, + city => $co->city(), + state => $co->state(), + zip => $co->zip(), + country => uc($co->country()), + email => $email, + #phone => format_tel($co->daytime()), + phone => $co->daytime() || $co->night, + }; + return $c; +} + +=item validate_contact_info + +Attempts to validate contact data for the domain based on OpenSRS rules. + +Returns undef if the contact data is acceptable, an error message if the contact +data lacks one or more required fields. + +=cut + +sub validate_contact_info { + my $c = shift; + + my %fields = ( + firstname => "first name", + lastname => "last name", + address => "street address", + city => "city", + state => "state", + zip => "ZIP/postal code", + country => "country", + email => "email address", + phone => "phone number", + ); + my @err = (); + foreach (keys %fields) { + if (!defined($c->{$_}) || !$c->{$_}) { + push @err, $fields{$_}; + } + } + if (scalar(@err) > 0) { + return "Contact information needs: " . join(', ', @err); + } + undef; +} + +=item testmode + +Returns the Net::OpenSRS-required test mode string based on whether the export +is configured to use the live or the test gateway. + +=cut + +sub testmode { + my $self = shift; + + return 'live' if $self->machine eq "rr-n1-tor.opensrs.net"; + return 'test' if $self->machine eq "horizon.opensrs.net"; + undef; +} + +=item _export_insert + +Attempts to "export" the domain, i.e. register or transfer it if the user selected +that option when editing the domain. + +Returns an error message on failure or undef on success. + +May also return an error message if it cannot load the required Perl module Net::OpenSRS, +or if the domain is not registerable, or if insufficient data is provided in the customer +record to generate the required contact information to register or transfer the domain. + +=cut + +sub _export_insert { + my( $self, $svc_domain ) = ( shift, shift ); + + return if $svc_domain->action eq 'I'; # Ignoring registration, just doing DNS + + if ($svc_domain->action eq 'N') { + return $self->register( $svc_domain ); + } elsif ($svc_domain->action eq 'M') { + return $self->transfer( $svc_domain ); + } + return "Unknown domain action " . $svc_domain->action; +} + +## 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); +# +# return ''; +# +#} + +## Domain registration exports do nothing on delete. You're just removing the domain from Freeside, not the registry +#sub _export_delete { +# my( $self, $svc_domain ) = ( shift, shift ); +# +# return ''; +#} + +=item is_supported_domain + +Return undef if the domain name uses a TLD or SLD that is supported by this registrar. +Otherwise return an error message explaining what's wrong. + +=cut + +sub is_supported_domain { + my $self = shift; + my $svc_domain = shift; + + # Get the TLD of the new domain + my @bits = split /\./, $svc_domain->domain; + + return "Can't register subdomains: " . $svc_domain->domain if scalar(@bits) != 2; + + my $tld = pop @bits; + + # See if it's one this export supports + my @tlds = split /\s+/, $self->option('tlds'); + @tlds = map { s/\.//; $_ } @tlds; + return "Can't register top-level domain $tld, restricted to: " . $self->option('tlds') if ! grep { $_ eq $tld } @tlds; + return undef; +} + +=item get_srs + +=cut + +sub get_srs { + my $self = shift; + + my $srs = Net::OpenSRS->new(); + + $srs->debug_level( $self->option('debug_level') ); # Output should be in the Apache error log + + $srs->environment( $self->testmode() ); + $srs->set_key( $self->option('privatekey') ); + + $srs->set_manage_auth( $self->option('username'), $self->option('password') ); + return $srs; +} + +=item get_status + +Returns a reference to a hashref containing information on the domain's status. The keys +defined depend on the status. + +'unregistered' means the domain is not registered. + +Otherwise, if the domain is in an asynchronous operation such as a transfer, returns the state +of that operation. + +Otherwise returns a value indicating if the domain can be managed through our reseller account. + +=cut + +sub get_status { + my ( $self, $svc_domain ) = @_; + my $rslt = {}; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $srs = $self->get_srs; + + if ($srs->is_available( $svc_domain->domain )) { + $rslt->{'unregistered'} = 1; + } else { + $rslt = $srs->check_transfer( $svc_domain->domain ); + if (defined($rslt->{'reason'})) { + my $rv = $srs->make_request( + { + action => 'belongs_to_rsp', + object => 'domain', + attributes => { + domain => $svc_domain->domain + } + } + ); + if ($rv) { + $self->_set_response; + if ( $rv->{attributes}->{'domain_expdate'} ) { + $rslt->{'expdate'} = $rv->{attributes}->{'domain_expdate'}; + } + } + } + } + + return $rslt; # Success +} + +=item register + +Attempts to register the domain through the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub register { + my ( $self, $svc_domain, $years ) = @_; + + return "Net::OpenSRS does not support period other than 1 year" if $years != 1; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $c = gen_contact_info($cust_main); + + $err = validate_contact_info($c); + return $err if $err; + + 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(); + } + +# 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 register succeeded +} + +=item transfer + +Attempts to transfer the domain into the reseller account associated with this export. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub transfer { + my ( $self, $svc_domain ) = @_; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + my $cust_main = $svc_domain->cust_svc->cust_pkg->cust_main; + + my $c = gen_contact_info($cust_main); + + $err = validate_contact_info($c); + return $err if $err; + + 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(); + } + +# return "Domain transfer not enabled" if !$self->option('transfer'); + return $srs->last_response() if !$srs->transfer_domain( $svc_domain->domain, $c); + + return ''; # Should only get here if transfer succeeded +} + +=item renew + +Attempts to renew the domain for the specified number of years. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub renew { + my ( $self, $svc_domain, $years ) = @_; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + 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(); + } + +# return "Domain renewal not enabled" if !$self->option('renew'); + return $srs->last_response() if !$srs->renew_domain( $svc_domain->domain, $years ); + + return ''; # Should only get here if renewal succeeded +} + +=item revoke + +Attempts to revoke the domain registration. Only succeeds if invoked during the OpenSRS +grace period immediately after registration. + +Like most export functions, returns an error message on failure or undef on success. + +=cut + +sub revoke { + my ( $self, $svc_domain ) = @_; + + eval "use Net::OpenSRS;"; + return $@ if $@; + + my $err = $self->is_supported_domain( $svc_domain ); + return $err if $err; + + 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(); + } + +# return "Domain registration revocation not enabled" if !$self->option('revoke'); + return $srs->last_response() if !$srs->revoke_domain( $svc_domain->domain); + + return ''; # Should only get here if transfer succeeded +} + +=item registrar + +Should return a full-blown object representing OpenSRS, but current just returns a hashref +containing the registrar name. + +=cut + +sub registrar { + return { + name => 'OpenSRS', + }; +} + +=back + +=head1 SEE ALSO + +L<Net::OpenSRS>, L<FS::part_export_option>, L<FS::export_svc>, L<FS::svc_domain>, +L<FS::Record>, schema.html from the base documentation. + + +=cut + +1; + diff --git a/FS/FS/part_export/globalpops_voip.pm b/FS/FS/part_export/globalpops_voip.pm index 3bd5783..67b48bb 100644 --- a/FS/FS/part_export/globalpops_voip.pm +++ b/FS/FS/part_export/globalpops_voip.pm @@ -32,7 +32,7 @@ sub get_dids { my $self = shift; my %opt = ref($_[0]) ? %{$_[0]} : @_; - my %search = (); + my %getdids = (); # 'orderby' => 'npa', #but it doesn't seem to work :/ if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm new file mode 100644 index 0000000..cf4b5e3 --- /dev/null +++ b/FS/FS/part_export/netsapiens.pm @@ -0,0 +1,308 @@ +package FS::part_export::netsapiens; + +use vars qw(@ISA $me %info); +use URI; +use MIME::Base64; +use Tie::IxHash; +use FS::part_export; + +@ISA = qw(FS::part_export); +$me = '[FS::part_export::netsapiens]'; + +tie my %options, 'Tie::IxHash', + 'login' => { label=>'NetSapiens tac2 User API username' }, + 'password' => { label=>'NetSapiens tac2 User API password' }, + 'url' => { label=>'NetSapiens tac2 User URL' }, + 'device_login' => { label=>'NetSapiens tac2 Device API username' }, + 'device_password' => { label=>'NetSapiens tac2 Device API password' }, + 'device_url' => { label=>'NetSapiens tac2 Device URL' }, + 'domain' => { label=>'NetSapiens Domain' }, + 'debug' => { label=>'Enable debugging', type=>'checkbox' }, +; + +%info = ( + 'svc' => 'svc_phone', + 'desc' => 'Provision phone numbers to NetSapiens', + 'options' => \%options, + 'notes' => <<'END' +Requires installation of +<a href="http://search.cpan.org/dist/REST-Client">REST::Client</a> +from CPAN. +END +); + +sub rebless { shift; } + +sub ns_command { + my $self = shift; + $self->_ns_command('', @_); +} + +sub ns_device_command { + my $self = shift; + $self->_ns_command('device_', @_); +} + +sub _ns_command { + my( $self, $prefix, $method, $command ) = splice(@_,0,4); + + eval 'use REST::Client'; + die $@ if $@; + + my $ns = new REST::Client 'host'=>$self->option($prefix.'url'); + + my @args = ( $command ); + + if ( $method eq 'PUT' ) { + my $content = $ns->buildQuery( { @_ } ); + $content =~ s/^\?//; + push @args, $content; + } elsif ( $method eq 'GET' ) { + $args[0] .= $ns->buildQuery( { @_ } ); + } + + warn "$me $method ". $self->option($prefix.'url'). + " $command ". join(', ', @_). "\n" + if $self->option('debug'); + + my $auth = encode_base64( $self->option($prefix.'login'). ':'. + $self->option($prefix.'password') ); + push @args, { 'Authorization' => "Basic $auth" }; + + $ns->$method( @args ); + $ns; +} + +sub ns_subscriber { + my($self, $svc_phone) = (shift, shift); + + my $domain = $self->option('domain'); + my $phonenum = $svc_phone->phonenum; + + "/domains_config/$domain/subscriber_config/$phonenum"; +} + +sub ns_registrar { + my($self, $svc_phone) = (shift, shift); + + $self->ns_subscriber($svc_phone). + '/registrar_config/'. $self->ns_devicename($svc_phone); +} + +sub ns_devicename { + my( $self, $svc_phone ) = (shift, shift); + + my $domain = $self->option('domain'); + #my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + #"sip:$countrycode$phonenum\@$domain"; + "sip:$phonenum\@$domain"; +} + +sub ns_dialplan { + my($self, $svc_phone) = (shift, shift); + + #my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + #"/dialplans/DID+Table/dialplan_config/sip:$countrycode$phonenum\@*" + "/dialplans/DID+Table/dialplan_config/sip:$phonenum\@*" +} + +sub ns_device { + my($self, $svc_phone, $phone_device ) = (shift, shift, shift); + + #my $countrycode = $svc_phone->countrycode; + #my $phonenum = $svc_phone->phonenum; + + "/phones_config/". lc($phone_device->mac_addr); +} + +sub ns_create_or_update { + my($self, $svc_phone, $dial_policy) = (shift, shift, shift); + + my $domain = $self->option('domain'); + #my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + my( $firstname, $lastname ); + if ( $svc_phone->phone_name =~ /^\s*(\S+)\s+(\S.*\S)\s*$/ ) { + $firstname = $1; + $lastname = $2; + } else { + #deal w/unaudited netsapiens services? + my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main; + $firstname = $cust_main->get('first'); + $lastname = $cust_main->get('last'); + } + + # Piece 1 (already done) - User creation + + my $ns = $self->ns_command( 'PUT', $self->ns_subscriber($svc_phone), + 'subscriber_login' => $phonenum.'@'.$domain, + 'firstname' => $firstname, + 'lastname' => $lastname, + 'subscriber_pin' => $svc_phone->pin, + 'dial_plan' => 'Default', #config? + 'dial_policy' => $dial_policy, + ); + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + #Piece 2 - sip device creation + + my $ns2 = $self->ns_command( 'PUT', $self->ns_registrar($svc_phone), + 'termination_match' => $self->ns_devicename($svc_phone) + ); + + if ( $ns2->responseCode !~ /^2/ ) { + return $ns2->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns2->responseContent ) ); + } + + #Piece 3 - DID mapping to user + + my $ns3 = $self->ns_command( 'PUT', $self->ns_dialplan($svc_phone), + 'to_user' => $phonenum, + 'to_host' => $domain, + ); + + if ( $ns3->responseCode !~ /^2/ ) { + return $ns3->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns3->responseContent ) ); + } + + ''; +} + +sub ns_delete { + my($self, $svc_phone) = (shift, shift); + + my $ns = $self->ns_command( 'DELETE', $self->ns_subscriber($svc_phone) ); + + #delete other things? + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + ''; + +} + +sub ns_parse_response { + my( $self, $content ) = ( shift, shift ); + + #try to screen-scrape something useful + tie my %hash, Tie::IxHash; + while ( $content =~ s/^.*?<p>\s*<b>(.+?)<\/b>\s*(.+?)\s*<\/p>//is ) { + ( $hash{$1} = $2 ) =~ s/^\s*<(\w+)>(.+?)<\/\1>/$2/is; + } + + %hash; +} + +sub _export_insert { + my($self, $svc_phone) = (shift, shift); + $self->ns_create_or_update($svc_phone, 'Permit All'); +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + return "can't change phonenum with NetSapiens (unprovision and reprovision?)" + if $old->phonenum ne $new->phonenum; + $self->_export_insert($new); +} + +sub _export_delete { + my( $self, $svc_phone ) = (shift, shift); + + $self->ns_delete($svc_phone); +} + +sub _export_suspend { + my( $self, $svc_phone ) = (shift, shift); + $self->ns_create_or_update($svc_phone, 'Deny'); +} + +sub _export_unsuspend { + my( $self, $svc_phone ) = (shift, shift); + #$self->ns_create_or_update($svc_phone, 'Permit All'); + $self->_export_insert($svc_phone); +} + +sub export_device_insert { + my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + + #my $domain = $self->option('domain'); + my $countrycode = $svc_phone->countrycode; + my $phonenum = $svc_phone->phonenum; + + my $device = $self->ns_devicename($svc_phone); + + my $ns = $self->ns_device_command( + 'PUT', $self->ns_device($svc_phone, $phone_device), + 'line1_enable' => 'yes', + 'device1' => $self->ns_devicename($svc_phone), + 'line1_ext' => $phonenum, +, + #'line2_enable' => 'yes', + #'device2' => + #'line2_ext' => + + #'notes' => + 'server' => 'SiPbx', + 'domain' => $self->option('domain'), + + 'brand' => $phone_device->part_device->devicename, + + ); + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + ''; + +} + +sub export_device_delete { + my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); + + my $ns = $self->ns_device_command( + 'DELETE', $self->ns_device($svc_phone, $phone_device), + ); + + if ( $ns->responseCode !~ /^2/ ) { + return $ns->responseCode. ' '. + join(', ', $self->ns_parse_response( $ns->responseContent ) ); + } + + ''; + +} + + +sub export_device_replace { + my( $self, $svc_phone, $new_phone_device, $old_phone_device ) = + (shift, shift, shift, shift); + + #? + $self->export_device_insert( $svc_phone, $new_phone_device ); + +} + +sub export_links { + my($self, $svc_phone, $arrayref) = (shift, shift, shift); + #push @$arrayref, qq!<A HREF="http://example.com/~!. $svc_phone->username. + # qq!">!. $svc_phone->username. qq!</A>!; + ''; +} + +1; diff --git a/FS/FS/part_export/prizm.pm b/FS/FS/part_export/prizm.pm index 2d4d858..9705440 100644 --- a/FS/FS/part_export/prizm.pm +++ b/FS/FS/part_export/prizm.pm @@ -200,6 +200,9 @@ sub _export_insert { # } # } + my $performance_profile = $svc->performance_profile; + $performance_profile ||= $svc->cust_svc->cust_pkg->part_pkg->pkg; + my $element_name_length = 50; $element_name_length = $1 if $self->option('element_name_length') =~ /^\s*(\d+)\s*$/; @@ -211,7 +214,7 @@ sub _export_insert { $location, $contact, sprintf("%032X", $svc->authkey), - $svc->cust_svc->cust_pkg->part_pkg->pkg, + $performance_profile, $svc->vlan_profile, ($self->option('ems') ? 1 : 0 ), ); @@ -256,7 +259,7 @@ sub _export_insert { $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', [ $element ], - $svc->cust_svc->cust_pkg->part_pkg->pkg, + $performance_profile, 0, 1, ); @@ -395,9 +398,12 @@ sub _export_replace { return $err_or_som unless ref($err_or_som); + my $performance_profile = $new->performance_profile; + $performance_profile ||= $new->cust_svc->cust_pkg->part_pkg->pkg; + $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', [ $element ], - $new->cust_svc->cust_pkg->part_pkg->pkg, + $performance_profile, 0, 1, ); diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index c55fa36..7baf2da 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -14,6 +14,9 @@ tie my %options, 'Tie::IxHash', default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' }, + 'useradd_no_queue' => { label=>'Run immediately', + type => 'checkbox', + }, 'useradd_stdin' => { label=>'Insert command STDIN', type =>'textarea', default=>'', @@ -22,6 +25,9 @@ tie my %options, 'Tie::IxHash', default=>'userdel -r $username', #default=>'rm -rf $dir', }, + 'userdel_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'userdel_stdin' => { label=>'Delete command STDIN', type =>'textarea', default=>'', @@ -35,6 +41,9 @@ tie my %options, 'Tie::IxHash', # 'rm -rf $old_dir'. #')' }, + 'usermod_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'usermod_stdin' => { label=>'Modify command STDIN', type =>'textarea', default=>'', @@ -48,12 +57,18 @@ tie my %options, 'Tie::IxHash', 'suspend' => { label=>'Suspension command', default=>'usermod -L $username', }, + 'suspend_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'suspend_stdin' => { label=>'Suspension command STDIN', default=>'', }, 'unsuspend' => { label=>'Unsuspension command', default=>'usermod -U $username', }, + 'unsuspend_no_queue' => { label=>'Run immediately', + type =>'checkbox', + }, 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', default=>'', }, @@ -65,6 +80,9 @@ tie my %options, 'Tie::IxHash', 'Radius group mapping to reason (via template user)', type => 'textarea', }, +# 'no_queue' => { label => 'Run command immediately', +# type => 'checkbox', +# }, ; %info = ( @@ -172,6 +190,8 @@ old_ for replace operations): <LI><code>$reasontext (when suspending)</code> <LI><code>$reasontypenum (when suspending)</code> <LI><code>$reasontypetext (when suspending)</code> + <LI><code>$pkgnum</code> + <LI><code>$custnum</code> <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available. </UL> END @@ -296,15 +316,27 @@ sub _export_command { $finger = shell_quote $finger; $crypt_password = shell_quote $crypt_password; $ldap_password = shell_quote $ldap_password; + $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : ''; + $custnum = $cust_pkg ? $cust_pkg->custnum : ''; my $command_string = eval(qq("$command")); - - $self->shellcommands_queue( $svc_acct->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => $command_string, - stdin_string => $stdin_string, + my @ssh_cmd_args = ( + user => $self->option('user') || 'root', + host => $self->machine, + command => $command_string, + stdin_string => $stdin_string, ); + + if($self->option($action . '_no_queue')) { + # discard return value just like freeside-queued. + eval { ssh_cmd(@ssh_cmd_args) }; + $error = $@; + return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + if $error; + } + else { + $self->shellcommands_queue( $svc_acct->svcnum, @ssh_cmd_args ); + } } sub _export_replace { @@ -317,6 +349,8 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; } + my $old_cust_pkg = $old->cust_svc->cust_pkg; + my $new_cust_pkg = $new->cust_svc->cust_pkg; $new_finger =~ /^(.*)\s+(\S+)$/ or $new_finger =~ /^((.*))$/; ($new_first, $new_last ) = ( $1, $2 ); $quoted_new__password = shell_quote $new__password; #old, wrong? @@ -364,15 +398,30 @@ sub _export_replace { $new_finger = shell_quote $new_finger; $new_crypt_password = shell_quote $new_crypt_password; $new_ldap_password = shell_quote $new_ldap_password; + $old_pkgnum = $old_cust_pkg ? $old_cust_pkg->pkgnum : ''; + $old_custnum = $old_cust_pkg ? $old_cust_pkg->custnum : ''; + $new_pkgnum = $new_cust_pkg ? $new_cust_pkg->pkgnum : ''; + $new_custnum = $new_cust_pkg ? $new_cust_pkg->custnum : ''; my $command_string = eval(qq("$command")); - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => $command_string, - stdin_string => $stdin_string, + my @ssh_cmd_args = ( + user => $self->option('user') || 'root', + host => $self->machine, + command => $command_string, + stdin_string => $stdin_string, ); + + if($self->option('usermod_no_queue')) { + # discard return value just like freeside-queued. + eval { ssh_cmd(@ssh_cmd_args) }; + $error = $@; + return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' + if $error; + } + else { + $self->shellcommands_queue( $new->svcnum, @ssh_cmd_args ); + } } #a good idea to queue anything that could fail or take any time diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm index 7c5d904..c209002 100644 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -15,6 +15,9 @@ tie my %options, 'Tie::IxHash', type =>'textarea', #default=>"$_password\n$_password\n", }, + 'useradd_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'userdel' => { label=>'Delete command', #default=>'', }, @@ -22,6 +25,9 @@ tie my %options, 'Tie::IxHash', type =>'textarea', #default=>'', }, + 'userdel_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'usermod' => { label=>'Modify command', default=>'', }, @@ -29,6 +35,9 @@ tie my %options, 'Tie::IxHash', type =>'textarea', #default=>"$_password\n$_password\n", }, + 'usermod_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'usermod_pwonly' => { label=>'Disallow username, domain, uid, dir and RADIUS group changes', type =>'checkbox', }, @@ -41,12 +50,18 @@ tie my %options, 'Tie::IxHash', 'suspend_stdin' => { label=>'Suspension command STDIN', default=>'', }, + 'suspend_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'unsuspend' => { label=>'Unsuspension command', default=>'', }, 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', default=>'', }, + 'unsuspend_no_queue' => { label => 'Run immediately', + type => 'checkbox', + }, 'crypt' => { label => 'Default password encryption', type=>'select', options=>[qw(crypt md5)], default => 'crypt', @@ -84,6 +99,17 @@ the same username with different domains. You will need to this.form.usermod_stdin.value = ""; this.form.usermod_pwonly.checked = true; '> + <LI><INPUT TYPE="button" VALUE="MagicMail" onClick=' + this.form.useradd.value = "/usr/bin/mm_create_email_service -e $svcnum -d $domain -u $username -p $quoted_password -f $first -l $last -m $svcnum -g EMAIL"; + this.form.useradd_stdin.value = ""; + this.form.useradd_no_queue.checked = 1; + this.form.userdel.value = "/usr/bin/mm_delete_user -e ${username}\\\@${domain}"; + this.form.userdel_stdin.value = ""; + this.form.suspend.value = "/usr/bin/mm_suspend_user -e ${username}\\\@${domain}"; + this.form.suspend_stdin.value = ""; + this.form.unsuspend.value = "/usr/bin/mm_activate_user -e ${username}\\\@${domain}"; + this.form.unsuspend_stdin.value = ""; + '> </UL> The following variables are available for interpolation (prefixed with diff --git a/FS/FS/part_export/www_plesk.pm b/FS/FS/part_export/www_plesk.pm index 82d5557..ccf9b3e 100644 --- a/FS/FS/part_export/www_plesk.pm +++ b/FS/FS/part_export/www_plesk.pm @@ -26,7 +26,7 @@ Real-time export to <a href="http://www.swsoft.com/">Plesk</a> managed server. Requires installation of <a href="http://search.cpan.org/dist/Net-Plesk">Net::Plesk</a> -from CPAN. +from CPAN and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:www_plesk.pm">configuration</a>. END ); |