package FS::svc_acct;
+use base qw( FS::svc_Domain_Mixin FS::svc_PBX_Mixin
+ FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin
+ FS::svc_Radius_Mixin
+ FS::svc_Tower_Mixin
+ FS::svc_IP_Mixin
+ FS::Password_Mixin
+ FS::svc_Common
+ );
use strict;
-use base qw( FS::svc_Domain_Mixin FS::svc_CGP_Mixin FS::svc_CGPRule_Mixin
- FS::svc_Common );
use vars qw( $DEBUG $me $conf $skip_fuzzyfiles
$dir_prefix @shells $usernamemin
$usernamemax $passwordmin $passwordmax
$username_noperiod $username_nounderscore $username_nodash
$username_uppercase $username_percent $username_colon
$username_slash $username_equals $username_pound
+ $username_exclamation
$password_noampersand $password_noexclamation
- $warning_template $warning_from $warning_subject $warning_mimetype
- $warning_cc
+ $warning_msgnum
$smtpmachine
$radius_password $radius_ip
$dirhash
use Fcntl qw(:flock);
use Date::Format;
use Crypt::PasswdMD5 1.2;
-use Digest::SHA1 'sha1_base64';
+use Digest::SHA 'sha1_base64';
use Digest::MD5 'md5_base64';
use Data::Dumper;
use Text::Template;
use FS::Msgcat qw(gettext);
use FS::UI::bytecount;
use FS::UI::Web;
+use FS::PagedSearch qw( psearch ); # XXX in v4, replace with FS::Cursor
use FS::part_pkg;
use FS::part_svc;
use FS::svc_acct_pop;
-use FS::cust_main_invoice;
use FS::svc_domain;
use FS::svc_pbx;
use FS::raddb;
use FS::queue;
use FS::radius_usergroup;
+use FS::radius_group;
use FS::export_svc;
use FS::part_export;
use FS::svc_forward;
use FS::svc_www;
use FS::cdr;
-use FS::acct_snarf;
+use FS::tower_sector;
$DEBUG = 0;
$me = '[FS::svc_acct]';
@shells = $conf->config('shells');
$usernamemin = $conf->config('usernamemin') || 2;
$usernamemax = $conf->config('usernamemax');
- $passwordmin = $conf->config('passwordmin'); # || 6;
- #blank->6, keep 0
+ $passwordmin = $conf->config('passwordmin');
+ #blank->8, keep 0
$passwordmin = ( defined($passwordmin) && $passwordmin =~ /\d+/ )
? $passwordmin
- : 6;
- $passwordmax = $conf->config('passwordmax') || 8;
+ : 8;
+ $passwordmax = $conf->config('passwordmax') || 12;
$username_letter = $conf->exists('username-letter');
$username_letterfirst = $conf->exists('username-letterfirst');
$username_noperiod = $conf->exists('username-noperiod');
$username_slash = $conf->exists('username-slash');
$username_equals = $conf->exists('username-equals');
$username_pound = $conf->exists('username-pound');
+ $username_exclamation = $conf->exists('username-exclamation');
$password_noampersand = $conf->exists('password-noexclamation');
$password_noexclamation = $conf->exists('password-noexclamation');
$dirhash = $conf->config('dirhash') || 0;
- if ( $conf->exists('warning_email') ) {
- $warning_template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config('warning_email') ]
- ) or warn "can't create warning email template: $Text::Template::ERROR";
- $warning_from = $conf->config('warning_email-from'); # || 'your-isp-is-dum'
- $warning_subject = $conf->config('warning_email-subject') || 'Warning';
- $warning_mimetype = $conf->config('warning_email-mimetype') || 'text/plain';
- $warning_cc = $conf->config('warning_email-cc');
- } else {
- $warning_template = '';
- $warning_from = '';
- $warning_subject = '';
- $warning_mimetype = '';
- $warning_cc = '';
- }
+ $warning_msgnum = $conf->config('threshold_warning_msgnum');
$smtpmachine = $conf->config('smtpmachine');
$radius_password = $conf->config('radius-password') || 'Password';
$radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
- @pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps');
+ @pw_set = FS::svc_acct->pw_set;
}
);
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '.', ',' );
sub _cache {
my $self = shift;
'sorts' => [ 'username', 'uid', 'seconds', 'last_login' ],
'display_weight' => 10,
'cancel_weight' => 50,
+ 'ip_field' => 'slipip',
+ 'manual_require' => 1,
'fields' => {
'dir' => 'Home directory',
'uid' => {
disable_default => 1,
disable_fixed => 1,
disable_select => 1,
+ required => 1,
},
'password_selfchange' => { label => 'Password modification',
type => 'checkbox',
label => 'Quota', #Mail storage limit
type => 'text',
disable_inventory => 1,
- disable_select => 1,
},
'file_quota'=> {
label => 'File storage limit',
type => 'text',
disable_inventory => 1,
- disable_select => 1,
},
'file_maxnum'=> {
label => 'Number of files limit',
type => 'text',
disable_inventory => 1,
- disable_select => 1,
},
'file_maxsize'=> {
label => 'File size limit',
type => 'text',
disable_inventory => 1,
- disable_select => 1,
},
- '_password' => 'Password',
+ '_password' => { label => 'Password',
+ #required => 1
+ },
'gid' => {
label => 'GID',
def_info => 'when blank, defaults to UID',
'domsvc' => {
label => 'Domain',
type => 'select',
+ select_svc => 1,
select_table => 'svc_domain',
select_key => 'svcnum',
select_label => 'domain',
disable_inventory => 1,
+ required => 1,
},
'pbxsvc' => { label => 'PBX',
type => 'select-svc_pbx.html',
disable_inventory => 1,
disable_select => 1, #UI wonky, pry works otherwise
},
+ 'sectornum' => 'Tower sector',
+ 'routernum' => 'Router/block',
+ 'blocknum' => {
+ 'label' => 'Address block',
+ 'type' => 'select',
+ 'select_table' => 'addr_block',
+ 'select_key' => 'blocknum',
+ 'select_label' => 'cidr',
+ 'disable_inventory' => 1,
+ },
'usergroup' => {
label => 'RADIUS groups',
- type => 'radius_usergroup_selector',
+ type => 'select-radius_group.html',
disable_inventory => 1,
disable_select => 1,
+ multiple => 1,
},
'seconds' => { label => 'Seconds',
label_sort => 'with Time Remaining',
type => 'text',
disable_inventory => 1,
disable_select => 1,
- disable_part_svc_column => 1,
+ #disable_part_svc_column => 1,
},
'upbytes' => { label => 'Upload',
type => 'text',
sub table_dupcheck_fields { ( 'username', 'domsvc' ); }
-sub _fieldhandlers {
- {
- #false laziness with edit/svc_acct.cgi
- 'usergroup' => sub {
- my( $self, $groups ) = @_;
- if ( ref($groups) eq 'ARRAY' ) {
- $groups;
- } elsif ( length($groups) ) {
- [ split(/\s*,\s*/, $groups) ];
- } else {
- [];
- }
- },
- };
-}
-
sub last_login {
shift->_lastlog('in', @_);
}
my $dbh = dbh;
my @jobnums;
- my $error = $self->SUPER::insert(
+ my $error = $self->SUPER::insert( # usergroup is here
'jobnums' => \@jobnums,
'child_objects' => $self->child_objects,
%options,
);
+
+ $error ||= $self->insert_password_history;
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
- if ( $self->usergroup ) {
- foreach my $groupname ( @{$self->usergroup} ) {
- my $radius_usergroup = new FS::radius_usergroup ( {
- svcnum => $self->svcnum,
- groupname => $groupname,
- } );
- my $error = $radius_usergroup->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
- }
-
unless ( $skip_fuzzyfiles ) {
$error = $self->queue_fuzzyfiles_update;
if ( $error ) {
|| $conf->exists('emailinvoiceauto')
&& ! $cust_main->invoicing_list_emailonly
) {
- my @invoicing_list = $cust_main->invoicing_list;
- push @invoicing_list, $self->email;
- $cust_main->invoicing_list(\@invoicing_list);
- }
- #welcome email
- my @welcome_exclude_svcparts = $conf->config('svc_acct_welcome_exclude');
- unless ( grep { $_ eq $self->svcpart } @welcome_exclude_svcparts ) {
- my $error = '';
- my $msgnum = $conf->config('welcome_msgnum', $agentnum);
- if ( $msgnum ) {
- my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $error = $msg_template->send('cust_main' => $cust_main,
- 'object' => $self);
- }
- else { #!$msgnum
- my ($to,$welcome_template,$welcome_from,$welcome_subject,$welcome_subject_template,$welcome_mimetype)
- = ('','','','','','');
-
- if ( $conf->exists('welcome_email', $agentnum) ) {
- $welcome_template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config('welcome_email', $agentnum) ]
- ) or warn "can't create welcome email template: $Text::Template::ERROR";
- $welcome_from = $conf->config('welcome_email-from', $agentnum);
- # || 'your-isp-is-dum'
- $welcome_subject = $conf->config('welcome_email-subject', $agentnum)
- || 'Welcome';
- $welcome_subject_template = new Text::Template (
- TYPE => 'STRING',
- SOURCE => $welcome_subject,
- ) or warn "can't create welcome email subject template: $Text::Template::ERROR";
- $welcome_mimetype = $conf->config('welcome_email-mimetype', $agentnum)
- || 'text/plain';
- }
- if ( $welcome_template ) {
- my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
- if ( $to ) {
-
- my %hash = (
- 'custnum' => $self->custnum,
- 'username' => $self->username,
- 'password' => $self->_password,
- 'first' => $cust_main->first,
- 'last' => $cust_main->getfield('last'),
- 'pkg' => $cust_pkg->part_pkg->pkg,
- );
- my $wqueue = new FS::queue {
- 'svcnum' => $self->svcnum,
- 'job' => 'FS::svc_acct::send_email'
- };
- my $error = $wqueue->insert(
- 'to' => $to,
- 'from' => $welcome_from,
- 'subject' => $welcome_subject_template->fill_in( HASH => \%hash, ),
- 'mimetype' => $welcome_mimetype,
- 'body' => $welcome_template->fill_in( HASH => \%hash, ),
- );
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error queuing welcome email: $error";
- }
-
- if ( $options{'depend_jobnum'} ) {
- warn "$me depend_jobnum found; adding to welcome email dependancies"
- if $DEBUG;
- if ( ref($options{'depend_jobnum'}) ) {
- warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
- "to welcome email dependancies"
- if $DEBUG;
- push @jobnums, @{ $options{'depend_jobnum'} };
- } else {
- warn "$me adding job $options{'depend_jobnum'} ".
- "to welcome email dependancies"
- if $DEBUG;
- push @jobnums, $options{'depend_jobnum'};
- }
- }
-
- foreach my $jobnum ( @jobnums ) {
- my $error = $wqueue->depend_insert($jobnum);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error queuing welcome email job dependancy: $error";
- }
- }
-
- }
-
- } # if $welcome_template
- } # if !$msgnum
+ # slight false laziness w/ edit/process/cust_main.cgi...
+ # and also slightly arbitrary behavior.
+ #
+ # this will never happen but check it anyway
+ my ($contact) = map { $_->contact }
+ qsearch('contact_email', { emailaddress => $self->email });
+
+ if (!$contact) {
+ # if the "real name" of this account matches the first + last name
+ # of a contact, attach the email address to that person.
+ my @contacts = map { $_->contact } $cust_main->cust_contact;
+ my $myname = $self->get('finger');
+ my ($contact) =
+ grep { $_->get('first') . ' ' . $_->get('last') eq $myname } @contacts;
+ # otherwise just pick the first one
+ $contact = $contacts[0];
+ }
+ # if there is one
+ $contact ||= FS::contact->new({
+ 'custnum' => $cust_main->get('custnum'),
+ 'locationnum' => $cust_main->get('bill_locationnum'),
+ 'last' => $cust_main->get('last'),
+ 'first' => $cust_main->get('first'),
+ });
+ $contact->set('emailaddress', $self->email);
+ $contact->set('invoice_dest', 'Y');
+
+ if ( $contact->get('contactnum') ) {
+ $error = $contact->replace;
+ } else {
+ $error = $contact->insert;
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "creating invoice destination contact: $error";
+ }
}
+
} # if $cust_pkg
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- foreach my $cust_main_invoice (
- qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
- ) {
- unless ( defined($cust_main_invoice) ) {
- warn "WARNING: something's wrong with qsearch";
- next;
- }
- my %hash = $cust_main_invoice->hash;
- $hash{'dest'} = $self->email;
- my $new = new FS::cust_main_invoice \%hash;
- my $error = $new->replace($cust_main_invoice);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
foreach my $svc_domain (
qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
) {
}
}
- my $error = $self->SUPER::delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
- foreach my $radius_usergroup (
- qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
+ foreach my $svc_phone (
+ qsearch( 'svc_phone', { 'forward_svcnum' => $self->svcnum })
) {
- my $error = $radius_usergroup->delete;
+ $svc_phone->set('forward_svcnum', '');
+ my $error = $svc_phone->replace;
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
+ my $error = $self->delete_password_history
+ || $self->SUPER::delete; # usergroup here
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
}
+ return "can't change username"
+ if $old->username ne $new->username
+ && $conf->exists('svc_acct-no_edit_username');
+
#change homdir when we change username
$new->setfield('dir', '') if $old->username ne $new->username;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- # redundant, but so $new->usergroup gets set
- $error = $new->check;
- return $error if $error;
-
- $old->usergroup( [ $old->radius_groups ] );
- if ( $DEBUG ) {
- warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
- warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
- }
- if ( $new->usergroup ) {
- #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
- my @newgroups = @{$new->usergroup};
- foreach my $oldgroup ( @{$old->usergroup} ) {
- if ( grep { $oldgroup eq $_ } @newgroups ) {
- @newgroups = grep { $oldgroup ne $_ } @newgroups;
- next;
- }
- my $radius_usergroup = qsearchs('radius_usergroup', {
- svcnum => $old->svcnum,
- groupname => $oldgroup,
- } );
- my $error = $radius_usergroup->delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error deleting radius_usergroup $oldgroup: $error";
- }
- }
-
- foreach my $newgroup ( @newgroups ) {
- my $radius_usergroup = new FS::radius_usergroup ( {
- svcnum => $new->svcnum,
- groupname => $newgroup,
- } );
- my $error = $radius_usergroup->insert;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error adding radius_usergroup $newgroup: $error";
- }
- }
+ $error = $new->SUPER::replace($old, @_); # usergroup here
+ # don't need to record this unless the password was changed
+ if ( $old->_password ne $new->_password ) {
+ $error ||= $new->insert_password_history;
}
- $error = $new->SUPER::replace($old, @_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error if $error;
my($recref) = $self->hashref;
- my $x = $self->setfixed( $self->_fieldhandlers );
+ my $x = $self->setfixed;
return $x unless ref($x);
my $part_svc = $x;
- if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
- $self->usergroup(
- [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
- }
-
my $error = $self->ut_numbern('svcnum')
#|| $self->ut_number('domsvc')
|| $self->ut_foreign_key( 'domsvc', 'svc_domain', 'svcnum' )
|| $self->ut_foreign_keyn('pbxsvc', 'svc_pbx', 'svcnum' )
+ || $self->ut_foreign_keyn('sectornum','tower_sector','sectornum')
+ || $self->ut_foreign_keyn('routernum','router','routernum')
+ || $self->ut_foreign_keyn('blocknum','addr_block','blocknum')
|| $self->ut_textn('sec_phrase')
|| $self->ut_snumbern('seconds')
|| $self->ut_snumbern('upbytes')
;
return $error if $error;
+ # assign IP address, etc.
+ if ( $conf->exists('svc_acct-ip_addr') ) {
+ my $error = $self->svc_ip_check;
+ return $error if $error;
+ } else { # I think this is correct
+ $self->routernum('');
+ $self->blocknum('');
+ }
+
my $cust_pkg;
local $username_letter = $username_letter;
+ local $username_uppercase = $username_uppercase;
if ($self->svcnum) {
my $cust_svc = $self->cust_svc
or return "no cust_svc record found for svcnum ". $self->svcnum;
if ($cust_pkg) {
$username_letter =
$conf->exists('username-letter', $cust_pkg->cust_main->agentnum);
+ $username_uppercase =
+ $conf->exists('username-uppercase', $cust_pkg->cust_main->agentnum);
}
my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
- $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=\#]{$usernamemin,$ulen})$/i
+ $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=\#\!]{$usernamemin,$ulen})$/i
or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
$recref->{username} = $1;
+ my $uerror = gettext('illegal_username'). ': '. $recref->{username};
+
unless ( $username_uppercase ) {
- $recref->{username} =~ /[A-Z]/ and return gettext('illegal_username');
+ $recref->{username} =~ /[A-Z]/ and return $uerror;
}
if ( $username_letterfirst ) {
- $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
+ $recref->{username} =~ /^[a-z]/ or return $uerror;
} elsif ( $username_letter ) {
- $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
+ $recref->{username} =~ /[a-z]/ or return $uerror;
}
if ( $username_noperiod ) {
- $recref->{username} =~ /\./ and return gettext('illegal_username');
+ $recref->{username} =~ /\./ and return $uerror;
}
if ( $username_nounderscore ) {
- $recref->{username} =~ /_/ and return gettext('illegal_username');
+ $recref->{username} =~ /_/ and return $uerror;
}
if ( $username_nodash ) {
- $recref->{username} =~ /\-/ and return gettext('illegal_username');
+ $recref->{username} =~ /\-/ and return $uerror;
}
unless ( $username_ampersand ) {
- $recref->{username} =~ /\&/ and return gettext('illegal_username');
+ $recref->{username} =~ /\&/ and return $uerror;
}
unless ( $username_percent ) {
- $recref->{username} =~ /\%/ and return gettext('illegal_username');
+ $recref->{username} =~ /\%/ and return $uerror;
}
unless ( $username_colon ) {
- $recref->{username} =~ /\:/ and return gettext('illegal_username');
+ $recref->{username} =~ /\:/ and return $uerror;
}
unless ( $username_slash ) {
- $recref->{username} =~ /\// and return gettext('illegal_username');
+ $recref->{username} =~ /\// and return $uerror;
}
unless ( $username_equals ) {
- $recref->{username} =~ /\=/ and return gettext('illegal_username');
+ $recref->{username} =~ /\=/ and return $uerror;
}
unless ( $username_pound ) {
- $recref->{username} =~ /\#/ and return gettext('illegal_username');
+ $recref->{username} =~ /\#/ and return $uerror;
+ }
+ unless ( $username_exclamation ) {
+ $recref->{username} =~ /\!/ and return $uerror;
}
}
- # $error = $self->ut_textn('finger');
- # return $error if $error;
if ( $self->getfield('finger') eq '' ) {
my $cust_pkg = $self->svcnum
? $self->cust_svc->cust_pkg
$self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
}
}
- $self->getfield('finger') =~ /^([\w \,\.\-\'\&]+)$/
+ # $error = $self->ut_textn('finger');
+ # return $error if $error;
+ $self->getfield('finger') =~ /^([\w \,\.\-\'\&\t\!\@\#\$\%\(\)\+\;\"\?\/\*\<\>]*)$/
or return "Illegal finger: ". $self->getfield('finger');
$self->setfield('finger', $1);
unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
if ( $recref->{slipip} eq '' ) {
- $recref->{slipip} = '';
+ $recref->{slipip} = ''; # eh?
} elsif ( $recref->{slipip} eq '0e0' ) {
$recref->{slipip} = '0e0';
} else {
or return "Illegal slipip: ". $self->slipip;
$recref->{slipip} = $1;
}
-
}
#arbitrary RADIUS stuff; allow ut_textn for now
$recref->{_password} = $1;
} else {
return gettext('illegal_password'). " $passwordmin-$passwordmax ".
- FS::Msgcat::_gettext('illegal_password_characters').
- ": ". $recref->{_password};
+ FS::Msgcat::_gettext('illegal_password_characters');
}
if ( $password_noampersand ) {
else {
return "invalid password encoding ('".$recref->{_password_encoding}."'";
}
+
$self->SUPER::check;
}
if ( !$encoding ) {
# set encoding to system default
($encoding, $encryption) =
- split(/-/, lc($conf->config('default-password-encoding')));
+ split(/-/, lc($conf->config('default-password-encoding') || ''));
$encoding ||= 'legacy';
$self->_password_encoding($encoding);
}
$self->username. '@'. $self->domain(@_);
}
+
=item acct_snarf
Returns an array of FS::acct_snarf records associated with the account.
=cut
-sub acct_snarf {
- my $self = shift;
- qsearch({
- 'table' => 'acct_snarf',
- 'hashref' => { 'svcnum' => $self->svcnum },
- #'order_by' => 'ORDER BY priority ASC',
- });
-}
+# unused as originally intended, but now by Communigate Pro "RPOP"
=item cgp_rpop_hashref
return '' unless $amount;
+ return ''
+ if $self->cust_svc->part_svc->part_svc_column($column)->columnflag eq 'F';
+
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
die "Can't update $column for svcnum". $self->svcnum
if $rv == 0;
- #$self->snapshot; #not necessary, we retain the old values
- #create an object with the updated usage values
- my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
- #call exports
- my $error = $new->replace($self);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing: $error";
+ if ( $conf->exists('radius-chillispot-max') ) {
+ #$self->snapshot; #not necessary, we retain the old values
+ #create an object with the updated usage values
+ my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+ #call exports
+ my $error = $new->replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing: $error";
+ }
}
#overlimit_action eq 'cancel' handling
}
}
- if ($warning_template && &{$op2warncondition{$op}}($self, $column, $amount)) {
+ if ($warning_msgnum && &{$op2warncondition{$op}}($self, $column, $amount)) {
my $wqueue = new FS::queue {
'svcnum' => $self->svcnum,
'job' => 'FS::svc_acct::reached_threshold',
};
- my $to = '';
- if ($op eq '-'){
- $to = $warning_cc if &{$op2condition{$op}}($self, $column, $amount);
- }
-
# x_threshold race
my $error = $wqueue->insert(
'svcnum' => $self->svcnum,
'op' => $op,
- 'column' => $column,
- 'to' => $to,
+ 'column' => $column
);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
my $cust_pkg = $self->cust_svc->cust_pkg;
- my $conf_overlimit =
+ my @conf_overlimit =
$cust_pkg
? $conf->config('overlimit_groups', $cust_pkg->cust_main->agentnum )
: $conf->config('overlimit_groups');
foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- my $groups = $conf_overlimit || $part_export->option('overlimit_groups');
- next unless $groups;
-
- my $gref = &{ $self->_fieldhandlers->{'usergroup'} }( $self, $groups );
+ my @groups = scalar(@conf_overlimit) ? @conf_overlimit
+ : split(' ',$part_export->option('overlimit_groups'));
+ next unless scalar(@groups);
my $other = new FS::svc_acct $self->hashref;
- $other->usergroup( $gref );
+ $other->usergroup(\@groups);
my($new,$old);
if ($action eq 'suspend') {
die "Can't update usage for svcnum ". $self->svcnum
if $rv == 0;
}
-
- #$self->snapshot; #not necessary, we retain the old values
- #create an object with the updated usage values
- my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
- local($FS::Record::nowarn_identical) = 1;
- my $error = $new->replace($self); #call exports
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing: $error";
+
+ if ( $conf->exists('radius-chillispot-max') ) {
+ #$self->snapshot; #not necessary, we retain the old values
+ #create an object with the updated usage values
+ my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+ local($FS::Record::nowarn_identical) = 1;
+ my $error = $new->replace($self); #call exports
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing: $error";
+ }
}
if ( $reset ) {
=item seconds_since TIMESTAMP
Returns the number of seconds this account has been online since TIMESTAMP,
-according to the session monitor (see L<FS::Session>).
+according to the session monitor (see L<FS::session>).
TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
L<Time::Local> and L<Date::Parse> for conversion functions.
$self->cust_svc->seconds_since(@_);
}
-=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
-
-Returns the numbers of seconds this account has been online between
-TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
-external SQL radacct table, specified via sqlradius export. Sessions which
-started in the specified range but are still open are counted from session
-start to the end of the range (unless they are over 1 day old, in which case
-they are presumed missing their stop record and not counted). Also, sessions
-which end in the range but started earlier are counted from the start of the
-range to session end. Finally, sessions which start before the range but end
-after are counted for the entire range.
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-#note: POD here, implementation in FS::cust_svc
-sub seconds_since_sqlradacct {
- my $self = shift;
- $self->cust_svc->seconds_since_sqlradacct(@_);
-}
-
-=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
-
-Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
-in this package for sessions ending between TIMESTAMP_START (inclusive) and
-TIMESTAMP_END (exclusive).
-
-TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
-L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
-functions.
-
-=cut
-
-#note: POD here, implementation in FS::cust_svc
-sub attribute_since_sqlradacct {
- my $self = shift;
- $self->cust_svc->attribute_since_sqlradacct(@_);
-}
-
-=item get_session_history TIMESTAMP_START TIMESTAMP_END
-
-Returns an array of hash references of this customers login history for the
-given time range. (document this better)
-
-=cut
-
-sub get_session_history {
- my $self = shift;
- $self->cust_svc->get_session_history(@_);
-}
-
=item last_login_text
Returns text describing the time of last login.
$self->last_login ? ctime($self->last_login) : 'unknown';
}
-=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
+=item psearch_cdrs OPTIONS
-=cut
+Returns a paged search (L<FS::PagedSearch>) for Call Detail Records
+associated with this service. For svc_acct, "associated with" means that
+either the "src" or the "charged_party" field of the CDR matches either
+the "username" field of the service or the username@domain label.
-sub get_cdrs {
- my($self, $start, $end, %opt ) = @_;
-
- my $did = $self->username; #yup
-
- my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
-
- my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
-
- #SELECT $for_update * FROM cdr
- # WHERE calldate >= $start #need a conversion
- # AND calldate < $end #ditto
- # AND ( charged_party = "$did"
- # OR charged_party = "$prefix$did" #if length($prefix);
- # OR ( ( charged_party IS NULL OR charged_party = '' )
- # AND
- # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
- # )
- # )
- # AND ( freesidestatus IS NULL OR freesidestatus = '' )
-
- my $charged_or_src;
- if ( length($prefix) ) {
- $charged_or_src =
- " AND ( charged_party = '$did'
- OR charged_party = '$prefix$did'
- OR ( ( charged_party IS NULL OR charged_party = '' )
- AND
- ( src = '$did' OR src = '$prefix$did' )
- )
- )
- ";
- } else {
- $charged_or_src =
- " AND ( charged_party = '$did'
- OR ( ( charged_party IS NULL OR charged_party = '' )
- AND
- src = '$did'
- )
- )
- ";
+=cut
+sub psearch_cdrs {
+ my($self, %options) = @_;
+ my @fields;
+ my %hash;
+ my @where;
+
+ my $did = dbh->quote($self->username);
+ my $diddomain = dbh->quote($self->label);
+
+ my $prefix = $options{'default_prefix'} || ''; #convergent.au '+61'
+ my $prefixdid = dbh->quote($prefix . $self->username);
+
+ my $for_update = $options{'for_update'} ? 'FOR UPDATE' : '';
+
+ if ( $options{inbound} ) {
+ # these will be selected under their DIDs
+ push @where, "FALSE";
+ }
+
+ my @orwhere;
+ if (!$options{'disable_charged_party'}) {
+ push @orwhere,
+ "charged_party = $did",
+ "charged_party = $prefixdid",
+ "charged_party = $diddomain"
+ ;
+ }
+ if (!$options{'disable_src'}) {
+ push @orwhere,
+ "src = $did AND charged_party IS NULL",
+ "src = $prefixdid AND charged_party IS NULL",
+ "src = $diddomain AND charged_party IS NULL"
+ ;
+ }
+ push @where, '(' . join(' OR ', @orwhere) . ')';
+
+ # $options{'status'} = '' is meaningful; for the rest of them it's not
+ if ( exists $options{'status'} ) {
+ $hash{'freesidestatus'} = $options{'status'};
+ }
+ if ( $options{'cdrtypenum'} ) {
+ $hash{'cdrtypenum'} = $options{'cdrtypenum'};
+ }
+ if ( $options{'calltypenum'} ) {
+ $hash{'calltypenum'} = $options{'calltypenum'};
+ }
+ if ( $options{'begin'} ) {
+ push @where, 'startdate >= '. $options{'begin'};
+ }
+ if ( $options{'end'} ) {
+ push @where, 'startdate < '. $options{'end'};
+ }
+ if ( $options{'nonzero'} ) {
+ push @where, 'duration > 0';
+ }
+
+ my $extra_sql = join(' AND ', @where);
+ if ($extra_sql) {
+ if (keys %hash) {
+ $extra_sql = " AND ".$extra_sql;
+ } else {
+ $extra_sql = " WHERE ".$extra_sql;
+ }
}
-
- qsearch(
- 'select' => "$for_update *",
+ return psearch({
+ 'select' => '*',
'table' => 'cdr',
- 'hashref' => {
- #( freesidestatus IS NULL OR freesidestatus = '' )
- 'freesidestatus' => '',
- },
- 'extra_sql' => $charged_or_src,
-
- );
-
+ 'hashref' => \%hash,
+ 'extra_sql' => $extra_sql,
+ 'order_by' => "ORDER BY startdate $for_update",
+ });
}
-=item radius_groups
+=item get_cdrs (DEPRECATED)
-Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
+Like psearch_cdrs, but returns all the L<FS::cdr> objects at once, in a
+single list. Arguments are the same as for psearch_cdrs.
=cut
-sub radius_groups {
+sub get_cdrs {
my $self = shift;
- if ( $self->usergroup ) {
- confess "explicitly specified usergroup not an arrayref: ". $self->usergroup
- unless ref($self->usergroup) eq 'ARRAY';
- #when provisioning records, export callback runs in svc_Common.pm before
- #radius_usergroup records can be inserted...
- @{$self->usergroup};
- } else {
- map { $_->groupname }
- qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
- }
+ my $psearch = $self->psearch_cdrs(@_);
+ qsearch ( $psearch->{query} )
}
+# sub radius_groups has moved to svc_Radius_Mixin
+
=item clone_suspended
Constructor used by FS::part_export::_export_suspend fallback. Document
if ( $self->_password_encoding eq 'ldap' ) {
- my $auth = from_rfc2307 Authen::Passphrase $self->_password;
+ $password =~ s/^{PLAIN}/{CLEARTEXT}/;
+ my $auth = from_rfc2307 Authen::Passphrase $password;
return $auth->match($check_password);
} elsif ( $self->_password_encoding eq 'crypt' ) {
);
} elsif ( $encryption eq 'md5' ) {
return unix_md5_crypt( $self->_password );
+ } elsif ( $encryption eq 'sha512' ) {
+ return crypt(
+ $self->_password,
+ '$6$rounds=15420$'. join('', map $saltset[int(rand(64))], (1..16) )
+ );
} elsif ( $encryption eq 'sha1_base64' ) { #for acct_sql
my $pass = sha1_base64( $self->_password );
$pass .= '=' x (4 - length($pass) % 4); #properly padded base64
$self->domain. '/maildirs/'. $self->username. '/';
}
+=item password_svc_check
+
+Override, for L<FS::Password_Mixin>. Not really intended for other use.
+
+=cut
+
+sub password_svc_check {
+ my ($self, $password) = @_;
+ foreach my $field ( qw(username finger) ) {
+ foreach my $word (split(/\W+/,$self->get($field))) {
+ next unless length($word) > 2;
+ if ($password =~ /$word/i) {
+ return qq(Password contains account information '$word');
+ }
+ }
+ }
+ return '';
+}
+
=back
=head1 CLASS METHODS
=cut
-sub search {
- my ($class, $params) = @_;
+sub _search_svc {
+ my( $class, $params, $from, $where ) = @_;
- my @where = ();
+ #these two should probably move to svc_Domain_Mixin ?
# domain
if ( $params->{'domain'} ) {
my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
#preserve previous behavior & bubble up an error if $svc_domain not found?
- push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
+ push @$where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
}
# domsvc
if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
- push @where, "domsvc = $1";
- }
-
- #unlinked
- push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
-
- #agentnum
- if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
- push @where, "agentnum = $1";
- }
-
- #custnum
- if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
- push @where, "custnum = $1";
+ push @$where, "domsvc = $1";
}
- #pkgpart
- if ( $params->{'pkgpart'} && scalar(@{ $params->{'pkgpart'} }) ) {
- #XXX untaint or sql quote
- push @where,
- 'cust_pkg.pkgpart IN ('. join(',', @{ $params->{'pkgpart'} } ). ')';
- }
# popnum
if ( $params->{'popnum'} =~ /^(\d+)$/ ) {
- push @where, "popnum = $1";
+ push @$where, "popnum = $1";
}
- # svcpart
- if ( $params->{'svcpart'} =~ /^(\d+)$/ ) {
- push @where, "svcpart = $1";
- }
+ #and these in svc_Tower_Mixin, or maybe we never should have done svc_acct
+ # towers (or, as mark thought, never should have done svc_broadband)
- # here is the agent virtualization
- #if ($params->{CurrentUser}) {
- # my $access_user =
- # qsearchs('access_user', { username => $params->{CurrentUser} });
- #
- # if ($access_user) {
- # push @where, $access_user->agentnums_sql('table'=>'cust_main');
- # }else{
- # push @where, "1=0";
- # }
- #} else {
- push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
- 'table' => 'cust_main',
- 'null_right' => 'View/link unlinked services',
- );
- #}
-
- push @where, @{ $params->{'where'} } if $params->{'where'};
-
- my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
-
- my $addl_from = ' LEFT JOIN cust_svc USING ( svcnum ) '.
- ' LEFT JOIN part_svc USING ( svcpart ) '.
- ' LEFT JOIN cust_pkg USING ( pkgnum ) '.
- ' LEFT JOIN cust_main USING ( custnum ) ';
-
- my $count_query = "SELECT COUNT(*) FROM svc_acct $addl_from $extra_sql";
- #if ( keys %svc_acct ) {
- # $count_query .= ' WHERE '.
- # join(' AND ', map "$_ = ". dbh->quote($svc_acct{$_}),
- # keys %svc_acct
- # );
- #}
-
- my $sql_query = {
- 'table' => 'svc_acct',
- 'hashref' => {}, # \%svc_acct,
- 'select' => join(', ',
- 'svc_acct.*',
- 'part_svc.svc',
- 'cust_main.custnum',
- FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
- ),
- 'addl_from' => $addl_from,
- 'extra_sql' => $extra_sql,
- 'order_by' => $params->{'order_by'},
- 'count_query' => $count_query,
- };
+ # sector and tower
+ my @where_sector = $class->tower_sector_sql($params);
+ if ( @where_sector ) {
+ push @$where, @where_sector;
+ push @$from, ' LEFT JOIN tower_sector USING ( sectornum )';
+ }
}
=over 4
-=item send_email
-
-This is the FS::svc_acct job-queue-able version. It still uses
-FS::Misc::send_email under-the-hood.
-
-=cut
-
-sub send_email {
- my %opt = @_;
-
- eval "use FS::Misc qw(send_email)";
- die $@ if $@;
-
- $opt{mimetype} ||= 'text/plain';
- $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
-
- my $error = send_email(
- 'from' => $opt{from},
- 'to' => $opt{to},
- 'subject' => $opt{subject},
- 'content-type' => $opt{mimetype},
- 'body' => [ map "$_\n", split("\n", $opt{body}) ],
- );
- die $error if $error;
-}
-
=item check_and_rebuild_fuzzyfiles
=cut
}
-
-=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
-
-=cut
-
-sub radius_usergroup_selector {
- my $sel_groups = shift;
- my %sel_groups = map { $_=>1 } @$sel_groups;
-
- my $selectname = shift || 'radius_usergroup';
-
- my $dbh = dbh;
- my $sth = $dbh->prepare(
- 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
- ) or die $dbh->errstr;
- $sth->execute() or die $sth->errstr;
- my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
-
- my $html = <<END;
- <SCRIPT>
- function ${selectname}_doadd(object) {
- var myvalue = object.${selectname}_add.value;
- var optionName = new Option(myvalue,myvalue,false,true);
- var length = object.$selectname.length;
- object.$selectname.options[length] = optionName;
- object.${selectname}_add.value = "";
- }
- </SCRIPT>
- <SELECT MULTIPLE NAME="$selectname">
-END
-
- foreach my $group ( @all_groups ) {
- $html .= qq(<OPTION VALUE="$group");
- if ( $sel_groups{$group} ) {
- $html .= ' SELECTED';
- $sel_groups{$group} = 0;
- }
- $html .= ">$group</OPTION>\n";
- }
- foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
- $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
- };
- $html .= '</SELECT>';
-
- $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
- qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
-
- $html;
-}
-
=item reached_threshold
Performs some activities when svc_acct thresholds (such as number of seconds
my $error = $svc_acct->replace;
die $error if $error; # email next time, i guess
- if ( $warning_template ) {
- eval "use FS::Misc qw(send_email)";
- die $@ if $@;
+ if ( $warning_msgnum ) {
- my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
- my $cust_main = $cust_pkg->cust_main;
+ my $msg_template = qsearchs('msg_template',{ msgnum => $warning_msgnum });
+ die "Could not load template for threshold_warning_msgnum ($warning_msgnum)" unless $msg_template;
- my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ }
- $cust_main->invoicing_list,
- ($opt{'to'} ? $opt{'to'} : ())
- );
-
- my $mimetype = $warning_mimetype;
- $mimetype .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
-
- my $body = $warning_template->fill_in( HASH => {
- 'custnum' => $cust_main->custnum,
- 'username' => $svc_acct->username,
- 'password' => $svc_acct->_password,
- 'first' => $cust_main->first,
- 'last' => $cust_main->getfield('last'),
- 'pkg' => $cust_pkg->part_pkg->pkg,
- 'column' => $opt{'column'},
- 'amount' => $opt{'column'} =~/bytes/
- ? FS::UI::bytecount::display_bytecount($svc_acct->getfield($opt{'column'}))
- : $svc_acct->getfield($opt{'column'}),
- 'threshold' => $opt{'column'} =~/bytes/
- ? FS::UI::bytecount::display_bytecount($threshold)
- : $threshold,
- } );
-
-
- my $error = send_email(
- 'from' => $warning_from,
- 'to' => $to,
- 'subject' => $warning_subject,
- 'content-type' => $mimetype,
- 'body' => [ map "$_\n", split("\n", $body) ],
+ my $cust_main = $svc_acct->cust_svc->cust_pkg->cust_main;
+
+ my $to = join(', ', $cust_main->invoicing_list_emailonly );
+
+ my $error = $msg_template->send(
+ cust_main => $cust_main,
+ object => $svc_acct,
+ to => $to,
+ substitutions => {
+ # have to override these, because we changed threshold above
+ 'column' => $opt{'column'},
+ 'amount' => $opt{'column'} =~/bytes/
+ ? FS::UI::bytecount::display_bytecount($svc_acct->getfield($opt{'column'}))
+ : $svc_acct->getfield($opt{'column'}),
+ 'threshold' => $opt{'column'} =~/bytes/
+ ? FS::UI::bytecount::display_bytecount($threshold)
+ : $threshold,
+ },
);
- die $error if $error;
+
+ die "Error sending threshold warning email: $error" if $error;
+
}
}else{
die "unknown op: " . $opt{'op'};
current object. This is probably a bug as it's unexpected and
counterintuitive.
-radius_usergroup_selector? putting web ui components in here? they should
-probably live somewhere else...
-
insertion of RADIUS group stuff in insert could be done with child_objects now
(would probably clean up export of them too)
projects / freeside.git / blobdiff