diff options
Diffstat (limited to 'FS/FS/part_export')
58 files changed, 0 insertions, 13862 deletions
diff --git a/FS/FS/part_export/acct_freeside.pm b/FS/FS/part_export/acct_freeside.pm deleted file mode 100644 index 3c287ca..0000000 --- a/FS/FS/part_export/acct_freeside.pm +++ /dev/null @@ -1,139 +0,0 @@ -package FS::part_export::acct_freeside; - -use vars qw( @ISA %info $DEBUG ); -use Data::Dumper; -use Tie::IxHash; -use FS::part_export; -#use FS::Record qw( qsearch qsearchs ); -use Frontier::Client; - -@ISA = qw(FS::part_export); - -$DEBUG = 1; - -tie my %options, 'Tie::IxHash', - 'xmlrpc_url' => { label => 'Full URL to target Freeside xmlrpc.cgi', }, - 'ss_username' => { label => 'Self-service username', }, - 'ss_domain' => { label => 'Self-service domain', }, - 'ss_password' => { label => 'Self-service password', }, - 'domsvc' => { label => 'Domain svcnum on target machine', }, - 'pkgnum' => { label => 'Customer package pkgnum on target machine', }, - 'svcpart' => { label => 'Service definition svcpart on target machine', }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to another Freeside server', - 'options' => \%options, - 'notes' => <<END -Real-time export to another Freeside server via self-service. -Requires installation of -<a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a> -from CPAN and setup of an appropriate bulk customer on the other Freeside server. -END -); - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - my $result = $self->_freeside_command('provision_acct', - 'pkgnum' => $self->option('pkgnum'), - 'svcpart' => $self->option('svcpart'), - 'username' => $svc_acct->username, - '_password' => $svc_acct->_password, - '_password2' => $svc_acct->_password, - 'domsvc' => $self->option('domsvc'), - ); - - $result->{error} || ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - my $svcnum = $self->_freeside_find_svc( $old ); - return $svcnum unless $svcnum =~ /^(\d+)$/; - - #only pw change supported for now... - my $result = $self->_freeside_command( 'myaccount_passwd', - 'svcnum' => $svcnum, - 'new_password' => $new->_password, - 'new_password2' => $new->_password, - ); - - $result->{error} || ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - - my $svcnum = $self->_freeside_find_svc( $svc_acct ); - return $svcnum unless $svcnum =~ /^(\d+)$/; - - my $result = $self->_freeside_command( 'unprovision_svc', 'svcnum'=>$svcnum ); - - $result->{'error'} || ''; - -} - -sub _freeside_find_svc { - my( $self, $svc_acct ) = ( shift, shift ); - - my $list_svcs = $self->_freeside_command( 'list_svcs', 'svcdb'=>'svc_acct' ); - my @svc = grep { $svc_acct->username eq $_->{username} - #&& compare domains - } @{ $list_svcs->{svcs} }; - - return 'multiple services found on target FS' if scalar(@svc) > 1; - return 'no service found on target FS' if scalar(@svc) == 0; #shouldn't be fatal? - - $svc[0]->{'svcnum'}; - -} - -sub _freeside_command { - my( $self, $method, @args ) = @_; - - my %login = ( - 'username' => $self->option('ss_username'), - 'domain' => $self->option('ss_domain'), - 'password' => $self->option('ss_password'), - ); - my $login_result = $self->_do_freeside_command( 'login', %login ); - return $login_result if $login_result->{error}; - my $session_id = $login_result->{session_id}; - - #could reuse $session id for replace & delete where we have to find then delete.. - - my %command = ( - session_id => $session_id, - @args - ); - my $result = $self->_do_freeside_command( $method, %command ); - - $result; - -} - -sub _do_freeside_command { - my( $self, $method, %args ) = @_; - - # a questionable choice... but it'll do for now. - eval "use Frontier::Client;"; - die $@ if $@; - - #reuse? - my $conn = Frontier::Client->new( url => $self->option('xmlrpc_url') ); - - warn "sending FS selfservice $method: ". Dumper(\%args) - if $DEBUG; - my $result = $conn->call("FS.SelfService.XMLRPC.$method", \%args); - warn "FS selfservice $method response: ". Dumper($result) - if $DEBUG; - - $result; - -} - -1; diff --git a/FS/FS/part_export/acct_http.pm b/FS/FS/part_export/acct_http.pm deleted file mode 100644 index b4c64ac..0000000 --- a/FS/FS/part_export/acct_http.pm +++ /dev/null @@ -1,63 +0,0 @@ -package FS::part_export::acct_http; - -use vars qw( @ISA %info ); -use FS::part_export::http; -use Tie::IxHash; - -@ISA = qw( FS::part_export::http ); - -tie %options, 'Tie::IxHash', - 'method' => { label =>'Method', - type =>'select', - #options =>[qw(POST GET)], - options =>[qw(POST)], - default =>'POST' }, - 'url' => { label => 'URL', default => 'http://', }, - 'insert_data' => { - label => 'Insert data', - type => 'textarea', - default => join("\n", - "action 'add'", - "username \$svc_x->username", - "password \$svc_x->_password", - "prismid \$cust_main->agent_custid ? \$cust_main->agent_custid : \$cust_main->custnum ", - "name \$cust_main->first.' '.\$cust_main->last", - ), - }, - 'delete_data' => { - label => 'Delete data', - type => 'textarea', - default => join("\n", - "action 'remove'", - "username \$svc_x->username", - ), - }, - 'replace_data' => { - label => 'Replace data', - type => 'textarea', - default => join("\n", - "action 'update'", - "username \$old->username", - "password \$new->_password", - ), - }, - 'success_regexp' => { - label => 'Success Regexp', - default => '', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Send an HTTP or HTTPS GET or POST request, for accounts.', - 'options' => \%options, - 'notes' => <<'END' -Send an HTTP or HTTPS GET or POST to the specified URL on account addition, -modification and deletion. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required. -END -); - -1; diff --git a/FS/FS/part_export/acct_plesk.pm b/FS/FS/part_export/acct_plesk.pm deleted file mode 100644 index d8d70a3..0000000 --- a/FS/FS/part_export/acct_plesk.pm +++ /dev/null @@ -1,121 +0,0 @@ -package FS::part_export::acct_plesk; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'URL' => { label=>'URL' }, - 'login' => { label=>'Login' }, - 'password' => { label=>'Password' }, - 'debug' => { label=>'Enable debugging', - type=>'checkbox' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Plesk managed mail service', - 'options'=> \%options, - 'notes' => <<'END' -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 and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:acct_plesk.pm">configuration</a>. -END -); - -sub rebless { shift; } - -# experiment: want the status of these right away (don't want account to -# create or whatever and then get error in the queue from dup username or -# something), so no queueing - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - - $self->_plesk_command( 'mail_add', - $svc_acct->domain, - $svc_acct->username, - $svc_acct->_password, - ) || - $self->_export_unsuspend($svc_acct); -} - -sub _plesk_command { - my( $self, $method, $domain, @args ) = @_; - - eval "use Net::Plesk;"; - return $@ if $@; - - local($Net::Plesk::DEBUG) = 1 - if $self->option('debug'); - - my $plesk = new Net::Plesk ( - 'POST' => $self->option('URL'), - ':HTTP_AUTH_LOGIN' => $self->option('login'), - ':HTTP_AUTH_PASSWD' => $self->option('password'), - ); - - my $dresponse = $plesk->domain_get( $domain ); - return $dresponse->errortext unless $dresponse->is_success; - my $domainID = $dresponse->id; - - my $response = $plesk->$method($dresponse->id, @args); - return $response->errortext unless $response->is_success; - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - return "can't change domain with Plesk" - if $old->domain ne $new->domain; - return "can't change username with Plesk" - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - - $self->_plesk_command( 'mail_set', - $new->domain, - $new->username, - $new->_password, - $old->cust_svc->cust_pkg->susp ? 0 : 1, - ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - - $self->_plesk_command( 'mail_remove', - $svc_acct->domain, - $svc_acct->username, - ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - - $self->_plesk_command( 'mail_set', - $svc_acct->domain, - $svc_acct->username, - $svc_acct->_password, - 0, - ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - - $self->_plesk_command( 'mail_set', - $svc_acct->domain, - $svc_acct->username, - $svc_acct->_password, - 1, - ); -} - -1; - diff --git a/FS/FS/part_export/acct_sql.pm b/FS/FS/part_export/acct_sql.pm deleted file mode 100644 index 9f1ae7b..0000000 --- a/FS/FS/part_export/acct_sql.pm +++ /dev/null @@ -1,310 +0,0 @@ -package FS::part_export::acct_sql; - -use vars qw(@ISA %info); -use Tie::IxHash; -#use Digest::MD5 qw(md5_hex); -use FS::Record; #qw(qsearchs); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'datasrc' => { label => 'DBI data source' }, - 'username' => { label => 'Database username' }, - 'password' => { label => 'Database password' }, - 'table' => { label => 'Database table' }, - 'schema' => { label => - 'Database schema mapping to Freeside methods.', - type => 'textarea', - }, - 'static' => { label => - 'Database schema mapping to static values.', - type => 'textarea', - }, - 'primary_key' => { label => 'Database primary key' }, - 'crypt' => { label => 'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %vpopmail_map, 'Tie::IxHash', - 'pw_name' => 'username', - 'pw_domain' => 'domain', - 'pw_passwd' => 'crypt_password', - 'pw_uid' => 'uid', - 'pw_gid' => 'gid', - 'pw_gecos' => 'finger', - 'pw_dir' => 'dir', - #'pw_shell' => 'shell', - 'pw_shell' => 'quota', -; -my $vpopmail_map = join('\n', map "$_ $vpopmail_map{$_}", keys %vpopmail_map ); - -tie my %postfix_courierimap_mailbox_map, 'Tie::IxHash', - 'username' => 'email', - 'password' => '_password', - 'crypt' => 'crypt_password', - 'name' => 'finger', - 'maildir' => 'virtual_maildir', - 'domain' => 'domain', - 'svcnum' => 'svcnum', -; -my $postfix_courierimap_mailbox_map = - join('\n', map "$_ $postfix_courierimap_mailbox_map{$_}", - keys %postfix_courierimap_mailbox_map ); - -tie my %postfix_courierimap_alias_map, 'Tie::IxHash', - 'address' => 'email', - 'goto' => 'email', - 'domain' => 'domain', - 'svcnum' => 'svcnum', -; -my $postfix_courierimap_alias_map = - join('\n', map "$_ $postfix_courierimap_alias_map{$_}", - keys %postfix_courierimap_alias_map ); - -tie my %postfix_native_mailbox_map, 'Tie::IxHash', - 'userid' => 'email', - 'uid' => 'uid', - 'gid' => 'gid', - 'password' => 'ldap_password', - 'mail' => 'domain_slash_username', -; -my $postfix_native_mailbox_map = - join('\n', map "$_ $postfix_native_mailbox_map{$_}", - keys %postfix_native_mailbox_map ); - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export of accounts to SQL databases '. - '(vpopmail, Postfix+Courier IMAP, others?)', - 'options' => \%options, - 'nodomain' => '', - 'notes' => <<END -Export accounts (svc_acct records) to SQL databases. Currently has default -configurations for vpopmail and Postfix+Courier IMAP but intended to be -configurable for other schemas as well. - -<BR><BR>In contrast to sqlmail, this is intended to export just svc_acct -records only, rather than a single export for svc_acct, svc_forward and -svc_domain records, to export in "default" database schemas rather than -configure the MTA or POP/IMAP server for a Freeside-specific schema, and -to be configured for different mail server setups. - -<BR><BR>Use these buttons for some useful presets: -<UL> - <li><INPUT TYPE="button" VALUE="vpopmail" onClick=' - this.form.table.value = "vpopmail"; - this.form.schema.value = "$vpopmail_map"; - this.form.primary_key.value = "pw_name, pw_domain"; - '> - <LI><INPUT TYPE="button" VALUE="postfix_courierimap_mailbox" onClick=' - this.form.table.value = "mailbox"; - this.form.schema.value = "$postfix_courierimap_mailbox_map"; - this.form.primary_key.value = "username"; - '> - <LI><INPUT TYPE="button" VALUE="postfix_courierimap_alias" onClick=' - this.form.table.value = "alias"; - this.form.schema.value = "$postfix_courierimap_alias_map"; - this.form.primary_key.value = "address"; - '> - <LI><INPUT TYPE="button" VALUE="postfix_native_mailbox" onClick=' - this.form.table.value = "users"; - this.form.schema.value = "$postfix_native_mailbox_map"; - this.form.primary_key.value = "userid"; - '> -</UL> -END -); - -sub _schema_map { shift->_map('schema'); } -sub _static_map { shift->_map('static'); } - -sub _map { - my $self = shift; - map { /^\s*(\S+)\s*(\S+)\s*$/ } split("\n", $self->option(shift) ); -} - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - my %schema = $self->_schema_map; - my %static = $self->_static_map; - - my %record = ( - - ( map { $_ => $static{$_} } keys %static ), - - ( map { my $value = $schema{$_}; - my @arg = (); - push @arg, $self->option('crypt') - if $value eq 'crypt_password' && $self->option('crypt'); - $_ => $svc_acct->$value(@arg); - } keys %schema - ), - - ); - - my $err_or_queue = - $self->acct_sql_queue( - $svc_acct->svcnum, - 'insert', - $self->option('table'), - %record - ); - return $err_or_queue unless ref($err_or_queue); - - ''; - -} - -sub _export_replace { - my($self, $new, $old) = (shift, shift, shift); - - my %schema = $self->_schema_map; - my %static = $self->_static_map; - - my @primary_key = (); - if ( $self->option('primary_key') =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) { - my $keymap = $schema{$key}; - push @primary_key, $old->$keymap(); - } - } else { - my $keymap = $schema{$self->option('primary_key')}; - push @primary_key, $old->$keymap(); - } - - my %record = ( - - ( map { $_ => $static{$_} } keys %static ), - - ( map { my $value = $schema{$_}; - my @arg = (); - push @arg, $self->option('crypt') - if $value eq 'crypt_password' && $self->option('crypt'); - $_ => $new->$value(@arg); - } keys %schema - ), - - ); - - my $err_or_queue = $self->acct_sql_queue( - $new->svcnum, - 'replace', - $self->option('table'), - $self->option('primary_key'), @primary_key, - %record, - ); - return $err_or_queue unless ref($err_or_queue); - ''; -} - -sub _export_delete { - my ( $self, $svc_acct ) = (shift, shift); - - my %schema = $self->_schema_map; - - my %primary_key = (); - if ( $self->option('primary_key') =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) { - my $keymap = $schema{$key}; - $primary_key{ $key } = $svc_acct->$keymap(); - } - } else { - my $keymap = $schema{$self->option('primary_key')}; - $primary_key{ $self->option('primary_key') } = $svc_acct->$keymap(), - } - - my $err_or_queue = $self->acct_sql_queue( - $svc_acct->svcnum, - 'delete', - $self->option('table'), - %primary_key, - #$self->option('primary_key') => $svc_acct->$keymap(), - ); - return $err_or_queue unless ref($err_or_queue); - ''; -} - -sub acct_sql_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::acct_sql::acct_sql_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ) or $queue; -} - -sub acct_sql_insert { #subroutine, not method - my $dbh = acct_sql_connect(shift, shift, shift); - my( $table, %record ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO $table ( ". join(", ", keys %record). - " ) VALUES ( ". join(", ", map '?', keys %record ). " )" - ) or die $dbh->errstr; - - $sth->execute( values(%record) ) - or die "can't insert into $table table: ". $sth->errstr; - - $dbh->disconnect; -} - -sub acct_sql_delete { #subroutine, not method - my $dbh = acct_sql_connect(shift, shift, shift); - my( $table, %record ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM $table WHERE ". join(' AND ', map "$_ = ? ", keys %record ) - ) or die $dbh->errstr; - - $sth->execute( map $record{$_}, keys %record ) - or die "can't delete from $table table: ". $sth->errstr; - - $dbh->disconnect; -} - -sub acct_sql_replace { #subroutine, not method - my $dbh = acct_sql_connect(shift, shift, shift); - - my( $table, $pkey ) = ( shift, shift ); - - my %primary_key = (); - if ( $pkey =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $pkey ) ) { - $primary_key{$key} = shift; - } - } else { - $primary_key{$pkey} = shift; - } - - my %record = @_; - - my $sth = $dbh->prepare( - "UPDATE $table". - ' SET '. join(', ', map "$_ = ?", keys %record ). - ' WHERE '. join(' AND ', map "$_ = ?", keys %primary_key ) - ) or die $dbh->errstr; - - $sth->execute( values(%record), values(%primary_key) ); - - $dbh->disconnect; -} - -sub acct_sql_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - -1; - diff --git a/FS/FS/part_export/amazon_ec2.pm b/FS/FS/part_export/amazon_ec2.pm deleted file mode 100644 index 0e65ca0..0000000 --- a/FS/FS/part_export/amazon_ec2.pm +++ /dev/null @@ -1,169 +0,0 @@ -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/apache.pm b/FS/FS/part_export/apache.pm deleted file mode 100644 index 35b00cc..0000000 --- a/FS/FS/part_export/apache.pm +++ /dev/null @@ -1,47 +0,0 @@ -package FS::part_export::apache; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'httpd_conf' => { label=>'httpd.conf snippet location', - default=>'/etc/apache/httpd-freeside.conf', }, - 'restart' => { label=>'Apache restart command', - default=>'apachectl graceful', - }, - 'template' => { - label => 'Template', - type => 'textarea', - default => <<'END', -<VirtualHost $domain> #generic -#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html -DocumentRoot /var/www/$zone -ServerName $zone -ServerAlias *.$zone -#BandWidthModule On -#LargeFileLimit 4096 12288 -#FrontpageEnable on -</VirtualHost> - -END - }, -; - -%info = ( - 'svc' => 'svc_www', - 'desc' => 'Export an Apache httpd.conf file snippet.', - 'options' => \%options, - 'notes' => <<'END' -Batch export of an httpd.conf snippet from a template. Typically used with -something like <code>Include /etc/apache/httpd-freeside.conf</code> in -httpd.conf. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed. Run bin/apache.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/artera_turbo.pm b/FS/FS/part_export/artera_turbo.pm deleted file mode 100644 index c006db9..0000000 --- a/FS/FS/part_export/artera_turbo.pm +++ /dev/null @@ -1,181 +0,0 @@ -package FS::part_export::artera_turbo; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::Record qw(qsearch); -use FS::part_export; -use FS::cust_svc; -use FS::svc_external; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'rid' => { 'label' => 'Reseller ID (RID)' }, - 'username' => { 'label' => 'Reseller username', }, - 'password' => { 'label' => 'Reseller password', }, - 'pid' => { 'label' => 'Artera Product ID', }, - 'priceid' => { 'label' => 'Artera Price ID', }, - 'agent_aid' => { 'label' => 'Export agentnum values to Artera AID', - 'type' => 'checkbox', - }, - 'aid' => { 'label' => 'Artera Agent ID to use if not using agentnum values', }, - 'production' => { 'label' => 'Production mode (leave unchecked for staging)', - 'type' => 'checkbox', - }, - 'debug' => { 'label' => 'Enable debug logging', - 'type' => 'checkbox', - }, - 'enable_edit' => { 'label' => 'Enable local editing of Artera serial numbers and key codes (note that the changes will NOT be exported to Artera)', - 'type' => 'checkbox', - }, -; - -%info = ( - 'svc' => 'svc_external', - #'svc' => [qw( svc_acct svc_forward )], - 'desc' => - 'Real-time export to Artera Turbo Reseller API', - 'options' => \%options, - #'nodomain' => 'Y', - 'notes' => <<'END' -Real-time export to <a href="http://www.arteraturbo.com/">Artera Turbo</a> -Reseller API. Requires installation of -<a href="http://search.cpan.org/dist/Net-Artera">Net::Artera</a> -from CPAN. You probably also want to: -<UL> - <LI>In the configuration UI section: set the <B>svc_external-skip_manual</B> and <B>svc_external-display_type</B> configuration values. - <LI>In the message catalog: set <B>svc_external-id</B> to <I>Artera Serial Number</I> and set <B>svc_external-title</B> to <I>Artera Key Code</I>. -</UL> -END -); - -sub rebless { shift; } - -sub _new_Artera { - my $self = shift; - - my $artera = new Net::Artera ( - map { $_ => $self->option($_) } - qw( rid username password production ) - ); -} - - -sub _export_insert { - my($self, $svc_external) = (shift, shift); - - # want the ASN (serial) and AKC (key code) right away - - eval "use Net::Artera;"; - return $@ if $@; - $Net::Artera::DEBUG = 1 if $self->option('debug'); - my $artera = $self->_new_Artera; - - my $cust_pkg = $svc_external->cust_svc->cust_pkg; - my $part_pkg = $cust_pkg->part_pkg; - my @svc_acct = grep { $_->table eq 'svc_acct' } - map { $_->svc_x } - sort { my $svcpart = $part_pkg->svcpart('svc_acct'); - ($b->svcpart==$svcpart) cmp ($a->svcpart==$svcpart); } - qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); - my $email = scalar(@svc_acct) ? $svc_acct[0]->email : ''; - - my $cust_main = $cust_pkg->cust_main; - - my $result = $artera->newOrder( - 'pid' => $self->option('pid'), - 'priceid' => $self->option('priceid'), - 'email' => $email, - 'cname' => $cust_main->name, - 'ref' => $svc_external->svcnum, - 'aid' => ( $self->option('agent_aid') - ? $cust_main->agentnum - : $self->option('aid') ), - 'add1' => $cust_main->address1, - 'add2' => $cust_main->address2, - 'add3' => $cust_main->city, - 'add4' => $cust_main->state, - 'zip' => $cust_main->zip, - 'cid' => $cust_main->country, - 'phone' => $cust_main->daytime || $cust_main->night, - 'fax' => $cust_main->fax, - ); - - if ( $result->{'id'} == 1 ) { - my $new = new FS::svc_external { $svc_external->hash }; - $new->id(sprintf('%010d', $result->{'ASN'})); - $new->title( substr('0000000000'.uc($result->{'AKC'}), -10) ); - $new->replace($svc_external); - } else { - $result->{'message'} || 'No response from Artera'; - } -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return '' if $self->option('enable_edit'); - return "can't change serial number with Artera" - if $old->id != $new->id && $old->id; - return "can't change key code with Artera" - if $old->title ne $new->title && $old->title; - ''; -} - -sub _export_delete { - my( $self, $svc_external ) = (shift, shift); - $self->queue_statusChange(17, $svc_external); -} - -sub _export_suspend { - my( $self, $svc_external ) = (shift, shift); - $self->queue_statusChange(16, $svc_external); -} - -sub _export_unsuspend { - my( $self, $svc_external ) = (shift, shift); - $self->queue_statusChange(15, $svc_external); -} - -sub queue_statusChange { - my( $self, $status, $svc_external ) = @_; - - my $queue = new FS::queue { - 'svcnum' => $svc_external->svcnum, - 'job' => 'FS::part_export::artera_turbo::statusChange', - }; - $queue->insert( - ( map { $self->option($_) } - qw( rid username password production ) ), - $status, - $svc_external->id, - $svc_external->title, - $self->option('debug'), - ); -} - -sub statusChange { - my( $rid, $username, $password, $prod, $status, $id, $title, $debug ) = @_; - - eval "use Net::Artera;"; - return $@ if $@; - $Net::Artera::DEBUG = 1 if $debug; - - my $artera = new Net::Artera ( - 'rid' => $rid, - 'username' => $username, - 'password' => $password, - 'production' => $prod, - ); - - my $result = $artera->statusChange( - 'asn' => sprintf('%010d', $id), - 'akc' => substr("0000000000$title", -10), - 'statusid' => $status, - ); - - die $result->{'message'} unless $result->{'id'} == 1; - -} - -1; - diff --git a/FS/FS/part_export/bind.pm b/FS/FS/part_export/bind.pm deleted file mode 100644 index 1ef7b65..0000000 --- a/FS/FS/part_export/bind.pm +++ /dev/null @@ -1,35 +0,0 @@ -package FS::part_export::bind; - -use vars qw(@ISA %info %options); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie %options, 'Tie::IxHash', - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, - 'bind_release' => { label => 'ISC BIND Release', - type => 'select', - options => [qw(BIND8 BIND9)], - default => 'BIND8' }, - 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', - default => '1D' }, - 'reload' => { label => 'Optional reload command. If not specified, defaults to "ndc" under BIND8 and "rndc" under BIND9.', }, -; - -%info = ( - 'svc' => 'svc_domain', - 'desc' => 'Batch export to BIND named', - 'options' => \%options, - 'notes' => <<'END' -Batch export of BIND zone and configuration files to a primary nameserver. -<a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> -must be installed. Run bin/bind.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/bind_slave.pm b/FS/FS/part_export/bind_slave.pm deleted file mode 100644 index c89325f..0000000 --- a/FS/FS/part_export/bind_slave.pm +++ /dev/null @@ -1,28 +0,0 @@ -package FS::part_export::bind_slave; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie my %options, 'Tie::IxHash', - 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, - %FS::part_export::bind::options, -; -delete $options{'zonepath'}; - -%info = ( - 'svc' => 'svc_domain', - 'desc' =>'Batch export to slave BIND named', - 'options' => \%options, - 'notes' => <<'END' -Batch export of BIND configuration file to a secondary nameserver. Zones are -slaved from the listed masters. -<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed. Run bin/bind.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm deleted file mode 100644 index 7b5feb2..0000000 --- a/FS/FS/part_export/bsdshell.pm +++ /dev/null @@ -1,25 +0,0 @@ -package FS::part_export::bsdshell; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::passwdfile; - -@ISA = qw(FS::part_export::passwdfile); - -tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -MD5 crypt requires installation of -<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a> -from CPAN. Run bin/bsdshell.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/cardfortress.pm b/FS/FS/part_export/cardfortress.pm deleted file mode 100644 index 4916a6e..0000000 --- a/FS/FS/part_export/cardfortress.pm +++ /dev/null @@ -1,64 +0,0 @@ -package FS::part_export::cardfortress; - -use strict; -use base 'FS::part_export'; -use vars qw( %info ); -use String::ShellQuote; - -#tie my %options, 'Tie::IxHash'; -#; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'CardFortress', - 'options' => {}, #\%options, - 'nodomain' => 'Y', - 'notes' => '', -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - eval "use Net::OpenSSH;"; - return $@ if $@; - - open my $def_in, '<', '/dev/null' or die "unable to open /dev/null"; - my $ssh = Net::OpenSSH->new( $self->machine, - default_stdin_fh => $def_in ); - - my $private_key = $ssh->capture( - { 'stdin_data' => $svc_acct->_password. "\n" }, - '/usr/local/bin/merchant_create', map $svc_acct->$_, qw( username finger ) - ); - return $ssh->error if $ssh->error; - - $svc_acct->cf_privatekey($private_key); - - $svc_acct->replace; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - return 'username changes not yet supported' - if $old->username ne $new->username; - - return 'password changes not yet supported' - if $old->_password ne $new->_password; - - return 'Real name changes not yet supported' - if $old->finger ne $new->finger; - - ''; -} - -sub _export_delete { - #my( $self, $svc_x ) = (shift, shift); - - return 'deletion not yet supproted'; -} - -1; diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm deleted file mode 100644 index a3ec5e0..0000000 --- a/FS/FS/part_export/communigate_pro.pm +++ /dev/null @@ -1,1070 +0,0 @@ -package FS::part_export::communigate_pro; - -use strict; -use vars qw(@ISA %info %options %quotas $DEBUG); -use Data::Dumper; -use Tie::IxHash; -use FS::part_export; -use FS::queue; - -@ISA = qw(FS::part_export); - -$DEBUG = 1; - -tie %options, 'Tie::IxHash', - 'port' => { label =>'Port number', default=>'106', }, - 'login' => { label =>'The administrator account name. The name can contain a domain part.', }, - 'password' => { label =>'The administrator account password.', }, - 'accountType' => { label => 'Type for newly-created accounts (default when not specified in service)', - type => 'select', - options => [qw(MultiMailbox TextMailbox MailDirMailbox AGrade BGrade CGrade)], - default => 'MultiMailbox', - }, - 'externalFlag' => { label => 'Create accounts with an external (visible for legacy mailers) INBOX.', - type => 'checkbox', - }, - 'AccessModes' => { label => 'Access modes (default when not specified in service)', - default => 'Mail POP IMAP PWD WebMail WebSite', - }, - 'create_domain' => { label => 'Domain creation API call', - type => 'select', - options => [qw( CreateDomain CreateSharedDomain )], - } -; - -%info = ( - 'svc' => [qw( svc_acct svc_domain svc_forward svc_mailinglist )], - 'desc' => 'Real-time export of accounts, domains, mail forwards and mailing lists to a CommuniGate Pro mail server', - 'options' => \%options, - 'notes' => <<'END' -Real time export of accounts, domains, mail forwards and mailing lists to a -<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> -mail server. The -<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> -must be installed as CGP::CLI. -END -); - -%quotas = ( - 'quota' => 'MaxAccountSize', - 'file_quota' => 'MaxWebSize', - 'file_maxnum' => 'MaxWebFiles', - 'file_maxsize' => 'MaxFileSize', -); - -sub rebless { shift; } - -sub export_username { - my($self, $svc_acct) = (shift, shift); - $svc_acct->email; -} - -sub _export_insert { - my( $self, $svc_x ) = (shift, shift); - - my $table = $svc_x->table; - my $method = "_export_insert_$table"; - $self->$method($svc_x, @_); -} - -sub _export_insert_svc_acct { - my( $self, $svc_acct ) = (shift, shift); - - my %settings = ( - 'AccessModes' => [ split(' ', ( $svc_acct->cgp_accessmodes - || $self->option('AccessModes') ) - ) - ], - 'RealName' => $svc_acct->finger, - 'Password' => $svc_acct->_password, - - 'PasswordRecovery' => ($svc_acct->password_recover ? 'YES':'NO'), - - 'RulesAllowed' => $svc_acct->cgp_rulesallowed, - 'RPOPAllowed' =>($svc_acct->cgp_rpopallowed ?'YES':'NO'), - 'MailToAll' =>($svc_acct->cgp_mailtoall ?'YES':'NO'), - 'AddMailTrailer' =>($svc_acct->cgp_addmailtrailer ?'YES':'NO'), - - 'ArchiveMessagesAfter' => $svc_acct->cgp_archiveafter, - - map { $quotas{$_} => $svc_acct->$_() } - grep $svc_acct->$_(), keys %quotas - ); - #XXX phase 3: mailing lists - - my @options = ( 'CreateAccount', - 'accountName' => $self->export_username($svc_acct), - 'accountType' => ( $svc_acct->cgp_type - || $self->option('accountType') ), - 'settings' => \%settings - ); - - push @options, 'externalFlag' => $self->option('externalFlag') - if $self->option('externalFlag'); - - #let's do the create realtime too, for much the same reasons, and to avoid - #pain of trying to queue w/dep the prefs & aliases - eval { $self->communigate_pro_runcommand( @options ) }; - return $@ if $@; - - #preferences - my %prefs = (); - $prefs{'DeleteMode'} = $svc_acct->cgp_deletemode if $svc_acct->cgp_deletemode; - $prefs{'EmptyTrash'} = $svc_acct->cgp_emptytrash if $svc_acct->cgp_emptytrash; - $prefs{'Language'} = $svc_acct->cgp_language if $svc_acct->cgp_language; - $prefs{'TimeZone'} = $svc_acct->cgp_timezone if $svc_acct->cgp_timezone; - $prefs{'SkinName'} = $svc_acct->cgp_skinname if $svc_acct->cgp_skinname; - $prefs{'ProntoSkinName'} = $svc_acct->cgp_prontoskinname if $svc_acct->cgp_prontoskinname; - $prefs{'SendMDNMode'} = $svc_acct->cgp_sendmdnmode if $svc_acct->cgp_sendmdnmode; - if ( keys %prefs ) { - my $pref_err = $self->communigate_pro_queue( $svc_acct->svcnum, - 'UpdateAccountPrefs', - $self->export_username($svc_acct), - %prefs, - ); - warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err" - if $pref_err; - } - - #aliases - if ( $svc_acct->cgp_aliases ) { - my $alias_err = $self->communigate_pro_queue( $svc_acct->svcnum, - 'SetAccountAliases', - $self->export_username($svc_acct), - [ split(/\s*[,\s]\s*/, $svc_acct->cgp_aliases) ], - ); - warn "WARNING: error queueing SetAccountAliases job: $alias_err" - if $alias_err; - } - - my $rule_error = $self->communigate_pro_queue( - $svc_acct->svcnum, - 'SetAccountMailRules', - $self->export_username($svc_acct), - $svc_acct->cgp_rule_arrayref, - ); - warn "WARNING: error queueing SetAccountMailRules job: $rule_error" - if $rule_error; - - my $rpop_error = $self->communigate_pro_queue( - $svc_acct->svcnum, - 'SetAccountRPOPs', - $self->export_username($svc_acct), - $svc_acct->cgp_rpop_hashref, - ); - warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error" - if $rpop_error; - - ''; - -} - -sub _export_insert_svc_domain { - my( $self, $svc_domain ) = (shift, shift); - - my $create = $self->option('create_domain') || 'CreateDomain'; - - my %settings = ( - 'DomainAccessModes' => [ split(' ', $svc_domain->cgp_accessmodes ) ], - ); - $settings{'AccountsLimit'} = $svc_domain->max_accounts - if $svc_domain->max_accounts; - $settings{'AdminDomainName'} = $svc_domain->parent_svc_x->domain - if $svc_domain->parent_svcnum; - $settings{'TrailerText'} = $svc_domain->trailer - if $svc_domain->trailer; - $settings{'CertificateType'} = $svc_domain->cgp_certificatetype - if $svc_domain->cgp_certificatetype; - - my @options = ( $create, $svc_domain->domain, \%settings ); - - eval { $self->communigate_pro_runcommand( @options ) }; - return $@ if $@; - - #aliases - if ( $svc_domain->cgp_aliases ) { - my $alias_err = $self->communigate_pro_queue( $svc_domain->svcnum, - 'SetDomainAliases', - $svc_domain->domain, - split(/\s*[,\s]\s*/, $svc_domain->cgp_aliases), - ); - warn "WARNING: error queueing SetDomainAliases job: $alias_err" - if $alias_err; - } - - #account defaults - my $def_err = $self->communigate_pro_queue( $svc_domain->svcnum, - 'SetAccountDefaults', - $svc_domain->domain, - 'PWDAllowed' =>($svc_domain->acct_def_password_selfchange ? 'YES':'NO'), - 'PasswordRecovery' => ($svc_domain->acct_def_password_recover ? 'YES':'NO'), - 'AccessModes' => $svc_domain->acct_def_cgp_accessmodes, - 'MaxAccountSize' => $svc_domain->acct_def_quota, - 'MaxWebSize' => $svc_domain->acct_def_file_quota, - 'MaxWebFile' => $svc_domain->acct_def_file_maxnum, - 'MaxFileSize' => $svc_domain->acct_def_file_maxsize, - 'RulesAllowed' => $svc_domain->acct_def_cgp_rulesallowed, - 'RPOPAllowed' =>($svc_domain->acct_def_cgp_rpopallowed ?'YES':'NO'), - 'MailToAll' =>($svc_domain->acct_def_cgp_mailtoall ?'YES':'NO'), - 'AddMailTrailer' =>($svc_domain->acct_def_cgp_addmailtrailer ?'YES':'NO'), - 'ArchiveMessagesAfter' => $svc_domain->acct_def_cgp_archiveafter, - ); - warn "WARNING: error queueing SetAccountDefaults job: $def_err" - if $def_err; - - #account defaults prefs - my $pref_err = $self->communigate_pro_queue( $svc_domain->svcnum, - 'SetAccountDefaultPrefs', - $svc_domain->domain, - 'DeleteMode' => $svc_domain->acct_def_cgp_deletemode, - 'EmptyTrash' => $svc_domain->acct_def_cgp_emptytrash, - 'Language' => $svc_domain->acct_def_cgp_language, - 'TimeZone' => $svc_domain->acct_def_cgp_timezone, - 'SkinName' => $svc_domain->acct_def_cgp_skinname, - 'ProntoSkinName' => $svc_domain->acct_def_cgp_prontoskinname, - 'SendMDNMode' => $svc_domain->acct_def_cgp_sendmdnmode, - ); - warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err" - if $pref_err; - - my $rule_error = $self->communigate_pro_queue( - $svc_domain->svcnum, - 'SetDomainMailRules', - $svc_domain->domain, - $svc_domain->cgp_rule_arrayref, - ); - warn "WARNING: error queueing SetDomainMailRules job: $rule_error" - if $rule_error; - - ''; - -} - -sub _export_insert_svc_forward { - my( $self, $svc_forward ) = (shift, shift); - - my $src = $svc_forward->src || $svc_forward->srcsvc_acct->email; - my $dst = $svc_forward->dst || $svc_forward->dstsvc_acct->email; - - #real-time here, presuming CGP does some dup detection? - eval { $self->communigate_pro_runcommand( 'CreateForwarder', $src, $dst); }; - return $@ if $@; - - ''; -} - -sub _export_insert_svc_mailinglist { - my( $self, $svc_mlist ) = (shift, shift); - - my @members = map $_->email_address, - $svc_mlist->mailinglist->mailinglistmember; - - #real-time here, presuming CGP does some dup detection - eval { $self->communigate_pro_runcommand( - 'CreateGroup', - $svc_mlist->username.'@'.$svc_mlist->domain, - { 'RealName' => $svc_mlist->listname, - 'SetReplyTo' => ( $svc_mlist->reply_to ? 'YES' : 'NO' ), - 'RemoveAuthor' => ( $svc_mlist->remove_from ? 'YES' : 'NO' ), - 'RejectAuto' => ( $svc_mlist->reject_auto ? 'YES' : 'NO' ), - 'RemoveToAndCc' => ( $svc_mlist->remove_to_and_cc ? 'YES' : 'NO' ), - 'Members' => \@members, - } - ); - }; - return $@ if $@; - - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - my $table = $new->table; - my $method = "_export_replace_$table"; - $self->$method($new, $old, @_); -} - -sub _export_replace_svc_acct { - my( $self, $new, $old ) = (shift, shift, shift); - - #let's just do the rename part realtime rather than trying to queue - #w/dependencies. we don't want FS winding up out-of-sync with the wrong - #username and a queued job anyway. right?? - if ( $self->export_username($old) ne $self->export_username($new) ) { - eval { $self->communigate_pro_runcommand( - 'RenameAccount', - $self->export_username($old), - $self->export_username($new), - ) }; - return $@ if $@; - } - - if ( $new->_password ne $old->_password - && '*SUSPENDED* '.$old->_password ne $new->_password - ) { - $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword', - $self->export_username($new), $new->_password - ); - } - - my %settings = (); - - $settings{'RealName'} = $new->finger - if $old->finger ne $new->finger; - $settings{$quotas{$_}} = $new->$_() - foreach grep $old->$_() ne $new->$_(), keys %quotas; - $settings{'accountType'} = $new->cgp_type - if $old->cgp_type ne $new->cgp_type; - $settings{'AccessModes'} = $new->cgp_accessmodes - if $old->cgp_accessmodes ne $new->cgp_accessmodes - || $old->cgp_type ne $new->cgp_type; - - $settings{'PasswordRecovery'} = ( $new->password_recover ? 'YES':'NO' ) - if $old->password_recover ne $new->password_recover; - - $settings{'RulesAllowed'} = $new->cgp_rulesallowed - if $old->cgp_rulesallowed ne $new->cgp_rulesallowed; - $settings{'RPOPAllowed'} = ( $new->cgp_rpopallowed ? 'YES':'NO' ) - if $old->cgp_rpopallowed ne $new->cgp_rpopallowed; - $settings{'MailToAll'} = ( $new->cgp_mailtoall ? 'YES':'NO' ) - if $old->cgp_mailtoall ne $new->cgp_mailtoall; - $settings{'AddMailTrailer'} = ( $new->cgp_addmailtrailer ? 'YES':'NO' ) - if $old->cgp_addmailtrailer ne $new->cgp_addmailtrailer; - $settings{'ArchiveMessagesAfter'} = $new->cgp_archiveafter - if $old->cgp_archiveafter ne $new->cgp_archiveafter; - - #XXX phase 3: mailing lists - - if ( keys %settings ) { - my $error = $self->communigate_pro_queue( - $new->svcnum, - 'UpdateAccountSettings', - $self->export_username($new), - %settings, - ); - return $error if $error; - } - - #preferences - my %prefs = (); - $prefs{'DeleteMode'} = $new->cgp_deletemode - if $old->cgp_deletemode ne $new->cgp_deletemode; - $prefs{'EmptyTrash'} = $new->cgp_emptytrash - if $old->cgp_emptytrash ne $new->cgp_emptytrash; - $prefs{'Language'} = $new->cgp_language - if $old->cgp_language ne $new->cgp_language; - $prefs{'TimeZone'} = $new->cgp_timezone - if $old->cgp_timezone ne $new->cgp_timezone; - $prefs{'SkinName'} = $new->cgp_skinname - if $old->cgp_skinname ne $new->cgp_skinname; - $prefs{'ProntoSkinName'} = $new->cgp_prontoskinname - if $old->cgp_prontoskinname ne $new->cgp_prontoskinname; - $prefs{'SendMDNMode'} = $new->cgp_sendmdnmode - if $old->cgp_sendmdnmode ne $new->cgp_sendmdnmode; - if ( keys %prefs ) { - my $pref_err = $self->communigate_pro_queue( $new->svcnum, - 'UpdateAccountPrefs', - $self->export_username($new), - %prefs, - ); - warn "WARNING: error queueing UpdateAccountPrefs job: $pref_err" - if $pref_err; - } - - if ( $old->cgp_aliases ne $new->cgp_aliases ) { - my $error = $self->communigate_pro_queue( - $new->svcnum, - 'SetAccountAliases', - $self->export_username($new), - [ split(/\s*[,\s]\s*/, $new->cgp_aliases) ], - ); - return $error if $error; - } - - my $rule_error = $self->communigate_pro_queue( - $new->svcnum, - 'SetAccountMailRules', - $self->export_username($new), - $new->cgp_rule_arrayref, - ); - warn "WARNING: error queueing SetAccountMailRules job: $rule_error" - if $rule_error; - - my $rpop_error = $self->communigate_pro_queue( - $new->svcnum, - 'SetAccountRPOPs', - $self->export_username($new), - $new->cgp_rpop_hashref, - ); - warn "WARNING: error queueing SetAccountMailRPOPs job: $rpop_error" - if $rpop_error; - - ''; - -} - -sub _export_replace_svc_domain { - my( $self, $new, $old ) = (shift, shift, shift); - - #let's just do the rename part realtime rather than trying to queue - #w/dependencies. we don't want FS winding up out-of-sync with the wrong - #username and a queued job anyway. right?? - if ( $old->domain ne $new->domain ) { - eval { $self->communigate_pro_runcommand( - 'RenameDomain', $old->domain, $new->domain, - ) }; - return $@ if $@; - } - - my %settings = (); - $settings{'AccountsLimit'} = $new->max_accounts - if $old->max_accounts ne $new->max_accounts; - $settings{'TrailerText'} = $new->trailer - if $old->trailer ne $new->trailer; - $settings{'DomainAccessModes'} = $new->cgp_accessmodes - if $old->cgp_accessmodes ne $new->cgp_accessmodes; - $settings{'AdminDomainName'} = - $new->parent_svcnum ? $new->parent_svc_x->domain : '' - if $old->parent_svcnum != $new->parent_svcnum; - $settings{'CertificateType'} = $new->cgp_certificatetype - if $old->cgp_certificatetype ne $new->cgp_certificatetype; - - if ( keys %settings ) { - my $error = $self->communigate_pro_queue( $new->svcnum, - 'UpdateDomainSettings', - $new->domain, - %settings, - ); - return $error if $error; - } - - if ( $old->cgp_aliases ne $new->cgp_aliases ) { - my $error = $self->communigate_pro_queue( $new->svcnum, - 'SetDomainAliases', - $new->domain, - split(/\s*[,\s]\s*/, $new->cgp_aliases), - ); - return $error if $error; - } - - #below this identical to insert... any value to doing an Update here? - #not seeing any big one... i guess it would be nice to avoid the update - #when things haven't changed - - #account defaults - my $def_err = $self->communigate_pro_queue( $new->svcnum, - 'SetAccountDefaults', - $new->domain, - 'PWDAllowed' => ( $new->acct_def_password_selfchange ? 'YES' : 'NO' ), - 'PasswordRecovery' => ( $new->acct_def_password_recover ? 'YES' : 'NO' ), - 'AccessModes' => $new->acct_def_cgp_accessmodes, - 'MaxAccountSize' => $new->acct_def_quota, - 'MaxWebSize' => $new->acct_def_file_quota, - 'MaxWebFile' => $new->acct_def_file_maxnum, - 'MaxFileSize' => $new->acct_def_file_maxsize, - 'RulesAllowed' => $new->acct_def_cgp_rulesallowed, - 'RPOPAllowed' => ( $new->acct_def_cgp_rpopallowed ? 'YES' : 'NO' ), - 'MailToAll' => ( $new->acct_def_cgp_mailtoall ? 'YES' : 'NO' ), - 'AddMailTrailer' => ( $new->acct_def_cgp_addmailtrailer ? 'YES' : 'NO' ), - 'ArchiveMessagesAfter' => $new->acct_def_cgp_archiveafter, - ); - warn "WARNING: error queueing SetAccountDefaults job: $def_err" - if $def_err; - - #account defaults prefs - my $pref_err = $self->communigate_pro_queue( $new->svcnum, - 'SetAccountDefaultPrefs', - $new->domain, - 'DeleteMode' => $new->acct_def_cgp_deletemode, - 'EmptyTrash' => $new->acct_def_cgp_emptytrash, - 'Language' => $new->acct_def_cgp_language, - 'TimeZone' => $new->acct_def_cgp_timezone, - 'SkinName' => $new->acct_def_cgp_skinname, - 'ProntoSkinName' => $new->acct_def_cgp_prontoskinname, - 'SendMDNMode' => $new->acct_def_cgp_sendmdnmode, - ); - warn "WARNING: error queueing SetAccountDefaultPrefs job: $pref_err" - if $pref_err; - - my $rule_error = $self->communigate_pro_queue( - $new->svcnum, - 'SetDomainMailRules', - $new->domain, - $new->cgp_rule_arrayref, - ); - warn "WARNING: error queueing SetDomainMailRules job: $rule_error" - if $rule_error; - - ''; -} - -sub _export_replace_svc_forward { - my( $self, $new, $old ) = (shift, shift, shift); - - my $osrc = $old->src || $old->srcsvc_acct->email; - my $nsrc = $new->src || $new->srcsvc_acct->email; - my $odst = $old->dst || $old->dstsvc_acct->email; - my $ndst = $new->dst || $new->dstsvc_acct->email; - - if ( $odst ne $ndst ) { - - #no change command, so delete and create (real-time) - eval { $self->communigate_pro_runcommand('DeleteForwarder', $osrc) }; - return $@ if $@; - eval { $self->communigate_pro_runcommand('CreateForwarder', $nsrc, $ndst)}; - return $@ if $@; - - } elsif ( $osrc ne $nsrc ) { - - #real-time here, presuming CGP does some dup detection? - eval { $self->communigate_pro_runcommand( 'RenameForwarder', $osrc, $nsrc)}; - return $@ if $@; - - } else { - warn "communigate replace called for svc_forward with no changes\n";#confess - } - - ''; -} - -sub _export_replace_svc_mailinglist { - my( $self, $new, $old ) = (shift, shift, shift); - - my $oldGroupName = $old->username.'@'.$old->domain; - my $newGroupName = $new->username.'@'.$new->domain; - - if ( $oldGroupName ne $newGroupName ) { - eval { $self->communigate_pro_runcommand( - 'RenameGroup', $oldGroupName, $newGroupName ); }; - return $@ if $@; - } - - my @members = map $_->email_address, - $new->mailinglist->mailinglistmember; - - #real-time here, presuming CGP does some dup detection - eval { $self->communigate_pro_runcommand( - 'SetGroup', $newGroupName, - { 'RealName' => $new->listname, - 'SetReplyTo' => ( $new->reply_to ? 'YES' : 'NO' ), - 'RemoveAuthor' => ( $new->remove_from ? 'YES' : 'NO' ), - 'RejectAuto' => ( $new->reject_auto ? 'YES' : 'NO' ), - 'RemoveToAndCc' => ( $new->remove_to_and_cc ? 'YES' : 'NO' ), - 'Members' => \@members, - } - ); - }; - return $@ if $@; - - ''; - -} - -sub _export_delete { - my( $self, $svc_x ) = (shift, shift); - - my $table = $svc_x->table; - my $method = "_export_delete_$table"; - $self->$method($svc_x, @_); -} - -sub _export_delete_svc_acct { - my( $self, $svc_acct ) = (shift, shift); - - $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount', - $self->export_username($svc_acct), - ); -} - -sub _export_delete_svc_domain { - my( $self, $svc_domain ) = (shift, shift); - - $self->communigate_pro_queue( $svc_domain->svcnum, 'DeleteDomain', - $svc_domain->domain, - #XXX turn on force option for domain deletion? - ); -} - -sub _export_delete_svc_forward { - my( $self, $svc_forward ) = (shift, shift); - - $self->communigate_pro_queue( $svc_forward->svcnum, 'DeleteForwarder', - ($svc_forward->src || $svc_forward->srcsvc_acct->email), - ); -} - -sub _export_delete_svc_mailinglist { - my( $self, $svc_mailinglist ) = (shift, shift); - - #real-time here, presuming CGP does some dup detection - eval { $self->communigate_pro_runcommand( - 'DeleteGroup', - $svc_mailinglist->username.'@'.$svc_mailinglist->domain, - ); - }; - return $@ if $@; - - ''; - -} - -sub _export_suspend { - my( $self, $svc_x ) = (shift, shift); - - my $table = $svc_x->table; - my $method = "_export_suspend_$table"; - $self->$method($svc_x, @_); - -} - -sub _export_suspend_svc_acct { - my( $self, $svc_acct ) = (shift, shift); - - #XXX is this the desired suspnsion action? - - $self->communigate_pro_queue( - $svc_acct->svcnum, - 'UpdateAccountSettings', - $self->export_username($svc_acct), - 'AccessModes' => 'Mail', - ); - -} - -sub _export_suspend_svc_domain { - my( $self, $svc_domain) = (shift, shift); - - #XXX domain operations - ''; - -} - -sub _export_unsuspend { - my( $self, $svc_x ) = (shift, shift); - - my $table = $svc_x->table; - my $method = "_export_unsuspend_$table"; - $self->$method($svc_x, @_); - -} - -sub _export_unsuspend_svc_acct { - my( $self, $svc_acct ) = (shift, shift); - - $self->communigate_pro_queue( - $svc_acct->svcnum, - 'UpdateAccountSettings', - $self->export_username($svc_acct), - 'AccessModes' => ( $svc_acct->cgp_accessmodes - || $self->option('AccessModes') ), - ); - -} - -sub _export_unsuspend_svc_domain { - my( $self, $svc_domain) = (shift, shift); - - #XXX domain operations - ''; - -} - -sub export_mailinglistmember_insert { - my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); - $svc_mailinglist->replace(); -} - -sub export_mailinglistmember_replace { - my( $self, $svc_mailinglist, $new, $old ) = (shift, shift, shift, shift); - die "no way to do this from the UI right now"; -} - -sub export_mailinglistmember_delete { - my( $self, $svc_mailinglist, $mailinglistmember ) = (shift, shift, shift); - $svc_mailinglist->replace(); -} - -sub export_getsettings { - my($self, $svc_x) = (shift, shift); - - my $table = $svc_x->table; - my $method = "export_getsettings_$table"; - - $self->can($method) ? $self->$method($svc_x, @_) : ''; - -} - -sub export_getsettings_svc_domain { - my($self, $svc_domain, $settingsref, $defaultref ) = @_; - - my $settings = eval { $self->communigate_pro_runcommand( - 'GetDomainSettings', - $svc_domain->domain - ) }; - return $@ if $@; - - my $effective_settings = eval { $self->communigate_pro_runcommand( - 'GetDomainEffectiveSettings', - $svc_domain->domain - ) }; - return $@ if $@; - - my $acct_defaults = eval { $self->communigate_pro_runcommand( - 'GetAccountDefaults', - $svc_domain->domain - ) }; - return $@ if $@; - - my $acct_defaultprefs = eval { $self->communigate_pro_runcommand( - 'GetAccountDefaultPrefs', - $svc_domain->domain - ) }; - return $@ if $@; - - my $rules = eval { $self->communigate_pro_runcommand( - 'GetDomainMailRules', - $svc_domain->domain - ) }; - return $@ if $@; - - #aliases too - my $aliases = eval { $self->communigate_pro_runcommand( - 'GetDomainAliases', - $svc_domain->domain - ) }; - return $@ if $@; - - my %more = ( - ( map { ("Acct. Default $_" => $acct_defaults->{$_}); } - keys(%$acct_defaults) - ), - ( map { ("Acct. Default $_" => $acct_defaultprefs->{$_}); } #diff label?? - keys(%$acct_defaultprefs) - ), - ( map _rule2string($_), @$rules ), - 'Aliases' => join(', ', @$aliases), - ); - - %$effective_settings = ( %$effective_settings, %more ); - %$settings = ( %$settings, %more ); - - #false laziness w/below - - my %defaults = map { $_ => 1 } - grep !exists(${$settings}{$_}), keys %$effective_settings; - - foreach my $key ( grep ref($effective_settings->{$_}), - keys %$effective_settings ) - { - $effective_settings->{$key} = _pretty( $effective_settings->{$key} ); - } - - %{$settingsref} = %$effective_settings; - %{$defaultref} = %defaults; - - ''; -} - -sub export_getsettings_svc_acct { - my($self, $svc_acct, $settingsref, $defaultref ) = @_; - - my $settings = eval { $self->communigate_pro_runcommand( - 'GetAccountSettings', - $svc_acct->email - ) }; - return $@ if $@; - - delete($settings->{'Password'}); - - my $effective_settings = eval { $self->communigate_pro_runcommand( - 'GetAccountEffectiveSettings', - $svc_acct->email - ) }; - return $@ if $@; - - delete($effective_settings->{'Password'}); - - #prefs/effectiveprefs too - - my $prefs = eval { $self->communigate_pro_runcommand( - 'GetAccountPrefs', - $svc_acct->email - ) }; - return $@ if $@; - - my $effective_prefs = eval { $self->communigate_pro_runcommand( - 'GetAccountEffectivePrefs', - $svc_acct->email - ) }; - return $@ if $@; - - %$effective_settings = ( %$effective_settings, - map { ("Pref $_" => $effective_prefs->{$_}); } - keys(%$effective_prefs) - ); - %$settings = ( %$settings, - map { ("Pref $_" => $prefs->{$_}); } - keys(%$prefs) - ); - - #mail rules - my $rules = eval { $self->communigate_pro_runcommand( - 'GetAccountMailRules', - $svc_acct->email - ) }; - return $@ if $@; - - %$effective_settings = ( %$effective_settings, - map _rule2string($_), @$rules - ); - %$settings = ( %$settings, - map _rule2string($_), @$rules - ); - -# #rpops too -# my $rpops = eval { $self->communigate_pro_runcommand( -# 'GetAccountRPOPs', -# $svc_acct->email -# ) }; -# return $@ if $@; -# -# %$effective_settings = ( %$effective_settings, -# map _rpop2string($_), %$rpops -# ); -# %$settings = ( %$settings, -# map _rpop2string($_), %rpops -# ); - - #aliases too - my $aliases = eval { $self->communigate_pro_runcommand( - 'GetAccountAliases', - $svc_acct->email - ) }; - return $@ if $@; - - $effective_settings->{'Aliases'} = join(', ', @$aliases); - $settings->{'Aliases'} = join(', ', @$aliases); - - #false laziness w/above - - my %defaults = map { $_ => 1 } - grep !exists(${$settings}{$_}), keys %$effective_settings; - - foreach my $key ( grep ref($effective_settings->{$_}), - keys %$effective_settings ) - { - $effective_settings->{$key} = _pretty( $effective_settings->{$key} ); - } - - %{$settingsref} = %$effective_settings; - %{$defaultref} = %defaults; - - ''; - -} - -sub _pretty { - my $value = shift; - if ( ref($value) eq 'ARRAY' ) { - '['. join(' ', map { ref($_) ? _pretty($_) : $_ } @$value ). ']'; - } elsif ( ref($value) eq 'HASH' ) { - '{'. join(', ', - map { my $v = $value->{$_}; - "$_:". ( ref($v) ? _pretty($v) : $v ); - } - keys %$value - ). '}'; - } else { - warn "serializing ". ref($value). " for table display not yet handled"; - } -} - -sub export_getsettings_svc_forward { - my($self, $svc_forward, $settingsref, $defaultref ) = @_; - - my $dest = eval { $self->communigate_pro_runcommand( - 'GetForwarder', - ($svc_forward->src || $svc_forward->srcsvc_acct->email), - ) }; - return $@ if $@; - - my $settings = { 'Destination' => $dest }; - - %{$settingsref} = %$settings; - %{$defaultref} = (); - - ''; -} - -sub _rule2string { - my $rule = shift; - my($priority, $name, $conditions, $actions, $comment) = @$rule; - $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions); - $actions = join(', ', map { my $a = $_; join(' ', @$a); } @$actions); - ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)"); -} - -#sub _rpop2string { -# my $rpop = shift; -# my($priority, $name, $conditions, $actions, $comment) = @$rule; -# $conditions = join(', ', map { my $a = $_; join(' ', @$a); } @$conditions); -# $actions = join(', ', map { my $a = $_; join(' ', @$a); } @$actions); -# ("Mail rule $name" => "$priority IF $conditions THEN $actions ($comment)"); -#} - -sub export_getsettings_svc_mailinglist { - my($self, $svc_mailinglist, $settingsref, $defaultref ) = @_; - - my $settings = eval { $self->communigate_pro_runcommand( - 'GetGroup', - $svc_mailinglist->username.'@'.$svc_mailinglist->domain, - ) }; - return $@ if $@; - - $settings->{'Members'} = join(', ', @{ $settings->{'Members'} } ); - - %{$settingsref} = %$settings; - - ''; -} - -sub communigate_pro_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $jobnum = ''; #don't actually care - $self->communigate_pro_queue_dep( \$jobnum, $svcnum, $method, @_); -} - -sub communigate_pro_queue_dep { - my( $self, $jobnumref, $svcnum, $method ) = splice(@_,0,4); - - my %kludge_methods = ( - #'CreateAccount' => 'CreateAccount', - 'UpdateAccountSettings' => 'UpdateAccountSettings', - 'UpdateAccountPrefs' => 'cp_Scalar_Hash', - #'CreateDomain' => 'cp_Scalar_Hash', - #'CreateSharedDomain' => 'cp_Scalar_Hash', - 'UpdateDomainSettings' => 'cp_Scalar_settingsHash', - 'SetDomainAliases' => 'cp_Scalar_Array', - 'SetAccountDefaults' => 'cp_Scalar_settingsHash', - 'UpdateAccountDefaults' => 'cp_Scalar_settingsHash', - 'SetAccountDefaultPrefs' => 'cp_Scalar_settingsHash', - 'UpdateAccountDefaultPrefs' => 'cp_Scalar_settingsHash', - 'SetAccountRPOPs' => 'cp_Scalar_Hash', - ); - my $sub = exists($kludge_methods{$method}) - ? $kludge_methods{$method} - : 'communigate_pro_command'; - - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::communigate_pro::$sub", - }; - my $error = $queue->insert( - $self->machine, - $self->option('port'), - $self->option('login'), - $self->option('password'), - $method, - @_, - ); - $$jobnumref = $queue->jobnum unless $error; - - return $error; -} - -sub communigate_pro_runcommand { - my( $self, $method ) = (shift, shift); - - communigate_pro_command( - $self->machine, - $self->option('port'), - $self->option('login'), - $self->option('password'), - $method, - @_, - ); - -} - -#XXX one sub per arg prototype is lame. more magic? i suppose queue needs -# to store data strctures properly instead of just an arg list. right. - -sub cp_Scalar_Hash { - my( $machine, $port, $login, $password, $method, $scalar, %hash ) = @_; - my @args = ( $scalar, \%hash ); - communigate_pro_command( $machine, $port, $login, $password, $method, @args ); -} - -sub cp_Scalar_Array { - my( $machine, $port, $login, $password, $method, $scalar, @array ) = @_; - my @args = ( $scalar, \@array ); - communigate_pro_command( $machine, $port, $login, $password, $method, @args ); -} - -#sub cp_Hash { -# my( $machine, $port, $login, $password, $method, %hash ) = @_; -# my @args = ( \%hash ); -# communigate_pro_command( $machine, $port, $login, $password, $method, @args ); -#} - -sub cp_Scalar_settingsHash { - my( $machine, $port, $login, $password, $method, $domain, %settings ) = @_; - for (qw( AccessModes DomainAccessModes )) { - $settings{$_} = [split(' ',$settings{$_})] if $settings{$_}; - } - my @args = ( 'domain' => $domain, 'settings' => \%settings ); - communigate_pro_command( $machine, $port, $login, $password, $method, @args ); -} - -#sub CreateAccount { -# my( $machine, $port, $login, $password, $method, %args ) = @_; -# my $accountName = delete $args{'accountName'}; -# my $accountType = delete $args{'accountType'}; -# my $externalFlag = delete $args{'externalFlag'}; -# $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; -# my @args = ( accountName => $accountName, -# accountType => $accountType, -# settings => \%args, -# ); -# #externalFlag => $externalFlag, -# push @args, externalFlag => $externalFlag if $externalFlag; -# -# communigate_pro_command( $machine, $port, $login, $password, $method, @args ); -# -#} - -sub UpdateAccountSettings { - my( $machine, $port, $login, $password, $method, $accountName, %args ) = @_; - $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; - my @args = ( $accountName, \%args ); - communigate_pro_command( $machine, $port, $login, $password, $method, @args ); -} - -sub communigate_pro_command { #subroutine, not method - my( $machine, $port, $login, $password, $method, @args ) = @_; - - eval "use CGP::CLI"; - die $@ if $@; - - my $cli = new CGP::CLI( { - 'PeerAddr' => $machine, - 'PeerPort' => $port, - 'login' => $login, - 'password' => $password, - } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n"; - - #warn "$method ". Dumper(@args) if $DEBUG; - - my $return = $cli->$method(@args) - or die "Communigate Pro error: ". $cli->getErrMessage. "\n"; - - $cli->Logout; # or die "Can't logout of CGPro: $CGP::ERR_STRING\n"; - - $return; - -} - -1; - diff --git a/FS/FS/part_export/communigate_pro_singledomain.pm b/FS/FS/part_export/communigate_pro_singledomain.pm deleted file mode 100644 index e25043f..0000000 --- a/FS/FS/part_export/communigate_pro_singledomain.pm +++ /dev/null @@ -1,37 +0,0 @@ -package FS::part_export::communigate_pro_singledomain; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::communigate_pro; - -@ISA = qw(FS::part_export::communigate_pro); - -tie my %options, 'Tie::IxHash', %FS::part_export::communigate_pro::options, - 'domain' => { label=>'Domain', }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Real-time export to a CommuniGate Pro mail server, one domain only', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -Real time export to a -<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> -mail server. This is an unusual export to CommuniGate Pro that forces all -accounts into a single domain. As CommuniGate Pro supports multiple domains, -unless you have a specific reason for using this export, you probably want to -use the communigate_pro export instead. The -<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> -must be installed as CGP::CLI. -END -); - -sub export_username { - my($self, $svc_acct) = (shift, shift); - $svc_acct->username. '@'. $self->option('domain'); -} - -1; - diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm deleted file mode 100644 index 96fa437..0000000 --- a/FS/FS/part_export/cp.pm +++ /dev/null @@ -1,161 +0,0 @@ -package FS::part_export::cp; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'port' => { label=>'Port number' }, - 'username' => { label=>'Username' }, - 'password' => { label=>'Password' }, - 'domain' => { label=>'Domain' }, - 'workgroup' => { label=>'Default Workgroup' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', - 'options'=> \%options, - 'notes' => <<'END' -Real-time export to -<a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>. -Requires installation of -<a href="http://search.cpan.org/dist/Net-APP">Net::APP</a> -from CPAN. -END -); - -sub rebless { shift; } - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'create_mailbox', - 'Mailbox' => $svc_acct->username, - 'Password' => $svc_acct->_password, - 'Workgroup' => $self->option('workgroup'), - 'Domain' => $svc_acct->domain, - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change domain with Critical Path" - if $old->domain ne $new->domain; - return "can't change username with Critical Path" #CP no longer supports this - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - $self->cp_queue( $new->svcnum, 'replace', $new->domain, - $old->username, $new->username, $old->_password, $new->_password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'delete_mailbox', - 'Mailbox' => $svc_acct->username, - 'Domain' => $svc_acct->domain, - ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', - 'Mailbox' => $svc_acct->username, - 'Domain' => $svc_acct->domain, - 'OTHER' => 'T', - 'OTHER_SUSPEND' => 'T', - ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $self->cp_queue( $svc_acct->svcnum, 'set_mailbox_status', - 'Mailbox' => $svc_acct->username, - 'Domain' => $svc_acct->domain, - 'PAYMENT' => 'F', - 'OTHER' => 'F', - 'OTHER_SUSPEND' => 'F', - 'OTHER_BOUNCE' => 'F', - ); -} - -sub cp_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::cp::cp_command', - }; - $queue->insert( - $self->machine, - $self->option('port'), - $self->option('username'), - $self->option('password'), - $self->option('domain'), - $method, - @_, - ); -} - -sub cp_command { #subroutine, not method - my($host, $port, $username, $password, $login_domain, $method, @args) = @_; - - #quelle hack - if ( $method eq 'replace' ) { - - my( $domain, $old_username, $new_username, $old_password, $new_password) - = @args; - - if ( $old_username ne $new_username ) { - cp_command($host, $port, $username, $password, 'rename_mailbox', - Domain => $domain, - Old_Mailbox => $old_username, - New_Mailbox => $new_username, - ); - } - - #my $other = 'F'; - if ( $new_password =~ /^\*SUSPENDED\* (.*)$/ ) { - $new_password = $1; - # $other = 'T'; - } - #cp_command($host, $port, $username, $password, $login_domain, - # 'set_mailbox_status', - # Domain => $domain, - # Mailbox => $new_username, - # Other => $other, - # Other_Bounce => $other, - #); - - if ( $old_password ne $new_password ) { - cp_command($host, $port, $username, $password, $login_domain, - 'change_mailbox', - Domain => $domain, - Mailbox => $new_username, - Password => $new_password, - ); - } - - return; - } - #eof quelle hack - - eval "use Net::APP;"; - - my $app = new Net::APP ( - "$host:$port", - User => $username, - Password => $password, - Domain => $login_domain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->$method( @args ); - - die $app->message."\n" unless $app->ok; - -} - -1; - diff --git a/FS/FS/part_export/cpanel.pm b/FS/FS/part_export/cpanel.pm deleted file mode 100644 index 0ad00df..0000000 --- a/FS/FS/part_export/cpanel.pm +++ /dev/null @@ -1,192 +0,0 @@ -package FS::part_export::cpanel; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote access username' }, - 'accesshash' => { label=>'Remote access key', type=>'textarea' }, - 'debug' => { label=>'Enable debugging', type=>'checkbox' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Cpanel control panel.', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => 'Real time export to a the <a href="http://www.cpanel.net/">Cpanel</a> control panel software. Service definition names are exported as Cpanel packages. Requires installation of the Cpanel::Accounting perl module distributed with Cpanel.', -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, 'insert', - $svc_acct->domain, - $svc_acct->username, - $svc_acct->_password, - $svc_acct->cust_svc->part_svc->svc, - ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username with cpanel" - if $old->username ne $new->username; - return "can't change password with cpanel" - if $old->_passsword ne $new->_password; - return "can't change domain with cpanel" - if $old->domain ne $new->domain; - - ''; - - ##return '' unless $old->_password ne $new->_password; - #$err_or_queue = $self->cpanel_queue( $new->svcnum, - # 'replace', $new->username, $new->_password ); - #ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, - 'delete', $svc_acct->username - ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, - 'suspend', $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->cpanel_queue( $svc_acct->svcnum, - 'unsuspend', $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - - -sub cpanel_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::cpanel::cpanel_$method", - }; - $queue->insert( - $self->machine, - $self->option('user'), - $self->option('accesshash'), - $self->option('debug'), - @_ - ) or $queue; -} - - -sub cpanel_insert { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - -# my $whm = cpanel_connect($machine, $user, $accesshash, $debug); -# warn " cpanel->createacct ". join(', ', @_). "\n" -# if $debug; -# my $response = $whm->createacct(@_); -# die $whm->{'error'} if $whm->{'error'}; -# warn " cpanel response: $response\n" -# if $debug; - - warn "cpanel_insert: attempting web interface to add POP" - if $debug; - - my($domain, $username, $password, $svc) = @_; - - use LWP::UserAgent; - use HTTP::Request::Common qw(POST); - - my $url = - "http://$user:$accesshash\@$domain:2082/frontend/x/mail/addpop2.html"; - - my $ua = LWP::UserAgent->new(); - - #$req->authorization_basic($user, $accesshash); - - my $res = $ua->request( - POST( $url, - [ - 'email' => $username, - 'domain' => $domain, - 'password' => $password, - 'quota' => 10, #? - ] - ) - ); - - die "Error submitting data to $url: ". $res->status_line - unless $res->is_success; - - die "Username in use" - if $res->content =~ /exists/; - - die "Account not created: ". $res->content - if $res->content =~ /failure/; - -} - -#sub cpanel_replace { #subroutine, not method -#} - -sub cpanel_delete { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - my $whm = cpanel_connect($machine, $user, $accesshash, $debug); - warn " cpanel->killacct ". join(', ', @_). "\n" - if $debug; - my $response = $whm->killacct(shift); - die $whm->{'error'} if $whm->{'error'}; - warn " cpanel response: $response\n" - if $debug; -} - -sub cpanel_suspend { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - my $whm = cpanel_connect($machine, $user, $accesshash, $debug); - warn " cpanel->suspend ". join(', ', @_). "\n" - if $debug; - my $response = $whm->suspend(shift); - die $whm->{'error'} if $whm->{'error'}; - warn " cpanel response: $response\n" - if $debug; -} - -sub cpanel_unsuspend { #subroutine, not method - my( $machine, $user, $accesshash, $debug ) = splice(@_,0,4); - my $whm = cpanel_connect($machine, $user, $accesshash, $debug); - warn " cpanel->unsuspend ". join(', ', @_). "\n" - if $debug; - my $response = $whm->unsuspend(shift); - die $whm->{'error'} if $whm->{'error'}; - warn " cpanel response: $response\n" - if $debug; -} - -sub cpanel_connect { - my( $host, $user, $accesshash, $debug ) = @_; - - eval "use Cpanel::Accounting;"; - die $@ if $@; - - warn "creating new Cpanel::Accounting connection to $user@$host\n" - if $debug; - - my $whm = new Cpanel::Accounting; - $whm->{'host'} = $host; - $whm->{'user'} = $user; - $whm->{'accesshash'} = $accesshash; - $whm->{'usessl'} = 1; - - $whm; -} diff --git a/FS/FS/part_export/cust_http.pm b/FS/FS/part_export/cust_http.pm deleted file mode 100644 index e8b677b..0000000 --- a/FS/FS/part_export/cust_http.pm +++ /dev/null @@ -1,67 +0,0 @@ -package FS::part_export::cust_http; - -use vars qw( @ISA %info ); -use FS::part_export::http; -use Tie::IxHash; - -@ISA = qw( FS::part_export::http ); - -tie %options, 'Tie::IxHash', - 'method' => { label =>'Method', - type =>'select', - #options =>[qw(POST GET)], - options =>[qw(POST)], - default =>'POST' }, - 'url' => { label => 'URL', default => 'http://', }, - 'insert_data' => { - label => 'Insert data', - type => 'textarea', - default => join("\n", - "action 'insert'", - "custnum \$cust_main->custnum", - "first \$cust_main->first", - "last \$cust_main->get('last')", - ( map "$_ \$cust_main->$_", qw( company address1 address2 city county state zip country daytime night fax last ) ), - "email \$cust_main->invoicing_list_emailonly_scalar", - ), - }, - 'delete_data' => { - label => 'Delete data', - type => 'textarea', - default => join("\n", - "action 'delete'", - "custnum \$cust_main->custnum", - ), - }, - 'replace_data' => { - label => 'Replace data', - type => 'textarea', - default => join("\n", - "action 'replace'", - "custnum \$new_cust_main->custnum", - "first \$new_cust_main->first", - "last \$new_cust_main->get('last')", - ( map "$_ \$cust_main->$_", qw( company address1 address2 city county state zip country daytime night fax last ) ), - "email \$new_cust_main->invoicing_list_emailonly_scalar", - ), - }, - 'success_regexp' => { - label => 'Success Regexp', - default => '', - }, -; - -%info = ( - 'svc' => 'cust_main', - 'desc' => 'Send an HTTP or HTTPS GET or POST request, for customers.', - 'options' => \%options, - 'notes' => <<'END' -Send an HTTP or HTTPS GET or POST to the specified URL on customer addition, -modification and deletion. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required. -END -); - -1; diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm deleted file mode 100644 index 84c9e5a..0000000 --- a/FS/FS/part_export/cyrus.pm +++ /dev/null @@ -1,120 +0,0 @@ -package FS::part_export::cyrus; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'server' => { label=>'IMAP server' }, - 'username' => { label=>'Admin username' }, - 'password' => { label=>'Admin password' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Cyrus IMAP server', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -Integration with -<a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>. -Cyrus::IMAP::Admin should be installed locally and the connection to the -server secured. <B>svc_acct.quota</B>, if available, is used to set the -Cyrus quota. -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $self->cyrus_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, $svc_acct->quota ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username using Cyrus" - if $old->username ne $new->username; - return ''; -# #return '' unless $old->_password ne $new->_password; -# $self->cyrus_queue( $new->svcnum, -# 'replace', $new->username, $new->_password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->cyrus_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); -} - -#a good idea to queue anything that could fail or take any time -sub cyrus_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::cyrus::cyrus_$method", - }; - $queue->insert( - $self->option('server'), - $self->option('username'), - $self->option('password'), - @_ - ); -} - -sub cyrus_insert { #subroutine, not method - my $client = cyrus_connect(shift, shift, shift); - my( $username, $quota ) = @_; - my $rc = $client->create("user.$username"); - my $error = $client->error; - die "creating user.$username: $error" if $error; - - $rc = $client->setacl("user.$username", $username => 'all' ); - $error = $client->error; - die "setacl user.$username: $error" if $error; - - if ( $quota ) { - $rc = $client->setquota("user.$username", 'STORAGE' => $quota ); - $error = $client->error; - die "setquota user.$username: $error" if $error; - } - -} - -sub cyrus_delete { #subroutine, not method - my ( $server, $admin_username, $password_username, $username ) = @_; - my $client = cyrus_connect($server, $admin_username, $password_username); - - my $rc = $client->setacl("user.$username", $admin_username => 'all' ); - my $error = $client->error; - die $error if $error; - - $rc = $client->delete("user.$username"); - $error = $client->error; - die $error if $error; -} - -sub cyrus_connect { - - my( $server, $admin_username, $admin_password ) = @_; - - eval "use Cyrus::IMAP::Admin;"; - - my $client = Cyrus::IMAP::Admin->new($server); - $client->authenticate( - -user => $admin_username, - -mechanism => "login", - -password => $admin_password, - ); - $client; - -} - -#sub cyrus_replace { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/dashcs_e911.pm b/FS/FS/part_export/dashcs_e911.pm deleted file mode 100644 index 320d0a6..0000000 --- a/FS/FS/part_export/dashcs_e911.pm +++ /dev/null @@ -1,153 +0,0 @@ -package FS::part_export::dashcs_e911; - -use strict; -use vars qw(@ISA %info $me $DEBUG); -use Tie::IxHash; -use FS::part_export; - -$DEBUG = 0; -$me = '['.__PACKAGE__.']'; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'username' => { label=>'Dash username', }, - '_password' => { label=>'Dash password', }, - 'staging' => { label=>'Staging (test mode)', type=>'checkbox', }, -; - -%info = ( - 'svc' => 'svc_phone', - 'desc' => 'Provision e911 services via Dash Carrier Services', - 'notes' => 'Provision e911 services via Dash Carrier Services', - 'options' => \%options, -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_phone) = (shift, shift); - return 'invalid phonenum' unless $svc_phone->phonenum; - - my $opts = { map{ $_ => $self->option($_) } keys %options }; - $opts->{wantreturn} = 1; - - my %location_hash = $svc_phone->location_hash; - my $location = { - 'address1' => $location_hash{address1}, - 'address2' => $location_hash{address2}, - 'community' => $location_hash{city}, - 'state' => $location_hash{state}, - 'postalcode' => $location_hash{zip}, - }; - - my $error_or_ref = - dash_command($opts, 'validateLocation', { 'location' => $location } ); - return $error_or_ref unless ref($error_or_ref); - - my $status = $error_or_ref->get_Location->get_status; # hate - return $status->get_description unless $status->get_code eq 'GEOCODED'; - - my $cust_pkg = $svc_phone->cust_svc->cust_pkg; - my $cust_main = $cust_pkg->cust_main if $cust_pkg; - my $caller_name = $cust_main ? $cust_main->name_short : 'unknown'; - - my $arg = { - 'uri' => { - 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum, - 'callername' => $caller_name, - }, - 'location' => $location, - }; - - $error_or_ref = dash_command($opts, 'addLocation', $arg ); - return $error_or_ref unless ref($error_or_ref); - - my $id = $error_or_ref->get_Location->get_locationid; - $self->_export_command('provisionLocation', { 'locationid' => $id }); -} - -sub _export_delete { - my($self, $svc_phone) = (shift, shift); - return '' unless $svc_phone->phonenum; - - my $arg = { 'uri' => 'tel:'. $svc_phone->countrycode. $svc_phone->phonenum }; - $self->_export_queue('removeURI', $arg); -} - -sub _export_suspend { - my($self) = shift; - ''; -} - -sub _export_unsuspend { - my($self) = shift; - ''; -} - -sub _export_command { - my $self = shift; - - my $opts = { map{ $_ => $self->option($_) } keys %options }; - - dash_command($opts, @_); - -} - -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - - # this could succeed in unprovision but fail to provision - my $arg = { 'uri' => 'tel:'. $old->countrycode. $old->phonenum }; - $self->_export_command('removeURI', $arg) || $self->_export_insert($new); -} - -#a good idea to queue anything that could fail or take any time -sub _export_queue { - my $self = shift; - - my $opts = { map{ $_ => $self->option($_) } keys %options }; - - my $queue = new FS::queue { - 'job' => "FS::part_export::dashcs_e911::dash_command", - }; - $queue->insert( $opts, @_ ); -} - -sub dash_command { - my ( $opt, $method, $arg ) = (shift, shift, shift); - - warn "$me: dash_command called with method $method\n" if $DEBUG; - - my @module = qw( - Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort - SOAP::Lite - ); - - foreach my $module ( @module ) { - eval "use $module;"; - die $@ if $@; - } - - local *SOAP::Transport::HTTP::Client::get_basic_credentials = sub { - return ($opt->{'username'}, $opt->{'_password'}); - }; - - my $service = new Net::DashCS::Interfaces::EmergencyProvisioningService::EmergencyProvisioningPort( - { deserializer_args => { strict => 0 } } - ); - - $service->set_proxy('https://staging-service.dashcs.com/dash-api/soap/emergencyprovisioning/v1') - if $opt->{'staging'}; - - my $result = $service->$method($arg); - - if (not $result) { - warn "returning fault: ". $result->get_faultstring if $DEBUG; - return ''.$result->get_faultstring; - } - - warn "returning ok: $result\n" if $DEBUG; - return $result if $opt->{wantreturn}; - ''; -} diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm deleted file mode 100644 index 582e292..0000000 --- a/FS/FS/part_export/domain_shellcommands.pm +++ /dev/null @@ -1,165 +0,0 @@ -package FS::part_export::domain_shellcommands; - -use strict; -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -%info = ( - 'svc' => 'svc_domain', - 'desc' => 'Run remote commands via SSH, for domains (qmail, ISPMan).', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH, for domains. You will need to -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="qmail catchall .qmail-domain-default maintenance" onClick=' - this.form.useradd.value = "[ \"$uid\" -a \"$gid\" -a \"$dir\" -a \"$qdomain\" ] && [ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }"; - this.form.userdel.value = ""; - this.form.usermod.value = ""; - '> - <LI> - <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.useradd.value = "/usr/local/ispman/bin/ispman.addDomain -d $domain changeme"; - this.form.userdel.value = "/usr/local/ispman/bin/ispman.deleteDomain -d $domain"; - this.form.usermod.value = ""; - '> -</UL> -The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$domain</code> - <LI><code>$qdomain</code> - domain with periods replaced by colons - <LI><code>$uid</code> - of catchall account - <LI><code>$gid</code> - of catchall account - <LI><code>$dir</code> - home directory of catchall account - <LI>All other fields in - <a href="../docs/schema.html#svc_domain">svc_domain</a> are also available. -</UL> -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_command { - my ( $self, $action, $svc_domain) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_domain->getfield($_) foreach $svc_domain->fields; - } - ( $qdomain = $domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES - - if ( $svc_domain->catchall ) { - no strict 'refs'; - my $svc_acct = $svc_domain->catchall_svc_acct; - ${$_} = $svc_acct->getfield($_) foreach qw(uid gid dir); - } else { - no strict 'refs'; - ${$_} = '' foreach qw(uid gid dir); - } - - #done setting variables for the command - - $self->shellcommands_queue( $svc_domain->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - ( $old_qdomain = $old_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES - ( $new_qdomain = $new_domain ) =~ s/\./:/g; #see dot-qmail(5): EXTENSION ADDRESSES - - { - no strict 'refs'; - - if ( $old->catchall ) { - my $svc_acct = $old->catchall_svc_acct; - ${"old_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir); - } else { - ${"old_$_"} = '' foreach qw(uid gid dir); - } - if ( $new->catchall ) { - my $svc_acct = $new->catchall_svc_acct; - ${"new_$_"} = $svc_acct->getfield($_) foreach qw(uid gid dir); - } else { - ${"new_$_"} = '' foreach qw(uid gid dir); - } - - } - - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::domain_shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/domain_sql.pm b/FS/FS/part_export/domain_sql.pm deleted file mode 100644 index 3010338..0000000 --- a/FS/FS/part_export/domain_sql.pm +++ /dev/null @@ -1,241 +0,0 @@ -package FS::part_export::domain_sql; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -#quite a bit of false laziness w/acct_sql - some stuff should be generalized -#out to a "dababase base class" - -tie my %options, 'Tie::IxHash', - 'datasrc' => { label => 'DBI data source' }, - 'username' => { label => 'Database username' }, - 'password' => { label => 'Database password' }, - 'table' => { label => 'Database table' }, - 'schema' => { label => - 'Database schema mapping to Freeside methods.', - type => 'textarea', - }, - 'static' => { label => - 'Database schema mapping to static values.', - type => 'textarea', - }, - 'primary_key' => { label => 'Database primary key' }, -; - -tie my %postfix_transport_map, 'Tie::IxHash', - 'domain' => 'domain' -; -my $postfix_transport_map = - join('\n', map "$_ $postfix_transport_map{$_}", - keys %postfix_transport_map ); -tie my %postfix_transport_static, 'Tie::IxHash', - 'transport' => 'virtual:', -; -my $postfix_transport_static = - join('\n', map "$_ $postfix_transport_static{$_}", - keys %postfix_transport_static ); - -%info = ( - 'svc' => 'svc_domain', - 'desc' => 'Real time export of domains to SQL databases '. - '(postfix, others?)', - 'options' => \%options, - 'notes' => <<END -Export domains (svc_domain records) to SQL databases. Currently this is a -simple export with a default for Postfix, but it can be extended for other -uses. - -<BR><BR>Use these buttons for useful presets: -<UL> - <LI><INPUT TYPE="button" VALUE="postfix_transport" onClick=' - this.form.table.value = "transport"; - this.form.schema.value = "$postfix_transport_map"; - this.form.static.value = "$postfix_transport_static"; - this.form.primary_key.value = "domain"; - '> -</UL> -END -); - -sub _schema_map { shift->_map('schema'); } -sub _static_map { shift->_map('static'); } - -sub _map { - my $self = shift; - map { /^\s*(\S+)\s*(\S+)\s*$/ } split("\n", $self->option(shift) ); -} - -sub _export_insert { - my($self, $svc_domain) = (shift, shift); - - my %schema = $self->_schema_map; - my %static = $self->_static_map; - - my %record = ( ( map { $_ => $static{$_} } keys %static ), - ( map { my $method = $schema{$_}; - $_ => $svc_domain->$method(); - } - keys %schema - ) - ); - - my $err_or_queue = - $self->domain_sql_queue( - $svc_domain->svcnum, - 'insert', - $self->option('table'), - %record - ); - return $err_or_queue unless ref($err_or_queue); - - ''; -} - -sub _export_replace { - my($self, $new, $old) = (shift, shift, shift); - - my %schema = $self->_schema_map; - my %static = $self->_static_map; - #my %map = (%schema, %static); - - my @primary_key = (); - if ( $self->option('primary_key') =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) { - my $keymap = $schema{$key}; - push @primary_key, $old->$keymap(); - } - } else { - my %map = (%schema, %static); - my $keymap = $map{$self->option('primary_key')}; - push @primary_key, $old->$keymap(); - } - - my %record = ( ( map { $_ => $static{$_} } keys %static ), - ( map { my $method = $schema{$_}; - $_ => $new->$method(); - } - keys %schema - ) - ); - - my $err_or_queue = $self->domain_sql_queue( - $new->svcnum, - 'replace', - $self->option('table'), - $self->option('primary_key'), @primary_key, - %record, - ); - return $err_or_queue unless ref($err_or_queue); - ''; -} - -sub _export_delete { - my ( $self, $svc_domain ) = (shift, shift); - - my %schema = $self->_schema_map; - my %static = $self->_static_map; - my %map = (%schema, %static); - - my %primary_key = (); - if ( $self->option('primary_key') =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) { - my $keymap = $map{$key}; - $primary_key{ $key } = $svc_domain->$keymap(); - } - } else { - my $keymap = $map{$self->option('primary_key')}; - $primary_key{ $self->option('primary_key') } = $svc_domain->$keymap(), - } - - my $err_or_queue = $self->domain_sql_queue( - $svc_domain->svcnum, - 'delete', - $self->option('table'), - %primary_key, - #$self->option('primary_key') => $svc_domain->$keymap(), - ); - return $err_or_queue unless ref($err_or_queue); - ''; -} - -sub domain_sql_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::domain_sql::domain_sql_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ) or $queue; -} - -sub domain_sql_insert { #subroutine, not method - my $dbh = domain_sql_connect(shift, shift, shift); - my( $table, %record ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO $table ( ". join(", ", keys %record). - " ) VALUES ( ". join(", ", map '?', keys %record ). " )" - ) or die $dbh->errstr; - - $sth->execute( values(%record) ) - or die "can't insert into $table table: ". $sth->errstr; - - $dbh->disconnect; -} - -sub domain_sql_delete { #subroutine, not method - my $dbh = domain_sql_connect(shift, shift, shift); - my( $table, %record ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM $table WHERE ". join(' AND ', map "$_ = ? ", keys %record ) - ) or die $dbh->errstr; - - $sth->execute( map $record{$_}, keys %record ) - or die "can't delete from $table table: ". $sth->errstr; - - $dbh->disconnect; -} - -sub domain_sql_replace { #subroutine, not method - my $dbh = domain_sql_connect(shift, shift, shift); - - my( $table, $pkey ) = ( shift, shift ); - - my %primary_key = (); - if ( $pkey =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $pkey ) ) { - $primary_key{$key} = shift; - } - } else { - $primary_key{$pkey} = shift; - } - - my %record = @_; - - my $sth = $dbh->prepare( - "UPDATE $table". - ' SET '. join(', ', map "$_ = ?", keys %record ). - ' WHERE '. join(' AND ', map "$_ = ?", keys %primary_key ) - ) or die $dbh->errstr; - - $sth->execute( values(%record), values(%primary_key) ); - - $dbh->disconnect; -} - -sub domain_sql_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - -1; - diff --git a/FS/FS/part_export/domreg_net_dri.pm b/FS/FS/part_export/domreg_net_dri.pm deleted file mode 100644 index bf01602..0000000 --- a/FS/FS/part_export/domreg_net_dri.pm +++ /dev/null @@ -1,614 +0,0 @@ -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 deleted file mode 100644 index 76f0059..0000000 --- a/FS/FS/part_export/domreg_opensrs.pm +++ /dev/null @@ -1,616 +0,0 @@ -package FS::part_export::domreg_opensrs; - -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; -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); -$me = '[' . __PACKAGE__ . ']'; -$DEBUG = 0; - -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', - }, - '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 ], - 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; -} - -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? -} - -## 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 ) = @_; - - $years = 1 unless $years; #default to 1 year since we don't seem to pass it - - 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; - -# 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 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 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 some export functions, dies on failure or returns undef on success. -It is always called from the queue. - -=cut - -sub renew_through { - my ( $self, $svc_domain, $date ) = @_; - - warn "$me: renew_through called\n" if $DEBUG; - eval "use Net::OpenSRS;"; - die $@ if $@; - - unless ( $date ) { - my $cust_pkg = $svc_domain->cust_svc->cust_pkg; - die "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 ); - die $err if $err; - - warn "$me: checking status\n" if $DEBUG; - my $rv = $self->get_status($svc_domain); - die "Domain ". $svc_domain->domain. " is not renewable" - unless $rv->{expdate}; - - die "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 ); - - die "Can't renew ". $svc_domain->domain. " for more than 10 years." - if $years > 10; #no infinite loop - } - - return '' unless $years; - - 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, - } - } - ); - die $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 -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/everyone_net.pm b/FS/FS/part_export/everyone_net.pm deleted file mode 100644 index e04318e..0000000 --- a/FS/FS/part_export/everyone_net.pm +++ /dev/null @@ -1,132 +0,0 @@ -package FS::part_export::everyone_net; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'clientID' => { label=>'clientID' }, - 'password' => { label=>'Password' }, - #'workgroup' => { label=>'Default Workgroup' }, - 'debug' => { label=>'Enable debugging', - type=>'checkbox' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to Everyone.net outsourced mail service', - 'options'=> \%options, - 'notes' => <<'END' -Real-time export to -<a href="http://www.cp.net/">Everyone.net</a> via the XRC Remote API. -Requires installation of -<a href="http://search.cpan.org/dist/Net-XRC">Net::XRC</a> -from CPAN. -END -); - -sub rebless { shift; } - -# experiement: want the status of these right away (don't want account to -# create or whatever and then get error in the queue from dup username or -# something), so no queueing - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'createUser', - $svc_acct->domain, - [], - string($svc_acct->username), - string($svc_acct->_password), - ); -} - -sub _xrc_command { - my( $self, $method, $domain, @args ) = @_; - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - local($Net::XRC::DEBUG) = 1 - if $self->option('debug'); - - my $xrc = new Net::XRC ( - 'clientID' => $self->option('clientID'), - 'password' => $self->option('password'), - ); - - my $dresponse = $xrc->lookupMXReadyClientIDByEmailDomain( string($domain) ); - return $dresponse->error unless $dresponse->is_success; - my $clientID = $dresponse->content; - return "clientID for domain $domain not found" - if $clientID == -1; - - my $response = $xrc->$method($clientID, @args); - return $response->error unless $response->is_success; - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - return "can't change domain with Everyone.net" - if $old->domain ne $new->domain; - return "can't change username with Everyone.net" - if $old->username ne $new->username; - return '' unless $old->_password ne $new->_password; - - $self->_xrc_command( 'setUserPassword', - $new->domain, - string($new->username), - string($new->_password), - ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'deleteUser', - $svc_acct->domain, - string($svc_acct->username), - ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'suspendUser', - $svc_acct->domain, - string($svc_acct->username), - ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - - eval "use Net::XRC qw(:types);"; - return $@ if $@; - - $self->_xrc_command( 'unsuspendUser', - $svc_acct->domain, - string($svc_acct->username), - ); -} - -1; - diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm deleted file mode 100644 index 0f79ede..0000000 --- a/FS/FS/part_export/forward_shellcommands.pm +++ /dev/null @@ -1,182 +0,0 @@ -package FS::part_export::forward_shellcommands; - -use strict; -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -%info = ( - 'svc' => 'svc_forward', - 'desc' => 'Run remote commands via SSH, for forwards', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH, for forwards. You will need to -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="text vpopmail maintenance" onClick=' - this.form.useradd.value = "[ -d /home/vpopmail/domains/$domain/$username ] && { echo \"$destination\" > /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; - this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; - this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }"; - '> - <LI> - <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.useradd.value = ""; - this.form.userdel.value = ""; - this.form.usermod.value = ""; - '> -</UL> -The following variables are available for interpolation (prefixed with -<code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$username</code> - username of forward source - <LI><code>$domain</code> - domain of forward source - <LI><code>$source</code> - forward source ($username@$domain) - <LI><code>$destination</code> - forward destination - <LI>All other fields in <a href="../docs/schema.html#svc_forward">svc_forward</a> are also available. -</UL> -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_command { - my ( $self, $action, $svc_forward ) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_forward->getfield($_) foreach $svc_forward->fields; - } - - if ( $svc_forward->srcsvc ) { - my $srcsvc_acct = $svc_forward->srcsvc_acct; - $username = $srcsvc_acct->username; - $domain = $srcsvc_acct->domain; - $source = $srcsvc_acct->email; - } else { - $source = $svc_forward->src; - ( $username, $domain ) = split(/\@/, $source); - } - - if ($svc_forward->dstsvc) { - $destination = $svc_forward->dstsvc_acct->email; - } else { - $destination = $svc_forward->dst; - } - - #done setting variables for the command - - $self->shellcommands_queue( $svc_forward->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - - if ( $old->srcsvc ) { - my $srcsvc_acct = $old->srcsvc_acct; - $old_username = $srcsvc_acct->username; - $old_domain = $srcsvc_acct->domain; - $old_source = $srcsvc_acct->email; - } else { - $old_source = $old->src; - ( $old_username, $old_domain ) = split(/\@/, $old_source); - } - - if ( $old->dstsvc ) { - $old_destination = $old->dstsvc_acct->email; - } else { - $old_destination = $old->dst; - } - - if ( $new->srcsvc ) { - my $srcsvc_acct = $new->srcsvc_acct; - $new_username = $srcsvc_acct->username; - $new_domain = $srcsvc_acct->domain; - $new_source = $srcsvc_acct->email; - } else { - $new_source = $new->src; - ( $new_username, $new_domain ) = split(/\@/, $new_source); - } - - if ( $new->dstsvc ) { - $new_destination = $new->dstsvc_acct->email; - } else { - $new_destination = $new->dst; - } - - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::forward_shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/globalpops_voip.pm b/FS/FS/part_export/globalpops_voip.pm deleted file mode 100644 index 67b48bb..0000000 --- a/FS/FS/part_export/globalpops_voip.pm +++ /dev/null @@ -1,370 +0,0 @@ -package FS::part_export::globalpops_voip; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::Record qw(qsearch dbh); -use FS::part_export; -use FS::phone_avail; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'login' => { label=>'GlobalPOPs Media Services API login' }, - 'password' => { label=>'GlobalPOPs Media Services API password' }, - 'endpointgroup' => { label=>'GlobalPOPs endpoint group number' }, - 'dry_run' => { label=>"Test mode - don't actually provision" }, -; - -%info = ( - 'svc' => 'svc_phone', - 'desc' => 'Provision phone numbers to GlobalPOPs VoIP', - 'options' => \%options, - 'notes' => <<'END' -Requires installation of -<a href="http://search.cpan.org/dist/Net-GlobalPOPs-MediaServicesAPI">Net::GlobalPOPs::MediaServicesAPI</a> -from CPAN. -END -); - -sub rebless { shift; } - -sub get_dids { - my $self = shift; - my %opt = ref($_[0]) ? %{$_[0]} : @_; - - my %getdids = (); - # 'orderby' => 'npa', #but it doesn't seem to work :/ - - if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers - %getdids = ( 'npa' => $opt{'areacode'}, - 'nxx' => $opt{'exchange'}, - ); - } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX) - %getdids = ( 'npa' => $opt{'areacode'} ); - } elsif ( $opt{'state'} ) { - - my @avail = qsearch({ - 'table' => 'phone_avail', - 'hashref' => { 'exportnum' => $self->exportnum, - 'countrycode' => '1', #don't hardcode me when gp goes int'l - 'state' => $opt{'state'}, - }, - 'order_by' => 'ORDER BY npa', - }); - - return [ map $_->npa, @avail ] if @avail; #return cached area codes instead - - #otherwise, search for em - %getdids = ( 'state' => $opt{'state'} ); - - } - - my $dids = $self->gp_command('getDIDs', %getdids); - - #use Data::Dumper; - #warn Dumper($dids); - - my $search = $dids->{'search'}; - - if ( $search->{'statuscode'} == 302200 ) { - return []; - } elsif ( $search->{'statuscode'} != 100 ) { - die "Error running globalpop getDIDs: ". - $search->{'statuscode'}. ': '. $search->{'status'}; #die?? - } - - my @return = (); - - #my $latas = $search->{state}{lata}; - my %latas; - if ( grep $search->{state}{lata}{$_}, qw(name rate_center) ) { - %latas = map $search->{state}{lata}{$_}, - qw(name rate_center); - } else { - %latas = %{ $search->{state}{lata} }; - } - - foreach my $lata ( keys %latas ) { - - #warn "LATA $lata"; - - #my $l = $latas{$lata}; - #$l = $l->{rate_center} if exists $l->{rate_center}; - - my $lata_dids = $self->gp_command('getDIDs', %getdids, 'lata'=>$lata); - my $lata_search = $lata_dids->{'search'}; - unless ( $lata_search->{'statuscode'} == 100 ) { - die "Error running globalpop getDIDs: ". $lata_search->{'status'}; #die?? - } - - my $l = $lata_search->{state}{lata}{'rate_center'}; - - #use Data::Dumper; - #warn Dumper($l); - - my %rate_center; - if ( grep $l->{$_}, qw(name friendlyname) ) { - %rate_center = map $l->{$_}, - qw(name friendlyname); - } else { - %rate_center = %$l; - } - - foreach my $rate_center ( keys %rate_center ) { - - #warn "rate center $rate_center"; - - my $rc = $rate_center{$rate_center}; - $rc = $rc->{friendlyname} if exists $rc->{friendlyname}; - - my @r = (); - if ( exists($rc->{npa}) ) { - @r = ($rc); - } else { - @r = map { { 'name'=>$_, %{ $rc->{$_} } }; } keys %$rc - } - - foreach my $r (@r) { - - my @npa = (); - if ( exists($r->{npa}{name}) ) { - @npa = ($r->{npa}) - } else { - @npa = map { { 'name'=>$_, %{ $r->{npa}{$_} } } } keys %{ $r->{npa} }; - } - - foreach my $npa (@npa) { - - if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers - - #warn Dumper($npa); - - my $tn = $npa->{nxx}{tn} || $npa->{nxx}{$opt{'exchange'}}{tn}; - - my @tn = ref($tn) ? @$tn : ($tn); - #push @return, @tn; - push @return, map { - if ( /^\s*(\d{3})(\d{3})(\d{4})\s*$/ ) { - "$1-$2-$3"; - } else { - $_; - } - } - @tn; - - } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX) - - if ( $npa->{nxx}{name} ) { - @nxx = ( $npa->{nxx}{name} ); - } else { - @nxx = keys %{ $npa->{nxx} }; - } - - push @return, map { $r->{name}. ' ('. $npa->{name}. "-$_-XXXX)"; } - @nxx; - - } elsif ( $opt{'state'} ) { #and not other things, then return areacode - #my $ac = $npa->{name}; - #use Data::Dumper; - #warn Dumper($r) unless length($ac) == 3; - - push @return, $npa->{name} - unless grep { $_ eq $npa->{name} } @return; - - } else { - warn "WARNING: returning nothing for get_dids without known options"; #? - } - - } #foreach my $npa - - } #foreach my $r - - } #foreach my $rate_center - - } #foreach my $lata - - if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers - @return = sort { $a cmp $b } @return; #string comparison actually dwiw - } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX) - @return = sort { lc($a) cmp lc($b) } @return; - } elsif ( $opt{'state'} ) { #and not other things, then return areacode - - #populate cache - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $errmsg = 'WARNING: error populating phone availability cache: '; - my $error = ''; - foreach my $return (@return) { - my $phone_avail = new FS::phone_avail { - 'exportnum' => $self->exportnum, - 'countrycode' => '1', #don't hardcode me when gp goes int'l - 'state' => $opt{'state'}, - 'npa' => $return, - }; - $error = $phone_avail->insert(); - if ( $error ) { - warn $errmsg.$error; - last; - } - } - - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - } else { - $dbh->commit or warn $errmsg.$dbh->errstr if $oldAutoCommit; - } - - #end populate cache - - #@return = sort { (split(' ', $a))[0] <=> (split(' ', $b))[0] } @return; - @return = sort { $a <=> $b } @return; - } else { - warn "WARNING: returning nothing for get_dids without known options"; #? - } - - \@return; - -} - -sub gp_command { - my( $self, $command, @args ) = @_; - - eval "use Net::GlobalPOPs::MediaServicesAPI;"; - die $@ if $@; - - my $gp = Net::GlobalPOPs::MediaServicesAPI->new( - 'login' => $self->option('login'), - 'password' => $self->option('password'), - #'debug' => $debug, - ); - - $gp->$command(@args); -} - - -sub _export_insert { - my( $self, $svc_phone ) = (shift, shift); - - return '' if $self->option('dry_run'); - - #we want to provision and catch errors now, not queue - - my $r = $self->gp_command('reserveDID', - 'did' => $svc_phone->phonenum, - 'minutes' => 1, - 'endpointgroup' => $self->option('endpointgroup'), - ); - - my $rdid = $r->{did}; - - if ( $rdid->{'statuscode'} != 100 ) { - return "Error running globalpop reserveDID: ". - $rdid->{'statuscode'}. ': '. $rdid->{'status'}; - } - - my $a = $self->gp_command('assignDID', - 'did' => $svc_phone->phonenum, - 'endpointgroup' => $self->option('endpointgroup'), - #'rewrite' - #'cnam' - ); - - my $adid = $a->{did}; - - if ( $adid->{'statuscode'} != 100 ) { - return "Error running globalpop assignDID: ". - $adid->{'statuscode'}. ': '. $adid->{'status'}; - } - - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - #hmm, what's to change? - ''; -} - -sub _export_delete { - my( $self, $svc_phone ) = (shift, shift); - - return '' if $self->option('dry_run'); - - #probably okay to queue the deletion...? - #but hell, let's do it inline anyway, who wants phone numbers hanging around - - my $r = $self->gp_command('releaseDID', - 'did' => $svc_phone->phonenum, - ); - - my $rdid = $r->{did}; - - if ( $rdid->{'statuscode'} != 100 ) { - return "Error running globalpop releaseDID: ". - $rdid->{'statuscode'}. ': '. $rdid->{'status'}; - } - - ''; -} - -sub _export_suspend { - my( $self, $svc_phone ) = (shift, shift); - #nop for now - ''; -} - -sub _export_unsuspend { - my( $self, $svc_phone ) = (shift, shift); - #nop for now - ''; -} - -#hmm, might forgo queueing entirely for most things, data is too much of a pita -#sub globalpops_voip_queue { -# my( $self, $svcnum, $method ) = (shift, shift, shift); -# my $queue = new FS::queue { -# 'svcnum' => $svcnum, -# 'job' => 'FS::part_export::globalpops_voip::globalpops_voip_command', -# }; -# $queue->insert( -# $self->option('login'), -# $self->option('password'), -# $method, -# @_, -# ); -#} - -sub globalpops_voip_command { - my($login, $password, $method, @args) = @_; - - eval "use Net::GlobalPOPs::MediaServicesAPI;"; - die $@ if $@; - - my $gp = new Net::GlobalPOPs - 'login' => $login, - 'password' => $password, - #'debug' => 1, - ; - - my $return = $gp->$method( @args ); - - #$return->{'status'} - #$return->{'statuscode'} - - die $return->{'status'} if $return->{'statuscode'}; - -} - -1; - diff --git a/FS/FS/part_export/grandstream.pm b/FS/FS/part_export/grandstream.pm deleted file mode 100644 index 5c6f1ed..0000000 --- a/FS/FS/part_export/grandstream.pm +++ /dev/null @@ -1,257 +0,0 @@ -package FS::part_export::grandstream; - -use base 'FS::part_export'; -use vars qw($DEBUG $me %info $GAPSLITE_HOME $JAVA_HOME); -use URI; -use MIME::Base64; -use Tie::IxHash; -use IPC::Run qw(run); -use FS::CGI qw(rooturl); - -$DEBUG = 0; - -$me = '[' . __PACKAGE__ . ']'; -$GAPSLITE_HOME = '/usr/local/src/GS_CFG_GEN/'; - -my @java = qw( /usr/lib/jvm/default-java/ /usr/java/default/ - /usr/lib/jvm/java-6-sun/ - /usr/lib/jvm/java-1.4.2-gcj-4.1-1.4.2.0/ - ); #add more common places distros and people put their JREs - -$JAVA_HOME = (grep { -e $_ } @java)[0]; - -tie my %options, 'Tie::IxHash', - 'upload' => { label=>'Enable upload to TFTP server via SSH', - type=>'checkbox', - }, - 'user' => { label=>'User name for SSH to TFTP server' }, - 'tftproot' => { label=>'Directory in which to upload configuration' }, - 'java_home' => { label=>'Path to java to be used', - default=>$JAVA_HOME, - }, - 'gapslite_home' => { label=>'Path to grandstream configuration tool', - default=>$GAPSLITE_HOME, - }, - 'template' => { label=>'Configuration template', - type=>'textarea', - notes=>'Type or paste the configuration template here', - }, -; - -%info = ( - 'svc' => [ qw( part_device ) ], # svc_phone - 'desc' => 'Provision phone numbers to Grandstream Networks phones/ATAs', - 'options' => \%options, - 'notes' => 'Provision phone numbers to Grandstream Networks phones/ATAs. Requires a Java runtime environment and the Grandstream configuration tool to be installed.', -); - -sub rebless { shift; } - -sub gs_create_config { - my($self, $mac, %opt) = (@_); - - eval "use Net::SCP;"; - die $@ if $@; - - warn "gs_create_config called with mac of $mac\n" if $DEBUG; - $mac = sprintf('%012s', lc($mac)); - my $dir = '%%%FREESIDE_CONF%%%/cache.'. $FS::UID::datasrc; - - my $fh = new File::Temp( - TEMPLATE => "grandstream.$mac.XXXXXXXX", - DIR => $dir, - UNLINK => 0, - ); - - my $filename = $fh->filename; - - #my $template = new Text::Template ( - # TYPE => 'ARRAY', - # SOURCE => $self->option('template'), - # DELIMITERS => $delimiters, - # OUTPUT => $fh, - #); - - #$template->compile or die "Can't compile template: $Text::Template::ERROR\n"; - - #my $config = $template->fill_in( HASH => { mac_addr => $mac } ); - - print $fh $self->option('template') or die "print failed: $!"; - close $fh; - - #system( "export GAPSLITE_HOME=$GAPSLITE_HOME; export JAVA_HOME=$JAVA_HOME; ". - # "cd $dir; $GAPSLITE_HOME/bin/encode.sh $mac $filename $dir/cfg$mac" - # ) == 0 - # or die "grandstream encode failed: $!"; - my $out_and_err = ''; - my @cmd = ( "$JAVA_HOME/bin/java", - '-classpath', "$GAPSLITE_HOME/lib/gapslite.jar:$GAPSLITE_HOME/lib/bcprov-jdk14-124.jar:$GAPSLITE_HOME/config", - 'com.grandstream.cmd.TextEncoder', - $mac, $filename, "$dir/cfg$mac", - ); - run \@cmd, '>&', \$out_and_err - or die "grandstream encode failed: $out_and_err"; - - unlink $filename; - - open my $encoded, "$dir/cfg$mac" or die "open cfg$mac failed: $!"; - - my $content; - - if ($opt{upload}) { - if ($self->option('upload')) { - my $scp = new Net::SCP ( { - 'host' => $self->machine, - 'user' => $self->option('user'), - 'cwd' => $self->option('tftproot'), - } ); - - $scp->put( "$dir/cfg$mac" ) or die "upload failed: ". $scp->errstr; - } - } else { - local $/; - $content = <$encoded>; - } - - close $encoded; - unlink "$dir/cfg$mac"; - - $content; -} - -sub gs_create { - my($self, $mac) = (shift, shift); - - return unless $mac; # be more alarmed? Or check upstream? - - $self->gs_create_config($mac, 'upload' => 1); - ''; -} - -sub gs_delete { - my($self, $mac) = (shift, shift); - - $mac = sprintf('%012s', lc($mac)); - - ssh_cmd( user => $self->option('user'), - host => $self->machine, - command => 'rm', - args => [ '-f', $self->option('tftproot'). "/cfg$mac" ], - ); - ''; - -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -sub _export_insert { -# my( $self, $svc_phone ) = (shift, shift); -# $self->gs_create($svc_phone->mac_addr); - ''; -} - -sub _export_replace { -# my( $self, $new_svc, $old_svc ) = (shift, shift, shift); -# $self->gs_delete($old_svc->mac_addr); -# $self->gs_create($new_svc->mac_addr); - ''; -} - -sub _export_delete { -# my( $self, $svc_phone ) = (shift, shift); -# $self->gs_delete($svc_phone->mac_addr); - ''; -} - -sub _export_suspend { - ''; -} - -sub _export_unsuspend { - ''; -} - -sub export_device_insert { - my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); - $self->gs_create($phone_device->mac_addr); - ''; -} - -sub export_device_delete { - my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); - $self->gs_delete($phone_device->mac_addr); - ''; -} - -sub export_device_config { - my( $self, $svc_phone, $phone_device ) = (shift, shift, shift); - - my $mac; -# if ($phone_device) { - $mac = $phone_device->mac_addr; -# } else { -# $mac = $svc_phone->mac_addr; -# } - - return '' unless $mac; # be more alarmed? Or check upstream? - - $self->gs_create_config($mac); -} - - -sub export_device_replace { - my( $self, $svc_phone, $new_svc_or_device, $old_svc_or_device ) = - (shift, shift, shift, shift); - - $self->gs_delete($old_svc_or_device->mac_addr); - $self->gs_create($new_svc_or_device->mac_addr); - ''; -} - -# bad overloading? -sub export_links { - my($self, $svc_phone, $arrayref) = (shift, shift, shift); - - return; # remove if we actually support being an export for svc_phone; - - my @deviceparts = map { $_->devicepart } $self->export_device; - my @devices = grep { my $part = $_->devicepart; - scalar( grep { $_ == $part } @deviceparts ); - } $svc_phone->phone_device; - - my $export = $self->exportnum; - my $fsurl = rooturl(); - if (@devices) { - foreach my $device ( @devices ) { - next unless $device->mac_addr; - my $num = $device->devicenum; - push @$arrayref, - qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;devicenum=$num">!. - qq! Phone config </A>!; - } - } elsif ($svc_phone->mac_addr) { - my $num = $svc_phone->svcnum; - push @$arrayref, - qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;svcnum=$num">!. - qq! Phone config </A>!; - } #else - ''; -} - -sub export_device_links { - my($self, $svc_phone, $device, $arrayref) = (shift, shift, shift, shift); - warn "export_device_links $self $svc_phone $device $arrayref\n" if $DEBUG; - return unless $device && $device->mac_addr; - my $export = $self->exportnum; - my $fsurl = rooturl(); - my $num = $device->devicenum; - push @$arrayref, - qq!<A HREF="$fsurl/misc/phone_device_config.html?exportnum=$export;devicenum=$num">!. - qq! Phone config </A>!; - ''; -} - -1; diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm deleted file mode 100644 index 3749224..0000000 --- a/FS/FS/part_export/http.pm +++ /dev/null @@ -1,151 +0,0 @@ -package FS::part_export::http; - -use base qw( FS::part_export ); -use vars qw( %options %info ); -use Tie::IxHash; - -tie %options, 'Tie::IxHash', - 'method' => { label =>'Method', - type =>'select', - #options =>[qw(POST GET)], - options =>[qw(POST)], - default =>'POST' }, - 'url' => { label => 'URL', default => 'http://', }, - 'insert_data' => { - label => 'Insert data', - type => 'textarea', - default => join("\n", - 'DomainName $svc_x->domain', - 'Email ( grep { $_ !~ /^(POST|FAX)$/ } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]', - 'test 1', - 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i', - ), - }, - 'delete_data' => { - label => 'Delete data', - type => 'textarea', - default => join("\n", - ), - }, - 'replace_data' => { - label => 'Replace data', - type => 'textarea', - default => join("\n", - ), - }, - 'success_regexp' => { - label => 'Success Regexp', - default => '', - }, -; - -%info = ( - 'svc' => 'svc_domain', - 'desc' => 'Send an HTTP or HTTPS GET or POST request', - 'options' => \%options, - 'notes' => <<'END' -Send an HTTP or HTTPS GET or POST to the specified URL. For HTTPS support, -<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> -or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> -is required. -END -); - -sub rebless { shift; } - -sub _export_insert { - my $self = shift; - $self->_export_command('insert', @_); -} - -sub _export_delete { - my $self = shift; - $self->_export_command('delete', @_); -} - -sub _export_command { - my( $self, $action, $svc_x ) = ( shift, shift, shift ); - - return unless $self->option("${action}_data"); - - my $cust_main = $svc_x->table eq 'cust_main' - ? $svc_x - : $svc_x->cust_svc->cust_pkg->cust_main; - - $self->http_queue( $svc_x->svcnum, - $self->option('method'), - $self->option('url'), - $self->option('success_regexp'), - map { - /^\s*(\S+)\s+(.*)$/ or /()()/; - my( $field, $value_expression ) = ( $1, $2 ); - my $value = eval $value_expression; - die $@ if $@; - ( $field, $value ); - } split(/\n/, $self->option("${action}_data") ) - ); - -} - -sub _export_replace { - my( $self, $new, $old ) = ( shift, shift, shift ); - - return unless $self->option('replace_data'); - - my $new_cust_main = $new->table eq 'cust_main' - ? $new - : $new->cust_svc->cust_pkg->cust_main; - my $cust_main = $new_cust_main; #so folks can use $new_cust_main or $cust_main - - $self->http_queue( $new->svcnum, - $self->option('method'), - $self->option('url'), - $self->option('success_regexp'), - map { - /^\s*(\S+)\s+(.*)$/ or /()()/; - my( $field, $value_expression ) = ( $1, $2 ); - my $value = eval $value_expression; - die $@ if $@; - ( $field, $value ); - } split(/\n/, $self->option('replace_data') ) - ); - -} - -sub http_queue { - my($self, $svcnum) = (shift, shift); - my $queue = new FS::queue { 'job' => "FS::part_export::http::http" }; - $queue->svcnum($svcnum) if $svcnum; - $queue->insert( @_ ); -} - -sub http { - my($method, $url, $success_regexp, @data) = @_; - - $method = lc($method); - - eval "use LWP::UserAgent;"; - die "using LWP::UserAgent: $@" if $@; - eval "use HTTP::Request::Common;"; - die "using HTTP::Request::Common: $@" if $@; - - my $ua = LWP::UserAgent->new; - - #my $response = $ua->$method( - # $url, \%data, - # 'Content-Type'=>'application/x-www-form-urlencoded' - #); - my $req = HTTP::Request::Common::POST( $url, \@data ); - my $response = $ua->request($req); - - die $response->error_as_HTML if $response->is_error; - - if(length($success_regexp) > 1) { - my $response_content = $response->content; - die $response_content unless $response_content =~ /$success_regexp/; - } - -} - -1; - diff --git a/FS/FS/part_export/ikano.pm b/FS/FS/part_export/ikano.pm deleted file mode 100644 index fe645e4..0000000 --- a/FS/FS/part_export/ikano.pm +++ /dev/null @@ -1,697 +0,0 @@ -package FS::part_export::ikano; - -use strict; -use warnings; -use vars qw(@ISA %info %loopType $me); -use Tie::IxHash; -use Date::Format qw( time2str ); -use Date::Parse qw( str2time ); -use FS::Record qw(qsearch qsearchs dbh); -use FS::part_export; -use FS::svc_dsl; -use Data::Dumper; - -@ISA = qw(FS::part_export); -$me= '[' . __PACKAGE__ . ']'; - -tie my %options, 'Tie::IxHash', - 'keyid' => { label=>'Ikano keyid' }, - 'username' => { label=>'Ikano username', - default => 'admin', - }, - 'password' => { label=>'Ikano password' }, - 'check_networks' => { label => 'Check Networks', - default => 'ATT,BELLCA', - }, - 'debug' => { label => 'Debug Mode', type => 'checkbox' }, -; - -%info = ( - 'svc' => 'svc_dsl', - 'desc' => 'Provision DSL to Ikano', - 'options' => \%options, - 'notes' => <<'END' -Requires installation of -<a href="http://search.cpan.org/dist/Net-Ikano">Net::Ikano</a> from CPAN. -END -); - -%loopType = ( '' => 'Line-share', '0' => 'Standalone' ); - -sub rebless { shift; } - -sub external_pkg_map { 1; } - -sub dsl_pull { -# we distinguish between invalid new data (return error) versus data that -# has legitimately changed (may eventually execute hooks; now just update) -# if we do add hooks later, we should work on a copy of svc_dsl and pass -# the old and new svc_dsl to the hooks so they know what changed -# -# current assumptions of what won't change (from their side): -# vendor_order_id, vendor_qual_id, vendor_order_type, pushed, monitored, -# last_pull, address (from qual), contact info, ProductCustomId - my($self, $svc_dsl, $threshold) = (shift, shift, shift); - my $result = $self->valid_order($svc_dsl,'pull'); - return $result unless $result eq ''; - - my $now = time; - if($now - $svc_dsl->last_pull < $threshold) { - warn "$me skipping pull since threshold not reached (svcnum=" - . $svc_dsl->svcnum . ",now=$now,threshold=$threshold,last_pull=" - . $svc_dsl->last_pull .")" if $self->option('debug'); - return ''; - } - - $result = $self->ikano_command('ORDERSTATUS', - { OrderId => $svc_dsl->vendor_order_id } ); - return $result unless ref($result); # scalar (string) is an error - - # now we're getting an OrderResponse which should have one Order in it - warn "$me pull OrderResponse hash:\n".Dumper($result) - if $self->option('debug'); - - return 'Invalid order response' unless defined $result->{'Order'}; - $result = $result->{'Order'}; - - return 'No order id or status returned' - unless defined $result->{'Status'} && defined $result->{'OrderId'}; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - # 1. status - my $order_status = grep($_ eq $result->{'Status'}, @Net::Ikano::orderStatus) - ? $result->{'Status'} : ''; - return 'Invalid new status' if $order_status eq ''; - $svc_dsl->vendor_order_status($order_status) - if($svc_dsl->vendor_order_status ne $order_status); - $svc_dsl->monitored('') - if ($order_status eq 'CANCELLED' || $order_status eq 'COMPLETED'); - - # 2. fields we don't care much about - my %justUpdate = ( 'first' => 'FirstName', - 'last' => 'LastName', - 'company' => 'CompanyName', - 'username' => 'Username', - 'password' => 'Password' ); - - my($fsf, $ikanof); - while (($fsf, $ikanof) = each %justUpdate) { - $svc_dsl->$fsf($result->{$ikanof}) - if $result->{$ikanof} ne $svc_dsl->$fsf; - } - - # let's look inside the <Product> response element - my @product = $result->{'Product'}; - return 'Invalid number of products on order' if scalar(@product) != 1; - my $product = $result->{'Product'}[0]; - - # 3. phonenum - if($svc_dsl->loop_type eq '') { # line-share -# TN may change only if sub changes it and New or Change order in Completed status - my $tn = $product->{'PhoneNumber'}; - if($tn ne $svc_dsl->phonenum) { - if( ($svc_dsl->vendor_order_type eq 'NEW' - || $svc_dsl->vendor_order_type eq 'CHANGE') - && $svc_dsl->vendor_order_status eq 'COMPLETED' ) { - $svc_dsl->phonenum($tn); - } - else { return 'TN has changed in an invalid state'; } - } - } - elsif($svc_dsl->loop_type eq '0') { # dry loop -# TN may change only if it's assigned while a New or Change order is in progress - return 'Invalid PhoneNumber value for a dry loop' - if $product->{'PhoneNumber'} ne 'STANDALONE'; - my $tn = $product->{'VirtualPhoneNumber'}; - if($tn ne $svc_dsl->phonenum) { - if( ($svc_dsl->vendor_order_type eq 'NEW' - || $svc_dsl->vendor_order_type eq 'CHANGE') - && $svc_dsl->vendor_order_status ne 'COMPLETED' - && $svc_dsl->vendor_order_status ne 'CANCELLED') { - $svc_dsl->phonenum($tn); - } - else { return 'TN has changed in an invalid state'; } - } - } - - # 4. desired_due_date - may change if manually changed - if($svc_dsl->vendor_order_type eq 'NEW' - || $svc_dsl->vendor_order_type eq 'CHANGE'){ - my $f = str2time($product->{'DateToOrder'}); - return 'Invalid DateToOrder' unless $f; - $svc_dsl->desired_due_date($f) if $svc_dsl->desired_due_date ne $f; - # XXX: optionally sync back to start_date or whatever... - } - elsif($svc_dsl->vendor_order_type eq 'CANCEL'){ - my $f = str2time($product->{'DateToDisconnect'}); - return 'Invalid DateToDisconnect' unless $f; - $svc_dsl->desired_due_date($f) if $svc_dsl->desired_due_date ne $f; - # XXX: optionally sync back to expire or whatever... - } - - # 5. due_date - if($svc_dsl->vendor_order_type eq 'NEW' - || $svc_dsl->vendor_order_type eq 'CHANGE') { - my $f = str2time($product->{'ActivationDate'}); - if($svc_dsl->vendor_order_status ne 'NEW' - && $svc_dsl->vendor_order_status ne 'CANCELLED') { - return 'Invalid ActivationDate' unless $f; - $svc_dsl->due_date($f) if $svc_dsl->due_date ne $f; - } - } - # Ikano API does not implement the proper disconnect date, - # so we can't do anything about it - - # 6. staticips - for now just comma-separate them - my $tstatics = $result->{'StaticIps'}; - my @istatics = defined $tstatics ? @$tstatics : (); - my $ostatics = $svc_dsl->staticips; - my @ostatics = split(',',$ostatics); - # more horrible search/sync code below... - my $staticsChanged = 0; - foreach my $istatic ( @istatics ) { # they have, we don't - unless ( grep($_ eq $istatic, @ostatics) ) { - push @ostatics, $istatic; - $staticsChanged = 1; - } - } - for(my $i=0; $i < scalar(@ostatics); $i++) { - unless ( grep($_ eq $ostatics[$i], @istatics) ) { - splice(@ostatics,$i,1); - $i--; - $staticsChanged = 1; - } - } - $svc_dsl->staticips(join(',',@ostatics)) if $staticsChanged; - - # 7. notes - put them into the common format and compare - my $tnotes = $result->{'OrderNotes'}; - my @tnotes = defined $tnotes ? @$tnotes : (); - my @inotes = (); # all Ikano OrderNotes as FS::dsl_note objects - my $notesChanged = 0; - foreach my $tnote ( @tnotes ) { - my $inote = $self->ikano2fsnote($tnote,$svc_dsl->svcnum); - return 'Cannot parse note' unless ref($inote); - push @inotes, $inote; - } - my @onotes = $svc_dsl->notes; - # assume notes we already have don't change & no notes added from our side - # so using the horrible code below just find what we're missing and add it - my $error; - foreach my $inote ( @inotes ) { - my $found = 0; - foreach my $onote ( @onotes ) { - if($onote->date == $inote->date && $onote->note eq $inote->note) { - $found = 1; - last; - } - } - $error = $inote->insert unless ( $found ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Cannot add note: $error"; - } - } - - $svc_dsl->last_pull((time)); - local $FS::svc_Common::noexport_hack = 1; - $error = $svc_dsl->replace; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Cannot update DSL data: $error"; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub ikano2fsnote { - my($self,$n,$svcnum) = (shift,shift,shift); - my @ikanoRequired = qw( HighPriority StaffId Date Text CompanyStaffId ); - return '' unless defined $n->{'HighPriority'} - && defined $n->{'StaffId'} - && defined $n->{'CompanyStaffId'} - && defined $n->{'Date'} - && defined $n->{'Text'} - ; - my $by = 'Unknown'; - $by = "Ikano" if $n->{'CompanyStaffId'} == -1 && $n->{'StaffId'} != -1; - $by = "Us" if $n->{'StaffId'} == -1 && $n->{'CompanyStaffId'} != -1; - - new FS::dsl_note( { - 'svcnum' => $svcnum, - 'author' => $by, - 'priority' => $n->{'HighPriority'} eq 'false' ? 'N' : 'H', - '_date' => int(str2time($n->{'Date'})), - 'note' => $n->{'Text'}, - } ); -} - -sub qual { - my($self,$qual) = (shift,shift); -# address always required for Ikano qual, TN optional (assume dry if not given) - - my %location_hash = $qual->location; - return 'No address provided' unless %location_hash; - my $svctn = $qual->phonenum; - - my $result = $self->ikano_command('PREQUAL', - { AddressLine1 => $location_hash{address1}, - AddressUnitType => $location_hash{location_type}, - AddressUnitValue => $location_hash{location_number}, - AddressCity => $location_hash{city}, - AddressState => $location_hash{state}, - ZipCode => $location_hash{zip}, - Country => $location_hash{country}, - LocationType => $location_hash{location_kind}, - PhoneNumber => length($svctn) > 1 ? $svctn : "STANDALONE", - RequestClientIP => '127.0.0.1', - CheckNetworks => $self->option('check_networks'), - } ); - return $result unless ref($result); # error case - return 'Invalid prequal response' unless defined $result->{'PrequalId'}; - - my $qoptions = {}; - # lame data structure traversal... - # don't spend much time here, just get TermsId and ProductCustomId - my $networks = $result->{'Network'}; - my @networks = defined $networks ? @$networks : (); - my $netcount = 0; - foreach my $network ( @networks ) { - my $productgroups = $network->{'ProductGroup'}; - my @productgroups = defined $productgroups ? @$productgroups : (); - my $pgcount = 0; - foreach my $productgroup ( @productgroups ) { - my $prefix = "ikano_Network_$netcount"."_ProductGroup_$pgcount"."_"; - $qoptions->{$prefix."TermsId"} = $productgroup->{'TermsId'}; - my $products = $productgroup->{'Product'}; - my @products = defined $products ? @$products : (); - my $prodcount = 0; - foreach my $product ( @products ) { - $qoptions->{$prefix."Product_$prodcount"."_ProductCustomId"} = $product->{'ProductCustomId'}; - $prodcount++; - } - $pgcount++; - } - $netcount++; - } - - { 'vendor_qual_id' => $result->{'PrequalId'}, - 'status' => scalar(@networks) ? 'Q' : 'D', - 'options' => $qoptions, - }; -} - -sub qual_html { - my($self,$qual) = (shift,shift); - - my %qual_options = $qual->options; - my @externalids = (); - my( $optionname, $optionvalue ); - while (($optionname, $optionvalue) = each %qual_options) { - push @externalids, $optionvalue - if ( $optionname =~ /^ikano_Network_(\d+)_ProductGroup_(\d+)_Product_(\d+)_ProductCustomId$/ - && $optionvalue ne '' ); - } - - # XXX: eventually perhaps this should return both the packages a link to - # order each package and go to the svc prov with the prequal id filled in - # but only if cust, not prospect! - my $list = "<B>Qualifying Packages:</B><UL>"; - my @part_pkgs = qsearch( 'part_pkg', { 'disabled' => '' } ); - foreach my $part_pkg ( @part_pkgs ) { - my %vendor_pkg_ids = $part_pkg->vendor_pkg_ids; - my $externalid = $vendor_pkg_ids{$self->exportnum} - if defined $vendor_pkg_ids{$self->exportnum}; - if ( $externalid ) { - $list .= "<LI>".$part_pkg->pkgpart.": ".$part_pkg->pkg." - " - .$part_pkg->comment."</LI>" - if grep( $_ eq $externalid, @externalids ); - } - } - $list .= "</UL>"; - $list; -} - -sub notes_html { - my($self,$svc_dsl) = (shift,shift); - my $conf = new FS::Conf; - my $date_format = $conf->config('date_format') || '%m/%d/%Y'; - my @notes = $svc_dsl->notes; - my $html = '<TABLE border="1" cellspacing="2" cellpadding="2" id="dsl_notes"> - <TR><TH>Date</TH><TH>By</TH><TH>Priority</TH><TH>Note</TH></TR>'; - foreach my $note ( @notes ) { - $html .= "<TR> - <TD>".time2str("$date_format %H:%M",$note->date)."</TD> - <TD>".$note->by."</TD> - <TD>". ($note->priority eq 'N' ? 'Normal' : 'High') ."</TD> - <TD>".$note->note."</TD></TR>"; - } - $html .= '</TABLE>'; - $html; -} - -sub loop_type_long { # sub, not a method - my($svc_dsl) = (shift); - return $loopType{$svc_dsl->loop_type}; -} - -sub ikano_command { - my( $self, $command, $args ) = @_; - - $self->loadmod; - - my $ikano = Net::Ikano->new( - 'keyid' => $self->option('keyid'), - 'username' => $self->option('username'), - 'password' => $self->option('password'), - 'debug' => $self->option('debug'), - ); - - $ikano->$command($args); -} - -sub loadmod { - eval "use Net::Ikano;"; - die $@ if $@; -} - -sub valid_order { - my( $self, $svc_dsl, $action ) = (shift, shift, shift); - - $self->loadmod; - - warn "$me valid_order action=$action svc_dsl:\n". Dumper($svc_dsl) - if $self->option('debug'); - - # common to all order types/status/loop_type - my $error = !($svc_dsl->desired_due_date - && grep($_ eq $svc_dsl->vendor_order_type, Net::Ikano->orderTypes) - && $svc_dsl->first - && $svc_dsl->last - && defined $svc_dsl->loop_type - && $svc_dsl->vendor_qual_id - ); - return 'Missing or invalid order data' if $error; - - my %vendor_pkg_ids = $svc_dsl->cust_svc->cust_pkg->part_pkg->vendor_pkg_ids; - return 'Package does not have an external id configured' - unless defined $vendor_pkg_ids{$self->exportnum}; - - return 'No valid qualification for this order' - unless qsearch( 'qual', { 'vendor_qual_id' => $svc_dsl->vendor_qual_id }); - - # now go by order type - # weird ifs & long lines for readability and ease of understanding - don't change - if($svc_dsl->vendor_order_type eq 'NEW') { - if($svc_dsl->pushed) { - $error = !( ($action eq 'pull' || $action eq 'statuschg' - || $action eq 'delete' || $action eq 'expire') - && length($svc_dsl->vendor_order_id) > 0 - && length($svc_dsl->vendor_order_status) > 0 - ); - return 'Invalid order data' if $error; - - return 'Phone number required for status change' - if ($action eq 'statuschg' && length($svc_dsl->phonenum) < 1); - } - else { # unpushed New order - cannot do anything other than push it - $error = !($action eq 'insert' - && length($svc_dsl->vendor_order_id) < 1 - && length($svc_dsl->vendor_order_status) < 1 - && ( ($svc_dsl->phonenum eq '' && $svc_dsl->loop_type eq '0') # dry - || ($svc_dsl->phonenum ne '' && $svc_dsl->loop_type eq '') # line-share - ) - ); - return 'Invalid order data' if $error; - } - } - elsif($svc_dsl->vendor_order_type eq 'CANCEL') { - } - elsif($svc_dsl->vendor_order_type eq 'CHANGE') { - } - - ''; -} - -sub qual2termsid { - my ($self,$vendor_qual_id,$ProductCustomId) = (shift,shift,shift); - my $qual = qsearchs( 'qual', { 'vendor_qual_id' => $vendor_qual_id }); - return '' unless $qual; - my %qual_options = $qual->options; - my( $optionname, $optionvalue ); - while (($optionname, $optionvalue) = each %qual_options) { - if ( $optionname =~ /^ikano_Network_(\d+)_ProductGroup_(\d+)_Product_(\d+)_ProductCustomId$/ - && $optionvalue eq $ProductCustomId ) { - my $network = $1; - my $productgroup = $2; - return $qual->option("ikano_Network_".$network."_ProductGroup_".$productgroup."_TermsId"); - } - } - ''; -} - -sub _export_insert { - my( $self, $svc_dsl ) = (shift, shift); - - my $result = $self->valid_order($svc_dsl,'insert'); - return $result unless $result eq ''; - - my $isp_chg = $svc_dsl->isp_chg eq 'Y' ? 'YES' : 'NO'; - my $contactTN = $svc_dsl->cust_svc->cust_pkg->cust_main->daytime; - $contactTN =~ s/[^0-9]//g; - - my %vendor_pkg_ids = $svc_dsl->cust_svc->cust_pkg->part_pkg->vendor_pkg_ids; - my $ProductCustomId = $vendor_pkg_ids{$self->exportnum}; - - my $args = { - orderType => 'NEW', - ProductCustomId => $ProductCustomId, - TermsId => $self->qual2termsid($svc_dsl->vendor_qual_id,$ProductCustomId), - DSLPhoneNumber => $svc_dsl->loop_type eq '0' ? 'STANDALONE' - : $svc_dsl->phonenum, - Password => $svc_dsl->password, - PrequalId => $svc_dsl->vendor_qual_id, - CompanyName => $svc_dsl->company, - FirstName => $svc_dsl->first, - LastName => $svc_dsl->last, - MiddleName => '', - ContactMethod => 'PHONE', - ContactPhoneNumber => $contactTN, - ContactEmail => 'x@x.xx', - ContactFax => '', - DateToOrder => time2str("%Y-%m-%d",$svc_dsl->desired_due_date), - RequestClientIP => '127.0.0.1', - IspChange => $isp_chg, - IspPrevious => $isp_chg eq 'YES' ? $svc_dsl->isp_prev : '', - CurrentProvider => $isp_chg eq 'NO' ? $svc_dsl->isp_prev : '', - }; - - $result = $self->ikano_command('ORDER',$args); - return $result unless ref($result); # scalar (string) is an error - - # now we're getting an OrderResponse which should have one Order in it - warn "$me _export_insert OrderResponse hash:\n".Dumper($result) - if $self->option('debug'); - - return 'Invalid order response' unless defined $result->{'Order'}; - $result = $result->{'Order'}; - - return 'No/invalid order id or status returned' - unless defined $result->{'Status'} && defined $result->{'OrderId'} - && grep($_ eq $result->{'Status'}, @Net::Ikano::orderStatus); - - $svc_dsl->pushed(time); - $svc_dsl->last_pull((time)+1); - $svc_dsl->vendor_order_id($result->{'OrderId'}); - $svc_dsl->vendor_order_status($result->{'Status'}); - $svc_dsl->username($result->{'Username'}); - local $FS::svc_Common::noexport_hack = 1; - $result = $svc_dsl->replace; - return "Error setting DSL fields: $result" if $result; - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); -# XXX only supports password changes now, but should return error if -# another change is attempted? - - if($new->password ne $old->password) { - my $result = $self->valid_order($new,'statuschg'); - return $result unless $result eq ''; - - $result = $self->ikano_command('PASSWORDCHANGE', - { DSLPhoneNumber => $new->phonenum, - NewPassword => $new->password, - } ); - return $result unless ref($result); # scalar (string) is an error - - return 'Error changing password' unless defined $result->{'Password'} - && $result->{'Password'} eq $new->password; - } - - ''; -} - -sub _export_delete { - my( $self, $svc_dsl ) = (shift, shift); - - my $result = $self->valid_order($svc_dsl,'delete'); - return $result unless $result eq ''; - - # for now allow an immediate cancel only on New orders in New/Pending status - #XXX: add support for Change and Cancel orders in New/Pending status later - - if($svc_dsl->vendor_order_type eq 'NEW') { - if($svc_dsl->vendor_order_status eq 'NEW' - || $svc_dsl->vendor_order_status eq 'PENDING') { - my $result = $self->ikano_command('CANCEL', - { OrderId => $svc_dsl->vendor_order_id, } ); - return $result unless ref($result); # scalar (string) is an error - return 'Unable to cancel order' unless $result->{'Order'}; - $result = $result->{'Order'}; - return 'Invalid cancellation response' - unless $result->{'Status'} eq 'CANCELLED' - && $result->{'OrderId'} eq $svc_dsl->vendor_order_id; - - # we're supposed to do a pull, but it will break everything, so don't - # this is very wrong... - } - else { - return "Cannot cancel a NEW order unless it's in NEW or PENDING status"; - } - } - elsif($svc_dsl->vendor_order_type eq 'CANCEL') { - return 'Cannot cancel a CANCEL order unless expire was set' - unless $svc_dsl->cust_svc->cust_pkg->expire > 0; - } - else { - return 'Canceling orders other than NEW orders is not currently implemented'; - } - - ''; -} - -sub export_expire { - my($self, $svc_dsl, $date) = (shift, shift, shift); - - my $result = $self->valid_order($svc_dsl,'expire'); - return $result unless $result eq ''; - - # for now allow a proper cancel only on New orders in Completed status - #XXX: add support for some other cases in future - - if($svc_dsl->vendor_order_type eq 'NEW' - && $svc_dsl->vendor_order_status eq 'COMPLETED') { - - my $contactTN = $svc_dsl->cust_svc->cust_pkg->cust_main->daytime; - $contactTN =~ s/[^0-9]//g; - - my %vendor_pkg_ids = $svc_dsl->cust_svc->cust_pkg->part_pkg->vendor_pkg_ids; - my $ProductCustomId = $vendor_pkg_ids{$self->exportnum}; - - # we are now a cancel order - $svc_dsl->desired_due_date($date); - $svc_dsl->vendor_order_type('CANCEL'); - - my $args = { - orderType => 'CANCEL', - ProductCustomId => $ProductCustomId, - TermsId => $self->qual2termsid($svc_dsl->vendor_qual_id,$ProductCustomId), - DSLPhoneNumber => $svc_dsl->loop_type eq '0' ? 'STANDALONE' - : $svc_dsl->phonenum, - Password => $svc_dsl->password, - PrequalId => $svc_dsl->vendor_qual_id, - CompanyName => $svc_dsl->company, - FirstName => $svc_dsl->first, - LastName => $svc_dsl->last, - MiddleName => '', - ContactMethod => 'PHONE', - ContactPhoneNumber => $contactTN, - ContactEmail => 'x@x.xx', - ContactFax => '', - DateToOrder => time2str("%Y-%m-%d",$date), - RequestClientIP => '127.0.0.1', - IspChange => 'NO', - IspPrevious => '', - CurrentProvider => '', - }; - - $args->{'VirtualPhoneNumber'} = $svc_dsl->phonenum - if $svc_dsl->loop_type eq '0'; - - $result = $self->ikano_command('ORDER',$args); - return $result unless ref($result); # scalar (string) is an error - - # now we're getting an OrderResponse which should have one Order in it - warn "$me _export_insert OrderResponse hash:\n".Dumper($result) - if $self->option('debug'); - - return 'Invalid order response' unless defined $result->{'Order'}; - $result = $result->{'Order'}; - - return 'No/invalid order id or status returned' - unless defined $result->{'Status'} && defined $result->{'OrderId'} - && grep($_ eq $result->{'Status'}, @Net::Ikano::orderStatus); - - $svc_dsl->pushed(time); - $svc_dsl->last_pull((time)+1); - $svc_dsl->vendor_order_id($result->{'OrderId'}); - $svc_dsl->vendor_order_status($result->{'Status'}); - $svc_dsl->monitored('Y'); - local $FS::svc_Common::noexport_hack = 1; - $result = $svc_dsl->replace; - return "Error setting DSL fields: $result" if $result; - } - else { - return "Cancelling anything other than NEW orders in COMPLETED status is " - . "not currently implemented"; - } - ''; -} - -sub statuschg { - my( $self, $svc_dsl, $type ) = (shift, shift, shift); - - my $result = $self->valid_order($svc_dsl,'statuschg'); - return $result unless $result eq ''; - - # get the DSLServiceId - $result = $self->ikano_command('CUSTOMERLOOKUP', - { PhoneNumber => $svc_dsl->phonenum } ); - return $result unless ref($result); # scalar (string) is an error - return 'No DSLServiceId found' unless defined $result->{'DSLServiceId'}; - my $DSLServiceId = $result->{'DSLServiceId'}; - - $result = $self->ikano_command('ACCOUNTSTATUSCHANGE', - { DSLPhoneNumber => $svc_dsl->phonenum, - DSLServiceId => $DSLServiceId, - type => $type, - } ); - return $result unless ref($result); # scalar (string) is an error - ''; -} - -sub _export_suspend { - my( $self, $svc_dsl ) = (shift, shift); - $self->statuschg($svc_dsl,"SUSPEND"); -} - -sub _export_unsuspend { - my( $self, $svc_dsl ) = (shift, shift); - $self->statuschg($svc_dsl,"UNSUSPEND"); -} - -1; diff --git a/FS/FS/part_export/indosoft.pm b/FS/FS/part_export/indosoft.pm deleted file mode 100644 index b573401..0000000 --- a/FS/FS/part_export/indosoft.pm +++ /dev/null @@ -1,219 +0,0 @@ -package FS::part_export::indosoft; - -use vars qw(@ISA %info $insert_hack); -use Tie::IxHash; -use Date::Format; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'url' => { label => 'Voicebridge API URL' }, - 'account_id' => { label => 'Voicebridge Account ID' }, -; - -%info = ( - 'svc' => 'svc_phone', #svc_bridge? svc_confbridge? - 'desc' => - 'Export conferences to the Indosoft Conference Bridge', - 'options' => \%options, - 'notes' => <<'END' -Export conferences to the Indosoft conference bridge. -Net::Indosoft::Voicebridge is required. -END -); - -$insert_hack = 0; - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_phone) = (shift, shift); - - my $cust_main = $svc_phone->cust_svc->cust_pkg->cust_main; - - my $address = $cust_main->address1; - $address .= ' '.$cust_main->address2 if $cust_main->address2; - - my $phone = $cust_main->daytime || $cust_main->night; - - my @email = $cust_main->invoicing_list_emailonly; - - #svc_phone->location_hash stuff? well that was for e911.. this shouldn't - # even be svc_phone - - #add client - my $client_return = eval { - indosoft_runcommand( 'addClient', - 'account_id' => $self->option('account_id'), - - 'client_contact_name' => $cust_main->name, #or just first last? - 'client_contact_password' => $svc_phone->sip_password, # ? - - 'client_contact_addr' => $address, - 'client_contact_city' => $cust_main->city, - 'client_contact_state' => $cust_main->state, - 'client_contact_country' => $cust_main->country, - 'client_contact_zip' => $cust_main->zip, - - 'client_contact_phone' => $phone, - 'client_contact_fax' => $cust_main->fax, - 'client_contact_email' => $email[0], - ); - }; - return $@ if $@; - - my $client_id = $client_return->{client_id}; - - #add conference - my $conf_return = eval { - indosoft_runcommand( 'addConference', - 'client_id' => $client_id, - 'conference_name' => $cust_main->name, - 'conference_desc' => $svc_phone->svcnum. ' for '. $cust_main->name, - 'start_time' => time2str('%Y-%d-$m %T', time), #now, right?? '2010-20-04 16:20:00', - #'moderated_flag' => 0, - #'entry_ann_flag' => 0 - #'record_flag' => 0 - #'moh_flag' => 0 - #'talk_detect_flag' => 0 - #'play_user_cnt_flag' => 0 - #'wait_for_admin' => 0 - #'stop_on_admin_exit' => 0 - #'second_pin' => 0 - #'secondary_pin' => 0, - #'allow_sub-conf' => 0, - #'duration' => 0, - #'conference_type' => 'reservation', #'reservationless', - ); - }; - return $@ if $@; - - my $conference_id = $conf_return->{conference_id}; - - #put conference_id in svc_phone.phonenum (and client_id in... phone_name???) - local($insert_hack) = 1; - $svc_phone->phonenum($conference_id); - $svc_phone->phone_name($client_id); - #my $error = $svc_phone->replace; - #return $error if $error; - $svc_phone->replace; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change phone number as conference_id with indosoft" - if $old->phonenum ne $new->phonenum && ! $insert_hack; - return ''; - - #change anything? -} - -sub _export_delete { - my( $self, $svc_phone ) = (shift, shift); - - #delete conference - my $conf_return = eval { - indosoft_runcommand( 'deleteConference', - 'conference_id' => $svc_phone->phonenum, - ); - }; - return $@ if $@; - - #delete client - my $client_return = eval { - indosoft_runcommand( 'deleteClient', - 'client_id' => $svc_phone->phone_name, - ) - }; - return $@ if $@; - - ''; - -} - -# #these three are optional -# # fallback for svc_acct will change and restore password -# sub _export_suspend { -# my( $self, $svc_phone ) = (shift, shift); -# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, -# 'suspend', $svc_phone->username ); -# ref($err_or_queue) ? '' : $err_or_queue; -# } -# -# sub _export_unsuspend { -# my( $self, $svc_phone ) = (shift, shift); -# $err_or_queue = $self->indosoft_queue( $svc_phone->svcnum, -# 'unsuspend', $svc_phone->username ); -# ref($err_or_queue) ? '' : $err_or_queue; -# } -# -# 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>!; -# ''; -# } - -### - -sub indosoft_runcommand { - my( $self, $method ) = (shift, shift); - - indosoft_command( - $self->option('url'), - $method, - @_, - ); - -} - -sub indosoft_command { - my( $url, $method, @args ) = @_; - - eval 'use Net::Indosoft::Voicebridge;'; - die $@ if $@; - - my $vb = new Net::Indosoft::Voicebridge( 'url' => $url ); - - my $return = $vb->$method( @args ); - - die "Indosoft error: ". $return->{'error'} if $return->{'error'}; - - $return; - -} - - -# #a good idea to queue anything that could fail or take any time -# sub indosoft_queue { -# my( $self, $svcnum, $method ) = (shift, shift, shift); -# my $queue = new FS::queue { -# 'svcnum' => $svcnum, -# 'job' => "FS::part_export::indosoft::indosoft_$method", -# }; -# $queue->insert( @_ ) or $queue; -# } -# -# sub indosoft_insert { #subroutine, not method -# my( $username, $password ) = @_; -# #do things with $username and $password -# } -# -# sub indosoft_replace { #subroutine, not method -# } -# -# sub indosoft_delete { #subroutine, not method -# my( $username ) = @_; -# #do things with $username -# } -# -# sub indosoft_suspend { #subroutine, not method -# } -# -# sub indosoft_unsuspend { #subroutine, not method -# } - - -1; diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm deleted file mode 100644 index ef16c7c..0000000 --- a/FS/FS/part_export/infostreet.pm +++ /dev/null @@ -1,277 +0,0 @@ -package FS::part_export::infostreet; - -use vars qw(@ISA %info %infostreet2cust_main $DEBUG); -use Tie::IxHash; -use FS::UID qw(dbh); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'url' => { label=>'XML-RPC Access URL', }, - 'login' => { label=>'InfoStreet login', }, - 'password' => { label=>'InfoStreet password', }, - 'groupID' => { label=>'InfoStreet groupID', }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to InfoStreet streetSmartAPI', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -Real-time export to -<a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI. -Requires installation of -<a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a> from CPAN. -END -); - -$DEBUG = 0; - -%infostreet2cust_main = ( - 'firstName' => 'first', - 'lastName' => 'last', - 'address1' => 'address1', - 'address2' => 'address2', - 'city' => 'city', - 'state' => 'state', - 'zipCode' => 'zip', - 'country' => 'country', - 'phoneNumber' => 'daytime', - 'faxNumber' => 'night', #noment-request... -); - -sub rebless { shift; } - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - my $cust_main = $svc_acct->cust_svc->cust_pkg->cust_main; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $err_or_queue = $self->infostreet_err_or_queue( $svc_acct->svcnum, - 'createUser', $svc_acct->username, $svc_acct->_password ); - return $err_or_queue unless ref($err_or_queue); - my $jobnum = $err_or_queue->jobnum; - - my %contact_info = ( map { - $_ => $cust_main->getfield( $infostreet2cust_main{$_} ); - } keys %infostreet2cust_main ); - - my @emails = grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list; - $contact_info{'email'} = $emails[0] if @emails; - - #this one is kinda noment-specific - $contact_info{'organization'} = $cust_main->agent->agent; - - $err_or_queue = $self->infostreet_queueContact( $svc_acct->svcnum, - $svc_acct->username, %contact_info ); - return $err_or_queue unless ref($err_or_queue); - - # If a quota has been specified set the quota because it is not the default - $err_or_queue = $self->infostreet_queueSetQuota( $svc_acct->svcnum, - $svc_acct->username, $svc_acct->quota ) if $svc_acct->quota; - return $err_or_queue unless ref($err_or_queue); - - my $error = $err_or_queue->depend_insert( $jobnum ); - return $error if $error; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't change username with InfoStreet" - if $old->username ne $new->username; - - # If the quota has changed then do the export to setQuota - my $err_or_queue = $self->infostreet_queueSetQuota( $new->svcnum, $new->username, $new->quota ) - if ( $old->quota != $new->quota ); - return $err_or_queue unless ref($err_or_queue); - - - return '' unless $old->_password ne $new->_password; - $self->infostreet_queue( $new->svcnum, - 'passwd', $new->username, $new->_password ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'purgeAccount,releaseUsername', $svc_acct->username ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'setStatus', $svc_acct->username, 'DISABLED' ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $self->infostreet_queue( $svc_acct->svcnum, - 'setStatus', $svc_acct->username, 'ACTIVE' ); -} - -sub infostreet_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_command', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - $method, - @_, - ); -} - -#ick false laziness -sub infostreet_err_or_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_command', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - $method, - @_, - ) or $queue; -} - -sub infostreet_queueContact { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_setContact', - }; - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - @_, - ) or $queue; -} - -sub infostreet_setContact { - my($url, $is_username, $is_password, $groupID, $username, %contact_info) = @_; - my $accountID = infostreet_command($url, $is_username, $is_password, $groupID, - 'getAccountID', $username); - foreach my $field ( keys %contact_info ) { - infostreet_command($url, $is_username, $is_password, $groupID, - 'setContactField', [ 'int'=>$accountID ], $field, $contact_info{$field} ); - } - -} - -sub infostreet_queueSetQuota { - - my( $self, $svcnum) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => 'FS::part_export::infostreet::infostreet_setQuota', - }; - - $queue->insert( - $self->option('url'), - $self->option('login'), - $self->option('password'), - $self->option('groupID'), - @_, - ) or $queue; - -} - -sub infostreet_setQuota { - my($url, $is_username, $is_password, $groupID, $username, $quota) = @_; - infostreet_command($url, $is_username, $is_password, $groupID, 'setQuota', $username, [ 'int'=> $quota ] ); -} - - -sub infostreet_command { #subroutine, not method - my($url, $username, $password, $groupID, $method, @args) = @_; - - warn "[FS::part_export::infostreet] $method ".join(' ', @args)."\n" if $DEBUG; - - #quelle hack - if ( $method =~ /,/ ) { - foreach my $part ( split(/,\s*/, $method) ) { - infostreet_command($url, $username, $password, $groupID, $part, @args); - } - return; - } - - eval "use Frontier::Client;"; - die $@ if $@; - - eval 'sub Frontier::RPC2::String::repr { - my $self = shift; - my $value = $$self; - $value =~ s/([&<>\"])/$Frontier::RPC2::char_entities{$1}/ge; - $value; - }'; - die $@ if $@; - - my $conn = Frontier::Client->new( url => $url ); - my $key_result = $conn->call( 'authenticate', $username, $password, $groupID); - my %key_result = _infostreet_parse($key_result); - die $key_result{error} unless $key_result{success}; - my $key = $key_result{data}; - - #my $result = $conn->call($method, $key, @args); - my $result = $conn->call( $method, $key, - map { - if ( ref($_) ) { - my( $type, $value) = @{$_}; - $conn->$type($value); - } else { - $conn->string($_); - } - } @args ); - my %result = _infostreet_parse($result); - die $result{error} unless $result{success}; - - $result->{data}; - -} - -#sub infostreet_command_byid { #subroutine, not method; -# my($url, $username, $password, $groupID, $method, @args ) = @_; -# -# infostreet_command -# -#} - -sub _infostreet_parse { #subroutine, not method - my $arg = shift; - map { - my $value = $arg->{$_}; - #warn ref($value); - $value = $value->value() - if ref($value) && $value->isa('Frontier::RPC2::DataType'); - $_=>$value; - } keys %$arg; -} - -1; - diff --git a/FS/FS/part_export/internal_diddb.pm b/FS/FS/part_export/internal_diddb.pm deleted file mode 100644 index a330cb0..0000000 --- a/FS/FS/part_export/internal_diddb.pm +++ /dev/null @@ -1,134 +0,0 @@ -package FS::part_export::internal_diddb; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::Record qw(qsearch qsearchs); -use FS::part_export; -use FS::phone_avail; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'countrycode' => { label => 'Country code', 'default' => '1', }, -; - -%info = ( - 'svc' => 'svc_phone', - 'desc' => 'Provision phone numbers from the internal DID database', - 'notes' => 'After adding the export, DIDs may be imported under Tools -> Importing -> Import phone numbers (DIDs)', - 'options' => \%options, -); - -sub rebless { shift; } - -sub get_dids { - my $self = shift; - my %opt = ref($_[0]) ? %{$_[0]} : @_; - - my %hash = ( 'countrycode' => ( $self->option('countrycode') || '1' ), - 'exportnum' => $self->exportnum, - 'svcnum' => '', - ); - - if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers - - $hash{npa} = $opt{areacode}; - $hash{nxx} = $opt{exchange}; - - return [ map { $_->npa. '-'. $_->nxx. '-'. $_->station } - qsearch({ 'table' => 'phone_avail', - 'hashref' => \%hash, - 'order_by' => 'ORDER BY station', - }) - ]; - - } elsif ( $opt{'areacode'} ) { #return city (npa-nxx-XXXX) - - $hash{npa} = $opt{areacode}; - - return [ map { '('. $_->npa. '-'. $_->nxx. '-XXXX)' } - qsearch({ 'select' => 'DISTINCT npa, nxx', - 'table' => 'phone_avail', - 'hashref' => \%hash, - 'order_by' => 'ORDER BY nxx', - }) - ]; - - } elsif ( $opt{'state'} ) { #return aracodes - - $hash{state} = $opt{state}; - - return [ map { $_->npa } - qsearch({ 'select' => 'DISTINCT npa', - 'table' => 'phone_avail', - 'hashref' => \%hash, - 'order_by' => 'ORDER BY npa', - }) - ]; - - } else { - die "FS::part_export::internal_diddb::get_dids called without options\n"; - } - -} - -sub _export_insert { #link phone_avail to svcnum - my( $self, $svc_phone ) = (shift, shift); - - $svc_phone->phonenum =~ /^(\d{3})(\d{3})(\d+)$/ - or return "unparsable phone number: ". $svc_phone->phonenum; - my( $npa, $nxx, $station ) = ($1, $2, $3); - - my $phone_avail = qsearchs('phone_avail', { - 'countrycode' => ( $self->option('countrycode') || '1' ), - 'exportnum' => $self->exportnum, - 'svcnum' => '', - 'npa' => $npa, - 'nxx' => $nxx, - 'station' => $station, - }); - - return "number not available: ". $svc_phone->phonenum - unless $phone_avail; - - $phone_avail->svcnum($svc_phone->svcnum); - - $phone_avail->replace; - -} - -sub _export_delete { #unlink phone_avail from svcnum - my( $self, $svc_phone ) = (shift, shift); - - $svc_phone->phonenum =~ /^(\d{3})(\d{3})(\d+)$/ - or return "unparsable phone number: ". $svc_phone->phonenum; - my( $npa, $nxx, $station ) = ($1, $2, $3); - - my $phone_avail = qsearchs('phone_avail', { - 'countrycode' => ( $self->option('countrycode') || '1'), - 'exportnum' => $self->exportnum, - 'svcnum' => $svc_phone->svcnum, - #these too? - 'npa' => $npa, - 'nxx' => $nxx, - 'station' => $station, - }); - - unless ( $phone_avail ) { - warn "WARNING: can't find number to return to availability: ". - $svc_phone->phonenum; - return; - } - - $phone_avail->svcnum(''); - - $phone_avail->replace; - -} - -sub _export_replace { ''; } -sub _export_suspend { ''; } -sub _export_unsuspend { ''; } - -1; - diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm deleted file mode 100644 index 8385320..0000000 --- a/FS/FS/part_export/ldap.pm +++ /dev/null @@ -1,264 +0,0 @@ -package FS::part_export::ldap; - -use vars qw(@ISA %info @saltset); -use Tie::IxHash; -use FS::Record qw( dbh ); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'dn' => { label=>'Root DN' }, - 'password' => { label=>'Root DN password' }, - 'userdn' => { label=>'User DN' }, - 'key_attrib' => { label=>'Key attribute name', - default=>'uid' }, - 'attributes' => { label=>'Attributes', - type=>'textarea', - default=>join("\n", - 'uid $username', - 'mail $username\@$domain', - 'uidno $uid', - 'gidno $gid', - 'cn $first', - 'sn $last', - 'mailquota $quota', - 'vmail', - 'location', - 'mailtag', - 'mailhost', - 'mailmessagestore $dir', - 'userpassword $crypt_password', - 'hint', - 'answer $sec_phrase', - 'objectclass top,person,inetOrgPerson', - ), - }, - 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to LDAP', - 'options' => \%options, - 'notes' => <<'END' -Real-time export to arbitrary LDAP attributes. Requires installation of -<a href="http://search.cpan.org/dist/Net-LDAP">Net::LDAP</a> from CPAN. -END -); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -sub rebless { shift; } - -sub svc_context_eval { - # This should possibly be in svc_Common? - # Except the only places we use it are here and in shellcommands, - # and it's not even the same version. - my $svc_acct = shift; - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - ${$_} = $svc_acct->$_() foreach qw( domain ldap_password ); - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - if ( $cust_pkg ) { - my $cust_main = $cust_pkg->cust_main; - ${$_} = $cust_main->getfield($_) foreach qw(first last); - } - # DEPRECATED, probably fails for non-plain password encoding - $crypt_password = ''; #surpress "used only once" warnings - $crypt_password = '{crypt}'. crypt( $svc_acct->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] ); - - return map { eval(qq("$_")) } @_ ; -} - -sub key_attrib { - my $self = shift; - return $self->option('key_attrib') if $self->option('key_attrib'); - # otherwise, guess that it's the one that's set to $username - foreach ( split("\n",$self->option('attributes')) ) { - /^\s*(\w+)\s+\$username\s*$/ && return $1; - } - # can't recover from that, but we can fail in a more obvious way - # than the old code did... - die "no key_attrib set in LDAP export\n"; -} - -sub ldap_attrib { - # Convert the svc_acct to its LDAP attribute set. - my($self, $svc_acct) = (shift, shift); - my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; - ( $1 => $2 ); } - grep { /^\s*(\w+)\s+(.*\S)\s*$/ } - split("\n", $self->option('attributes')); - - my @vals = svc_context_eval($svc_acct, values(%attrib)); - @attrib{keys(%attrib)} = @vals; - - if ( $self->option('radius') ) { - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %radius = $svc_acct->$method(); - foreach my $radius ( keys %radius ) { - ( my $ldap = $radius ) =~ s/\-//g; - $attrib{$ldap} = $radius{$radius}; - } - } - } - return %attrib; -} - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - my $err_or_queue = $self->ldap_queue( - $svc_acct->svcnum, - 'insert', - $self->key_attrib, - $self->ldap_attrib($svc_acct), - ); - return $err_or_queue unless ref($err_or_queue); - - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $jobnum = ''; - - # the Lazy way: nuke the entry and recreate it. - # any reason this shouldn't work? Freeside _has_ to have - # write access to these entries and their parent DN. - my $key = $self->key_attrib; - my %attrib = $self->ldap_attrib($old); - my $err_or_queue = $self->ldap_queue( - $old->svcnum, - 'delete', - $key, - $attrib{$key} - ); - if( !ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - $jobnum = $err_or_queue->jobnum; - $err_or_queue = $self->ldap_queue( - $new->svcnum, - 'insert', - $key, - $self->ldap_attrib($new) - ); - if( !ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - $err_or_queue = $err_or_queue->depend_insert($jobnum); - if( $err_or_queue ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - - my $key = $self->key_attrib; - my ( $val ) = map { /^\s*$key\s+(.*\S)\s*$/ ? $1 : () } - split("\n", $self->option('attributes')); - ( $val ) = svc_context_eval($svc_acct, $val); - my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete', - $key, $val ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub ldap_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::ldap::ldap_$method", - }; - $queue->insert( - $self->machine, - $self->option('dn'), - $self->option('password'), - $self->option('userdn'), - @_, - ) or $queue; -} - -sub ldap_insert { #subroutine, not method - my $ldap = ldap_connect(shift, shift, shift); - my( $userdn, $key_attrib, %attrib ) = @_; - - $userdn = "$key_attrib=$attrib{$key_attrib}, $userdn"; - #icky hack, but should be unsurprising to the LDAPers - foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) { - $attrib{$key} = [ split(/,/, $attrib{$key}) ]; - } - - my $status = $ldap->add( $userdn, attrs => [ %attrib ] ); - die 'LDAP error: '. $status->error. "\n" if $status->is_error; - - $ldap->unbind; -} - -sub ldap_delete { - my $ldap = ldap_connect(shift, shift, shift); - - my $entry = ldap_fetch($ldap, @_); - if($entry) { - my $status = $ldap->delete($entry); - die 'LDAP error: '.$status->error."\n" if $status->is_error; - } - $ldap->unbind; - # should failing to find the entry be fatal? - # if it is, it will block unprovisioning the service, which is a pain. -} - -sub ldap_fetch { - # avoid needless duplication in delete and modify - my( $ldap, $userdn, %key_data ) = @_; - my $filter = join('', map { "($_=$key_data{$_})" } keys(%key_data)); - - my $status = $ldap->search( base => $userdn, - scope => 'one', - filter => $filter ); - die 'LDAP error: '.$status->error."\n" if $status->is_error; - my ($entry) = $status->entries; - warn "Entry '$filter' not found in LDAP\n" if !$entry; - return $entry; -} - -sub ldap_connect { - my( $machine, $dn, $password ) = @_; - my %bind_options; - $bind_options{password} = $password if length($password); - - eval "use Net::LDAP"; - die $@ if $@; - - my $ldap = Net::LDAP->new($machine) or die $@; - my $status = $ldap->bind( $dn, %bind_options ); - die 'LDAP error: '. $status->error. "\n" if $status->is_error; - - $ldap; -} - -1; - diff --git a/FS/FS/part_export/nas_wrapper.pm b/FS/FS/part_export/nas_wrapper.pm deleted file mode 100644 index 2499ba3..0000000 --- a/FS/FS/part_export/nas_wrapper.pm +++ /dev/null @@ -1,311 +0,0 @@ -package FS::part_export::nas_wrapper; - -=head1 FS::part_export::nas_wrapper - -This is a meta-export that triggers other exports for FS::svc_broadband objects -based on a set of configurable conditions. These conditions are defined by the -following FS::router virtual fields: - -=over 4 - -=item nas_conf - Per-router meta-export configuration. See L</"nas_conf Syntax">. - -=back - -=head2 nas_conf Syntax - -export_name|routernum[,routernum]|[field,condition[,field,condition]][||...] - -=over 4 - -=item export_name - Name or exportnum of the export to be executed. In order to specify export options you must use the exportnum form. (ex. 'router' for FS::part_export::router). - -=item routernum - FS::router routernum corresponding to the desired FS::router for which this export will be run. - -=item field - FS::svc_broadband field (real or virtual). The following condition (regex) will be matched against the value of this field. - -=item condition - A regular expression to be match against the value of the previously listed FS::svc_broadband field. - -=back - -If multiple routernum's are specified, then the export will be triggered for each router listed. If multiple field/condition pairs are present, then the results of the matches will be and'd. Note that if a false match is found, the rest of the matches may not be checked. - -You can specify multiple export/router/condition sets by concatenating them with '||'. - -=cut - -use strict; -use vars qw(@ISA %info $me $DEBUG); - -use FS::Record qw(qsearchs); -use FS::part_export; - -use Tie::IxHash; -use Data::Dumper qw(Dumper); - -@ISA = qw(FS::part_export); -$me = '[' . __PACKAGE__ . ']'; -$DEBUG = 0; - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'A meta-export that triggers other svc_broadband exports.', - 'options' => {}, - 'notes' => '', -); - - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('insert', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('delete', @_); -} - -sub _export_suspend { - my($self) = shift; - $self->_export_command('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command('unsuspend', @_); -} - -sub _export_replace { - my($self) = shift; - $self->_export_command('replace', @_); -} - -sub _export_command { - my ( $self, $action, $svc_broadband) = (shift, shift, shift); - - my ($new, $old); - if ($action eq 'replace') { - $new = $svc_broadband; - $old = shift; - } - - my $router = $svc_broadband->addr_block->router; - - return '' unless grep(/^nas_conf$/, $router->fields); - my $nas_conf = $router->nas_conf; - - my $child_exports = &_parse_nas_conf($nas_conf); - - my $error = ''; - - my $queue_child_exports = {}; - - # Similar to FS::svc_Common::replace, calling insert, delete, and replace - # exports where necessary depending on which conditions match. - if ($action eq 'replace') { - - my @new_child_exports = (); - my @old_child_exports = (); - - # Find all the matching "new" child exports. - foreach my $child_export (@$child_exports) { - my $match = &_test_child_export_conditions( - $child_export->{'conditions'}, - $new, - ); - - if ($match) { - push @new_child_exports, $child_export; - } - } - - # Find all the matching "old" child exports. - foreach my $child_export (@$child_exports) { - my $match = &_test_child_export_conditions( - $child_export->{'conditions'}, - $old, - ); - - if ($match) { - push @old_child_exports, $child_export; - } - } - - # Insert exports for new. - push @{$queue_child_exports->{'insert'}}, ( - map { - my $new_child_export = $_; - if (! grep { $new_child_export eq $_ } @old_child_exports) { - $new_child_export->{'args'} = [ $new ]; - $new_child_export; - } else { - (); - } - } @new_child_exports - ); - - # Replace exports for new and old. - push @{$queue_child_exports->{'replace'}}, ( - map { - my $new_child_export = $_; - if (grep { $new_child_export eq $_ } @old_child_exports) { - $new_child_export->{'args'} = [ $new, $old ]; - $new_child_export; - } else { - (); - } - } @new_child_exports - ); - - # Delete exports for old. - push @{$queue_child_exports->{'delete'}}, ( - grep { - my $old_child_export = $_; - if (! grep { $old_child_export eq $_ } @new_child_exports) { - $old_child_export->{'args'} = [ $old ]; - $old_child_export; - } else { - (); - } - } @old_child_exports - ); - - } else { - - foreach my $child_export (@$child_exports) { - my $match = &_test_child_export_conditions( - $child_export->{'conditions'}, - $svc_broadband, - ); - - if ($match) { - $child_export->{'args'} = [ $svc_broadband ]; - push @{$queue_child_exports->{$action}}, $child_export; - } - } - - } - - warn "[debug]$me Dispatching child exports... " - . &Dumper($queue_child_exports) if $DEBUG; - - # Actually call the child exports now, with their preset action and arguments. - foreach my $_action (keys(%$queue_child_exports)) { - - foreach my $_child_export (@{$queue_child_exports->{$_action}}) { - $error = &_dispatch_child_export( - $_child_export, - $_action, - @{$_child_export->{'args'}}, - @_, - ); - - # Bail if there's an error queueing one of the exports. - # This will all get rolled-back. - return $error if $error; - } - - } - - return ''; - -} - - -sub _parse_nas_conf { - - my $nas_conf = shift; - my @child_exports = (); - - foreach my $cond_set ($nas_conf =~ m/(.*?[^\\])(?:\|\||$)/g) { - - warn "[debug]$me cond_set is '$cond_set'" if $DEBUG; - - my @args = $cond_set =~ m/(.*?[^\\])(?:\||$)/g; - - my %child_export = ( - 'export' => $args[0], - 'routernum' => [ split(/,\s*/, $args[1]) ], - 'conditions' => { @args[2..$#args] }, - ); - - warn "[debug]$me " . Dumper(\%child_export) if $DEBUG; - - push @child_exports, { %child_export }; - - } - - return \@child_exports; - -} - -sub _dispatch_child_export { - - my ($child_export, $action, @args) = (shift, shift, @_); - - my $child_export_name = $child_export->{'export'}; - my @routernums = @{$child_export->{'routernum'}}; - - my $error = ''; - - # And the real hack begins... - - my $child_part_export; - if ($child_export_name =~ /^(\d+)$/) { - my $exportnum = $1; - $child_part_export = qsearchs('part_export', { exportnum => $exportnum }); - unless ($child_part_export) { - return "No such FS::part_export with exportnum '$exportnum'"; - } - - $child_export_name = $child_part_export->exporttype; - } else { - $child_part_export = new FS::part_export { - 'exporttype' => $child_export_name, - 'machine' => 'bogus', - }; - } - - warn "[debug]$me running export '$child_export_name' for routernum(s) '" - . join(',', @routernums) . "'" if $DEBUG; - - my $cmd_method = "_export_$action"; - - foreach my $routernum (@routernums) { - $error ||= $child_part_export->$cmd_method( - @args, - 'routernum' => $routernum, - ); - last if $error; - } - - warn "[debug]$me export '$child_export_name' returned '$error'" - if $DEBUG; - - return $error; - -} - -sub _test_child_export_conditions { - - my ($conditions, $svc_broadband) = (shift, shift); - - my $match = 1; - foreach my $cond_field (keys %$conditions) { - my $cond_regex = $conditions->{$cond_field}; - warn "[debug]$me Condition: $cond_field =~ /$cond_regex/" if $DEBUG; - unless ($svc_broadband->get($cond_field) =~ /$cond_regex/) { - $match = 0; - last; - } - } - - return $match; - -} - - -1; - diff --git a/FS/FS/part_export/netsapiens.pm b/FS/FS/part_export/netsapiens.pm deleted file mode 100644 index 83f0f01..0000000 --- a/FS/FS/part_export/netsapiens.pm +++ /dev/null @@ -1,312 +0,0 @@ -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', ], # 'part_device', - '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'). join(', ', @args). "\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_domain { - my($self, $svc_phone) = (shift, shift); - $svc_phone->domain || $self->option('domain'); -} - -sub ns_subscriber { - my($self, $svc_phone) = (shift, shift); - - my $domain = $self->ns_domain($svc_phone); - 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->ns_domain($svc_phone); - #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->ns_domain($svc_phone); - #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->ns_domain($svc_phone); - 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' => $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/null.pm b/FS/FS/part_export/null.pm deleted file mode 100644 index 0145af3..0000000 --- a/FS/FS/part_export/null.pm +++ /dev/null @@ -1,13 +0,0 @@ -package FS::part_export::null; - -use vars qw(@ISA); -use FS::part_export; - -@ISA = qw(FS::part_export); - -sub rebless { shift; } - -sub _export_insert {} -sub _export_replace {} -sub _export_delete {} - diff --git a/FS/FS/part_export/passwdfile.pm b/FS/FS/part_export/passwdfile.pm deleted file mode 100644 index 2978d25..0000000 --- a/FS/FS/part_export/passwdfile.pm +++ /dev/null @@ -1,18 +0,0 @@ -package FS::part_export::passwdfile; - -use strict; -use vars qw(@ISA %options); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie %options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -1; - diff --git a/FS/FS/part_export/phone_shellcommands.pm b/FS/FS/part_export/phone_shellcommands.pm deleted file mode 100644 index 040af27..0000000 --- a/FS/FS/part_export/phone_shellcommands.pm +++ /dev/null @@ -1,140 +0,0 @@ -package FS::part_export::phone_shellcommands; - -use strict; -use vars qw(@ISA %info); -use Tie::IxHash; -use String::ShellQuote; -use FS::part_export; - -@ISA = qw(FS::part_export); - -#TODO -#- modify command (get something from freepbx for changing PINs) -#- suspension/unsuspension - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root', }, - 'useradd' => { label=>'Insert command', }, - 'userdel' => { label=>'Delete command', }, - 'usermod' => { label=>'Modify command', }, - 'suspend' => { label=>'Suspension command', }, - 'unsuspend' => { label=>'Unsuspension command', }, -; - -%info = ( - 'svc' => 'svc_phone', - 'desc' => 'Run remote commands via SSH, for phone numbers', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH, for phone numbers. You will need to -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="FreePBX (build_exten CLI module needed)" onClick=' - this.form.user.value = "root"; - this.form.useradd.value = "build_exten.php --create --exten $phonenum --directdid 1$phonenum --sip-secret $sip_password --name $cust_name --vm-password $pin && /usr/share/asterisk/bin/module_admin reload"; - this.form.userdel.value = "build_exten.php --delete --exten $phonenum && /usr/share/asterisk/bin/module_admin reload"; - this.form.usermod.value = "build_exten.php --modify --exten $new_phonenum --directdid 1$new_phonenum --sip-secret $new_sip_password --name $new_cust_name --vm-password $new_pin && /usr/share/asterisk/bin/module_admin reload"; - this.form.suspend.value = ""; - this.form.unsuspend.value = ""; - '> (Important note: Reduce freeside-queued "max_kids" to 1 when using FreePBX integration) - </UL> - -The following variables are available for interpolation (prefixed with new_ or -old_ for replace operations): -<UL> - <LI><code>$countrycode</code> - Country code - <LI><code>$phonenum</code> - Phone number - <LI><code>$sip_password</code> - SIP secret (quoted for the shell) - <LI><code>$pin</code> - Personal identification number - <LI><code>$cust_name</code> - Customer name (quoted for the shell) -</UL> -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_suspend { - my($self) = shift; - $self->_export_command('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command('unsuspend', @_); -} - -sub _export_command { - my ( $self, $action, $svc_phone) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_phone->getfield($_) foreach $svc_phone->fields; - } - my $cust_pkg = $svc_phone->cust_svc->cust_pkg; - my $cust_name = $cust_pkg ? $cust_pkg->cust_main->name : ''; - $cust_name = shell_quote $cust_name; - my $sip_password = shell_quote $svc_phone->sip_password; - #done setting variables for the command - - $self->shellcommands_queue( $svc_phone->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - - my $cust_pkg = $new->cust_svc->cust_pkg; - my $new_cust_name = $cust_pkg ? $cust_pkg->cust_main->name : ''; - $new_cust_name = shell_quote $new_cust_name; - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::phone_shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - diff --git a/FS/FS/part_export/phone_sqlradius.pm b/FS/FS/part_export/phone_sqlradius.pm deleted file mode 100644 index 24f7845..0000000 --- a/FS/FS/part_export/phone_sqlradius.pm +++ /dev/null @@ -1,158 +0,0 @@ -package FS::part_export::phone_sqlradius; - -use vars qw(@ISA $DEBUG %info ); -use Tie::IxHash; -use FS::Record qw( dbh str2time_sql ); #qsearch qsearchs ); -#use FS::part_export; -use FS::part_export::sqlradius qw(sqlradius_connect); -#use FS::svc_phone; -#use FS::export_svc; -#use Carp qw( cluck ); - -@ISA = qw(FS::part_export::sqlradius); - -$DEBUG = 0; - -tie %options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source ' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, - 'ignore_accounting' => { - type => 'checkbox', - label => 'Ignore accounting records from this database' - }, - 'hide_ip' => { - type => 'checkbox', - label => 'Hide IP address information on session reports', - }, - 'hide_data' => { - type => 'checkbox', - label => 'Hide download/upload information on session reports', - }, - - #should be default for this one, right? - #'show_called_station' => { - # type => 'checkbox', - # label => 'Show the Called-Station-ID on session reports', - #}, - - #N/A - #'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit', } , - #'groups_susp_reason' => { label => - # 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)', - # type => 'textarea', - # }, - -; - -%info = ( - 'svc' => 'svc_phone', - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) for phone provisioning and rating', - 'options' => \%options, - 'notes' => <<END, -Real-time export of <b>radcheck</b> table -<!--, <b>radreply</b> and <b>usergroup</b>-- tables> -to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> -or <a href="http://radius.innercite.com/">ICRADIUS</a>. -<br><br> - -This export is for phone/VoIP provisioning and rating. For a regular RADIUS -export, see sqlradius. -<br><br> - -<!--An existing RADIUS database will be updated in realtime, but you can use -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-phone_sqlradius-reset">freeside-phone_sqlradius-reset</a> -to delete the entire RADIUS database and repopulate the tables from the -Freeside database. -<br><br> ---> - -See the -<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a> -and the -<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> -for the exact syntax of a DBI data source. - -END -); - -sub rebless { shift; } - -sub export_username { - my($self, $svc_phone) = (shift, shift); - $svc_phone->countrycode. $svc_phone->phonenum; -} - -sub _export_suspend {} -sub _export_unsuspend {} - -#probably harmless that we ->can('usage_sessions').... ? - -#we want to feed these into CDRs, not update svc_acct records -sub update_svc { - my $self = shift; - - my $fdbh = dbh; - my $dbh = sqlradius_connect( map $self->option($_), - qw( datasrc username password ) ); - - my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); - - my @fields = qw( radacctid username realm acctsessiontime ); - - my @param = (); - my $where = ''; - - my $sth = $dbh->prepare(" - SELECT RadAcctId, UserName, AcctSessionTime, - $str2time AcctStartTime), $str2time AcctStopTime), - CallingStationID, CalledStationID - FROM radacct - WHERE FreesideStatus IS NULL - AND AcctStopTime != 0 - ") or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - - while ( my $row = $sth->fetchrow_arrayref ) { - my( $RadAcctId, $UserName, $AcctSessionTime, - $AcctStartTime, $AcctStopTime, - $CallingStationID, $CalledStationID, - )= @$row; - warn "processing record: ". - "$RadAcctId ($UserName for ${AcctSessionTime}s" - if $DEBUG; - - my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at - local $FS::UID::AutoCommit = 0; # least we can avoid over counting - - my $cdr = new FS::cdr { - 'src' => $CallingStationID, - 'charged_party' => $UserName, - 'dst' => $CalledStationID, - 'startdate' => $AcctStartTime, - 'enddate' => $AcctStopTime, - 'duration' => $AcctStopTime - $AcctStartTime, - 'billsec' => $AcctSessionTime, - }; - - my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ". - "(UserName $UserName)"; - - my $error = $cdr->insert; - my $status = $error ? 'skipped' : 'done'; - - warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; - my $psth = $dbh->prepare("UPDATE radacct - SET FreesideStatus = ? - WHERE RadAcctId = ?" - ) or die $dbh->errstr; - $psth->execute($status, $RadAcctId) or die $psth->errstr; - - $fdbh->commit or die $fdbh->errstr if $oldAutoCommit; - - } - -} - -1; - diff --git a/FS/FS/part_export/postfix.pm b/FS/FS/part_export/postfix.pm deleted file mode 100644 index 4fd19ee..0000000 --- a/FS/FS/part_export/postfix.pm +++ /dev/null @@ -1,32 +0,0 @@ -package FS::part_export::postfix; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::null; - -@ISA = qw(FS::part_export::null); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'aliases' => { label=>'aliases file location', default=>'/etc/aliases' }, - 'virtual' => { label=>'virtual file location', default=>'/etc/postfix/virtual' }, - 'mydomain' => { label=>'local domain', default=>'' }, - 'newaliases' => { label=>'newaliases command', default=>'newaliases' }, - 'postmap' => { label=>'postmap command', - default=>'postmap hash:/etc/postfix/virtual', }, - 'reload' => { label=>'reload command', - default=>'postfix reload' }, -; - -%info = ( - 'svc' => 'svc_forward', - 'desc' => 'Postfix text files', - 'options' => \%options, - 'notes' => <<'END' -Batch export of Postfix aliases and virtual files. -<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed. Run bin/postfix.export to export the files. -END -); - -1; diff --git a/FS/FS/part_export/prizm.pm b/FS/FS/part_export/prizm.pm deleted file mode 100644 index 02e89c6..0000000 --- a/FS/FS/part_export/prizm.pm +++ /dev/null @@ -1,591 +0,0 @@ -package FS::part_export::prizm; - -use vars qw(@ISA %info %options $DEBUG $me); -use Tie::IxHash; -use FS::Record qw(fields dbh); -use FS::part_export; - -@ISA = qw(FS::part_export); -$DEBUG = 0; -$me = '[' . __PACKAGE__ . ']'; - -tie %options, 'Tie::IxHash', - 'url' => { label => 'Northbound url', default=>'https://localhost:8443/prizm/nbi' }, - 'user' => { label => 'Northbound username', default=>'nbi' }, - 'password' => { label => 'Password', default => '' }, - 'ems' => { label => 'Full EMS', type => 'checkbox' }, - 'always_bam' => { label => 'Always activate/suspend authentication', type => 'checkbox' }, - 'element_name_length' => { label => 'Size of siteName (best left blank)' }, -; - -my $notes = <<'EOT'; -Real-time export of <b>svc_broadband</b>, <b>cust_pkg</b>, and <b>cust_main</b> -record data to Motorola -<a href="http://motorola.canopywireless.com/products/prizm/">Canopy Prizm -software</a> via the Northbound interface.<br><br> - -Freeside will attempt to create an element in an existing network with the -values provided in svc_broadband. Of particular interest are -<ul> - <li> mac address - used to identify the element - <li> vlan profile - an exact match for a vlan profiles defined in prizm - <li> ip address - defines the management ip address of the prizm element - <li> latitude - GPS latitude - <li> longitude - GPS longitude - <li> altitude - GPS altitude -</ul> - -In addition freeside attempts to set the service plan name in prizm to the -name of the package in which the service resides. - -The service is associated with a customer in prizm as well, and freeside -will create the customer should none already exist with import id matching -the freeside customer number. The following fields are set. - -<ul> - <li> importId - the freeside customer number - <li> customerType - freeside - <li> customerName - the name associated with the freeside shipping address - <li> address1 - the shipping address - <li> address2 - <li> city - <li> state - <li> zipCode - <li> country - <li> workPhone - the daytime phone number - <li> homePhone - the night phone number - <li> freesideId - the freeside customer number -</ul> - - Additionally set on the element are -<ul> - <li> Site Name - The shipping name followed by the service broadband description field - <li> Site Location - the shipping address - <li> Site Contact - the daytime and night phone numbers -</ul> - -Freeside provisions, suspends, and unsuspends elements BAM only unless the -'Full EMS' checkbox is checked.<br><br> - -When freeside provisions an element the siteName is copied internally by -prizm in such a manner that it is possible for the value to exceed the size -of the column used in the prizm database. Therefore freeside truncates -by default this value to 50 characters. It is thought that this -column is the account_name column of the element_user_account table. It -may be possible to lift this limit by modifying the prizm database and -setting a new appropriate value on this export. This is untested and -possibly harmful. - -EOT - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Real-time export to Northbound Interface', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => $notes, -); - -sub prizm_command { - my ($self,$namespace,$method) = (shift,shift,shift); - - eval "use Net::Prizm 0.04 qw(CustomerInfo PrizmElement);"; - die $@ if $@; - - my $prizm = new Net::Prizm ( - namespace => $namespace, - url => $self->option('url'), - user => $self->option('user'), - password => $self->option('password'), - ); - - $prizm->$method(@_); -} - -sub queued_prizm_command { # subroutine - my( $url, $user, $password, $namespace, $method, @args ) = @_; - - eval "use Net::Prizm 0.04 qw(CustomerInfo PrizmElement);"; - die $@ if $@; - - my $prizm = new Net::Prizm ( - namespace => $namespace, - url => $url, - user => $user, - password => $password, - ); - - $err_or_som = $prizm->$method( @args); - - die $err_or_som - unless ref($err_or_som); - - ''; - -} - -sub _export_insert { - my( $self, $svc ) = ( shift, shift ); - warn "$me: _export_insert called for export ". $self->exportnum. - " on service ". $svc->svcnum. "\n" - if $DEBUG; - - my $cust_main = $svc->cust_svc->cust_pkg->cust_main; - - my $err_or_som = $self->prizm_command('CustomerIfService', 'getCustomers', - ['import_id'], - [$cust_main->custnum], - ['='], - ); - return $err_or_som - unless ref($err_or_som); - - my $pre = ''; - if ( defined $cust_main->dbdef_table->column('ship_last') ) { - $pre = $cust_main->ship_last ? 'ship_' : ''; - } - my $name = $pre ? $cust_main->ship_name : $cust_main->name; - my $location = join(" ", map { my $method = "$pre$_"; $cust_main->$method } - qw (address1 address2 city state zip) - ); - my $contact = join(" ", map { my $method = "$pre$_"; $cust_main->$method } - qw (daytime night) - ); - - my $pcustomer; - if ($err_or_som->result->[0]) { - $pcustomer = $err_or_som->result->[0]->customerId; - warn "$me: found customer $pcustomer in prizm\n" if $DEBUG; - }else{ - my $chashref = $cust_main->hashref; - my $customerinfo = { - importId => $cust_main->custnum, - customerName => $name, - customerType => 'freeside', - address1 => $chashref->{"${pre}address1"}, - address2 => $chashref->{"${pre}address2"}, - city => $chashref->{"${pre}city"}, - state => $chashref->{"${pre}state"}, - zipCode => $chashref->{"${pre}zip"}, - workPhone => $chashref->{"${pre}daytime"}, - homePhone => $chashref->{"${pre}night"}, - email => @{[$cust_main->invoicing_list_emailonly]}[0], - extraFieldNames => [ 'country', 'freesideId', - ], - extraFieldValues => [ $chashref->{"${pre}country"}, $cust_main->custnum, - ], - }; - - $err_or_som = $self->prizm_command('CustomerIfService', 'addCustomer', - $customerinfo); - return $err_or_som - unless ref($err_or_som); - - $pcustomer = $err_or_som->result; - warn "$me: added customer $pcustomer to prizm\n" if $DEBUG; - } - warn "multiple prizm customers found for $cust_main->custnum" - if scalar(@$pcustomer) > 1; - -# #kinda big question/expensive -# $err_or_som = $self->prizm_command('NetworkIfService', 'getPrizmElements', -# ['Network Default Gateway Address'], -# [$svc->addr_block->ip_gateway], -# ['='], -# ); -# return $err_or_som -# unless ref($err_or_som); -# -# return "No elements in network" unless exists $err_or_som->result->[0]; - - my $networkid = 0; -# for (my $i = 0; $i < $err_or_som->result->[0]->attributeNames; $i++) { -# if ($err_or_som->result->[0]->attributeNames->[$i] eq "Network.ID"){ -# $networkid = $err_or_som->result->[0]->attributeValues->[$i]; -# last; -# } -# } - -# here we cope with a problem of prizm failing to insert for reason -# of duplicate mac addr, but doing so inconsistently... a race in prizm? - - $self->prizm_command( 'CustomerIfService', 'removeElementFromCustomer', - 0, - $cust_main->custnum, - 0, - $svc->mac_addr, - ); - - $err_or_som = $self->prizm_command( 'NetworkIfService', 'getPrizmElements', - [ 'MAC Address' ], - [ $svc->mac_addr ], - [ '=' ], - ); - if ( ref($err_or_som) && $err_or_som->result->[0] ) { # ignore errors - $self->prizm_command( 'NetworkIfService', 'deleteElement', - $err_or_som->result->[0], - 1, - ); - } -# end of coping - - 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*$/; - $err_or_som = $self->prizm_command('NetworkIfService', 'addProvisionedElement', - $networkid, - $svc->mac_addr, - substr($name . " " . $svc->description, - 0, $element_name_length), - $location, - $contact, - sprintf("%032X", $svc->authkey || 0), - $performance_profile, - $svc->vlan_profile, - ($self->option('ems') ? 1 : 0 ), - ); - return $err_or_som - unless ref($err_or_som); - warn "$me: added provisioned element to prizm\n" if $DEBUG; - - my (@names) = ('Management IP', - 'GPS Latitude', - 'GPS Longitude', - 'GPS Altitude', - 'Site Name', - 'Site Location', - 'Site Contact', - ); - my (@values) = ($svc->ip_addr, - $svc->latitude, - $svc->longitude, - $svc->altitude, - $name . " " . $svc->description, - $location, - $contact, - ); - $element = $err_or_som->result->elementId; - $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfig', - [ $element ], - \@names, - \@values, - 0, - 1, - ); - return $err_or_som - unless ref($err_or_som); - warn "$me: set element configuration\n" if $DEBUG; - - $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', - [ $element ], - $svc->vlan_profile, - 0, - 1, - ); - return $err_or_som - unless ref($err_or_som); - warn "$me: set element vlan profile\n" if $DEBUG; - - $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', - [ $element ], - $performance_profile, - 0, - 1, - ); - return $err_or_som - unless ref($err_or_som); - warn "$me: set element configset (performance profile)\n" if $DEBUG; - - $err_or_som = $self->prizm_command('NetworkIfService', - 'activateNetworkElements', - [ $element ], - 1, - ( $self->option('ems') ? 1 : 0 ), - ); - - return $err_or_som - unless ref($err_or_som); - warn "$me: activated element\n" if $DEBUG; - - $err_or_som = $self->prizm_command('CustomerIfService', - 'addElementToCustomer', - 0, - $cust_main->custnum, - 0, - $svc->mac_addr, - ); - - return $err_or_som - unless ref($err_or_som); - warn "$me: added element to customer\n" if $DEBUG; - - ''; -} - -sub _export_delete { - my( $self, $svc ) = ( shift, shift ); - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $cust_pkg = $svc->cust_svc->cust_pkg; - - my $depend = []; - - if ($cust_pkg) { - my $queue = new FS::queue { - 'svcnum' => $svc->svcnum, - 'job' => 'FS::part_export::prizm::queued_prizm_command', - }; - my $error = $queue->insert( - ( map { $self->option($_) } - qw( url user password ) ), - 'CustomerIfService', - 'removeElementFromCustomer', - 0, - $cust_pkg->custnum, - 0, - $svc->mac_addr, - ); - - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - push @$depend, $queue->jobnum; - } - - my $err_or_queue = - $self->queue_statuschange('deleteElement', $depend, $svc, 1); - - unless (ref($err_or_queue)) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = ( shift, shift, shift ); - - my $err_or_som = $self->prizm_command('NetworkIfService', 'getPrizmElements', - [ 'MAC Address' ], - [ $old->mac_addr ], - [ '=' ], - ); - return $err_or_som - unless ref($err_or_som); - - return "Can't find prizm element for " . $old->mac_addr - unless $err_or_som->result->[0]; - - my %freeside2prizm = ( mac_addr => 'MAC Address', - ip_addr => 'Management IP', - latitude => 'GPS Latitude', - longitude => 'GPS Longitude', - altitude => 'GPS Altitude', - authkey => 'Authentication Key', - ); - - my (@values); - my (@names) = map { push @values, $new->$_; $freeside2prizm{$_} } - grep { $old->$_ ne $new->$_ } - grep { exists($freeside2prizm{$_}) } - fields( 'svc_broadband' ); - - if ($old->description ne $new->description) { - my $cust_main = $old->cust_svc->cust_pkg->cust_main; - my $name = defined($cust_main->dbdef_table->column('ship_last')) - ? $cust_main->ship_name - : $cust_main->name; - push @values, $name . " " . $new->description; - push @names, "Site Name"; - } - - my $element = $err_or_som->result->[0]->elementId; - - $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfig', - [ $element ], - \@names, - \@values, - 0, - 1, - ); - return $err_or_som - unless ref($err_or_som); - - $err_or_som = $self->prizm_command('NetworkIfService', 'setElementConfigSet', - [ $element ], - $new->vlan_profile, - 0, - 1, - ) - if $old->vlan_profile ne $new->vlan_profile; - - 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 ], - $performance_profile, - 0, - 1, - ); - return $err_or_som - unless ref($err_or_som); - - ''; - -} - -sub _export_suspend { - my( $self, $svc ) = ( shift, shift ); - my $depend = []; - my $ems = $self->option('ems') ? 1 : 0; - my $err_or_queue = ''; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $err_or_queue = - $self->queue_statuschange('suspendNetworkElements', [], $svc, 1, $ems); - unless (ref($err_or_queue)) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - push @$depend, $err_or_queue->jobnum; - - if ($ems && $self->option('always_bam')) { - $err_or_queue = - $self->queue_statuschange('suspendNetworkElements', $depend, $svc, 1, 0); - unless (ref($err_or_queue)) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_unsuspend { - my( $self, $svc ) = ( shift, shift ); - my $depend = []; - my $ems = $self->option('ems') ? 1 : 0; - my $err_or_queue = ''; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ($ems && $self->option('always_bam')) { - $err_or_queue = - $self->queue_statuschange('activateNetworkElements', [], $svc, 1, 0); - unless (ref($err_or_queue)) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - push @$depend, $err_or_queue->jobnum; - } - - $err_or_queue = - $self->queue_statuschange('activateNetworkElements', $depend, $svc, 1, $ems); - unless (ref($err_or_queue)) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub export_links { - my( $self, $svc, $arrayref ) = ( shift, shift, shift ); - - push @$arrayref, - '<A HREF="http://'. $svc->ip_addr. '" target="_blank">SM</A>'; - - ''; -} - -sub queue_statuschange { - my( $self, $method, $jobs, $svc, @args ) = @_; - - # already in a transaction and can't die here - - my $queue = new FS::queue { - 'svcnum' => $svc->svcnum, - 'job' => 'FS::part_export::prizm::statuschange', - }; - my $error = $queue->insert( - ( map { $self->option($_) } - qw( url user password ) ), - $method, - $svc->mac_addr, - @args, - ); - - unless ($error) { # successful insertion - foreach my $job ( @$jobs ) { - $error ||= $queue->depend_insert($job); - } - } - - $error or $queue; -} - -sub statuschange { # subroutine - my( $url, $user, $password, $method, $mac_addr, @args) = @_; - - eval "use Net::Prizm 0.04 qw(CustomerInfo PrizmElement);"; - die $@ if $@; - - my $prizm = new Net::Prizm ( - namespace => 'NetworkIfService', - url => $url, - user => $user, - password => $password, - ); - - my $err_or_som = $prizm->getPrizmElements( [ 'MAC Address' ], - [ $mac_addr ], - [ '=' ], - ); - die $err_or_som - unless ref($err_or_som); - - die "Can't find prizm element for " . $mac_addr - unless $err_or_som->result->[0]; - - my $arg1; - # yuck! - if ($method =~ /suspendNetworkElements/ || $method =~ /activateNetworkElements/) { - $arg1 = [ $err_or_som->result->[0]->elementId ]; - }else{ - $arg1 = $err_or_som->result->[0]->elementId; - } - $err_or_som = $prizm->$method( $arg1, @args ); - - die $err_or_som - unless ref($err_or_som); - - ''; - -} - - -1; diff --git a/FS/FS/part_export/radiator.pm b/FS/FS/part_export/radiator.pm deleted file mode 100644 index 2ac3edb..0000000 --- a/FS/FS/part_export/radiator.pm +++ /dev/null @@ -1,167 +0,0 @@ -package FS::part_export::radiator; - -use vars qw(@ISA %info $radusers); -use Tie::IxHash; -use FS::part_export::sqlradius; - -tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to RADIATOR', - 'options' => \%options, - 'nodomain' => '', - 'notes' => <<'END', -Real-time export of the <b>radusers</b> table to any SQL database in -<a href="http://www.open.com.au/radiator/">Radiator</a>-native format. -To setup accounting, see the RADIATOR documentation for hooks to update -a standard <b>radacct</b> table. -END -); - -@ISA = qw(FS::part_export::sqlradius); #for regular sqlradius accounting - -$radusers = 'RADUSERS'; #MySQL is case sensitive about table names! huh - -#sub export_username { -# my($self, $svc_acct) = (shift, shift); -# $svc_acct->email; -#} - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - - $self->radiator_queue( - $svc_acct->svcnum, - 'insert', - $self->_radiator_hash($svc_acct), - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - -# return "can't (yet) change domain with radiator export" -# if $old->domain ne $new->domain; -# return "can't (yet) change username with radiator export" -# if $old->username ne $new->username; - - $self->radiator_queue( - $new->svcnum, - 'replace', - $self->export_username($old), - $self->_radiator_hash($new), - ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - - $self->radiator_queue( - $svc_acct->svcnum, - 'delete', - $self->export_username($svc_acct), - ); -} - -sub _radiator_hash { - my( $self, $svc_acct ) = @_; - my %hash = ( - 'username' => $self->export_username($svc_acct), - 'pass_word' => $svc_acct->crypt_password, - 'fullname' => $svc_acct->finger, - map { my $method = "radius_$_"; $_ => $svc_acct->$method(); } - qw( framed_filter_id framed_mtu framed_netmask framed_protocol - framed_routing login_host login_service login_tcp_port ) - ); - $hash{'timeleft'} = $svc_acct->seconds - if $svc_acct->seconds =~ /^\d+$/; - $hash{'staticaddress'} = $svc_acct->slipip - if $svc_acct->slipip =~ /^[\d\.]+$/; # and $self->slipip ne '0.0.0.0'; - - $hash{'servicename'} = ( $svc_acct->radius_groups )[0]; - - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - $hash{'validto'} = $cust_pkg->bill - if $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill; - - #some other random stuff, should probably be attributes or virtual fields - #$hash{'state'} = 0; #only inserts - #$hash{'badlogins'} = 0; #only inserts - $hash{'maxlogins'} = 1; - $hash{'addeddate'} = $cust_pkg->setup - if $cust_pkg && $cust_pkg->setup; - $hash{'validfrom'} = $cust_pkg->last_bill || $cust_pkg->setup - if $cust_pkg && ( $cust_pkg->last_bill || $cust_pkg->setup ); - $hash{'state'} = $cust_pkg->susp ? 1 : 0 - if $cust_pkg; - - %hash; -} - -sub radiator_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::radiator::radiator_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ); # or $queue; -} - -sub radiator_insert { #subroutine, not method - my $dbh = radiator_connect(shift, shift, shift); - my %hash = @_; - $hash{'state'} = 0; #see "random stuff" above - $hash{'badlogins'} = 0; #see "random stuff" above - - my $sth = $dbh->prepare( - "INSERT INTO $radusers ( ". join(', ', keys %hash ). ' ) '. - 'VALUES ( '. join(', ', map '?', keys %hash ). ' ) ' - ) or die $dbh->errstr; - $sth->execute( values %hash ) - or die $sth->errstr; - - $dbh->disconnect; - -} - -sub radiator_replace { #subroutine, not method - my $dbh = radiator_connect(shift, shift, shift); - my ( $old_username, %hash ) = @_; - - my $sth = $dbh->prepare( - "UPDATE $radusers SET ". join(', ', map " $_ = ?", keys %hash ). - ' WHERE username = ?' - ) or die $dbh->errstr; - $sth->execute( values(%hash), $old_username ) - or die $sth->errstr; - - $dbh->disconnect; -} - -sub radiator_delete { #subroutine, not method - my $dbh = radiator_connect(shift, shift, shift); - my ( $username ) = @_; - - my $sth = $dbh->prepare( - "DELETE FROM $radusers WHERE username = ?" - ) or die $dbh->errstr; - $sth->execute( $username ) - or die $sth->errstr; - - $dbh->disconnect; -} - - -sub radiator_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - -1; diff --git a/FS/FS/part_export/router.pm b/FS/FS/part_export/router.pm deleted file mode 100644 index 42aa51c..0000000 --- a/FS/FS/part_export/router.pm +++ /dev/null @@ -1,375 +0,0 @@ -package FS::part_export::router; - -=head1 FS::part_export::router - -This export connects to a router and transmits commands via telnet or SSH. -It requires the following custom router fields: - -=head1 Required custom fields - -=over 4 - -=item admin_address - IP address (or hostname) to connect. - -=item admin_user - Username for the router. - -=item admin_password - Password for the router. - -=item admin_protocol - Protocol to use for the router. 'telnet' or 'ssh'. The ssh protocol only support password-less (ie. RSA key) authentication. As such, the admin_password field isn't used if ssh is specified. - -=item admin_timeout - Time in seconds to wait for a connection. - -=item admin_prompt - A regular expression matching the router's prompt. See Net::Telnet for details. Only applies to the 'telnet' protocol. - -=item admin_cmd_insert - Insert export command. - -=item admin_cmd_insert_error - Insert export command error pattern. - -=item admin_cmd_delete - Delete export command. - -=item admin_cmd_delete_error - Delete export command error pattern. - -=item admin_cmd_replace - Replace export command. - -=item admin_cmd_replace_error - Replace export command error pattern. - -=item admin_cmd_suspend - Suspend export command. - -=item admin_cmd_suspend_error - Support export command error pattern. - -=item admin_cmd_unsuspend - Unsuspend export command. - -=item admin_cmd_unsuspend_error - Unsuspend export command error pattern. - -The admin_cmd_* virtual fields, if set, will be processed in one of two ways. After being expanded, they will be run on the router specified by admin_address using the protocol specified by admin_protocol. - -=over 4 - -=item Text::Template - -If the export command contains the string [@--, then it will be processed with Text::Template using [@-- and --@] as delimeters. - -=item eval - -If the export command does not contain [@--, it will be double quoted and eval'd. - -=back - -The admin_cmd_*_error virtual fields, if set, define a regular expression that will be matched against the output of the command being run. If the pattern matches, an error will be raised using the output as the error. - -If any of the required router virtual fields are not defined, then the export silently declines. - -=back - -The export itself takes no options. - -=cut - -use strict; -use vars qw(@ISA %info $me $DEBUG); -use Tie::IxHash; -use Text::Template; - -use FS::Record qw(qsearchs); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'protocol' => { - label=>'Protocol', - type =>'select', - options => [qw(telnet ssh)], - default => 'telnet'}, -; - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Send a command to a router.', - 'options' => \%options, - 'notes' => 'Installation of Net::Telnet from CPAN is required for telnet connections. This export will execute if the following virtual fields are set on the router: admin_user, admin_password, admin_address, admin_timeout, admin_prompt. Option virtual fields are: admin_cmd_insert, admin_cmd_replace, admin_cmd_delete, admin_cmd_suspend, admin_cmd_unsuspend. See the module documentation for a full list of required/supported router virtual fields.', -); - -$me = '[' . __PACKAGE__ . ']'; -$DEBUG = 1; - - -sub rebless { shift; } - -sub _field_prefix { 'admin'; } - -sub _req_router_fields { - map { - $_[0]->_field_prefix . '_' . $_ - } (qw(address prompt user)); -} - -sub _export_insert { - my($self) = shift; - warn "Running insert for " . ref($self); - $self->_export_command('insert', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('delete', @_); -} - -sub _export_suspend { - my($self) = shift; - $self->_export_command('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command('unsuspend', @_); -} - -sub _export_replace { - my($self) = shift; - $self->_export_command('replace', @_); -} - -sub _export_command { - my ($self, $action, $svc_broadband) = (shift, shift, shift); - my ($error, $old); - - if ($action eq 'replace') { - $old = shift; - } - - warn "[debug]$me Processing action '$action'" if $DEBUG; - - # fetch router info - my $router = $self->_get_router($svc_broadband, @_); - unless ($router) { - return "Unable to lookup router for $action export"; - } - - unless ($self->_check_router_fields($router)) { - # Virtual fields aren't defined. Exit silently. - warn "[debug]$me Required router virtual fields not defined. Returning..." - if $DEBUG; - return ''; - } - - my $args; - ($error, $args) = $self->_prepare_args( - $action, - $router, - $svc_broadband, - ($old ? $old : ()), - @_ - ); - - if ($error) { - # Error occured while preparing args. - return $error; - } elsif (not defined $args) { - # Silently decline. - warn "[debug]$me Declining '$action' export" if $DEBUG; - return ''; - } # else ... queue the export. - - warn "[debug]$me Queueing with args: " . join(', ', @$args) if $DEBUG; - - return( - $self->_queue( - $svc_broadband->svcnum, - $self->_get_cmd_sub($svc_broadband, $router), - @$args - ) - ); - -} - -sub _prepare_args { - - my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift); - my $old = shift if ($action eq 'replace'); - my $error = ''; - - my $field_prefix = $self->_field_prefix; - my $command = $router->getfield("${field_prefix}_cmd_${action}"); - unless ($command) { - warn "[debug]$me router custom field '${field_prefix}_cmd_$action' " - . "is not defined." if $DEBUG; - return ''; - } - - if ($command =~ /\[\@--/) { # Use Text::Template - - my $template_data = {}; - - if ($action eq 'replace') { - $template_data->{"old_$_"} = $old->getfield($_) foreach $old->fields; - $template_data->{"new_$_"} = $svc_broadband->getfield($_) - foreach $svc_broadband->fields; - } else { - $template_data->{$_} = $svc_broadband->getfield($_) - foreach $svc_broadband->fields; - } - - my $template = new Text::Template ( - TYPE => 'STRING', - SOURCE => $command, - DELIMITERS => [ '[@--', '--@]' ], - ) or return "Unable to construct template for router command: " - . $Text::Template::ERROR; - - $command = $template->fill_in( - HASH => $template_data, - BROKEN_ARG => \$error, - BROKEN => sub { - my %bargs = @_; - my $err = $bargs{'arg'}; - $$err = $bargs{'error'}; - return undef; - }, - ); - - if (not defined $command or $error) { - $error ||= $Text::Template::ERROR; - return "Unable to fill-in template for router command: $error"; - } - - } else { # Use eval - no strict 'vars'; - no strict 'refs'; - - if ($action eq 'replace') { - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - $command = eval(qq("$command")); - } else { - ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - $command = eval(qq("$command")); - } - return $@ if $@; - } - - my $args = [ - 'user' => $router->getfield($field_prefix . '_user'), - 'password' => $router->getfield($field_prefix . '_password'), - 'host' => $router->getfield($field_prefix . '_address'), - 'Timeout' => $router->getfield($field_prefix . '_timeout'), - 'Prompt' => $router->getfield($field_prefix . '_prompt'), - 'command' => $command, - ]; - - my $error_check = $router->getfield("${field_prefix}_cmd_${action}_error"); - push(@$args, ('error_check' => $error_check)) if ($error_check); - - return('', $args); - -} - -sub _get_cmd_sub { - - my ($self, $svc_broadband, $router) = (shift, shift, shift); - - my $protocol = ( - $router->getfield($self->_field_prefix . '_protocol') =~ /^(telnet|ssh)$/ - ) ? $1 : 'telnet'; - - return(ref($self)."::".$protocol."_cmd"); - -} - -sub _check_router_fields { - - my ($self, $router, $action) = (shift, shift, shift); - my @check_fields = $self->_req_router_fields; - - foreach (@check_fields) { - if ($router->getfield($_) eq '') { - warn "[debug]$me Required field '$_' is unset" if $DEBUG; - return 0; - } else { - return 1; - } - } - -} - -sub _queue { - my( $self, $svcnum, $cmd_sub ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - }; - $queue->job($cmd_sub); - $queue->insert(@_); -} - -sub _get_router { - my ($self, $svc_broadband, %args) = (shift, shift, shift, @_); - - my $router; - if ($args{'routernum'}) { - $router = qsearchs('router', { routernum => $args{'routernum'}}); - } else { - $router = $svc_broadband->addr_block->router; - } - - return($router); - -} - - -# Subroutines -sub ssh_cmd { - my %arg = @_; - - eval 'use Net::SSH \'0.08\''; - die $@ if $@; - - my @out = &Net::SSH::ssh_cmd( { @_ } ); - my $error = &_cmd_error_check(\%arg, \@out); - - die ("Error while processing ssh command: $error") if $error; - - return ''; - -} - -sub telnet_cmd { - my %arg = @_; - - eval 'use Net::Telnet'; - die $@ if $@; - - my $t = new Net::Telnet (Timeout => $arg{'Timeout'}, - Prompt => $arg{'Prompt'}); - $t->open($arg{'host'}); - $t->login($arg{'user'}, $arg{'password'}); - my @out = $t->cmd($arg{'command'}); - my $error = &_cmd_error_check(\%arg, \@out); - - die ("Error while processing telnet command: $error") if $error; - - return ''; - -} - -sub _cmd_error_check { - my ($arg, $out) = (shift, shift); - - die "_cmd_error_check called without proper arguments" - unless (ref($arg) eq 'HASH' and ref($out) eq 'ARRAY'); - - unless (exists($arg->{'error_check'}) and $arg->{'error_check'} ne '') { - #Preserve default behaviour and return output if a check isn't defined. - warn "Output from router command: " . join('', @$out) if $DEBUG; - return ''; - } - - my $error_check = $arg->{'error_check'}; - foreach (@$out) { - return $_ if /$error_check/; - } - - return ''; - -} - -1; diff --git a/FS/FS/part_export/rt_ticket.pm b/FS/FS/part_export/rt_ticket.pm deleted file mode 100644 index b53b7da..0000000 --- a/FS/FS/part_export/rt_ticket.pm +++ /dev/null @@ -1,219 +0,0 @@ -package FS::part_export::rt_ticket; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; -use FS::Record qw(qsearch qsearchs); -use FS::Conf; -use FS::TicketSystem; - -@ISA = qw(FS::part_export); - -my %templates; -my %queues; -my %template_select = ( - type => 'select', - freeform => 1, - option_label => sub { - $templates{$_[0]}; - }, - option_values => sub { - %templates = (0 => '', - map { $_->msgnum, $_->msgname } - qsearch({ table => 'msg_template', - hashref => {}, - order_by => 'ORDER BY msgnum ASC' - }) - ); - sort keys (%templates); - }, -); - -my %queue_select = ( - type => 'select', - freeform => 1, - option_label => sub { - $queues{$_[0]}; - }, - option_values => sub { - %queues = (0 => '', FS::TicketSystem->queues()); - sort {$queues{$a} cmp $queues{$b}} keys %queues; - }, -); - -tie my %options, 'Tie::IxHash', ( - 'insert_queue' => { - before => ' -<TR><TD COLSPAN=2> -<TABLE> - <TR><TH></TH><TH>Queue</TH><TH>Template</TH></TR> - <TR><TD>New service</TD><TD>', - %queue_select, - after => '</TD>' - }, - 'insert_template' => { - before => '<TD>', - %template_select, - after => '</TD></TR> -', - }, - 'delete_queue' => { - before => ' - <TR><TD>Delete</TD><TD>', - %queue_select, - after => '</TD>', - }, - 'delete_template' => { - before => '<TD>', - %template_select, - after => '</TD></TR> -', - }, - 'replace_queue' => { - before => ' - <TR><TD>Modify</TD><TD>', - %queue_select, - after => '</TD>', - }, - 'replace_template' => { - before => '<TD>', - %template_select, - after => '</TD></TR> -', - }, - 'suspend_queue' => { - before => ' - <TR><TD>Suspend</TD><TD>', - %queue_select, - after => '</TD>', - }, - 'suspend_template' => { - before => '<TD>', - %template_select, - after => '</TD></TR> -', - }, - 'unsuspend_queue' => { - before => ' - <TR><TD>Unsuspend</TD><TD>', - %queue_select, - after => '</TD>', - }, - 'unsuspend_template' => { - before => '<TD>', - %template_select, - after => '</TD></TR> - </TABLE> -</TD></TR>', - }, - 'requestor' => { - freeform => 0, - label => 'Requestor', - 'type' => 'select', - option_label => sub { - my @labels = ( - 'Template From: address', - 'Customer\'s invoice address', - ); - $labels[shift]; - }, - option_values => sub { (0, 1) }, - }, -); - -%info = ( - 'svc' => [qw( svc_acct svc_broadband svc_phone svc_domain )], - 'desc' => - 'Create an RT ticket', - 'options' => \%options, - 'nodomain' => '', - 'notes' => ' - Create a ticket in RT. The subject and body of the ticket - will be generated from a message template.' -); - -sub _export_ticket { - my( $self, $action, $svc ) = (shift, shift, shift); - my $conf = new FS::Conf; - die "rt_ticket export - no ticket system configured" - unless $conf->config('ticket_system'); - - FS::TicketSystem->init(); - - my $msgnum = $self->option($action.'_template'); - return if !$msgnum; - - my $queue = $self->option($action.'_queue'); - return if !$queue; - - my $msg_template = FS::msg_template->by_key($msgnum); - return "Template $msgnum not found\n" if !$msg_template; - - my $cust_pkg = $svc->cust_svc->cust_pkg; - my $cust_main = $svc->cust_svc->cust_pkg->cust_main if $cust_pkg; - my $custnum = $cust_main->custnum if $cust_main; - my $svcnum = $svc->svcnum if $action ne 'delete'; - - my %msg; - if ( $action eq 'replace' ) { - my $old = shift; - %msg = $msg_template->prepare( - 'cust_main' => $cust_main, - 'object' => [ $svc, $old ], - ); - - } - else { - %msg = $msg_template->prepare( - 'cust_main' => $cust_main, - 'object' => $svc, - ); - } - my $requestor = $msg{'from'}; - $requestor = [ $cust_main->invoicing_list_emailonly ] - if $cust_main and $self->option('requestor') == 1; - - my $err_or_ticket = FS::TicketSystem->create_ticket( - '', #session should already exist - 'queue' => $queue, - 'subject' => $msg{'subject'}, - 'requestor' => $requestor, - 'message' => $msg{'html_body'}, - 'mime_type' => 'text/html', - 'custnum' => $custnum, - 'svcnum' => $svcnum, - ); - if( ref($err_or_ticket) ) { - return ''; - } - else { - return $err_or_ticket; - } -} - -sub _export_insert { - my($self, $svc) = (shift, shift); - $self->_export_ticket('insert', $svc); -} - -sub _export_replace { - my($self, $new, $old) = (shift, shift, shift); - $self->_export_ticket('replace', $new, $old); -} - -sub _export_delete { - my($self, $svc) = (shift, shift); - $self->_export_ticket('delete', $svc); -} - -sub _export_suspend { - my($self, $svc) = (shift, shift); - $self->_export_ticket('suspend', $svc); -} - -sub _export_unsuspend { - my($self, $svc) = (shift, shift); - $self->_export_ticket('unsuspend', $svc); -} - -1; diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm deleted file mode 100644 index 50af45d..0000000 --- a/FS/FS/part_export/shellcommands.pm +++ /dev/null @@ -1,480 +0,0 @@ -package FS::part_export::shellcommands; - -use vars qw(@ISA %info); -use Tie::IxHash; -use String::ShellQuote; -use FS::part_export; -use FS::Record qw( qsearch qsearchs ); - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - 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=>'', - }, - 'userdel' => { label=>'Delete command', - 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=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username', - #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. - # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. - # 'find . -depth -print | cpio -pdm $new_dir; '. - # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. - # 'rm -rf $old_dir'. - #')' - }, - 'usermod_no_queue' => { label=>'Run immediately', - type =>'checkbox', - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - default=>'', - }, - 'usermod_pwonly' => { label=>'Disallow username, domain, uid, gid, and dir changes', #and RADIUS group changes', - type =>'checkbox', - }, - 'usermod_nousername' => { label=>'Disallow just username changes', - type =>'checkbox', - }, - '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=>'', - }, - 'crypt' => { label => 'Default password encryption', - type=>'select', options=>[qw(crypt md5)], - default => 'crypt', - }, - 'groups_susp_reason' => { label => - 'Radius group mapping to reason (via template user)', - type => 'textarea', - }, -# 'no_queue' => { label => 'Run command immediately', -# type => 'checkbox', -# }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -Run remote commands via SSH. Usernames are considered unique (also see -shellcommands_withdomain). You probably want this if the commands you are -running will not accept a domain as a parameter. You will need to -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. - -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="Linux" onClick=' - this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "userdel -r $username"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username"; - this.form.usermod_stdin.value = ""; - this.form.suspend.value = "usermod -L $username"; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = "usermod -U $username"; - this.form.unsuspend_stdin.value=""; - '> - <LI> - <INPUT TYPE="button" VALUE="FreeBSD before 4.10 / 5.3" onClick=' - this.form.useradd.value = "lockf /etc/passwd.lock pw useradd $username -d $dir -m -s $shell -u $uid -c $finger -h 0"; - this.form.useradd_stdin.value = "$_password\n"; - this.form.userdel.value = "lockf /etc/passwd.lock pw userdel $username -r"; this.form.userdel_stdin.value=""; - this.form.usermod.value = "lockf /etc/passwd.lock pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -c $new_finger -h 0"; - this.form.usermod_stdin.value = "$new__password\n"; this.form.suspend.value = "lockf /etc/passwd.lock pw lock $username"; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = "lockf /etc/passwd.lock pw unlock $username"; this.form.unsuspend_stdin.value=""; - '> - Note: On FreeBSD versions before 5.3 and 4.10 (4.10 is after 4.9, not - 4.1!), due to deficient locking in pw(1), you must disable the chpass(1), - chsh(1), chfn(1), passwd(1), and vipw(1) commands, or replace them with - wrappers that prepend "lockf /etc/passwd.lock". Alternatively, apply the - patch in - <A HREF="http://www.freebsd.org/cgi/query-pr.cgi?pr=23501">FreeBSD PR#23501</A> - and use the "FreeBSD 4.10 / 5.3 or later" button below. - <LI> - <INPUT TYPE="button" VALUE="FreeBSD 4.10 / 5.3 or later" onClick=' - this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0"; - this.form.useradd_stdin.value = "$_password\n"; - this.form.userdel.value = "pw userdel $username -r"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -c $new_finger -h 0"; - this.form.usermod_stdin.value = "$new__password\n"; - this.form.suspend.value = "pw lock $username"; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = "pw unlock $username"; - this.form.unsuspend_stdin.value=""; - '> - <LI> - <INPUT TYPE="button" VALUE="NetBSD/OpenBSD" onClick=' - this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "userdel -r $username"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -g $new_gid -p $new_crypt_password $old_username"; - this.form.usermod_stdin.value = ""; - this.form.suspend.value = ""; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = ""; - this.form.unsuspend_stdin.value=""; - '> - <LI> - <INPUT TYPE="button" VALUE="Just maintain directories (use with sysvshell or bsdshell)" onClick=' - this.form.useradd.value = "cp -pr /etc/skel $dir; chown -R $uid.$gid $dir"; this.form.useradd_stdin.value = ""; - this.form.usermod.value = "[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $new_uid.$new_gid $new_dir; rm -rf $old_dir )"; - this.form.usermod_stdin.value = ""; - this.form.userdel.value = "rm -rf $dir"; - this.form.userdel_stdin.value=""; - this.form.suspend.value = ""; - this.form.suspend_stdin.value=""; - this.form.unsuspend.value = ""; - this.form.unsuspend_stdin.value=""; - '> -</UL> - -The following variables are available for interpolation (prefixed with new_ or -old_ for replace operations): -<UL> - <LI><code>$username</code> - <LI><code>$_password</code> - <LI><code>$quoted_password</code> - unencrypted password, already quoted for the shell (do not add additional quotes). - <LI><code>$crypt_password</code> - encrypted password. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes). - <LI><code>$ldap_password</code> - Password in LDAP/RFC2307 format (for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or "{MD5}5426824942db4253f87a1009fd5d2d4"). When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes). - <LI><code>$uid</code> - <LI><code>$gid</code> - <LI><code>$finger</code> - GECOS. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes). - <LI><code>$first</code> - First name of GECOS. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes). - <LI><code>$last</code> - Last name of GECOS. When used on the command line (rather than STDIN), it will be quoted for the shell already (do not add additional quotes). - <LI><code>$dir</code> - home directory - <LI><code>$shell</code> - <LI><code>$quota</code> - <LI><code>@radius_groups</code> - <LI><code>$reasonnum (when suspending)</code> - <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 <b>svc_acct</b> are also available. - <LI>The following fields from <b>cust_main</b> are also available (except during replace): company, address1, address2, city, state, zip, county, daytime, night, fax, otaker, agent_custid. When used on the command line (rather than STDIN), they will be quoted for the shell already (do not add additional quotes). -</UL> -END -); - -sub _groups_susp_reason_map { shift->_map('groups_susp_reason'); } - -sub _map { - my $self = shift; - map { reverse(/^\s*(\S+)\s*(.*)\s*$/) } split("\n", $self->option(shift) ); -} - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_suspend { - my($self) = shift; - $self->_export_command_or_super('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command_or_super('unsuspend', @_); -} - -sub _export_command_or_super { - my($self, $action) = (shift, shift); - if ( $self->option($action) =~ /^\s*$/ ) { - my $method = "SUPER::_export_$action"; - $self->$method(@_); - } else { - $self->_export_command($action, @_); - } -}; - -sub _export_command { - my ( $self, $action, $svc_acct) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - my $stdin = $self->option($action."_stdin"); - - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - - # snarfs are unused at this point? - my $count = 1; - foreach my $acct_snarf ( $svc_acct->acct_snarf ) { - ${"snarf_$_$count"} = shell_quote( $acct_snarf->get($_) ) - foreach qw( machine username _password ); - $count++; - } - } - - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - if ( $cust_pkg ) { - no strict 'vars'; - { - no strict 'refs'; - foreach my $custf (qw( company address1 address2 city state zip country - daytime night fax otaker agent_custid - )) - { - ${$custf} = $cust_pkg->cust_main->$custf(); - } - } - $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0]; - } else { - $email = ''; - } - - $finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/; - ($first, $last ) = ( $1, $2 ); - $domain = $svc_acct->domain; - - $quoted_password = shell_quote $_password; - - $crypt_password = $svc_acct->crypt_password( $self->option('crypt') ); - $ldap_password = $svc_acct->ldap_password( $self->option('crypt') ); - - @radius_groups = $svc_acct->radius_groups; - - my ($reasonnum, $reasontext, $reasontypenum, $reasontypetext); - if ( $cust_pkg && $action eq 'suspend' && - (my $r = $cust_pkg->last_reason('susp')) ) - { - $reasonnum = $r->reasonnum; - $reasontext = $r->reason; - $reasontypenum = $r->reason_type; - $reasontypetext = $r->reasontype->type; - - my %reasonmap = $self->_groups_susp_reason_map; - my $userspec = ''; - $userspec = $reasonmap{$reasonnum} - if exists($reasonmap{$reasonnum}); - $userspec = $reasonmap{$reasontext} - if (!$userspec && exists($reasonmap{$reasontext})); - - my $suspend_user; - if ( $userspec =~ /^\d+$/ ) { - $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } ); - } elsif ( $userspec =~ /^\S+\@\S+$/ ) { - my ($username,$domain) = split(/\@/, $userspec); - for my $user (qsearch( 'svc_acct', { 'username' => $username } )){ - $suspend_user = $user if $userspec eq $user->email; - } - } elsif ($userspec) { - $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } ); - } - - @radius_groups = $suspend_user->radius_groups - if $suspend_user; - - } else { - $reasonnum = $reasontext = $reasontypenum = $reasontypetext = ''; - } - - $pkgnum = $cust_pkg ? $cust_pkg->pkgnum : ''; - $custnum = $cust_pkg ? $cust_pkg->custnum : ''; - - my $stdin_string = eval(qq("$stdin")); - - $first = shell_quote $first; - $last = shell_quote $last; - $finger = shell_quote $finger; - $crypt_password = shell_quote $crypt_password; - $ldap_password = shell_quote $ldap_password; - - $company = shell_quote $company; - $address1 = shell_quote $address1; - $address2 = shell_quote $address2; - $city = shell_quote $city; - $state = shell_quote $state; - $zip = shell_quote $zip; - $country = shell_quote $country; - $daytime = shell_quote $daytime; - $night = shell_quote $night; - $fax = shell_quote $fax; - $otaker = shell_quote $otaker; - $agent_custid = shell_quote $agent_custid; - - my $command_string = eval(qq("$command")); - 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 { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - my $stdin = $self->option('usermod_stdin'); - no strict 'vars'; - { - no strict 'refs'; - ${"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; - my $new_cust_main = $new_cust_pkg ? $new_cust_pkg->cust_main : ''; - - $new_finger =~ /^(.*)\s+(\S+)$/ or $new_finger =~ /^((.*))$/; - ($new_first, $new_last ) = ( $1, $2 ); - $quoted_new__password = shell_quote $new__password; #old, wrong? - $new_quoted_password = shell_quote $new__password; #new, better? - $old_domain = $old->domain; - $new_domain = $new->domain; - - $new_crypt_password = $new->crypt_password( $self->option('crypt') ); - $new_ldap_password = $new->ldap_password( $self->option('crypt') ); - - @old_radius_groups = $old->radius_groups; - @new_radius_groups = $new->radius_groups; - - my $error = ''; - if ( $self->option('usermod_pwonly') || $self->option('usermod_nousername') ){ - if ( $old_username ne $new_username ) { - $error ||= "can't change username"; - } - } - if ( $self->option('usermod_pwonly') ) { - if ( $old_domain ne $new_domain ) { - $error ||= "can't change domain"; - } - if ( $old_uid != $new_uid ) { - $error ||= "can't change uid"; - } - if ( $old_gid != $new_gid ) { - $error ||= "can't change gid"; - } - if ( $old_dir ne $new_dir ) { - $error ||= "can't change dir"; - } - #if ( join("\n", sort @old_radius_groups) ne - # join("\n", sort @new_radius_groups) ) { - # $error ||= "can't change RADIUS groups"; - #} - } - return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' - if $error; - - $new_agent_custid = $new_cust_main ? $new_cust_main->agent_custid : ''; - $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 $stdin_string = eval(qq("$stdin")); - - $new_first = shell_quote $new_first; - $new_last = shell_quote $new_last; - $new_finger = shell_quote $new_finger; - $new_crypt_password = shell_quote $new_crypt_password; - $new_ldap_password = shell_quote $new_ldap_password; - $new_agent_custid = shell_quote $new_agent_custid; - - my $command_string = eval(qq("$command")); - - 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 -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm deleted file mode 100644 index d5a6187..0000000 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ /dev/null @@ -1,138 +0,0 @@ -package FS::part_export::shellcommands_withdomain; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::shellcommands; - -@ISA = qw(FS::part_export::shellcommands); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - #default=>'' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, - 'useradd_no_queue' => { label => 'Run immediately', - type => 'checkbox', - }, - 'userdel' => { label=>'Delete command', - #default=>'', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - #default=>'', - }, - 'userdel_no_queue' => { label => 'Run immediately', - type => 'checkbox', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - 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', - }, - 'usermod_nousername' => { label=>'Disallow just username changes', - type =>'checkbox', - }, - 'suspend' => { label=>'Suspension command', - default=>'', - }, - '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', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan)', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH. username@domain (rather than just usernames) are -considered unique (also see shellcommands). You probably want this if the -commands you are running will accept a domain as a parameter, and will allow -the same username with different domains. You will need to -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. - -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI><INPUT TYPE="button" VALUE="vpopmail" onClick=' - this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password"; - this.form.usermod_stdin.value = ""; - this.form.usermod_pwonly.checked = true; - '> - <LI><INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.useradd.value = "/usr/local/ispman/bin/ispman.addUser -d $domain -f $first -l $last -q $quota -p $quoted_password $username"; - this.form.useradd_stdin.value = ""; - this.form.userdel.value = "/usr/local/ispman/bin/ispman.delUser -d $domain $username"; - this.form.userdel_stdin.value=""; - this.form.usermod.value = "/usr/local/ispman/bin/ispman.passwd.user $new_username\\\@$new_domain $new_quoted_password"; - 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 -<code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$username</code> - <LI><code>$domain</code> - <LI><code>$_password</code> - <LI><code>$quoted_password</code> - unencrypted password, already quoted for the shell (do not add additional quotes) - <LI><code>$crypt_password</code> - encrypted password, already quoted for the shell (do not add additional quotes) - <LI><code>$uid</code> - <LI><code>$gid</code> - <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes) - <LI><code>$dir</code> - home directory - <LI><code>$shell</code> - <LI><code>$quota</code> - <LI><code>@radius_groups</code> - <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available. -</UL> -END -); - -1; - diff --git a/FS/FS/part_export/snmp.pm b/FS/FS/part_export/snmp.pm deleted file mode 100644 index 81b3c7e..0000000 --- a/FS/FS/part_export/snmp.pm +++ /dev/null @@ -1,256 +0,0 @@ -package FS::part_export::snmp; - -=head1 FS::part_export::snmp - -This export sends SNMP SETs to a router using the Net::SNMP package. It requires the following custom fields to be defined on a router. If any of the required custom fields are not present, then the export will exit quietly. - -=head1 Required custom fields - -=over 4 - -=item snmp_address - IP address (or hostname) of the router/agent - -=item snmp_comm - R/W SNMP community of the router/agent - -=item snmp_version - SNMP version of the router/agent - -=back - -=head1 Optional custom fields - -=over 4 - -=item snmp_cmd_insert - SNMP SETs to perform on insert. See L</Formatting> - -=item snmp_cmd_replace - SNMP SETs to perform on replace. See L</Formatting> - -=item snmp_cmd_delete - SNMP SETs to perform on delete. See L</Formatting> - -=item snmp_cmd_suspend - SNMP SETs to perform on suspend. See L</Formatting> - -=item snmp_cmd_unsuspend - SNMP SETs to perform on unsuspend. See L</Formatting> - -=back - -=head1 Formatting - -The values for the snmp_cmd_* fields should be formatted as follows: - -<OID>|<Data Type>|<expr>[||<OID>|<Data Type>|<expr>[...]] - -=over 4 - -=item OID - SNMP object ID (ex. 1.3.6.1.4.1.1.20). If the OID string starts with a '.', then the Private Enterprise OID (1.3.6.1.4.1) is prepended. - -=item Data Type - SNMP data types understood by L<Net::SNMP>, as well as HEX_STRING for convenience. ex. INTEGER, OCTET_STRING, IPADDRESS, ... - -=item expr - Expression to be eval'd by freeside. By default, the expression is double quoted and eval'd with all FS::svc_broadband fields available as scalars (ex. $svcnum, $ip_addr, $speed_up). However, if the expression contains a non-escaped double quote, the expression is eval'd without being double quoted. In this case, the expression must be a block of valid perl code that returns the desired value. - -You must escape non-delimiter pipes ("|") with a backslash. - -=back - -=head1 Examples - -This is an example for exporting to a Trango Access5830 AP. Newlines inserted for clarity. - -=over 4 - -=item snmp_cmd_delete - - -1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1| - -=item snmp_cmd_insert - - -1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$radio_addr =~ /[0-9a-fA-F]{2}/g)|| -1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1| - -=item snmp_cmd_replace - - -1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.8|INTEGER|1||1.3.6.1.4.1.5454.1.20.3.5.1|INTEGER|50|| -1.3.6.1.4.1.5454.1.20.3.5.2|HEX_STRING|join("",$new_radio_addr =~ /[0-9a-fA-F]{2}/g)|| -1.3.6.1.4.1.5454.1.20.3.5.7|INTEGER|1| - -=back - -=cut - - -use strict; -use vars qw(@ISA %info $me $DEBUG); -use Tie::IxHash; -use FS::Record qw(qsearch qsearchs); -use FS::part_export; -use FS::part_export::router; - -@ISA = qw(FS::part_export::router); - -tie my %options, 'Tie::IxHash', (); - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Sends SNMP SETs to an SNMP agent.', - 'options' => \%options, - 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::snmp for required virtual fields and usage information.', -); - -$me= '[' . __PACKAGE__ . ']'; -$DEBUG = 1; - - -sub _field_prefix { 'snmp'; } - -sub _req_router_fields { - map { - $_[0]->_field_prefix . '_' . $_ - } (qw(address comm version)); -} - -sub _get_cmd_sub { - - my ($self, $svc_broadband, $router) = (shift, shift, shift); - - return(ref($self) . '::snmp_cmd'); - -} - -sub _prepare_args { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old; - my $field_prefix = $self->_field_prefix; - - if ($action eq 'replace') { $old = shift; } - - my $raw_cmd = $router->getfield("${field_prefix}_cmd_${action}"); - unless ($raw_cmd) { - warn "[debug]$me router custom field '${field_prefix}_cmd_$action' " - . "is not defined." if $DEBUG; - return ''; - } - - my $args = [ - '-hostname' => $router->getfield($field_prefix.'_address'), - '-version' => $router->getfield($field_prefix.'_version'), - '-community' => $router->getfield($field_prefix.'_comm'), - ]; - - my @varbindlist = (); - - foreach my $snmp_cmd ($raw_cmd =~ m/(.*?[^\\])(?:\|\||$)/g) { - - warn "[debug]$me snmp_cmd is '$snmp_cmd'" if $DEBUG; - - my ($oid, $type, $expr) = $snmp_cmd =~ m/(.*?[^\\])(?:\||$)/g; - - if ($oid =~ /^([\d\.]+)$/) { - $oid = $1; - $oid = ($oid =~ /^\./) ? '1.3.6.1.4.1' . $oid : $oid; - } else { - return "Invalid SNMP OID '$oid'"; - } - - if ($type =~ /^([A-Z_\d]+)$/) { - $type = $1; - } else { - return "Invalid SNMP ASN.1 type '$type'"; - } - - if ($expr =~ /^(.*)$/) { - $expr = $1; - } else { - return "Invalid expression '$expr'"; - } - - { - no strict 'vars'; - no strict 'refs'; - - if ($action eq 'replace') { - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr")); - } else { - ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - $expr = ($expr =~/[^\\]"/) ? eval($expr) : eval(qq("$expr")); - } - return $@ if $@; - } - - push @varbindlist, ($oid, $type, $expr); - - } - - push @$args, ('-varbindlist', @varbindlist); - - return('', $args); - -} - -sub snmp_cmd { - eval "use Net::SNMP;"; - die $@ if $@; - - my %args = (); - my @varbindlist = (); - while (scalar(@_)) { - my $key = shift; - if ($key eq '-varbindlist') { - push @varbindlist, @_; - last; - } else { - $args{$key} = shift; - } - } - - my $i = 0; - while ($i*3 < scalar(@varbindlist)) { - my $type_index = ($i*3)+1; - my $type_name = $varbindlist[$type_index]; - - # Implementing HEX_STRING outselves since Net::SNMP doesn't. Ewwww! - if ($type_name eq 'HEX_STRING') { - my $value_index = $type_index + 1; - $type_name = 'OCTET_STRING'; - $varbindlist[$value_index] = pack('H*', $varbindlist[$value_index]); - } - - my $type = eval "Net::SNMP::$type_name"; - if ($@ or not defined $type) { - warn $@ if $DEBUG; - die "snmp_cmd error: Unable to lookup type '$type_name'"; - } - - $varbindlist[$type_index] = $type; - } continue { - $i++; - } - - my ($snmp, $error) = Net::SNMP->session(%args); - die "snmp_cmd error: $error" unless($snmp); - - my $res = $snmp->set_request('-varbindlist' => \@varbindlist); - unless($res) { - $error = $snmp->error; - $snmp->close; - die "snmp_cmd error: " . $error; - } - - $snmp->close; - - return ''; - -} - - -=head1 BUGS - -Plenty, I'm sure. - -=cut - -1; diff --git a/FS/FS/part_export/soma.pm b/FS/FS/part_export/soma.pm deleted file mode 100644 index c73d9f9..0000000 --- a/FS/FS/part_export/soma.pm +++ /dev/null @@ -1,412 +0,0 @@ -package FS::part_export::soma; - -use vars qw(@ISA %info %options $DEBUG); -use Tie::IxHash; -use FS::Record qw(fields dbh); -use FS::part_export; - -@ISA = qw(FS::part_export); -$DEBUG = 1; - -tie %options, 'Tie::IxHash', - 'url' => { label => 'Soma OSS-API url', default=>'https://localhost:8088/ossapi/services' }, - 'data_app_id' => { label => 'SOMA Data Application Id', default => '' }, -; - -my $notes = <<'EOT'; -Real-time export of <b>svc_external</b> and <b>svc_broadband</b> record data -to SOMA Networks <a href="http://www.somanetworks.com">platform</a> via the -OSS-API.<br><br> - -Freeside will attempt to create/delete a cpe for the ESN provided in -svc_external. If a data application id is provided then freeside will -use the values provided in svc_broadband to manage the attributes and -features of that cpe. - -EOT - -%info = ( - 'svc' => [ qw ( svc_broadband svc_external ) ], - 'desc' => 'Real-time export to SOMA platform', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => $notes, -); - -sub _export_insert { - my( $self, $svc ) = ( shift, shift ); - - warn "_export_insert called for service ". $svc->svcnum - if $DEBUG; - - my %args = ( url => $self->option('url'), method => '_queueable_insert' ); - - $args{esn} = $self->esn($svc) or return 'No ESN found!'; - - my $svcdb = $svc->cust_svc->part_svc->svcdb; - $args{svcdb} = $svcdb; - if ( $svcdb eq 'svc_external' ) { - #do nothing - } elsif ( $svcdb eq 'svc_broadband' ){ - $args{data_app_id} = $self->option('data_app_id') - } else { - return "Don't know how to provision $svcdb"; - } - - warn "dispatching statuschange" if $DEBUG; - - eval { statuschange(%args) }; - return $@ if $@; - - ''; -} - -sub _export_delete { - my( $self, $svc ) = ( shift, shift ); - - my %args = ( url => $self->option('url'), method => '_queueable_delete' ); - - $args{esn} = $self->esn($svc) or return 'No ESN found!'; - - my $svcdb = $svc->cust_svc->part_svc->svcdb; - $args{svcdb} = $svcdb; - if ( $svcdb eq 'svc_external' ) { - #do nothing - } elsif ( $svcdb eq 'svc_broadband' ){ - $args{data_app_id} = $self->option('data_app_id') - } else { - return "Don't know how to provision $svcdb"; - } - - eval { statuschange(%args) }; - return $@ if $@; - - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = ( shift, shift, shift ); - - my %args = ( url => $self->option('url'), method => '_queueable_replace' ); - - $args{esn} = $self->esn($old) or return 'No old ESN found!'; - $args{new_esn} = $self->esn($new) or return 'No new ESN found!'; - - my $svcdb = $old->cust_svc->part_svc->svcdb; - $args{svcdb} = $svcdb; - if ( $svcdb eq 'svc_external' ) { - #do nothing - } elsif ( $svcdb eq 'svc_broadband' ){ - $args{data_app_id} = $self->option('data_app_id') - } else { - return "Don't know how to provision $svcdb"; - } - - eval { statuschange(%args) }; - return $@ if $@; - - ''; -} - -sub _export_suspend { - my( $self, $svc ) = ( shift, shift ); - - $self->queue_statuschange('_queueable_suspend', $svc); -} - -sub _export_unsuspend { - my( $self, $svc ) = ( shift, shift ); - - $self->queue_statuschange('_queueable_unsuspend', $svc); -} - -sub queue_statuschange { - my( $self, $method, $svc ) = @_; - - my %args = ( url => $self->option('url'), method => $method ); - - my $svcdb = $svc->cust_svc->part_svc->svcdb; - $args{svcdb} = $svcdb; - if ( $svcdb eq 'svc_external' ) { - #do absolutely nothing - return ''; - } elsif ( $svcdb eq 'svc_broadband' ){ - $args{data_app_id} = $self->option('data_app_id') - } else { - return "Don't know how to provision $svcdb"; - } - - $args{esn} = $self->esn($svc); - - my $queue = new FS::queue { - 'svcnum' => $svc->svcnum, - 'job' => 'FS::part_export::soma::statuschange', - }; - my $error = $queue->insert( %args ); - - return $error if $error; - - ''; - -} - -sub statuschange { # subroutine - my( %options ) = @_; - - warn "statuschange called with options ". - join (', ', map { "$_ => $options{$_}" } keys(%options)) - if $DEBUG; - - my $method = $options{method}; - - eval "use Net::Soma 0.01 qw(ApplicationDef ApplicationInstance - AttributeDef AttributeInstance);"; - die $@ if $@; - - my %soma_objects = (); - foreach my $service ( qw ( CPECollection CPEAccess AppCatalog Applications ) ) - { - $soma_objects{$service} = new Net::Soma ( namespace => $service."Service", - url => $options{'url'}, - die_on_fault => 1, - ); - } - - my $cpeid = eval {$soma_objects{CPECollection}->getCPEByESN( $options{esn} )}; - warn "failed to find CPE with ESN $options{esn}" - if ($DEBUG && !$cpeid); - - if ( $method eq '_queueable_insert' && $options{svcdb} eq 'svc_external' ) { - if ( !$cpeid ) { - # only type 1 is used at this time - $cpeid = $soma_objects{CPECollection}->createCPE( $options{esn}, 1 ); - } else { - $soma_objects{CPECollection}->releaseCPE( $cpeid ); - die "Soma element for $options{esn} already exists"; - } - } - - die "Can't find soma element for $options{esn}" - unless $cpeid; - - warn "dispatching $method from statuschange" if $DEBUG; - &{$method}( \%soma_objects, $cpeid, %options ); - -} - -sub _queueable_insert { - my( $soma_objects, $cpeid, %options ) = @_; - - warn "_queueable_insert called for $cpeid with options ". - join (', ', map { "$_ => $options{$_}" } keys(%options)) - if $DEBUG; - - my $appid = $options{data_app_id}; - if ($appid) { - my $application = - $soma_objects->{AppCatalog} - ->getDefaultApplicationInstance($appid, $cpeid); - - my $attribute = - $soma_objects->{AppCatalog} - ->getDefaultApplicationAttributeInstance(2, 1, $cpeid); - $attribute->value('G'); - - my $i = 0; - foreach my $instance (@{$application->attributes}) { - unless ($instance->definitionId == $attribute->definitionId) { - $i++; next; - } - $application->attributes->[$i] = $attribute; - last; - } - - $soma_objects->{Applications}->subscribeApp( $cpeid, $application ); - } - - $soma_objects->{CPECollection}->releaseCPE( $cpeid ); - - ''; -} - -sub _queueable_delete { - my( $soma_objects, $cpeid, %options ) = @_; - - my $appid = $options{data_app_id}; - my $norelease; - - if ($appid) { - my $applications = - $soma_objects->{Applications}->getSubscribedApplications( $cpeid ); - - my $instance_id; - foreach $application (@$applications) { - next unless $application->definitionId == $appid; - $instance_id = $application->instanceId; - } - - $soma_objects->{Applications}->unsubscribeApp( $cpeid, $instance_id ); - - } else { - - $soma_objects->{CPECollection}->deleteCPE($cpeid); - $norelease = 1; - - } - - $soma_objects->{CPECollection}->releaseCPE( $cpeid ) unless $norelease; - - ''; -} - -sub _queueable_replace { - my( $soma_objects, $cpeid, %options ) = @_; - - my $appid = $options{data_app_id} || ''; - - if (exists($options{data_app_id})) { - my $applications = - $soma_objects->{Applications}->getSubscribedApplications( $cpeid ); - - my $instance_id; - foreach $application (@$applications) { - next unless $application->internalName eq 'dataApplication'; - if ($application->definitionId != $options{data_app_id}) { - $instance_id = $application->instanceId; - $soma_objects->{Applications}->unsubscribeApp( $cpeid, $instance_id ); - } - } - - if ($appid && !$instance_id ) { - my $application = - $soma_objects->{AppCatalog} - ->getDefaultApplicationInstance($appid, $cpeid); - - $soma_objects->{Applications}->subscribeApp( $cpeid, $application ); - } - - } else { - - $soma_objects->{CPEAccess}->switchCPE($cpeid, $options{new_esn}) - unless( $options{new_esn} eq $options{esn}); - - } - - $soma_objects->{CPECollection}->releaseCPE( $cpeid ); - - ''; -} - -sub _queueable_suspend { - my( $soma_objects, $cpeid, %options ) = @_; - - my $appid = $options{data_app_id}; - - if ($appid) { - my $applications = - $soma_objects->{Applications}->getSubscribedApplications( $cpeid ); - - my $instance_id; - foreach $application (@$applications) { - next unless $application->definitionId == $appid; - - $instance_id = $application->instanceId; - my $app_def = - $soma_objects->{AppCatalog}->getApplicationDef($appid, $cpeid); - my @attr_def = grep { $_->internalName eq 'status' } - @{$app_def->attributes}; - - foreach my $attribute ( @{$application->attributes} ) { - next unless $attribute->definitionId == $attr_def[0]->definitionId; - $attribute->{value} = 'S'; - - $soma_objects->{Applications}->setAppAttribute( $cpeid, - $instance_id, - $attribute - ); - } - - } - - } else { - - #do nothing - - } - - $soma_objects->{CPECollection}->releaseCPE( $cpeid ); - - ''; -} - -sub _queueable_unsuspend { - my( $soma_objects, $cpeid, %options ) = @_; - - my $appid = $options{data_app_id}; - - if ($appid) { - my $applications = - $soma_objects->{Applications}->getSubscribedApplications( $cpeid ); - - my $instance_id; - foreach $application (@$applications) { - next unless $application->definitionId == $appid; - - $instance_id = $application->instanceId; - my $app_def = - $soma_objects->{AppCatalog}->getApplicationDef($appid, $cpeid); - my @attr_def = grep { $_->internalName eq 'status' } - @{$app_def->attributes}; - - foreach my $attribute ( @{$application->attributes} ) { - next unless $attribute->definitionId == $attr_def[0]->definitionId; - $attribute->{value} = 'E'; - - $soma_objects->{Applications}->setAppAttribute( $cpeid, - $instance_id, - $attribute - ); - } - - } - - } else { - - #do nothing - - } - - $soma_objects->{CPECollection}->releaseCPE( $cpeid ); - - ''; -} - -sub esn { - my ( $self, $svc ) = @_; - my $svcdb = $svc->cust_svc->part_svc->svcdb; - - if ($svcdb eq 'svc_external') { - my $esn = $svc->title; - $esn =~ /^\s*([\da-fA-F]{1,16})\s*$/ && ($esn = $1); - return sprintf( '%016s', $esn ); - } - - my $cust_pkg = $svc->cust_svc->cust_pkg; - return '' unless $cust_pkg; - - my @cust_svc = grep { $_->part_svc->svcdb eq 'svc_external' && - scalar( $_->part_svc->part_export('soma') ) - } - $cust_pkg->cust_svc; - return '' unless scalar(@cust_svc); - warn "part_export::soma found multiple ESNs for cust_svc ". $svc->svcnum - if scalar( @cust_svc ) > 1; - - my $esn = $cust_svc[0]->svc_x->title; - $esn =~ /^\s*([\da-fA-F]{1,16})\s*$/ && ($esn = $1); - - sprintf( '%016s', $esn ); -} - - -1; diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm deleted file mode 100644 index cbdaf7f..0000000 --- a/FS/FS/part_export/sqlmail.pm +++ /dev/null @@ -1,220 +0,0 @@ -package FS::part_export::sqlmail; - -use vars qw(@ISA %info); -use Tie::IxHash; -use Digest::MD5 qw(md5_hex); -use FS::Record qw(qsearchs); -use FS::part_export; -use FS::svc_domain; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'datasrc' => { label => 'DBI data source' }, - 'username' => { label => 'Database username' }, - 'password' => { label => 'Database password' }, - 'server_type' => { - label => 'Server type', - type => 'select', - options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain - courier_crypt)], - default => ['dovecot_plain'], }, - 'svc_acct_table' => { label => 'User Table', default => 'user_acct' }, - 'svc_forward_table' => { label => 'Forward Table', default => 'forward' }, - 'svc_domain_table' => { label => 'Domain Table', default => 'domain' }, - 'svc_acct_fields' => { label => 'svc_acct Export Fields', - default => 'username _password domsvc svcnum' }, - 'svc_forward_fields' => { label => 'svc_forward Export Fields', - default => 'srcsvc dstsvc dst' }, - 'svc_domain_fields' => { label => 'svc_domain Export Fields', - default => 'domain svcnum catchall' }, - 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)}, - type => 'checkbox' }, -; - -%info = ( - 'svc' => [qw( svc_acct svc_domain svc_forward )], - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%options, - 'nodomain' => '', - 'notes' => <<'END' -Database schema can be made to work with Courier IMAP, Exim and Dovecot. -Others could work but are untested. (more detailed description from -Kristian / fire2wire? ) -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc) = (shift, shift); - # this is a svc_something. - - my $svcdb = $svc->cust_svc->part_svc->svcdb; - my $export_table = $self->option($svcdb . '_table') - or die('Export table not defined for svcdb: ' . $svcdb); - my @export_fields = split(/\s+/, $self->option($svcdb . '_fields')); - my $svchash = update_values($self, $svc, $svcdb); - - foreach my $key (keys(%$svchash)) { - unless (grep { $key eq $_ } @export_fields) { - delete $svchash->{$key}; - } - } - - my $error = $self->sqlmail_queue( $svc->svcnum, 'insert', - $self->option('server_type'), $export_table, - (map { ($_, $svchash->{$_}); } keys(%$svchash))); - return $error if $error; - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - my $svcdb = $new->cust_svc->part_svc->svcdb; - my $export_table = $self->option($svcdb . '_table') - or die('Export table not defined for svcdb: ' . $svcdb); - my @export_fields = split(/\s+/, $self->option($svcdb . '_fields')); - my $svchash = update_values($self, $new, $svcdb); - - foreach my $key (keys(%$svchash)) { - unless (grep { $key eq $_ } @export_fields) { - delete $svchash->{$key}; - } - } - - my $error = $self->sqlmail_queue( $new->svcnum, 'replace', - $old->svcnum, $self->option('server_type'), $export_table, - (map { ($_, $svchash->{$_}); } keys(%$svchash))); - return $error if $error; - ''; - -} - -sub _export_delete { - my( $self, $svc ) = (shift, shift); - - my $svcdb = $svc->cust_svc->part_svc->svcdb; - my $table = $self->option($svcdb . '_table') - or die('Export table not defined for svcdb: ' . $svcdb); - - $self->sqlmail_queue( $svc->svcnum, 'delete', $table, - $svc->svcnum ); -} - -sub sqlmail_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::sqlmail::sqlmail_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ); -} - -sub sqlmail_insert { #subroutine, not method - my $dbh = sqlmail_connect(shift, shift, shift); - my( $server_type, $table ) = (shift, shift); - - my %attrs = @_; - - map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs); - my $query = sprintf("INSERT INTO %s (%s) values (%s)", - $table, join(",", keys(%attrs)), - join(',', values(%attrs))); - - $dbh->do($query) or die $dbh->errstr; - $dbh->disconnect; - - ''; -} - -sub sqlmail_delete { #subroutine, not method - my $dbh = sqlmail_connect(shift, shift, shift); - my( $table, $svcnum ) = @_; - - $dbh->do("DELETE FROM $table WHERE svcnum = $svcnum") or die $dbh->errstr; - $dbh->disconnect; - - ''; -} - -sub sqlmail_replace { - my $dbh = sqlmail_connect(shift, shift, shift); - my($oldsvcnum, $server_type, $table) = (shift, shift, shift); - - my %attrs = @_; - map { $attrs{$_} = $attrs{$_} ? qq!'$attrs{$_}'! : 'NULL'; } keys(%attrs); - - my $query = "SELECT COUNT(*) FROM $table WHERE svcnum = $oldsvcnum"; - my $result = $dbh->selectrow_arrayref($query) or die $dbh->errstr; - - if (@$result[0] == 0) { - $query = sprintf("INSERT INTO %s (%s) values (%s)", - $table, join(",", keys(%attrs)), - join(',', values(%attrs))); - $dbh->do($query) or die $dbh->errstr; - } else { - $query = sprintf('UPDATE %s SET %s WHERE svcnum = %s', - $table, join(', ', map {"$_ = $attrs{$_}"} keys(%attrs)), - $oldsvcnum); - $dbh->do($query) or die $dbh->errstr; - } - - $dbh->disconnect; - - ''; -} - -sub sqlmail_connect { - DBI->connect(@_) or die $DBI::errstr; -} - -sub update_values { - - # Update records to conform to a particular server_type. - - my ($self, $svc, $svcdb) = (shift,shift,shift); - my $svchash = { %{$svc->hashref} } or return ''; # We need a copy. - - if ($svcdb eq 'svc_acct') { - if ($self->option('server_type') eq 'courier_crypt') { - my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64]; - $svchash->{_password} = crypt($svchash->{_password}, $salt); - - } elsif ($self->option('server_type') eq 'dovecot_plain') { - $svchash->{_password} = '{PLAIN}' . $svchash->{_password}; - - } elsif ($self->option('server_type') eq 'dovecot_crypt') { - my $salt = join '', ('.', '/', 0..9,'A'..'Z', 'a'..'z')[rand 64, rand 64]; - $svchash->{_password} = '{CRYPT}' . crypt($svchash->{_password}, $salt); - - } elsif ($self->option('server_type') eq 'dovecot_digest_md5') { - my $svc_domain = qsearchs('svc_domain', { svcnum => $svc->domsvc }); - die('Unable to lookup svc_domain with domsvc: ' . $svc->domsvc) - unless ($svc_domain); - - my $domain = $svc_domain->domain; - my $md5hash = '{DIGEST-MD5}' . md5_hex(join(':', $svchash->{username}, - $domain, $svchash->{_password})); - $svchash->{_password} = $md5hash; - } - } elsif ($svcdb eq 'svc_forward') { - if ($self->option('resolve_dstsvc') && $svc->dstsvc_acct) { - $svchash->{dst} = $svc->dstsvc_acct->username . '@' . - $svc->dstsvc_acct->svc_domain->domain; - } - } - - return($svchash); - -} - -1; - diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm deleted file mode 100644 index 15aa986..0000000 --- a/FS/FS/part_export/sqlradius.pm +++ /dev/null @@ -1,861 +0,0 @@ -package FS::part_export::sqlradius; - -use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2); -use Exporter; -use Tie::IxHash; -use FS::Record qw( dbh qsearch qsearchs str2time_sql ); -use FS::part_export; -use FS::svc_acct; -use FS::export_svc; -use Carp qw( cluck ); - -@ISA = qw(FS::part_export); -@EXPORT_OK = qw( sqlradius_connect ); - -$DEBUG = 0; - -tie %options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source ' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, - 'usergroup' => { label => 'Group table', - type => 'select', - options => [qw( usergroup radusergroup ) ], - }, - 'ignore_accounting' => { - type => 'checkbox', - label => 'Ignore accounting records from this database' - }, - 'process_single_realm' => { - type => 'checkbox', - label => 'Only process one realm of accounting records', - }, - 'realm' => { label => 'The realm of of accounting records to be processed' }, - 'ignore_long_sessions' => { - type => 'checkbox', - label => 'Ignore sessions which span billing periods', - }, - 'hide_ip' => { - type => 'checkbox', - label => 'Hide IP address information on session reports', - }, - 'hide_data' => { - type => 'checkbox', - label => 'Hide download/upload information on session reports', - }, - 'show_called_station' => { - type => 'checkbox', - label => 'Show the Called-Station-ID on session reports', - }, - 'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)', } , - 'groups_susp_reason' => { label => - 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)', - type => 'textarea', - }, - -; - -$notes1 = <<'END'; -Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>/<b>radusergroup</b> -tables to any SQL database for -<a href="http://www.freeradius.org/">FreeRADIUS</a> -or <a href="http://radius.innercite.com/">ICRADIUS</a>. -END - -$notes2 = <<'END'; -An existing RADIUS database will be updated in realtime, but you can use -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Developer/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> -to delete the entire RADIUS database and repopulate the tables from the -Freeside database. See the -<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a> -and the -<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> -for the exact syntax of a DBI data source. -<ul> - <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected. - <li>Using ICRADIUS, add a dummy "op" column to your database: - <blockquote><code> - ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> - ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> - ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> - ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '==' - </code></blockquote> - <li>Using Radiator, see the - <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a> - for configuration information. -</ul> -END - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => $notes1. - 'This export does not export RADIUS realms (see also '. - 'sqlradius_withdomain). '. - $notes2 -); - -sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) } - split( "\n", shift->option('groups_susp_reason')); -} - -sub rebless { shift; } - -sub export_username { - my($self, $svc_acct) = (shift, shift); - warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1; - $svc_acct->username; -} - -sub _export_insert { - my($self, $svc_x) = (shift, shift); - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %attrib = $svc_x->$method(); - next unless keys %attrib; - my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'insert', - $table, $self->export_username($svc_x), %attrib ); - return $err_or_queue unless ref($err_or_queue); - } - my @groups = $svc_x->radius_groups; - if ( @groups ) { - cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum. - " (". $self->export_username($svc_x). " with ". join(", ", @groups) - if $DEBUG; - my $usergroup = $self->option('usergroup') || 'usergroup'; - my $err_or_queue = $self->sqlradius_queue( - $svc_x->svcnum, 'usergroup_insert', - $self->export_username($svc_x), $usergroup, @groups ); - return $err_or_queue unless ref($err_or_queue); - } - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $jobnum = ''; - if ( $self->export_username($old) ne $self->export_username($new) ) { - my $usergroup = $self->option('usergroup') || 'usergroup'; - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', - $self->export_username($new), $self->export_username($old), $usergroup ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - $jobnum = $err_or_queue->jobnum; - } - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %new = $new->$method(); - my %old = $old->$method(); - if ( grep { !exists $old{$_} #new attributes - || $new{$_} ne $old{$_} #changed - } keys %new - ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', - $table, $self->export_username($new), %new ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - my @del = grep { !exists $new{$_} } keys %old; - if ( @del ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', - $table, $self->export_username($new), @del ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - } - - my $error; - my (@oldgroups) = $old->radius_groups; - my (@newgroups) = $new->radius_groups; - $error = $self->sqlreplace_usergroups( $new->svcnum, - $self->export_username($new), - $jobnum ? $jobnum : '', - \@oldgroups, - \@newgroups, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - - my $new = $svc_acct->clone_suspended; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', - 'check', $self->export_username($new), $new->radius_check ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - - my $error; - my (@newgroups) = $self->suspended_usergroups($svc_acct); - $error = - $self->sqlreplace_usergroups( $new->svcnum, - $self->export_username($new), - '', - $svc_acct->usergroup, - \@newgroups, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - 'check', $self->export_username($svc_acct), $svc_acct->radius_check ); - unless ( ref($err_or_queue) ) { - $dbh->rollback if $oldAutoCommit; - return $err_or_queue; - } - - my $error; - my (@oldgroups) = $self->suspended_usergroups($svc_acct); - $error = $self->sqlreplace_usergroups( $svc_acct->svcnum, - $self->export_username($svc_acct), - '', - \@oldgroups, - $svc_acct->usergroup, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_delete { - my( $self, $svc_x ) = (shift, shift); - my $usergroup = $self->option('usergroup') || 'usergroup'; - my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete', - $self->export_username($svc_x), $usergroup ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub sqlradius_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::sqlradius::sqlradius_$method", - }; - $queue->insert( - $self->option('datasrc'), - $self->option('username'), - $self->option('password'), - @_, - ) or $queue; -} - -sub suspended_usergroups { - my ($self, $svc_acct) = (shift, shift); - - return () unless $svc_acct; - - #false laziness with FS::part_export::shellcommands - #subclass part_export? - - my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp'); - my %reasonmap = $self->_groups_susp_reason_map; - my $userspec = ''; - if ($r) { - $userspec = $reasonmap{$r->reasonnum} - if exists($reasonmap{$r->reasonnum}); - $userspec = $reasonmap{$r->reason} - if (!$userspec && exists($reasonmap{$r->reason})); - } - my $suspend_user; - if ($userspec =~ /^d+$/ ){ - $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } ); - }elsif ($userspec =~ /^\S+\@\S+$/){ - my ($username,$domain) = split(/\@/, $userspec); - for my $user (qsearch( 'svc_acct', { 'username' => $username } )){ - $suspend_user = $user if $userspec eq $user->email; - } - }elsif ($userspec){ - $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } ); - } - #esalf - return $suspend_user->radius_groups if $suspend_user; - (); -} - -sub sqlradius_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $table, $username, %attributes ) = @_; - - foreach my $attribute ( keys %attributes ) { - - my $s_sth = $dbh->prepare( - "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?" - ) or die $dbh->errstr; - $s_sth->execute( $username, $attribute ) or die $s_sth->errstr; - - if ( $s_sth->fetchrow_arrayref->[0] ) { - - my $u_sth = $dbh->prepare( - "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?" - ) or die $dbh->errstr; - $u_sth->execute($attributes{$attribute}, $username, $attribute) - or die $u_sth->errstr; - - } else { - - my $i_sth = $dbh->prepare( - "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ". - "VALUES ( ?, ?, ?, ? )" - ) or die $dbh->errstr; - $i_sth->execute( - $username, - $attribute, - ( $attribute eq 'Password' ? '==' : ':=' ), - $attributes{$attribute}, - ) or die $i_sth->errstr; - - } - - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_insert { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my $username = shift; - my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; - my @groups = @_; - - my $s_sth = $dbh->prepare( - "SELECT COUNT(*) FROM $usergroup WHERE UserName = ? AND GroupName = ?" - ) or die $dbh->errstr; - - my $sth = $dbh->prepare( - "INSERT INTO $usergroup ( UserName, GroupName ) VALUES ( ?, ? )" - ) or die $dbh->errstr; - - foreach my $group ( @groups ) { - $s_sth->execute( $username, $group ) or die $s_sth->errstr; - if ($s_sth->fetchrow_arrayref->[0]) { - warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " . - "$group for $username\n" - if $DEBUG; - next; - } - $sth->execute( $username, $group ) - or die "can't insert into groupname table: ". $sth->errstr; - } - if ( $s_sth->{Active} ) { - warn "sqlradius s_sth still active; calling ->finish()"; - $s_sth->finish; - } - if ( $sth->{Active} ) { - warn "sqlradius sth still active; calling ->finish()"; - $sth->finish; - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my $username = shift; - my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; - my @groups = @_; - - my $sth = $dbh->prepare( - "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( $username, $group ) - or die "can't delete from groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_rename { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my($new_username, $old_username) = (shift, shift); - my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; - foreach my $table (qw(radreply radcheck), $usergroup ) { - my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") - or die $dbh->errstr; - $sth->execute($new_username, $old_username) - or die "can't update $table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_attrib_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $table, $username, @attrib ) = @_; - - foreach my $attribute ( @attrib ) { - my $sth = $dbh->prepare( - "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" ) - or die $dbh->errstr; - $sth->execute($username,$attribute) - or die "can't delete from rad$table table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my $username = shift; - my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; - - foreach my $table (qw( radcheck radreply), $usergroup ) { - my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); - $sth->execute($username) - or die "can't delete from $table table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_connect { - #my($datasrc, $username, $password) = @_; - #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; - DBI->connect(@_) or die $DBI::errstr; -} - -sub sqlreplace_usergroups { - my ($self, $svcnum, $username, $jobnum, $old, $new) = @_; - - # (sorta) false laziness with FS::svc_acct::replace - my @oldgroups = @$old; - my @newgroups = @$new; - my @delgroups = (); - foreach my $oldgroup ( @oldgroups ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - push @delgroups, $oldgroup; - } - - my $usergroup = $self->option('usergroup') || 'usergroup'; - - if ( @delgroups ) { - my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete', - $username, $usergroup, @delgroups ); - return $err_or_queue - unless ref($err_or_queue); - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - return $error if $error; - } - } - - if ( @newgroups ) { - cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ". - "with ". join(", ", @newgroups) - if $DEBUG; - my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert', - $username, $usergroup, @newgroups ); - return $err_or_queue - unless ref($err_or_queue); - if ( $jobnum ) { - my $error = $err_or_queue->depend_insert( $jobnum ); - return $error if $error; - } - } - ''; -} - - -#-- - -=item usage_sessions HASHREF - -=item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ] - -New-style: pass a hashref with the following keys: - -=over 4 - -=item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp - -=item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp - -=item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead) - -=item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp - -=item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp - -=item svc_acct - -=item ip - -=item prefix - -=back - -Old-style: - -TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see -L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion -functions. - -SVC_ACCT, if specified, limits the results to the specified account. - -IP, if specified, limits the results to the specified IP address. - -PREFIX, if specified, limits the results to records with a matching -Called-Station-ID. - -#SQL_SELECT defaults to * if unspecified. It can be useful to set it to -#SUM(acctsessiontime) or SUM(AcctInputOctets), etc. - -Returns an arrayref of hashrefs with the following fields: - -=over 4 - -=item username - -=item framedipaddress - -=item acctstarttime - -=item acctstoptime - -=item acctsessiontime - -=item acctinputoctets - -=item acctoutputoctets - -=item calledstationid - -=back - -=cut - -#some false laziness w/cust_svc::seconds_since_sqlradacct - -sub usage_sessions { - my( $self ) = shift; - - my $opt = {}; - my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', ''); - if ( ref($_[0]) ) { - $opt = shift; - $start = $opt->{stoptime_start}; - $end = $opt->{stoptime_end}; - $svc_acct = $opt->{svc_acct}; - $ip = $opt->{ip}; - $prefix = $opt->{prefix}; - } else { - ( $start, $end ) = splice(@_, 0, 2); - $svc_acct = @_ ? shift : ''; - $ip = @_ ? shift : ''; - $prefix = @_ ? shift : ''; - #my $select = @_ ? shift : '*'; - } - - $end ||= 2147483647; - - return [] if $self->option('ignore_accounting'); - - my $dbh = sqlradius_connect( map $self->option($_), - qw( datasrc username password ) ); - - #select a unix time conversion function based on database type - my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); - - my @fields = ( - qw( username realm framedipaddress - acctsessiontime acctinputoctets acctoutputoctets - calledstationid - ), - "$str2time acctstarttime ) as acctstarttime", - "$str2time acctstoptime ) as acctstoptime", - ); - - my @param = (); - my @where = (); - - if ( $svc_acct ) { - my $username = $self->export_username($svc_acct); - if ( $username =~ /^([^@]+)\@([^@]+)$/ ) { - push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )'; - push @param, $username, $1, $2; - } else { - push @where, 'UserName = ?'; - push @param, $username; - } - } - - if ($self->option('process_single_realm')) { - push @where, 'Realm = ?'; - push @param, $self->option('realm'); - } - - if ( length($ip) ) { - push @where, ' FramedIPAddress = ?'; - push @param, $ip; - } - - if ( length($prefix) ) { - #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/ - push @where, " CalledStationID LIKE 'sip:$prefix\%'"; - } - - if ( $start ) { - push @where, "$str2time AcctStopTime ) >= ?"; - push @param, $start; - } - if ( $end ) { - push @where, "$str2time AcctStopTime ) <= ?"; - push @param, $end; - } - if ( $opt->{open_sessions} ) { - push @where, 'AcctStopTime IS NULL'; - } - if ( $opt->{starttime_start} ) { - push @where, "$str2time AcctStartTime ) >= ?"; - push @param, $opt->{starttime_start}; - } - if ( $opt->{starttime_end} ) { - push @where, "$str2time AcctStartTime ) <= ?"; - push @param, $opt->{starttime_end}; - } - - my $where = join(' AND ', @where); - $where = "WHERE $where" if $where; - - my $sth = $dbh->prepare('SELECT '. join(', ', @fields). - " FROM radacct - $where - ORDER BY AcctStartTime DESC - ") or die $dbh->errstr; - $sth->execute(@param) or die $sth->errstr; - - [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ]; - -} - -=item update_svc_acct - -=cut - -sub update_svc { - my $self = shift; - - my $conf = new FS::Conf; - - my $fdbh = dbh; - my $dbh = sqlradius_connect( map $self->option($_), - qw( datasrc username password ) ); - - my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); - my @fields = qw( radacctid username realm acctsessiontime ); - - my @param = (); - my $where = ''; - - my $sth = $dbh->prepare(" - SELECT RadAcctId, UserName, Realm, AcctSessionTime, - $str2time AcctStartTime), $str2time AcctStopTime), - AcctInputOctets, AcctOutputOctets - FROM radacct - WHERE FreesideStatus IS NULL - AND AcctStopTime != 0 - ") or die $dbh->errstr; - $sth->execute() or die $sth->errstr; - - while ( my $row = $sth->fetchrow_arrayref ) { - my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime, - $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row; - warn "processing record: ". - "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s" - if $DEBUG; - - $UserName = lc($UserName) unless $conf->exists('username-uppercase'); - - #my %search = ( 'username' => $UserName ); - - my $extra_sql = ''; - if ( ref($self) =~ /withdomain/ ) { #well... - $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain - WHERE svc_domain.svcnum = svc_acct.domsvc ) "; - } - - my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at - local $FS::UID::AutoCommit = 0; # least we can avoid over counting - - my $status = 'skipped'; - my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ". - "(UserName $UserName, Realm $Realm)"; - - if ( $self->option('process_single_realm') - && $self->option('realm') ne $Realm ) - { - warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG; - } else { - my @svc_acct = - grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum, - 'svcpart' => $_->cust_svc->svcpart, } ) - } - qsearch( 'svc_acct', - { 'username' => $UserName }, - '', - $extra_sql - ); - - if ( !@svc_acct ) { - warn "WARNING: no svc_acct record found $errinfo - skipping\n"; - } elsif ( scalar(@svc_acct) > 1 ) { - warn "WARNING: multiple svc_acct records found $errinfo - skipping\n"; - } else { - - my $svc_acct = $svc_acct[0]; - warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG; - - $svc_acct->last_login($AcctStartTime); - $svc_acct->last_logout($AcctStopTime); - - my $session_time = $AcctStopTime; - $session_time = $AcctStartTime if $self->option('ignore_long_sessions'); - - my $cust_pkg = $svc_acct->cust_svc->cust_pkg; - if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill - || $cust_pkg->setup ) ) { - $status = 'skipped (too old)'; - } else { - my @st; - push @st, _try_decrement($svc_acct, 'seconds', $AcctSessionTime); - push @st, _try_decrement($svc_acct, 'upbytes', $AcctInputOctets); - push @st, _try_decrement($svc_acct, 'downbytes', $AcctOutputOctets); - push @st, _try_decrement($svc_acct, 'totalbytes', $AcctInputOctets - + $AcctOutputOctets); - $status=join(' ', @st); - } - } - } - - warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; - my $psth = $dbh->prepare("UPDATE radacct - SET FreesideStatus = ? - WHERE RadAcctId = ?" - ) or die $dbh->errstr; - $psth->execute($status, $RadAcctId) or die $psth->errstr; - - $fdbh->commit or die $fdbh->errstr if $oldAutoCommit; - - } - -} - -sub _try_decrement { - my ($svc_acct, $column, $amount) = @_; - if ( $svc_acct->$column !~ /^$/ ) { - warn " svc_acct.$column found (". $svc_acct->$column. - ") - decrementing\n" - if $DEBUG; - my $method = 'decrement_' . $column; - my $error = $svc_acct->$method($amount); - die $error if $error; - return 'done'; - } else { - warn " no existing $column value for svc_acct - skipping\n" if $DEBUG; - } - return 'skipped'; -} - -### -#class methods -### - -sub all_sqlradius { - #my $class = shift; - - #don't just look for ->can('usage_sessions'), we're sqlradius-specific - # (radiator is supposed to be setup with a radacct table) - #i suppose it would be more slick to look for things that inherit from us.. - - my @part_export = (); - push @part_export, qsearch('part_export', { 'exporttype' => $_ } ) - foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius ); - @part_export; -} - -sub all_sqlradius_withaccounting { - my $class = shift; - grep { ! $_->option('ignore_accounting') } $class->all_sqlradius; -} - -1; - diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm deleted file mode 100644 index e5a7151..0000000 --- a/FS/FS/part_export/sqlradius_withdomain.pm +++ /dev/null @@ -1,28 +0,0 @@ -package FS::part_export::sqlradius_withdomain; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::sqlradius; - -tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS) with realms', - 'options' => \%options, - 'nodomain' => '', - 'notes' => $FS::part_export::sqlradius::notes1. - 'This export exports domains to RADIUS realms (see also '. - 'sqlradius). '. - $FS::part_export::sqlradius::notes2 -); - -@ISA = qw(FS::part_export::sqlradius); - -sub export_username { - my($self, $svc_acct) = (shift, shift); - $svc_acct->email; -} - -1; - diff --git a/FS/FS/part_export/sysvshell.pm b/FS/FS/part_export/sysvshell.pm deleted file mode 100644 index 244c3bf..0000000 --- a/FS/FS/part_export/sysvshell.pm +++ /dev/null @@ -1,25 +0,0 @@ -package FS::part_export::sysvshell; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export::passwdfile; - -@ISA = qw(FS::part_export::passwdfile); - -tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux, Solaris)', - 'options' => \%options, - 'nodomain' => 'Y', - 'notes' => <<'END' -MD5 crypt requires installation of -<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a> -from CPAN. Run bin/sysvshell.export to export the files. -END -); - -1; - diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm deleted file mode 100644 index 869c7c7..0000000 --- a/FS/FS/part_export/textradius.pm +++ /dev/null @@ -1,191 +0,0 @@ -package FS::part_export::textradius; - -use vars qw(@ISA %info $prefix); -use Fcntl qw(:flock); -use Tie::IxHash; -use FS::UID qw(datasrc); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => - 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', - 'options' => \%options, - 'notes' => <<'END' -This will edit a text RADIUS users file in place on a remote server. -Requires installation of -<a href="http://search.cpan.org/dist/RADIUS-UserFile">RADIUS::UserFile</a> -from CPAN. If using RADIUS::UserFile 1.01, make sure to apply -<a href="http://rt.cpan.org/NoAuth/Bug.html?id=1210">this patch</a>. Also -make sure <a href="http://rsync.samba.org/">rsync</a> is installed on the -remote machine, and <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">SSH is setup for unattended -operation</a>. -END -); - -$prefix = "%%%FREESIDE_CONF%%%/export."; - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, $svc_acct->radius_check, '-', $svc_acct->radius_reply); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't (yet?) change username with textradius" - if $old->username ne $new->username; - #return '' unless $old->_password ne $new->_password; - $err_or_queue = $self->textradius_queue( $new->svcnum, 'insert', - $new->username, $new->radius_check, '-', $new->radius_reply); - ref($err_or_queue) ? '' : $err_or_queue; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $err_or_queue = $self->textradius_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); - ref($err_or_queue) ? '' : $err_or_queue; -} - -#a good idea to queue anything that could fail or take any time -sub textradius_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::textradius::textradius_$method", - }; - $queue->insert( - $self->option('user')||'root', - $self->machine, - $self->option('users'), - @_, - ) or $queue; -} - -sub textradius_insert { #subroutine, not method - my( $user, $host, $users, $username, @attributes ) = @_; - - #silly arg processing - my($att, @check); - push @check, $att while @attributes && ($att=shift @attributes) ne '-'; - my %check = @check; - my %reply = @attributes; - - my $file = textradius_download($user, $host, $users); - - eval "use RADIUS::UserFile;"; - die $@ if $@; - - my $userfile = new RADIUS::UserFile( - File => $file, - Who => [ $username ], - Check_Items => [ keys %check ], - ) or die "error parsing $file"; - - $userfile->remove($username); - $userfile->add( - Who => $username, - Attributes => { %check, %reply }, - Comment => 'user added by Freeside', - ) or die "error adding to $file"; - - $userfile->update( Who => [ $username ] ) - or die "error updating $file"; - - textradius_upload($user, $host, $users); - -} - -sub textradius_delete { #subroutine, not method - my( $user, $host, $users, $username ) = @_; - - my $file = textradius_download($user, $host, $users); - - eval "use RADIUS::UserFile;"; - die $@ if $@; - - my $userfile = new RADIUS::UserFile( - File => $file, - Who => [ $username ], - ) or die "error parsing $file"; - - $userfile->remove($username); - - $userfile->update( Who => [ $username ] ) - or die "error updating $file"; - - textradius_upload($user, $host, $users); -} - -sub textradius_download { - my( $user, $host, $users ) = @_; - - my $dir = $prefix. datasrc; - mkdir $dir, 0700 or die $! unless -d $dir; - $dir .= "/$host"; - mkdir $dir, 0700 or die $! unless -d $dir; - - my $dest = "$dir/users"; - - eval "use File::Rsync;"; - die $@ if $@; - my $rsync = File::Rsync->new({ rsh => 'ssh' }); - - open(LOCK, "+>>$dest.lock") - and flock(LOCK,LOCK_EX) - or die "can't open $dest.lock: $!"; - - $rsync->exec( { - src => "$user\@$host:$users", - dest => $dest, - } ); # true/false return value from exec is not working, alas - if ( $rsync->err ) { - die "error downloading $user\@$host:$users : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); - } - - $dest; -} - -sub textradius_upload { - my( $user, $host, $users ) = @_; - - my $dir = $prefix. datasrc. "/$host"; - - eval "use File::Rsync;"; - die $@ if $@; - my $rsync = File::Rsync->new({ - rsh => 'ssh', - #dry_run => 1, - }); - $rsync->exec( { - src => "$dir/users", - dest => "$user\@$host:$users", - } ); # true/false return value from exec is not working, alas - if ( $rsync->err ) { - die "error uploading to $user\@$host:$users : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); - } - - flock(LOCK,LOCK_UN); - close LOCK; - -} - -1; - diff --git a/FS/FS/part_export/thirdlane.pm b/FS/FS/part_export/thirdlane.pm deleted file mode 100644 index 60c0997..0000000 --- a/FS/FS/part_export/thirdlane.pm +++ /dev/null @@ -1,348 +0,0 @@ -package FS::part_export::thirdlane; - -use base qw( FS::part_export ); - -use vars qw(%info $me); -use Tie::IxHash; -use URI::Escape; -use Frontier::Client; - -$me = '['.__PACKAGE__.']'; - -tie my %options, 'Tie::IxHash', - #'server' => { label => 'Thirdlane server name or IP address', }, - 'username' => { label => 'Thirdlane username', }, - 'password' => { label => 'Thirdlane password', }, - 'ssl' => { label => 'Enable HTTPS (SSL) connection', - type => 'checkbox', - }, - 'port' => { label => 'Port number if not 80 or 443', }, - 'prototype_tenant' => { label => 'Prototype tenant name', }, - 'omit_countrycode' => { label => 'Omit country code', type => 'checkbox' }, - 'debug' => { label => 'Checkbox label', type => 'checkbox' }, -# 'select_option' => { label => 'Select option description', -# type => 'select', options=>[qw(chocolate vanilla)], -# default => 'vanilla', -# }, -# 'textarea_option' => { label => 'Textarea option description', -# type => 'textarea', -# default => 'Default text.', -# }, -; - -%info = ( - 'svc' => [qw( svc_pbx svc_phone svc_acct )], - 'desc' => - 'Export tenants, DIDs and admins to Thirdlane PBX manager', - 'options' => \%options, - 'notes' => <<'END' -Exports tenants, DIDs and admins to Thirdlane PBX manager using the XML-RPC API. -END -); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_x) = (shift, shift); - - if ( $svc_x->isa('FS::svc_pbx') ) { - - return 'Name must be 19 characters or less (thirdlane restriction?)' - if length($svc_x->title) > 19; - - return 'Name must consist of alphanumerics and spaces only (thirdlane restriction?)' - unless $svc_x->title =~ /^[\w\s]+$/; - - my $tenant = { - 'tenant' => $svc_x->title, - 'maxusers' => $svc_x->max_extensions, - #others? will they not clone? - }; - - @what_to_clone = qw(routes schedules menus queues voiceprompts moh); - - my $result = $self->_thirdlane_command( 'asterisk::rpc_tenant_create', - $tenant, - $self->option('prototype_tenant'), - \@what_to_clone, - ); - - #use Data::Dumper; - #warn Dumper(\$result); - $result eq '0' ? '' : 'Thirdlane API failure (rpc_tenant_create)'; - - } elsif ( $svc_x->isa('FS::svc_phone') ) { - - my $result = $self->_thirdlane_command( - 'asterisk::rpc_did_create', - $self->_thirdlane_did($svc_x) - ); - - #use Data::Dumper; - #warn Dumper(\$result); - $result eq '0' or return 'Thirdlane API failure (rpc_did_create)'; - - return '' unless $svc_x->pbxsvc; - - $result = $self->_thirdlane_command( - 'asterisk::rpc_did_assign', - $self->_thirdlane_did($svc_x), - $svc_x->pbx_title, - ); - - #use Data::Dumper; - #warn Dumper(\$result); - $result eq '0' ? '' : 'Thirdlane API failure (rpc_did_assign)'; - - } elsif ( $svc_x->isa('FS::svc_acct') ) { - - return 'Must select a PBX' unless $svc_x->pbxsvc; - - my $result = $self->_thirdlane_command( - 'asterisk::rpc_admin_create', - $svc_x->username, - $svc_x->_password, - $svc_x->pbx_title, - ); - - #use Data::Dumper; - #warn Dumper(\$result); - $result eq '0' ? '' : 'Thirdlane API failure (rpc_admin_create)'; - - } else { - die "guru meditation #10: $svc_x is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; - } - -} - -sub _export_replace { - my($self, $new, $old) = (shift, shift, shift); - -# #return "can't change username with thirdlane" -# # if $old->username ne $new->username; -# #return '' unless $old->_password ne $new->_password; -# $err_or_queue = $self->thirdlane_queue( $new->svcnum, -# 'replace', $new->username, $new->_password ); -# ref($err_or_queue) ? '' : $err_or_queue; - - if ( $new->isa('FS::svc_pbx') ) { - - #need more info on how the API works for changing names.. can it? - return "can't change PBX name with thirdlane (yet?)" - if $old->title ne $new->title; - - my $tenant = { - 'tenant' => $old->title, - 'maxusers' => $new->max_extensions, - #others? will they not clone? - }; - - my $result = $self->_thirdlane_command( 'asterisk::rpc_tenant_update', - $tenant - ); - - #use Data::Dumper; - #warn Dumper(\$result); - $result eq '0' ? '' : 'Thirdlane API failure (rpc_tenant_update)'; - - } elsif ( $new->isa('FS::svc_phone') ) { - - return "can't change DID countrycode with thirdlane" - if $old->countrycode ne $new->countrycode; - return "can't change DID number with thirdlane" - if $old->phonenum ne $new->phonenum; - - if ( $old->pbxsvc != $new->pbxsvc ) { - - if ( $old->pbxsvc ) { - my $result = $self->_thirdlane_command( - 'asterisk::rpc_did_unassign', - $self->_thirdlane_did($old), - ); - $result eq '0' or return 'Thirdlane API failure (rpc_did_unassign)'; - } - - if ( $new->pbxsvc ) { - my $result = $self->_thirdlane_command( - 'asterisk::rpc_did_assign', - $self->_thirdlane_did($new), - $new->pbx_title, - ); - $result eq '0' or return 'Thirdlane API failure (rpc_did_assign)'; - } - - - } - - ''; - - } elsif ( $new->isa('FS::svc_acct') ) { - - return "can't change uesrname with thirdlane" - if $old->username ne $new->username; - - return "can't change password with thirdlane" - if $old->_password ne $new->_password; - - return "can't change PBX for user with thirdlane" - if $old->pbxsvc != $new->pbxsvc; - - ''; #we don't care then - - } else { - die "guru meditation #11: $new is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; - } - -} - -sub _export_delete { - my($self, $svc_x) = (shift, shift); - #my( $self, $svc_something ) = (shift, shift); - #$err_or_queue = $self->thirdlane_queue( $svc_something->svcnum, - # 'delete', $svc_something->username ); - #ref($err_or_queue) ? '' : $err_or_queue; - - if ( $svc_x->isa('FS::svc_pbx') ) { - - my $result = $self->_thirdlane_command( 'asterisk::rpc_tenant_delete', - $svc_x->title, - ); - - #use Data::Dumper; - #warn Dumper(\$result); - #$result eq '0' ? '' : 'Thirdlane API failure (rpc_tenant_delete)'; - warn "Thirdlane API failure (rpc_tenant_delete); deleting anyway\n" - if $result ne '0'; - ''; - - } elsif ( $svc_x->isa('FS::svc_phone') ) { - - if ( $svc_x->pbxsvc ) { - my $result = $self->_thirdlane_command( - 'asterisk::rpc_did_unassign', - $self->_thirdlane_did($svc_x), - ); - $result eq '0' or return 'Thirdlane API failure (rpc_did_unassign)'; - } - - my $result = $self->_thirdlane_command( - 'asterisk::rpc_did_delete', - $self->_thirdlane_did($svc_x), - ); - $result eq '0' ? '' : 'Thirdlane API failure (rpc_did_delete)'; - - } elsif ( $svc_x->isa('FS::svc_acct') ) { - - return '' unless $svc_x->pbxsvc; #error out? nah - - my $result = $self->_thirdlane_command( - 'asterisk::rpc_admin_delete', - $svc_x->username, - $svc_x->pbx_title, - ); - - #use Data::Dumper; - #warn Dumper(\$result); - #$result eq '0' ? '' : 'Thirdlane API failure (rpc_admin_delete)'; - warn "Thirdlane API failure (rpc_admin_delete); deleting anyway\n" - if $result ne '0'; - ''; - - } else { - die "guru meditation #12: $svc_x is not FS::svc_pbx, FS::svc_phone or FS::svc_acct"; - } - -} - -sub _thirdlane_command { - my($self, @param) = @_; - - my $url = $self->option('ssl') ? 'https://' : 'http://'; - $url .= uri_escape($self->option('username')). ':'. - uri_escape($self->option('password')). '@'. - $self->machine; - $url .= ':'. $self->option('port') if $self->option('port'); - $url .= '/xmlrpc.cgi'; - - warn "$me connecting to $url\n" - if $self->option('debug'); - my $conn = Frontier::Client->new( 'url' => $url, - #no, spews output to browser - #'debug' => $self->option('debug'), - ); - - warn "$me sending command: ". join(' ', @param). "\n" - if $self->option('debug'); - $conn->call(@param); - -} - -sub _thirdlane_did { - my($self, $svc_phone) = @_; - if ( $self->option('omit_countrycode') ) { - $svc_phone->phonenum; - } else { - $svc_phone->countrycode. $svc_phone->phonenum; - } -} - - #my( $self, $svc_something ) = (shift, shift); - #$err_or_queue = $self->thirdlane_queue( $svc_something->svcnum, - # 'delete', $svc_something->username ); - #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->thirdlane_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->thirdlane_queue( $svc_something->svcnum, -# 'unsuspend', $svc_something->username ); -# ref($err_or_queue) ? '' : $err_or_queue; -#} -# -#sub export_links { -# my($self, $svc_something, $arrayref) = (shift, shift, shift); -# #push @$arrayref, qq!<A HREF="http://example.com/~!. $svc_something->username. -# # qq!">!. $svc_something->username. qq!</A>!; -# ''; -#} - -#### -# -##a good idea to queue anything that could fail or take any time -#sub thirdlane_queue { -# my( $self, $svcnum, $method ) = (shift, shift, shift); -# my $queue = new FS::queue { -# 'svcnum' => $svcnum, -# 'job' => "FS::part_export::thirdlane::thirdlane_$method", -# }; -# $queue->insert( @_ ) or $queue; -#} -# -#sub thirdlane_insert { #subroutine, not method -# my( $username, $password ) = @_; -# #do things with $username and $password -#} -# -#sub thirdlane_replace { #subroutine, not method -#} -# -#sub thirdlane_delete { #subroutine, not method -# my( $username ) = @_; -# #do things with $username -#} -# -#sub thirdlane_suspend { #subroutine, not method -#} -# -#sub thirdlane_unsuspend { #subroutine, not method -#} - -1; diff --git a/FS/FS/part_export/trango.pm b/FS/FS/part_export/trango.pm deleted file mode 100644 index e7f1126..0000000 --- a/FS/FS/part_export/trango.pm +++ /dev/null @@ -1,434 +0,0 @@ -package FS::part_export::trango; - -=head1 FS::part_export::trango - -This export sends SNMP SETs to a router using the Net::SNMP package. It requires the following custom fields to be defined on a router. If any of the required custom fields are not present, then the export will exit quietly. - -=head1 Required custom fields - -=over 4 - -=item trango_address - IP address (or hostname) of the Trango AP. - -=item trango_comm - R/W SNMP community of the Trango AP. - -=item trango_ap_type - Trango AP Model. Currently 'access5830' is the only supported option. - -=back - -=head1 Optional custom fields - -=over 4 - -=item trango_baseid - Base ID of the Trango AP. See L</"Generating SU IDs">. - -=item trango_apid - AP ID of the Trango AP. See L</"Generating SU IDs">. - -=back - -=head1 Generating SU IDs - -This export will/must generate a unique SU ID for each service exported to a Trango AP. It can be done such that SU IDs are globally unique, unique per Base ID, or unique per Base ID/AP ID pair. This is accomplished by setting neither trango_baseid and trango_apid, only trango_baseid, or both trango_baseid and trango_apid, respectively. An SU ID will be generated if the FS::svc_broadband virtual field specified by suid_field export option is unset, otherwise the existing value will be used. - -=head1 Device Support - -This export has been tested with the Trango Access5830 AP. - - -=cut - - -use strict; -use vars qw(@ISA %info $me $DEBUG $trango_mib $counter_dir); - -use FS::UID qw(dbh datasrc); -use FS::Record qw(qsearch qsearchs); -use FS::part_export::snmp; - -use Tie::IxHash; -use File::CounterFile; -use Data::Dumper qw(Dumper); - -@ISA = qw(FS::part_export::snmp); - -tie my %options, 'Tie::IxHash', ( - 'suid_field' => { - 'label' => 'Trango SU ID field', - 'default' => 'trango_suid', - 'notes' => 'Name of the FS::svc_broadband virtual field that will contain the SU ID.', - }, - 'mac_field' => { - 'label' => 'Trango MAC address field', - 'default' => '', - 'notes' => 'Name of the FS::svc_broadband virtual field that will contain the SU\'s MAC address.', - }, -); - -%info = ( - 'svc' => 'svc_broadband', - 'desc' => 'Sends SNMP SETs to a Trango AP.', - 'options' => \%options, - 'notes' => 'Requires Net::SNMP. See the documentation for FS::part_export::trango for required virtual fields and usage information.', -); - -$me= '[' . __PACKAGE__ . ']'; -$DEBUG = 1; - -$trango_mib = { - 'access5830' => { - 'snmpversion' => 'snmpv1', - 'varbinds' => { - 'insert' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbAddMac - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2', - 'type' => 'HEX_STRING', - 'value' => \&_trango_access5830_sudbAddMac, - }, - { # sudbAddSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'delete' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbDeleteSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'replace' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbDeleteSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8', - 'type' => 'INTEGER', - 'value' => 1, - }, - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbAddMac - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2', - 'type' => 'HEX_STRING', - 'value' => \&_trango_access5830_sudbAddMac, - }, - { # sudbAddSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'suspend' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbDeleteSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.8', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - 'unsuspend' => [ - { # sudbDeleteOrAddID - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.1', - 'type' => 'INTEGER', - 'value' => \&_trango_access5830_sudbDeleteOrAddId, - }, - { # sudbAddMac - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.2', - 'type' => 'HEX_STRING', - 'value' => \&_trango_access5830_sudbAddMac, - }, - { # sudbAddSU - 'oid' => '1.3.6.1.4.1.5454.1.20.3.5.7', - 'type' => 'INTEGER', - 'value' => 1, - }, - ], - }, - }, -}; - - -sub _field_prefix { 'trango'; } - -sub _req_router_fields { - map { - $_[0]->_field_prefix . '_' . $_ - } (qw(address comm ap_type suid_field)); -} - -sub _get_cmd_sub { - - return('FS::part_export::snmp::snmp_cmd'); - -} - -sub _prepare_args { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old = shift if $action eq 'replace'; - my $field_prefix = $self->_field_prefix; - my $error; - - my $ap_type = $router->getfield($field_prefix . '_ap_type'); - - unless (exists $trango_mib->{$ap_type}) { - return "Unsupported Trango AP type '$ap_type'"; - } - - $error = $self->_check_suid( - $action, $router, $svc_broadband, ($old) ? $old : () - ); - return $error if $error; - - $error = $self->_check_mac( - $action, $router, $svc_broadband, ($old) ? $old : () - ); - return $error if $error; - - my $ap_mib = $trango_mib->{$ap_type}; - - my $args = [ - '-hostname' => $router->getfield($field_prefix.'_address'), - '-version' => $ap_mib->{'snmpversion'}, - '-community' => $router->getfield($field_prefix.'_comm'), - ]; - - my @varbindlist = (); - - foreach my $oid (@{$ap_mib->{'varbinds'}->{$action}}) { - warn "[debug]$me Processing OID '" . $oid->{'oid'} . "'" if $DEBUG; - my $value; - if (ref($oid->{'value'}) eq 'CODE') { - eval { - $value = &{$oid->{'value'}}( - $self, $action, $router, $svc_broadband, - (($old) ? $old : ()), - ); - }; - return "While processing OID '" . $oid->{'oid'} . "':" . $@ - if $@; - } else { - $value = $oid->{'value'}; - } - - warn "[debug]$me Value for OID '" . $oid->{'oid'} . "': " if $DEBUG; - - if (defined $value) { # Skip OIDs with undefined values. - push @varbindlist, ($oid->{'oid'}, $oid->{'type'}, $value); - } - } - - - push @$args, ('-varbindlist', @varbindlist); - - return('', $args); - -} - -sub _check_suid { - - my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift); - my $old = shift if $action eq 'replace'; - my $error; - - my $suid_field = $self->option('suid_field'); - unless (grep {$_ eq $suid_field} $svc_broadband->fields) { - return "Missing Trango SU ID field. " - . "See the trango export options for more info."; - } - - my $suid = $svc_broadband->getfield($suid_field); - if ($action eq 'replace') { - my $old_suid = $old->getfield($suid_field); - - if ($old_suid ne '' and $old_suid ne $suid) { - return 'Cannot change Trango SU ID'; - } - } - - if (not $suid =~ /^\d+$/ and $action ne 'delete') { - my $new_suid = eval { $self->_get_next_suid($router); }; - return "Error while getting next Trango SU ID: $@" if ($@); - - warn "[debug]$me Got new SU ID: $new_suid" if $DEBUG; - $svc_broadband->set($suid_field, $new_suid); - - #FIXME: Probably a bad hack. - # We need to update the SU ID field in the database. - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::svc_Common::noexport_hack = 1; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $svcnum = $svc_broadband->svcnum; - - my $old_svc = qsearchs('svc_broadband', { svcnum => $svcnum }); - unless ($old_svc) { - return "Unable to retrieve svc_broadband with svcnum '$svcnum"; - } - - my $svcpart = $svc_broadband->svcpart - ? $svc_broadband->svcpart - : $svc_broadband->cust_svc->svcpart; - - my $new_svc = new FS::svc_broadband { - $old_svc->hash, - $suid_field => $new_suid, - svcpart => $svcpart, - }; - - $error = $new_svc->check; - if ($error) { - $dbh->rollback if $oldAutoCommit; - return "Error while updating the Trango SU ID: $error" if $error; - } - - warn "[debug]$me Updating svc_broadband with SU ID '$new_suid'...\n" . - &Dumper($new_svc) if $DEBUG; - - $error = eval { $new_svc->replace($old_svc); }; - - if ($@ or $error) { - $error ||= $@; - $dbh->rollback if $oldAutoCommit; - return "Error while updating the Trango SU ID: $error" if $error; - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - } - - return ''; - -} - -sub _check_mac { - - my ($self, $action, $router, $svc_broadband) = (shift, shift, shift, shift); - my $old = shift if $action eq 'replace'; - - my $mac_field = $self->option('mac_field'); - unless (grep {$_ eq $mac_field} $svc_broadband->fields) { - return "Missing Trango MAC address field. " - . "See the trango export options for more info."; - } - - my $mac_addr = $svc_broadband->getfield($mac_field); - unless (length(join('', $mac_addr =~ /[0-9a-fA-F]/g)) == 12) { - return "Invalid Trango MAC address: $mac_addr"; - } - - return(''); - -} - -sub _get_next_suid { - - my ($self, $router) = (shift, shift); - - my $counter_dir = '/usr/local/etc/freeside/export.'. datasrc . '/trango'; - my $baseid = $router->getfield('trango_baseid'); - my $apid = $router->getfield('trango_apid'); - - my $counter_file_suffix = ''; - if ($baseid ne '') { - $counter_file_suffix .= "_B$baseid"; - if ($apid ne '') { - $counter_file_suffix .= "_A$apid"; - } - } - - my $counter_file = $counter_dir . '/SUID' . $counter_file_suffix; - - warn "[debug]$me Using SUID counter file '$counter_file'"; - - my $suid = eval { - mkdir $counter_dir, 0700 unless -d $counter_dir; - - my $cf = new File::CounterFile($counter_file, 0); - $cf->inc; - }; - - die "Error generating next Trango SU ID: $@" if (not $suid or $@); - - return($suid); - -} - - - -# Trango-specific subroutines for generating varbind values. -# -# All subs should die on error, and return undef to decline. OIDs that -# decline will not be added to varbinds. - -sub _trango_access5830_sudbDeleteOrAddId { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old = shift if $action eq 'replace'; - - my $suid = $svc_broadband->getfield($self->option('suid_field')); - - # Sanity check. - unless ($suid =~ /^\d+$/) { - if ($action eq 'delete') { - # Silently ignore. If we don't have a valid SU ID now, we probably - # never did. - return undef; - } else { - die "Invalid Trango SU ID '$suid'"; - } - } - - return ($suid); - -} - -sub _trango_access5830_sudbAddMac { - - my ($self, $action, $router) = (shift, shift, shift); - my ($svc_broadband) = shift; - my $old = shift if $action eq 'replace'; - - my $mac_addr = $svc_broadband->getfield($self->option('mac_field')); - $mac_addr = join('', $mac_addr =~ /[0-9a-fA-F]/g); - - # Sanity check. - die "Invalid Trango MAC address '$mac_addr'" unless (length($mac_addr)==12); - - return($mac_addr); - -} - - -=head1 BUGS - -Plenty, I'm sure. - -=cut - - -1; diff --git a/FS/FS/part_export/vitelity.pm b/FS/FS/part_export/vitelity.pm deleted file mode 100644 index 7803b3f..0000000 --- a/FS/FS/part_export/vitelity.pm +++ /dev/null @@ -1,250 +0,0 @@ -package FS::part_export::vitelity; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::Record qw(qsearch dbh); -use FS::part_export; -use FS::phone_avail; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'login' => { label=>'Vitelity API login' }, - 'pass' => { label=>'Vitelity API password' }, - 'dry_run' => { label=>"Test mode - don't actually provision" }, - 'routesip' => { label=>'routesip (optional sub-account)' }, - 'type' => { label=>'type (optional DID type to order)' }, -; - -%info = ( - 'svc' => 'svc_phone', - 'desc' => 'Provision phone numbers to Vitelity', - 'options' => \%options, - 'notes' => <<'END' -Requires installation of -<a href="http://search.cpan.org/dist/Net-Vitelity">Net::Vitelity</a> -from CPAN. -<br><br> -routesip - optional Vitelity sub-account to which newly ordered DIDs will be routed -<br>type - optional DID type (perminute, unlimited, or your-pri) -END -); - -sub rebless { shift; } - -sub get_dids { - my $self = shift; - my %opt = ref($_[0]) ? %{$_[0]} : @_; - -# currently one of three cases: areacode+exchange, areacode, state -# name == ratecenter - - my %search = (); - - my $method = ''; - - if ( $opt{'areacode'} && $opt{'exchange'} ) { #return numbers in format NPA-NXX-XXXX - - return [ - map { join('-', $_->npa, $_->nxx, $_->station ) } - qsearch({ - 'table' => 'phone_avail', - 'hashref' => { 'exportnum' => $self->exportnum, - 'countrycode' => '1', # vitelity is US/CA only now - 'npa' => $opt{'areacode'}, - 'nxx' => $opt{'exchange'}, - }, - 'order_by' => 'ORDER BY station', - }) - ]; - - } elsif ( $opt{'areacode'} ) { #return exchanges in format NPA-NXX- literal 'XXXX' - - # you can't call $->name .... that returns "(unlinked)" - # and in any case this is still major abuse of encapsulation, it just happens to work for the other fields - return [ - map { $_->{'Hash'}->{name}.' ('. $_->npa. '-'. $_->nxx. '-XXXX)' } - qsearch({ - # i know this doesn't do the same thing as before, but now the sort works - 'select' => 'DISTINCT npa,nxx,name', - 'table' => 'phone_avail', - 'hashref' => { 'exportnum' => $self->exportnum, - 'countrycode' => '1', # vitelity is US/CA only now - 'npa' => $opt{'areacode'}, - }, - 'order_by' => 'ORDER BY nxx', - }) - ]; - - } elsif ( $opt{'state'} ) { #and not other things, then return areacode - - #XXX need to flush the cache at some point :/ - - my @avail = qsearch({ - 'select' => 'DISTINCT npa', - 'table' => 'phone_avail', - 'hashref' => { 'exportnum' => $self->exportnum, - 'countrycode' => '1', # vitelity is US/CA only now - 'state' => $opt{'state'}, - }, - 'order_by' => 'ORDER BY npa', - }); - - return [ map $_->npa, @avail ] if @avail; #return cached area codes instead - - #otherwise, search for em - - my @ratecenters = $self->vitelity_command( 'listavailratecenters', - 'state' => $opt{'state'}, - ); - # XXX: Options: type=unlimited OR type=pri - - if ( $ratecenters[0] eq 'unavailable' ) { - return []; - } elsif ( $ratecenters[0] eq 'missingdata' ) { - die "missingdata error running Vitelity API"; #die? - } - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $errmsg = 'WARNING: error populating phone availability cache: '; - - my %npa = (); - foreach my $ratecenter (@ratecenters) { - - my @dids = $self->vitelity_command( 'listlocal', - 'state' => $opt{'state'}, - 'ratecenter' => $ratecenter, - ); - # XXX: Options: type=unlimited OR type=pri - - if ( $dids[0] eq 'unavailable' ) { - next; - } elsif ( $dids[0] eq 'missingdata' ) { - die "missingdata error running Vitelity API"; #die? - } - - foreach my $did ( @dids ) { - $did =~ /^(\d{3})(\d{3})(\d{4}),/ or die "unparsable did $did\n"; - my($npa, $nxx, $station) = ($1, $2, $3); - $npa{$npa}++; - - my $phone_avail = new FS::phone_avail { - 'exportnum' => $self->exportnum, - 'countrycode' => '1', # vitelity is US/CA only now - 'state' => $opt{'state'}, - 'npa' => $npa, - 'nxx' => $nxx, - 'station' => $station, - 'name' => $ratecenter, - }; - - $error = $phone_avail->insert(); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - die $errmsg.$error; - } - - } - - } - - $dbh->commit or warn $errmsg.$dbh->errstr if $oldAutoCommit; - - my @return = sort { $a <=> $b } keys %npa; - #@return = sort { (split(' ', $a))[0] <=> (split(' ', $b))[0] } @return; - - return \@return; - - } else { - die "get_dids called without state or areacode options"; - } - -} - -sub vitelity_command { - my( $self, $command, @args ) = @_; - - eval "use Net::Vitelity;"; - die $@ if $@; - - my $vitelity = Net::Vitelity->new( - 'login' => $self->option('login'), - 'pass' => $self->option('pass'), - #'debug' => $debug, - ); - - $vitelity->$command(@args); -} - -sub _export_insert { - my( $self, $svc_phone ) = (shift, shift); - - return '' if $self->option('dry_run'); - - #we want to provision and catch errors now, not queue - - %vparams = ( 'did' => $svc_phone->phonenum ); - $vparams{'routesip'} = $self->option('routesip') - if defined $self->option('routesip'); - $vparams{'type'} = $self->option('type') - if defined $self->option('type'); - - my $result = $self->vitelity_command('getlocaldid',%vparams); - - if ( $result ne 'success' ) { - return "Error running Vitelity getlocaldid: $result"; - } - - ''; -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - #hmm, what's to change? - ''; -} - -sub _export_delete { - my( $self, $svc_phone ) = (shift, shift); - - return '' if $self->option('dry_run'); - - #probably okay to queue the deletion...? - #but hell, let's do it inline anyway, who wants phone numbers hanging around - - my $result = $self->vitelity_command('removedid', - 'did' => $svc_phone->phonenum, - ); - - if ( $result ne 'success' ) { - return "Error running Vitelity getlocaldid: $result"; - } - - ''; -} - -sub _export_suspend { - my( $self, $svc_phone ) = (shift, shift); - #nop for now - ''; -} - -sub _export_unsuspend { - my( $self, $svc_phone ) = (shift, shift); - #nop for now - ''; -} - -1; - diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm deleted file mode 100644 index 799a8e1..0000000 --- a/FS/FS/part_export/vpopmail.pm +++ /dev/null @@ -1,254 +0,0 @@ -package FS::part_export::vpopmail; - -use vars qw(@ISA %info @saltset $exportdir); -use Fcntl qw(:flock); -use Tie::IxHash; -use File::Path; -use FS::UID qw( datasrc ); -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - #'machine' => { label=>'vpopmail machine', }, - 'dir' => { label=>'directory', }, # ?more info? default? - 'uid' => { label=>'vpopmail uid' }, - 'gid' => { label=>'vpopmail gid' }, - 'restart' => { label=> 'vpopmail restart command', - default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to vpopmail text files', - 'options' => \%options, - 'notes' => <<'END' -This export is currently unmaintained. See shellcommands_withdomain for an -export that uses vpopmail CLI commands instead.<BR> -<BR> -Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text -files. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> -must be installed, and you will need to -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a> -to <b>vpopmail</b>@<i>export.host</i>. -END -); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - $self->vpopmail_queue( $svc_acct->svcnum, 'insert', - $svc_acct->username, - crypt($svc_acct->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), - $svc_acct->domain, - $svc_acct->quota, - $svc_acct->finger, - ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - my $cpassword = crypt( - $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] - ); - - return "can't change username with vpopmail" - if $old->username ne $new->username; - - #no.... if mail can't be preserved, better to disallow username changes - #if ($old->username ne $new->username || $old->domain ne $new->domain ) { - # vpopmail_queue( $svc_acct->svcnum, 'delete', - # $old->username, $old->domain - # ); - # vpopmail_queue( $svc_acct->svcnum, 'insert', - # $new->username, - # $cpassword, - # $new->domain, - # ); - - return '' unless $old->_password ne $new->_password; - - $self->vpopmail_queue( $new->svcnum, 'replace', - $new->username, $cpassword, $new->domain, $new->quota, $new->finger ); -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->vpopmail_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username, $svc_acct->domain ); -} - -#a good idea to queue anything that could fail or take any time -sub vpopmail_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - - my $exportdir = "%%%FREESIDE_EXPORT%%%/export." . datasrc; - mkdir $exportdir, 0700 or die $! unless -d $exportdir; - $exportdir .= "/vpopmail"; - mkdir $exportdir, 0700 or die $! unless -d $exportdir; - $exportdir .= '/'. $self->machine; - mkdir $exportdir, 0700 or die $! unless -d $exportdir; - mkdir "$exportdir/domains", 0700 or die $! unless -d "$exportdir/domains"; - - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::vpopmail::vpopmail_$method", - }; - $queue->insert( - $exportdir, - $self->machine, - $self->option('dir'), - $self->option('uid'), - $self->option('gid'), - $self->option('restart'), - @_ - ); -} - -sub vpopmail_insert { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - my( $username, $password, $domain, $quota, $finger ) = @_; - - mkdir "$exportdir/domains/$domain", 0700 or die $! - unless -d "$exportdir/domains/$domain"; - - (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open vpasswd file for $username\@$domain: ". - "$exportdir/domains/$domain/vpasswd: $!"; - print VPASSWD join(":", - $username, - $password, - '1', - '0', - $finger, - "$dir/domains/$domain/$username", - $quota ? $quota.'S' : 'NOQUOTA', - ), "\n"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - for my $mkdir ( - grep { ! -d $_ } map { "$exportdir/domains/$domain/$username$_" } - ( '', qw( /Maildir /Maildir/cur /Maildir/new /Maildir/tmp ) ) - ) { - mkdir $mkdir, 0700 or die "can't mkdir $mkdir: $!"; - } - - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart ); - -} - -sub vpopmail_replace { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - my( $username, $password, $domain, $quota, $finger ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while (<VPASSWD>) { - my ($mailbox, $pw, $vuid, $vgid, $vfinger, $vdir, $vquota, @rest) = - split(':', $_); - if ( $username ne $mailbox ) { - print VPASSWDTMP $_; - next - } - print VPASSWDTMP join (':', - $mailbox, - $password, - '1', - '0', - $finger, - "$dir/domains/$domain/$username", #$vdir - $quota ? $quota.'S' : 'NOQUOTA', - ), "\n"; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart ); - -} - -sub vpopmail_delete { #subroutine, not method - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - my( $username, $domain ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while (<VPASSWD>) { - my ($mailbox, $rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", - "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - rmtree "$exportdir/domains/$domain/$username" - or die "can't rmtree $exportdir/domains/$domain/$username: $!"; - - vpopmail_sync( $exportdir, $machine, $dir, $uid, $gid, $restart ); -} - -sub vpopmail_sync { - my( $exportdir, $machine, $dir, $uid, $gid, $restart ) = splice @_,0,6; - - chdir $exportdir; -# my @args = ( $rsync, "-rlpt", "-e", $ssh, "domains/", -# "vpopmail\@$machine:$dir/domains/" ); -# system {$args[0]} @args; - - eval "use File::Rsync;"; - die $@ if $@; - - my $rsync = File::Rsync->new({ rsh => 'ssh' }); - - $rsync->exec( { - recursive => 1, - perms => 1, - times => 1, - src => "$exportdir/domains/", - dest => "vpopmail\@$machine:$dir/domains/", - } ); # true/false return value from exec is not working, alas - if ( $rsync->err ) { - die "error uploading to vpopmail\@$machine:$dir/domains/ : ". - 'exit status: '. $rsync->status. ', '. - 'STDERR: '. join(" / ", $rsync->err). ', '. - 'STDOUT: '. join(" / ", $rsync->out); - } - - eval "use Net::SSH qw(ssh);"; - die $@ if $@; - - ssh("vpopmail\@$machine", $restart) if $restart; -} - -1; - diff --git a/FS/FS/part_export/www_plesk.pm b/FS/FS/part_export/www_plesk.pm deleted file mode 100644 index ccf9b3e..0000000 --- a/FS/FS/part_export/www_plesk.pm +++ /dev/null @@ -1,138 +0,0 @@ -package FS::part_export::www_plesk; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'URL' => { label=>'URL' }, - 'login' => { label=>'Login' }, - 'password' => { label=>'Password' }, - 'template' => { label=>'Domain Template' }, - 'web' => { label=>'Host Website', - type=>'checkbox' }, - 'debug' => { label=>'Enable debugging', - type=>'checkbox' }, -; - -%info = ( - 'svc' => 'svc_www', - 'desc' => 'Real-time export to Plesk managed hosting service', - 'options'=> \%options, - 'notes' => <<'END' -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 and proper <a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.7:Documentation:Administration:www_plesk.pm">configuration</a>. -END -); - -sub rebless { shift; } - -# experiment: want the status of these right away (don't want account to -# create or whatever and then get error in the queue from dup username or -# something), so no queueing - -sub _export_insert { - my( $self, $www ) = ( shift, shift ); - - eval "use Net::Plesk;"; - return $@ if $@; - - my $plesk = new Net::Plesk ( - 'POST' => $self->option('URL'), - ':HTTP_AUTH_LOGIN' => $self->option('login'), - ':HTTP_AUTH_PASSWD' => $self->option('password'), - ); - - my $gcresp = $plesk->client_get( $www->svc_acct->username ); - return $gcresp->errortext - unless $gcresp->is_success; - - unless ($gcresp->id) { - my $cust_main = $www->cust_svc->cust_pkg->cust_main; - $gcresp = $plesk->client_add( $cust_main->name, - $www->svc_acct->username, - $www->svc_acct->_password, - $cust_main->daytime, - $cust_main->fax, - $cust_main->invoicing_list->[0], - $cust_main->address1 . $cust_main->address2, - $cust_main->city, - $cust_main->state, - $cust_main->zip, - $cust_main->country, - ); - return $gcresp->errortext - unless $gcresp->is_success; - } - - $plesk->client_ippool_add_ip ( $gcresp->id, - $www->domain_record->recdata, - ); - - if ($self->option('web')) { - $self->_plesk_command( 'domain_add', - $www->domain_record->svc_domain->domain, - $gcresp->id, - $www->domain_record->recdata, - $self->option('template')?$self->option('template'):'', - $www->svc_acct->username, - $www->svc_acct->_password, - ); - }else{ - $self->_plesk_command( 'domain_add', - $www->domain_record->svc_domain->domain, - $gcresp->id, - $www->domain_record->recdata, - $self->option('template')?$self->option('template'):'', - ); - } -} - -sub _plesk_command { - my( $self, $method, @args ) = @_; - - eval "use Net::Plesk;"; - return $@ if $@; - - local($Net::Plesk::DEBUG) = 1 - if $self->option('debug'); - - my $plesk = new Net::Plesk ( - 'POST' => $self->option('URL'), - ':HTTP_AUTH_LOGIN' => $self->option('login'), - ':HTTP_AUTH_PASSWD' => $self->option('password'), - ); - - my $response = $plesk->$method(@args); - return $response->errortext unless $response->is_success; - ''; - -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - - return "can't change domain with Plesk" - if $old->domain_record->svc_domain->domain ne - $new->domain_record->svc_domain->domain; - - return "can't change client with Plesk" - if $old->svc_acct->username ne - $new->svc_acct->username; - - return ''; - -} - -sub _export_delete { - my( $self, $www ) = ( shift, shift ); - $self->_plesk_command( 'domain_del', $www->domain_record->svc_domain->domain); -} - -1; - diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm deleted file mode 100644 index 91b294e..0000000 --- a/FS/FS/part_export/www_shellcommands.pm +++ /dev/null @@ -1,190 +0,0 @@ -package FS::part_export::www_shellcommands; - -use strict; -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone', - }, - 'userdel' => { label=>'Delete command', - default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone', - }, - 'usermod' => { label=>'Modify command', - default=>'[ -n "$old_zone" ] && rm /var/www/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ "$old_username" != "$new_username" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone', - }, - 'suspend' => { label=>'Suspension command', - default=>'[ -n "$zone" ] && chmod 0 /var/www/$zone', - }, - 'unsuspend'=> { label=>'Unsuspension command', - default=>'[ -n "$zone" ] && chmod 755 /var/www/$zone', - }, -; - -%info = ( - 'svc' => 'svc_www', - 'desc' => 'Run remote commands via SSH, for virtual web sites (directory maintenance, FrontPage, ISPMan)', - 'options' => \%options, - 'notes' => <<'END' -Run remote commands via SSH, for virtual web sites. You will need to -<a href="http://www.freeside.biz/mediawiki/index.php/Freeside:1.9:Documentation:Administration:SSH_Keys">setup SSH for unattended operation</a>. -<BR><BR>Use these buttons for some useful presets: -<UL> - <LI> - <INPUT TYPE="button" VALUE="Maintain directories" onClick=' - this.form.user.value = "root"; - this.form.useradd.value = "mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone"; - this.form.userdel.value = "[ -n \"$zone\" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone"; - this.form.usermod.value = "[ -n \"$old_zone\" ] && rm /var/www/$old_zone; [ \"$old_zone\" != \"$new_zone\" -a -n \"$new_zone\" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ \"$old_username\" != \"$new_username\" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone"; - this.form.suspend.value = "[ -n \"$zone\" ] && chmod 0 /var/www/$zone"; - this.form.unsuspend.value = "[ -n \"$zone\" ] && chmod 755 /var/www/$zone"; - '> - <LI> - <INPUT TYPE="button" VALUE="FrontPage extensions" onClick=' - this.form.user.value = "root"; - this.form.useradd.value = "/usr/local/frontpage/version5.0/bin/owsadm.exe -o install -p 80 -m $zone -xu $username -xg www-data -s /etc/apache/httpd.conf -u $username -pw $_password"; - this.form.userdel.value = "/usr/local/frontpage/version5.0/bin/owsadm.exe -o uninstall -p 80 -m $zone -s /etc/apache/httpd.conf"; - this.form.usermod.value = ""; - this.form.suspend.value = ""; - this.form.unsuspend.value = ""; - '> - <LI> - <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' - this.form.user.value = "root"; - this.form.useradd.value = "/usr/local/ispman/bin/ispman.addvhost -d $domain $bare_zone"; - this.form.userdel.value = "/usr/local/ispman/bin/ispman.deletevhost -d $domain $bare_zone"; - this.form.usermod.value = ""; - this.form.suspend.value = ""; - this.form.unsuspend.value = ""; - '></UL> -The following variables are available for interpolation (prefixed with -<code>new_</code> or <code>old_</code> for replace operations): -<UL> - <LI><code>$zone</code> - fully-qualified zone of this virtual host - <LI><code>$bare_zone</code> - just the zone of this virtual host, without the domain portion - <LI><code>$domain</code> - base domain - <LI><code>$username</code> - <LI><code>$_password</code> - <LI><code>$homedir</code> - <LI>All other fields in <a href="../docs/schema.html#svc_www">svc_www</a> - are also available. -</UL> -END -); - - -sub rebless { shift; } - -sub _export_insert { - my($self) = shift; - $self->_export_command('useradd', @_); -} - -sub _export_delete { - my($self) = shift; - $self->_export_command('userdel', @_); -} - -sub _export_suspend { - my($self) = shift; - $self->_export_command('suspend', @_); -} - -sub _export_unsuspend { - my($self) = shift; - $self->_export_command('unsuspend', @_); -} - -sub _export_command { - my ( $self, $action, $svc_www) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_www->getfield($_) foreach $svc_www->fields; - } - my $domain_record = $svc_www->domain_record; # or die ? - my $zone = $domain_record->zone; # or die ? - my $domain = $domain_record->svc_domain->domain; - ( my $bare_zone = $zone ) =~ s/\.$domain$//; - my $svc_acct = $svc_www->svc_acct; # or die ? - my $username = $svc_acct->username; - my $_password = $svc_acct->_password; - my $homedir = $svc_acct->dir; # or die ? - - #done setting variables for the command - - $self->shellcommands_queue( $svc_www->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -sub _export_replace { - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('usermod'); - - #set variable for the command - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - my $old_domain_record = $old->domain_record; # or die ? - my $old_zone = $old_domain_record->zone; # or die ? - my $old_domain = $old_domain_record->svc_domain->domain; - ( my $old_bare_zone = $old_zone ) =~ s/\.$old_domain$//; - my $old_svc_acct = $old->svc_acct; # or die ? - my $old_username = $old_svc_acct->username; - my $old_homedir = $old_svc_acct->dir; # or die ? - - my $new_domain_record = $new->domain_record; # or die ? - my $new_zone = $new_domain_record->zone; # or die ? - my $new_domain = $new_domain_record->svc_domain->domain; - ( my $new_bare_zone = $new_zone ) =~ s/\.$new_domain$//; - my $new_svc_acct = $new->svc_acct; # or die ? - my $new_username = $new_svc_acct->username; - #my $new__password = $new_svc_acct->_password; - my $new_homedir = $new_svc_acct->dir; # or die ? - - #done setting variables for the command - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - ); -} - -#a good idea to queue anything that could fail or take any time -sub shellcommands_queue { - my( $self, $svcnum ) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::www_shellcommands::ssh_cmd", - }; - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -#sub shellcommands_insert { #subroutine, not method -#} -#sub shellcommands_replace { #subroutine, not method -#} -#sub shellcommands_delete { #subroutine, not method -#} - |