diff options
Diffstat (limited to 'FS/FS/part_export')
31 files changed, 0 insertions, 4762 deletions
diff --git a/FS/FS/part_export/acct_sql.pm b/FS/FS/part_export/acct_sql.pm deleted file mode 100644 index 4b92e80..0000000 --- a/FS/FS/part_export/acct_sql.pm +++ /dev/null @@ -1,271 +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', - }, - '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 ); - -%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"; - '> -</UL> -END -); - -sub _map { - my $self = shift; - map { /^\s*(\S+)\s*(\S+)\s*$/ } split("\n", $self->option('schema') ); -} - -sub rebless { shift; } - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - my %map = $self->_map; - - my %record = map { my $value = $map{$_}; - my @arg = (); - push @arg, $self->option('crypt') - if $value eq 'crypt_password' && $self->option('crypt'); - $_ => $svc_acct->$value(@arg); - } keys %map; - - 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 %map = $self->_map; - - my @primary_key = (); - if ( $self->option('primary_key') =~ /,/ ) { - foreach my $key ( split(/\s*,\s*/, $self->option('primary_key') ) ) { - my $keymap = $map{$key}; - push @primary_key, $old->$keymap(); - } - } else { - my $keymap = $map{$self->option('primary_key')}; - push @primary_key, $old->$keymap(); - } - - my %record = map { my $value = $map{$_}; - my @arg = (); - push @arg, $self->option('crypt') - if $value eq 'crypt_password' && $self->option('crypt'); - $_ => $new->$value(@arg); - } keys %map; - - 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 %map = $self->_map; - - 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_acct->$keymap(); - } - } else { - my $keymap = $map{$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/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/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm deleted file mode 100644 index 6da2017..0000000 --- a/FS/FS/part_export/communigate_pro.pm +++ /dev/null @@ -1,178 +0,0 @@ -package FS::part_export::communigate_pro; - -use vars qw(@ISA %info %options); -use Tie::IxHash; -use FS::part_export; -use FS::queue; - -@ISA = qw(FS::part_export); - -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', - type=>'select', - options=>[qw( MultiMailbox TextMailbox MailDirMailbox )], - default=>'MultiMailbox', - }, - 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.', - type=>'checkbox', - }, - 'AccessModes' => { label=>'Access modes', - default=>'Mail POP IMAP PWD WebMail WebSite', - }, -; - -%info = ( - 'svc' => 'svc_acct', - 'desc' => 'Real-time export to a CommuniGate Pro mail server', - 'options' => \%options, - 'notes' => <<'END' -Real time export 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 -); - -sub rebless { shift; } - -sub export_username { - my($self, $svc_acct) = (shift, shift); - $svc_acct->email; -} - -sub _export_insert { - my( $self, $svc_acct ) = (shift, shift); - my @options = ( $svc_acct->svcnum, 'CreateAccount', - 'accountName' => $self->export_username($svc_acct), - 'accountType' => $self->option('accountType'), - 'AccessModes' => $self->option('AccessModes'), - 'RealName' => $svc_acct->finger, - 'Password' => $svc_acct->_password, - ); - push @options, 'MaxAccountSize' => $svc_acct->quota if $svc_acct->quota; - push @options, 'externalFlag' => $self->option('externalFlag') - if $self->option('externalFlag'); - - $self->communigate_pro_queue( @options ); -} - -sub _export_replace { - my( $self, $new, $old ) = (shift, shift, shift); - return "can't (yet) change username with CommuniGate Pro" - if $old->username ne $new->username; - return "can't (yet) change domain with CommuniGate Pro" - if $self->export_username($old) ne $self->export_username($new); - return "can't (yet) change GECOS with CommuniGate Pro" - if $old->finger ne $new->finger; - return "can't (yet) change quota with CommuniGate Pro" - if $old->quota ne $new->quota; - return '' unless $old->username ne $new->username - || $old->_password ne $new->_password - || $old->finger ne $new->finger - || $old->quota ne $new->quota; - - return '' if '*SUSPENDED* '. $old->_password eq $new->_password; - - #my $err_or_queue = $self->communigate_pro_queue( $new->svcnum,'RenameAccount', - # $old->email, $new->email ); - #return $err_or_queue unless ref($err_or_queue); - #my $jobnum = $err_or_queue->jobnum; - - $self->communigate_pro_queue( $new->svcnum, 'SetAccountPassword', - $self->export_username($new), $new->_password ) - if $new->_password ne $old->_password; - -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'DeleteAccount', - $self->export_username($svc_acct), - ); -} - -sub _export_suspend { - my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', - 'accountName' => $self->export_username($svc_acct), - 'AccessModes' => 'Mail', - ); -} - -sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); - $self->communigate_pro_queue( $svc_acct->svcnum, 'UpdateAccountSettings', - 'accountName' => $self->export_username($svc_acct), - 'AccessModes' => $self->option('AccessModes'), - ); -} - -sub communigate_pro_queue { - my( $self, $svcnum, $method ) = (shift, shift, shift); - my @kludge_methods = qw(CreateAccount UpdateAccountSettings); - my $sub = 'communigate_pro_command'; - $sub = $method if grep { $method eq $_ } @kludge_methods; - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::communigate_pro::$sub", - }; - $queue->insert( - $self->machine, - $self->option('port'), - $self->option('login'), - $self->option('password'), - $method, - @_, - ); - -} - -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, %args ) = @_; - my $accountName = delete $args{'accountName'}; - $args{'AccessModes'} = [ split(' ', $args{'AccessModes'}) ]; - @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"; - - my $cli = new CGP::CLI( { - 'PeerAddr' => $machine, - 'PeerPort' => $port, - 'login' => $login, - 'password' => $password, - } ) or die "Can't login to CGPro: $CGP::ERR_STRING\n"; - - $cli->$method(@args) or die "CGPro error: ". $cli->getErrMessage; - - $cli->Logout or die "Can't logout of CGPro: $CGP::ERR_STRING\n"; - -} - -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/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/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm deleted file mode 100644 index 994c113..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="../docs/ssh.html">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/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 cee24e4..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="../docs/ssh.html">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/http.pm b/FS/FS/part_export/http.pm deleted file mode 100644 index 55d8329..0000000 --- a/FS/FS/part_export/http.pm +++ /dev/null @@ -1,134 +0,0 @@ -package FS::part_export::http; - -use vars qw(@ISA %info); -use Tie::IxHash; -use FS::part_export; - -@ISA = qw(FS::part_export); - -tie my %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", - ), - }, -; - -%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"); - - $self->http_queue( $svc_x->svcnum, - $self->option('method'), - $self->option('url'), - 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'); - - $self->http_queue( $svc_x->svcnum, - $self->option('method'), - $self->option('url'), - map { - /^\s*(\S+)\s+(.*)$/ or /()()/; - my( $field, $value_expression ) = ( $1, $2 ); - die $@ if $@; - ( $field, $value ); - } split(/\n/, $self->option('replace_data') ) - ); - -} - -sub http_queue { - my($self, $svcnum) = (shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - 'job' => "FS::part_export::http::http", - }; - $queue->insert( @_ ); -} - -sub http { - my($method, $url, @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; - -} - -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/ldap.pm b/FS/FS/part_export/ldap.pm deleted file mode 100644 index 823d99d..0000000 --- a/FS/FS/part_export/ldap.pm +++ /dev/null @@ -1,294 +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' }, - '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 _export_insert { - my($self, $svc_acct) = (shift, shift); - - #false laziness w/shellcommands.pm - { - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - ${$_} = $svc_acct->$_() foreach qw( domain ); - 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); - } - } - $crypt_password = ''; #surpress "used only once" warnings - $crypt_password = '{crypt}'. crypt( $svc_acct->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] ); - - my $username_attrib; - my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/; - $username_attrib = $1 if $2 eq '$username'; - ( $1 => eval(qq("$2")) ); } - grep { /^\s*(\w+)\s+(.*\S)\s*$/ } - split("\n", $self->option('attributes')); - - 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}; - } - } - } - - my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert', - #$svc_acct->username, - $username_attrib, - %attrib ); - return $err_or_queue unless ref($err_or_queue); - - #groups with LDAP? - #my @groups = $svc_acct->radius_groups; - #if ( @groups ) { - # my $err_or_queue = $self->ldap_queue( - # $svc_acct->svcnum, 'usergroup_insert', - # $svc_acct->username, @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'; - - return "can't (yet?) change username with ldap" - if $old->username ne $new->username; - - return "ldap replace unimplemented"; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $jobnum = ''; - #if ( $old->username ne $new->username ) { - # my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename', - # $new->username, $old->username ); - # 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->ldap_queue( $new->svcnum, 'insert', - $table, $new->username, %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->ldap_queue( $new->svcnum, 'attrib_delete', - $table, $new->username, @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; - } - } - } - } - - # (sorta) false laziness with FS::svc_acct::replace - my @oldgroups = @{$old->usergroup}; #uuuh - my @newgroups = $new->radius_groups; - my @delgroups = (); - foreach my $oldgroup ( @oldgroups ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - push @delgroups, $oldgroup; - } - - if ( @delgroups ) { - my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete', - $new->username, @delgroups ); - 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; - } - } - } - - if ( @newgroups ) { - my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert', - $new->username, @newgroups ); - 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; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - return "ldap delete unimplemented"; - my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete', - $svc_acct->username ); - 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, $username_attrib, %attrib ) = @_; - - $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn" - if $username_attrib; - #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 { #subroutine, not method -# my $dbh = ldap_connect(shift, shift, shift); -# my $username = shift; -# -# 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 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/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/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/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 648a437..0000000 --- a/FS/FS/part_export/router.pm +++ /dev/null @@ -1,190 +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: - -=over 4 - -=item admin_address - IP address (or hostname) to connect - -=item admin_user - username for admin access - -=item admin_password - password for admin access - -=back - -The export itself needs the following options: - -=over 4 - -=item insert, replace, delete - command strings (to be interpolated) - -=item Prompt - prompt string to expect from router after successful login - -=item Timeout - time to wait for prompt string - -=back - -(Prompt and Timeout are required only for telnet connections.) - -=cut - -use vars qw(@ISA %info @saltset); -use Tie::IxHash; -use String::ShellQuote; -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'}, - 'insert' => {label=>'Insert command', default=>'' }, - 'delete' => {label=>'Delete command', default=>'' }, - 'replace' => {label=>'Replace command', default=>'' }, - 'Timeout' => {label=>'Time to wait for prompt', default=>'20' }, - 'Prompt' => {label=>'Prompt string', default=>'#' } -; - -%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. ( more detailed description from Kristian / fire2wire? )', -); - -@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); - -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_command { - my ( $self, $action, $svc_broadband) = (shift, shift, shift); - my $command = $self->option($action); - return '' if $command =~ /^\s*$/; - - no strict 'vars'; - { - no strict 'refs'; - ${$_} = $svc_broadband->getfield($_) foreach $svc_broadband->fields; - } - # fetch router info - my $router = $svc_broadband->addr_block->router; - my %r; - $r{$_} = $router->getfield($_) foreach $router->virtual_fields; - #warn qq("$command"); - #warn eval(qq("$command")); - - warn "admin_address: '$r{admin_address}'"; - - if ($r{admin_address} ne '') { - $self->router_queue( $svc_broadband->svcnum, $self->option('protocol'), - user => $r{admin_user}, - password => $r{admin_password}, - host => $r{admin_address}, - Timeout => $self->option('Timeout'), - Prompt => $self->option('Prompt'), - command => eval(qq("$command")), - ); - } else { - return ''; - } -} - -sub _export_replace { - - # We don't handle the case of a svc_broadband moving between routers. - # If you want to do that, reprovision the service. - - my($self, $new, $old ) = (shift, shift, shift); - my $command = $self->option('replace'); - no strict 'vars'; - { - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - } - - my $router = $new->addr_block->router; - my %r; - $r{$_} = $router->getfield($_) foreach $router->virtual_fields; - - if ($r{admin_address} ne '') { - $self->router_queue( $new->svcnum, $self->option('protocol'), - user => $r{admin_user}, - password => $r{admin_password}, - host => $r{admin_address}, - Timeout => $self->option('Timeout'), - Prompt => $self->option('Prompt'), - command => eval(qq("$command")), - ); - } else { - return ''; - } -} - -#a good idea to queue anything that could fail or take any time -sub router_queue { - #warn join ':', @_; - my( $self, $svcnum, $protocol ) = (shift, shift, shift); - my $queue = new FS::queue { - 'svcnum' => $svcnum, - }; - $queue->job ("FS::part_export::router::".$protocol."_cmd"); - $queue->insert( @_ ); -} - -sub ssh_cmd { #subroutine, not method - use Net::SSH '0.08'; - &Net::SSH::ssh_cmd( { @_ } ); -} - -sub telnet_cmd { - eval 'use Net::Telnet;'; - die $@ if $@; - - warn join(', ', @_); - - my %arg = @_; - - my $t = new Net::Telnet (Timeout => $arg{Timeout}, - Prompt => $arg{Prompt}); - $t->open($arg{host}); - $t->login($arg{user}, $arg{password}); - my @error = $t->cmd($arg{command}); - die @error if (grep /^ERROR/, @error); -} - -#sub router_insert { #subroutine, not method -#} -#sub router_replace { #subroutine, not method -#} -#sub router_delete { #subroutine, not method -#} - -1; - diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm deleted file mode 100644 index e488a52..0000000 --- a/FS/FS/part_export/shellcommands.pm +++ /dev/null @@ -1,334 +0,0 @@ -package FS::part_export::shellcommands; - -use vars qw(@ISA %info); -use Tie::IxHash; -use String::ShellQuote; -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=>'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_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'userdel -r $username', - #default=>'rm -rf $dir', - }, - '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_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_stdin' => { label=>'Suspension command STDIN', - default=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'usermod -U $username', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, - 'crypt' => { label => 'Default password encryption', - type=>'select', options=>[qw(crypt md5)], - default => 'crypt', - }, -; - -%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="../docs/ssh.html">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, 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 -); - -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; - - 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 ) { - $email = ( grep { $_ !~ /^(POST|FAX)$/ } $cust_pkg->cust_main->invoicing_list )[0]; - } else { - $email = ''; - } - - $finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/; - ($first, $last ) = ( $1, $2 ); - $first = shell_quote $first; - $last = shell_quote $last; - $finger = shell_quote $finger; - $quoted_password = shell_quote $_password; - $domain = $svc_acct->domain; - - $crypt_password = - shell_quote( $svc_acct->crypt_password( $self->option('crypt') ) ); - - @radius_groups = $svc_acct->radius_groups; - - $self->shellcommands_queue( $svc_acct->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - stdin_string => eval(qq("$stdin")), - ); -} - -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; - } - $new_finger =~ /^(.*)\s+(\S+)$/ or $new_finger =~ /^((.*))$/; - ($new_first, $new_last ) = ( $1, $2 ); - $new_first = shell_quote $new_first; - $new_last = shell_quote $new_last; - $new_finger = shell_quote $new_finger; - $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 = - shell_quote( $new->crypt_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; - - $self->shellcommands_queue( $new->svcnum, - user => $self->option('user')||'root', - host => $self->machine, - command => eval(qq("$command")), - stdin_string => eval(qq("$stdin")), - ); -} - -#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 7c5d904..0000000 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ /dev/null @@ -1,112 +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", - }, - 'userdel' => { label=>'Delete command', - #default=>'', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - #default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, - '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=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, - '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="../docs/ssh.html">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; - '> -</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/sqlmail.pm b/FS/FS/part_export/sqlmail.pm deleted file mode 100644 index 6d61e0e..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 => 'domain svcnum catchall' }, - 'svc_domain_fields' => { label => 'svc_domain Export Fields', - default => 'srcsvc dstsvc dst' }, - '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 10bccb0..0000000 --- a/FS/FS/part_export/sqlradius.pm +++ /dev/null @@ -1,552 +0,0 @@ -package FS::part_export::sqlradius; - -use vars qw(@ISA $DEBUG %info %options $notes1 $notes2); -use Tie::IxHash; -use FS::Record qw( dbh qsearch ); -use FS::part_export; -use FS::svc_acct; -use FS::export_svc; - -@ISA = qw(FS::part_export); - -$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', - }, - 'show_called_station' => { - type => 'checkbox', - label => 'Show the Called-Station-ID on session reports', - }, -; - -$notes1 = <<'END'; -Real-time export of <b>radcheck</b>, <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>. -END - -$notes2 = <<'END'; -An existing RADIUS database will be updated in realtime, but you can use -<a href="../docs/man/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 rebless { shift; } - -sub export_username { - my($self, $svc_acct) = (shift, shift); - warn "export_username called on $self with arg $svc_acct" if $DEBUG; - $svc_acct->username; -} - -sub _export_insert { - my($self, $svc_acct) = (shift, shift); - - foreach my $table (qw(reply check)) { - my $method = "radius_$table"; - my %attrib = $svc_acct->$method(); - next unless keys %attrib; - my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', - $table, $self->export_username($svc_acct), %attrib ); - return $err_or_queue unless ref($err_or_queue); - } - my @groups = $svc_acct->radius_groups; - if ( @groups ) { - my $err_or_queue = $self->sqlradius_queue( - $svc_acct->svcnum, 'usergroup_insert', - $self->export_username($svc_acct), @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 $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', - $self->export_username($new), $self->export_username($old) ); - 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; - } - } - } - } - - # (sorta) false laziness with FS::svc_acct::replace - my @oldgroups = @{$old->usergroup}; #uuuh - my @newgroups = $new->radius_groups; - my @delgroups = (); - foreach my $oldgroup ( @oldgroups ) { - if ( grep { $oldgroup eq $_ } @newgroups ) { - @newgroups = grep { $oldgroup ne $_ } @newgroups; - next; - } - push @delgroups, $oldgroup; - } - - if ( @delgroups ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', - $self->export_username($new), @delgroups ); - 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; - } - } - } - - if ( @newgroups ) { - my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert', - $self->export_username($new), @newgroups ); - 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; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; -} - -sub _export_delete { - my( $self, $svc_acct ) = (shift, shift); - my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete', - $self->export_username($svc_acct) ); - 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 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 =~ /Password/i ? '==' : ':=' ), - $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, @groups ) = @_; - - my $sth = $dbh->prepare( - "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )" - ) or die $dbh->errstr; - foreach my $group ( @groups ) { - $sth->execute( $username, $group ) - or die "can't insert into groupname table: ". $sth->errstr; - } - $dbh->disconnect; -} - -sub sqlradius_usergroup_delete { #subroutine, not method - my $dbh = sqlradius_connect(shift, shift, shift); - my( $username, @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) = @_; - 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; - - 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; -} - -#-- - -=item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ] - -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, $start, $end ) = splice(@_, 0, 3); - my $svc_acct = @_ ? shift : ''; - my $ip = @_ ? shift : ''; - my $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; - if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { - $str2time = 'UNIX_TIMESTAMP('; - } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { - $str2time = 'EXTRACT( EPOCH FROM '; - } else { - warn "warning: unknown database type ". $dbh->{Driver}->{Name}. - "; guessing how to convert to UNIX timestamps"; - $str2time = 'extract(epoch from '; - } - - 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 ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) { - $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND'; - push @param, $username, $1, $2; - } else { - $where = 'UserName = ? AND'; - push @param, $username; - } - } - - if ( length($ip) ) { - $where .= ' FramedIPAddress = ? AND'; - push @param, $ip; - } - - if ( length($prefix) ) { - #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/ - $where .= " CalledStationID LIKE 'sip:$prefix\%' AND"; - } - - push @param, $start, $end; - - my $sth = $dbh->prepare('SELECT '. join(', ', @fields). - " FROM radacct - WHERE $where - $str2time AcctStopTime ) >= ? - AND $str2time AcctStopTime ) <= ? - 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_acct { - my $self = shift; - - my $dbh = sqlradius_connect( map $self->option($_), - qw( datasrc username password ) ); - - my @fields = qw( radacctid username realm acctsessiontime ); - - my @param = (); - my $where = ''; - - my $sth = $dbh->prepare(" - SELECT RadAcctId, UserName, Realm, AcctSessionTime - 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) = @$row; - warn "processing record: ". - "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s" - if $DEBUG; - - 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 $svc_domain = qsearch - } - - my @svc_acct = - grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum, - 'svcpart' => $_->cust_svc->svcpart, } ) - } - qsearch( 'svc_acct', - { 'username' => $UserName }, - '', - $extra_sql - ); - - my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ". - "(UserName $UserName, Realm $Realm)"; - my $status = 'skipped'; - 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; - if ( $svc_acct->seconds !~ /^$/ ) { - warn " svc_acct.seconds found (". $svc_acct->seconds. - ") - decrementing\n" - if $DEBUG; - my $error = $svc_acct->decrement_seconds($AcctSessionTime); - die $error if $error; - $status = 'done'; - } else { - warn " no existing seconds value for svc_acct - skiping\n" if $DEBUG; - } - } - - 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; - - } - -} - -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 65936ea..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="../docs/ssh.html">SSH is setup for unattended -operation</a>. -END -); - -$prefix = "/usr/local/etc/freeside/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/vpopmail.pm b/FS/FS/part_export/vpopmail.pm deleted file mode 100644 index 0fc8266..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="../docs/ssh.html">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 = "/usr/local/etc/freeside/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_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm deleted file mode 100644 index 9d3564e..0000000 --- a/FS/FS/part_export/www_shellcommands.pm +++ /dev/null @@ -1,167 +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', - }, -; - -%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="../docs/ssh.html">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"; - '> - <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 = ""; - '> - <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 = ""; - '></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>$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_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 -#} - |