'freeside_1_4_0_pre14'.
Critical Path provisioning has been updated and can now username changes
and suspension/unsuspension.
---
-
- New export code!
- Name and company searches:
- now case-insensative
--
+complete bind import and export and edit of dns zone files
+
+card retry changes (ticket 417)
+
+working company search and job dependancies
+
+welcome emails
+
+MySQL!
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!
+
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' => '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' => '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',
},
'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;
foreach ( keys %callback ) {
&{$callback{$_}};
+ 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.15 2002-06-14 09:19:33 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 );
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.37 2002-06-07 20:33:27 khoff 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
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);
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
}
+=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
=head1 SUBROUTINES
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;
@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;
+
+ 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.10 2002-06-10 23:02:41 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
=cut
+# This subroutine should be modified or removed. In its present form, it
+# imposes the arbitrary restriction that no export type can be associated
+# with more than one svcdb. The only place it's used is in edit/part_svc.cgi
+# to generate the list of allowed exports, which can be done more cleanly by
+# export_info anyway.
+
sub exporttype2svcdb {
my $exporttype = $_[0];
foreach my $svcdb ( keys %exports ) {
'';
}
+tie my %sysvshell_options, 'Tie::IxHash',
+ 'crypt' => { label=>'Password encryption',
+ type=>'select', options=>[qw(crypt md5)],
+ default=>'crypt',
+ },
+;
+
+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' },
;
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 %sqlmail_options, 'Tie::IxHash',
+ 'datasrc' => { label=>'DBI data source' },
+ 'username' => { label=>'Database username' },
+ 'password' => { label=>'Database password' },
+;
#export names cannot have dashes...
'sysvshell' => {
'desc' =>
'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV)',
- 'options' => {},
+ '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 shell.export, etc.',
},
'bsdshell' => {
'desc' =>
'Batch export of /etc/passwd and /etc/master.passwd files (BSD)',
- 'options' => {},
+ '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 shell.export, etc.',
},
# 'nis' => {
# 'desc' =>
'textradius' => {
'desc' => 'Batch export of a text /etc/raddb/users file (Livingston, Cistron)',
'options' => {},
+ 'notes' => 'unfinished...',
},
'shellcommands' => {
'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>. Use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete 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.',
},
'cyrus' => {
'bind' => {
'desc' =>'Batch export to BIND named',
'options' => \%bind_options,
- 'notes' => 'bind export notes',
+ 'notes' => 'bind export notes File::Rsync dependancy, run bind.export',
},
'bind_slave' => {
'desc' =>'Batch export to slave BIND named',
'options' => \%bind_slave_options,
- 'notes' => 'bind export notes (secondary munge)',
+ 'notes' => 'bind export notes (secondary munge) File::Rsync dependancy, run bind.export',
+ },
+
+ '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.',
},
'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.',
+ },
+ },
'svc_www' => {},
--- /dev/null
+package FS::part_export::bsdshell;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_export);
+
+sub rebless { shift; }
+
+sub _export_insert {
+ my($self, $svc_acct) = (shift, shift);
+ $err_or_queue = $self->bsdshell_queue( $svc_acct->svcnum, 'insert',
+ $svc_acct->username, $svc_acct->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ #return "can't change username with bsdshell"
+ # if $old->username ne $new->username;
+ #return '' unless $old->_password ne $new->_password;
+ $err_or_queue = $self->bsdshell_queue( $new->svcnum,
+ 'replace', $new->username, $new->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $err_or_queue = $self->bsdshell_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 bsdshell_queue {
+ my( $self, $svcnum, $method ) = (shift, shift, shift);
+ my $queue = new FS::queue {
+ 'svcnum' => $svcnum,
+ 'job' => "FS::part_export::bsdshell::bsdshell_$method",
+ };
+ $queue->insert( @_ ) or $queue;
+}
+
+sub bsdshell_insert { #subroutine, not method
+}
+sub bsdshell_replace { #subroutine, not method
+}
+sub bsdshell_delete { #subroutine, not method
+}
+
package FS::part_export::infostreet;
-use vars qw(@ISA);
+use vars qw(@ISA %infostreet2cust_main);
use FS::part_export;
@ISA = qw(FS::part_export);
+%infostreet2cust_main = (
+ 'firstName' => 'first',
+ 'lastName' => 'last',
+ 'address1' => 'address1',
+ 'address2' => 'address2',
+ 'city' => 'city',
+ 'state' => 'state',
+ 'zipCode' => 'zip',
+ 'country' => 'country',
+ 'phoneNumber' => 'dayphone',
+);
+
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;
+ my $accountID = $self->infostreet_queue( $svc_acct->svcnum,
'createUser', $svc_acct->username, $svc_acct->_password );
+ foreach my $infostreet_field ( keys %infostreet2cust_main ) {
+ my $error = $self->infostreet_queue( $svc_acct->svcnum,
+ 'setContactField', $accountID, $infostreet_field,
+ $cust_main->getfield( $infostreet2cust_main{$infostreet_field} ) );
+ return $error if $error;
+ }
+
+ $self->infostreet_queue( $svc_acct->svcnum,
+ 'setContactField', $accountID, 'email', $cust_main->invoicing_list )
+ #this one is kinda noment-specific
+ || $self->infostreet_queue( $svc_acct->svcnum,
+ 'setContactField', $accountID, 'title', $cust_main->agent->agent );
+
}
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 {
my %result = _infostreet_parse($result);
die $result{error} unless $result{success};
+ $result->{data};
+
}
+#sub infostreet_command_byid { #subroutine, not method;
+# my($url, $username, $password, $groupID, $method, @args ) = @_;
+#
+# infostreet_command
+#
+#}
+
sub _infostreet_parse { #subroutine, not method
my $arg = shift;
map {
my $command = $self->option($action);
no strict 'refs';
${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
- $self->shellcommands_queue(
+ $self->shellcommands_queue( $svc_acct->svcnum,
$self->options('user')||'root'. "\@". $self->options('machine'),
eval(qq("$command"))
);
no strict 'refs';
${"old_$_"} = $old->getfield($_) foreach $old->fields;
${"new_$_"} = $new->getfield($_) foreach $new->fields;
- $self->shellcommands_queue(
+ $self->shellcommands_queue( $new->svcnum,
$self->options('user')||'root'. "\@". $self->options('machine'),
eval(qq("$command"))
);
--- /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;
+}
+
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 );
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
--- /dev/null
+package FS::part_export::textradius;
+
+use vars qw(@ISA);
+use FS::part_export;
+
+@ISA = qw(FS::part_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->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_replace {
+ my( $self, $new, $old ) = (shift, shift, shift);
+ #return "can't 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,
+ 'replace', $new->username, $new->_password );
+ ref($err_or_queue) ? '' : $err_or_queue;
+}
+
+sub _export_delete {
+ my( $self, $svc_acct ) = (shift, shift);
+ $err_or_queue = $self->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( @_ ) or $queue;
+}
+
+sub textradius_insert { #subroutine, not method
+}
+sub textradius_replace { #subroutine, not method
+}
+sub textradius_delete { #subroutine, not method
+}
+
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;
'';
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 = '';
}
$status .= ': '. $queue->statustext if $queue->statustext;
my @queue_depend = $queue->queue_depend;
$status .= ' (waiting for '.
- join(', ', map { $_->other_jobnum } @queue_depend ).
+ join(', ', map { $_->depend_jobnum } @queue_depend ).
')'
if @queue_depend;
my $changable = $dangerous
=head1 VERSION
-$Id: queue.pm,v 1.13 2002-05-15 14:00:32 ivan Exp $
+$Id: queue.pm,v 1.14 2002-06-14 11:22:53 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"
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;
'';
}
}
- #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";
- }
- }
+ #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
$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
=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
use POSIX qw(setsid);
use Date::Format;
use IO::File;
-use FS::UID qw(adminsuidsetup forksuidsetup driver_name);
+use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh);
use FS::Record qw(qsearchs);
use FS::queue;
+use FS::queue_depend;
# no autoloading just yet
use FS::cust_main;
use Net::SSH 0.05;
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--; }
}
$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 {
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 ) {
--- /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::textradius;
+$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 = ivan
+PASSWD_MACHINE = localhost
+
+SIGNUP_USER = ivan
+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.0pre14
+TAG=freeside_1_4_0_pre14
#VERSION=1.4.0beta1
#TAG=freeside_1_4_0_beta1
[ -e ./httemplate/docs/man/FS/UI ] || mkdir httemplate/docs/man/FS/UI
[ -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
+ 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.1 2002-05-23 13:00:08 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::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;
+ }
+ }
+ }
+
+ }
+
+ }
+
+}
+#########
+
#!/usr/bin/perl -Tw
#
-# $Id: fs-setup,v 1.91 2002-05-15 13:24:24 ivan Exp $
+# $Id: fs-setup,v 1.92 2002-05-31 22:37:06 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', '', '',
},
'illegal_password' => {
- 'en_US' => 'Illegal password',
+ 'en_US' => 'Illegal password (',
+ },
+
+ 'illeggal_password_characters' => {
+ 'en_US' => ' characters)',
},
'username_in_use' => {
--- /dev/null
+#!/usr/bin/perl -w
+
+# sysvshell and 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 @sysv_exports = qsearch('part_export', { 'exporttype' => 'sysvshell' } );
+my @bsd_exports = qsearch('part_export', { 'exporttype' => 'bsdshell' } );
+
+my $rsync = File::Rsync->new({
+ rsh => 'ssh',
+# dry_run => 1,
+});
+
+foreach my $export ( @sysv_exports ) {
+}
+
+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(MASTER,LOCK_EX|LOCK_NB)
+ ) or die "Can't open $prefix/passwd: $!";
+
+ chmod 0644, "$spooldir/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 -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;
- }
- }
- }
-
- }
-
- }
-
-}
-#########
-
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.
+++ /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
+++ /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>
<li>A <b>transactional</b> database engine supported by Perl's <a href="http://www.hermetica.com/technologia/DBI/">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:
$ <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>
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 'text' ) {
+ $html .= qq!<INPUT TYPE="text" NAME="$option" VALUE="$value" SIZE=64>!;
+ } else {
+ $html .= "unknown type $type";
+ }
+ $html .= '</TD></TR>';
}
$html .= '</TABLE>';
--- /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");
+}
+
+%>
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></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;
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;
}
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>',
;
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>
# 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