diff options
Diffstat (limited to 'FS/FS/part_export')
27 files changed, 3747 insertions, 0 deletions
diff --git a/FS/FS/part_export/acct_sql.pm b/FS/FS/part_export/acct_sql.pm new file mode 100644 index 0000000..dfc37d0 --- /dev/null +++ b/FS/FS/part_export/acct_sql.pm @@ -0,0 +1,177 @@ +package FS::part_export::acct_sql; + +use vars qw(@ISA %info @saltset); +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' }, +; + +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 '. + '(Postfix+Courier IMAP, others?)', + 'options' => \%options, + 'nodomain' => '', + 'notes' => <<END +Export accounts (svc_acct records) to SQL databases. Written for +Postfix+Courier IMAP but intended to be generally useful for generic SQL +exports, eventually. + +<BR><BR>In contrast to sqlmail, this is newer and less well tested, and +currently less flexible. It 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" formats rather than configure the MTA or POP/IMAP server +for a Freeside-specific schema, and possibly to be configured for different +mail server setups through some subclassing rather than options. + +<BR><BR>Use these buttons for some useful presets: +<UL> + <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{$_}; + $_ => $svc_acct->$value(); + } 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 { +} + +sub _export_delete { + my ( $self, $svc_acct ) = (shift, shift); + my %map = $self->_map; + my $keymap = $map{$self->option('primary_key')}; + my $err_or_queue = $self->acct_sql_queue( + $svc_acct->svcnum, + 'delete', + $self->option('table'), + $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( map $record{$_}, keys %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_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 new file mode 100644 index 0000000..35b00cc --- /dev/null +++ b/FS/FS/part_export/apache.pm @@ -0,0 +1,47 @@ +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/bind.pm b/FS/FS/part_export/bind.pm new file mode 100644 index 0000000..1ef7b65 --- /dev/null +++ b/FS/FS/part_export/bind.pm @@ -0,0 +1,35 @@ +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 new file mode 100644 index 0000000..c89325f --- /dev/null +++ b/FS/FS/part_export/bind_slave.pm @@ -0,0 +1,28 @@ +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 new file mode 100644 index 0000000..7b5feb2 --- /dev/null +++ b/FS/FS/part_export/bsdshell.pm @@ -0,0 +1,25 @@ +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 new file mode 100644 index 0000000..6da2017 --- /dev/null +++ b/FS/FS/part_export/communigate_pro.pm @@ -0,0 +1,178 @@ +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 new file mode 100644 index 0000000..6a1bf60 --- /dev/null +++ b/FS/FS/part_export/communigate_pro_singledomain.pm @@ -0,0 +1,37 @@ +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 multipledomains, +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 new file mode 100644 index 0000000..a295c57 --- /dev/null +++ b/FS/FS/part_export/cp.pm @@ -0,0 +1,160 @@ +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 '' unless $old->username ne $new->username + || $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/cyrus.pm b/FS/FS/part_export/cyrus.pm new file mode 100644 index 0000000..84c9e5a --- /dev/null +++ b/FS/FS/part_export/cyrus.pm @@ -0,0 +1,120 @@ +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 new file mode 100644 index 0000000..0ba5617 --- /dev/null +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -0,0 +1,161 @@ +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); + + #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 + + if ( $old->catchall ) { + no strict 'refs'; + 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 ) { + no strict 'refs'; + 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/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm new file mode 100644 index 0000000..fe30435 --- /dev/null +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -0,0 +1,159 @@ +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> + <LI><code>$domain</code> + <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); + + #set variable for the command + no strict 'vars'; + { + no strict 'refs'; + ${$_} = $svc_forward->getfield($_) foreach $svc_forward->fields; + } + + my $svc_acct = $svc_forward->srcsvc_acct; + $username = $svc_acct->username; + $domain = $svc_acct->domain; + if ($svc_forward->dstsvc_acct) { + $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; + } + + my $old_svc_acct = $old->srcsvc_acct; + $old_username = $old_svc_acct->username; + $old_domain = $old_svc_acct->domain; + if ($old->dstsvc_acct) { + $old_destination = $old->dstsvc_acct->email; + } else { + $old_destination = $old->dst; + } + + my $new_svc_acct = $new->srcsvc_acct; + $new_username = $new_svc_acct->username; + $new_domain = $new_svc_acct->domain; + 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 new file mode 100644 index 0000000..0be2a0f --- /dev/null +++ b/FS/FS/part_export/http.pm @@ -0,0 +1,134 @@ +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 { $_ ne "POST" } $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 new file mode 100644 index 0000000..309e7ce --- /dev/null +++ b/FS/FS/part_export/infostreet.pm @@ -0,0 +1,277 @@ +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 { $_ ne 'POST' } $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 new file mode 100644 index 0000000..823d99d --- /dev/null +++ b/FS/FS/part_export/ldap.pm @@ -0,0 +1,294 @@ +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 new file mode 100644 index 0000000..0145af3 --- /dev/null +++ b/FS/FS/part_export/null.pm @@ -0,0 +1,13 @@ +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 new file mode 100644 index 0000000..2978d25 --- /dev/null +++ b/FS/FS/part_export/passwdfile.pm @@ -0,0 +1,18 @@ +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 new file mode 100644 index 0000000..4fd19ee --- /dev/null +++ b/FS/FS/part_export/postfix.pm @@ -0,0 +1,32 @@ +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/router.pm b/FS/FS/part_export/router.pm new file mode 100644 index 0000000..648a437 --- /dev/null +++ b/FS/FS/part_export/router.pm @@ -0,0 +1,190 @@ +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 new file mode 100644 index 0000000..4f201cf --- /dev/null +++ b/FS/FS/part_export/shellcommands.pm @@ -0,0 +1,338 @@ +package FS::part_export::shellcommands; + +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', + '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 -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 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=>'', + }, +; + +%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 -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 -g $gid -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 -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 -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 -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 quoted for the shell + <LI><code>$crypt_password</code> - encrypted password + <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 +); + +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + +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 { $_ ne 'POST' } $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; + + #eventually should check a "password-encoding" field + if ( length($svc_acct->_password) == 13 + || $svc_acct->_password =~ /^\$(1|2a?)\$/ ) { + $crypt_password = shell_quote $svc_acct->_password; + } else { + $crypt_password = crypt( + $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + } + + @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 $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; + + #eventuall should check a "password-encoding" field + if ( length($new->_password) == 13 + || $new->_password =~ /^\$(1|2a?)\$/ ) { + $new_crypt_password = shell_quote $new->_password; + } else { + $new_crypt_password = + crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + } + + @old_radius_groups = $old->radius_groups; + @new_radius_groups = $new->radius_groups; + + if ( $self->option('usermod_pwonly') ) { + my $error = ''; + if ( $old_username ne $new_username ) { + $error ||= "can't change username"; + } + if ( $old_domain ne $new_domain ) { + $error ||= "can't change domain"; + } + if ( $old_uid != $new_uid ) { + $error ||= "can't change uid"; + } + 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 new file mode 100644 index 0000000..89ee95f --- /dev/null +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -0,0 +1,105 @@ +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 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=>'', + }, +; + +%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 quoted for the shell + <LI><code>$crypt_password</code> - encrypted password + <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 new file mode 100644 index 0000000..6d61e0e --- /dev/null +++ b/FS/FS/part_export/sqlmail.pm @@ -0,0 +1,220 @@ +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 new file mode 100644 index 0000000..fd5bb89 --- /dev/null +++ b/FS/FS/part_export/sqlradius.pm @@ -0,0 +1,337 @@ +package FS::part_export::sqlradius; + +use vars qw(@ISA %info %options $notes1 $notes2); +use Tie::IxHash; +use FS::Record qw( dbh ); +use FS::part_export; + +@ISA = qw(FS::part_export); + +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' + }, +; + +$notes1 = <<'END'; +Real-time export of radcheck, radreply and usergroup tables to any SQL database +for <a href="http://www.freeradius.org/">FreeRADIUS</a>, +<a href="http://radius.innercite.com/">ICRADIUS</a> +or <a href="http://www.open.com.au/radiator/">Radiator</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, Radiator)', + '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); + $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; +} + +1; + diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm new file mode 100644 index 0000000..6130e5e --- /dev/null +++ b/FS/FS/part_export/sqlradius_withdomain.pm @@ -0,0 +1,28 @@ +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, Radiator) 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 new file mode 100644 index 0000000..244c3bf --- /dev/null +++ b/FS/FS/part_export/sysvshell.pm @@ -0,0 +1,25 @@ +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 new file mode 100644 index 0000000..65936ea --- /dev/null +++ b/FS/FS/part_export/textradius.pm @@ -0,0 +1,191 @@ +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 new file mode 100644 index 0000000..62fa8ba --- /dev/null +++ b/FS/FS/part_export/vpopmail.pm @@ -0,0 +1,252 @@ +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' +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>. See shellcommands_withdomain for an +export that uses vpopmail commands instead. +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 new file mode 100644 index 0000000..0e50d60 --- /dev/null +++ b/FS/FS/part_export/www_shellcommands.pm @@ -0,0 +1,166 @@ +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); + + #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 +#} + |