'freeside_1_4_0_beta1'.
Critical Path provisioning has been updated and can now username changes
and suspension/unsuspension.
---
-
- New export code!
- Name and company searches:
- now case-insensative
--
+- MySQL is now supported
+
+- BIND import and export and web UI support for editing the zone files.
+ (apply the patch at http://rt.cpan.org/NoAuth/Bug.html?id=508 if
+ importing zones until upstream release DNS::ZoneParse 0.9)
+
+- Welcome emails
+
+- Working company searches and job queue dependancies
+
+card retry changes (ticket 417)
+
+--
+
+- real-time text radius export
+
+- one-time charges
+
+- found "must start freeside-queued as freeside" problem on freebsd.
+ freeside-queued now compatible with freebsd, old openssh, mysql...
+
+- shellcommands now works! has defaults for freebsd, linux, netbsd, just directories, etc.
+
+- real-time textradius export!
Noment Networks, LLC <http://www.noment.com/> sponsored ICRADIUS/FreeRADIUS
groups, message catalogs, and signup server enhancements.
+Donald Greer <dgreer@austintx.com> provided the SQL to work around MySQL's lack
+of subqueries, and Dale Hege <fhege@lumenexus.net> provided the patches.
+Thanks!
+
+<baloo@gimpgirl.com> sent in several documentation patches.
+
+"Stephen Bechard" <steve@destek.net> sent in patches for svc_www services and
+other fixes.
+
Everything else is my (Ivan Kohler <ivan@420.am>) fault.
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;
{
'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',
},
{
'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',
},
{
'key' => 'editreferrals',
'section' => 'UI',
- 'description' => 'Enable referral modification for existing customers',
+ 'description' => 'Enable advertising source modification for existing customers',
'type' => 'checkbox',
},
{
'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 a
n <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',
},
{
'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',
},
{
'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',
},
{
'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',
},
{
'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',
},
'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;
--- /dev/null
+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;
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);
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') && @_;
}
$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";
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 = '';
? ( $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 = '';
} ( $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 = '';
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 = '';
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),
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
foreach ( keys %callback ) {
&{$callback{$_}};
+ # breaks multi-database installs # delete $callback{$_}; #run once
}
$dbh;
=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
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 );
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;
] );
my $message = new Mail::Internet (
'Header' => $header,
- 'Body' => [ $self->print_text('', $template) ], #( date)
+ 'Body' => [ @print_text ], #( date)
);
$!=0;
$message->smtpsend( Host => $smtpmachine )
" 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";
if ( $transaction->is_success() && $action2 ) {
my $auth = $transaction->authorization;
my $ordernum = $transaction->order_number;
+
#warn "********* $auth ***********\n";
#warn "********* $ordernum ***********\n";
my $capture =
$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;
] );
my $message = new Mail::Internet (
'Header' => $header,
- 'Body' => [ $template->fill_in() ],
+ 'Body' => [ $template->fill_in(HASH => $templ_hash) ],
);
$!=0;
$message->smtpsend( Host => $smtpmachine )
'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];
=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
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
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;
}
#eslaf
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
'';
}
=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
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 );
sub insert {
my $self = shift;
- my @param = @_;
+ my $cust_pkgs = @_ ? shift : {};
+ my $invoicing_list = @_ ? shift : '';
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
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;
}
}
}
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,
$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);
$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 ) {
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.
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
next unless $amount > 0;
+
foreach my $part_bill_event (
sort { $a->seconds <=> $b->seconds
|| $a->weight <=> $b->weight
$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.
=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,
} );
- $part_pkg->insert;
+ 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,
+ } );
+ $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;
+ 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
my ( $selected_county, $selected_state, $selected_country,
$prefix, $onchange ) = @_;
+ $prefix = '' unless defined $prefix;
+
$countyflag = 0;
# unless ( @cust_main_county ) { #cache
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 );
}
}
- $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;
}
#eslaf
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
'';
}
=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
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";
}
}
=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
=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
=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
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);
=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,
=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
''; #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
'';
-};
+}
=item delete
my $exporttype = $self->exporttype;
my $class = ref($self). "::$exporttype";
eval "use $class;";
+ die $@ if $@;
bless($self, $class);
}
$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;
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
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=>'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; '.
# '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 %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' },
;
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...
'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' =>
# '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 $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' => {
'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?...)',
},
'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?...)',
},
'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' => {
+ 'www_shellcommands' => {
+ 'desc' => 'www_shellcommands',
+ 'options' => {}, # \%www_shellcommands_options,
+ 'notes' => 'unfinished...',
+ },
- 'svc_www' => {},
+ },
);
=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...) ... ?
--- /dev/null
+package FS::part_export::bind;
+
+use vars qw(@ISA);
+use FS::part_export::null;
+
+@ISA = qw(FS::part_export::null);
+
--- /dev/null
+package FS::part_export::bind_slave;
+
+use vars qw(@ISA);
+use FS::part_export::null;
+
+@ISA = qw(FS::part_export::null);
+
--- /dev/null
+package FS::part_export::bsdshell;
+
+use vars qw(@ISA);
+use FS::part_export::null;
+
+@ISA = qw(FS::part_export::null);
+
--- /dev/null
+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;
+
+}
+
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 {
'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 {
);
}
+#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', $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) ) {
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 { $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 {
--- /dev/null
+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 {}
+
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 {
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")),
);
}
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
--- /dev/null
+package FS::part_export::shellcommands_withdomain;
+
+use vars qw(@ISA);
+use FS::part_export::shellcommands;
+
+@ISA = qw(FS::part_export::shellcommands);
+
--- /dev/null
+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;
+}
+
package FS::part_export::sqlradius;
use vars qw(@ISA);
+use FS::Record qw( dbh );
use FS::part_export;
@ISA = qw(FS::part_export);
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 );
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;
+ }
+ }
}
}
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;
+
'';
}
--- /dev/null
+package FS::part_export::sysvshell;
+
+use vars qw(@ISA);
+use FS::part_export::null;
+
+@ISA = qw(FS::part_export::null);
+
--- /dev/null
+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;
+
+}
+
--- /dev/null
+package FS::part_export::shellcommands;
+
+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_acct) = (shift, shift, shift);
+ my $command = $self->option($action);
+ my $stdin = $self->option($action."_stdin");
+ no strict 'refs';
+ ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
+ $self->shellcommands_queue( $svc_acct->svcnum,
+ user => $self->option('user')||'root',
+ host => $self->machine,
+ command => eval(qq("$command")),
+ stdin_string => eval(qq("$stdin")),
+ );
+}
+
+sub _export_replace {
+ my($self, $new, $old ) = (shift, shift, shift);
+ my $command = $self->option('usermod');
+ my $stdin = $self->option('usermod_stdin');
+ no strict 'refs';
+ ${"old_$_"} = $old->getfield($_) foreach $old->fields;
+ ${"new_$_"} = $new->getfield($_) foreach $new->fields;
+ $self->shellcommands_queue( $new->svcnum,
+ user => $self->option('user')||'root',
+ host => $self->machine,
+ command => eval(qq("$command")),
+ stdin_string => eval(qq("$stdin")),
+ );
+}
+
+#a good idea to queue anything that could fail or take any time
+sub shellcommands_queue {
+ my( $self, $svcnum ) = (shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::shellcommands::ssh_cmd",
+ };
+ $queue->insert( @_ );
+}
+
+sub ssh_cmd { #subroutine, not method
+ use Net::SSH '0.06';
+ &Net::SSH::ssh_cmd( { @_ } );
+}
+
+#sub shellcommands_insert { #subroutine, not method
+#}
+#sub shellcommands_replace { #subroutine, not method
+#}
+#sub shellcommands_delete { #subroutine, not method
+#}
+
$self->ut_numbern('optionnum')
|| $self->ut_number('exportnum')
|| $self->ut_alpha('optionname')
- || $self->ut_textn('optionvalue')
+ || $self->ut_anything('optionvalue')
;
return $error if $error;
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;
$conf = new FS::Conf;
};
+$jobnums = '';
+
=head1 NAME
FS::queue - Object methods for queue records
}
}
+ push @$jobnums, $self->jobnum if $jobnums;
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
|| $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;
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;
}
my($hashref, $noactions) = @_;
use Date::Format;
+ use HTML::Entities;
use FS::CGI;
my @queue = qsearch( 'queue', $hashref );
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 = '';
}
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 ) {
=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.
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 );
=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.
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';
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;
'';
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
=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
$username_noperiod $username_nounderscore $username_nodash
$username_uppercase
$mydomain
+ $welcome_template $welcome_from $welcome_subject $welcome_mimetype
+ $smtpmachine
$dirhash
@saltset @pw_set );
use Carp;
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 );
$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' , '.' , '/' );
$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});
$self->svcpart($cust_svc->svcpart);
}
+ #new duplicate username checking
+
+ my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } );
+ my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username,
+ 'domsvc' => $self->domsvc } );
+
+ if ( @dup_user || @dup_userdomain ) {
+ my $exports = FS::part_export::export_info('svc_acct');
+ my( %conflict_user_svcpart, %conflict_userdomain_svcpart );
+
+ my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
+ unless ( $part_svc ) {
+ $dbh->rollback if $oldAutoCommit;
+ return 'unknown svcpart '. $self->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_user_svcpart{$dup_svcpart}) ) {
+ return "duplicate username\@domain: conflicts with svcnum ".
+ $dup_userdomain->svcnum. " via exportnum ".
+ $conflict_user_svcpart{$dup_svcpart};
+ }
+ }
+
+ }
+
+ #see? i told you it was more complicated
+
my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
return "Unknown svcpart" unless $part_svc;
- return "uid in use"
+ return "uid ". $self->uid. " in use"
if $part_svc->part_svc_column('uid')->columnflag ne 'F'
&& qsearchs( 'svc_acct', { 'uid' => $self->uid } )
&& $self->username !~ /^(hyla)?fax$/
+ && $self->username !~ /^toor$/ #FreeBSD
;
- $error = $self->SUPER::insert;
+ my @jobnums;
+ $error = $self->SUPER::insert(\@jobnums);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
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);
+ #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;
}
}
- 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;
'';
}
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
}
- #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
}
) {
$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
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
#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;
$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
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
$html;
}
+=back
+
=head1 BUGS
The $recref stuff in sub check should be cleaned up.
$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;
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
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
}
+=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
=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
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"
=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
my $dom_svcnum = $domain_record->svcnum;
my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } );
# or die ?
- $zone .= $svc_domain->domain;
+ $zone .= '.'. $svc_domain->domain;
}
my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
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/Conf.pm
FS/ConfItem.pm
FS/Record.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
t/agent.t
t/agent_type.t
t/CGI.t
+t/InitHandler.t
t/Conf.t
t/ConfItem.t
t/Record.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
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--; }
$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;
}
$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 {
--- /dev/null
+#!/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
+
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 ) {
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
=head1 SEE ALSO
-<FS::part_export>, L<FS::part_export::sqlradius>
+L<freeside-reexport>, L<FS::part_export>, L<FS::part_export::sqlradius>
=cut
--- /dev/null
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::InitHandler;
+$loaded=1;
+print "ok 1\n";
--- /dev/null
+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";
--- /dev/null
+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";
--- /dev/null
+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";
--- /dev/null
+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";
--- /dev/null
+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";
--- /dev/null
+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";
--- /dev/null
+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";
--- /dev/null
+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";
--- /dev/null
+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";
DB_USER = freeside
DB_PASSWORD=
-#TEMPLATE = asp
-TEMPLATE = mason
+TEMPLATE = asp
+#TEMPLATE = mason
ASP_GLOBAL = /usr/local/etc/freeside/asp-global
INSTALLGROUP = root
+#edit the stuff below to have the daemons start
+
+QUEUED_USER=ivan
+
+#eventually this shouldn't be needed
+FREESIDE_PATH = `pwd`
+
+PASSWD_USER = nostart
+PASSWD_MACHINE = localhost
+
+SIGNUP_USER = nostart
+SIGNUP_MACHINE = localhost
+SIGNUP_AGENTNUM = 2
+SIGNUP_REFNUM = 2
+
#---
#not changable yet
FREESIDE_CONF = /usr/local/etc/freeside
-VERSION=1.4.0pre13
-TAG=freeside_1_4_0_pre13
-#VERSION=1.4.0beta1
-#TAG=freeside_1_4_0_beta1
+#VERSION=1.4.0pre14
+#TAG=freeside_1_4_0_pre14
+VERSION=1.4.0beta1
+TAG=freeside_1_4_0_beta1
help:
@echo "supported targets: aspdocs masondocs alldocs docs install-docs"
[ -e ./httemplate/docs/man/bin ] || mkdir httemplate/docs/man/bin
[ -e ./httemplate/docs/man/FS ] || mkdir httemplate/docs/man/FS
[ -e ./httemplate/docs/man/FS/UI ] || mkdir httemplate/docs/man/FS/UI
+ [ -e ./httemplate/docs/man/FS/part_export ] || mkdir httemplate/docs/man/FS/part_export
[ -e DONT_REBUILD_DOCS ] || bin/pod2x
+forcehtmlman:
+ [ -e ./httemplate/docs/man ] || mkdir httemplate/docs/man
+ [ -e ./httemplate/docs/man/bin ] || mkdir httemplate/docs/man/bin
+ [ -e ./httemplate/docs/man/FS ] || mkdir httemplate/docs/man/FS
+ [ -e ./httemplate/docs/man/FS/UI ] || mkdir httemplate/docs/man/FS/UI
+ [ -e ./httemplate/docs/man/FS/part_export ] || mkdir httemplate/docs/man/FS/part_export
+ bin/pod2x
install-docs: docs
[ -e ${FREESIDE_DOCUMENT_ROOT} ] && mv ${FREESIDE_DOCUMENT_ROOT} ${FREESIDE_DOCUMENT_ROOT}.`date +%Y%m%d%H%M%S` || true
install-init:
#[ -e ${INIT_FILE} ] || install -o root -g ${INSTALLGROUP} -m 711 init.d/freeside-init ${INIT_FILE}
install -o root -g ${INSTALLGROUP} -m 711 init.d/freeside-init ${INIT_FILE}
+ perl -p -i -e "\
+ s/%%%QUEUED_USER%%%/${QUEUED_USER}/g;\
+ s'%%%FREESIDE_PATH%%%'${FREESIDE_PATH}'g;\
+ s/%%%PASSWD_USER%%%/${PASSWD_USER}/g;\
+ s/%%%PASSWD_MACHINE%%%/${PASSWD_MACHINE}/g;\
+ s/%%%SIGNUP_USER%%%/${SIGNUP_USER}/g;\
+ s/%%%SIGNUP_MACHINE%%%/${SIGNUP_MACHINE}/g;\
+ s/%%%SIGNUP_AGENTNUM%%%/${SIGNUP_AGENTNUM}/g;\
+ s/%%%SIGNUP_REFNUM%%%/${SIGNUP_REFNUM}/g;\
+ " ${INIT_FILE}
install: install-perl-modules install-docs install-init
#these are probably only useful if you're me...
-upload-docs:
+upload-docs: forcehtmlman
ssh cleanwhisker.420.am rm -rf /var/www/www.sisd.com/freeside/devdocs
scp -pr httemplate/docs cleanwhisker.420.am:/var/www/www.sisd.com/freeside/devdocs
--- /dev/null
+the following is necessary to upgrade from 1.4.0pre13 to 1.4.0pre14
+
+if you're upgrading from before 1.4.0pre14 see README.1.4.0pre13 first!
+
+if you're upgrading from 1.3.1 follow the instructions in
+httemplate/docs/upgrade8.html instead
+
+----
+
+install the FS perl modules and httemplate as per install.html or upgrade8.html
+
+Restart Apache and freeside-queued
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use File::Path;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_pkg;
+use FS::cust_svc;
+use FS::svc_domain;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
+mkdir $spooldir, 0700 unless -d $spooldir;
+
+my @exports = qsearch('part_export', { 'exporttype' => 'bind' } );
+my @sexports = qsearch('part_export', { 'exporttype' => 'bind_slave' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @exports ) {
+
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+
+ #prevent old domain files from piling up
+ #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
+
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ open(NAMED_CONF,">$prefix/named.conf")
+ or die "can't open $prefix/named.conf: $!";
+
+ open(CONF_HEADER,"<$prefix/named.conf.HEADER"); #or die
+ while (<CONF_HEADER>) { print NAMED_CONF $_; }
+ close CONF_HEADER;
+
+ my $zonepath = $export->option('zonepath');
+ $zonepath =~ s/\/$//;
+
+ #false laziness with freeside-sqlradius-reset and shell.export
+ my @svc_domain =
+ map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
+
+ foreach my $svc_domain ( @svc_domain ) {
+ my $domain = $svc_domain->domain;
+ my @masters = qsearch('domain_record', {
+ 'svcnum' => $svc_domain->svcnum,
+ 'rectype' => '_mstr',
+ } );
+ if ( @masters ) {
+ my $masters = join('; ', map { $_->recdata } @masters );
+
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type slave;
+ file "db.$domain";
+ masters { $masters; };
+};
+
+END
+
+ } else {
+
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type master;
+ file "$zonepath/db.$domain";
+};
+
+END
+
+ open (DB_MASTER,">$prefix/db.$domain")
+ or die "can't open $prefix/db.$domain: $!";
+
+ my @domain_records =
+ qsearch('domain_record', { 'svcnum' => $svc_domain->svcnum } );
+ foreach my $domain_record (
+ sort { $b->rectype cmp $a->rectype } @domain_records
+ ) {
+ #if ( $domain_record->rectype eq 'SOA' ) {
+ # print DB_MASTER join("\t", $domain_record-> reczone
+ #} else {
+ print DB_MASTER join("\t",
+ map { $domain_record->getfield($_) }
+ qw( reczone recaf rectype recdata )
+ ), "\n";
+ #}
+ }
+
+ close DB_MASTER;
+
+ }
+
+ }
+
+ $rsync->exec( {
+ src => "$prefix/",
+ recursive => 1,
+ dest => "root\@$machine:$zonepath/",
+ exclude => [qw( *.import named.conf.HEADER named.conf )],
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ # warn $rsync->out;
+
+ $rsync->exec( {
+ src => "$prefix/named.conf",
+ dest => "root\@$machine:". $export->option('named_conf'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("root\@$machine", 'ndc reload');
+
+}
+
+close NAMED_CONF;
+
+foreach my $sexport ( @sexports ) { #false laziness with above
+
+ my $machine = $sexport->machine;
+ my $prefix = "$spooldir/$machine";
+
+ #prevent old domain files from piling up
+ #rmtree "$prefix" or die "can't rmtree $prefix.db: $!";
+
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ open(NAMED_CONF,">$prefix/named.conf")
+ or die "can't open $prefix/named.conf: $!";
+
+ open(CONF_HEADER,"<$prefix/named.conf.HEADER"); #or die
+ while (<CONF_HEADER>) { print NAMED_CONF $_; }
+ close CONF_HEADER;
+
+ my $masters = $sexport->option('master');
+
+ #false laziness with freeside-sqlradius-reset
+ my @svc_domain =
+ map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $sexport->export_svc;
+
+ foreach my $svc_domain ( @svc_domain ) {
+ my $domain = $svc_domain->domain;
+ print NAMED_CONF <<END;
+zone "$domain" {
+ type slave;
+ file "db.$domain";
+ masters { $masters; };
+};
+
+END
+
+ }
+
+ $rsync->exec( {
+ src => "$prefix/named.conf",
+ dest => "root\@$machine:". $sexport->option('named_conf'),
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+# warn $rsync->out;
+
+ ssh("root\@$machine", 'ndc reload');
+
+}
+close NAMED_CONF;
+
+# -----
+
+sub usage {
+ die "Usage:\n bind.export user\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+#
+# $Id: bind.import,v 1.2 2002-06-21 09:13:16 ivan Exp $
+
+#need to manually put header in /usr/local/etc/freeside/export.<datasrc./bind/<machine>/named.conf.HEADER
+
+use strict;
+use vars qw( %d_part_svc );
+use Term::Query qw(query);
+#use BIND::Conf_Parser;
+#use DNS::ZoneParse;
+
+#use Net::SCP qw(iscp);
+use Net::SCP qw(scp);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch); #qsearchs);
+#use FS::svc_acct_sm;
+use FS::svc_domain;
+use FS::domain_record;
+#use FS::svc_acct;
+#use FS::part_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+$FS::svc_Common::noexport_hack = 1;
+$FS::domain_record::noserial_hack = 1;
+
+use vars qw($spooldir);
+$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
+mkdir $spooldir unless -d $spooldir;
+
+%d_part_svc =
+ map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
+
+print "\n\n",
+ ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
+ "\n\n";
+use vars qw($domain_svcpart);
+$^W=0; #Term::Query isn't -w-safe
+$domain_svcpart =
+ query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ];
+$^W=1;
+
+print "\n\n", <<END;
+Enter the location and name of your primary named.conf file, for example
+"ns.isp.com:/var/named/named.conf"
+END
+my($named_conf)=&getvalue(":");
+
+use vars qw($named_machine $prefix);
+$named_machine = (split(/:/, $named_conf))[0];
+$prefix = "$spooldir/$named_machine";
+mkdir $prefix unless -d $prefix;
+
+#iscp("root\@$named_conf","$prefix/named.conf.import");
+scp("root\@$named_conf","$prefix/named.conf.import");
+
+
+sub getvalue {
+ my $prompt = shift;
+ $^W=0; # Term::Query isn't -w-safe
+ my $return = query $prompt, '';
+ $^W=1;
+ $return;
+}
+
+print "\n\n";
+
+##
+
+$FS::svc_domain::whois_hack=1;
+
+my $p = Parser->new;
+$p->parse_file("$prefix/named.conf.import");
+
+print "\nBIND import completed.\n";
+
+##
+
+sub usage {
+ die "Usage:\n\n svc_domain.import user\n";
+}
+
+########
+BEGIN {
+
+ package Parser;
+ use BIND::Conf_Parser;
+ use vars qw(@ISA $named_dir);
+ @ISA = qw(BIND::Conf_Parser);
+
+ sub handle_option {
+ my($self, $option, $argument) = @_;
+ return unless $option eq "directory";
+ $named_dir = $argument;
+ }
+
+ sub handle_zone {
+ my($self, $name, $class, $type, $options) = @_;
+ return unless $class eq 'in';
+ return if grep { $name eq $_ }
+ ( qw( . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa ) );
+
+ my $domain = new FS::svc_domain( {
+ svcpart => $main::domain_svcpart,
+ domain => $name,
+ action => 'N',
+ } );
+ my $error = $domain->insert;
+ die $error if $error;
+
+ if ( $type eq 'slave' ) {
+
+ #use Data::Dumper;
+ #print Dumper($options);
+ #exit;
+
+ foreach my $master ( @{ $options->{masters} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => '@',
+ 'recaf' => 'IN',
+ 'rectype' => '_mstr',
+ 'recdata' => $master,
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ }
+
+ } elsif ( $type eq 'master' ) {
+
+ my $file = $options->{file};
+
+ use File::Basename;
+ my $basefile = basename($file);
+ my $sourcefile = $file;
+ $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//;
+ use Net::SCP qw(iscp scp);
+ scp("root\@$main::named_machine:$sourcefile",
+ "$main::prefix/$basefile.import");
+
+ use DNS::ZoneParse;
+ my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import");
+
+ my $dump = $zone->Dump;
+
+ #use Data::Dumper;
+ #print "$name: ". Dumper($dump);
+ #exit;
+
+ foreach my $rectype ( keys %$dump ) {
+ if ( $rectype =~ /^SOA$/i ) {
+ my $rec = $dump->{$rectype};
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{origin},
+ 'recaf' => 'IN',
+ 'rectype' => $rectype,
+ 'recdata' =>
+ $rec->{primary}. ' '. $rec->{email}. ' ( '.
+ join(' ', map $rec->{$_},
+ qw( serial refresh retry expire minimumTTL ) ).
+ ' )',
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ } else {
+ #die $dump->{$rectype};
+ foreach my $rec ( @{ $dump->{$rectype} } ) {
+ my $domain_record = new FS::domain_record( {
+ 'svcnum' => $domain->svcnum,
+ 'reczone' => $rec->{name},
+ 'recaf' => $rec->{class},
+ 'rectype' => $rectype,
+ 'recdata' => ( $rectype =~ /^MX$/i
+ ? $rec->{priority}. ' '. $rec->{host}
+ : $rec->{host} ),
+ } );
+ my $error = $domain_record->insert;
+ die $error if $error;
+ }
+ }
+ }
+
+ }
+
+ }
+
+}
+#########
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# bsdshell export
+
+use strict;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_acct;
+
+my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell";
+
+my @bsd_exports = qsearch('part_export', { 'exporttype' => 'bsdshell' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @bsd_exports ) {
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #LOCKING!!!
+
+ ( open(MASTER,">$prefix/master.passwd")
+ #!!! and flock(MASTER,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/master.passwd: $!";
+ ( open(PASSWD,">$prefix/passwd")
+ #!!! and flock(PASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/passwd: $!";
+
+ chmod 0644, "$prefix/passwd";
+ chmod 0600, "$prefix/master.passwd";
+
+ #false laziness with freeside-sqlradius-reset and bind.export
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
+
+ next unless @svc_acct;
+
+ foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) {
+
+ my $password = $svc_acct->_password;
+ my $cpassword;
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ # MD5 !!!!
+ } else {
+ $cpassword=$password;
+ }
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $svc_acct->username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF FreeBSD MASTER PASSWD FILE HERE
+ print MASTER join(":",
+ $svc_acct->username, # User name
+ $cpassword, # Encrypted password
+ $svc_acct->uid, # User ID
+ $svc_acct->gid, # Group ID
+ "", # Login Class
+ "0", # Password Change Time
+ "0", # Password Expiration Time
+ $svc_acct->finger, # Users name
+ $svc_acct->dir, # Users home directory
+ $svc_acct->shell, # shell
+ ), "\n" ;
+
+ }
+
+ #!!! flock(MASTER,LOCK_UN);
+ #!!! flock(PASSWD,LOCK_UN);
+ close MASTER;
+ close PASSWD;
+
+ $rsync->exec( {
+ src => "$prefix/passwd",
+ dest => "root\@$machine:/etc/passwd"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ $rsync->exec( {
+ src => "$prefix/master.passwd",
+ dest => "root\@$machine:/etc/master.passwd.new"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+ ssh("root\@$machine", "pwd_mkdb /etc/master.passwd.new");
+
+ # UNLOCK!!
+}
#!/usr/bin/perl -Tw
#
-# $Id: fs-migrate-svc_acct_sm,v 1.3 2001-08-21 02:43:18 ivan Exp $
+# $Id: fs-migrate-svc_acct_sm,v 1.4 2002-06-21 09:13:16 ivan Exp $
#
# jeff@cmh.net 01-Jul-20
$|=1;
-$FS::svc_acct::nossh_hack = 1;
-$FS::svc_forward::nossh_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
$FS::svc_domain::whois_hack = 1;
%part_domain_svc=map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
#!/usr/bin/perl -Tw
#
-# $Id: fs-setup,v 1.91 2002-05-15 13:24:24 ivan Exp $
+# $Id: fs-setup,v 1.95 2002-06-28 20:23:54 ivan Exp $
#to delay loading dbdef until we're ready
BEGIN { $FS::Record::setup_hack = 1; }
'address1', 'varchar', '', $char_d,
'address2', 'varchar', 'NULL', $char_d,
'city', 'varchar', '', $char_d,
- 'state', 'varchar', '', $char_d,
+ 'state', 'varchar', 'NULL', $char_d,
'zip', 'varchar', '', 10,
'country', 'char', '', 2,
# 'trancode', 'int', '', '',
'domsvc', 'int', '', '',
],
'primary_key' => 'svcnum',
- 'unique' => [ [ 'username', 'domsvc' ] ],
+ #'unique' => [ [ 'username', 'domsvc' ] ],
'index' => [ ['username'], ['domsvc'] ],
},
#!/usr/bin/perl -Tw
-# $Id: passwd.import,v 1.1 2002-04-20 11:57:35 ivan Exp $
+# $Id: passwd.import,v 1.5 2002-06-21 09:57:05 ivan Exp $
use strict;
use vars qw(%part_svc);
use Term::Query qw(query);
use Net::SCP qw(iscp);
use FS::UID qw(adminsuidsetup datasrc);
-use FS::Record qw(qsearch);
+use FS::Record qw(qsearch qsearchs);
use FS::svc_acct;
use FS::part_svc;
my($spooldir)="/usr/local/etc/freeside/export.". datasrc;
#$FS::svc_acct::nossh_hack = 1;
-$FS::svc_acct::noexport_hack = 1;
+$FS::svc_Common::noexport_hack = 1;
###
while (<PASSWD>) {
chop;
- my($username,$x,$uid,$gid,$finger,$dir,$shell)=split(/:/);
- my($password)=$upassword{$username} || $password{$username};
+ my($username,$x,$uid,$gid,$finger,$dir,$shell) = split(/:/);
+ my $password = $password{$username};
- $svcpart = $shell_svcpart;
+ my $svcpart = $shell_svcpart;
+
+ #if ( qsearchs('svc_acct', { 'username' => $username } ) ) {
+ # warn "warning: $username already exists; skipping\n";
+ # next;
+ #}
my($svc_acct) = new FS::svc_acct ({
'svcpart' => $svcpart,
'finger' => $finger,
'dir' => $dir,
'shell' => $shell,
- %{$allparam{$username}},
+ #%{$allparam{$username}},
});
my($error);
$error=$svc_acct->insert;
die $error if $error;
- delete $upassword{$username};
}
sub usage {
glob("./fs_signup/FS-SignupClient/*.pm"),
glob("./fs_selfadmin/FS-MailAdminServer/*.pm"),
) {
- next if $file =~ /^blib\//;
+ next if $file =~ /(^|\/)blib\//;
#$file =~ /\/([\w\-]+)\.pm$/ or die "oops file $file";
my $name;
if ( $file =~ /fs_\w+\/FS\-\w+\/(.*)\.pm$/ ) {
},
'illegal_password' => {
- 'en_US' => 'Illegal password',
+ 'en_US' => 'Illegal password (',
+ },
+
+ 'illegal_password_characters' => {
+ 'en_US' => ' characters)',
},
'username_in_use' => {
#!/usr/bin/perl -w
#
-# $Id: svc_acct.export,v 1.35 2002-03-20 21:31:49 ivan Exp $
+# $Id: svc_acct.export,v 1.36 2002-05-16 14:28:35 ivan Exp $
#
# Create and export password, radius and vpopmail password files:
# passwd, passwd.adjunct, shadow, acp_passwd, acp_userinfo, acp_dialup
# qq(Password = "$rpassword"\n\t),
join ",\n\t", map { qq($_ = "$radreply{$_}") } keys %radreply;
- if ( $ip && $ip ne '0e0' ) {
- #print USERS qq(,\n\tFramed-Address = "$ip"\n\n);
- print USERS qq(,\n\tFramed-IP-Address = "$ip"\n\n);
- } else {
+ #if ( $ip && $ip ne '0e0' ) {
+ # #print USERS qq(,\n\tFramed-Address = "$ip"\n\n);
+ # print USERS qq(,\n\tFramed-IP-Address = "$ip"\n\n);
+ #} else {
print USERS qq(\n\n);
- }
+ #}
}
+++ /dev/null
-#!/usr/bin/perl -w
-#
-# $Id: svc_domain.import,v 1.5 2002-04-30 05:43:34 ivan Exp $
-
-use strict;
-use vars qw( %d_part_svc );
-use Term::Query qw(query);
-#use BIND::Conf_Parser;
-#use DNS::ZoneParse;
-
-#use Net::SCP qw(iscp);
-use Net::SCP qw(scp);
-use FS::UID qw(adminsuidsetup datasrc);
-use FS::Record qw(qsearch); #qsearchs);
-#use FS::svc_acct_sm;
-use FS::svc_domain;
-use FS::domain_record;
-#use FS::svc_acct;
-#use FS::part_svc;
-
-my $user = shift or die &usage;
-adminsuidsetup $user;
-
-use vars qw($spooldir);
-$spooldir = "/usr/local/etc/freeside/export.". datasrc. "/bind";
-mkdir $spooldir unless -d $spooldir;
-
-%d_part_svc =
- map { $_->svcpart, $_ } qsearch('part_svc',{'svcdb'=>'svc_domain'});
-
-print "\n\n",
- ( join "\n", map "$_: ".$d_part_svc{$_}->svc, sort keys %d_part_svc ),
- "\n\n";
-use vars qw($domain_svcpart);
-$^W=0; #Term::Query isn't -w-safe
-$domain_svcpart =
- query "Enter part number for domains: ", 'irk', [ keys %d_part_svc ];
-$^W=1;
-
-print "\n\n", <<END;
-Enter the location and name of your primary named.conf file, for example
-"ns.isp.com:/var/named/named.conf"
-END
-my($named_conf)=&getvalue(":");
-
-use vars qw($named_machine $prefix);
-$named_machine = (split(/:/, $named_conf))[0];
-$prefix = "$spooldir/$named_machine";
-mkdir $prefix unless -d $prefix;
-
-#iscp("root\@$named_conf","$prefix/named.conf.import");
-scp("root\@$named_conf","$prefix/named.conf.import");
-
-
-sub getvalue {
- my $prompt = shift;
- $^W=0; # Term::Query isn't -w-safe
- my $return = query $prompt, '';
- $^W=1;
- $return;
-}
-
-print "\n\n";
-
-##
-
-$FS::svc_domain::whois_hack=1;
-
-my $p = Parser->new;
-$p->parse_file("$prefix/named.conf.import");
-
-print "\nBIND import completed.\n";
-
-##
-
-sub usage {
- die "Usage:\n\n svc_domain.import user\n";
-}
-
-########
-BEGIN {
-
- package Parser;
- use BIND::Conf_Parser;
- use vars qw(@ISA $named_dir);
- @ISA = qw(BIND::Conf_Parser);
-
- sub handle_option {
- my($self, $option, $argument) = @_;
- return unless $option eq "directory";
- $named_dir = $argument;
- }
-
- sub handle_zone {
- my($self, $name, $class, $type, $options) = @_;
- return unless $class eq 'in';
- return if grep { $name eq $_ }
- ( qw( . localhost 127.in-addr.arpa 0.in-addr.arpa 255.in-addr.arpa ) );
-
- my $domain = new FS::svc_domain( {
- svcpart => $main::domain_svcpart,
- domain => $name,
- action => 'N',
- } );
- my $error = $domain->insert;
- die $error if $error;
-
- if ( $type eq 'slave' ) {
-
- #use Data::Dumper;
- #print Dumper($options);
- #exit;
-
- foreach my $master ( @{ $options->{masters} } ) {
- my $domain_record = new FS::domain_record( {
- 'svcnum' => $domain->svcnum,
- 'reczone' => '@',
- 'recaf' => 'IN',
- 'rectype' => '_mstr',
- 'recdata' => $master,
- } );
- my $error = $domain_record->insert;
- die $error if $error;
- }
-
- } elsif ( $type eq 'master' ) {
-
- my $file = $options->{file};
-
- use File::Basename;
- my $basefile = basename($file);
- my $sourcefile = $file;
- $sourcefile = "$named_dir/$sourcefile" unless $file =~ /^\//;
- use Net::SCP qw(iscp scp);
- scp("root\@$main::named_machine:$sourcefile",
- "$main::prefix/$basefile.import");
-
- use DNS::ZoneParse;
- my $zone = DNS::ZoneParse->new("$main::prefix/$basefile.import");
-
- my $dump = $zone->Dump;
-
- #use Data::Dumper;
- #print "$name: ". Dumper($dump);
- #exit;
-
- foreach my $rectype ( keys %$dump ) {
- if ( $rectype =~ /^SOA$/i ) {
- my $rec = $dump->{$rectype};
- my $domain_record = new FS::domain_record( {
- 'svcnum' => $domain->svcnum,
- 'reczone' => $rec->{origin},
- 'recaf' => 'IN',
- 'rectype' => $rectype,
- 'recdata' =>
- $rec->{primary}. ' '. $rec->{email}. ' ( '.
- join(' ', map $rec->{$_},
- qw( serial refresh retry expire minimumTTL ) ).
- ' )',
- } );
- my $error = $domain_record->insert;
- die $error if $error;
- } else {
- #die $dump->{$rectype};
- foreach my $rec ( @{ $dump->{$rectype} } ) {
- my $domain_record = new FS::domain_record( {
- 'svcnum' => $domain->svcnum,
- 'reczone' => $rec->{name},
- 'recaf' => $rec->{class},
- 'rectype' => $rectype,
- 'recdata' => ( $rectype =~ /^MX$/i
- ? $rec->{priority}. ' '. $rec->{host}
- : $rec->{host} ),
- } );
- my $error = $domain_record->insert;
- die $error if $error;
- }
- }
- }
-
- }
-
- }
-
-}
-#########
-
--- /dev/null
+#!/usr/bin/perl -w
+
+# sysvshell export
+
+use strict;
+use File::Rsync;
+use Net::SSH qw(ssh);
+use FS::UID qw(adminsuidsetup datasrc);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::cust_svc;
+use FS::svc_acct;
+
+my @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $spooldir = "/usr/local/etc/freeside/export.". datasrc;
+#my $spooldir = "/usr/local/etc/freeside/export.". datasrc. "/shell";
+
+my @sysv_exports = qsearch('part_export', { 'exporttype' => 'sysvshell' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @sysv_exports ) {
+ my $machine = $export->machine;
+ my $prefix = "$spooldir/$machine";
+ mkdir $prefix, 0700 unless -d $prefix;
+
+ #LOCKING!!!
+
+ ( open(SHADOW,">$prefix/shadow")
+ #!!! and flock(SHADOW,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/shadow: $!";
+ ( open(PASSWD,">$prefix/passwd")
+ #!!! and flock(PASSWD,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/passwd: $!";
+
+ chmod 0644, "$prefix/passwd";
+ chmod 0600, "$prefix/shadow";
+
+ #false laziness with freeside-sqlradius-reset and bind.export
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
+
+ next unless @svc_acct;
+
+ foreach my $svc_acct ( sort { $a->uid <=> $b->uid } @svc_acct ) {
+
+ my $password = $svc_acct->_password;
+ my $cpassword;
+ #if ( ( length($password) <= 8 )
+ if ( ( length($password) <= 12 )
+ && ( $password ne '*' )
+ && ( $password ne '!!' )
+ && ( $password ne '' )
+ ) {
+ $cpassword=crypt($password,
+ $saltset[int(rand(64))].$saltset[int(rand(64))]
+ );
+ # MD5 !!!!
+ } else {
+ $cpassword=$password;
+ }
+
+ ###
+ # FORMAT OF THE PASSWD FILE HERE
+ print PASSWD join(":",
+ $svc_acct->username,
+ 'x', # "##". $username,
+ $svc_acct->uid,
+ $svc_acct->gid,
+ $svc_acct->finger,
+ $svc_acct->dir,
+ $svc_acct->shell,
+ ), "\n";
+
+ ###
+ # FORMAT OF THE SHADOW FILE HERE
+ print SHADOW join(":",
+ $svc_acct->username,
+ $cpassword,
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ '',
+ ), "\n";
+
+ }
+
+ #!!! flock(SHADOW,LOCK_UN);
+ #!!! flock(PASSWD,LOCK_UN);
+ close SHADOW;
+ close PASSWD;
+
+ $rsync->exec( {
+ src => "$prefix/shadow",
+ dest => "root\@$machine:/etc/shadow"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ $rsync->exec( {
+ src => "$prefix/passwd",
+ dest => "root\@$machine:/etc/passwd"
+ } ) or die "rsync to $machine failed: ". join(" / ", $rsync->err);
+
+ # UNLOCK!!
+}
Your credit card could not be processed for the following reason:
{ $error }
-Please provide us with new billing infromation so that we may continue your
+Please provide us with new billing information so that we may continue your
service uninterrupted.
Thanks.
sub _export_insert {
my($self, $svc_something) = (shift, shift);
- $err_or_queue = $self->myexport_queue( $svc_acct->svcnum, 'insert',
+ $err_or_queue = $self->myexport_queue( $svc_something->svcnum, 'insert',
$svc_something->username, $svc_something->_password );
ref($err_or_queue) ? '' : $err_or_queue;
}
sub _export_delete {
my( $self, $svc_something ) = (shift, shift);
- $err_or_queue = $self->myexport_queue( $svc_acct->svcnum,
+ $err_or_queue = $self->myexport_queue( $svc_something->svcnum,
'delete', $svc_something->username );
ref($err_or_queue) ? '' : $err_or_queue;
}
+++ /dev/null
-package FS::MailAdminClient;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK $fs_mailadmind_socket);
-use Exporter;
-use Socket;
-use FileHandle;
-use IO::Handle;
-
-$VERSION = '0.01';
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( signup_info authenticate list_packages list_mailboxes delete_mailbox password_mailbox add_mailbox list_forwards list_pkg_forwards delete_forward add_forward new_customer );
-
-$fs_mailadmind_socket = "/usr/local/freeside/fs_mailadmind_socket";
-
-$ENV{'PATH'} ='/usr/bin:/usr/ucb:/bin';
-$ENV{'SHELL'} = '/bin/sh';
-$ENV{'IFS'} = " \t\n";
-$ENV{'CDPATH'} = '';
-$ENV{'ENV'} = '';
-$ENV{'BASH_ENV'} = '';
-
-my $freeside_uid = scalar(getpwnam('freeside'));
-die "not running as the freeside user\n" if $> != $freeside_uid;
-
-=head1 NAME
-
-FS::MailAdminClient - Freeside mail administration client API
-
-=head1 SYNOPSIS
-
- use FS::MailAdminClient qw( signup_info list_mailboxes new_customer );
-
- ( $locales, $packages, $pops ) = signup_info;
-
- ( $accounts ) = list_mailboxes;
-
- $error = new_customer ( {
- 'first' => $first,
- 'last' => $last,
- 'ss' => $ss,
- 'comapny' => $company,
- 'address1' => $address1,
- 'address2' => $address2,
- 'city' => $city,
- 'county' => $county,
- 'state' => $state,
- 'zip' => $zip,
- 'country' => $country,
- 'daytime' => $daytime,
- 'night' => $night,
- 'fax' => $fax,
- 'payby' => $payby,
- 'payinfo' => $payinfo,
- 'paydate' => $paydate,
- 'payname' => $payname,
- 'invoicing_list' => $invoicing_list,
- 'pkgpart' => $pkgpart,
- 'username' => $username,
- '_password' => $password,
- 'popnum' => $popnum,
- } );
-
-=head1 DESCRIPTION
-
-This module provides an API for a remote mail administration server.
-
-It needs to be run as the freeside user. Because of this, the program which
-calls these subroutines should be written very carefully.
-
-=head1 SUBROUTINES
-
-=over 4
-
-=item signup_info
-
-Returns three array references of hash references.
-
-The first set of hash references is of allowable locales. Each hash reference
-has the following keys:
- taxnum
- state
- county
- country
-
-The second set of hash references is of allowable packages. Each hash
-reference has the following keys:
- pkgpart
- pkg
-
-The third set of hash references is of allowable POPs (Points Of Presence).
-Each hash reference has the following keys:
- popnum
- city
- state
- ac
- exch
-
-=cut
-
-sub signup_info {
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "signup_info\n";
- SOCK->flush;
-
- chop ( my $n_cust_main_county = <SOCK> );
- my @cust_main_county = map {
- chop ( my $taxnum = <SOCK> );
- chop ( my $state = <SOCK> );
- chop ( my $county = <SOCK> );
- chop ( my $country = <SOCK> );
- {
- 'taxnum' => $taxnum,
- 'state' => $state,
- 'county' => $county,
- 'country' => $country,
- };
- } 1 .. $n_cust_main_county;
-
- chop ( my $n_part_pkg = <SOCK> );
- my @part_pkg = map {
- chop ( my $pkgpart = <SOCK> );
- chop ( my $pkg = <SOCK> );
- {
- 'pkgpart' => $pkgpart,
- 'pkg' => $pkg,
- };
- } 1 .. $n_part_pkg;
-
- chop ( my $n_svc_acct_pop = <SOCK> );
- my @svc_acct_pop = map {
- chop ( my $popnum = <SOCK> );
- chop ( my $city = <SOCK> );
- chop ( my $state = <SOCK> );
- chop ( my $ac = <SOCK> );
- chop ( my $exch = <SOCK> );
- chop ( my $loc = <SOCK> );
- {
- 'popnum' => $popnum,
- 'city' => $city,
- 'state' => $state,
- 'ac' => $ac,
- 'exch' => $exch,
- 'loc' => $loc,
- };
- } 1 .. $n_svc_acct_pop;
-
- close SOCK;
-
- \@cust_main_county, \@part_pkg, \@svc_acct_pop;
-}
-
-=item authenticate
-
-Authentictes against a service on the remote Freeside system. Requires a hash
-reference as a parameter with the following keys:
- authuser
- _password
-
-Returns a scalar error message of the form "authuser OK|FAILED" or an error
-message.
-
-=cut
-
-sub authenticate {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "authenticate", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser _password
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item list_packages
-
-Returns one array reference of hash references.
-
-The set of hash references is of existing packages. Each hash reference
-has the following keys:
- pkgnum
- domain
- account
-
-=cut
-
-sub list_packages {
- my $user = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_packages\n", $user, "\n";
- SOCK->flush;
-
- chop ( my $n_packages = <SOCK> );
- my @packages = map {
- chop ( my $pkgnum = <SOCK> );
- chop ( my $domain = <SOCK> );
- chop ( my $account = <SOCK> );
- {
- 'pkgnum' => $pkgnum,
- 'domain' => $domain,
- 'account' => $account,
- };
- } 1 .. $n_packages;
-
- close SOCK;
-
- \@packages;
-}
-
-=item list_mailboxes
-
-Returns one array references of hash references.
-
-The set of hash references is of existing accounts. Each hash reference
-has the following keys:
- svcnum
- username
- _password
-
-=cut
-
-sub list_mailboxes {
- my ($user, $package) = @_;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_mailboxes\n", $user, "\n", $package, "\n";
- SOCK->flush;
-
- chop ( my $n_svc_acct = <SOCK> );
- my @svc_acct = map {
- chop ( my $svcnum = <SOCK> );
- chop ( my $username = <SOCK> );
- chop ( my $_password = <SOCK> );
- {
- 'svcnum' => $svcnum,
- 'username' => $username,
- '_password' => $_password,
- };
- } 1 .. $n_svc_acct;
-
- close SOCK;
-
- \@svc_acct;
-}
-
-=item delete_mailbox
-
-Deletes a mailbox service from the remote Freeside system. Requires a hash
-reference as a paramater with the following keys:
- authuser
- account
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub delete_mailbox {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "delete_mailbox", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser account
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item password_mailbox
-
-Changes the password for a mailbox service on the remote Freeside system.
- Requires a hash reference as a paramater with the following keys:
- authuser
- account
- _password
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub password_mailbox {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "password_mailbox", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser account _password
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item add_mailbox
-
-Creates a mailbox service on the remote Freeside system. Requires a hash
-reference as a parameter with the following keys:
- authuser
- package
- account
- _password
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub add_mailbox {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "add_mailbox", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser package account _password
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item list_forwards
-
-Returns one array references of hash references.
-
-The set of hash references is of existing forwards. Each hash reference
-has the following keys:
- svcnum
- dest
-
-=cut
-
-sub list_forwards {
- my ($user, $service) = @_;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_forwards\n", $user, "\n", $service, "\n";
- SOCK->flush;
-
- chop ( my $n_svc_forward = <SOCK> );
- my @svc_forward = map {
- chop ( my $svcnum = <SOCK> );
- chop ( my $dest = <SOCK> );
- {
- 'svcnum' => $svcnum,
- 'dest' => $dest,
- };
- } 1 .. $n_svc_forward;
-
- close SOCK;
-
- \@svc_forward;
-}
-
-=item list_pkg_forwards
-
-Returns one array references of hash references.
-
-The set of hash references is of existing forwards. Each hash reference
-has the following keys:
- svcnum
- srcsvc
- dest
-
-=cut
-
-sub list_pkg_forwards {
- my ($user, $package) = @_;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "list_pkg_forwards\n", $user, "\n", $package, "\n";
- SOCK->flush;
-
- chop ( my $n_svc_forward = <SOCK> );
- my @svc_forward = map {
- chop ( my $svcnum = <SOCK> );
- chop ( my $srcsvc = <SOCK> );
- chop ( my $dest = <SOCK> );
- {
- 'svcnum' => $svcnum,
- 'srcsvc' => $srcsvc,
- 'dest' => $dest,
- };
- } 1 .. $n_svc_forward;
-
- close SOCK;
-
- \@svc_forward;
-}
-
-=item delete_forward
-
-Deletes a forward service from the remote Freeside system. Requires a hash
-reference as a paramater with the following keys:
- authuser
- svcnum
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub delete_forward {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "delete_forward", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser svcnum
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item add_forward
-
-Creates a forward service on the remote Freeside system. Requires a hash
-reference as a parameter with the following keys:
- authuser
- package
- source
- dest
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub add_forward {
- my $hashref = shift;
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "add_forward", "\n";
- SOCK->flush;
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- authuser package source dest
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- close SOCK;
-
- $error;
-}
-
-=item new_customer HASHREF
-
-Adds a customer to the remote Freeside system. Requires a hash reference as
-a paramater with the following keys:
- first
- last
- ss
- comapny
- address1
- address2
- city
- county
- state
- zip
- country
- daytime
- night
- fax
- payby
- payinfo
- paydate
- payname
- invoicing_list
- pkgpart
- username
- _password
- popnum
-
-Returns a scalar error message, or the empty string for success.
-
-=cut
-
-sub new_customer {
- my $hashref = shift;
-
- socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
- connect(SOCK, sockaddr_un($fs_mailadmind_socket)) or die "connect: $!";
- print SOCK "new_customer\n";
-
- print SOCK join("\n", map { $hashref->{$_} } qw(
- first last ss company address1 address2 city county state zip country
- daytime night fax payby payinfo paydate payname invoicing_list
- pkgpart username _password popnum
- ) ), "\n";
- SOCK->flush;
-
- chop( my $error = <SOCK> );
- $error;
-}
-
-=back
-
-=head1 VERSION
-
-$Id: MailAdminClient.pm,v 1.1 2001-10-18 15:04:54 jeff Exp $
-
-=head1 BUGS
-
-=head1 SEE ALSO
-
-L<fs_signupd>, L<FS::SignupServer>, L<FS::cust_main>
-
-=cut
-
-1;
-
+++ /dev/null
-#!/usr/bin/perl
-########################################################################
-# #
-# mailadmin.cgi NCI2000 #
-# Jeff Finucane <jeff@nci2000.net> #
-# 26 April 2001 #
-# #
-########################################################################
-
-use DBI;
-use strict;
-use CGI;
-use FS::MailAdminClient qw(authenticate list_packages list_mailboxes delete_mailbox password_mailbox add_mailbox list_forwards list_pkg_forwards delete_forward add_forward);
-
-my $sessionfile = '/usr/local/apache/htdocs/mailadmin/adminsess'; # session file
-my $tmpdir = '/usr/local/apache/htdocs/mailadmin/tmp'; # Location to store temp files
-my $cookiedomain = ".your.dom"; # domain if THIS server, should prepend with a '.'
-my $cookieexpire = '+12h'; # expire the cookie session after this much idle time
-my $sessexpire = 43200; # expire session after this long of no use (in seconds)
-
-my $body = "<body bgcolor=dddddd>";
-
-#### Should not have to change anything under this line ####
-my $printmainpage = 1;
-my $i = 0;
-my $printheader = 1;
-my $query = new CGI;
-my $cgi = $query->url();
-my $now = getdatetime();
-my $current_package = 0;
-my $current_account = 0;
-my $current_domname = "";
-
-# if they are trying to login we wont check the session yet
-if ($query->param('login') eq '' && $query->param('action') ne 'login') {
- checksession();
- printheader();
-}
-
-if ($query->param('login') ne '') {
-
- my $username = $query->param('username');
- my $password = $query->param('password');
-
- if (!checkuserpass($username, $password)) {
- printheader();
- error('not_admin');
- }
-
- my @alpha = ('A'..'Z', 'a'..'z', 0..9);
- my $sessid = '';
- for (my $i = 0; $i < 10; $i++) {
- $sessid .= @alpha[rand(@alpha)];
- }
-
- my $cookie1 = $query->cookie(-name=>'username',
- -value=>$username,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- my $cookie2 = $query->cookie(-name=>'ma_sessionid',
- -value=>$sessid,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- my $now = time();
- open(NEWSESS, ">>$sessionfile") || error('open');
- print NEWSESS "$username $sessid $now 0 0\n";
- close(NEWSESS);
-
- print $query->header(-COOKIE=>[$cookie1, $cookie2]);
-
- $printmainpage = 1;
-
-} elsif ($query->param('action') eq 'blankframe') {
-
- print "<html>$body</body></html>\n";
- $printmainpage = 0;
-
-} elsif ($query->param('action') eq 'list_packages') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- my $list = list_packages($username);
- print "<html>$body\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Package Number</td><td><p>Description</td></tr>\n";
- foreach my $package ( @{$list} ) {
- print "<tr>";
- print "<td></td><td><p>$package->{'pkgnum'}</td><td><p>$package->{'domain'}</td>\n";
- print "<td></td><td><a href=\"$cgi\?action=select&package=$package->{'pkgnum'}&account=$package->{'account'}&domname=$package->{'domain'}\" target=\"rightmainframe\">select</td>\n";
- print "</tr>";
- }
- print "</table>\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'list_mailboxes') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $list = list_mailboxes($username, $current_package);
- my $forwardlist = list_pkg_forwards($username, $current_package);
- print "<html>$body\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Username</td><td><p>Password</td></tr>\n";
- foreach my $account ( @{$list} ) {
- print "<tr>";
- print "<td></td><td><p>$account->{'username'}</td><td><p>$account->{'_password'}</td>\n";
- print "<td></td><td><a href=\"$cgi\?action=change&account=$account->{'svcnum'}&mailbox=$account->{'username'}\" target=\"rightmainframe\">change</td>\n";
- print "</tr>";
-
-# my $forwardlist = list_forwards($username, $account->{'svcnum'});
-# foreach my $forward ( @{$forwardlist} ) {
-# my $label = qq!=> ! . $forward->{'dest'};
-# print "<tr><td></td><td></td><td><p>$label</td></tr>\n";
-# }
- foreach my $forward ( @{$forwardlist} ) {
- if ($forward->{'srcsvc'} == $account->{'svcnum'}) {
- my $label = qq!=> ! . $forward->{'dest'};
- print "<tr><td></td><td></td><td><p>$label</td></tr>\n";
- }
- }
-
- }
- print "</table>\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'select') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- $current_package = $query->param('package');
- $current_account = $query->param('account');
- $current_domname = $query->param('domname');
- set_package();
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center>\n";
- print "<p>Selected package $current_package\n";
- print "</center>\n";
- print "</form>\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'change') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $mailbox = $query->param('mailbox');
- my $list = list_forwards($username, $account);
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Username</td><td><p>$mailbox</td></tr>\n";
- print "<input type=hidden name=\"account\" value=\"$account\">\n";
- print "<input type=hidden name=\"mailbox\" value=\"$mailbox\">\n";
- foreach my $forward ( @{$list} ) {
- my $label = qq!=> ! . $forward->{'dest'};
-# print "<tr><td></td><td></td><td><p>$label</td></tr>\n";
- print "<tr><td></td><td></td><td><p>$label</td><td><a href=\"$cgi\?action=deleteforward&service=$forward->{'svcnum'}&mailbox=$mailbox&dest=$forward->{'dest'}\" target=\"rightmainframe\">remove</td></tr>\n";
- }
- print "<tr><td></td><td><p>Password</td><td><input type=text name=\"_password\" value=\"\"></td></tr>\n";
- print "</table>\n";
- print "<input type=submit name=\"deleteaccount\" value=\"Delete This User\">\n";
- print "<input type=submit name=\"changepassword\" value=\"Change The Password\">\n";
- print "<input type=submit name=\"addforward\" value=\"Add Forwarding\">\n";
- print "</center>\n";
- print "</form>\n";
- print "<br>\n";
- print "<p> You may delete this user and all mailforwarding by pressing <B>Delete This User</B>.\n";
- print "<p> To set or change the password for this user, type the new password in the box next to <B>Password</B> and press <B>Change The Password</B>.\n";
- print "<p> If you would like to have mail destined for this user forwarded to another email address then press the <B>Add Forwarding</B> button.\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('deleteaccount') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $mailbox = $query->param('mailbox');
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<p>Are you certain you want to delete user $mailbox?\n";
- print "<p><input type=hidden name=\"account\" value=\"$account\">\n";
- print "<input type=submit name=\"deleteaccounty\" value=\"Confirm\">\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('deleteaccounty') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
-
- if ( my $error = delete_mailbox ( {
- 'authuser' => $username,
- 'account' => $account,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Deleted\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('changepassword') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $_password = $query->param('_password');
-
- if ( my $error = password_mailbox ( {
- 'authuser' => $username,
- 'account' => $account,
- '_password' => $_password,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Changed\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'newmailbox') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center><table border=0>\n";
- print "<tr><td></td><td><p>Username </td><td><input type=text name=\"account\" value=\"\"></td><td>@ " . $current_domname . "</td></tr>\n";
- print "<tr><td></td><td><p>Password</td><td><input type=text name=\"_password\" value=\"\"></td></tr>\n";
- print "</table>\n";
- print "<input type=submit name=\"addmailbox\" value=\"Add This User\">\n";
- print "</center>\n";
- print "</form>\n";
- print "<br>\n";
- print "<p>Use this screen to add a new mailbox user. If the domain name of the email address (the part after the <B>@</B> sign) is not what you expect then you may need to use <B>List Packages</B> to select the package with the correct domain.\n";
- print "<p>Enter the first portion of the email address in the box adjacent to <B>Username</B> and enter the password for that user in the space next to <B>Password</B>. Then press the button labeled <B>Add The User</B>.\n";
- print "<p>If you do not want to add a new user at this time then select a choice from the menu at the left, such as <B>List Mailboxes</B>.\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('addmailbox') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $_password = $query->param('_password');
-
- if ( my $error = add_mailbox ( {
- 'authuser' => $username,
- 'package' => $current_package,
- 'account' => $account,
- '_password' => $_password,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Created\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'deleteforward') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $svcnum = $query->param('service');
- my $mailbox = $query->param('mailbox');
- my $dest = $query->param('dest');
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<p>Are you certain you want to remove the forwarding from $mailbox to $dest?\n";
- print "<p><input type=hidden name=\"service\" value=\"$svcnum\">\n";
- print "<input type=submit name=\"deleteforwardy\" value=\"Confirm\">\n";
- print "</body></html>\n";
- $printmainpage=0;
-
-} elsif ($query->param('deleteforwardy') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $service = $query->param('service');
-
- if ( my $error = delete_forward ( {
- 'authuser' => $username,
- 'svcnum' => $service,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Forwarding Removed\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('addforward') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $mailbox = $query->param('mailbox');
-
- print "<html>$body\n";
- print "<form name=form1 action=\"$cgi\" method=post target=\"rightmainframe\">\n";
- print "<center><table border=0>\n";
- print "<input type=hidden name=\"account\" value=\"$account\">\n";
- print "<input type=hidden name=\"mailbox\" value=\"$mailbox\">\n";
- print "<tr><td>Forward mail from </td><td><p>$mailbox:</td><td> to </td></tr>\n";
- print "<tr><td></td><td><p>Destination:</td><td><input type=text name=\"dest\" value=\"\"></td></tr>\n";
- print "</table>\n";
- print "<input type=submit name=\"addforwarddst\" value=\"Add the Forwarding\">\n";
- print "</center>\n";
- print "</form>\n";
- print "<br>\n";
- print "<p> If you would like mail originally destined for the above address to be forwarded to a different email address then type that email address in the box next to <B>Destination:</B> and press the <B>Add the Forwarding</B> button.\n";
- print "<p> If you do not want to add mail forwarding then select a choice from the menu at the left, such as <B>List Accounts</B>.\n";
-
- $printmainpage=0;
-
-} elsif ($query->param('addforwarddst') ne '') {
-
- my $username = $query->cookie(-name=>'username'); # session checked
- select_package($username) unless $current_package;
- my $account = $query->param('account');
- my $dest = $query->param('dest');
-
- if ( my $error = add_forward ( {
- 'authuser' => $username,
- 'package' => $current_package,
- 'source' => $account,
- 'dest' => $dest,
- } ) ) {
- print "<html>$body\n";
- print "<p>$error\n";
- print "</body></html>\n";
-
- } else {
- print "<html>$body\n";
- print "<p>Forwarding Created\n";
- print "</body></html>\n";
- }
-
- $printmainpage=0;
-
-} elsif ($query->param('action') eq 'navframe') {
-
- print "<html><body bgcolor=bbbbbb>\n";
- print "<center><h2>NCI2000 MAIL ADMIN Web Interface</h2></center>\n";
-
- print "<br><center>Choose Action:</center><br>\n";
- print "<center><table border=0>\n";
- print "<ul>\n";
- print "<tr><td><li><a href=\"$cgi\?action=logout\" target=\"_top\">Log Off</a></td><tr>\n";
- print "<tr><td><li><a href=\"$cgi\?action=list_packages\" target=\"rightmainframe\">List Packages</a></td><tr>\n";
- print "<tr><td><li><a href=\"$cgi\?action=list_mailboxes\" target=\"rightmainframe\">List Accounts</a></td><tr>\n";
- print "<tr><td><li><a href=\"$cgi\?action=newmailbox\" target=\"rightmainframe\">Add Account</a></td><tr>\n";
- print "</ul>\n";
- print "</table></center>\n";
-
- print "<br><br><br>\n";
- print "</body></html>\n";
-
- $printmainpage = 0;
-
-} elsif ($query->param('action') eq 'rightmainframe') {
-
- print "<html>$body\n";
- print "<br><br><br>\n";
- print "<font size=4><----- Please choose function on the left menu</font>\n";
- print "<br><br>\n";
- print "<p> Choose <B>Log Off</B> when you are finished. This helps prevent unauthorized access to your accounts.\n";
- print "<p> Use <B>List Packages</B> when you administer multiple packages. When you have multiple domains at NCI2000 you are likely to have multiple packages. Use of <B>List Packages</B> is not necessary if administer only one package.\n";
- print "<p> Use <B>List Accounts</B> to view your current arrangement of mailboxes. From this list you my choose to make changes to existing mailboxes or delete mailboxes. If you would like to modify the forwarding associated with a mailbox then choose it from this list.\n";
- print "<p> Use <B>Add Account</B> when you would like an additional mailbox. After you have added the mailbox you may choose to make additional changes from the list provided by <B>List Accounts<B>.\n";
- print "</body></html>\n";
-
- $printmainpage = 0;
-
-}
-
-
-if ($query->param('action') eq 'login') {
-
- printheader();
- printlogin();
-
-} elsif ($query->param('action') eq 'logout') {
-
- destroysession();
- printheader();
- printlogin();
-
-} elsif ($printmainpage) {
-
-
- print "<html><head><title>NCI2000 MAIL ADMIN Web Interface</title></head>\n";
- print "<FRAMESET cols=\"160,*\" BORDER=\"3\">\n";
- print "<FRAME NAME=\"navframe\" src=\"$cgi?action=navframe\">\n";
- print "<FRAME NAME=\"rightmainframe\" src=\"$cgi?action=rightmainframe\">\n";
- print "</FRAMESET>\n";
- print "</html>\n";
-
-
-}
-
-sub getdatetime {
- my $today = localtime(time());
- my ($day,$mon,$dayofmon,$time,$year) = split(/\s+/,$today);
- my @datemonths = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
-
- my $numidx = "01";
- my ($nummon);
- foreach my $mons (@datemonths) {
- if ($mon eq $mons) {
- $nummon = $numidx;
- }
- $numidx++;
- }
-
- return "$year-$nummon-$dayofmon $time";
-
-}
-
-sub error {
-
- my $error = shift;
- my $arg1 = shift;
-
- printheader();
-
- if ($error eq 'not_admin') {
- print "<html><head><title>Error!</title></head>\n";
- print "$body\n";
- print "<center><h1><font face=arial>Error!</font></h1></center>\n";
- print "<font face=arial>Unauthorized attempt to access mail administration.</font>\n";
- print "<br><font face=arial>Please login again if you think this is an error.</font>\n";
- print "<form><input type=button value=\"<<Back\" OnClick=\"history.back()\"></form>\n";
- print "</body></html>\n";
- } elsif ($error eq 'exists') {
- print "<html><head><title>Error!</title></head>\n";
- print "$body\n";
- print "<center><h1><font face=arial>Error!</font></h1></center>\n";
- print "<font face=arial>The user you are trying to enter already exists. Please go back and enter a different username</font>\n";
- print "</font></body></html>\n";
- } elsif ($error eq 'ingroup') {
- print "<html><head><title>Error!</title></head>\n";
- print "$body\n";
- print "<center><h1><font face=arial>Error!</font></h1></center>\n";
- print "<font face=arial>This user is already in the group <i>$arg1</i>. Please go back and deselect group <i>$arg1</i> from the list.</font>\n";
- print "<form><input type=button value=\"<<Back\" OnClick=\"history.back()\"></form>\n";
- print "</font></body></html>\n";
- } elsif ($error eq 'sess_expired') {
- print "<html>$body\n";
- print "<center><font size=4>Your session has expired.</font></center>\n";
- print "<br><br><center>Please login again <a href=\"$cgi\?action=login\" target=\"_top\"> HERE</a></center>\n";
- print "</body></html>\n";
- } elsif ($error eq 'open') {
- print "<html>$body\n";
- print "<center><font size=4>Unable to open or rename file.</font></center>\n";
- print "<br><br><center>If this continues, please contact your administrator</center>\n";
- print "</body></html>\n";
- }
-
-
- exit;
-
-}
-
-
-#print a html header if not printed yet
-sub printheader {
-
- if ($printheader) {
- print "Content-Type: text/html\n\n";
- $printheader = 0;
- }
-
-}
-
-
-#verify user can access administration
-sub checksession {
-
- my $username = $query->cookie(-name=>'username');
- my $sessionid = $query->cookie(-name=>'ma_sessionid');
-
- if ($sessionid eq '') {
- printheader();
- if ($query->param()) {
- error('sess_expired');
- } else {
- printlogin();
- exit;
- }
- }
-
- my $now = time();
- my $founduser = 0;
- open(SESSFILE, "$sessionfile") || error('open');
- error('open') if -l "$tmpdir/adminsess.$$";
- open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open');
- while (<SESSFILE>) {
- chomp();
- my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/);
- next if $now - $sessexpire > $time;
- if ($username eq $user && !$founduser) {
- if ($sess eq $sessionid) {
- $founduser = 1;
- print NEWSESS "$user $sess $now $pkgnum $svcdomain $domname\n";
- $current_package=$pkgnum;
- $current_account=$svcdomain;
- $current_domname=$domname;
- next;
- }
- }
- print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n";
- }
- close(SESSFILE);
- close(NEWSESS);
- system("mv $tmpdir/adminsess.$$ $sessionfile");
- error('sess_expired') unless $founduser;
-
- my $cookie1 = $query->cookie(-name=>'username',
- -value=>$username,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- my $cookie2 = $query->cookie(-name=>'ma_sessionid',
- -value=>$sessionid,
- -expires=>$cookieexpire,
- -domain=>$cookiedomain);
-
- print $query->header(-COOKIE=>[$cookie1, $cookie2]);
-
- $printheader = 0;
-
- return 0;
-
-}
-
-sub destroysession {
-
- my $username = $query->cookie(-name=>'username');
- my $sessionid = $query->cookie(-name=>'ma_sessionid');
-
- if ($sessionid eq '') {
- printheader();
- if ($query->param()) {
- error('sess_expired');
- } else {
- printlogin();
- exit;
- }
- }
-
- my $now = time();
- my $founduser = 0;
- open(SESSFILE, "$sessionfile") || error('open');
- error('open') if -l "$tmpdir/adminsess.$$";
- open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open');
- while (<SESSFILE>) {
- chomp();
- my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/);
- next if $now - $sessexpire > $time;
- if ($username eq $user && !$founduser) {
- if ($sess eq $sessionid) {
- $founduser = 1;
- next;
- }
- }
- print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n";
- }
- close(SESSFILE);
- close(NEWSESS);
- system("mv $tmpdir/adminsess.$$ $sessionfile");
- error('sess_expired') unless $founduser;
-
- $printheader = 0;
-
- return 0;
-
-}
-
-# checks the username and pass against the database
-sub checkuserpass {
-
- my $username = shift;
- my $password = shift;
-
- my $error = authenticate ( {
- 'authuser' => $username,
- '_password' => $password,
- } );
-
- if ($error eq "$username OK") {
- return 1;
- }else{
- return 0;
- }
-
-}
-
-#printlogin prints a login page
-sub printlogin {
-
- print "<html>$body\n";
- print "<center><font size=4>Please login to access MAIL ADMIN</font></center>\n";
- print "<form action=\"$cgi\" method=post>\n";
- print "<center>Email Address: <input type=text name=\"username\">\n";
- print "<br>Email Password: <input type=password name=\"password\">\n";
- print "<br><input type=submit name=\"login\" value=\"Login\">\n";
- print "</form></center>\n";
- print "</body></html>\n";
-}
-
-
-#select_package chooses a administrable package if more than one exists
-sub select_package {
- my $user = shift;
- my $packages = list_packages($user);
- if (scalar(@{$packages}) eq 1) {
- $current_package = @{$packages}[0]->{'pkgnum'};
- set_package();
- }
- if (scalar(@{$packages}) > 1) {
-# print $query->redirect("$cgi\?action=list_packages");
- print "<p>No package selected. You must first <a href=\"$cgi\?action=list_packages\" target=\"rightmainframe\">select a package</a>.\n";
- exit;
- }
-}
-
-sub set_package {
-
- my $username = $query->cookie(-name=>'username');
- my $sessionid = $query->cookie(-name=>'ma_sessionid');
-
- if ($sessionid eq '') {
- printheader();
- if ($query->param()) {
- error('sess_expired');
- } else {
- printlogin();
- exit;
- }
- }
-
- my $now = time();
- my $founduser = 0;
- open(SESSFILE, "$sessionfile") || error('open');
- error('open') if -l "$tmpdir/adminsess.$$";
- open(NEWSESS, ">$tmpdir/adminsess.$$") || error('open');
- while (<SESSFILE>) {
- chomp();
- my ($user, $sess, $time, $pkgnum, $svcdomain, $domname) = split(/\s+/);
- next if $now - $sessexpire > $time;
- if ($username eq $user && !$founduser) {
- if ($sess eq $sessionid) {
- $founduser = 1;
- print NEWSESS "$user $sess $time $current_package $current_account $current_domname\n";
- next;
- }
- }
- print NEWSESS "$user $sess $time $pkgnum $svcdomain $domname\n";
- }
- close(SESSFILE);
- close(NEWSESS);
- system("mv $tmpdir/adminsess.$$ $sessionfile");
- error('sess_expired') unless $founduser;
-
- $printheader = 0;
-
- return 0;
-
-}
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-
-eval 'exec /usr/bin/perl -Tw -S $0 ${1+"$@"}'
- if 0; # not running under some shell
-#
-# fs_mailadmind
-#
-# This is run REMOTELY over ssh by fs_mailadmin_server.
-#
-
-use strict;
-use Socket;
-
-use vars qw( $Debug );
-
-$Debug = 0;
-
-my($fs_mailadmind_socket)="/usr/local/freeside/fs_mailadmind_socket";
-
-$ENV{'PATH'} ='/usr/local/bin:/usr/bin:/usr/ucb:/bin';
-$ENV{'SHELL'} = '/bin/sh';
-$ENV{'IFS'} = " \t\n";
-$ENV{'CDPATH'} = '';
-$ENV{'ENV'} = '';
-$ENV{'BASH_ENV'} = '';
-
-$|=1;
-
-warn "[fs_mailadmind] Reading locales...\n" if $Debug;
-chomp( my $n_cust_main_county = <STDIN> );
-my @cust_main_county = map {
- chomp( my $taxnum = <STDIN> );
- chomp( my $state = <STDIN> );
- chomp( my $county = <STDIN> );
- chomp( my $country = <STDIN> );
- {
- 'taxnum' => $taxnum,
- 'state' => $state,
- 'county' => $county,
- 'country' => $country,
- };
-} ( 1 .. $n_cust_main_county );
-
-warn "[fs_mailadmind] Reading package definitions...\n" if $Debug;
-chomp( my $n_part_pkg = <STDIN> );
-my @part_pkg = map {
- chomp( my $pkgpart = <STDIN> );
- chomp( my $pkg = <STDIN> );
- {
- 'pkgpart' => $pkgpart,
- 'pkg' => $pkg,
- };
-} ( 1 .. $n_part_pkg );
-
-warn "[fs_mailadmind] Reading POPs...\n" if $Debug;
-chomp( my $n_svc_acct_pop = <STDIN> );
-my @svc_acct_pop = map {
- chomp( my $popnum = <STDIN> );
- chomp( my $city = <STDIN> );
- chomp( my $state = <STDIN> );
- chomp( my $ac = <STDIN> );
- chomp( my $exch = <STDIN> );
- chomp( my $loc = <STDIN> );
- {
- 'popnum' => $popnum,
- 'city' => $city,
- 'state' => $state,
- 'ac' => $ac,
- 'exch' => $exch,
- 'loc' => $loc,
- };
-} ( 1 .. $n_svc_acct_pop );
-
-warn "[fs_mailadmind] Creating $fs_mailadmind_socket\n" if $Debug;
-my $uaddr = sockaddr_un($fs_mailadmind_socket);
-my $proto = getprotobyname('tcp');
-socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
-unlink($fs_mailadmind_socket);
-bind(Server, $uaddr) or die "bind: $!";
-listen(Server,SOMAXCONN) or die "listen: $!";
-
-warn "[fs_mailadmind] Entering main loop...\n" if $Debug;
-my $paddr;
-for ( ; $paddr = accept(Client,Server); close Client) {
-
- chop( my $command = <Client> );
-
- if ( $command eq "signup_info" ) {
- warn "[fs_mailadmind] sending signup info...\n" if $Debug;
- print Client join("\n", $n_cust_main_county,
- map {
- $_->{taxnum},
- $_->{state},
- $_->{county},
- $_->{country},
- } @cust_main_county
- ), "\n";
-
- print Client join("\n", $n_part_pkg,
- map {
- $_->{pkgpart},
- $_->{pkg},
- } @part_pkg
- ), "\n";
-
- print Client join("\n", $n_svc_acct_pop,
- map {
- $_->{popnum},
- $_->{city},
- $_->{state},
- $_->{ac},
- $_->{exch},
- $_->{loc},
- } @svc_acct_pop
- ), "\n";
-
- } elsif ( $command eq "new_customer" ) {
- warn "[fs_mailadmind] reading customer signup...\n" if $Debug;
- my(
- $first, $last, $ss, $company, $address1, $address2, $city, $county,
- $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo,
- $paydate, $payname, $invoicing_list, $pkgpart, $username, $password,
- $popnum,
- ) = map { scalar(<Client>) } ( 1 .. 23 );
-
- warn "[fs_mailadmind] sending customer data to remote server...\n" if $Debug;
- print
- $first, $last, $ss, $company, $address1, $address2, $city, $county,
- $state, $zip, $country, $daytime, $night, $fax, $payby, $payinfo,
- $paydate, $payname, $invoicing_list, $pkgpart, $username, $password,
- $popnum,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "authenticate" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading authentication material...\n" if $Debug;
- chop( my $password = <Client> );
- warn "[fs_mailadmind] sending information to remote server...\n" if $Debug;
- print "authenticate\n", $user, "\n", $password, "\n";
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "list_packages" ) {
- warn "[fs_mailadmind] reading user information to list_packages...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_packages\n", $user, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_packages = <STDIN> );
- my @packages = map {
- chomp( my $pkgnum = <STDIN> );
- chomp( my $domain = <STDIN> );
- chomp( my $account = <STDIN> );
- {
- 'pkgnum' => $pkgnum,
- 'domain' => $domain,
- 'account' => $account,
- };
- } ( 1 .. $n_packages );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_packages,
- map {
- $_->{pkgnum},
- $_->{domain},
- $_->{account},
- } @packages
- ), "\n";
-
- } elsif ( $command eq "list_mailboxes" ) {
- warn "[fs_mailadmind] reading user information to list_mailboxes...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading package number to list_mailboxes...\n" if $Debug;
- chop( my $package = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_mailboxes\n", $user, "\n", $package, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_svc_acct = <STDIN> );
- my @svc_acct = map {
- chomp( my $svcnum = <STDIN> );
- chomp( my $username = <STDIN> );
- chomp( my $_password = <STDIN> );
- {
- 'svcnum' => $svcnum,
- 'username' => $username,
- '_password' => $_password,
- };
- } ( 1 .. $n_svc_acct );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_svc_acct,
- map {
- $_->{svcnum},
- $_->{username},
- $_->{_password},
- } @svc_acct
- ), "\n";
-
- } elsif ( $command eq "delete_mailbox" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading account information to delete...\n" if $Debug;
- chop( my $account = <Client> );
- warn "[fs_mailadmind] sending information to remote server...\n" if $Debug;
- print "delete_mailbox\n", $user, "\n", $account, "\n";
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "password_mailbox" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading account information to password...\n" if $Debug;
- my(
- $account, $_password,
- ) = map { scalar(<Client>) } ( 1 .. 2 );
-
- warn "[fs_mailadmind] sending password data to remote server...\n" if $Debug;
- print "password_mailbox", "\n";
- print
- $user, "\n", $account, $_password,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "add_mailbox" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading account information to create...\n" if $Debug;
- my(
- $package, $account, $_password,
- ) = map { scalar(<Client>) } ( 1 .. 3 );
-
- warn "[fs_mailadmind] sending service data to remote server...\n" if $Debug;
- print "add_mailbox", "\n";
- print
- $user, "\n", $package, $account, $_password,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "add_forward" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading forward information to create...\n" if $Debug;
- my(
- $package, $source, $dest,
- ) = map { scalar(<Client>) } ( 1 .. 3 );
-
- warn "[fs_mailadmind] sending service data to remote server...\n" if $Debug;
- print "add_forward", "\n";
- print
- $user, "\n", $package, $source, $dest,
- ;
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "delete_forward" ) {
- warn "[fs_mailadmind] reading user information to auth...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading forward information to delete...\n" if $Debug;
- chop( my $service = <Client> );
- warn "[fs_mailadmind] sending information to remote server...\n" if $Debug;
- print "delete_forward\n", $user, "\n", $service, "\n";
-
- warn "[fs_mailadmind] reading error from remote server...\n" if $Debug;
- my $error = <STDIN>;
-
- warn "[fs_mailadmind] sending error to local client...\n" if $Debug;
- print Client $error;
-
- } elsif ( $command eq "list_forwards" ) {
- warn "[fs_mailadmind] reading user information to list_forwards...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading service number to list_forwards...\n" if $Debug;
- chop( my $service = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_forwards\n", $user, "\n", $service, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_svc_forward = <STDIN> );
- my @svc_forward = map {
- chomp( my $svcnum = <STDIN> );
- chomp( my $dest = <STDIN> );
- {
- 'svcnum' => $svcnum,
- 'dest' => $dest,
- };
- } ( 1 .. $n_svc_forward );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_svc_forward,
- map {
- $_->{svcnum},
- $_->{dest},
- } @svc_forward
- ), "\n";
-
- } elsif ( $command eq "list_pkg_forwards" ) {
- warn "[fs_mailadmind] reading user information to list_pkg_forwards...\n" if $Debug;
- chop( my $user = <Client> );
- warn "[fs_mailadmind] reading service number to list_forwards...\n" if $Debug;
- chop( my $package = <Client> );
- warn "[fs_mailadmind] sending user information to remote server...\n" if $Debug;
- print "list_pkg_forwards\n", $user, "\n", $package, "\n";
-
- warn "[fs_mailadmind] reading data from remote server...\n" if $Debug;
- chomp( my $n_svc_forward = <STDIN> );
- my @svc_forward = map {
- chomp( my $svcnum = <STDIN> );
- chomp( my $srcsvc = <STDIN> );
- chomp( my $dest = <STDIN> );
- {
- 'svcnum' => $svcnum,
- 'srcsvc' => $srcsvc,
- 'dest' => $dest,
- };
- } ( 1 .. $n_svc_forward );
-
- warn "[fs_mailadmind] sending data to local client...\n" if $Debug;
-
- print Client join("\n", $n_svc_forward,
- map {
- $_->{svcnum},
- $_->{srcsvc},
- $_->{dest},
- } @svc_forward
- ), "\n";
-
- } else {
- die "unexpected command from client: $command";
- }
-
-}
-
+++ /dev/null
-
-This collection of files implements a 'self-administered mail service.'
-Configuration is similar to fs_signupd
-
-Additionally you will need to modify the database:
-
-CREATE TABLE svc_acct_admin (
- svcnum int primary key,
- adminsvc int not null
-);
-
-creating both as keys might be good
-
-(and perform the dbdef-create)
-
-
-As it exists now, a package containing one svc_domain, at least one
-svc_acct_admin, and other services can have its svc_acct's and svc_forward's
-manipulated by the svc_acct referenced by a svc_acct_admin in the package.
-
-One svc_acct may be referenced as svc_acct_admin for multiple packages.
-
-fs_mailadmin_server contains hard coded references to service numbers which
-will require editing for your system.
-
-It's not a lot, but it might provide inspiration.
-
+++ /dev/null
-#!/usr/bin/perl -Tw
-#
-# fs_mailadmin_server
-#
-
-use strict;
-use IO::Handle;
-use FS::SSH qw(sshopen2);
-use FS::UID qw(adminsuidsetup);
-use FS::Conf;
-use FS::Record qw( qsearch qsearchs );
-use FS::cust_main_county;
-use FS::cust_main;
-use FS::svc_acct_admin;
-
-use vars qw( $opt $Debug $conf $default_domain );
-
-$Debug = 1;
-
-#my @payby = qw(CARD PREPAY);
-
-my $user = shift or die &usage;
-&adminsuidsetup( $user );
-
-$conf = new FS::Conf;
-$default_domain = $conf->config('domain');
-
-my $machine = shift or die &usage;
-
-my $agentnum = shift or die &usage;
-my $agent = qsearchs( 'agent', { 'agentnum' => $agentnum } ) or die &usage;
-my $pkgpart = $agent->pkgpart_hashref;
-
-my $refnum = shift or die &usage;
-
-#causing trouble for some folks
-#$SIG{CHLD} = sub { wait() };
-
-my($fs_mailadmind)=$conf->config('fs_mailadmind');
-
-while (1) {
- my($reader,$writer)=(new IO::Handle, new IO::Handle);
- $writer->autoflush(1);
- warn "[fs_mailadmin_server] Connecting to $machine...\n" if $Debug;
- sshopen2($machine,$reader,$writer,$fs_mailadmind);
-
- my $data;
-
- warn "[fs_mailadmin_server] Sending locales...\n" if $Debug;
- my @cust_main_county = qsearch('cust_main_county', {} );
- print $writer $data = join("\n",
- ( scalar(@cust_main_county) || die "no tax rates (cust_main_county records)" ),
- map {
- $_->taxnum,
- $_->state,
- $_->county,
- $_->country,
- } @cust_main_county
- ),"\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- warn "[fs_mailadmin_server] Sending package definitions...\n" if $Debug;
- my @part_pkg = grep { $_->svcpart('svc_acct') && $pkgpart->{ $_->pkgpart } }
- qsearch( 'part_pkg', {} );
- print $writer $data = join("\n",
- ( scalar(@part_pkg) || die "no usable package definitions, agent $agentnum" ),
- map {
- $_->pkgpart,
- $_->pkg,
- } @part_pkg
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- warn "[fs_mailadmin_server] Sending POPs...\n" if $Debug;
- my @svc_acct_pop = qsearch ('svc_acct_pop',{} );
- print $writer $data = join("\n",
- ( scalar(@svc_acct_pop) || die "No points of presence (svc_acct_pop records)" ),
- map {
- $_->popnum,
- $_->city,
- $_->state,
- $_->ac,
- $_->exch,
- $_->loc,
- } @svc_acct_pop
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- warn "[fs_mailadmin_server] Entering main loop...\n" if $Debug;
-COMMAND: while (1) {
- warn "[fs_mailadmin_server] Reading (waiting for) command...\n" if $Debug;
- chop( my($command, $user) = map { scalar(<$reader>) } ( 1 .. 2 ) );
- my $domain = $default_domain;
- $user =~ /^([\w\.\-]+)\@(([\w\-]+\.)+\w+)$/;
- ($user, $domain) = ($1, $2);
-
- if ($command eq 'authenticate'){
- warn "[fs_mailadmin_server] Processing authenticate command for $user \n" if $Debug;
- chop( my($password) = map { scalar(<$reader>) } ( 1 .. 1 ) );
-
- my $error = '';
-
- my @svc_domain = qsearchs('svc_domain', { 'domain' => $domain });
-
- if (scalar(@svc_domain) != 1) {
- warn "Nonexistant or duplicate service account for \"$domain\"";
- next COMMAND;
- }
-
- my @svc_acct = qsearchs('svc_acct', { 'username' => $user,
- 'domsvc' => $svc_domain[0]->svcnum });
- if (scalar(@svc_acct) != 1) {
- die "Nonexistant or duplicate service account for \"$user\"";
- next COMMAND;
- }
-
- if ($svc_acct[0]->_password eq $password) {
- $error = "$user\@$domain OK";
- }else{
- $error = "$user\@$domain FAILED";
- }
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
- }
- elsif ($command eq 'list_packages'){
- warn "[fs_mailadmin_server] Processing list_packages command for $user \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my %packages;
- my %accounts;
-
- foreach my $package (@packages) {
- $packages{my $pkgnum = $package->getfield('pkgnum')} = $default_domain;
- $accounts{$pkgnum} = 0;
- my @services = qsearch('cust_svc', { 'pkgnum' => $pkgnum });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '4'){
- my $account=qsearchs('svc_domain', { 'svcnum' => $service->getfield('svcnum') });
- $packages{$pkgnum}=$account->getfield('domain');
- $accounts{$pkgnum}=$account->getfield('svcnum');
- }
- }
- }
-
- print $writer $data = join("\n",
- ( scalar(keys(%packages)) ),
- map {
- $_,
- $packages{$_},
- $accounts{$_},
- } keys(%packages)
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
- }elsif ($command eq 'list_mailboxes'){
-
- warn "[fs_mailadmin_server] Processing list_mailboxes command for $user" if $Debug;
- chop( my($pkgnum) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "package $pkgnum \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my @accounts;
-
- foreach my $package (@packages) {
- next unless ($pkgnum eq $package->getfield('pkgnum'));
- my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '2'){
- my $account=qsearchs('svc_acct', { 'svcnum' => $service->getfield('svcnum') });
-# $accounts[$#accounts+1]=$account->getfield('username');
- $accounts[$#accounts+1]=$account;
- }
- }
- }
-
- print $writer $data = join("\n",
-# ( scalar(@accounts) || die "No accounts (svc_acct records)" ),
- ( scalar(@accounts) ),
- map {
- $_->svcnum,
-# $_->username,
- $_->email,
-# $_->_password,
- '*****',
- } @accounts
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
-
- } elsif ($command eq 'delete_mailbox'){
- warn "[fs_mailadmin_server] Processing delete_mailbox command for $user " if $Debug;
- chop( my($account) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "account $account \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- my @svc_acct = qsearchs('svc_acct', { 'svcnum' => $account }) unless $error;
- if (scalar(@svc_acct) != 1) { $error ||= 'Nonexistant or duplicate service account for user.' };
- if (! $error && check_administrator(\@packages, $svc_acct[0])){
-# not sure about the next three lines... do we delete? or return error
- foreach my $svc_forward (qsearch('svc_forward', { 'dstsvc' => $svc_acct[0]->getfield('svcnum') })) {
- $error ||= $svc_forward->delete;
- }
- foreach my $svc_forward (qsearch('svc_forward', { 'srcsvc' => $svc_acct[0]->getfield('svcnum') })) {
- $error ||= $svc_forward->delete;
- }
- $error ||= $svc_acct[0]->delete;
- } else {
- $error ||= "Illegal attempt to remove service";
- }
-
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } elsif ($command eq 'password_mailbox'){
- warn "[fs_mailadmin_server] Processing password_mailbox command for $user " if $Debug;
- chop( my($account, $_password) = map { scalar(<$reader>) } ( 1 .. 2 ) );
- warn "account $account with password $_password \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- my @svc_acct = qsearchs('svc_acct', { 'svcnum' => $account }) unless $error;
- if (scalar(@svc_acct) != 1) { $error ||= 'Nonexistant or duplicate service account.' };
-
- if (! $error && check_administrator(\@packages, $svc_acct[0])){
- my $new = new FS::svc_acct ({$svc_acct[0]->hash});
- $new->setfield('_password' => $_password);
- $error ||= $new->replace($svc_acct[0]);
- } else {
- $error ||= "Illegal attempt to change password";
- }
-
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } elsif ($command eq 'add_mailbox'){
- warn "[fs_mailadmin_server] Processing add_mailbox command for $user " if $Debug;
- chop( my($target_package, $account, $_password) = map { scalar(<$reader>) } ( 1 .. 3 ) );
- warn "in package $target_package account $account with password $_password \n" if $Debug;
-
- my $found_package;
- my $domainsvc=0;
- my $svcpart=2; # this is 'email box'
- my $svcpartsm=3; # this is 'domain alias'
- my $error = '';
- my $found = 0;
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- foreach my $package (@packages) {
- if ($package->getfield('pkgnum') eq $target_package) {
- $found = 1;
- $found_package=$package;
- my @services = qsearch('cust_svc', { 'pkgnum' => $target_package });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '4'){
- my @svc_domain=qsearchs('svc_domain', { 'svcnum' => $service->getfield('svcnum') });
- if (scalar(@svc_domain) eq 1) {
- $domainsvc=$svc_domain[0]->getfield('svcnum');
- }
- }
- }
- last;
- }
- }
- warn "User $user does not have administration rights to package $target_package\n" unless $found;
- $error ||= "User $user does not have administration rights to package $target_package\n" unless $found;
-
- my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$found_package->getfield('pkgpart')});
-
- #list of services this pkgpart includes (although at the moment we only care
- # about $svcpart
- my $pkg_svc;
- my %pkg_svc = ();
- foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $found_package->pkgpart }) ) {
- $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity;
- }
-
- my @services = qsearch('cust_svc', {'pkgnum' => $found_package->getfield('pkgnum'),
- 'svcpart' => $svcpart,
- });
-
- if (scalar(@services) >= $pkg_svc{$svcpart}) {
- $error="Maximum allowed already reached.";
- }
-
- my $svc_acct = new FS::svc_acct ( {
- 'pkgnum' => $found_package->pkgnum,
- 'svcpart' => $svcpart,
- 'username' => $account,
- 'domsvc' => $domainsvc,
- '_password' => $_password,
- } );
-
- my $y = $svc_acct->setdefault; # arguably should be in new method
- $error ||= $y unless ref($y);
- #and just in case you were silly
- $svc_acct->pkgnum($found_package->pkgnum);
- $svc_acct->svcpart($svcpart);
- $svc_acct->username($account);
- $svc_acct->domsvc($domainsvc);
- $svc_acct->_password($_password);
-
- $error ||= $svc_acct->check;
-
- if ( ! $error ) { #in this case, $cust_pkg should always
- #be definied, but....
- $error ||= $svc_acct->insert;
- warn "WARNING: $error on pre-checked svc_acct record!" if $error;
- }
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- }elsif ($command eq 'list_forwards'){
-
- warn "[fs_mailadmin_server] Processing list_forwards command for $user" if $Debug;
- chop( my($svcnum) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "service $svcnum \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my @forwards;
-
- foreach my $package (@packages) {
-# next unless ($pkgnum eq $package->getfield('pkgnum'));
- my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '10'){
- my $forward=qsearchs('svc_forward', { 'svcnum' => $service->getfield('svcnum') });
- $forwards[$#forwards+1]=$forward if ($forward->getfield('srcsvc') == $svcnum);
- }
- }
- }
-
- print $writer $data = join("\n",
- ( scalar(@forwards) ),
- map {
- $_->svcnum,
- ($_->dstsvc ? qsearchs('svc_acct', {'svcnum' => $_->dstsvc})->email : $_->dst),
- } @forwards
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
-
- }elsif ($command eq 'list_pkg_forwards'){
-
- warn "[fs_mailadmin_server] Processing list_pkg_forwards command for $user" if $Debug;
- chop( my($pkgnum) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "package $pkgnum \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval {find_administrable_packages( $user, $domain )};
- warn "$@" if $@;
-
- my @forwards;
-
- foreach my $package (@packages) {
- next unless ($pkgnum eq $package->getfield('pkgnum'));
- my @services = qsearch('cust_svc', { 'pkgnum' => $package->getfield('pkgnum') });
- foreach my $service (@services) {
- if ($service->getfield('svcpart') eq '10'){
- my $forward=qsearchs('svc_forward', { 'svcnum' => $service->getfield('svcnum') });
- $forwards[$#forwards+1]=$forward;
- }
- }
- }
-
- print $writer $data = join("\n",
- ( scalar(@forwards) ),
- map {
- $_->svcnum,
- $_->srcsvc,
- ($_->dstsvc ? qsearchs('svc_acct', {'svcnum' => $_->dstsvc})->email : $_->dst),
- } @forwards
- ), "\n";
- warn "[fs_mailadmin_server] $data\n" if $Debug > 2;
-
-
- } elsif ($command eq 'delete_forward'){
- warn "[fs_mailadmin_server] Processing delete_forward command for $user " if $Debug;
- chop( my($forward) = map { scalar(<$reader>) } ( 1 .. 1 ) );
- warn "forward $forward \n" if $Debug;
-
- my $error = '';
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- my @svc_forward = qsearchs('svc_forward', { 'svcnum' => $forward }) unless $error;
- if (scalar(@svc_forward) != 1) { $error ||= 'Nonexistant or duplicate service account for user.' };
- if (! $error && check_administrator(\@packages, $svc_forward[0])){
-# not sure about the next three lines... do we delete? or return error
- $error ||= $svc_forward[0]->delete;
- } else {
- $error ||= "Illegal attempt to remove service";
- }
-
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } elsif ($command eq 'add_forward'){
- warn "[fs_mailadmin_server] Processing add_forward command for $user " if $Debug;
- chop( my($target_package, $source, $dest) = map { scalar(<$reader>) } ( 1 .. 3 ) );
- warn "in package $target_package source $source with destination $dest \n" if $Debug;
-
- my $found_package;
- my $domainsvc=0;
- my $svcpart=10; # this is 'forward service'
- my $error = '';
- my $found = 0;
-
- my @packages = eval { find_administrable_packages($user, $domain) };
- warn "$@" if $@;
- $error ||= "$@" if $@;
-
- foreach my $package (@packages) {
- if ($package->getfield('pkgnum') eq $target_package) {
- $found = 1;
- $found_package=$package;
- last;
- }
- }
- warn "User $user does not have administration rights to package $target_package\n" unless $found;
- $error ||= "User $user does not have administration rights to package $target_package\n" unless $found;
-
- my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $source });
- warn "Forwarding source $source does not exist.\n" unless $svc_acct;
- $error ||= "Forwarding source $source does not exist.\n" unless $svc_acct;
-
- my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $source });
- warn "Forwarding source $source not attached to any account.\n" unless $cust_svc;
- $error ||= "Forwarding source $source not attached to any account.\n" unless $cust_svc;
-
- if ( ! $error ) {
- warn "Forwarding source $source is not in package $target_package\n"
- unless ($cust_svc->getfield('pkgnum') == $target_package);
- $error ||= "Forwarding source $source is not in package $target_package\n"
- unless ($cust_svc->getfield('pkgnum') == $target_package);
- }
-
- my $part_pkg = qsearchs('part_pkg',{'pkgpart'=>$found_package->getfield('pkgpart')});
-
- #list of services this pkgpart includes (although at the moment we only care
- # about $svcpart
- my $pkg_svc;
- my %pkg_svc = ();
- foreach $pkg_svc ( qsearch('pkg_svc',{'pkgpart'=> $found_package->pkgpart }) ) {
- $pkg_svc{$pkg_svc->svcpart} = $pkg_svc->quantity if $pkg_svc->quantity;
- }
-
- my @services = qsearch('cust_svc', {'pkgnum' => $found_package->getfield('pkgnum'),
- 'svcpart' => $svcpart,
- });
-
- if (scalar(@services) >= $pkg_svc{$svcpart}) {
- $error="Maximum allowed already reached.";
- }
-
- my $svc_forward = new FS::svc_forward ( {
- 'pkgnum' => $found_package->pkgnum,
- 'svcpart' => $svcpart,
- 'srcsvc' => $source,
- 'dstsvc' => 0,
- 'dst' => $dest,
- } );
-
- my $y = $svc_forward->setdefault; # arguably should be in new method
- $error ||= $y unless ref($y);
- #and just in case you were silly
- $svc_forward->pkgnum($found_package->pkgnum);
- $svc_forward->svcpart($svcpart);
- $svc_forward->srcsvc($source);
- $svc_forward->dstsvc(0);
- $svc_forward->dst($dest);
-
- $error ||= $svc_forward->check;
-
- if ( ! $error ) { #in this case, $cust_pkg should always
- #be definied, but....
- $error ||= $svc_forward->insert;
- warn "WARNING: $error on pre-checked svc_forward record!" if $error;
- }
-
- warn "[fs_mailadmin_server] Sending results...\n" if $Debug;
- print $writer $error, "\n";
-
- } else {
- warn "[fs_mailadmin_server] Bad command: $command \n" if $Debug;
- print $writer "Bad command \n";
- }
- }
- close $writer;
- close $reader;
- warn "connection to $machine lost! waiting 60 seconds...\n";
- sleep 60;
- warn "reconnecting...\n";
-}
-
-sub usage {
- die "Usage:\n\n fs_mailadmin_server user machine agentnum refnum\n";
-}
-
-#sub find_administrable_packages {
-# my $user = shift;
-#
-# my $error = '';
-#
-# my @svc_acct = qsearchs('svc_acct', { 'username' => $user });
-# if (scalar(@svc_acct) != 1) {
-# die "Nonexistant or duplicate service account for \"$user\"";
-# }
-#
-# my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct[0]->getfield('svcnum') });
-# if (scalar(@cust_svc) != 1 ) {
-# die "Nonexistant or duplicate customer service for \"$user\"";
-# }
-#
-# my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') });
-# if (scalar(@cust_pkg) != 1) {
-# die "Nonexistant or duplicate customer package for \"$user\"";
-# }
-#
-# my @cust_main = qsearchs('cust_main', { 'custnum' => $cust_pkg[0]->getfield('custnum') });
-# if (scalar(@cust_main) != 1 ) {
-# die "Nonexistant or duplicate customer for \"$user\"";
-# }
-#
-# my @packages = $cust_main[0]->ncancelled_pkgs;
-#}
-
-sub find_administrable_packages {
- my $user = shift;
- my $domain = shift;
-
- my @packages;
- my $error = '';
-
- my @svc_domain = qsearchs('svc_domain', { 'domain' => $domain });
-
- if (scalar(@svc_domain) != 1) {
- die "Nonexistant or duplicate service account for \"$domain\"";
- }
-
- my @svc_acct = qsearchs('svc_acct', { 'username' => $user,
- 'domsvc' => $svc_domain[0]->svcnum });
- if (scalar(@svc_acct) != 1) {
- die "Nonexistant or duplicate service account for \"$user\"";
- }
-
- my @svc_acct_admin = qsearch('svc_acct_admin', {'adminsvc' => $svc_acct[0]->getfield('svcnum') });
- die "Nonexistant or duplicate customer service for \"$user\"" unless scalar(@svc_acct_admin);
-
- foreach my $svc_acct_admin (@svc_acct_admin) {
- my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct_admin->getfield('svcnum') });
- if (scalar(@cust_svc) != 1 ) {
- die "Nonexistant or duplicate customer service for admin \"$svc_acct_admin->getfield('svcnum')\"";
- }
-
- my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') });
- if (scalar(@cust_pkg) != 1) {
- die "Nonexistant or duplicate customer package for admin \"$user\"";
- }
-
- push @packages, $cust_pkg[0] unless $cust_pkg[0]->getfield('cancel');
-
- }
- (@packages);
-}
-
-sub check_administrator {
- my ($allowed_packages_aref, $svc_acct_ref) = @_;
-
- my $error = '';
- my $found = 0;
-
- {
- my @cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_acct_ref->getfield('svcnum') });
- if (scalar(@cust_svc) != 1 ) {
- warn "Nonexistant or duplicate customer service for \"$svc_acct_ref->getfield('username')\"";
- last;
- }
-
- my @cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $cust_svc[0]->getfield('pkgnum') });
- if (scalar(@cust_pkg) != 1) {
- warn "Nonexistant or duplicate customer package for \"$svc_acct_ref->getfield('username')\"";
- last;
- }
-
- foreach my $package (@$allowed_packages_aref) {
- if ($package->getfield('pkgnum') eq $cust_pkg[0]->getfield('pkgnum')) {
- $found = 1;
- last;
- }
- }
- }
-
- $found;
-}
-
-sub check_add {
- my ($allowed_packages_aref, $target_package) = @_;
-
- my $error = '';
- my $found = 0;
-
- foreach my $package (@$allowed_packages_aref) {
- if ($package->getfield('pkgnum') eq $target_package) {
- $found = 1;
- last;
- }
- }
-
- $found;
-}
-
--- /dev/null
+Revision history for Perl extension FS::SelfService.
+
+0.01 Tue May 28 16:49:41 2002
+ - original version; created by h2xs 1.21 with options
+ -A -X -n FS::SelfService
+
--- /dev/null
+Changes
+Makefile.PL
+MANIFEST
+README
+SelfService.pm
+test.pl
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'FS::SelfService',
+ 'VERSION_FROM' => 'SelfService.pm', # finds $VERSION
+ 'EXE_FILES' => [ 'freeside-selfservice-clientd' ],
+ 'INSTALLSCRIPT' => '/usr/local/sbin',
+ 'INSTALLSITEBIN' => '/usr/local/sbin',
+ 'PERM_RWX' => '750',
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'SelfService.pm', # retrieve abstract from module
+ AUTHOR => 'Ivan Kohler <ivan-freeside-selfservice@420.am>') : ()),
+);
--- /dev/null
+package FS::SelfService;
+
+use 5.006;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration use FS::SelfService ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+our %EXPORT_TAGS = ( 'all' => [ qw(
+
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+
+);
+our $VERSION = '0.01';
+
+
+# Preloaded methods go here.
+
+1;
+__END__
+# Below is stub documentation for your module. You better edit it!
+
+=head1 NAME
+
+FS::SelfService - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+ use FS::SelfService;
+ blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for FS::SelfService, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+=head2 EXPORT
+
+None by default.
+
+
+=head1 AUTHOR
+
+A. U. Thor, E<lt>a.u.thor@a.galaxy.far.far.awayE<gt>
+
+=head1 SEE ALSO
+
+L<perl>.
+
+=cut
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+BEGIN { plan tests => 1 };
+use FS::SelfService;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+# Insert your test code below, the Test module is use()ed here so read
+# its man page ( perldoc Test ) for help writing this test script.
+
--- /dev/null
+#!/usr/bin/perl -w
+#
+# freeside-selfservice-server
+
+# alas, much false laziness with freeside-queued and fs_signup_server. at
+# least it is slated to replace fs_{signup,passwd,mailadmin}_server
+# should probably generalize the version in here, or better yet use
+# Proc::Daemon or somesuch
+
+use strict;
+use vars qw( $kids $max_kids $shutdown $log_file );
+use vars qw($ssh_pid);
+use Fcntl qw(:flock);
+use POSIX qw(setsid);
+use IO::Handle;
+use Storable qw(nstore_fd fd_retrieve);
+use Net::SSH qw(sshopen2);
+use FS::UID qw(adminsuidsetup);
+
+#use Tie::RefHash;
+#use FS::Conf;
+#use FS::Record qw( qsearch qsearchs );
+#use FS::cust_main_county;
+#use FS::cust_main;
+#use FS::Msgcat qw(gettext);
+
+$shutdown = 0;
+$max_kids = '10'; #?
+$kids = 0;
+
+my $user = shift or die &usage;
+my $machine = shift or die &usage;
+my $pid_file = "/var/run/freeside-selfservice-server.$user.pid";
+#my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; $FS::UID::datasrc not posible, but should include machine name at least, hmm
+
+&init($user);
+
+my $clientd = "/usr/local/sbin/freeside-selfservice-clientd"; #better name?
+
+my %dispatch = (
+ 'signup' => \&signup,
+ #'signup_init' => 'signup_init',
+ 'passwd' => \&passwd,
+
+);
+
+my $warnkids=0;
+while (1) {
+ my($reader, $writer) = (new IO::Handle, new IO::Handle);
+ warn "connecting to $machine";
+ $ssh_pid = sshopen2($machine,$reader,$writer,$clientd);
+
+ warn "entering main loop";
+ while (1) {
+
+ warn "waiting for packet from client";
+ my $packet = eval {
+ local $SIG{__DIE__};
+ local $SIG{ALRM} = sub { die "alarm\n" }; #NB: \n required
+ alarm 5;
+ my $p = fd_retrieve($reader);
+ alarm 0;
+ $p;
+ };
+ if ($@) {
+ die $@ unless $@ eq "alarm\n";
+ #timeout
+ next unless $shutdown;
+ &shutdown;
+ }
+ warn "packet received";
+
+ #prevent runaway forking
+ my $warnkids = 0;
+ while ( $kids >= $max_kids ) {
+ warn "WARNING: maximum $kids children reached" unless $warnkids++;
+ sleep 1;
+ }
+
+ warn "forking child";
+ defined( my $pid = fork ) or die "can't fork: $!";
+ if ( $pid ) {
+ warn "child $pid spawned";
+ $kids++;
+ } else { #kid time
+
+ #get new db handle
+ $FS::UID::dbh->{InactiveDestroy} = 1;
+ forksuidsetup($user);
+
+ my $sub = $dispatch{$packet->{_packet}};
+ my $rv;
+ if ( $sub ) {
+ warn "calling $sub handler";
+ $rv = &{$sub}($packet);
+ } else {
+ warn my $error = "WARNING: unknown packet type ". $packet->{_packet};
+ $rv = { _error => $error };
+ }
+ $rv->{_token} = $packet->{_token}; #identifier
+
+ warn "sending response";
+ flock($writer, LOCK_EX); #acquire write lock
+ nstore_fd($rv, $writer) or die "can't send response: $!";
+ $writer->flush;
+ flock($writer, LOCK_UN); #release write lock
+
+ warn "child exiting";
+ exit; #end-of-kid
+ }
+
+ }
+
+}
+
+###
+# utility subroutines
+###
+
+sub init {
+ my $user = shift;
+
+ chdir "/" or die "Can't chdir to /: $!";
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ defined(my $pid = fork) or die "Can't fork: $!";
+ if ( $pid ) {
+ print "freeside-selfservice-server to $machine started with pid $pid\n"; #logging to $log_file
+ exit unless $pid_file;
+ my $pidfh = new IO::File ">$pid_file" or exit;
+ print $pidfh "$pid\n";
+ exit;
+ }
+
+ sub REAPER { my $pid = wait; $SIG{CHLD} = \&REAPER; $kids--; }
+ $SIG{CHLD} = \&REAPER;
+
+ $shutdown = 0;
+ $SIG{HUP} = sub { warn "SIGHUP received; shutting down\n"; $shutdown++; };
+ $SIG{INT} = sub { warn "SIGINT received; shutting down\n"; $shutdown++; };
+ $SIG{TERM} = sub { warn "SIGTERM received; shutting down\n"; $shutdown++; };
+ $SIG{QUIT} = sub { warn "SIGQUIT received; shutting down\n"; $shutdown++; };
+ $SIG{PIPE} = sub { warn "SIGPIPE received; shutting down\n"; $shutdown++; };
+
+ $> = $FS::UID::freeside_uid unless $>;
+ $< = $>;
+ $ENV{HOME} = (getpwuid($>))[7]; #for ssh
+ adminsuidsetup $user;
+
+ #$log_file = "/usr/local/etc/freeside/selfservice.". $FS::UID::datasrc; #MACHINE NAME
+ $log_file = "/usr/local/etc/freeside/selfservice.$machine.log";
+
+ open STDOUT, '>/dev/null'
+ or die "Can't write to /dev/null: $!";
+ setsid or die "Can't start a new session: $!";
+ open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
+
+ $SIG{__DIE__} = \&_die;
+ $SIG{__WARN__} = \&_logmsg;
+
+ warn "freeside-selfservice-server starting\n";
+
+}
+
+sub shutdown {
+ my $wait = 12; #wait up to 1 minute
+ while ( $kids && $wait-- ) {
+ warn "waiting for $kids children to terminate";
+ sleep 5;
+ }
+ warn "abandoning $kids children" if $kids;
+ kill 'TERM', $ssh_pid if $ssh_pid;
+ die "exiting";
+}
+
+sub _die {
+ my $msg = shift;
+ unlink $pid_file if -e $pid_file;
+ _logmsg($msg);
+}
+
+sub _logmsg {
+ chomp( my $msg = shift );
+ my $log = new IO::File ">>$log_file";
+ flock($log, LOCK_EX);
+ seek($log, 0, 2);
+ print $log "[server] [". time2str("%a %b %e %T %Y",time). "] [$$] $msg\n";
+ flock($log, LOCK_UN);
+ close $log;
+}
+
+sub usage {
+ die "Usage:\n\n fs_signup_server user machine\n";
+}
+
+###
+# handlers... should go in their own files eventually...
+###
+
#!/usr/bin/perl -Tw
#
-# $Id: signup.cgi,v 1.27 2002-04-25 12:03:15 ivan Exp $
+# $Id: signup.cgi,v 1.29 2002-05-30 22:45:20 ivan Exp $
use strict;
use vars qw( @payby $cgi $locales $packages $pops $init_data $error
? 'decline.html'
: '/usr/local/freeside/decline.html';
+
if ( -e $ieak_file ) {
my $ieak_txt = Text::Template::_load_text($ieak_file)
or die $Text::Template::ERROR;
$ieak_txt =~ /^(.*)$/s; #untaint the template source - it's trusted
$ieak_txt = $1;
+ $ieak_txt =~ s/\r//g; # don't double \r on old templates
+ $ieak_txt =~ s/\n/\r\n/g;
$ieak_template = new Text::Template ( TYPE => 'STRING', SOURCE => $ieak_txt )
or die $Text::Template::ERROR;
} else {
#false laziness w/FS::cust_bill::send & FS::cust_pay::delete
use Mail::Header;
- use Mail::Internet;
+ use Mail::Internet 1.44;
use Date::Format;
my $from = $conf->config('invoice_from'); #??? as good as any
$ENV{MAILADDRESS} = $from;
"This is an automatic message from your Freeside installation\n",
"informing you a customer has signed up via the signup server:\n",
"\n",
- 'custnum: '. $cust_main->custnum. "\n",
- 'Name : '. $cust_main->last. ", ". $cust_main->first. "\n",
- 'Agent : '. $cust_main->agent->agent. "\n",
+ 'custnum : '. $cust_main->custnum. "\n",
+ 'Name : '. $cust_main->last. ", ". $cust_main->first. "\n",
+ 'Agent : '. $cust_main->agent->agent. "\n",
+ 'Package : '. $part_pkg->pkg. ' - '. $part_pkg->comment. "\n",
+ 'Signup Date : '. time2str('%C', time). "\n",
+ 'Username : '. $svc_acct->username. "\n",
+ #'Password : '. # config file to turn this on if noment insists
+ 'Day phone : '. $cust_main->daytime. "\n",
+ 'Night phone : '. $cust_main->night. "\n",
+ 'Address : '. $cust_main->address1. "\n",
+ ( $cust_main->address2
+ ? ' '. $cust_main->address2. "\n"
+ : '' ),
+ ' '. $cust_main->city. ', '. $cust_main->state. ' '.
+ $cust_main->zip. "\n",
+ ( $cust_main->country eq 'US'
+ ? ''
+ : ' '. $cust_main->country. "\n" ),
"\n",
];
- if ( $cust_main->balance > 0 ) {
- push @$body,
- "This customer has an outstanding balance and has been suspended.\n";
- }
+ #if ( $cust_main->balance > 0 ) {
+ # push @$body,
+ # "This customer has an outstanding balance and has been suspended.\n";
+ #}
my $message = new Mail::Internet ( 'Header' => $header, 'Body' => $body );
$!=0;
$message->smtpsend( Host => $smtpmachine )
-[Entry]\r
-Entry_Name = The Internet\r
-[Phone]\r
-Dial_As_Is=no\r
-Phone_Number = { $exch. $loc }\r
-Area_Code = { $ac }\r
-Country_Code = 1\r
-Country_Id = 1\r
-[Server]\r
-Type = PPP\r
-SW_Compress = Yes\r
-PW_Encrypt = Yes\r
-Negotiate_TCP/IP = Yes\r
-Disable_LCP = No\r
-[TCP/IP]\r
-Specify_IP_Address = No\r
-Specity_Server_Address = No\r
-IP_Header_Compress = Yes\r
-Gateway_On_Remote = Yes\r
-[User]\r
-Name = { $username }\r
-Password = { $password }\r
-Display_Password = Yes\r
-[Internet_Mail]\r
-Email_Name = { $email_name }\r
-Email_Address = { $username }\@domain.tld\r
-POP_Server = mail.domain.tld\r
-POP_Server_Port_Number = 110\r
-POP_Login_Name = { $username }\r
-POP_Login_Password = { $password }\r
-SMTP_Server = mail.domain.tld\r
-SMTP_Server_Port_Number = 25\r
-Install_Mail = 1\r
-[Internet_News]\r
-NNTP_Server = news.domain.tld\r
-NNTP_Server_Port_Number = 119\r
-Logon_Required = No\r
-Install_News = 1\r
-[Branding]\r
-Window_Title = The Internet\r
+[Entry]
+Entry_Name = The Internet
+[Phone]
+Dial_As_Is=no
+Phone_Number = { $exch. $loc }
+Area_Code = { $ac }
+Country_Code = 1
+Country_Id = 1
+[Server]
+Type = PPP
+SW_Compress = Yes
+PW_Encrypt = Yes
+Negotiate_TCP/IP = Yes
+Disable_LCP = No
+[TCP/IP]
+Specify_IP_Address = No
+Specity_Server_Address = No
+IP_Header_Compress = Yes
+Gateway_On_Remote = Yes
+[User]
+Name = { $username }
+Password = { $password }
+Display_Password = Yes
+[Internet_Mail]
+Email_Name = { $email_name }
+Email_Address = { $username }\@domain.tld
+POP_Server = mail.domain.tld
+POP_Server_Port_Number = 110
+POP_Login_Name = { $username }
+POP_Login_Password = { $password }
+SMTP_Server = mail.domain.tld
+SMTP_Server_Port_Number = 25
+Install_Mail = 1
+[Internet_News]
+NNTP_Server = news.domain.tld
+NNTP_Server_Port_Number = 119
+Logon_Required = No
+Install_News = 1
+[Branding]
+Window_Title = The Internet
%search = ( 'disabled' => '' );
}
-my @part_svc = qsearch('part_svc', \%search );
+my @part_svc =
+ sort { $a->getfield('svcpart') <=> $b->getfield('svcpart') }
+ qsearch('part_svc', \%search );
my $total = scalar(@part_svc);
%>
<TH COLSPAN=2>Modifier</TH>
</TR>
-<% foreach my $part_svc ( sort {
- $a->getfield('svcpart') <=> $b->getfield('svcpart')
- } @part_svc ) {
+<% foreach my $part_svc ( @part_svc ) {
my $hashref = $part_svc->hashref;
my $svcdb = $hashref->{svcdb};
my @dfields = fields($svcdb);
<% } %>
<TR>
- <TD COLSPAN=<%= $cgi->param('showdisabled') ? 7 : 8 %>><A HREF="<%= $p %>edit/part_svc.cgi"><I>Add a new service definition</I></A></TD>
+ <TD COLSPAN=<%= $cgi->param('showdisabled') ? 7 : 8 %>>
+ <FORM METHOD="POST" ACTION="<%= $p %>edit/part_svc.cgi"><A HREF="<%= $p %>edit/part_svc.cgi"><I>Add a new service definition</I></A> or <SELECT NAME="clone"><OPTION></OPTION>
+<% foreach my $part_svc ( @part_svc ) { %>
+ <OPTION VALUE="<%= $part_svc->svcpart %>"><%= $part_svc->svc %></OPTION>
+<% } %>
+ </SELECT><INPUT TYPE="submit" VALUE="Clone existing service">
+ </FORM>
+ </TD>
</TR>
</TABLE>
</BODY>
+++ /dev/null
-<HTML>
- <HEAD>
- <TITLE>
- Freeside Main Menu
- </TITLE>
- </HEAD>
- <BODY BGCOLOR="#FFFFFF">
- <table width="100%">
- <tr><td>
- <IMG BORDER=0 ALT="Silicon Interactive Software Design" SRC="images/small-logo.png">
- </td><td>
- <font color="#ff0000" size=7>freeside main menu</font>
- </td><td align=right valign=bottom>
- version 1.4.0
- <BR><A HREF="http://www.sisd.com/freeside">Freeside home page</A>
- <BR><A HREF="docs/">Documentation</A>
- <BR><A HREF="index.html">New interface</A>
- </td></tr>
- </table>
- <hr noshade>
- <ul>
- <li><A HREF="edit/cust_main.cgi">New Customer</A>
- <li><A NAME="search">Search</A>
- <ul>
- <LI><A HREF="search/cust_main.html">customers (by last name and/or company)</A>
- <LI><A HREF="search/cust_main-payinfo.html">customers (by credit card number)</A>
- <LI><A HREF="search/svc_acct.html">accounts (by username)</A>
- <LI><A HREF="search/svc_domain.html">domains (by domain)</A>
-<!-- <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>-->
-<!-- <LI><A HREF="search/svc_forward.html">mail forwards (by ?)</A>-->
- <LI><A HREF="search/cust_bill.html">invoices (by invoice number)</A>
- <LI><A HREF="search/cust_pay.html">checks (by check number)</A>
- </ul>
- <li><A NAME="browse">Browse</A>
- <ul>
- <LI>customers (<A HREF="search/cust_main.cgi?browse=custnum">by customer number</A>) (<A HREF="search/cust_main.cgi?browse=last">by last name</A>) (<A HREF="search/cust_main.cgi?browse=company">by company</A>)
- <LI>invoices
- <UL>
- <LI>open invoices (<A HREF="search/cust_bill.cgi?OPEN_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN_custnum">by customer number</A>)
- <LI>30 day open invoices (<A HREF="search/cust_bill.cgi?OPEN30_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN30_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN30_custnum">by customer number</A>)
- <LI>60 day open invoices (<A HREF="search/cust_bill.cgi?OPEN60_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN60_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN60_custnum">by customer number</A>)
- <LI>90 day open invoices (<A HREF="search/cust_bill.cgi?OPEN90_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN90_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN90_custnum">by customer number</A>)
- <LI>120 day open invoices (<A HREF="search/cust_bill.cgi?OPEN120_invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?OPEN120_date">by date</A>) (<A HREF="search/cust_bill.cgi?OPEN120_custnum">by customer number</A>)
- <LI>all invoices (<A HREF="search/cust_bill.cgi?invnum">by invoice number</A>) (<A HREF="search/cust_bill.cgi?date">by date</A>) (<A HREF="search/cust_bill.cgi?custnum">by customer number</A>)
- </UL>
- <LI>financials
- <UL>
- <LI><A HREF="search/report_receivables.cgi">receivables report</A>
- <LI><A HREF="search/report_tax.html">tax reports</A>
- <LI><A HREF="search/report_cc.html">credit card receipts</A>
- <LI><A HREF="search/report_credit.html">in house credits</A>
- </UL>
- <LI>packages
- <UL>
- <LI><A HREF="search/cust_pkg.cgi?pkgnum">packages (by package number)</A>
- <LI><A HREF="search/cust_pkg.cgi?APKG_pkgnum">packages with unconfigured services (by package number)</A>
- </UL>
- <LI>services
- <UL>
- <LI>accounts (<A HREF="search/svc_acct.cgi?svcnum">by service number</A>) (<A HREF="search/svc_acct.cgi?username">by username</A>) (<A HREF="search/svc_acct.cgi?uid">by uid</A>)
- <LI>mail forwards (<A HREF="search/svc_forward.cgi?svcnum">by service number</A>) (by ?))
- <LI>domains (<A HREF="search/svc_domain.cgi?svcnum">by service number</A>) (<A HREF="search/svc_domain.cgi?domain">by domain</A>)
- </UL>
- <LI>unlinked services
- <UL>
- <LI>unlinked accounts (<A HREF="search/svc_acct.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_acct.cgi?UN_username">by username</A>) (<A HREF="search/svc_acct.cgi?UN_uid">by uid</A>)
- <LI>unlinked mail forwards (<A HREF="search/svc_forward.cgi?UN_svcnum">by service number</A>) (by ?))
- <LI>unlinked domains (<A HREF="search/svc_domain.cgi?UN_svcnum">by service number</A>) (<A HREF="search/svc_domain.cgi?UN_domain">by domain</A>)
- </UL>
- <LI><A HREF="browse/nas.cgi">NAS ports</A>
- <LI><A HREF="browse/queue.cgi">Job queue</A>
- <LI><A HREF="browse/cust_pay_batch.cgi">Pending credit card batch</A>
- </ul>
- <li>Miscellaneous
- <ul>
- <li><A HREF="search/cust_main-quickpay.html">Quick payment entry</A>
- </ul>
- </ul>
- <hr noshade>
- <ul>
- <li><A NAME="config" HREF="config/config-view.cgi">Configuration</a><!-- - <font size="+2" color="#ff0000">start here</font> -->
- <li><A NAME="admin">Administration</a>
- <ul>
- <LI><A HREF="browse/part_svc.cgi">View/Edit service definitions</A>
- - Services are items you offer to your customers.
- <LI><A HREF="browse/part_pkg.cgi">View/Edit package definitions</A>
- - One or more services are grouped together into a package and
- given pricing information. Customers purchase packages, not
- services.
- <LI><A HREF="browse/agent_type.cgi">View/Edit agent types</A>
- - Agent types define groups of package definitions that you can
- then assign to particular agents.
- <LI><A HREF="browse/agent.cgi">View/Edit agents</A>
- - Agents are resellers of your service. Agents may be limited
- to a subset of your full offerings (via their type).
- <LI><A HREF="browse/part_referral.cgi">View/Edit referrals</A>
- - Where a customer heard about your service. Tracked for
- informational purposes.
- <LI><A HREF="browse/cust_main_county.cgi">View/Edit locales and tax rates</A>
- - Change tax rates, or break down a country into states, or a state
- into counties and assign different tax rates to each.
- <LI><A HREF="browse/svc_acct_pop.cgi">View/Edit Access Numbers</A>
- - Points of Presence
- <LI><A HREF="browse/part_bill_event.cgi">View/Edit invoice events</A> - Actions for overdue invoices
- </ul>
- </ul>
- </BODY>
-</HTML>
<% my $conf = new FS::Conf; my @config_items = $conf->config_items; %>
<% foreach my $section ( qw(required billing username password UI session
- shell mail radius apache BIND
+ shell mail apache BIND
),
'', 'deprecated') { %>
<A NAME="<%= $section || 'unclassified' %>"></A>
<FONT SIZE="-2">
<% foreach my $nav_section ( qw(required billing username password UI session
- shell mail radius apache BIND
+ shell mail apache BIND
),
'', 'deprecated') { %>
<% if ( $section eq $nav_section ) { %>
<form name="OneTrueForm" action="config-process.cgi" METHOD="POST" onSubmit="SafeOnsubmit()">
<% foreach my $section ( qw(required billing username password UI session
- shell mail radius apache BIND
+ shell mail apache BIND
),
'', 'deprecated') { %>
<A NAME="<%= $section || 'unclassified' %>"></A>
<FONT SIZE="-2">
<% foreach my $nav_section ( qw(required billing username password UI session
- shell mail radius apache BIND
+ shell mail apache BIND
),
'', 'deprecated') { %>
<% if ( $section eq $nav_section ) { %>
<li><a href="http://perl.apache.org/">mod_perl</a> (if compiling your own mod_perl, make sure you set the <a href="http://perl.apache.org/guide/install.html#EVERYTHING">EVERYTHING</a>=1 compile-time option)
<li><a href="http://www.openssh.com/">SSH</a> (<a href="http://www.openssh.com//">OpenSSH</a> is recommended. SSH Communications Security <a href="http://www.ssh.com/products/ssh/download.cfm">commercial SSH version 3</a> has been reported incompatible with Freeside.)
<li><a href="http://rsync.samba.org/">rsync</a>
- <li>A <b>transactional</b> database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">DBI</a>.
+ <li>A <b>transactional</b> database engine <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">supported</a> by Perl's <a href="http://dbi.perl.org">DBI</a>.
<ul>
<li><a href="http://www.postgresql.org/">PostgreSQL</a> (v7 or higher) is recommended.
- <li><b>MySQL is NOT supported at this time.</b> If you are a developer who wishes to contribute MySQL support, see the <a href="mysql.html">MySQL notes</a>.
- <!-- <li>MySQL has been reported to work. -->
- <!-- <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are not supported</b>. If you really want to use MySQL, you need to use one of the new <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>, and set it as the default table type using the <code>--default-table-type=BDB</code> <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Command-line_options">mysqld command-line option</a> or by setting <code>default-table-type=BDB</code> in the <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Option_files">my.cnf option file</a>.-->
+ <li>MySQL has been reported to work.
+ <b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">MyISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are not supported</b>. If you want to use MySQL, you <b>must</b> use one of the new <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a> or <a href="http://www.mysql.com/doc/I/n/InnoDB.html">InnoDB</a>, and set it as the default table type when running fs-setup using the <code>--default-table-type=BDB</code> or <code>--default-table-type=InnoDB</code> <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Command-line_options">mysqld command-line option</a> or by setting <code>default-table-type=BDB</code> or <code>--default-table-type=InnoDB</code> in the <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Option_files">my.cnf option file</a>.
</ul>
<li>Perl modules (<a href="http://theoryx5.uwinnipeg.ca/CPAN/perl/CPAN.html">CPAN</a> will query, download and build perl modules automatically)
<ul>
<li><a href="http://search.cpan.org/search?dist=Time-Duration">Time-Duration</a>
<li><a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML-Widgets-SelectLayers</a>
<li><a href="http://search.cpan.org/search?dist=Storable">Storable</a>
- <li><a href="http://search.cpan.org/search?dist=Apache-DBI">Apache::DBI</a> <i>(optional but recommended for better webinterface performance)</i>
+ <li><a href="http://search.cpan.org/search?dist=ApacheDBI">Apache::DBI</a> <i>(optional but recommended for better webinterface performance)</i>
</ul>
</ul>
Install the Freeside distribution:
<ul>
- <li>Add the user `freeside' to your system.
+ <li>Add the user and group `freeside' to your system.
<li>Allow the freeside user full access to the freeside database.
<ul>
<li> with <a href="http://www.postgresql.org/users-lounge/docs/7.1/postgres/user-manag.html#DATABASE-USERS">PostgreSQL</a>:
<!-- <li>Unpack the tarball: <pre>gunzip -c fs-x.y.z.tar.gz | tar xvf -</pre>-->
<li>Edit the top-level Makefile:
<ul>
- <li>Set <tt>DATASOURCE</tt> to your <a href="http://search.cpan.org/doc/TIMB/DBI-1.20/DBI.pm">DBI data source</a>, for example, <tt>DBI:Pg:host=localhost;dbname=freeside</tt> for PostgresSQL or <tt>DBI:mysql:freeside</tt> for MySQL. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.20/DBI.pm">DBI manpage</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD">manpage for your DBD</a> for the exact syntax of a DBI data source.
+ <li>Set <tt>DATASOURCE</tt> to your <a href="http://search.cpan.org/doc/TIMB/DBI-1.28/DBI.pm">DBI data source</a>, for example, <tt>DBI:Pg:host=localhost;dbname=freeside</tt> for PostgresSQL or <tt>DBI:mysql:freeside</tt> for MySQL. See the <a href="http://search.cpan.org/doc/TIMB/DBI-1.28/DBI.pm">DBI manpage</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">manpage for your DBD</a> for the exact syntax of your DBI data source.
<li>Set <tt>DB_PASSWORD</tt> to the freeside database user's password.
</ul>
<li>Add the freeside database to your database engine:
$ <a href="man/bin/freeside-adduser.html">freeside-adduser</a> -h /usr/local/etc/freeside/htpasswd <i>username</i></pre></font>
</ul>
<i>(using other auth types, add each user to your <a href="http://httpd.apache.org/docs/misc/FAQ.html#user-authentication">Apache authentication</a> and then run: <tt>freeside-adduser <b>username</b></tt></i>
- <li>As the freeside UNIX user, run <tt>bin/fs-setup <b>username</b></tt> to create the database tables, passing the username of a Freeside user you created above:
+ <li>As the freeside UNIX user, run <tt>bin/fs-setup <b>username</b></tt> (in the untar'ed freeside directory) to create the database tables, passing the username of a Freeside user you created above:
<pre>
$ su freeside
+$ cd <b>/path/to/freeside-1.4.0/</b>
$ bin/fs-setup <b>username</b>
</pre>
- <li>As the freeside UNIX user, run <tt>bin/populate-msgcat <b>username</b></tt> to populate the message catalog, passing the username of a Freeside user you created above:
+ <li>As the freeside UNIX user, run <tt>bin/populate-msgcat <b>username</b></tt> (in the untar'ed freeside directory) to populate the message catalog, passing the username of a Freeside user you created above:
<pre>
$ su freeside
+$ cd <b>/path/to/freeside-1.4.0/</b>
$ bin/populate-msgcat <b>username</b>
</pre>
- <li><tt>freeside-queued</tt> was installed with the Perl modules. Start it now and ensure that is run upon system startup (Do this manually, or, edit the top-level Makefile, replacing INIT_FILE with the appropriate location on your system, and run <tt>make install-init</tt>.
+ <li><tt>freeside-queued</tt> was installed with the Perl modules. Start it now and ensure that is run upon system startup (Do this manually, or edit the top-level Makefile, replacing INIT_FILE with the appropriate location on your system, and run <tt>make install-init</tt>)
<li>Now proceed to the initial <a href="admin.html">administration</a> of your installation.
</ul>
</body>
<h1>Importing legacy data</h1>
<font size="+2">In most cases, legacy data import all cases will require writing custom code to deal with your particular legacy data. The example scripts here will not work "out-of-the-box". Importing your legacy data will most probably involve some hacking on the example scripts noted below. Contributions to the import process are welcome.</font>
<ul>
- <li><a name="svc_domain">bin/svc_domain.import</a> - Import domain information from BIND named
- <li><a name="svc_acct">bin/passwd.import</a> - Just import `passwd' and `shadow' or `master.passwd', no RADIUS import.
+ <li><a name="bind">bin/bind.import</a> - Import domain information from BIND named
+ <li><a name="passwd">bin/passwd.import</a> - Just import `passwd' and `shadow' or `master.passwd', no RADIUS import.
<li><a name="svc_acct">bin/svc_acct.import</a> - Import `passwd', ( `shadow' or `master.passwd' ) and RADIUS `users'. Before running bin/svc_acct.import, you need <a href="../browse/part_svc.cgi">services</a> (with table svc_acct) as follows:
<ul>
<li>Most accounts probably have entries in passwd and users (with Port-Limit nonexistant or 1)
+++ /dev/null
-<head>
- <title>MySQL notes</title>
-</head>
-<body>
- <h1>MySQL notes</h1>
-<font size=+2><b>MySQL is NOT supported at this time.</b></font>
-<i>The following information is provided for developers who wish to contribute MySQL support. Note that <b>ALL</b> of the items listed below need to be resolved to support MySQL.
-<ul>
- <li>See ticket <a href="http://pouncequick.420.am/rt/Ticket/Display.html?id=300">#300</a> in the bug-tracking system.
- <li><b>MySQL's default <a href="http://www.mysql.com/doc/M/y/MyISAM.html">My
-ISAM</a> and <a href="http://www.mysql.com/doc/I/S/ISAM.html">ISAM</a> table types are not supported</b>. You need to use one of the new <a href="http://www.mysql.com/doc/T/a/Table_types.html">transaction-safe table types</a> such as <a href="http://www.mysql.com/doc/B/D/BDB.html">BDB</a>, and set it as the default table type using the <code>--default-table-type=BDB</code> <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Command-line_options">mysqld command-line option</a> or by setting <code>default-table-type=BDB</code> in the <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Option_files">my.cnf option file</a>.
-</ul>
-</body>
--- /dev/null
+<head>
+ <title>Unattended SSH</title>
+</head>
+<body>
+ <h1>Unattended SSH</h1>
+ <br><a name=ssh>Unattended remote login</a> - Freeside can login to remote machines unattended using SSH. This can pose a security risk if not configured correctly, and will allow an intruder who breaks into your freeside machine full access to your remote machines. <b>Do not use this feature unless you understand what you are doing!</b>
+ <ul>
+ <li>As the freeside user (on your freeside machine), generate an authentication key using <a href="http://www.tac.eu.org/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>. Since this is for unattended operation, use a blank passphrase.
+ <li>Append the newly-created <code>identity.pub</code> file to <code>~root/.ssh/authorized_keys</code> on the remote machine(s).
+ <li>Some new SSH v2 implementation accept v2 style keys only. Use the <code>-t</code> option to <a href="http://www.tac.eu.org/cgi-bin/man-cgi?ssh-keygen+1">ssh-keygen</a>, and append the created <code>id_dsa.pub</code> or <code>id_rsa.pub</code> to <code>~root/.ssh/authorized_keys2</code> on the remote machine(s).
+ <li>You may need to set <code>PermitRootLogin without-password</code> (meaning with keys only) in your <code>sshd_config</code> file on the remote machine(s).
+ </ul>
+
+</body>
+
<li>If migrating from less than 1.3.1, see these <a href="upgrade7.html">instructions</a> first.
<li><font size="+2" color="#ff0000">Backup your database and current Freeside installation.</font> (with <a href="http://www.ca.postgresql.org/devel-corner/docs/postgres/backup.html">PostgreSQL</a>) (with <a href="http://www.mysql.com/documentation/mysql/bychapter/manual_MySQL_Database_Administration.html#Backup">MySQL</a>)
<li><a href="http://perl.apache.org/">mod_perl</a> is now required.
- <li>Install <a href="http://search.cpan.org/search?dist=Time-Duration">Time-Duration</a>, <a href="http://search.cpan.org/search?dist=Tie-IxHash">Tie-IxHash</a> and <a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML-Widgets-SelectLayers</a>.
+ <li>Install <a href="http://search.cpan.org/search?dist=Time-Duration">Time-Duration</a>, <a href="http://search.cpan.org/search?dist=Tie-IxHash">Tie-IxHash</a> and <a href="http://search.cpan.org/search?dist=HTML-Widgets-SelectLayers">HTML-Widgets-SelectLayers</a> (minimum version 0.02).
<li>Install <a href="http://www.apache-asp.org/">Apache::ASP</a> or <a href="http://www.masonhq.com/">HTML::Mason</a>.
<li>Install <a href="http://rsync.samba.org/">rsync</a>
</ul>
dst varchar(80),
PRIMARY KEY (svcnum)
);
+ALTER TABLE part_svc ADD svc_forward__srcsvc varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_forward__srcsvc_flag char(1) NULL;
+ALTER TABLE part_svc ADD svc_forward__dstsvc varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_forward__dstsvc_flag char(1) NULL;
+ALTER TABLE part_svc ADD svc_forward__dst varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_forward__dst_flag char(1) NULL;
CREATE TABLE cust_credit_bill (
creditbillnum int primary key,
);
CREATE UNIQUE INDEX cust_tax_exempt1 ON cust_tax_exempt ( taxnum, year, month );
-ALTER TABLE svc_acct ADD domsvc integer NOT NULL;
+ALTER TABLE svc_acct ADD domsvc integer NULL;
+ALTER TABLE part_svc ADD svc_acct__domsvc varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_acct__domsvc_flag char(1) NULL;
ALTER TABLE svc_domain ADD catchall integer NULL;
ALTER TABLE cust_main ADD referral_custnum integer NULL;
+ALTER TABLE cust_main ADD comments text NULL;
ALTER TABLE cust_pay ADD custnum integer;
ALTER TABLE cust_pay_batch ADD paybatchnum integer;
ALTER TABLE cust_refund ADD custnum integer;
ALTER TABLE cust_bill_event ADD status varchar(80);
ALTER TABLE cust_bill_event ADD statustext text NULL;
ALTER TABLE svc_acct ADD sec_phrase varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_acct__sec_phrase varchar(80) NULL;
+ALTER TABLE part_svc ADD svc_acct__sec_phrase_flag char(1) NULL;
ALTER TABLE part_pkg ADD taxclass varchar(80) NULL;
ALTER TABLE cust_main_county ADD taxclass varchar(80) NULL;
ALTER TABLE cust_main_county ADD exempt_amount decimal(10,2);
CREATE UNIQUE INDEX svc_acct_sm_pkey ON svc_acct_sm ( svcnum );
CREATE UNIQUE INDEX svc_domain_pkey ON svc_domain ( svcnum );
CREATE UNIQUE INDEX svc_www_pkey ON svc_www ( svcnum );
-CREATE UNIQUE INDEX type_pkgs_pkey ON type_pkgs ( typenum );
</pre>
<li>If you wish to enable service/shipping addresses, apply the following
changes to your database:
ALTER TABLE cust_main ADD COLUMN ship_daytime varchar(20) NULL;
ALTER TABLE cust_main ADD COLUMN ship_night varchar(20) NULL;
ALTER TABLE cust_main ADD COLUMN ship_fax varchar(12) NULL;
-CREATE INDEX cust_main1 ON cust_main ( ship_last );
-CREATE INDEX cust_main2 ON cust_main ( ship_company );
-</pre>
- <li>If you wish to enable customer comments, apply the following change to
- your database:
-<pre>
-ALTER TABLE cust_main ADD COLUMN comments text NULL;
+CREATE INDEX cust_main4 ON cust_main ( ship_last );
+CREATE INDEX cust_main5 ON cust_main ( ship_company );
</pre>
<li>If you are using the signup server, reinstall it according to the <a href="signup.html">instructions</a>. The 1.3.x signup server is not compatible with 1.4.x.
- <li>Run bin/dbdef-create.
+ <li>Run <tt>bin/dbdef-create <i>username</i></tt>
<li>If you have svc_acct_sm records or service definitions:
<ul>
<li>Create a service definition with table svc_forward
- <li>Run bin/fs-migrate-svc_acct_sm
+ <li>Run <tt>bin/fs-migrate-svc_acct_sm <i>username</i></tt>
+ </ul>
+ <li>Or if you just have svc_acct records:
+ <ul>
+ <li>Order and provision a package for your default domain and note down the <b>Service #</b> or <i>svcnum</i>.
+ <li><tt>UPDATE svc_acct SET domsvc = </tt><i>svcnum</i>
+ <li>Update your service definitions to have default (or fixed) <b>domsvc</b>.
</ul>
- <li>Run bin/fs-migrate-payref
- <li>Run bin/fs-migrate-part_svc
+ <li>Run <tt>bin/fs-migrate-payref<i>username</i></tt>
+ <li>Run <tt>bin/fs-migrate-part_svc<i>username</i></tt>
<li><b>After running bin/fs-migrate-payref</b>, apply the following changes to your database:
<table border><tr><th>PostgreSQL</th><th>MySQL, others</th></tr>
<tr><td>
_date int null,
payby char(4) not null,
payinfo varchar(16) null,
- paybatch varchar(80) null
+ paybatch varchar(80) null,
+ closed char(1) null
);
-INSERT INTO cust_pay_temp SELECT * from cust_pay;
+INSERT INTO cust_pay_temp SELECT paynum, custnum, paid, _date, payby, payinfo, paybatch, closed FROM cust_pay;
DROP TABLE cust_pay;
ALTER TABLE cust_pay_temp RENAME TO cust_pay;
CREATE UNIQUE INDEX cust_pay1 ON cust_pay (paynum);
reason varchar(80) not null,
payby char(4) not null,
payinfo varchar(16) null,
- paybatch varchar(80) null
+ paybatch varchar(80) null,
+ closed char(1) null
);
-INSERT INTO cust_refund_temp SELECT * from cust_refund;
+INSERT INTO cust_refund_temp SELECT refundnum, custnum, _date, refund, otaker, reason, payby, payinfo, '', closed from cust_refund;
DROP TABLE cust_refund;
ALTER TABLE cust_refund_temp RENAME TO cust_refund;
CREATE UNIQUE INDEX cust_refund1 ON cust_refund (refundnum);
ALTER TABLE cust_refund DROP COLUMN crednum;
</pre></font>
</td></tr></table>
- <li><b>IMPORTANT: After applying the second set of database changes</b>, run bin/dbdef-create again.
- <li><b>IMPORTANT</b>: run bin/create-history-tables
- <li><b>IMPORTANT: After running bin/create-history-tables</b>, run bin/dbdef-create again.
+ <li><b>IMPORTANT: After applying the second set of database changes</b>, run <tt>bin/dbdef-create <i>username</i></tt> again.
+ <li><b>IMPORTANT</b>: run <tt>bin/create-history-tables <i>username</i></tt>
+ <li><b>IMPORTANT: After running bin/create-history-tables</b>, run <tt>bin/dbdef-create <i>username</i></tt> again.
+ <li>As the freeside UNIX user, run <tt>bin/populate-msgcat <i>username</i></tt
+> to populate the message catalog
<li>set the <a href="../config/config.cgi#username_policy">user_policy configuration value</a> as appropriate for your site.
<li>set the <a href="../config/config.cgi#locale">locale configuration value</a> to en_US.
<li>the mxmachines, nsmachines, arecords and cnamerecords configuration values have been deprecated. Set the <a href="../config/config.cgi#defaultrecords">defaultrecords configuration value</a> instead.
END
}
-#print <<END;
# if ( cust_bill == "Refund" ) {
# what.form.amount.value = "$credited";
# }
-#}
-#</SCRIPT>
-#END
-print "</SCRIPT>\n";
+print <<END;
+}
+</SCRIPT>
+END
print qq!<BR>Invoice #<SELECT NAME="invnum" SIZE=1 onChange="changed(this)">!,
'<OPTION VALUE="">';
if $layer;
foreach my $option ( keys %{$exports->{$layer}{options}} ) {
-# foreach my $option ( qw(url login password groupID ) ) {
my $optinfo = $exports->{$layer}{options}{$option};
my $label = $optinfo->{label};
+ my $type = defined($optinfo->{type}) ? $optinfo->{type} : 'text';
my $value = $cgi->param($option)
|| $part_export->option($option)
|| (exists $optinfo->{default} ? $optinfo->{default} : '');
- $html .= qq!<TR><TD ALIGN="right">$label</TD>!.
- qq!<TD><INPUT TYPE="text" NAME="$option" VALUE="$value" SIZE=64></TD>!.
- '</TR>';
+ $html .= qq!<TR><TD ALIGN="right">$label</TD><TD>!;
+ if ( $type eq 'select' ) {
+ $html .= qq!<SELECT NAME="$option">!;
+ foreach my $select_option ( @{$optinfo->{options}} ) {
+ #if ( ref($select_option) ) {
+ #} else {
+ $selected = $select_option eq $value ? ' SELECTED' : '';
+ $html .= qq!<OPTION VALUE="$select_option"$selected>!.
+ qq!$select_option</OPTION>!;
+ #}
+ }
+ $html .= '</SELECT>';
+ } elsif ( $type eq 'textarea' ) {
+ $html .= qq!<TEXTAREA NAME="$option">$value</TEXTAREA>!;
+ } elsif ( $type eq 'text' ) {
+ $html .= qq!<INPUT TYPE="text" NAME="$option" VALUE="$value" SIZE=64>!;
+ } else {
+ $html .= "unknown type $type";
+ }
+ $html .= '</TD></TR>';
}
$html .= '</TABLE>';
print ntable("#cccccc",2), <<END;
<TR><TD ALIGN="right">Package (customer-visable)</TD><TD><INPUT TYPE="text" NAME="pkg" SIZE=32 VALUE="$hashref->{pkg}"></TD></TR>
<TR><TD ALIGN="right">Comment (customer-hidden)</TD><TD><INPUT TYPE="text" NAME="comment" SIZE=32 VALUE="$hashref->{comment}"></TD></TR>
-<TR><TD ALIGN="right">Frequency (months) of recurring fee</TD><TD><INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}" SIZE=3></TD></TR>
+<TR><TD ALIGN="right">Frequency (months) of recurring fee</TD><TD><INPUT TYPE="text" NAME="freq" VALUE="$hashref->{freq}" SIZE=3> <I>0=no recurring fee, 1=monthly, 3=quarterly, 12=yearly</TD></TR>
<TR><TD ALIGN="right">Setup fee tax exempt</TD><TD>
END
print '</TD></TR>';
my $conf = new FS::Conf;
+#false laziness w/ view/cust_main.cgi quick order
if ( $conf->exists('enable_taxclasses') ) {
print '<TR><TD ALIGN="right">Tax class</TD><TD><SELECT NAME="taxclass">';
my $sth = dbh->prepare('SELECT DISTINCT taxclass FROM cust_main_county')
<!-- mason kludge -->
<%
my $part_svc;
+ my $clone = '';
if ( $cgi->param('error') ) { #error
$part_svc = new FS::part_svc ( {
map { $_, scalar($cgi->param($_)) } fields('part_svc')
} );
+ } elsif ( $cgi->param('clone') && $cgi->param('clone') =~ /^(\d+)$/ ) {#clone
+ #$cgi->param('clone') =~ /^(\d+)$/ or die "malformed query: $query";
+ $part_svc = qsearchs('part_svc', { 'svcpart'=>$1 } )
+ or die "unknown svcpart: $1";
+ $clone = $part_svc->svcpart;
+ $part_svc->svcpart('');
} elsif ( $cgi->keywords ) { #edit
my($query) = $cgi->keywords;
$query =~ /^(\d+)$/ or die "malformed query: $query";
my $columns = 3;
my $count = 0;
my @part_export =
- grep { $layer eq FS::part_export::exporttype2svcdb($_->exporttype) }
- qsearch( 'part_export', {} );
- $html .= '<BR><BR>'. table().
+ map { qsearch( 'part_export', {exporttype => $_ } ) }
+ keys %{FS::part_export::export_info($layer)};
+ $html .= '<BR><BR>'. table().
table(). "<TR><TH COLSPAN=$columns>Exports</TH></TR><TR>";
foreach my $part_export ( @part_export ) {
$html .= '<TD><INPUT TYPE="checkbox"'.
' NAME="exportnum'. $part_export->exportnum. '" VALUE="1" ';
$html .= 'CHECKED'
if qsearchs( 'export_svc', {
- exportnum => $part_export->exportnum,
- svcpart => $part_svc->svcpart });
+ exportnum => $part_export->exportnum,
+ svcpart => $clone || $part_svc->svcpart });
$html .= '> '. $part_export->exporttype. ' to '. $part_export->machine.
'</TD>';
$count++;
? grep { $_ ne 'svcnum' } fields($layer)
: ();
push @fields, 'usergroup' if $layer eq 'svc_acct'; #kludge
+ $part_svc->svcpart($clone) if $clone; #haha, undone below
foreach my $field (@fields) {
my $part_svc_column = $part_svc->part_svc_column($field);
my $value = $cgi->param('error')
}
$html .= "</TD></TR>\n";
}
+ $part_svc->svcpart('') if $clone; #undone
$html .= "</TABLE>";
$html .= '<BR><INPUT TYPE="submit" VALUE="'.
--- /dev/null
+<%
+
+my $recnum = $cgi->param('recnum');
+
+my $old = qsearchs('agent',{'recnum'=>$recnum}) if $recnum;
+
+my $new = new FS::domain_record ( {
+ map {
+ $_, scalar($cgi->param($_));
+ } fields('domain_record')
+} );
+
+my $error;
+if ( $recnum ) {
+ $error=$new->replace($old);
+} else {
+ $error=$new->insert;
+ $recnum=$new->getfield('recnum');
+}
+
+if ( $error ) {
+# $cgi->param('error', $error);
+# print $cgi->redirect(popurl(2). "agent.cgi?". $cgi->query_string );
+ #no edit screen to send them back to
+%>
+<!-- mason kludge -->
+<%
+ eidiot($error);
+} else {
+ my $svcnum = $new->svcnum;
+ print $cgi->redirect(popurl(3). "view/svc_domain.cgi?$svcnum");
+}
+
+%>
#fixup options
#warn join('-', split(',',$cgi->param('options')));
-my %options = map { $_=>$cgi->param($_) } split(',',$cgi->param('options'));
+my %options = map {
+ my $value = $cgi->param($_);
+ $value =~ s/\r\n/\n/g; #browsers? (textarea)
+ $_ => $value;
+} split(',', $cgi->param('options'));
my $new = new FS::part_export ( {
map {
--- /dev/null
+<%
+
+#untaint custnum
+$cgi->param('custnum') =~ /^(\d+)$/
+ or die 'illegal custnum '. $cgi->param('custnum');
+my $custnum = $1;
+
+$cgi->param('amount') =~ /^\s*(\d+(\.\d{1,2})?)\s*$/
+ or die 'illegal amount '. $cgi->param('amount');
+my $amount = $1;
+
+my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } )
+ or die "unknown custnum $custnum";
+
+my $error = $cust_main->charge(
+ $amount,
+ $cgi->param('pkg'),
+ '$'. sprintf("%.2f",$amount),
+ $cgi->param('taxclass')
+);
+
+if ($error) {
+%>
+<!-- mason kludge -->
+<%
+ eidiot($error);
+} else {
+ print $cgi->redirect(popurl(3). "view/cust_main.cgi?$custnum" );
+}
+
+%>
+
#untaint custnum
$cgi->param('custnum') =~ /^(\d+)$/
- or eidiot 'illegal custnum '. $cgi->param('custnum');
+ or die 'illegal custnum '. $cgi->param('custnum');
my $custnum = $1;
$cgi->param('pkgpart') =~ /^(\d+)$/
- or eidiot 'illegal pkgpart '. $cgi->param('pkgpart');
+ or die 'illegal pkgpart '. $cgi->param('pkgpart');
my $pkgpart = $1;
my @cust_pkg = ();
my $old;
if ( $svcnum ) {
- $old = qsearchs('svc_acct', { 'svcnum' => $svcnum } )
- or die "fatal: can't find account (svcnum $svcnum)!";
+ $old = qsearchs('svc_www', { 'svcnum' => $svcnum } )
+ or die "fatal: can't find website (svcnum $svcnum)!";
} else {
$old = '';
}
</BODY>
</HTML>
END
-
-
+%>
version 1.4.0
<BR><A HREF="http://www.sisd.com/freeside">Freeside home page</A>
<BR><A HREF="docs/">Documentation</A>
- <BR><A HREF="classic.html">Classic interface</A>
</td></tr>
</table>
<TR><TD>
<BR><FONT SIZE="+1"><A HREF="edit/cust_main.cgi">New Customer</A></FONT>
<BR>
- <BR><FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="last_on" VALUE="1">Last name <INPUT TYPE="text" NAME="last_text"><SELECT NAME="last_type"><OPTION SELECTED VALUE="All">(all)</OPTION><OPTION>Fuzzy<OPTION>Substring</OPTION><OPTION>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/cust_main.cgi?browse=last">all customers by last name</A></FORM>
- <FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="company_on" VALUE="1">Company <INPUT TYPE="text" NAME="company_text"><SELECT NAME="last_type"><OPTION SELECTED VALUE="All">(all)</OPTION><OPTION>Fuzzy<OPTION>Substring</OPTION><OPTION>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/cust_main.cgi?browse=company">all customers by company</A></FORM>
- <FORM ACTION="search/svc_acct.cgi" METHOD="POST">Username <INPUT TYPE="text" NAME="username"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_acct.cgi?username">all accounts by username</A></FORM>
- <FORM ACTION="search/svc_domain.cgi" METHOD="POST">Domain <INPUT TYPE="text" NAME="domain"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_domain.cgi?domain">all domains</A></FORM>
+ <BR><FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="custnum_on" VALUE="1">Customer # <INPUT TYPE="text" NAME="custnum_text"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/cust_main.cgi?browse=custnum">all customers by customer number</A></FORM>
+ <FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="last_on" VALUE="1">Last name <INPUT TYPE="text" NAME="last_text"><SELECT NAME="last_type"><OPTION SELECTED VALUE="All">(all)</OPTION><OPTION>Fuzzy<OPTION>Substring</OPTION><OPTION>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/cust_main.cgi?browse=last">all customers by last name</A></FORM>
+ <FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="company_on" VALUE="1">Company <INPUT TYPE="text" NAME="company_text"><SELECT NAME="company_type"><OPTION SELECTED VALUE="All">(all)</OPTION><OPTION>Fuzzy<OPTION>Substring</OPTION><OPTION>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/cust_main.cgi?browse=company">all customers by company</A></FORM>
+<!-- <FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="address2_on" VALUE="1">Unit <INPUT TYPE="text" NAME="address2_text"><INPUT TYPE="submit" VALUE="Search"></FORM>-->
+ <FORM ACTION="search/cust_main.cgi" METHOD="POST"><INPUT TYPE="hidden" NAME="phone_on" VALUE="1">Phone # <INPUT TYPE="text" NAME="phone_text"><INPUT TYPE="submit" VALUE="Search"></FORM>
+ <BR><FORM ACTION="search/svc_acct.cgi" METHOD="POST">Username <INPUT TYPE="text" NAME="username"><SELECT NAME="username_type"><OPTION VALUE="All">(all)</OPTION><OPTION>Fuzzy</OPTION><OPTION>Substring</OPTION><OPTION SELECTED>Exact</OPTION></SELECT><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_acct.cgi?username">all accounts by username</A> or <A HREF="search/svc_acct.cgi?uid">uid</A></FORM>
+ <BR><FORM ACTION="search/svc_domain.cgi" METHOD="POST">Domain <INPUT TYPE="text" NAME="domain"><INPUT TYPE="submit" VALUE="Search"> or <A HREF="search/svc_domain.cgi?domain">all domains</A></FORM>
<!-- <LI><A HREF="search/svc_acct_sm.html">mail aliases (by domain, and optionally username)</A>-->
<!-- <LI><A HREF="search/svc_forward.html">mail forwards (by ?)</A>-->
<BR>
$error = $cust_main->collect(
# 'invoice-time'=>$time,
- # 'batch_card'=> 'yes',
- 'batch_card'=> 'no',
- 'report_badcard'=> 'yes',
+ #'batch_card'=> 'yes',
+ #'batch_card'=> 'no',
+ #'report_badcard'=> 'yes',
+ 'retry_card' => 'yes',
);
}
#&eidiot($error) if $error;
$query =~ /^(\d+)$/;
my $svcnum = $1;
-my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
-die "Unknown svcnum!" unless $svc_acct;
+#my $svc_acct = qsearchs('svc_acct',{'svcnum'=>$svcnum});
+#die "Unknown svcnum!" unless $svc_acct;
my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$svcnum});
+die "Unknown svcnum!" unless $cust_svc;
&eidiot(qq!This account has already been audited. Cancel the
<A HREF="!. popurl(2). qq!view/cust_pkg.cgi?! . $cust_svc->getfield('pkgnum') .
qq!pkgnum"> package</A> instead.!)
if $cust_svc->pkgnum ne '' && $cust_svc->pkgnum ne '0';
+my $svc_x = $cust_svc->svc_x;
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
-my $error = $svc_acct->cancel;
-$error ||= $svc_acct->delete;
+my $error = $svc_x->cancel;
+$error ||= $svc_x->delete;
$error ||= $cust_svc->delete;
if ( $error ) {
This will <b>completely remove</b> all traces of this customer record. This
is <B>not</B> what you want if this is a real customer who has simply
canceled service with you. For that, cancel all of the customer's packages.
-(you can optionally hide cancelled customers with the <a href="../docs/config.html#hidecancelledcustomers">hidecancelledcustomers</a> configuration file)
+(you can optionally hide cancelled customers with the <a href="../config/config-view.cgi#hidecancelledcustomers">hidecancelledcustomers</a> configuration option)
<br>
<br>Are you <b>absolutely sure</b> you want to delete this customer?
<br><input type="submit" value="Yes">
--- /dev/null
+<%
+
+#untaint recnum
+my($query) = $cgi->keywords;
+$query =~ /^(\d+)$/ || die "Illegal recnum";
+my $recnum = $1;
+
+my $domain_record = qsearchs('domain_record',{'recnum'=>$recnum});
+
+my $error = $domain_record->delete;
+eidiot($error) if $error;
+
+print $cgi->redirect($p. "view/svc_domain.cgi?". $domain_record->svcnum);
+
+%>
<%
-#untaint paynum
+#untaint exportnum
my($query) = $cgi->keywords;
$query =~ /^(\d+)$/ || die "Illegal exportnum";
my $exportnum = $1;
$cgi->param('jobnum') =~ /^(\d+)$/ or die "Illegal jobnum";
my $jobnum = $1;
$job = qsearchs('queue', { 'jobnum' => $1 })
- or die "unknown jobnum $jobnum";
+ or die "unknown jobnum $jobnum - ".
+ "it probably completed normally or was removed by another user";
}
if ( $action eq 'new' ) {
my $ncancelled = '';
+ if ( driver_name eq 'mysql' ) {
+
+ my $query = "CREATE TEMPORARY TABLE temp1_$$ TYPE=MYISAM
+ SELECT cust_pkg.custnum,COUNT(*) as count
+ FROM cust_pkg,cust_main
+ WHERE cust_pkg.custnum = cust_main.custnum
+ AND ( cust_pkg.cancel IS NULL
+ OR cust_pkg.cancel = 0 )
+ GROUP BY cust_pkg.custnum";
+ my $sth = dbh->prepare($query) or die dbh->errstr. " preparing $query";
+ $sth->execute or die "Error executing \"$query\": ". $sth->errstr;
+ $query = "CREATE TEMPORARY TABLE temp2_$$ TYPE=MYISAM
+ SELECT cust_pkg.custnum,COUNT(*) as count
+ FROM cust_pkg,cust_main
+ WHERE cust_pkg.custnum = cust_main.custnum
+ GROUP BY cust_pkg.custnum";
+ my $sth = dbh->prepare($query) or die dbh->errstr. " preparing $query";
+ $sth->execute or die "Error executing \"$query\": ". $sth->errstr;
+ }
+
if ( $cgi->param('showcancelledcustomers') eq '0' #see if it was set by me
|| ( $conf->exists('hidecancelledcustomers')
&& ! $cgi->param('showcancelledcustomers') )
) {
#grep { $_->ncancelled_pkgs || ! $_->all_pkgs }
- #needed for MySQL??? OR cust_pkg.cancel = \"\"
- $ncancelled = "
- 0 < ( SELECT COUNT(*) FROM cust_pkg
- WHERE cust_pkg.custnum = cust_main.custnum
- AND ( cust_pkg.cancel IS NULL
- OR cust_pkg.cancel = 0
- )
- )
- OR 0 = ( SELECT COUNT(*) FROM cust_pkg
- WHERE cust_pkg.custnum = cust_main.custnum
- )
- ";
+ if ( driver_name eq 'mysql' ) {
+ $ncancelled = "
+ temp1_$$.custnum = cust_main.custnum
+ AND temp2_$$.custnum = cust_main.custnum
+ AND (temp1_$$.count > 0
+ OR temp2_$$.count = 0 )
+ ";
+ } else {
+ $ncancelled = "
+ 0 < ( SELECT COUNT(*) FROM cust_pkg
+ WHERE cust_pkg.custnum = cust_main.custnum
+ AND ( cust_pkg.cancel IS NULL
+ OR cust_pkg.cancel = 0
+ )
+ )
+ OR 0 = ( SELECT COUNT(*) FROM cust_pkg
+ WHERE cust_pkg.custnum = cust_main.custnum
+ )
+ ";
+ }
+
}
#EWWWWWW
}
$qual = " WHERE $qual" if $qual;
-
- my $statement = "SELECT COUNT(*) FROM cust_main $qual";
- my $sth = dbh->prepare($statement)
- or die dbh->errstr. " doing $statement";
+ my $statement;
+ if ( driver_name eq 'mysql' ) {
+ $statement = "SELECT COUNT(*) FROM cust_main";
+ $statement .= ", temp1_$$, temp2_$$ $qual" if $qual;
+ } else {
+ $statement = "SELECT COUNT(*) FROM cust_main $qual";
+ }
+ my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
$sth->execute or die "Error executing \"$statement\": ". $sth->errstr;
$total = $sth->fetchrow_arrayref->[0];
$ncancelled = " WHERE $ncancelled";
}
}
- my @just_cust_main = qsearch('cust_main', \%search, '',
- "$ncancelled $orderby $limit"
- );
+ my @just_cust_main;
+ if ( driver_name eq 'mysql' ) {
+ @just_cust_main = qsearch('cust_main', \%search, 'cust_main.*',
+ ",temp1_$$,temp2_$$ $ncancelled $orderby $limit");
+ } else {
+ @just_cust_main = qsearch('cust_main', \%search, '',
+ "$ncancelled $orderby $limit" );
+ }
+ if ( driver_name eq 'mysql' ) {
+ $query = "DROP TABLE temp1_$$,temp2_$$;";
+ my $sth = dbh->prepare($query) or die dbh->errstr. " preparing $query";
+ $sth->execute or die "Error executing \"$query\": ". $sth->errstr;
+ }
@cust_main = @just_cust_main;
# foreach my $cust_main ( @just_cust_main ) {
@cust_main=();
$sortby = \*last_sort;
+ push @cust_main, @{&custnumsearch}
+ if $cgi->param('custnum_on') && $cgi->param('custnum_text');
push @cust_main, @{&cardsearch}
if $cgi->param('card_on') && $cgi->param('card');
push @cust_main, @{&lastsearch}
if $cgi->param('last_on') && $cgi->param('last_text');
push @cust_main, @{&companysearch}
if $cgi->param('company_on') && $cgi->param('company_text');
+ push @cust_main, @{&address2search}
+ if $cgi->param('address2_on') && $cgi->param('address2_text');
+ push @cust_main, @{&phonesearch}
+ if $cgi->param('phone_on') && $cgi->param('phone_text');
push @cust_main, @{&referralsearch}
if $cgi->param('referral_custnum');
$a->getfield('custnum') <=> $b->getfield('custnum');
}
+sub custnumsearch {
+
+ my $custnum = $cgi->param('custnum_text');
+ $custnum =~ s/\D//g;
+ $custnum =~ /^(\d{1,23})$/ or eidiot "Illegal customer number\n";
+ my $custnum = $1;
+
+ [ qsearchs('cust_main', { 'custnum' => $custnum } ) ];
+}
+
sub cardsearch {
my($card)=$cgi->param('card');
$company_type{$_}++
};
- $cgi->param('company_text') =~ /^([\w \,\.\-\']*)$/
- or eidiot "Illegal company";
- my($company)=$1;
+ $cgi->param('company_text') =~
+ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+ or eidiot "Illegal company";
+ my $company = $1;
if ( $company_type{'Exact'} || $company_type{'Fuzzy'} ) {
push @cust_main, qsearch( 'cust_main',
\@cust_main;
}
+
+sub address2search {
+ my @cust_main;
+
+ $cgi->param('address2_text') =~
+ /^([\w \!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\=]*)$/
+ or eidiot "Illegal address2";
+ my $address2 = $1;
+
+ push @cust_main, qsearch( 'cust_main',
+ { 'address2' => { 'op' => 'ILIKE',
+ 'value' => $address2 } } );
+ push @cust_main, qsearch( 'cust_main',
+ { 'address2' => { 'op' => 'ILIKE',
+ 'value' => $address2 } } )
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ \@cust_main;
+}
+
+sub phonesearch {
+ my @cust_main;
+
+ my $phone = $cgi->param('phone_text');
+
+ #false laziness with Record::ut_phonen, only works with US/CA numbers...
+ $phone =~ s/\D//g;
+ $phone =~ /^(\d{3})(\d{3})(\d{4})(\d*)$/
+ or eidiot gettext('illegal_phone'). ": $phone";
+ $phone = "$1-$2-$3";
+ $phone .= " x$4" if $4;
+
+ my @fields = qw(daytime night fax);
+ push @fields, qw(ship_daytime ship_night ship_fax)
+ if defined dbdef->table('cust_main')->column('ship_last');
+
+ for my $field ( @fields ) {
+ push @cust_main, qsearch ( 'cust_main',
+ { $field => { 'op' => 'LIKE',
+ 'value' => "$phone%" } } );
+ }
+
+ \@cust_main;
+}
+
%>
#false laziness with below
my $statement = "SELECT COUNT(*) FROM cust_pkg $range";
warn $statement;
- my $sth = dbh->prepare($statement)
- or die dbh->errstr. " doing $statement";
+ my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
$sth->execute or die "Error executing \"$statement\": ". $sth->errstr;
$total = $sth->fetchrow_arrayref->[0];
$sortby=\*pkgnum_sort;
- $unconf = "
- WHERE 0 <
- ( SELECT count(*) FROM pkg_svc
- WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
- AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
- WHERE cust_svc.pkgnum = cust_pkg.pkgnum
- AND cust_svc.svcpart = pkg_svc.svcpart
- )
- )
- ";
-
#@cust_pkg=();
##perhaps this should go in cust_pkg as a qsearch-like constructor?
#my($cust_pkg);
# }
# push @cust_pkg, $cust_pkg if $flag;
#}
+
+ if ( driver_name eq 'mysql' ) {
+ #$query = "DROP TABLE temp1_$$,temp2_$$;";
+ #my $sth = dbh->prepare($query);
+ #$sth->execute;
+
+ $query = "CREATE TEMPORARY TABLE temp1_$$ TYPE=MYISAM
+ SELECT cust_svc.pkgnum,cust_svc.svcpart,COUNT(*) as count
+ FROM cust_pkg,cust_svc,pkg_svc
+ WHERE cust_pkg.pkgnum = cust_svc.pkgnum
+ AND cust_svc.svcpart = pkg_svc.svcpart
+ AND cust_pkg.pkgpart = pkg_svc.pkgpart
+ GROUP BY cust_svc.pkgnum,cust_svc.svcpart";
+ $sth = dbh->prepare($query) or die dbh->errstr. " preparing $query";
+
+ $sth->execute or die "Error executing \"$query\": ". $sth->errstr;
+
+ $query = "CREATE TEMPORARY TABLE temp2_$$ TYPE=MYISAM
+ SELECT cust_pkg.pkgnum FROM cust_pkg
+ LEFT JOIN pkg_svc ON (cust_pkg.pkgpart=pkg_svc.pkgpart)
+ LEFT JOIN temp1_$$ ON (cust_pkg.pkgnum = temp1_$$.pkgnum
+ AND pkg_svc.svcpart=temp1_$$.svcpart)
+ WHERE ( pkg_svc.quantity > temp1_$$.count
+ OR temp1_$$.pkgnum IS NULL )
+ AND pkg_svc.quantity != 0;";
+ $sth = dbh->prepare($query) or die dbh->errstr. " preparing $query";
+ $sth->execute or die "Error executing \"$query\": ". $sth->errstr;
+ $unconf = " LEFT JOIN temp2_$$ ON cust_pkg.pkgnum = temp2_$$.pkgnum
+ WHERE temp2_$$.pkgnum IS NOT NULL";
+
+ } else {
+
+ $unconf = "
+ WHERE 0 <
+ ( SELECT count(*) FROM pkg_svc
+ WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
+ AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
+ WHERE cust_svc.pkgnum = cust_pkg.pkgnum
+ AND cust_svc.svcpart = pkg_svc.svcpart
+ )
+ )
+ ";
+
+ }
} else {
die "Empty QUERY_STRING!";
}
my $statement = "SELECT COUNT(*) FROM cust_pkg $unconf";
- my $sth = dbh->prepare($statement)
- or die dbh->errstr. " doing $statement";
+ my $sth = dbh->prepare($statement) or die dbh->errstr." preparing $statement";
$sth->execute or die "Error executing \"$statement\": ". $sth->errstr;
$total = $sth->fetchrow_arrayref->[0];
-
- @cust_pkg = qsearch('cust_pkg',{}, '', "$unconf ORDER BY pkgnum $limit" );
+ my $tblname = driver_name eq 'mysql' ? 'cust_pkg.' : '';
+ @cust_pkg =
+ qsearch('cust_pkg',{}, '', "$unconf ORDER BY ${tblname}pkgnum $limit" );
+
+ if ( driver_name eq 'mysql' ) {
+ $query = "DROP TABLE temp1_$$,temp2_$$;";
+ my $sth = dbh->prepare($query) or die dbh->errstr. " doing $query";
+ $sth->execute; # or die "Error executing \"$query\": ". $sth->errstr;
+ }
+
}
if ( scalar(@cust_pkg) == 1 ) {
my $unlinked = '';
if ( $query =~ /^UN_(.*)$/ ) {
$query = $1;
- my $empty = driver_name =~ /^Pg$/i ? qq('') : qq("");
- $unlinked = "
- WHERE 0 <
- ( SELECT count(*) FROM cust_svc
- WHERE cust_svc.svcnum = svc_acct.svcnum
- AND ( pkgnum IS NULL OR pkgnum = 0 OR pkgnum = $empty )
- )
- ";
+ my $empty = driver_name eq 'Pg' ? qq('') : qq("");
+ if ( driver_name eq 'mysql' ) {
+ $unlinked = "LEFT JOIN cust_svc ON cust_svc.svcnum = svc_acct.svcnum
+ WHERE cust_svc.pkgnum IS NULL
+ OR cust_svc.pkgnum = 0
+ OR cust_svc.pkgnum = $empty";
+ } else {
+ $unlinked = "
+ WHERE 0 <
+ ( SELECT count(*) FROM cust_svc
+ WHERE cust_svc.svcnum = svc_acct.svcnum
+ AND ( pkgnum IS NULL OR pkgnum = 0 OR pkgnum = $empty )
+ )
+ ";
+ }
}
+my $tblname = driver_name eq 'mysql' ? 'svc_acct.' : '';
my(@svc_acct, $sortby);
if ( $query eq 'svcnum' ) {
$sortby=\*svcnum_sort;
- $orderby = 'ORDER BY svcnum';
+ $orderby = "ORDER BY ${tblname}svcnum";
} elsif ( $query eq 'username' ) {
$sortby=\*username_sort;
- $orderby = 'ORDER BY username';
+ $orderby = "ORDER BY ${tblname}username";
} elsif ( $query eq 'uid' ) {
$sortby=\*uid_sort;
- $orderby = ( $unlinked ? 'AND' : 'WHERE' ). ' uid IS NOT NULL ORDER BY uid';
+ $orderby = ( $unlinked ? 'AND' : 'WHERE' ).
+ " ${tblname}uid IS NOT NULL ORDER BY ${tblname}uid";
} else {
$sortby=\*uid_sort;
@svc_acct = @{&usernamesearch};
sub usernamesearch {
+ my @svc_acct;
+
+ my %username_type;
+ foreach ( $cgi->param('username_type') ) {
+ $username_type{$_}++;
+ }
+
$cgi->param('username') =~ /^([\w\-\.\&]+)$/; #untaint username_text
- my($username)=$1;
+ my $username = $1;
+
+ if ( $username_type{'Exact'} || $username_type{'Fuzzy'} ) {
+ push @svc_acct, qsearch( 'svc_acct',
+ { 'username' => { 'op' => 'ILIKE',
+ 'value' => $username } } );
+ }
+
+ if ( $username_type{'Substring'} || $username_type{'All'} ) {
+ push @svc_acct, qsearch( 'svc_acct',
+ { 'username' => { 'op' => 'ILIKE',
+ 'value' => "%$username%" } } );
+ }
+
+ if ( $username_type{'Fuzzy'} || $username_type{'All'} ) {
+ &FS::svc_acct::check_and_rebuild_fuzzyfiles;
+ my $all_username = &FS::svc_acct::all_username;
+
+ my %username;
+ if ( $username_type{'Fuzzy'} || $username_type{'All'} ) {
+ foreach ( amatch($username, [ qw(i) ], @$all_username) ) {
+ $username{$_}++;
+ }
+ }
+
+ #if ($username_type{'Sound-alike'}) {
+ #}
+
+ foreach ( keys %username ) {
+ push @svc_acct, qsearch('svc_acct',{'username'=>$_});
+ }
+
+ }
- [ qsearch('svc_acct',{'username'=>$username}) ];
+ #[ qsearch('svc_acct',{'username'=>$username}) ];
+ \@svc_acct;
}
if ( $cust_main->payby eq 'CARD' ) {
my $payinfo = $cust_main->payinfo;
- $payinfo = substr($payinfo,0,4). 'x'x(length($payinfo)-4);
-
+ $payinfo = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4));
print 'Credit card</TD></TR>',
'<TR><TD ALIGN="right">Card number</TD><TD BGCOLOR="#ffffff">',
$payinfo, '</TD></TR>',
$part_pkg->comment;
}
-print '</SELECT><INPUT TYPE="submit" VALUE="Order Package"><BR>';
+print '</SELECT><INPUT TYPE="submit" VALUE="Order Package"></FORM><BR>';
+
+print '<BR>'.
+ qq!<FORM ACTION="${p}edit/process/quick-charge.cgi" METHOD="POST">!.
+ qq!<INPUT TYPE="hidden" NAME="custnum" VALUE="$custnum">!.
+ qq!Description:<INPUT TYPE="text" NAME="pkg">!.
+ qq! Amount:<INPUT TYPE="text" NAME="amount" SIZE=6>!.
+ qq! !;
+
+#false laziness w/ edit/part_pkg.cgi
+if ( $conf->exists('enable_taxclasses') ) {
+ print '<SELECT NAME="taxclass">';
+ my $sth = dbh->prepare('SELECT DISTINCT taxclass FROM cust_main_county')
+ or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ foreach my $taxclass ( map $_->[0], @{$sth->fetchall_arrayref} ) {
+ print qq!<OPTION VALUE="$taxclass"!;
+ #print ' SELECTED' if $taxclass eq $hashref->{taxclass};
+ print qq!>$taxclass</OPTION>!;
+ }
+ print '</SELECT>';
+} else {
+ print '<INPUT TYPE="hidden" NAME="taxclass" VALUE="">';
+}
+
+print qq!<INPUT TYPE="submit" VALUE="One-time charge"></FORM><BR>!;
print <<END;
<SCRIPT>
for ( qw( setup bill susp expire cancel ) ) {
print "<TD ROWSPAN=$rowspan><FONT SIZE=-1>", ( $package->getfield($_)
- ? time2str("%D", $package->getfield($_) )
+ ? time2str("%D</FONT><BR><FONT SIZE=-3>%l:%M:%S%P %z</FONT>",
+ $package->getfield($_) )
: ' '
), '</FONT></TD>',
;
$payment->payinfo,
$cust_bill_pay->amount,
);
- $payinfo = substr($payinfo,0,4). 'x'x(length($payinfo)-4)
+ $payinfo = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4))
if $payby eq 'CARD';
my $target = "$payby$payinfo";
$payby =~ s/^BILL$/Check #/ if $payinfo;
my $payby = $payment->payby;
my $payinfo = $payment->payinfo;
#false laziness w/above
- $payinfo = substr($payinfo,0,4). 'x'x(length($payinfo)-4)
+ $payinfo = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4))
if $payby eq 'CARD';
my $target = "$payby$payinfo";
$payby =~ s/^BILL$/Check #/ if $payinfo;
( $charge ? "\$".sprintf("%.2f",$charge) : '' ),
"</FONT></TD>",
"<TD><FONT SIZE=-1>",
- ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
+ ( $payment ? "- \$".sprintf("%.2f",$payment) : '' ),
"</FONT></TD>",
"<TD><FONT SIZE=-1>",
- ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
+ ( $credit ? "- \$".sprintf("%.2f",$credit) : '' ),
"</FONT></TD>",
"<TD><FONT SIZE=-1>",
( $refund ? "\$".sprintf("%.2f",$refund) : '' ),
my $domain = $svc_domain->domain;
-print header('Domain View', menubar(
+%>
+
+<%= header('Domain View', menubar(
( ( $pkgnum || $custnum )
? ( "View this package (#$pkgnum)" => "${p}view/cust_pkg.cgi?$pkgnum",
"View this customer (#$custnum)" => "${p}view/cust_main.cgi?$custnum",
)
- : ( "Cancel this (unaudited) account" =>
+ : ( "Cancel this (unaudited) domain" =>
"${p}misc/cancel-unaudited.cgi?$svcnum" )
),
"Main menu" => $p,
-)),
- "Service #$svcnum",
- "<BR>Service: <B>", $part_svc->svc, "</B>",
- "<BR>Domain name: <B>$domain</B>.",
- qq!<BR>Catch all email <A HREF="${p}misc/catchall.cgi?$svcnum">(change)</A>:!,
- $email ? "<B>$email</B>." : "<I>(none)<I>",
- qq!<BR><BR><A HREF="http://www.geektools.com/cgi-bin/proxy.cgi?query=$domain;targetnic=auto">View whois information.</A>!,
- '<BR><BR>', ntable("",2),
- '<tr><th>Zone</th><th>Type</th><th>Data</th></tr>',
-;
-
-foreach my $domain_record ( qsearch('domain_record', { svcnum => $svcnum } ) ) {
- print '<tr><td>'. $domain_record->reczone. '</td>'.
- '<td>'. $domain_record->recaf. ' '. $domain_record->rectype. '</td>'.
- '<td>'. $domain_record->recdata. '</td></tr>';
-}
-print '</table>'.
- '<BR>'. joblisting({'svcnum'=>$svcnum}, 1).
- '</BODY></HTML>';
+)) %>
-%>
+Service #<%= $svcnum %>
+<BR>Service: <B><%= $part_svc->svc %></B>
+<BR>Domain name: <B><%= $domain %></B>
+<BR>Catch all email <A HREF="${p}misc/catchall.cgi?<%= $svcnum %>">(change)</A>:
+<%= $email ? "<B>$email</B>" : "<I>(none)<I>" %>
+<BR><BR><A HREF="http://www.geektools.com/cgi-bin/proxy.cgi?query=<%=$domain%>;targetnic=auto">View whois information.</A>
+<BR><BR>
+<SCRIPT>
+ function areyousure(href) {
+ if ( confirm("Remove this record?") == true )
+ window.location.href = href;
+ }
+</SCRIPT>
+
+<% my @records; if ( @records = $svc_domain->domain_record ) { %>
+ <%= ntable("",2) %>
+ <tr><th>Zone</th><th>Type</th><th>Data</th></tr>
+
+ <% foreach my $domain_record ( @records ) {
+ my $type = $domain_record->rectype eq '_mstr'
+ ? "(slave)"
+ : $domain_record->recaf. ' '. $domain_record->rectype;
+ %>
+
+ <tr><td><%= $domain_record->reczone %></td>
+ <td><%= $type %></td>
+ <td><%= $domain_record->recdata %>
+
+ <% unless ( $domain_record->rectype eq 'SOA' ) { %>
+ (<A HREF="javascript:areyousure('<%=$p%>misc/delete-domain_record.cgi?<%=$domain_record->recnum%>')">delete</A>)
+ <% } %>
+ </td></tr>
+ <% } %>
+ </table>
+<% } %>
+
+<BR>
+<FORM METHOD="POST" ACTION="<%=$p%>edit/process/domain_record.cgi">
+<INPUT TYPE="hidden" NAME="svcnum" VALUE="<%=$svcnum%>">
+<INPUT TYPE="text" NAME="reczone">
+<INPUT TYPE="hidden" NAME="recaf" VALUE="IN"> IN
+ <SELECT NAME="rectype">
+<% foreach (qw( A NS CNAME MX) ) { %>
+ <OPTION VALUE="<%=$_%>"><%=$_%></OPTION>
+<% } %>
+ </SELECT>
+<INPUT TYPE="text" NAME="recdata"> <INPUT TYPE="submit" VALUE="Add record">
+</FORM><BR><BR>or<BR><BR>
+<FORM METHOD="POST" ACTION="<%=$p%>edit/process/domain_record.cgi">
+<INPUT TYPE="hidden" NAME="svcnum" VALUE="<%=$svcnum%>">
+
+<% if ( @records ) { %> Delete all records and <% } %>
+Slave from nameserver IP
+<INPUT TYPE="hidden" NAME="svcnum" VALUE="<%=$svcnum%>">
+<INPUT TYPE="hidden" NAME="reczone" VALUE="@">
+<INPUT TYPE="hidden" NAME="recaf" VALUE="IN">
+<INPUT TYPE="hidden" NAME="rectype" VALUE="_mstr">
+<INPUT TYPE="text" NAME="recdata"> <INPUT TYPE="submit" VALUE="Slave domain">
+</FORM>
+<BR><BR><%= joblisting({'svcnum'=>$svcnum}, 1) %>
+</BODY></HTML>
}
#eofalse
+my $usersvc = $svc_www->usersvc;
+my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $usersvc } )
+ or die "svc_www: Unknown usersvc $usersvc";
+my $email = $svc_acct->email;
+
my $domain_record = qsearchs('domain_record', { 'recnum' => $svc_www->recnum } )
- or die "svc_www: Unknown recnum". $svc_www->recnum;
+ or die "svc_www: Unknown recnum ". $svc_www->recnum;
my $www = $domain_record->reczone;
unless ( $www =~ /\.$/ ) {
),
"Main menu" => $p,
)).
- "Service #$svcnum".
- qq!<BR>Website name: <B><A HREF="http://$www">$www</A></B>!.
+ qq!<A HREF="${p}edit/svc_www.cgi?$svcnum">Edit this information</A><BR>!.
+ ntable("#cccccc"). '<TR><TD>'. ntable("#cccccc",2).
+ qq!<TR><TD ALIGN="right">Service number</TD>!.
+ qq!<TD BGCOLOR="#ffffff">$svcnum</TD></TR>!.
+ qq!<TR><TD ALIGN="right">Website name</TD>!.
+ qq!<TD BGCOLOR="#ffffff"><A HREF="http://$www">$www<A></TD></TR>!.
+ qq!<TR><TD ALIGN="right">Account</TD>!.
+ qq!<TD BGCOLOR="#ffffff"><A HREF="${p}view/svc_acct.cgi?$usersvc">$email</A></TD></TR>!.
+ '</TABLE></TD></TR></TABLE>'.
'<BR>'. joblisting({'svcnum'=>$svcnum}, 1).
'</BODY></HTML>'
;
# chkconfig: 345 86 16
# description: Freeside daemons
-QUEUED_USER=ivan
+QUEUED_USER=%%%QUEUED_USER%%%
-FREESIDE_PATH="/home/ivan/freeside_current"
+FREESIDE_PATH="%%%FREESIDE_PATH%%%"
-PASSWD_USER=ivan
-PASSWD_MACHINE=localhost
+PASSWD_USER=%%%PASSWD_USER%%%
+PASSWD_MACHINE=%%%PASSWD_MACHINE%%%
-SIGNUP_USER=ivan
-SIGNUP_MACHINE=localhost
-SIGNUP_AGENTNUM=2
-SIGNUP_REFNUM=2
+SIGNUP_USER=%%%SIGNUP_USER%%%
+SIGNUP_MACHINE=%%%SIGNUP_MACHINE%%%
+SIGNUP_AGENTNUM=%%%SIGNUP_AGENTNUM%%%
+SIGNUP_REFNUM=%%%SIGNUP_REFNUM%%%
case "$1" in
start)
projects / freeside.git / commitdiff