diff options
Diffstat (limited to 'FS')
54 files changed, 2583 insertions, 349 deletions
diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 190c0aa37..e44ebcc0a 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -1,7 +1,7 @@ package FS::CGI; use strict; -use vars qw(@EXPORT_OK @ISA @header); +use vars qw(@EXPORT_OK @ISA); use Exporter; use CGI; use URI::URL; @@ -253,7 +253,7 @@ sub small_custview { my $html = 'Customer #<B>'. $cust_main->custnum. '</B>'. ntable('#e8e8e8'). '<TR><TD>'. ntable("#cccccc",2). - '<TR><TD ALIGN="right" VALIGN="top">Billing</TD><TD BGCOLOR="#ffffff">'. + '<TR><TD ALIGN="right" VALIGN="top">Billing<BR>Address</TD><TD BGCOLOR="#ffffff">'. $cust_main->getfield('last'). ', '. $cust_main->first. '<BR>'; $html .= $cust_main->company. '<BR>' if $cust_main->company; @@ -270,7 +270,7 @@ sub small_custview { my $pre = $cust_main->ship_last ? 'ship_' : ''; $html .= '<TD>'. ntable("#cccccc",2). - '<TR><TD ALIGN="right" VALIGN="top">Service</TD><TD BGCOLOR="#ffffff">'. + '<TR><TD ALIGN="right" VALIGN="top">Service<BR>Address</TD><TD BGCOLOR="#ffffff">'. $cust_main->get("${pre}last"). ', '. $cust_main->get("${pre}first"). '<BR>'; $html .= $cust_main->get("${pre}company"). '<BR>' diff --git a/FS/FS/ClientAPI.pm b/FS/FS/ClientAPI.pm new file mode 100644 index 000000000..f7b8eb028 --- /dev/null +++ b/FS/FS/ClientAPI.pm @@ -0,0 +1,44 @@ +package FS::ClientAPI; + +use strict; +use vars qw(%handler); + +%handler = (); + +#find modules +foreach my $INC ( @INC ) { + foreach my $file ( glob("$INC/FS/ClientAPI/*") ) { + $file =~ /\/(\w+)\.pm$/ or do { + warn "unrecognized ClientAPI file: $file"; + next + }; + my $mod = $1; + #warn "using FS::ClientAPI::$mod"; + eval "use FS::ClientAPI::$mod;"; + die "error using FS::ClientAPI::$mod: $@" if $@; + } +} + +#(sub for modules) +sub register_handlers { + my $self = shift; + my %new_handlers = @_; + foreach my $key ( keys %new_handlers ) { + warn "WARNING: redefining sub $key" if exists $handler{$key}; + #warn "registering $key"; + $handler{$key} = $new_handlers{$key}; + } +} + +#--- + +sub dispatch { + my ( $self, $name ) = ( shift, shift ); + my $sub = $handler{$name} + or die "unknown FS::ClientAPI sub $name (known: ". join(" ", keys %handler ); + #or die "unknown FS::ClientAPI sub $name"; + &{$sub}(@_); +} + +1; + diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm new file mode 100644 index 000000000..674785524 --- /dev/null +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -0,0 +1,136 @@ +package FS::ClientAPI::MyAccount; + +use strict; +use vars qw($cache); +use Digest::MD5 qw(md5_hex); +use Date::Format; +use Cache::SharedMemoryCache; #store in db? +use FS::CGI qw(small_custview); #doh +use FS::Conf; +use FS::Record qw(qsearchs); +use FS::svc_acct; +use FS::svc_domain; +use FS::cust_main; +use FS::cust_bill; + +use FS::ClientAPI; #hmm +FS::ClientAPI->register_handlers( + 'MyAccount/login' => \&login, + 'MyAccount/customer_info' => \&customer_info, + 'MyAccount/invoice' => \&invoice, +); + +#store in db? +my $cache = new Cache::SharedMemoryCache(); + +#false laziness w/FS::ClientAPI::passwd::passwd (needs to handle encrypted pw) +sub login { + my $p = shift; + + my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) + or return { error => "Domain not found" }; + + my $svc_acct = + ( length($p->{'password'}) < 13 + && qsearchs( 'svc_acct', { 'username' => $p->{'username'}, + 'domsvc' => $svc_domain->svcnum, + '_password' => $p->{'password'} } ) + ) + || qsearchs( 'svc_acct', { 'username' => $p->{'username'}, + 'domsvc' => $svc_domain->svcnum, + '_password' => $p->{'password'} } ); + + unless ( $svc_acct ) { return { error => 'Incorrect password.' } } + + my $session = { + 'svcnum' => $svc_acct->svcnum, + }; + + my $cust_pkg = $svc_acct->cust_svc->cust_pkg; + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + $session->{'custnum'} = $cust_main->custnum; + } + + my $session_id; + do { + $session_id = md5_hex(md5_hex(time(). {}. rand(). $$)) + } until ( ! defined $cache->get($session_id) ); #just in case + + $cache->set( $session_id, $session, '1 hour' ); + + return { 'error' => '', + 'session_id' => $session_id, + }; +} + +sub customer_info { + my $p = shift; + my $session = $cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my %return; + + my $custnum = $session->{'custnum'}; + + if ( $custnum ) { #customer record + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or return { 'error' => "unknown custnum $custnum" }; + + $return{balance} = $cust_main->balance; + + my @open = map { + { + invnum => $_->invnum, + date => time2str("%b %o, %Y", $_->_date), + owed => $_->owed, + }; + } $cust_main->open_cust_bill; + $return{open_invoices} = \@open; + + my $conf = new FS::Conf; + $return{small_custview} = + small_custview( $cust_main, $conf->config('defaultcountry') ); + + $return{name} = $cust_main->first. ' '. $cust_main->get('last'); + + } else { #no customer record + + my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $session->{'svcnum'} } ) + or die "unknown svcnum"; + $return{name} = $svc_acct->email; + + } + + + return { 'error' => '', + 'custnum' => $custnum, + %return, + }; + +} + +sub invoice { + my $p = shift; + my $session = $cache->get($p->{'session_id'}) + or return { 'error' => "Can't resume session" }; #better error message + + my $custnum = $session->{'custnum'}; + + my $invnum = $p->{'invnum'}; + + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum, + 'custnum' => $custnum } ) + or return { 'error' => "Can't find invnum" }; + + #my %return; + + return { 'error' => '', + 'invnum' => $invnum, + 'invoice_text' => join('', $cust_bill->print_text ), + }; + +} + + diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm new file mode 100644 index 000000000..29606227d --- /dev/null +++ b/FS/FS/ClientAPI/passwd.pm @@ -0,0 +1,56 @@ +package FS::ClientAPI::passwd; + +use strict; +use FS::Record qw(qsearchs); +use FS::svc_acct; +#use FS::svc_domain; + +use FS::ClientAPI; #hmm +FS::ClientAPI->register_handlers( + 'passwd/passwd' => \&passwd, + 'passwd/chfn' => \&chfn, + 'passwd/chsh' => \&chsh, +); + +sub passwd { + my $packet = shift; + + #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } ) + # or return { error => "Domain $domain not found" }; + + my $old_password = $packet->{'old_password'}; + my $new_password = $packet->{'new_password'}; + my $new_gecos = $packet->{'new_gecos'}; + my $new_shell = $packet->{'new_shell'}; + +#false laziness w/FS::ClientAPI::MyAccount::login (needs to handle encrypted pw) + my $svc_acct = + ( length($old_password) < 13 + && qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, + #'domsvc' => $svc_domain->svcnum, + '_password' => $old_password } ) + ) + || qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, + #'domsvc' => $svc_domain->svcnum, + '_password' => $old_password } ); + + unless ( $svc_acct ) { return { error => 'Incorrect password.' } } + + my %hash = $svc_acct->hash; + my $new_svc_acct = new FS::svc_acct ( \%hash ); + $new_svc_acct->setfield('_password', $new_password ) + if $new_password && $new_password ne $old_password; + $new_svc_acct->setfield('finger',$new_gecos) if $new_gecos; + $new_svc_acct->setfield('shell',$new_shell) if $new_shell; + my $error = $new_svc_acct->replace($svc_acct); + + return { error => $error }; + +} + +sub chfn {} + +sub chsh {} + +1; + diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 126461763..e93eaf3fc 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -221,8 +221,8 @@ httemplate/docs/config.html { 'key' => 'apacheroot', - 'section' => 'apache', - 'description' => 'The directory containing Apache virtual hosts', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, add a <i>www_shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. The directory containing Apache virtual hosts', 'type' => 'text', }, @@ -235,8 +235,8 @@ httemplate/docs/config.html { 'key' => 'apachemachine', - 'section' => 'apache', - 'description' => 'A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, add a <i>www_shellcommands</i> <a href="../browse/part_export.cgi">export</a> instead. A machine with the apacheroot directory and user home directories. The existance of this file enables setup of virtual host directories, and, in conjunction with the `home\' configuration file, symlinks into user home directories.', 'type' => 'text', }, @@ -249,15 +249,15 @@ httemplate/docs/config.html { 'key' => 'bindprimary', - 'section' => 'BIND', - 'description' => 'Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, add a <i>bind</i> <a href="../browse/part_export.cgi">export</a> instead. Your BIND primary nameserver. This enables export of /var/named/named.conf and zone files into /var/named', 'type' => 'text', }, { 'key' => 'bindsecondaries', - 'section' => 'BIND', - 'description' => 'Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, add a <i>bind_slave</i> <a href="../browse/part_export.cgi">export</a> instead. Your BIND secondary nameservers, one per line. This enables export of /var/named/named.conf', 'type' => 'textarea', }, @@ -277,8 +277,8 @@ httemplate/docs/config.html { 'key' => 'bsdshellmachines', - 'section' => 'shell', - 'description' => 'Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, add a <i>bsdshell</i> <a href="../browse/part_export.cgi">export</a> instead. Your BSD flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/master.passwd\'.', 'type' => 'textarea', }, @@ -348,7 +348,7 @@ httemplate/docs/config.html { 'key' => 'editreferrals', 'section' => 'UI', - 'description' => 'Enable referral modification for existing customers', + 'description' => 'Enable advertising source modification for existing customers', 'type' => 'checkbox', }, @@ -404,28 +404,28 @@ httemplate/docs/config.html { 'key' => 'icradiusmachines', 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add a <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the <a href="http://rootwood.haze.st/aspside/config/config-view.cgi#icradius_secrets">icradius_secrets</a> config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option. <blockquote><b>ADDITIONAL DEPRECATED FUNCTIONALITY</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines or <a href="http://www.freeradius.org/">FreeRADIUS</a> (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: <CODE>"radius.isp.tld radius_db radius_user passw0rd"</CODE></blockquote>', + 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to enable radcheck and radreply table population - by default in the Freeside database, or in the database specified by the <a href="http://rootwood.haze.st/aspside/config/config-view.cgi#icradius_secrets">icradius_secrets</a> config option (the radcheck and radreply tables needs to be created manually). You do not need to use MySQL for your Freeside database to export to an ICRADIUS/FreeRADIUS MySQL database with this option. <blockquote><b>ADDITIONAL DEPRECATED FUNCTIONALITY</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - your <a href="ftp://ftp.cheapnet.net/pub/icradius">ICRADIUS</a> machines or <a href="http://www.freeradius.org/">FreeRADIUS</a> (with MySQL authentication) machines, one per line. Machines listed in this file will have the radcheck table exported to them. Each line should contain four items, separted by whitespace: machine name, MySQL database name, MySQL username, and MySQL password. For example: <CODE>"radius.isp.tld radius_db radius_user passw0rd"</CODE></blockquote>', 'type' => [qw( checkbox textarea )], }, { 'key' => 'icradius_mysqldest', 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - Destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', + 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> https://billing.crosswind.net/freeside/browse/part_export.cgi">export</a> instead. Used to be the destination directory for the MySQL databases, on the ICRADIUS/FreeRADIUS machines. Defaults to "/usr/local/var/".', 'type' => 'text', }, { 'key' => 'icradius_mysqlsource', 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b> (instead use <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Replication">MySQL replication</a> or point icradius_secrets to the external database) - Source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', + 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> https://billing.crosswind.net/freeside/browse/part_export.cgi">export</a> instead. Used to be the source directory for for the MySQL radcheck table files, on the Freeside machine. Defaults to "/usr/local/var/freeside".', 'type' => 'text', }, { 'key' => 'icradius_secrets', 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, add <i>sqlradius</i> exports to <a href="../browse/part_svc">Service definitions</a> instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', + 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> https://billing.crosswind.net/freeside/browse/part_export.cgi">export</a> instead. This option used to specify a database for ICRADIUS/FreeRADIUS export. Three lines: DBI data source, username and password.', 'type' => 'textarea', }, @@ -506,8 +506,8 @@ httemplate/docs/config.html { 'key' => 'nismachines', - 'section' => 'shell', - 'description' => 'Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>. Your NIS master (not slave master) machines, one per line. This enables export of `/etc/global/passwd\' and `/etc/global/shadow\'.', 'type' => 'textarea', }, @@ -534,8 +534,8 @@ httemplate/docs/config.html { 'key' => 'radiusmachines', - 'section' => 'radius', - 'description' => 'Your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, add an <i>sqlradius</i> <a href="../browse/part_export.cgi">export</a> instead. This option used to export to be: your RADIUS authentication machines, one per line. This enables export of `/etc/raddb/users\'.', 'type' => 'textarea', }, @@ -633,8 +633,8 @@ httemplate/docs/config.html { 'key' => 'shellmachines', - 'section' => 'shell', - 'description' => 'Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, add a <i>sysvshell</i> <a href="../browse/part_export.cgi">export</a> instead. Your Linux and System V flavored shell (and mail) machines, one per line. This enables export of `/etc/passwd\' and `/etc/shadow\' files.', 'type' => 'textarea', }, @@ -717,15 +717,15 @@ httemplate/docs/config.html { 'key' => 'radiusprepend', - 'section' => 'radius', - 'description' => 'The contents will be prepended to the top of the RADIUS users file (text exports only).', + 'section' => 'deprecated', + 'description' => '<b>DEPRECATED</b>, real-time text radius now edits an existing file in place - just (turn off freeside-queued and) edit your RADIUS users file directly. The contents used to be be prepended to the top of the RADIUS users file (text exports only).', 'type' => 'textarea', }, { 'key' => 'textradiusprepend', 'section' => 'deprecated', - 'description' => '<b>DEPRECATED</b>, use RADIUS check attributes instead. This option will be removed soon. The contents will be prepended to the first line of a user\'s RADIUS entry in text exports.', + 'description' => '<b>DEPRECATED</b>, use RADIUS check attributes instead. The contents used to be prepended to the first line of a user\'s RADIUS entry in text exports.', 'type' => 'text', }, @@ -937,6 +937,35 @@ httemplate/docs/config.html 'type' => 'checkbox', }, + { + 'key' => 'welcome_email', + 'section' => '', + 'description' => 'Template file for welcome email. Welcome emails are sent to the customer email invoice destination(s) each time a svc_acct record is created. See the <a href="http://search.cpan.org/doc/MJD/Text-Template-1.42/Template.pm">Text::Template</a> documentation for details on the template substitution language. The following variables are available: <code>$username</code>, <code>$password</code>, <code>$first</code>, <code>$last</code> and <code>$pkg</code>.', + 'type' => 'textarea', + }, + + { + 'key' => 'welcome_email-from', + 'section' => '', + 'description' => 'From: address header for welcome email', + 'type' => 'text', + }, + + { + 'key' => 'welcome_email-subject', + 'section' => '', + 'description' => 'Subject: header for welcome email', + 'type' => 'text', + }, + + { + 'key' => 'welcome_email-mimetype', + 'section' => '', + 'description' => 'MIME type for welcome email', + 'type' => 'select', + 'select_enum' => [ 'text/plain', 'text/html' ], + }, + ); 1; diff --git a/FS/FS/InitHandler.pm b/FS/FS/InitHandler.pm new file mode 100644 index 000000000..87f507c22 --- /dev/null +++ b/FS/FS/InitHandler.pm @@ -0,0 +1,88 @@ +package FS::InitHandler; + +use strict; +use vars qw($DEBUG); +use FS::UID qw(adminsuidsetup); +use FS::Record; + +$DEBUG = 1; + +sub handler { + + use Date::Format; + use Date::Parse; + use Tie::IxHash; + use HTML::Entities; + use IO::Handle; + use IO::File; + use String::Approx; + use HTML::Widgets::SelectLayers 0.02; + #use FS::UID; + #use FS::Record; + use FS::Conf; + use FS::CGI; + use FS::Msgcat; + + use FS::agent; + use FS::agent_type; + use FS::domain_record; + use FS::cust_bill; + use FS::cust_bill_pay; + use FS::cust_credit; + use FS::cust_credit_bill; + use FS::cust_main; + use FS::cust_main_county; + use FS::cust_pay; + use FS::cust_pkg; + use FS::cust_refund; + use FS::cust_svc; + use FS::nas; + use FS::part_bill_event; + use FS::part_pkg; + use FS::part_referral; + use FS::part_svc; + use FS::pkg_svc; + use FS::port; + use FS::queue; + use FS::raddb; + use FS::session; + use FS::svc_acct; + use FS::svc_acct_pop; + use FS::svc_acct_sm; + use FS::svc_domain; + use FS::svc_forward; + use FS::svc_www; + use FS::type_pkgs; + use FS::part_export; + use FS::part_export_option; + use FS::export_svc; + use FS::msgcat; + + warn "[FS::InitHandler] handler called\n" if $DEBUG; + + #this is sure to be broken on freebsd + $> = $FS::UID::freeside_uid; + + open(MAPSECRETS,"<$FS::UID::conf_dir/mapsecrets") + or die "can't read $FS::UID::conf_dir/mapsecrets: $!"; + + my %seen; + while (<MAPSECRETS>) { + next if /^\s*(#|$)/; + /^([\w\-\.]+)\s(.*)$/ + or do { warn "strange line in mapsecrets: $_"; next; }; + my($user, $datasrc) = ($1, $2); + next if $seen{$datasrc}++; + warn "[FS::InitHandler] preloading $datasrc for $user\n" if $DEBUG; + adminsuidsetup($user); + } + + close MAPSECRETS; + + #lalala probably broken on freebsd + ($<, $>) = ($>, $<); + $< = 0; + +} + +1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index f7c3a41c8..e6126a13b 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -2,7 +2,7 @@ package FS::Record; use strict; use vars qw( $dbdef_file $dbdef $setup_hack $AUTOLOAD @ISA @EXPORT_OK $DEBUG - $me ); + $me %dbdef_cache ); use subs qw(reload_dbdef); use Exporter; use Carp qw(carp cluck croak confess); @@ -132,15 +132,8 @@ sub new { my $hashref = $self->{'Hash'} = shift; - foreach my $field ( $self->fields ) { - $hashref->{$field}='' unless defined $hashref->{$field}; - #trim the '$' and ',' from money fields for Pg (belong HERE?) - #(what about Pg i18n?) - if ( driver_name =~ /^Pg$/i - && $self->dbdef_table->column($field)->type eq 'money' ) { - ${$hashref}{$field} =~ s/^\$//; - ${$hashref}{$field} =~ s/\,//; - } + foreach my $field ( grep !defined($hashref->{$_}), $self->fields ) { + $hashref->{$field}=''; } $self->_cache($hashref, shift) if $self->can('_cache') && @_; @@ -250,7 +243,7 @@ sub qsearch { } $statement .= " $extra_sql" if defined($extra_sql); - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = $dbh->prepare($statement) or croak "$dbh->errstr doing $statement"; @@ -502,13 +495,13 @@ sub insert { join( ', ', @values ). ")" ; - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; my $h_sth; if ( defined $dbdef->table('h_'. $self->table) ) { my $h_statement = $self->_h_statement('insert'); - warn "[debug]$me $h_statement\n" if $DEBUG; + warn "[debug]$me $h_statement\n" if $DEBUG > 2; $h_sth = dbh->prepare($h_statement) or return dbh->errstr; } else { $h_sth = ''; @@ -562,13 +555,13 @@ sub delete { ? ( $self->dbdef_table->primary_key) : $self->fields ); - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; my $h_sth; if ( defined $dbdef->table('h_'. $self->table) ) { my $h_statement = $self->_h_statement('delete'); - warn "[debug]$me $h_statement\n" if $DEBUG; + warn "[debug]$me $h_statement\n" if $DEBUG > 2; $h_sth = dbh->prepare($h_statement) or return dbh->errstr; } else { $h_sth = ''; @@ -647,13 +640,13 @@ sub replace { } ( $primary_key ? ( $primary_key ) : $old->fields ) ) ; - warn "[debug]$me $statement\n" if $DEBUG; + warn "[debug]$me $statement\n" if $DEBUG > 1; my $sth = dbh->prepare($statement) or return dbh->errstr; my $h_old_sth; if ( defined $dbdef->table('h_'. $old->table) ) { my $h_old_statement = $old->_h_statement('replace_old'); - warn "[debug]$me $h_old_statement\n" if $DEBUG; + warn "[debug]$me $h_old_statement\n" if $DEBUG > 2; $h_old_sth = dbh->prepare($h_old_statement) or return dbh->errstr; } else { $h_old_sth = ''; @@ -662,7 +655,7 @@ sub replace { my $h_new_sth; if ( defined $dbdef->table('h_'. $new->table) ) { my $h_new_statement = $new->_h_statement('replace_new'); - warn "[debug]$me $h_new_statement\n" if $DEBUG; + warn "[debug]$me $h_new_statement\n" if $DEBUG > 2; $h_new_sth = dbh->prepare($h_new_statement) or return dbh->errstr; } else { $h_new_sth = ''; @@ -735,7 +728,7 @@ sub unique { my($self,$field) = @_; my($table)=$self->table; - croak("&FS::UID::checkruid failed") unless &checkruid; + #croak("&FS::UID::checkruid failed") unless &checkruid; croak "Unique called on field $field, but it is ", $self->getfield($field), @@ -1130,8 +1123,15 @@ I<$FS::Record::setup_hack> is true. Returns a DBIx::DBSchema object. sub reload_dbdef { my $file = shift || $dbdef_file; - $dbdef = load DBIx::DBSchema $file - or die "can't load database schema from $file"; + + unless ( exists $dbdef_cache{$file} ) { + warn "[debug]$me loading dbdef for $file\n" if $DEBUG; + $dbdef_cache{$file} = DBIx::DBSchema->load( $file ) + or die "can't load database schema from $file"; + } else { + warn "[debug]$me re-using cached dbdef for $file\n" if $DEBUG; + } + $dbdef = $dbdef_cache{$file}; } =item dbdef diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index d34d28e06..0b10612c5 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -92,6 +92,7 @@ sub forksuidsetup { foreach ( keys %callback ) { &{$callback{$_}}; + # breaks multi-database installs # delete $callback{$_}; #run once } $dbh; @@ -255,7 +256,7 @@ coderef into the hash %FS::UID::callback : =head1 VERSION -$Id: UID.pm,v 1.14 2002-02-23 07:00:21 ivan Exp $ +$Id: UID.pm,v 1.18 2002-07-03 11:23:25 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 449ab74b9..5a9fdd09b 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -8,7 +8,7 @@ use vars qw( $xaction $E_NoErr ); use vars qw( $bop_processor $bop_login $bop_password $bop_action @bop_options ); use vars qw( $invoice_lines @buf ); #yuck use Date::Format; -use Mail::Internet; +use Mail::Internet 1.44; use Mail::Header; use Text::Template; use FS::Record qw( qsearch qsearchs ); @@ -369,9 +369,9 @@ emails or print. See L<FS::cust_main_invoice>. sub send { my($self,$template) = @_; - - #my @print_text = $cust_bill->print_text; #( date ) + my @print_text = $self->print_text('', $template); my @invoicing_list = $self->cust_main->invoicing_list; + if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice #false laziness w/FS::cust_pay::delete & fs_signup_server && ::realtime_card #$ENV{SMTPHOSTS} = $smtpmachine; @@ -386,7 +386,7 @@ sub send { ] ); my $message = new Mail::Internet ( 'Header' => $header, - 'Body' => [ $self->print_text('', $template) ], #( date) + 'Body' => [ @print_text ], #( date) ); $!=0; $message->smtpsend( Host => $smtpmachine ) @@ -395,11 +395,12 @@ sub send { " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). " via server $smtpmachine with SMTP: $!"; - #} elsif ( grep { $_ eq 'POST' } @invoicing_list ) { - } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { + } + + if ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { #postal open(LPR, "|$lpr") or return "Can't open pipe to $lpr: $!"; - print LPR $self->print_text; #( date ) + print LPR @print_text; close LPR or return $! ? "Error closing $lpr: $!" : "Exit status $? from $lpr"; @@ -525,6 +526,7 @@ sub realtime_card { if ( $transaction->is_success() && $action2 ) { my $auth = $transaction->authorization; my $ordernum = $transaction->order_number; + #warn "********* $auth ***********\n"; #warn "********* $ordernum ***********\n"; my $capture = @@ -590,7 +592,7 @@ sub realtime_card { $template->compile() or return "($perror) can't compile template: $Text::Template::ERROR"; - my $error = $transaction->error_message; + my $templ_hash = { error => $transaction->error_message }; #false laziness w/FS::cust_pay::delete & fs_signup_server && ::send $ENV{MAILADDRESS} = $invoice_from; @@ -604,7 +606,7 @@ sub realtime_card { ] ); my $message = new Mail::Internet ( 'Header' => $header, - 'Body' => [ $template->fill_in() ], + 'Body' => [ $template->fill_in(HASH => $templ_hash) ], ); $!=0; $message->smtpsend( Host => $smtpmachine ) @@ -726,8 +728,10 @@ sub batch_card { 'payname' => $cust_main->getfield('payname'), 'amount' => $self->owed, } ); - $cust_pay_batch->insert; + my $error = $cust_pay_batch->insert; + die $error if $error; + ''; } =item print_text [TIME]; @@ -948,7 +952,7 @@ sub print_text { =head1 VERSION -$Id: cust_bill.pm,v 1.34 2002-05-06 13:36:02 ivan Exp $ +$Id: cust_bill.pm,v 1.38 2002-06-26 02:37:48 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_bill_event.pm b/FS/FS/cust_bill_event.pm index d5ca55f36..f631987aa 100644 --- a/FS/FS/cust_bill_event.pm +++ b/FS/FS/cust_bill_event.pm @@ -143,6 +143,21 @@ sub cust_bill { qsearchs( 'cust_bill', { 'invnum' => $self->invnum } ); } +=item retry + +Changes the status of this event from B<done> to B<failed>, allowing it to be +retried. + +=cut + +sub retry { + my $self = shift; + return '' unless $self->status eq 'done'; + my $old = ref($self)->new( { $self->hash } ); + $self->status('failed'); + $self->replace($old); +} + =back =head1 BUGS diff --git a/FS/FS/cust_credit.pm b/FS/FS/cust_credit.pm index 0ce5ac614..284d59de2 100644 --- a/FS/FS/cust_credit.pm +++ b/FS/FS/cust_credit.pm @@ -104,8 +104,6 @@ sub insert { return "error inserting $self: $error"; } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { my @errors = $cust_main->unsuspend; @@ -117,6 +115,8 @@ sub insert { } #eslaf + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } @@ -242,7 +242,7 @@ sub credited { =head1 VERSION -$Id: cust_credit.pm,v 1.15 2002-01-28 06:57:23 ivan Exp $ +$Id: cust_credit.pm,v 1.16 2002-06-04 14:35:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 0faa60ca6..eb468d981 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -27,6 +27,7 @@ use FS::part_pkg; use FS::part_bill_event; use FS::cust_bill_event; use FS::cust_tax_exempt; +use FS::type_pkgs; use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); @@ -220,7 +221,8 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: sub insert { my $self = shift; - my @param = @_; + my $cust_pkgs = @_ ? shift : {}; + my $invoicing_list = @_ ? shift : ''; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -261,27 +263,35 @@ sub insert { return $error; } - if ( @param ) { # CUST_PKG_HASHREF - my $cust_pkgs = shift @param; - foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - $error = $cust_pkg->insert; + # invoicing list + if ( $invoicing_list ) { + $error = $self->check_invoicing_list( $invoicing_list ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "checking invoicing_list (transaction rolled back): $error"; + } + $self->invoicing_list( $invoicing_list ); + } + + # packages + foreach my $cust_pkg ( keys %$cust_pkgs ) { + $cust_pkg->custnum( $self->custnum ); + $error = $cust_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_pkg (transaction rolled back): $error"; + } + foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { + $svc_something->pkgnum( $cust_pkg->pkgnum ); + if ( $seconds && $svc_something->isa('FS::svc_acct') ) { + $svc_something->seconds( $svc_something->seconds + $seconds ); + $seconds = 0; + } + $error = $svc_something->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $seconds ); - $seconds = 0; - } - $error = $svc_something->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } + #return "inserting svc_ (transaction rolled back): $error"; + return $error; } } } @@ -291,16 +301,6 @@ sub insert { return "No svc_acct record to apply pre-paid time"; } - if ( @param ) { # INVOICING_LIST_ARYREF - my $invoicing_list = shift @param; - $error = $self->check_invoicing_list( $invoicing_list ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "checking invoicing_list (transaction rolled back): $error"; - } - $self->invoicing_list( $invoicing_list ); - } - if ( $amount ) { my $cust_credit = new FS::cust_credit { 'custnum' => $self->custnum, @@ -482,6 +482,32 @@ sub replace { $self->invoicing_list( $invoicing_list ); } + if ( $self->payby eq 'CARD' && + grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { + # card info has changed, want to retry realtime_card invoice events + #false laziness w/collect + foreach my $cust_bill_event ( + grep { + #$_->part_bill_event->plan eq 'realtime-card' + $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' + && $_->status eq 'done' + && $_->statustext + } + map { $_->cust_bill_event } + grep { $_->cust_bill_event } + $self->open_cust_bill + + ) { + my $error = $cust_bill_event->retry; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error scheduling invoice events for retry: $error"; + } + } + #eslaf + + } + #false laziness with sub insert my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; $error = $queue->insert($self->getfield('last'), $self->company); @@ -1027,8 +1053,8 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', map $self->$_(), qw(state county country taxclass) ). - "\n"; + join('/', ( map $self->$_(), qw(state county country) ), + $part_pkg->taxclass ). "\n"; }; if ( $cust_main_county->exempt_amount ) { @@ -1171,6 +1197,8 @@ invoice_time - Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. +retry_card - Retry cards even when not scheduled by invoice events. + batch_card - This option is deprecated. See the invoice events web interface to control whether cards are batched or run against a realtime gateway. @@ -1203,9 +1231,29 @@ sub collect { return ''; } - foreach my $cust_bill ( - qsearch('cust_bill', { 'custnum' => $self->custnum, } ) - ) { + if ( exists($options{'retry_card'}) && $options{'retry_card'} ) { + #false laziness w/replace + foreach my $cust_bill_event ( + grep { + #$_->part_bill_event->plan eq 'realtime-card' + $_->part_bill_event->eventcode eq '$cust_bill->realtime_card();' + && $_->status eq 'done' + && $_->statustext + } + map { $_->cust_bill_event } + grep { $_->cust_bill_event } + $self->open_cust_bill + ) { + my $error = $cust_bill_event->retry; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error scheduling invoice events for retry: $error"; + } + } + #eslaf + } + + foreach my $cust_bill ( $self->cust_bill ) { #this has to be before next's my $amount = sprintf( "%.2f", $balance < $cust_bill->owed @@ -1223,6 +1271,7 @@ sub collect { next unless $amount > 0; + foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds || $a->weight <=> $b->weight @@ -1685,7 +1734,7 @@ sub credit { $cust_credit->insert; } -=item charge AMOUNT PKG COMMENT +=item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ] Creates a one-time charge for this customer. If there is an error, returns the error, otherwise returns false. @@ -1693,19 +1742,87 @@ the error, otherwise returns false. =cut sub charge { - my ( $self, $amount, $pkg, $comment ) = @_; + my ( $self, $amount ) = ( shift, shift ); + my $pkg = @_ ? shift : 'One-time charge'; + my $comment = @_ ? shift : '$'. sprintf("%.2f",$amount); + my $taxclass = @_ ? 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 $part_pkg = new FS::part_pkg ( { - 'pkg' => $pkg || 'One-time charge', - 'comment' => $comment || '$'. sprintf("%.2f".$amount), + 'pkg' => $pkg, + 'comment' => $comment, 'setup' => $amount, 'freq' => 0, 'recur' => '0', 'disabled' => 'Y', + 'taxclass' => $taxclass, + } ); + + my $error = $part_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + my $pkgpart = $part_pkg->pkgpart; + my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart ); + unless ( qsearchs('type_pkgs', \%type_pkgs ) ) { + my $type_pkgs = new FS::type_pkgs \%type_pkgs; + $error = $type_pkgs->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $cust_pkg = new FS::cust_pkg ( { + 'custnum' => $self->custnum, + 'pkgpart' => $pkgpart, } ); - $part_pkg->insert; + $error = $cust_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item cust_bill + +Returns all the invoices (see L<FS::cust_bill>) for this customer. +=cut + +sub cust_bill { + my $self = shift; + sort { $a->_date <=> $b->_date } + qsearch('cust_bill', { 'custnum' => $self->custnum, } ) +} + +=item open_cust_bill + +Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this +customer. + +=cut + +sub open_cust_bill { + my $self = shift; + grep { $_->owed > 0 } $self->cust_bill; } =back diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index 28f69c262..e41564d21 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -128,6 +128,8 @@ sub regionselector { my ( $selected_county, $selected_state, $selected_country, $prefix, $onchange ) = @_; + $prefix = '' unless defined $prefix; + $countyflag = 0; # unless ( @cust_main_county ) { #cache diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index ac60dc242..98eba704b 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -4,7 +4,7 @@ use strict; use vars qw( @ISA $conf $unsuspendauto $smtpmachine $invoice_from ); use Date::Format; use Mail::Header; -use Mail::Internet; +use Mail::Internet 1.44; use Business::CreditCard; use FS::UID qw( dbh ); use FS::Record qw( dbh qsearch qsearchs dbh ); @@ -152,8 +152,6 @@ sub insert { } } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - #false laziness w/ cust_credit::insert if ( $unsuspendauto && $old_balance && $cust_main->balance <= 0 ) { my @errors = $cust_main->unsuspend; @@ -165,6 +163,8 @@ sub insert { } #eslaf + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; } @@ -405,7 +405,7 @@ sub unapplied { =head1 VERSION -$Id: cust_pay.pm,v 1.19 2002-04-07 06:23:29 ivan Exp $ +$Id: cust_pay.pm,v 1.21 2002-06-04 14:35:52 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index a4256ea1f..8b65ac4bd 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -268,33 +268,11 @@ sub cancel { foreach my $cust_svc ( qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); - - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; - - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->cancel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling service: $error" - } - $error = $svc->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error deleting service: $error"; - } - } + my $error = $cust_svc->cancel; - $error = $cust_svc->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "Error deleting cust_svc: $error"; + return "Error cancelling cust_svc: $error"; } } @@ -701,7 +679,7 @@ sub order { =head1 VERSION -$Id: cust_pkg.pm,v 1.21 2002-05-04 00:47:24 ivan Exp $ +$Id: cust_pkg.pm,v 1.22 2002-05-22 12:17:06 ivan Exp $ =head1 BUGS diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index e6194b5b7..c7cc4b322 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -85,9 +85,67 @@ otherwise returns false. =item delete Deletes this service from the database. If there is an error, returns the -error, otherwise returns false. +error, otherwise returns false. Note that this only removes the cust_svc +record - you should probably use the B<cancel> method instead. -Called by the cancel method of the package (see L<FS::cust_pkg>). +=item cancel + +Cancels the relevant service by calling the B<cancel> method of the associated +FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object), +deleting the FS::svc_XXX record and then deleting this record. + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub cancel { + my $self = 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 $part_svc = $self->part_svc; + + $part_svc->svcdb =~ /^([\w\-]+)$/ or do { + $dbh->rollback if $oldAutoCommit; + return "Illegal svcdb value in part_svc!"; + }; + my $svcdb = $1; + require "FS/$svcdb.pm"; + + my $svc = $self->svc_x; + if ($svc) { + my $error = $svc->cancel; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error canceling service: $error"; + } + $error = $svc->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error deleting service: $error"; + } + } + + my $error = $self->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error deleting cust_svc: $error"; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; #no errors + +} =item replace OLD_RECORD @@ -286,7 +344,7 @@ sub seconds_since { =head1 VERSION -$Id: cust_svc.pm,v 1.14 2002-04-20 02:06:38 ivan Exp $ +$Id: cust_svc.pm,v 1.15 2002-05-22 12:17:06 ivan Exp $ =head1 BUGS diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 6f4dd0287..37cc6c9e8 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -1,10 +1,11 @@ package FS::domain_record; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $noserial_hack ); #use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs dbh ); use FS::svc_domain; +use FS::svc_www; @ISA = qw(FS::Record); @@ -71,12 +72,93 @@ otherwise returns false. =cut +sub insert { + my $self = 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; + + if ( $self->rectype eq '_mstr' ) { #delete all other records + foreach my $domain_record ( reverse $self->svc_domain->domain_record ) { + my $error = $domain_record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { + my $error = $self->increment_serial; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item delete Delete this record from the database. =cut +sub delete { + my $self = shift; + + return "Can't delete a domain record which has a website!" + if qsearchs( 'svc_www', { 'recnum' => $self->recnum } ); + + 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 $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { + my $error = $self->increment_serial; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item replace OLD_RECORD Replaces the OLD_RECORD with this one in the database. If there is an error, @@ -84,6 +166,40 @@ returns the error, otherwise returns false. =cut +sub replace { + my $self = 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 $error = $self->SUPER::replace(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + unless ( $self->rectype eq 'SOA' ) { + my $error = $self->increment_serial; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + +} + =item check Checks all fields to make sure this is a valid example. If there is @@ -158,11 +274,46 @@ sub check { ''; #no error } +=item increment_serial + +=cut + +sub increment_serial { + return '' if $noserial_hack; + my $self = shift; + + my $soa = qsearchs('domain_record', { + svcnum => $self->svcnum, + reczone => '@', #or full domain ? + recaf => 'IN', + rectype => 'SOA', + } ) or return "soa record not found; can't increment serial"; + + my $data = $soa->recdata; + $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works. + + my %hash = $soa->hash; + $hash{recdata} = $data; + my $new = new FS::domain_record \%hash; + $new->replace($soa); +} + +=item svc_domain + +Returns the domain (see L<FS::svc_domain>) for this record. + +=cut + +sub svc_domain { + my $self = shift; + qsearchs('svc_domain', { svcnum => $self->svcnum } ); +} + =back =head1 VERSION -$Id: domain_record.pm,v 1.7 2002-04-20 11:57:35 ivan Exp $ +$Id: domain_record.pm,v 1.11 2002-06-23 19:16:45 ivan Exp $ =head1 BUGS diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 752bbb1d3..0597cddf2 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -141,7 +141,7 @@ sub insert { ''; -}; +} =item delete @@ -371,6 +371,7 @@ sub rebless { my $exporttype = $self->exporttype; my $class = ref($self). "::$exporttype"; eval "use $class;"; + die $@ if $@; bless($self, $class); } @@ -413,6 +414,26 @@ sub export_delete { $self->_export_delete(@_); } +=item export_suspend + +=cut + +sub export_suspend { + my $self = shift; + $self->rebless; + $self->_export_suspend(@_); +} + +=item export_unsuspend + +=cut + +sub export_unsuspend { + my $self = shift; + $self->rebless; + $self->_export_unsuspend(@_); +} + #fallbacks providing useful error messages intead of infinite loops sub _export_insert { my $self = shift; @@ -429,6 +450,20 @@ sub _export_delete { return "_export_delete: unknown export type ". $self->exporttype; } +#fallbacks providing null operations + +sub _export_suspend { + my $self = shift; + #warn "warning: _export_suspened unimplemented for". ref($self); + ''; +} + +sub _export_unsuspend { + my $self = shift; + #warn "warning: _export_unsuspend unimplemented for ". ref($self); + ''; +} + =back =head1 SUBROUTINES @@ -459,33 +494,55 @@ sub export_info { my $r = { map { %{$exports{$_}} } keys %exports }; } -=item exporttype2svcdb EXPORTTYPE - -Returns the applicable I<svcdb> for an I<exporttype>. +#=item exporttype2svcdb EXPORTTYPE +# +#Returns the applicable I<svcdb> for an I<exporttype>. +# +#=cut +# +#sub exporttype2svcdb { +# my $exporttype = $_[0]; +# foreach my $svcdb ( keys %exports ) { +# return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; +# } +# ''; +#} -=cut +tie my %sysvshell_options, 'Tie::IxHash', + 'crypt' => { label=>'Password encryption', + type=>'select', options=>[qw(crypt md5)], + default=>'crypt', + }, +; -sub exporttype2svcdb { - my $exporttype = $_[0]; - foreach my $svcdb ( keys %exports ) { - return $svcdb if grep { $exporttype eq $_ } keys %{$exports{$svcdb}}; - } - ''; -} +tie my %bsdshell_options, 'Tie::IxHash', + 'crypt' => { label=>'Password encryption', + type=>'select', options=>[qw(crypt md5)], + default=>'crypt', + }, +; tie my %shellcommands_options, 'Tie::IxHash', #'machine' => { label=>'Remote machine' }, 'user' => { label=>'Remote username', default=>'root' }, 'useradd' => { label=>'Insert command', - default=>'useradd -d $dir -m -s $shell -u $uid $username' + default=>'useradd -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 $username', + default=>'userdel -r $username', #default=>'rm -rf $dir', }, + 'userdel_stdin' => { label=>'Delete command STDIN', + type =>'textarea', + default=>'', + }, 'usermod' => { label=>'Modify command', - default=>'usermod -d $new_dir -l $new_username -s $new_shell -u $new_uid $old_username', + default=>'usermod -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; '. @@ -493,10 +550,57 @@ tie my %shellcommands_options, 'Tie::IxHash', # 'rm -rf $old_dir'. #')' }, + 'usermod_stdin' => { label=>'Modify command STDIN', + type =>'textarea', + default=>'', + }, +; + +tie my %shellcommands_withdomain_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", + }, +; + +tie my %www_shellcommands_options, 'Tie::IxHash', + 'user' => { lable=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone', + }, + 'userdel' => { label=>'Delete command', + default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm $homedir/$zone', + }, + 'usermod' => { label=>'Modify command', + default=>'[ -n "$old_zone" ] && rm $old_homedir/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && mv /var/www/$old_zone /var/www/$new_zone; [ "$old_username" != "$new_username" ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone', + }, +; + +tie my %textradius_options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, ; tie my %sqlradius_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source' }, + 'datasrc' => { label=>'DBI data source ' }, 'username' => { label=>'Database username' }, 'password' => { label=>'Database password' }, ; @@ -545,6 +649,42 @@ tie my %bind_slave_options, 'Tie::IxHash', default => '/etc/bind/named.conf' }, ; +tie my %http_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", + ), + }, +; + +tie my %sqlmail_options, 'Tie::IxHash', + 'datasrc' => { label=>'DBI data source' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, +; #export names cannot have dashes... @@ -552,13 +692,17 @@ tie my %bind_slave_options, 'Tie::IxHash', 'svc_acct' => { 'sysvshell' => { 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)', - 'options' => {}, + 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV).', + 'options' => \%sysvshell_options, + 'nodomain' => 'Y', + 'notes' => 'MD5 crypt requires installation of <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a> from CPAN. Run bin/sysvshell.export to export the files.', }, 'bsdshell' => { 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', - 'options' => {}, + 'Batch export of /etc/passwd and /etc/master.passwd files (BSD).', + 'options' => \%bsdshell_options, + 'nodomain' => 'Y', + 'notes' => 'MD5 crypt requires installation of <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a> from CPAN. Run bin/bsdshell.export to export the files.', }, # 'nis' => { # 'desc' => @@ -566,22 +710,36 @@ tie my %bind_slave_options, 'Tie::IxHash', # 'options' => {}, # }, 'textradius' => { - 'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)', - 'options' => {}, + 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', + 'options' => \%textradius_options, + 'notes' => 'This will edit a text RADIUS users file in place on a remote server. Requires installation of <a href="http://search.cpan.org/search?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>.', }, 'shellcommands' => { 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', 'options' => \%shellcommands_options, 'nodomain' => 'Y', - 'notes' => 'shellcommandsnotes... (this one is the nodomain one)', + 'notes' => '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/NetBSD" onClick=\'this.form.useradd.value = "useradd -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 -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username"; this.form.usermod_stdin.value = "";\'><LI><INPUT TYPE="button" VALUE="FreeBSD" onClick=\'this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -h 0"; this.form.useradd_stdin.value = "$_password\n"; this.form.userdel.value = "pw userdel $username"; 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 -h 0"; this.form.usermod_stdin.value = "$new__password\n";\'><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 $uid.$gid $new_dir; rm -rf $old_dir )"; this.form.usermod_stdin.value = ""; this.form.userdel.value = "rm -rf $dir"; this.form.userdel_stdin.value="";\'></UL>', + }, + + 'shellcommands_withdomain' => { + 'desc' => 'Real-time export via remote SSH.', + 'options' => \%shellcommands_withdomain_options, + 'notes' => '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>.', }, 'sqlradius' => { 'desc' => 'Real-time export to SQL-backed RADIUS (ICRADIUS, FreeRADIUS)', 'options' => \%sqlradius_options, 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> or <a href="http://radius.innercite.com/">ICRADIUS</a>. Use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete and repopulate the tables from the Freeside database.', + 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a> or <a href="http://radius.innercite.com/">ICRADIUS</a>. 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/doc/TIMB/DBI-1.23/DBI.pm">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. If using <a href="http://www.freeradius.org/">FreeRADIUS</a> 0.5 or above, make sure your <b>op</b> fields are set to allow NULL values.', + }, + + 'sqlmail' => { + 'desc' => 'Real-time export to SQL-backed mail server', + 'options' => \%sqlmail_options, + 'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, 'cyrus' => { @@ -607,7 +765,6 @@ tie my %bind_slave_options, 'Tie::IxHash', 'vpopmail' => { 'desc' => 'Real-time export to vpopmail text files', 'options' => \%vpopmail_options, - 'notes' => 'Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text files (...extended description from jeff?...)', }, @@ -618,13 +775,26 @@ tie my %bind_slave_options, 'Tie::IxHash', 'bind' => { 'desc' =>'Batch export to BIND named', 'options' => \%bind_options, - 'notes' => 'bind export notes', + 'notes' => 'Batch export of BIND zone and configuration files to 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.', }, 'bind_slave' => { 'desc' =>'Batch export to slave BIND named', 'options' => \%bind_slave_options, - 'notes' => 'bind export notes (secondary munge)', + 'notes' => 'Batch export of BIND configuration file to a secondary nameserver. Zones are slaved from the listed masters. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/bind.export to export the files.', + }, + + 'http' => { + 'desc' => 'Send an HTTP or HTTPS GET or POST request', + 'options' => \%http_options, + 'notes' => 'Send an HTTP or HTTPS GET or POST to the specified URL. <a href="http://search.cpan.org/search?dist=libwww-perl">libwww-perl</a> must be installed. For HTTPS support, <a href="http://search.cpan.org/search?dist=Crypt-SSLeay">Crypt::SSLeay</a> or <a href="http://search.cpan.org/search?dist=IO-Socket-SSL">IO::Socket::SSL</a> is required.', + }, + + 'sqlmail' => { + 'desc' => 'Real-time export to SQL-backed mail server', + 'options' => \%sqlmail_options, + #'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', }, @@ -632,9 +802,23 @@ tie my %bind_slave_options, 'Tie::IxHash', 'svc_acct_sm' => {}, - 'svc_forward' => {}, + 'svc_forward' => { + 'sqlmail' => { + 'desc' => 'Real-time export to SQL-backed mail server', + 'options' => \%sqlmail_options, + #'nodomain' => 'Y', + 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', + }, + }, - 'svc_www' => {}, + 'svc_www' => { + 'www_shellcommands' => { + 'desc' => 'Run remote commands via SSH, for virtual web sites.', + 'options' => \%www_shellcommands_options, + 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.', + }, + + }, ); @@ -647,7 +831,8 @@ FS/FS/part_export/ (an example may be found in eg/export_template.pm) =head1 BUGS -Probably. +All the stuff in the %exports hash should be generated from the specific +export modules. Hmm... cust_export class (not necessarily a database table...) ... ? diff --git a/FS/FS/part_export/bind.pm b/FS/FS/part_export/bind.pm new file mode 100644 index 000000000..b72c9bdb0 --- /dev/null +++ b/FS/FS/part_export/bind.pm @@ -0,0 +1,7 @@ +package FS::part_export::bind; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/FS/part_export/bind_slave.pm b/FS/FS/part_export/bind_slave.pm new file mode 100644 index 000000000..ebb29c1d7 --- /dev/null +++ b/FS/FS/part_export/bind_slave.pm @@ -0,0 +1,7 @@ +package FS::part_export::bind_slave; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm new file mode 100644 index 000000000..06642097f --- /dev/null +++ b/FS/FS/part_export/bsdshell.pm @@ -0,0 +1,7 @@ +package FS::part_export::bsdshell; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm new file mode 100644 index 000000000..0e02f0f8e --- /dev/null +++ b/FS/FS/part_export/http.pm @@ -0,0 +1,88 @@ +package FS::part_export::http; + +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +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; + +} + diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index e86e82a66..f2d519932 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -1,16 +1,67 @@ package FS::part_export::infostreet; -use vars qw(@ISA); +use vars qw(@ISA %infostreet2cust_main $DEBUG); +use FS::UID qw(dbh); use FS::part_export; @ISA = qw(FS::part_export); +$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); - $self->infostreet_queue( $svc_acct->svcnum, + 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); + my $error = $err_or_queue->depend_insert( $jobnum ); + return $error if $error; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; + } sub _export_replace { @@ -28,6 +79,18 @@ sub _export_delete { '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 { @@ -44,9 +107,54 @@ sub infostreet_queue { ); } +#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_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) ) { @@ -56,6 +164,15 @@ sub infostreet_command { #subroutine, not method } 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); @@ -63,12 +180,30 @@ sub infostreet_command { #subroutine, not method 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, @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 { diff --git a/FS/FS/part_export/null.pm b/FS/FS/part_export/null.pm new file mode 100644 index 000000000..0145af3a4 --- /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/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index ccde72a68..56cd569af 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -1,10 +1,12 @@ package FS::part_export::shellcommands; -use vars qw(@ISA); +use vars qw(@ISA @saltset); use FS::part_export; @ISA = qw(FS::part_export); +@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); + sub rebless { shift; } sub _export_insert { @@ -20,23 +22,39 @@ sub _export_delete { sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); - no strict 'refs'; - ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; - $self->shellcommands_queue( - $self->options('user')||'root'. "\@". $self->options('machine'), - eval(qq("$command")) + my $stdin = $self->option($action."_stdin"); + { + no strict 'refs'; + ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields; + } + $crypt_password = ''; #surpress "used only once" warnings + $crypt_password = crypt( $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] ); + $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'); - no strict 'refs'; - ${"old_$_"} = $old->getfield($_) foreach $old->fields; - ${"new_$_"} = $new->getfield($_) foreach $new->fields; - $self->shellcommands_queue( - $self->options('user')||'root'. "\@". $self->options('machine'), - eval(qq("$command")) + my $stdin = $self->option('usermod_stdin'); + { + no strict 'refs'; + ${"old_$_"} = $old->getfield($_) foreach $old->fields; + ${"new_$_"} = $new->getfield($_) foreach $new->fields; + } + $new_crypt_password = ''; #surpress "used only once" warnings + $new_crypt_password = crypt( $new->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))]); + $self->shellcommands_queue( $new->svcnum, + user => $self->option('user')||'root', + host => $self->machine, + command => eval(qq("$command")), + stdin_string => eval(qq("$stdin")), ); } @@ -45,11 +63,16 @@ sub shellcommands_queue { my( $self, $svcnum ) = (shift, shift); my $queue = new FS::queue { 'svcnum' => $svcnum, - 'job' => "Net::SSH::ssh_cmd", #freeside-queued pre-uses... + 'job' => "FS::part_export::shellcommands::ssh_cmd", }; $queue->insert( @_ ); } +sub ssh_cmd { #subroutine, not method + use Net::SSH '0.06'; + &Net::SSH::ssh_cmd( { @_ } ); +} + #sub shellcommands_insert { #subroutine, not method #} #sub shellcommands_replace { #subroutine, not method diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm new file mode 100644 index 000000000..a15c24d88 --- /dev/null +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -0,0 +1,7 @@ +package FS::part_export::shellcommands_withdomain; + +use vars qw(@ISA); +use FS::part_export::shellcommands; + +@ISA = qw(FS::part_export::shellcommands); + diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm new file mode 100644 index 000000000..4194daf0c --- /dev/null +++ b/FS/FS/part_export/sqlmail.pm @@ -0,0 +1,111 @@ +package FS::part_export::sqlmail; + +use vars qw(@ISA %fs_mail_table %fields); +use FS::part_export; + +@ISA = qw(FS::part_export); + +%fs_mail_table = ( svc_acct => 'user', + svc_domain => 'domain' ); + +# fields that need to be copied into the fs_mail tables +$fields{user} = [qw(username _password finger domsvc svcnum )]; +$fields{domain} = [qw(domain svcnum catchall )]; + +sub rebless { shift; } + +sub _export_insert { + my($self, $svc) = (shift, shift); + # this is a svc_something. + + my $table = $fs_mail_table{$svc->cust_svc->part_svc->svcdb}; + my @attrib = map {$svc->$_} @{$fields{$table}}; + my $error = $self->sqlmail_queue( $svc->svcnum, 'insert', + $table, @attrib ); + return $error if $error; + ''; +} + +sub _export_replace { + my( $self, $new, $old ) = (shift, shift, shift); + + my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; + + my @old = ($old->svcnum, 'delete', $table, $old->svcnum); + my @narf = map {$new->$_} @{$fields{$table}}; + $self->sqlmail_queue($new->svcnum, 'replace', $table, + $new->svcnum, @narf); + + return $error if $error; + ''; +} + +sub _export_delete { + my( $self, $svc ) = (shift, shift); + my $table = $fs_mail_table{$new->cust_svc->part_svc->svcdb}; + $self->sqlmail_queue( $svc->svcnum, 'delete', $table, + $svc->svcnum ); +} + +sub sqlmail_queue { + my( $self, $svcnum, $method, $table ) = (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( $table, @attrib ) = @_; + + my $sth = $dbh->prepare( + "INSERT INTO $table (" . join (',', @{$fields{$table}}) . + ") VALUES ('" . join ("','", @attrib) . "')" + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + $dbh->disconnect; +} + +sub sqlmail_delete { #subroutine, not method + my $dbh = sqlmail_connect(shift, shift, shift); + my( $table, $svcnum ) = @_; + + my $sth = $dbh->prepare( + "DELETE FROM $table WHERE svcnum = $svcnum" + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + $dbh->disconnect; +} + +sub sqlmail_replace { + my $dbh = sqlmail_connect(shift, shift, shift); + my( $table, $svcnum, @attrib ) = @_; + + my %data; + @data{@{$fields{$table}}} = @attrib; + + my $sth = $dbh->prepare( + "UPDATE $table SET " . + ( join ',', map {$_ . "='" . $data{$_} . "'"} keys(%data) ) . + " WHERE svcnum = $svcnum" + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + $dbh->disconnect; +} + +sub sqlmail_connect { + #my($datasrc, $username, $password) = @_; + #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; + DBI->connect(@_) or die $DBI::errstr; +} + diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 51a828001..3c781c043 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -1,6 +1,7 @@ package FS::part_export::sqlradius; use vars qw(@ISA); +use FS::Record qw( dbh ); use FS::part_export; @ISA = qw(FS::part_export); @@ -12,7 +13,7 @@ sub _export_insert { foreach my $table (qw(reply check)) { my $method = "radius_$table"; - my %attrib = $svc_acct->$method; + my %attrib = $svc_acct->$method(); next unless keys %attrib; my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert', $table, $svc_acct->username, %attrib ); @@ -31,32 +32,66 @@ sub _export_insert { sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); - #return "can't (yet) change username with sqlradius" - # if $old->username ne $new->username; + 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 ( $old->username ne $new->username ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', $new->username, $old->username ); - return $err_or_queue unless ref($err_or_queue); + 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; + 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, $new->username, %new ); - return $err_or_queue unless ref($err_or_queue); + 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, $new->username, @del ); - return $err_or_queue unless ref($err_or_queue); + 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; + } + } } } @@ -75,15 +110,37 @@ sub _export_replace { if ( @delgroups ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete', $new->username, @delgroups ); - return $err_or_queue unless ref($err_or_queue); + 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', $new->username, @newgroups ); - return $err_or_queue unless ref($err_or_queue); + 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; + ''; } diff --git a/FS/FS/part_export/sysvshell.pm b/FS/FS/part_export/sysvshell.pm new file mode 100644 index 000000000..f3f6b34b6 --- /dev/null +++ b/FS/FS/part_export/sysvshell.pm @@ -0,0 +1,7 @@ +package FS::part_export::sysvshell; + +use vars qw(@ISA); +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm new file mode 100644 index 000000000..1492f2672 --- /dev/null +++ b/FS/FS/part_export/textradius.pm @@ -0,0 +1,166 @@ +package FS::part_export::textradius; + +use vars qw(@ISA $prefix); +use Fcntl qw(:flock); +use FS::UID qw(datasrc); +use FS::part_export; + +@ISA = qw(FS::part_export); + +$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; + +} + diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm new file mode 100644 index 000000000..84c162761 --- /dev/null +++ b/FS/FS/part_export/www_shellcommands.pm @@ -0,0 +1,112 @@ +package FS::part_export::www_shellcommands; + +use strict; +use vars qw(@ISA); +use FS::part_export; + +@ISA = qw(FS::part_export); + +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 'refs'; + ${$_} = $svc_www->getfield($_) foreach $svc_www->fields; + } + my $domain_record = $svc_www->domain_record; # or die ? + my $zone = $domain_record->reczone; # or die ? + unless ( $zone =~ /\.$/ ) { + my $svc_domain = $domain_record->svc_domain; # or die ? + $zone .= '.'. $svc_domain->domain; + } + + my $svc_acct = $svc_www->svc_acct; # or die ? + my $username = $svc_acct->username; + 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 '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->reczone; # or die ? + unless ( $old_zone =~ /\.$/ ) { + my $old_svc_domain = $old_domain_record->svc_domain; # or die ? + $old_zone .= '.'. $old_svc_domain->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->reczone; # or die ? + unless ( $new_zone =~ /\.$/ ) { + my $new_svc_domain = $new_domain_record->svc_domain; # or die ? + $new_zone .= '.'. $new_svc_domain->domain; + } + + my $new_svc_acct = $new->svc_acct; # or die ? + my $new_username = $new_svc_acct->username; + 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.06'; + &Net::SSH::ssh_cmd( { @_ } ); +} + +#sub shellcommands_insert { #subroutine, not method +#} +#sub shellcommands_replace { #subroutine, not method +#} +#sub shellcommands_delete { #subroutine, not method +#} + diff --git a/FS/FS/part_export_option.pm b/FS/FS/part_export_option.pm index 61ea956ae..a0b19fde1 100644 --- a/FS/FS/part_export_option.pm +++ b/FS/FS/part_export_option.pm @@ -106,7 +106,7 @@ sub check { $self->ut_numbern('optionnum') || $self->ut_number('exportnum') || $self->ut_alpha('optionname') - || $self->ut_textn('optionvalue') + || $self->ut_anything('optionvalue') ; return $error if $error; diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index c75f75874..d35dc883f 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -1,7 +1,7 @@ package FS::queue; use strict; -use vars qw( @ISA @EXPORT_OK $conf ); +use vars qw( @ISA @EXPORT_OK $conf $jobnums); use Exporter; use FS::UID; use FS::Conf; @@ -18,6 +18,8 @@ $FS::UID::callback{'FS::queue'} = sub { $conf = new FS::Conf; }; +$jobnums = ''; + =head1 NAME FS::queue - Object methods for queue records @@ -118,6 +120,8 @@ sub insert { } } + push @$jobnums, $self->jobnum if $jobnums; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -192,7 +196,7 @@ sub check { || $self->ut_anything('job') || $self->ut_numbern('_date') || $self->ut_enum('status',['', qw( new locked failed )]) - || $self->ut_textn('statustext') + || $self->ut_anything('statustext') || $self->ut_numbern('svcnum') ; return $error if $error; @@ -232,22 +236,35 @@ sub cust_svc { qsearchs('cust_svc', { 'svcnum' => $self->svcnum } ); } +=item queue_depend + +Returns the FS::queue_depend objects associated with this job, if any. + +=cut + +sub queue_depend { + my $self = shift; + qsearch('queue_depend', { 'jobnum' => $self->jobnum } ); +} + + =item depend_insert OTHER_JOBNUM -Inserts a dependancy for this job. If there is an error, returns the error, -otherwise returns false. +Inserts a dependancy for this job - it will not be run until the other job +specified completes. If there is an error, returns the error, otherwise +returns false. -When using job dependancies, you should wrap the insertion of jobs in a -database transaction. +When using job dependancies, you should wrap the insertion of all relevant jobs +in a database transaction. =cut sub depend_insert { my($self, $other_jobnum) = @_; - my $queue_depend = new FS::queue_depend ( + my $queue_depend = new FS::queue_depend ( { 'jobnum' => $self->jobnum, 'depend_jobnum' => $other_jobnum, - ); + } ); $queue_depend->insert; } @@ -265,6 +282,7 @@ sub joblisting { my($hashref, $noactions) = @_; use Date::Format; + use HTML::Entities; use FS::CGI; my @queue = qsearch( 'queue', $hashref ); @@ -295,7 +313,9 @@ END my $args; if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) { - $args = join(' ', $queue->args); + $args = encode_entities( join(' ', + map { length($_)<54 ? $_ : substr($_,0,32)."..." } $queue->args #1&g + ) ); } else { $args = ''; } @@ -303,6 +323,11 @@ END my $date = time2str( "%a %b %e %T %Y", $queue->_date ); my $status = $queue->status; $status .= ': '. $queue->statustext if $queue->statustext; + my @queue_depend = $queue->queue_depend; + $status .= ' (waiting for '. + join(', ', map { $_->depend_jobnum } @queue_depend ). + ')' + if @queue_depend; my $changable = $dangerous || ( ! $noactions && $status =~ /^failed/ || $status =~ /^locked/ ); if ( $changable ) { @@ -360,10 +385,12 @@ END =head1 VERSION -$Id: queue.pm,v 1.12 2002-05-15 13:24:24 ivan Exp $ +$Id: queue.pm,v 1.15 2002-07-02 06:48:59 ivan Exp $ =head1 BUGS +$jobnums global + =head1 SEE ALSO L<FS::Record>, schema.html from the base documentation. diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index ee190fb8d..87b6097aa 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -1,10 +1,11 @@ package FS::svc_Common; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $noexport_hack ); use FS::Record qw( qsearchs fields dbh ); use FS::cust_svc; use FS::part_svc; +use FS::queue; @ISA = qw( FS::Record ); @@ -27,7 +28,7 @@ inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record. =over 4 -=item insert +=item insert [ JOBNUM_ARRAYREF ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. @@ -35,10 +36,14 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be defined. An FS::cust_svc record will be created and inserted. +If an arrayref is passed as parameter, the B<jobnum>s of any export jobs will +be added to the array. + =cut sub insert { my $self = shift; + local $FS::queue::jobnums = shift if @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -85,6 +90,18 @@ sub insert { return $error; } + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_insert($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -112,16 +129,80 @@ sub delete { my $svcnum = $self->svcnum; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $error = $self->SUPER::delete; return $error if $error; + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_delete($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + return $error if $error; + my $cust_svc = $self->cust_svc; $error = $cust_svc->delete; return $error if $error; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; +} + +=item replace OLD_RECORD + +Replaces OLD_RECORD with this one. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub replace { + my ($new, $old) = (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 $error = $new->SUPER::replace($old); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_replace($new,$old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } + =item setfixed Sets any fixed fields for this service (see L<FS::part_svc>). If there is an @@ -198,24 +279,92 @@ sub cust_svc { =item suspend +Runs export_suspend callbacks. + +=cut + +sub suspend { + my $self = 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; + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_suspend($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item unsuspend +Runs export_unsuspend callbacks. + +=cut + +sub unsuspend { + my $self = 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; + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_unsuspend($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item cancel -Stubs - return false (no error) so derived classes don't need to define these +Stub - returns false (no error) so derived classes don't need to define these methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). =cut -sub suspend { ''; } -sub unsuspend { ''; } sub cancel { ''; } =back =head1 VERSION -$Id: svc_Common.pm,v 1.8 2002-03-18 16:05:35 ivan Exp $ +$Id: svc_Common.pm,v 1.12 2002-06-14 11:22:53 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index bb8c5e21e..bd01adfdc 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -8,6 +8,8 @@ use vars qw( @ISA $noexport_hack $conf $username_noperiod $username_nounderscore $username_nodash $username_uppercase $mydomain + $welcome_template $welcome_from $welcome_subject $welcome_mimetype + $smtpmachine $dirhash @saltset @pw_set ); use Carp; @@ -25,6 +27,8 @@ use FS::svc_domain; use FS::raddb; use FS::queue; use FS::radius_usergroup; +use FS::export_svc; +use FS::part_export; use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); @@ -46,8 +50,19 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); $mydomain = $conf->config('domain'); - $dirhash = $conf->config('dirhash') || 0; + if ( $conf->exists('welcome_email') ) { + $welcome_template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", $conf->config('welcome_email') ] + ) or warn "can't create welcome email template: $Text::Template::ERROR"; + $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum' + $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome'; + $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain'; + } else { + $welcome_template = ''; + } + $smtpmachine = $conf->config('smtpmachine'); }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -191,10 +206,13 @@ sub insert { $error = $self->check; return $error if $error; - return gettext('username_in_use'). ": ". $self->username - if qsearchs( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc, - } ); + #no, duplicate checking just got a whole lot more complicated + #(perhaps keep this check with a config option to turn on?) + + #return gettext('username_in_use'). ": ". $self->username + # if qsearchs( 'svc_acct', { 'username' => $self->username, + # 'domsvc' => $self->domsvc, + # } ); if ( $self->svcnum ) { my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); @@ -206,15 +224,88 @@ sub insert { $self->svcpart($cust_svc->svcpart); } - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - return "Unknown svcpart" unless $part_svc; - return "uid in use" - if $part_svc->part_svc_column('uid')->columnflag ne 'F' - && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) - && $self->username !~ /^(hyla)?fax$/ - ; + #new duplicate username checking + + my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); + unless ( $part_svc ) { + $dbh->rollback if $oldAutoCommit; + return 'unknown svcpart '. $self->svcpart; + } + + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); + my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc } ); + my @dup_uid; + if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' + && $self->username !~ /^(toor|(hyla)?fax)$/ ) { + @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } ); + } else { + @dup_uid = (); + } + + if ( @dup_user || @dup_userdomain || @dup_uid ) { + my $exports = FS::part_export::export_info('svc_acct'); + my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); + + foreach my $part_export ( $part_svc->part_export ) { + + #this will catch to the same exact export + my @svcparts = map { $_->svcpart } + qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + + #this will catch to exports w/same exporthost+type ??? + #my @other_part_export = qsearch('part_export', { + # 'machine' => $part_export->machine, + # 'exporttype' => $part_export->exporttype, + #} ); + #foreach my $other_part_export ( @other_part_export ) { + # push @svcparts, map { $_->svcpart } + # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + #} + + my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + if ( $nodomain =~ /^Y/i ) { + $conflict_user_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } else { + $conflict_userdomain_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } + } + + foreach my $dup_user ( @dup_user ) { + my $dup_svcpart = $dup_user->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_userdomain ( @dup_userdomain ) { + my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; + if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + return "duplicate username\@domain: conflicts with svcnum ". + $dup_userdomain->svcnum. " via exportnum ". + $conflict_userdomain_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_uid ( @dup_uid ) { + my $dup_svcpart = $dup_uid->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) + || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + return "duplicate uid: conflicts with svcnum". $dup_uid->svcnum. + "via exportnum ". $conflict_user_svcpart{$dup_svcpart} + || $conflict_userdomain_svcpart{$dup_svcpart}; + } + } + + } + + #see? i told you it was more complicated - $error = $self->SUPER::insert; + my @jobnums; + $error = $self->SUPER::insert(\@jobnums); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -234,16 +325,57 @@ sub insert { } } - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_insert($self); + #false laziness with sub replace (and cust_main) + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; + $error = $queue->insert($self->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + #welcome email + my $cust_pkg = $self->cust_svc->cust_pkg; + my( $cust_main, $to ) = ( '', '' ); + if ( $welcome_template && $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); + if ( $to ) { + my $wqueue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::send_email' + }; + warn "attempting to queue email to $to"; + my $error = $wqueue->insert( + 'to' => $to, + 'from' => $welcome_from, + 'subject' => $welcome_subject, + 'mimetype' => $welcome_mimetype, + 'body' => $welcome_template->fill_in( HASH => { + 'username' => $self->username, + 'password' => $self->_password, + 'first' => $cust_main->first, + 'last' => $cust_main->getfield('last'), + 'pkg' => $cust_pkg->part_pkg->pkg, + } ), + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; + return "queuing welcome email: $error"; + } + + foreach my $jobnum ( @jobnums ) { + my $error = $wqueue->depend_insert($jobnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queuing welcome email job dependancy: $error"; + } } + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -331,26 +463,12 @@ sub delete { } } - my $part_svc = $self->cust_svc->part_svc; - my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $part_svc->part_export ) { - my $error = $part_export->export_delete($self); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -395,12 +513,6 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } - $old->usergroup( [ $old->radius_groups ] ); if ( $new->usergroup ) { #(sorta) false laziness with FS::part_export::sqlradius::_export_replace @@ -435,18 +547,24 @@ sub replace { } - #new-style exports! - unless ( $noexport_hack ) { - foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { - my $error = $part_export->export_replace($new,$old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "exporting to ". $part_export->exporttype. - " (transaction rolled back): $error"; - } - } + $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; } + #false laziness with sub insert (and cust_main) + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; + $error = $queue->insert($new->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -468,10 +586,11 @@ sub suspend { ) { $hash{_password} = '*SUSPENDED* '.$hash{_password}; my $new = new FS::svc_acct ( \%hash ); - $new->replace($self); - } else { - ''; #no error (already suspended) + my $error = $new->replace($self); + return $error if $error; } + + $self->SUPER::suspend; } =item unsuspend @@ -489,10 +608,11 @@ sub unsuspend { if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) { $hash{_password} = $1; my $new = new FS::svc_acct ( \%hash ); - $new->replace($self); - } else { - ''; #no error (already unsuspended) + my $error = $new->replace($self); + return $error if $error; } + + $self->SUPER::unsuspend; } =item cancel @@ -577,7 +697,9 @@ sub check { #you can set a fixed gid in part_svc return "Only root can have uid 0" - if $recref->{uid} == 0 && $recref->{username} ne 'root'; + if $recref->{uid} == 0 + && $recref->{username} ne 'root' + && $recref->{username} ne 'toor'; # $error = $self->ut_textn('finger'); # return $error if $error; @@ -673,7 +795,9 @@ sub check { $recref->{_password} = '!!'; } else { #return "Illegal password"; - return gettext('illegal_password'). ": ". $recref->{_password}; + return gettext('illegal_password'). " $passwordmin-$passwordmax ". + FS::Msgcat::_gettext('illegal_password_characters'). + ": ". $recref->{_password}; } ''; #no error @@ -760,7 +884,7 @@ sub domain { =item svc_domain Returns the FS::svc_domain record for this account's domain (see -L<FS::svc_domain>. +L<FS::svc_domain>). =cut @@ -815,14 +939,137 @@ Returns all RADIUS groups for this account (see L<FS::radius_usergroup>). sub radius_groups { my $self = shift; - map { $_->groupname } - qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + if ( $self->usergroup ) { + #when provisioning records, export callback runs in svc_Common.pm before + #radius_usergroup records can be inserted... + @{$self->usergroup}; + } else { + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + } } =back =head1 SUBROUTINES +=over 4 + +=item send_email + +=cut + +sub send_email { + my %opt = @_; + + use Date::Format; + use Mail::Internet 1.44; + use Mail::Header; + + $opt{mimetype} ||= 'text/plain'; + $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; + + $ENV{MAILADDRESS} = $opt{from}; + my $header = new Mail::Header ( [ + "From: $opt{from}", + "To: $opt{to}", + "Sender: $opt{from}", + "Reply-To: $opt{from}", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $opt{subject}", + "Content-Type: $opt{mimetype}", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ map "$_\n", split("\n", $opt{body}) ], + ); + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; +} + +=item check_and_rebuild_fuzzyfiles + +=cut + +sub check_and_rebuild_fuzzyfiles { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + -e "$dir/svc_acct.username" + or &rebuild_fuzzyfiles; +} + +=item rebuild_fuzzyfiles + +=cut + +sub rebuild_fuzzyfiles { + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + #username + + open(USERNAMELOCK,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAMELOCK,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + my @all_username = map $_->getfield('username'), qsearch('svc_acct', {}); + + open (USERNAMECACHE,">$dir/svc_acct.username.tmp") + or die "can't open $dir/svc_acct.username.tmp: $!"; + print USERNAMECACHE join("\n", @all_username), "\n"; + close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!"; + + rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username"; + close USERNAMELOCK; + +} + +=item all_username + +=cut + +sub all_username { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + open(USERNAMECACHE,"<$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + my @array = map { chomp; $_; } <USERNAMECACHE>; + close USERNAMECACHE; + \@array; +} + +=item append_fuzzyfiles USERNAME + +=cut + +sub append_fuzzyfiles { + my $username = shift; + + &check_and_rebuild_fuzzyfiles; + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + open(USERNAME,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAME,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + print USERNAME "$username\n"; + + flock(USERNAME,LOCK_UN) + or die "can't unlock $dir/svc_acct.username: $!"; + close USERNAME; + + 1; +} + + + =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] =cut @@ -872,6 +1119,8 @@ END $html; } +=back + =head1 BUGS The $recref stuff in sub check should be cleaned up. diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 97c5b3147..b06d03013 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -6,7 +6,7 @@ use vars qw( @ISA $whois_hack $conf $smtpmachine $soarefresh $soaretry $qshellmachine $nossh_hack ); use Carp; -use Mail::Internet; +use Mail::Internet 1.44; use Mail::Header; use Date::Format; use Net::Whois 1.0; @@ -255,10 +255,34 @@ sub delete { if defined( $FS::Record::dbdef->table('svc_acct_sm') ) && qsearch('svc_acct_sm', { 'domsvc' => $self->svcnum } ); - return "Can't delete a domain with (domain_record) zone entries!" - if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); + #return "Can't delete a domain with (domain_record) zone entries!" + # if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); - $self->SUPER::delete; + 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 $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + foreach my $domain_record ( reverse $self->domain_record ) { + my $error = $domain_record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; } =item replace OLD_RECORD @@ -270,13 +294,12 @@ returns the error, otherwise returns false. sub replace { my ( $new, $old ) = ( shift, shift ); - my $error; return "Can't change domain - reorder." if $old->getfield('domain') ne $new->getfield('domain'); - $new->SUPER::replace($old); - + my $error = $new->SUPER::replace($old); + return $error if $error; } =item suspend @@ -369,6 +392,26 @@ sub check { } +=item domain_record + +=cut + +sub domain_record { + my $self = shift; + + my %order = ( + SOA => 1, + NS => 2, + MX => 3, + CNAME => 4, + A => 5, + ); + + sort { $order{$a->rectype} <=> $order{$b->rectype} } + qsearch('domain_record', { svcnum => $self->svcnum } ); + +} + =item whois Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or @@ -407,7 +450,7 @@ sub submit_internic { =head1 VERSION -$Id: svc_domain.pm,v 1.27 2002-05-10 07:45:29 ivan Exp $ +$Id: svc_domain.pm,v 1.31 2002-06-10 02:52:48 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 12f8b9236..1c5b5c40d 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -402,7 +402,7 @@ sub check { return "Unknown srcsvc" unless $self->srcsvc_acct; - return "Both dstsvc and dst were defined; one one can be specified" + return "Both dstsvc and dst were defined; only one can be specified" if $self->dstsvc && $self->dst; return "one of dstsvc or dst is required" @@ -452,7 +452,7 @@ sub dstsvc_acct { =head1 VERSION -$Id: svc_forward.pm,v 1.11 2002-02-20 01:03:09 ivan Exp $ +$Id: svc_forward.pm,v 1.12 2002-05-31 17:50:37 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index f09a3f89d..d7a42c8ae 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -1,7 +1,7 @@ package FS::svc_www; use strict; -use vars qw(@ISA $conf $apacheroot $apachemachine $apacheip $nossh_hack ); +use vars qw(@ISA $conf $apacheip); #use FS::Record qw( qsearch qsearchs ); use FS::Record qw( qsearchs dbh ); use FS::svc_Common; @@ -9,15 +9,12 @@ use FS::cust_svc; use FS::domain_record; use FS::svc_acct; use FS::svc_domain; -use Net::SSH qw(ssh); @ISA = qw( FS::svc_Common ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_www'} = sub { $conf = new FS::Conf; - $apacheroot = $conf->config('apacheroot'); - $apachemachine = $conf->config('apachemachine'); $apacheip = $conf->config('apacheip'); }; @@ -85,20 +82,6 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be defined. An FS::cust_svc record will be created and inserted. -If the configuration values (see L<FS::Conf>) I<apachemachine>, and -I<apacheroot> exist, the command: - - mkdir $apacheroot/$zone; - chown $username $apacheroot/$zone; - ln -s $apacheroot/$zone $homedir/$zone - -I<$zone> is the DNS A record pointed to by I<recnum> -I<$username> is the username pointed to by I<usersvc> -I<$homedir> is that user's home directory - -is executed on I<apachemachine> via ssh. This behaviour can be surpressed by -setting $FS::svc_www::nossh_hack true. - =cut sub insert { @@ -147,37 +130,6 @@ sub insert { return $error; } - my $domain_record = qsearchs('domain_record', { 'recnum' => $self->recnum } ); # or die ? - my $zone = $domain_record->reczone; - # or die ? - unless ( $zone =~ /\.$/ ) { - my $dom_svcnum = $domain_record->svcnum; - my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } ); - # or die ? - $zone .= $svc_domain->domain; - } - - my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); - # or die ? - my $username = $svc_acct->username; - # or die ? - my $homedir = $svc_acct->dir; - # or die ? - - if ( $apachemachine - && $apacheroot - && $zone - && $username - && $homedir - && ! $nossh_hack - ) { - ssh("root\@$apachemachine", - "mkdir $apacheroot/$zone; ". - "chown $username $apacheroot/$zone; ". - "ln -s $apacheroot/$zone $homedir/$zone" - ); - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -285,6 +237,30 @@ sub check { ''; #no error } +=item domain_record + +Returns the FS::domain_record record for this web virtual host's zone (see +L<FS::domain_record>). + +=cut + +sub domain_record { + my $self = shift; + qsearchs('domain_record', { 'recnum' => $self->recnum } ); +} + +=item svc_acct + +Returns the FS::svc_acct record for this web virtual host's owner (see +L<FS::svc_acct>). + +=cut + +sub svc_acct { + my $self = shift; + qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); +} + =back =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index a95470bb4..8355e40fb 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -16,8 +16,13 @@ bin/freeside-tax-report bin/freeside-cc-receipts-report bin/freeside-credit-report bin/freeside-expiration-alerter +bin/freeside-reexport FS.pm FS/CGI.pm +FS/InitHandler.pm +FS/ClientAPI.pm +FS/ClientAPI/passwd.pm +FS/ClientAPI/MyAccount.pm FS/Conf.pm FS/ConfItem.pm FS/Record.pm @@ -49,12 +54,22 @@ FS/part_bill_event.pm FS/export_svc.pm FS/part_export.pm FS/part_export_option.pm -FS/part_export/infostreet.pm -FS/part_export/sqlradius.pm -FS/part_export/cyrus.pm +FS/part_export/bind.pm +FS/part_export/bind_slave.pm +FS/part_export/bsdshell.pm FS/part_export/cp.pm +FS/part_export/cyrus.pm +FS/part_export/http.pm +FS/part_export/infostreet.pm +FS/part_export/null.pm FS/part_export/shellcommands.pm +FS/part_export/shellcommands_withdomain.pm +FS/part_export/sqlmail.pm +FS/part_export/sqlradius.pm +FS/part_export/sysvshell.pm +FS/part_export/textradius.pm FS/part_export/vpopmail.pm +FS/part_export/www_shellcommands.pm FS/part_pkg.pm FS/part_pop_local.pm FS/part_referral.pm @@ -84,6 +99,8 @@ FS/cust_tax_exempt.pm t/agent.t t/agent_type.t t/CGI.t +t/InitHandler.t +t/ClientAPI.t t/Conf.t t/ConfItem.t t/Record.t @@ -110,12 +127,22 @@ t/part_bill_event.t t/export_svc.t t/part_export.t t/part_export_option.t -t/part_export-infostreet.t -t/part_export-sqlradius.t -t/part_export-cyrus.t +t/part_export-bind.t +t/part_export-bind_slave.t +t/part_export-bsdshell.t t/part_export-cp.t +t/part_export-cyrus.t +t/part_export-http.t +t/part_export-infostreet.t +t/part_export-null.t t/part_export-shellcommands.t +t/part_export-shellcommands_withdomain.t +t/part_export-sqlmail.t +t/part_export-sqlradius.t +t/part_export-sysvshell.t +t/part_export-textradius.t t/part_export-vpopmail.t +t/part_export-www_shellcommands.t t/part_pkg.t t/part_pop_local.t t/part_referral.t diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 1539a48af..83074b9e4 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -7,23 +7,25 @@ use Fcntl qw(:flock); use POSIX qw(setsid); use Date::Format; use IO::File; -use FS::UID qw(adminsuidsetup forksuidsetup driver_name); -use FS::Record qw(qsearchs); +use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh); +use FS::Record qw(qsearch qsearchs); use FS::queue; +use FS::queue_depend; # no autoloading just yet use FS::cust_main; use FS::svc_acct; -use Net::SSH 0.05; +use Net::SSH 0.06; use FS::part_export; -my $pid_file = '/var/run/freeside-queued.pid'; - $max_kids = '10'; #guess it should be a config file... $kids = 0; my $user = shift or die &usage; +#my $pid_file = "/var/run/freeside-queued.$user.pid"; +my $pid_file = "/var/run/freeside-queued.pid"; + &daemonize1; sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; } @@ -34,8 +36,20 @@ $sigint = 0; $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $sigint++; }; $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $sigterm++; }; -$> = $FS::UID::freeside_uid unless $>; -$< = $>; +my $freeside_gid = scalar(getgrnam('freeside')) + or die "can't setgid to freeside group\n"; +$) = $freeside_gid; +$( = $freeside_gid; +#if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd +($(,$)) = ($),$(); +$) = $freeside_gid; + +$> = $FS::UID::freeside_uid; +$< = $FS::UID::freeside_uid; +#freebsd is sofa king broken, won't setuid() +($<,$>) = ($>,$<); +$> = $FS::UID::freeside_uid; + $ENV{HOME} = (getpwuid($>))[7]; #for ssh adminsuidsetup $user; @@ -59,27 +73,49 @@ while (1) { } $warnkids=0; - my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. - ' WHERE queue_depend.jobnum = queue.jobnum ) '; - + my $nodepend = driver_name eq 'mysql' + ? '' + : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + ' WHERE queue_depend.jobnum = queue.jobnum ) '; + + #my($job, $ljob); + #{ + # my $oldAutoCommit = $FS::UID::AutoCommit; + # local $FS::UID::AutoCommit = 0; + $FS::UID::AutoCommit = 0; + my $dbh = dbh; + my $job = qsearchs( 'queue', { 'status' => 'new' }, '', - driver_name =~ /^mysql$/i + driver_name eq 'mysql' ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" ) or do { + $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; sleep 5; #connecting to db is expensive next; }; + if ( driver_name eq 'mysql' + && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { + $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + sleep 5; #would be better if mysql could do everything in query above + next; + } + my %hash = $job->hash; $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); my $error = $ljob->replace($job); die $error if $error; + $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + + $FS::UID::AutoCommit = 1; + #} + my @args = $ljob->args; defined( my $pid = fork ) or do { diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport new file mode 100644 index 000000000..b5c50a422 --- /dev/null +++ b/FS/bin/freeside-reexport @@ -0,0 +1,62 @@ +#!/usr/bin/perl -Tw + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::svc_acct; +use FS::cust_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift or die &usage; +my @part_export; +if ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +my $svc_something = shift or die &usage; +my $svc_x; +if ( $svc_something =~ /^(\d+)$/ ) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$1 } ) + or die "svcnum $svc_something not found\n"; + $svc_x = $cust_svc->svc_x; +} else { + $svc_x = qsearchs('svc_acct', { username=>$svc_something } ) + or die "username $svc_something not found\n"; +} + +foreach my $part_export ( @part_export ) { + my $error = $part_export->export_insert($svc_x); + die $error if $error; +} + + +sub usage { + die "Usage:\n\n freeside-reexport user exportnum|exporttype svcnum|username\n"; +} + +=head1 NAME + +freeside-reexport - Command line tool to re-trigger export jobs for existing services + +=head1 SYNOPSIS + + freeside-reexport user exportnum|exporttype svcnum|username + +=head1 DESCRIPTION + + Re-queues the export job for the specified exportnum or exporttype(s) and + specified service (selected by svcnum or username). + +=head1 SEE ALSO + +L<freeside-sqlradius-reset>, L<FS::part_export> + +=cut + diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 132be754a..9d3a6a700 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -22,6 +22,7 @@ foreach my $export ( @exports ) { my $sth = $icradius_dbh->prepare("DELETE FROM $table"); $sth->execute or die "Can't reset $table table: ". $sth->errstr; } + $icradius_dbh->disconnect; } foreach my $export ( @exports ) { @@ -45,7 +46,7 @@ foreach my $export ( @exports ) { sub usage { #die "Usage:\n\n sqlradius_reset user machine\n"; - die "Usage:\n\n sqlradius_reset user\n"; + die "Usage:\n\n freeside-sqlradius-reset user\n"; } =head1 NAME @@ -65,7 +66,7 @@ B<username> is a username added by freeside-adduser. =head1 SEE ALSO -<FS::part_export>, L<FS::part_export::sqlradius> +L<freeside-reexport>, L<FS::part_export>, L<FS::part_export::sqlradius> =cut diff --git a/FS/t/ClientAPI.t b/FS/t/ClientAPI.t new file mode 100644 index 000000000..973d8dada --- /dev/null +++ b/FS/t/ClientAPI.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::ClientAPI; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/InitHandler.t b/FS/t/InitHandler.t new file mode 100644 index 000000000..0ce60c833 --- /dev/null +++ b/FS/t/InitHandler.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::InitHandler; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-bind.t b/FS/t/part_export-bind.t new file mode 100644 index 000000000..d0c96be40 --- /dev/null +++ b/FS/t/part_export-bind.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bind; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-bind_slave.t b/FS/t/part_export-bind_slave.t new file mode 100644 index 000000000..c6a038610 --- /dev/null +++ b/FS/t/part_export-bind_slave.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bind_slave; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-bsdshell.t b/FS/t/part_export-bsdshell.t new file mode 100644 index 000000000..eaf417a70 --- /dev/null +++ b/FS/t/part_export-bsdshell.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::bsdshell; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-http.t b/FS/t/part_export-http.t new file mode 100644 index 000000000..ea41b939f --- /dev/null +++ b/FS/t/part_export-http.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::http; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-null.t b/FS/t/part_export-null.t new file mode 100644 index 000000000..055cdcee6 --- /dev/null +++ b/FS/t/part_export-null.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::null; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-shellcommands_withdomain.t b/FS/t/part_export-shellcommands_withdomain.t new file mode 100644 index 000000000..c0bd1bbb0 --- /dev/null +++ b/FS/t/part_export-shellcommands_withdomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::shellcommands_withdomain; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sqlmail.t b/FS/t/part_export-sqlmail.t new file mode 100644 index 000000000..b048a75a5 --- /dev/null +++ b/FS/t/part_export-sqlmail.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sqlmail; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-sysvshell.t b/FS/t/part_export-sysvshell.t new file mode 100644 index 000000000..7fc24acb1 --- /dev/null +++ b/FS/t/part_export-sysvshell.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::sysvshell; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-textradius.t b/FS/t/part_export-textradius.t new file mode 100644 index 000000000..d8a48a0c8 --- /dev/null +++ b/FS/t/part_export-textradius.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::textradius; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-www_shellcommands.t b/FS/t/part_export-www_shellcommands.t new file mode 100644 index 000000000..2ea79cf97 --- /dev/null +++ b/FS/t/part_export-www_shellcommands.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::www_shellcommands; +$loaded=1; +print "ok 1\n"; |