X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=ffcadc9cbcbd95668ba89c815d7f2d8b9ea6f23f;hp=294e32794c732b5e47690ec376441d2457ca64fe;hb=ec271a1445bf232cd172c38e2dd3fd9d3c5c7c4e;hpb=7bb7306b32e48ae29fc91eb969ba70a465d21c2d diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 294e32794..ffcadc9cb 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,12 +1,21 @@ 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_Radius_Mixin + FS::svc_Tower_Mixin + FS::svc_IP_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 + $username_exclamation $password_noampersand $password_noexclamation $warning_template $warning_from $warning_subject $warning_mimetype $warning_cc @@ -20,6 +29,8 @@ use Carp; use Fcntl qw(:flock); use Date::Format; use Crypt::PasswdMD5 1.2; +use Digest::SHA 'sha1_base64'; +use Digest::MD5 'md5_base64'; use Data::Dumper; use Text::Template; use Authen::Passphrase; @@ -28,23 +39,25 @@ use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); 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::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; +use FS::tower_sector; $DEBUG = 0; $me = '[FS::svc_acct]'; @@ -56,7 +69,11 @@ FS::UID->install_callback( sub { @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'); @@ -67,6 +84,10 @@ FS::UID->install_callback( sub { $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'); + $username_exclamation = $conf->exists('username-exclamation'); $password_noampersand = $conf->exists('password-noexclamation'); $password_noexclamation = $conf->exists('password-noexclamation'); $dirhash = $conf->config('dirhash') || 0; @@ -94,7 +115,7 @@ FS::UID->install_callback( sub { ); @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; @@ -154,45 +175,71 @@ FS::svc_Common. The following fields are currently supported: =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 sec_phrase -=item _password_encoding - plain, crypt, ldap (or empty for autodetection) +security phrase -=item sec_phrase - security phrase +=item popnum -=item popnum - Point of presence (see L) +Point of presence (see L) =item uid =item gid -=item finger - GECOS +=item finger -=item dir - set automatically if blank (and uid is not) +GECOS + +=item dir + +set automatically if blank (and uid is not) =item shell -=item quota - (unimplementd) +=item quota + +=item slipip + +IP address + +=item seconds -=item slipip - IP address +=item upbytes -=item seconds - +=item downbyte -=item upbytes - +=item totalbytes -=item downbytes - +=item domsvc -=item totalbytes - +svcnum from svc_domain -=item domsvc - svcnum from svc_domain +=item pbxsvc -=item radius_I - I (reply) +Optional svcnum from svc_pbx -=item rc_I - I (check) +=item radius_I + +I (reply) + +=item rc_I + +I (check) =back @@ -213,6 +260,7 @@ sub table_info { 'sorts' => [ 'username', 'uid', 'seconds', 'last_login' ], 'display_weight' => 10, 'cancel_weight' => 50, + 'ip_field' => 'slipip', 'fields' => { 'dir' => 'Home directory', 'uid' => { @@ -236,14 +284,37 @@ sub table_info { disable_default => 1, disable_fixed => 1, disable_select => 1, + required => 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, }, - '_password' => 'Password', + 'file_quota'=> { + label => 'File storage limit', + type => 'text', + disable_inventory => 1, + }, + 'file_maxnum'=> { + label => 'Number of files limit', + type => 'text', + disable_inventory => 1, + }, + 'file_maxsize'=> { + label => 'File size limit', + type => 'text', + disable_inventory => 1, + }, + '_password' => { label => 'Password', + required => 1 + }, 'gid' => { label => 'GID', def_info => 'when blank, defaults to UID', @@ -266,13 +337,20 @@ sub table_info { 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', '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', @@ -343,6 +421,120 @@ sub table_info { 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 + }, }; } @@ -351,22 +543,6 @@ sub table { 'svc_acct'; } 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', @_); } @@ -518,42 +694,8 @@ sub insert { 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; #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'); - } - - } - } - my @jobnums; - $error = $self->SUPER::insert( + my $error = $self->SUPER::insert( # usergroup is here 'jobnums' => \@jobnums, 'child_objects' => $self->child_objects, %options, @@ -563,20 +705,6 @@ sub insert { 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 ) { @@ -601,84 +729,123 @@ sub insert { } #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 } @@ -750,22 +917,12 @@ sub delete { } } - my $error = $self->SUPER::delete; + my $error = $self->SUPER::delete; # usergroup here if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - foreach my $radius_usergroup ( - qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ) - ) { - my $error = $radius_usergroup->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -808,6 +965,10 @@ sub replace { } + 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; @@ -822,49 +983,7 @@ sub replace { 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, @_); + $error = $new->SUPER::replace($old, @_); # usergroup here if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error if $error; @@ -1002,31 +1121,64 @@ sub check { 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_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') || $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; + # 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; @@ -1038,43 +1190,58 @@ sub check { 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; - 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; + + my $uerror = gettext('illegal_username'). ': '. $recref->{username}; + + unless ( $username_uppercase ) { + $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 $uerror; + } + unless ( $username_equals ) { + $recref->{username} =~ /\=/ and return $uerror; + } + unless ( $username_pound ) { + $recref->{username} =~ /\#/ and return $uerror; + } + unless ( $username_exclamation ) { + $recref->{username} =~ /\!/ and return $uerror; } + $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; return "Unknown popnum" unless @@ -1117,7 +1284,7 @@ sub check { 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" @@ -1141,8 +1308,6 @@ sub check { } - # $error = $self->ut_textn('finger'); - # return $error if $error; if ( $self->getfield('finger') eq '' ) { my $cust_pkg = $self->svcnum ? $self->cust_svc->cust_pkg @@ -1152,17 +1317,22 @@ sub check { $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') ); } } - $self->getfield('finger') =~ - /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/ + # $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); - $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 '' ) { - $recref->{slipip} = ''; + $recref->{slipip} = ''; # eh? } elsif ( $recref->{slipip} eq '0e0' ) { $recref->{slipip} = '0e0'; } else { @@ -1170,7 +1340,6 @@ sub check { or return "Illegal slipip: ". $self->slipip; $recref->{slipip} = $1; } - } #arbitrary RADIUS stuff; allow ut_textn for now @@ -1178,6 +1347,18 @@ sub check { $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})$/ ) { @@ -1200,11 +1381,8 @@ sub check { } } 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 { @@ -1219,51 +1397,156 @@ sub check { if ( $password_noexclamation ) { $recref->{_password} =~ /\!/ and return gettext('illegal_password'); } + } + else { + return "invalid password encoding ('".$recref->{_password_encoding}."'"; + } - } else { + $self->SUPER::check; + +} + + +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; +} + + +=item set_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. + +If no password is supplied (or a zero-length password when minimum password length +is >0), one will be generated randomly. + +=cut - #carp "warning: _password_encoding unspecified\n"; +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; + } + } - #generate a password if it is blank - unless ( length( $recref->{_password} ) ) { + if ( !$encoding ) { + # set encoding to system default + ($encoding, $encryption) = + split(/-/, lc($conf->config('default-password-encoding') || '')); + $encoding ||= 'legacy'; + $self->_password_encoding($encoding); + } - $recref->{_password} = - join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); - $recref->{_password_encoding} = 'plain'; + 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 @@ -1455,6 +1738,7 @@ sub radius_reply { 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; @@ -1521,30 +1805,20 @@ for the password. 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); } @@ -1600,22 +1874,6 @@ sub domain { $svc_domain->domain; } -=item svc_domain - -Returns the FS::svc_domain record for this account's domain (see -L). - -=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). @@ -1638,20 +1896,32 @@ sub email { $self->username. '@'. $self->domain(@_); } + =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 +# unused as originally intended, but now by Communigate Pro "RPOP" 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 @@ -1837,26 +2107,13 @@ sub _op_usage { ( $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") @@ -1901,6 +2158,60 @@ sub _op_usage { } +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 ) = @_; @@ -1924,7 +2235,7 @@ sub set_usage { my $reset = 0; my %handyhash = (); if ( $options{null} ) { - %handyhash = ( map { ( $_ => 'NULL', $_."_threshold" => 'NULL' ) } + %handyhash = ( map { ( $_ => undef, $_."_threshold" => undef ) } qw( seconds upbytes downbytes totalbytes ) ); } @@ -1946,7 +2257,7 @@ sub set_usage { #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" @@ -1955,7 +2266,7 @@ sub set_usage { 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 @@ -1965,36 +2276,28 @@ sub set_usage { #$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); + 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" @@ -2067,152 +2370,109 @@ sub seconds_since { $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. Also see L and L 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) -in this package for sessions ending between TIMESTAMP_START (inclusive) and -TIMESTAMP_END (exclusive). +=item last_login_text -TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see -L. Also see L and L for conversion -functions. +Returns text describing the time of last login. =cut -#note: POD here, implementation in FS::cust_svc -sub attribute_since_sqlradacct { +sub last_login_text { my $self = shift; - $self->cust_svc->attribute_since_sqlradacct(@_); + $self->last_login ? ctime($self->last_login) : 'unknown'; } -=item get_session_history TIMESTAMP_START TIMESTAMP_END +=item psearch_cdrs OPTIONS -Returns an array of hash references of this customers login history for the -given time range. (document this better) +Returns a paged search (L) 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 the +"username" field of the service. =cut -sub get_session_history { - my $self = shift; - $self->cust_svc->get_session_history(@_); -} +sub psearch_cdrs { + my($self, %options) = @_; + my @fields; + my %hash; + my @where; -=item last_login_text + my $did = dbh->quote($self->username); -Returns text describing the time of last login. + my $prefix = $options{'default_prefix'} || ''; #convergent.au '+61' + my $prefixdid = dbh->quote($prefix . $self->username); -=cut + my $for_update = $options{'for_update'} ? 'FOR UPDATE' : ''; -sub last_login_text { - my $self = shift; - $self->last_login ? ctime($self->last_login) : 'unknown'; -} - -=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ] - -=cut + if ( $options{inbound} ) { + # these will be selected under their DIDs + push @where, "FALSE"; + } -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' - ) - ) - "; + my @orwhere; + if (!$options{'disable_charged_party'}) { + push @orwhere, + "charged_party = $did", + "charged_party = $prefixdid"; + } + if (!$options{'disable_src'}) { + push @orwhere, + "src = $did AND charged_party IS NULL", + "src = $prefixdid 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'; + } - qsearch( - 'select' => "$for_update *", + my $extra_sql = join(' AND ', @where); + if ($extra_sql) { + if (keys %hash) { + $extra_sql = " AND ".$extra_sql; + } else { + $extra_sql = " WHERE ".$extra_sql; + } + } + 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). +Like psearch_cdrs, but returns all the L 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 @@ -2259,7 +2519,8 @@ sub check_password { 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' ) { @@ -2323,12 +2584,12 @@ sub crypt_password { 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 { @@ -2336,7 +2597,7 @@ sub crypt_password { } } elsif ( $self->_password =~ /^\{CRYPT\}(.+)$/ ) { - $1; + return $1; } } elsif ( $self->_password_encoding eq 'crypt' ) { @@ -2349,12 +2610,16 @@ sub crypt_password { 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 { @@ -2375,12 +2640,12 @@ sub crypt_password { 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 { @@ -2498,6 +2763,81 @@ sub virtual_maildir { =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_svc { + my( $class, $params, $from, $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; + } + + # domsvc + if ( $params->{'domsvc'} =~ /^(\d+)$/ ) { + push @$where, "domsvc = $1"; + } + + + # popnum + if ( $params->{'popnum'} =~ /^(\d+)$/ ) { + push @$where, "popnum = $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) + + # 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 )'; + } + +} + +=back + =head1 SUBROUTINES =over 4 @@ -2608,56 +2948,6 @@ sub append_fuzzyfiles { } - -=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 = < - 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 = ""; - } - - '; - - $html .= qq!
!. - qq!!; - - $html; -} - =item reached_threshold Performs some activities when svc_acct thresholds (such as number of seconds @@ -2747,9 +3037,6 @@ The suspend, unsuspend and cancel methods update the database, but not the 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) @@ -2765,61 +3052,4 @@ schema.html from the base documentation. =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 I - -=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; -