package FS::svc_acct;
use strict;
-use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
+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_ampersand $username_letter $username_letterfirst
$username_noperiod $username_nounderscore $username_nodash
$username_uppercase $username_percent $username_colon
+ $username_slash $username_equals $username_pound
$password_noampersand $password_noexclamation
$warning_template $warning_from $warning_subject $warning_mimetype
$warning_cc
$dirhash
@saltset @pw_set );
use Scalar::Util qw( blessed );
+use Math::BigInt;
use Carp;
use Fcntl qw(:flock);
use Date::Format;
use Crypt::PasswdMD5 1.2;
+use Digest::SHA1 'sha1_base64';
+use Digest::MD5 'md5_base64';
use Data::Dumper;
use Text::Template;
use Authen::Passphrase;
use FS::Record qw( qsearch qsearchs fields dbh dbdef );
use FS::Msgcat qw(gettext);
use FS::UI::bytecount;
+use FS::UI::Web;
use FS::part_pkg;
-use FS::svc_Common;
-use FS::cust_svc;
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;
-
-@ISA = qw( FS::svc_Common );
+use FS::acct_snarf;
$DEBUG = 0;
$me = '[FS::svc_acct]';
@shells = $conf->config('shells');
$usernamemin = $conf->config('usernamemin') || 2;
$usernamemax = $conf->config('usernamemax');
- $passwordmin = $conf->config('passwordmin') || 6;
+ $passwordmin = $conf->config('passwordmin'); # || 6;
+ #blank->6, keep 0
+ $passwordmin = ( defined($passwordmin) && $passwordmin =~ /\d+/ )
+ ? $passwordmin
+ : 6;
$passwordmax = $conf->config('passwordmax') || 8;
$username_letter = $conf->exists('username-letter');
$username_letterfirst = $conf->exists('username-letterfirst');
$username_ampersand = $conf->exists('username-ampersand');
$username_percent = $conf->exists('username-percent');
$username_colon = $conf->exists('username-colon');
+ $username_slash = $conf->exists('username-slash');
+ $username_equals = $conf->exists('username-equals');
+ $username_pound = $conf->exists('username-pound');
$password_noampersand = $conf->exists('password-noexclamation');
$password_noexclamation = $conf->exists('password-noexclamation');
$dirhash = $conf->config('dirhash') || 0;
);
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
+@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '.', ',' );
sub _cache {
my $self = shift;
=over 4
-=item svcnum - primary key (assigned automatcially for new accounts)
+=item svcnum
+
+Primary key (assigned automatcially for new accounts)
=item username
-=item _password - generated if blank
+=item _password
+
+generated if blank
+
+=item _password_encoding
+
+plain, crypt, ldap (or empty for autodetection)
-=item _password_encoding - plain, crypt, ldap (or empty for autodetection)
+=item sec_phrase
-=item sec_phrase - security phrase
+security phrase
-=item popnum - Point of presence (see L<FS::svc_acct_pop>)
+=item popnum
+
+Point of presence (see L<FS::svc_acct_pop>)
=item uid
=item gid
-=item finger - GECOS
+=item finger
+
+GECOS
+
+=item dir
-=item dir - set automatically if blank (and uid is not)
+set automatically if blank (and uid is not)
=item shell
-=item quota - (unimplementd)
+=item quota
+
+=item slipip
+
+IP address
-=item slipip - IP address
+=item seconds
-=item seconds -
+=item upbytes
-=item upbytes -
+=item downbyte
-=item downbytes -
+=item totalbytes
-=item totalbytes -
+=item domsvc
-=item domsvc - svcnum from svc_domain
+svcnum from svc_domain
-=item radius_I<Radius_Attribute> - I<Radius-Attribute> (reply)
+=item pbxsvc
-=item rc_I<Radius_Attribute> - I<Radius-Attribute> (check)
+Optional svcnum from svc_pbx
+
+=item radius_I<Radius_Attribute>
+
+I<Radius-Attribute> (reply)
+
+=item rc_I<Radius_Attribute>
+
+I<Radius-Attribute> (check)
=back
disable_fixed => 1,
disable_select => 1,
},
+ 'password_selfchange' => { label => 'Password modification',
+ type => 'checkbox',
+ },
+ 'password_recover' => { label => 'Password recovery',
+ type => 'checkbox',
+ },
'quota' => {
- label => 'Quota',
+ 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,
select_key => 'svcnum',
select_label => 'domain',
disable_inventory => 1,
-
+ },
+ 'pbxsvc' => { label => 'PBX',
+ type => 'select-svc_pbx.html',
+ disable_inventory => 1,
+ disable_select => 1, #UI wonky, pry works otherwise
},
'usergroup' => {
label => 'RADIUS groups',
- type => 'radius_usergroup_selector',
+ type => 'select-radius_group.html',
disable_inventory => 1,
disable_select => 1,
},
label => 'Last logout',
type => 'disabled',
},
+
+ 'cgp_aliases' => {
+ label => 'Communigate aliases',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ #settings
+ 'cgp_type'=> {
+ label => 'Communigate account type',
+ type => 'select',
+ select_list => [qw( MultiMailbox TextMailbox MailDirMailbox AGrade BGrade CGrade )],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_accessmodes' => {
+ label => 'Communigate enabled services',
+ type => 'communigate_pro-accessmodes',
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_rulesallowed' => {
+ label => 'Allowed mail rules',
+ type => 'select',
+ select_list => [ '', 'No', 'Filter Only', 'All But Exec', 'Any' ],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_rpopallowed' => { label => 'RPOP modifications',
+ type => 'checkbox',
+ },
+ 'cgp_mailtoall' => { label => 'Accepts mail to "all"',
+ type => 'checkbox',
+ },
+ 'cgp_addmailtrailer' => { label => 'Add trailer to sent mail',
+ type => 'checkbox',
+ },
+ 'cgp_archiveafter' => {
+ label => 'Archive messages after',
+ type => 'select',
+ select_hash => [
+ -2 => 'default(730 days)',
+ 0 => 'Never',
+ 86400 => '24 hours',
+ 172800 => '2 days',
+ 259200 => '3 days',
+ 432000 => '5 days',
+ 604800 => '7 days',
+ 1209600 => '2 weeks',
+ 2592000 => '30 days',
+ 7776000 => '90 days',
+ 15552000 => '180 days',
+ 31536000 => '365 days',
+ 63072000 => '730 days',
+ ],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ #XXX mailing lists
+
+ #preferences
+ 'cgp_deletemode' => {
+ label => 'Communigate message delete method',
+ type => 'select',
+ select_list => [ 'Move To Trash', 'Immediately', 'Mark' ],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_emptytrash' => {
+ label => 'Communigate on logout remove trash',
+ type => 'select',
+ select_list => __PACKAGE__->cgp_emptytrash_values,
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_language' => {
+ label => 'Communigate language',
+ type => 'select',
+ select_list => [ '', qw( English Arabic Chinese Dutch French German Hebrew Italian Japanese Portuguese Russian Slovak Spanish Thai ) ],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_timezone' => {
+ label => 'Communigate time zone',
+ type => 'select',
+ select_list => __PACKAGE__->cgp_timezone_values,
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_skinname' => {
+ label => 'Communigate layout',
+ type => 'select',
+ select_list => [ '', '***', 'GoldFleece', 'Skin2' ],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_prontoskinname' => {
+ label => 'Communigate Pronto style',
+ type => 'select',
+ select_list => [ '', 'Pronto', 'Pronto-darkflame', 'Pronto-steel', 'Pronto-twilight', ],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+ 'cgp_sendmdnmode' => {
+ label => 'Communigate send read receipts',
+ type => 'select',
+ select_list => [ '', 'Never', 'Manually', 'Automatically' ],
+ disable_inventory => 1,
+ disable_select => 1,
+ },
+
+ #mail
+ #XXX RPOP settings
+
},
};
}
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $self->check;
- return $error if $error;
-
- if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
- my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
- unless ( $cust_svc ) {
- $dbh->rollback if $oldAutoCommit;
- return "no cust_svc record found for svcnum ". $self->svcnum;
- }
- $self->pkgnum($cust_svc->pkgnum);
- $self->svcpart($cust_svc->svcpart);
- }
-
- # set usage fields and thresholds if unset but set in a package def
- if ( $self->pkgnum ) {
- my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
- my $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
- if ( $part_pkg && $part_pkg->can('usage_valuehash') ) {
-
- my %values = $part_pkg->usage_valuehash;
- my $multiplier = $conf->exists('svc_acct-usage_threshold')
- ? 1 - $conf->config('svc_acct-usage_threshold')/100
- : 0.20;
-
- foreach ( keys %values ) {
- next if $self->getfield($_);
- $self->setfield( $_, $values{$_} );
- $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) );
- }
-
- }
- }
-
my @jobnums;
- $error = $self->SUPER::insert(
+ my $error = $self->SUPER::insert(
'jobnums' => \@jobnums,
'child_objects' => $self->child_objects,
%options,
}
if ( $self->usergroup ) {
- foreach my $groupname ( @{$self->usergroup} ) {
+ foreach my $groupnum ( @{$self->usergroup} ) {
my $radius_usergroup = new FS::radius_usergroup ( {
svcnum => $self->svcnum,
- groupname => $groupname,
+ groupnum => $groupnum,
} );
my $error = $radius_usergroup->insert;
if ( $error ) {
}
#welcome email
- 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 && $cust_pkg ) {
- 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";
+ 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);
}
-
- 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'};
+ 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
+ }
+ } # if $cust_pkg
- foreach my $jobnum ( @jobnums ) {
- my $error = $wqueue->depend_insert($jobnum);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "error queuing welcome email job dependancy: $error";
- }
- }
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ ''; #no error
+}
- }
+# set usage fields and thresholds if unset but set in a package def
+# AND the package already has a last bill date (otherwise they get double added)
+sub preinsert_hook_first {
+ my $self = shift;
- }
+ return '' unless $self->pkgnum;
- } # if ( $cust_pkg )
+ my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+ return '' unless $cust_pkg && $cust_pkg->last_bill;
+
+ my $part_pkg = $cust_pkg->part_pkg;
+ return '' unless $part_pkg && $part_pkg->can('usage_valuehash');
+
+ my %values = $part_pkg->usage_valuehash;
+ my $multiplier = $conf->exists('svc_acct-usage_threshold')
+ ? 1 - $conf->config('svc_acct-usage_threshold')/100
+ : 0.20; #doesn't matter
+
+ foreach ( keys %values ) {
+ next if $self->getfield($_);
+ $self->setfield( $_, $values{$_} );
+ $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) )
+ if $conf->exists('svc_acct-usage_threshold');
+ }
- $dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no error
}
}
+ 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;
$error = $new->check;
return $error if $error;
- $old->usergroup( [ $old->radius_groups ] );
+ $old->usergroup( [ $old->radius_groups('NUMBERS') ] );
if ( $DEBUG ) {
warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
- warn $new->email. "new groups: ". join(' ',@{$new->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 $radius_usergroup = qsearchs('radius_usergroup', {
svcnum => $old->svcnum,
- groupname => $oldgroup,
+ groupnum => $oldgroup,
} );
my $error = $radius_usergroup->delete;
if ( $error ) {
foreach my $newgroup ( @newgroups ) {
my $radius_usergroup = new FS::radius_usergroup ( {
svcnum => $new->svcnum,
- groupname => $newgroup,
+ groupnum => $newgroup,
} );
my $error = $radius_usergroup->insert;
if ( $error ) {
my $error = $self->ut_numbern('svcnum')
#|| $self->ut_number('domsvc')
- || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' )
+ || $self->ut_foreign_key( 'domsvc', 'svc_domain', 'svcnum' )
+ || $self->ut_foreign_keyn('pbxsvc', 'svc_pbx', 'svcnum' )
|| $self->ut_textn('sec_phrase')
|| $self->ut_snumbern('seconds')
|| $self->ut_snumbern('upbytes')
|| $self->ut_snumbern('downbytes')
|| $self->ut_snumbern('totalbytes')
- || $self->ut_enum( '_password_encoding',
- [ '', qw( plain crypt ldap ) ]
- )
+ || $self->ut_snumbern('seconds_threshold')
+ || $self->ut_snumbern('upbytes_threshold')
+ || $self->ut_snumbern('downbytes_threshold')
+ || $self->ut_snumbern('totalbytes_threshold')
+ || $self->ut_enum('_password_encoding', ['',qw(plain crypt ldap)])
+ || $self->ut_enum('password_selfchange', [ '', 'Y' ])
+ || $self->ut_enum('password_recover', [ '', 'Y' ])
+ #cardfortress
+ || $self->ut_anything('cf_privatekey')
+ #communigate
+ || $self->ut_textn('cgp_accessmodes')
+ || $self->ut_alphan('cgp_type')
+ || $self->ut_textn('cgp_aliases' ) #well
+ # settings
+ || $self->ut_alphasn('cgp_rulesallowed')
+ || $self->ut_enum('cgp_rpopallowed', [ '', 'Y' ])
+ || $self->ut_enum('cgp_mailtoall', [ '', 'Y' ])
+ || $self->ut_enum('cgp_addmailtrailer', [ '', 'Y' ])
+ || $self->ut_snumbern('cgp_archiveafter')
+ # preferences
+ || $self->ut_alphasn('cgp_deletemode')
+ || $self->ut_enum('cgp_emptytrash', $self->cgp_emptytrash_values)
+ || $self->ut_alphan('cgp_language')
+ || $self->ut_textn('cgp_timezone')
+ || $self->ut_textn('cgp_skinname')
+ || $self->ut_textn('cgp_prontoskinname')
+ || $self->ut_alphan('cgp_sendmdnmode')
;
return $error if $error;
}
my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
- if ( $username_uppercase ) {
- $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/i
- or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
- $recref->{username} = $1;
- } else {
- $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/
- or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
- $recref->{username} = $1;
- }
+ $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:\/\=\#]{$usernamemin,$ulen})$/i
+ or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
+ $recref->{username} = $1;
+
+ unless ( $username_uppercase ) {
+ $recref->{username} =~ /[A-Z]/ and return gettext('illegal_username');
+ }
if ( $username_letterfirst ) {
$recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
} elsif ( $username_letter ) {
unless ( $username_colon ) {
$recref->{username} =~ /\:/ and return gettext('illegal_username');
}
+ unless ( $username_slash ) {
+ $recref->{username} =~ /\// and return gettext('illegal_username');
+ }
+ unless ( $username_equals ) {
+ $recref->{username} =~ /\=/ and return gettext('illegal_username');
+ }
+ unless ( $username_pound ) {
+ $recref->{username} =~ /\#/ and return gettext('illegal_username');
+ }
+
$recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
$recref->{popnum} = $1;
unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) {
- $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
+ $recref->{dir} =~ /^([\/\w\-\.\&\:\#]*)$/
or return "Illegal directory: ". $recref->{dir};
$recref->{dir} = $1;
return "Illegal directory"
$self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
}
}
- $self->getfield('finger') =~
- /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
+ $self->getfield('finger') =~ /^([\w \,\.\-\'\&\t\!\@\#\$\%\(\)\+\;\"\?\/\*\<\>]+)$/
or return "Illegal finger: ". $self->getfield('finger');
$self->setfield('finger', $1);
- $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota";
- $recref->{quota} = $1;
+ for (qw( quota file_quota file_maxsize )) {
+ $recref->{$_} =~ /^(\w*)$/ or return "Illegal $_";
+ $recref->{$_} = $1;
+ }
+ $recref->{file_maxnum} =~ /^\s*(\d*)\s*$/ or return "Illegal file_maxnum";
+ $recref->{file_maxnum} = $1;
unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
if ( $recref->{slipip} eq '' ) {
$self->ut_textn($_);
}
+ # First, if _password is blank, generate one and set default encoding.
+ if ( ! $recref->{_password} ) {
+ $error = $self->set_password('');
+ }
+ # But if there's a _password but no encoding, assume it's plaintext and
+ # set it to default encoding.
+ elsif ( ! $recref->{_password_encoding} ) {
+ $error = $self->set_password($recref->{_password});
+ }
+ return $error if $error;
+
+ # Next, check _password to ensure compliance with the encoding.
if ( $recref->{_password_encoding} eq 'ldap' ) {
if ( $recref->{_password} =~ /^(\{[\w\-]+\})(!?.{0,64})$/ ) {
}
} elsif ( $recref->{_password_encoding} eq 'plain' ) {
-
- #generate a password if it is blank
- $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
- unless length( $recref->{_password} );
-
+ # Password randomization is now in set_password.
+ # Strip whitespace characters, check length requirements, etc.
if ( $recref->{_password} =~ /^([^\t\n]{$passwordmin,$passwordmax})$/ ) {
$recref->{_password} = $1;
} else {
if ( $password_noexclamation ) {
$recref->{_password} =~ /\!/ and return gettext('illegal_password');
}
+ }
+ else {
+ return "invalid password encoding ('".$recref->{_password_encoding}."'";
+ }
+ $self->SUPER::check;
- } else {
+}
+
+
+sub _password_encryption {
+ my $self = shift;
+ my $encoding = lc($self->_password_encoding);
+ return if !$encoding;
+ return 'plain' if $encoding eq 'plain';
+ if($encoding eq 'crypt') {
+ my $pass = $self->_password;
+ $pass =~ s/^\*SUSPENDED\* //;
+ $pass =~ s/^!!?//;
+ return 'md5' if $pass =~ /^\$1\$/;
+ #return 'blowfish' if $self->_password =~ /^\$2\$/;
+ return 'des' if length($pass) == 13;
+ return;
+ }
+ if($encoding eq 'ldap') {
+ uc($self->_password) =~ /^\{([\w-]+)\}/;
+ return 'crypt' if $1 eq 'CRYPT' or $1 eq 'DES';
+ return 'plain' if $1 eq 'PLAIN' or $1 eq 'CLEARTEXT';
+ return 'md5' if $1 eq 'MD5';
+ return 'sha1' if $1 eq 'SHA' or $1 eq 'SHA-1';
+
+ return;
+ }
+ return;
+}
+
+sub get_cleartext_password {
+ my $self = shift;
+ if($self->_password_encryption eq 'plain') {
+ if($self->_password_encoding eq 'ldap') {
+ $self->_password =~ /\{\w+\}(.*)$/;
+ return $1;
+ }
+ else {
+ return $self->_password;
+ }
+ }
+ return;
+}
- #carp "warning: _password_encoding unspecified\n";
+
+=item set_password
- #generate a password if it is blank
- unless ( length( $recref->{_password} ) ) {
+Set the cleartext password for the account. If _password_encoding is set, the
+new password will be encoded according to the existing method (including
+encryption mode, if it can be determined). Otherwise,
+config('default-password-encoding') is used.
- $recref->{_password} =
- join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
- $recref->{_password_encoding} = 'plain';
+If no password is supplied (or a zero-length password when minimum password length
+is >0), one will be generated randomly.
+=cut
+
+sub set_password {
+ my( $self, $pass ) = ( shift, shift );
+
+ warn "[$me] set_password (to $pass) called on $self: ". Dumper($self)
+ if $DEBUG;
+
+ my $failure = gettext('illegal_password'). " $passwordmin-$passwordmax ".
+ FS::Msgcat::_gettext('illegal_password_characters').
+ ": ". $pass;
+
+ my( $encoding, $encryption ) = ('', '');
+
+ if ( $self->_password_encoding ) {
+ $encoding = $self->_password_encoding;
+ # identify existing encryption method, try to use it.
+ $encryption = $self->_password_encryption;
+ if (!$encryption) {
+ # use the system default
+ undef $encoding;
+ }
+ }
+
+ if ( !$encoding ) {
+ # set encoding to system default
+ ($encoding, $encryption) =
+ split(/-/, lc($conf->config('default-password-encoding')));
+ $encoding ||= 'legacy';
+ $self->_password_encoding($encoding);
+ }
+
+ if ( $encoding eq 'legacy' ) {
+
+ # The legacy behavior from check():
+ # If the password is blank, randomize it and set encoding to 'plain'.
+ if(!defined($pass) or (length($pass) == 0 and $passwordmin)) {
+ $pass = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
+ $self->_password_encoding('plain');
} else {
-
- #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
- if ( $recref->{_password} =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
- $recref->{_password} = $1.$3;
- $recref->{_password_encoding} = 'plain';
- } elsif ( $recref->{_password} =~
- /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/
- ) {
- $recref->{_password} = $1.$3;
- $recref->{_password_encoding} = 'crypt';
- } elsif ( $recref->{_password} eq '*' ) {
- $recref->{_password} = '*';
- $recref->{_password_encoding} = 'crypt';
- } elsif ( $recref->{_password} eq '!' ) {
- $recref->{_password_encoding} = 'crypt';
- $recref->{_password} = '!';
- } elsif ( $recref->{_password} eq '!!' ) {
- $recref->{_password} = '!!';
- $recref->{_password_encoding} = 'crypt';
+ # Prefix + valid-length password
+ if ( $pass =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
+ $pass = $1.$3;
+ $self->_password_encoding('plain');
+ # Prefix + crypt string
+ } elsif ( $pass =~ /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/ ) {
+ $pass = $1.$3;
+ $self->_password_encoding('crypt');
+ # Various disabled crypt passwords
+ } elsif ( $pass eq '*' || $pass eq '!' || $pass eq '!!' ) {
+ $self->_password_encoding('crypt');
} else {
- #return "Illegal password";
- return gettext('illegal_password'). " $passwordmin-$passwordmax ".
- FS::Msgcat::_gettext('illegal_password_characters').
- ": ". $recref->{_password};
+ return $failure;
}
-
}
+ $self->_password($pass);
+ return;
+
}
- $self->SUPER::check;
+ return $failure
+ if $passwordmin && length($pass) < $passwordmin
+ or $passwordmax && length($pass) > $passwordmax;
+
+ if ( $encoding eq 'crypt' ) {
+ if ($encryption eq 'md5') {
+ $pass = unix_md5_crypt($pass);
+ } elsif ($encryption eq 'des') {
+ $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
+ }
+
+ } elsif ( $encoding eq 'ldap' ) {
+ if ($encryption eq 'md5') {
+ $pass = md5_base64($pass);
+ } elsif ($encryption eq 'sha1') {
+ $pass = sha1_base64($pass);
+ } elsif ($encryption eq 'crypt') {
+ $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
+ }
+ # else $encryption eq 'plain', do nothing
+ $pass .= '=' x (4 - length($pass) % 4) #properly padded base64
+ if $encryption eq 'md5' || $encryption eq 'sha1';
+ $pass = '{'.uc($encryption).'}'.$pass;
+ }
+ # else encoding eq 'plain'
+ $self->_password($pass);
+ return;
}
=item _check_system
$reply{'Session-Timeout'} = $self->seconds;
}
+ if ( $conf->exists('radius-chillispot-max') ) {
+ #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot
+
+ #hmm. just because sqlradius.pm says so?
+ my %whatis = (
+ 'input' => 'up',
+ 'output' => 'down',
+ 'total' => 'total',
+ );
+
+ foreach my $what (qw( input output total )) {
+ my $is = $whatis{$what}.'bytes';
+ if ( $self->$is() =~ /\d/ ) {
+ my $big = new Math::BigInt $self->$is();
+ $big = new Math::BigInt '0' if $big->is_neg();
+ my $att = "Chillispot-Max-\u$what";
+ $reply{"$att-Octets"} = $big->copy->band(0xffffffff)->bstr;
+ $reply{"$att-Gigawords"} = $big->copy->brsft(32)->bstr;
+ }
+ }
+
+ }
+
%reply;
}
$check{$pw_attrib} = $password;
my $cust_svc = $self->cust_svc;
- die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
- unless $cust_svc;
- my $cust_pkg = $cust_svc->cust_pkg;
- if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
- $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
+ if ( $cust_svc ) {
+ my $cust_pkg = $cust_svc->cust_pkg;
+ if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
+ $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
+ }
+ } else {
+ warn "WARNING: no cust_svc record for svc_acct.svcnum ". $self->svcnum.
+ "; can't set Expiration\n"
+ unless $cust_svc;
}
%check;
sub radius_password {
my $self = shift;
- my($pw_attrib, $password);
+ my $pw_attrib;
if ( $self->_password_encoding eq 'ldap' ) {
-
$pw_attrib = 'Password-With-Header';
- $password = $self->_password;
-
} elsif ( $self->_password_encoding eq 'crypt' ) {
-
$pw_attrib = 'Crypt-Password';
- $password = $self->_password;
-
} elsif ( $self->_password_encoding eq 'plain' ) {
-
- $pw_attrib = $radius_password; #Cleartext-Password? man rlm_pap
- $password = $self->_password;
-
+ $pw_attrib = $radius_password;
} else {
-
- $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';
- $password = $self->_password;
-
+ $pw_attrib = length($self->_password) <= 12
+ ? $radius_password
+ : 'Crypt-Password';
}
- ($pw_attrib, $password);
+ ($pw_attrib, $self->_password);
}
$svc_domain->domain;
}
-=item svc_domain
-
-Returns the FS::svc_domain record for this account's domain (see
-L<FS::svc_domain>).
-
-=cut
-
-# FS::h_svc_acct has a history-aware svc_domain override
-
-sub svc_domain {
- my $self = shift;
- $self->{'_domsvc'}
- ? $self->{'_domsvc'}
- : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
-}
-
=item cust_svc
Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
=item acct_snarf
Returns an array of FS::acct_snarf records associated with the account.
-If the acct_snarf table does not exist or there are no associated records,
-an empty list is returned
=cut
sub acct_snarf {
my $self = shift;
- return () unless dbdef->table('acct_snarf');
- eval "use FS::acct_snarf;";
- die $@ if $@;
- qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
+ qsearch({
+ 'table' => 'acct_snarf',
+ 'hashref' => { 'svcnum' => $self->svcnum },
+ #'order_by' => 'ORDER BY priority ASC',
+ });
+}
+
+=item cgp_rpop_hashref
+
+Returns an arrayref of RPOP data suitable for Communigate Pro API commands.
+
+=cut
+
+sub cgp_rpop_hashref {
+ my $self = shift;
+ { map { $_->snarfname => $_->cgp_hashref } $self->acct_snarf };
}
=item decrement_upbytes OCTETS
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";
+ }
+
+ #overlimit_action eq 'cancel' handling
+ my $cust_pkg = $self->cust_svc->cust_pkg;
+ if ( $cust_pkg
+ && $cust_pkg->part_pkg->option('overlimit_action', 1) eq 'cancel'
+ && $op eq '-' && &{$op2condition{$op}}($self, $column, $amount)
+ )
+ {
+
+ my $error = $cust_pkg->cancel; #XXX should have a reason
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling: $error";
+ }
+
+ #nothing else is relevant if we're cancelling, so commit & return success
+ warn "$me update successful; committing\n"
+ if $DEBUG;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+
+ }
+
my $action = $op2action{$op};
if ( &{$op2condition{$op}}($self, $column, $amount) &&
( $action eq 'suspend' && !$self->overlimit
|| $action eq 'unsuspend' && $self->overlimit )
) {
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- if ($part_export->option('overlimit_groups')) {
- my ($new,$old);
- my $other = new FS::svc_acct $self->hashref;
- my $groups = &{ $self->_fieldhandlers->{'usergroup'} }
- ($self, $part_export->option('overlimit_groups'));
- $other->usergroup( $groups );
- if ($action eq 'suspend'){
- $new = $other; $old = $self;
- }else{
- $new = $self; $old = $other;
- }
- my $error = $part_export->export_replace($new, $old);
- $error ||= $self->overlimit($action);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing radius groups in export, ${op}: $error";
- }
- }
+
+ my $error = $self->_op_overlimit($action);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
}
+
}
if ( $conf->exists("svc_acct-usage_$action")
}
+sub _op_overlimit {
+ my( $self, $action ) = @_;
+
+ 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 $cust_pkg = $self->cust_svc->cust_pkg;
+
+ 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 = 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(\@groups);
+
+ my($new,$old);
+ if ($action eq 'suspend') {
+ $new = $other;
+ $old = $self;
+ } else { # $action eq 'unsuspend'
+ $new = $self;
+ $old = $other;
+ }
+
+ my $error = $part_export->export_replace($new, $old)
+ || $self->overlimit($action);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing radius groups: $error";
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
sub set_usage {
my( $self, $valueref, %options ) = @_;
my $reset = 0;
my %handyhash = ();
if ( $options{null} ) {
- %handyhash = ( map { ( $_ => 'NULL', $_."_threshold" => 'NULL' ) }
+ %handyhash = ( map { ( $_ => undef, $_."_threshold" => undef ) }
qw( seconds upbytes downbytes totalbytes )
);
}
#die $error if $error; #services not explicity changed via the UI
my $sql = "UPDATE svc_acct SET " .
- join (',', map { "$_ = $handyhash{$_}" } (keys %handyhash) ).
+ join (',', map { "$_ = ?" } (keys %handyhash) ).
" WHERE svcnum = ". $self->svcnum;
warn "$me $sql\n"
if (scalar(keys %handyhash)) {
my $sth = $dbh->prepare( $sql )
or die "Error preparing $sql: ". $dbh->errstr;
- my $rv = $sth->execute();
+ my $rv = $sth->execute(values %handyhash);
die "Error executing $sql: ". $sth->errstr
unless defined($rv);
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 ( $reset ) {
- my $error;
-
- if ($self->overlimit) {
- $error = $self->overlimit('unsuspend');
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- if ($part_export->option('overlimit_groups')) {
- my $old = new FS::svc_acct $self->hashref;
- my $groups = &{ $self->_fieldhandlers->{'usergroup'} }
- ($self, $part_export->option('overlimit_groups'));
- $old->usergroup( $groups );
- $error ||= $part_export->export_replace($self, $old);
- }
- }
- }
- if ( $conf->exists("svc_acct-usage_unsuspend")) {
- $error ||= $self->cust_svc->cust_pkg->unsuspend;
- }
+ my $error = '';
+
+ $error = $self->_op_overlimit('unsuspend')
+ if $self->overlimit;;
+
+ $error ||= $self->cust_svc->cust_pkg->unsuspend
+ if $conf->exists("svc_acct-usage_unsuspend");
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "Error unsuspending: $error";
}
+
}
warn "$me update successful; committing\n"
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};
+ my $groups = join(',',@{$self->usergroup});
+ my @groups;
+ return @groups unless length($groups);
+ @groups = qsearch({ 'table' => 'radius_group',
+ 'extra_sql' => "where groupnum in ($groups)",
+ });
+ map { $_->groupname } @groups;
} else {
- map { $_->groupname }
- qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
+ my $format = shift || '';
+ my @groups = qsearch({ 'table' => 'radius_usergroup',
+ 'addl_from' => 'left join radius_group using (groupnum)',
+ 'select' => 'radius_group.*',
+ 'hashref' => { 'svcnum' => $self->svcnum },
+ });
+
+ # this is to preserve various legacy behaviour / avoid re-writing other code
+ return map { $_->groupnum } @groups if $format eq 'NUMBERS';
+ return map { $_->description . " (" . $_->groupname . ")" } @groups
+ if $format eq 'COMBINED';
+ map { $_->groupname } @groups;
}
}
my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
if ( $encryption eq 'crypt' ) {
- crypt(
+ return crypt(
$self->_password,
$saltset[int(rand(64))].$saltset[int(rand(64))]
);
} elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
+ return unix_md5_crypt( $self->_password );
} elsif ( $encryption eq 'blowfish' ) {
croak "unknown encryption method $encryption";
} else {
}
} elsif ( $self->_password =~ /^\{CRYPT\}(.+)$/ ) {
- $1;
+ return $1;
}
} elsif ( $self->_password_encoding eq 'crypt' ) {
my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
if ( $encryption eq 'crypt' ) {
- crypt(
+ return crypt(
$self->_password,
$saltset[int(rand(64))].$saltset[int(rand(64))]
);
} elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
+ return unix_md5_crypt( $self->_password );
+ } elsif ( $encryption eq 'sha1_base64' ) { #for acct_sql
+ my $pass = sha1_base64( $self->_password );
+ $pass .= '=' x (4 - length($pass) % 4); #properly padded base64
+ return $pass;
} elsif ( $encryption eq 'blowfish' ) {
croak "unknown encryption method $encryption";
} else {
my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
if ( $encryption eq 'crypt' ) {
- crypt(
+ return crypt(
$self->_password,
$saltset[int(rand(64))].$saltset[int(rand(64))]
);
} elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
+ return unix_md5_crypt( $self->_password );
} elsif ( $encryption eq 'blowfish' ) {
croak "unknown encryption method $encryption";
} else {
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item search HASHREF
+
+Class method which returns a qsearch hash expression to search for parameters
+specified in HASHREF. Valid parameters are
+
+=over 4
+
+=item domain
+
+=item domsvc
+
+=item unlinked
+
+=item agentnum
+
+=item pkgpart
+
+Arrayref of pkgparts
+
+=item pkgpart
+
+=item where
+
+Arrayref of additional WHERE clauses, will be ANDed together.
+
+=item order_by
+
+=item cust_fields
+
+=back
+
+=cut
+
+sub search {
+ my ($class, $params) = @_;
+
+ my @where = ();
+
+ # 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;
+ }
+
+ # 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";
+ }
+
+ #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";
+ }
+
+ # svcpart
+ if ( $params->{'svcpart'} =~ /^(\d+)$/ ) {
+ push @where, "svcpart = $1";
+ }
+
+
+ # 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,
+ };
+
+}
+
+=back
+
=head1 SUBROUTINES
=over 4
}
-
-=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
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)
+_op_usage and set_usage bypass the history... maybe they shouldn't
+
=head1 SEE ALSO
L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
=cut
-=item domain_select_hash %OPTIONS
-
-Returns a hash SVCNUM => DOMAIN ... representing the domains this customer
-may at present purchase.
-
-Currently available options are: I<pkgnum> I<svcpart>
-
-=cut
-
-sub domain_select_hash {
- my ($self, %options) = @_;
- my %domains = ();
- my $part_svc;
- my $cust_pkg;
-
- if (ref($self)) {
- $part_svc = $self->part_svc;
- $cust_pkg = $self->cust_svc->cust_pkg
- if $self->cust_svc;
- }
-
- $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
- if $options{'svcpart'};
-
- $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
- if $options{'pkgnum'};
-
- if ($part_svc && ( $part_svc->part_svc_column('domsvc')->columnflag eq 'S'
- || $part_svc->part_svc_column('domsvc')->columnflag eq 'F')) {
- %domains = map { $_->svcnum => $_->domain }
- map { qsearchs('svc_domain', { 'svcnum' => $_ }) }
- split(',', $part_svc->part_svc_column('domsvc')->columnvalue);
- }elsif ($cust_pkg && !$conf->exists('svc_acct-alldomains') ) {
- %domains = map { $_->svcnum => $_->domain }
- map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum }) }
- map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
- qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
- }else{
- %domains = map { $_->svcnum => $_->domain } qsearch('svc_domain', {} );
- }
-
- if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag eq 'D') {
- my $svc_domain = qsearchs('svc_domain',
- { 'svcnum' => $part_svc->part_svc_column('domsvc')->columnvalue } );
- if ( $svc_domain ) {
- $domains{$svc_domain->svcnum} = $svc_domain->domain;
- }else{
- warn "unknown svc_domain.svcnum for part_svc_column domsvc: ".
- $part_svc->part_svc_column('domsvc')->columnvalue;
-
- }
- }
-
- (%domains);
-}
-
1;
-