X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=c50dfd540cad6a792f1f981ad7ddee8c9857af36;hb=08dc9fe500cf44346e409fb8c75eda541300d64d;hp=de89819b3dc4bfba55fffef41927907c3c86eb56;hpb=0186436eb38e70da0a015e49dab67cec5f1a3467;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index de89819b3..c50dfd540 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -17,9 +17,11 @@ use Carp; use Fcntl qw(:flock); use Date::Format; use Crypt::PasswdMD5 1.2; +use Data::Dumper; use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); +use FS::Msgcat qw(gettext); use FS::svc_Common; use FS::cust_svc; use FS::part_svc; @@ -31,9 +33,9 @@ use FS::queue; use FS::radius_usergroup; use FS::export_svc; use FS::part_export; -use FS::Msgcat qw(gettext); use FS::svc_forward; use FS::svc_www; +use FS::cdr; @ISA = qw( FS::svc_Common ); @@ -186,6 +188,22 @@ Creates a new account. To add the account to the database, see L<"insert">. sub table { 'svc_acct'; } +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 { + []; + } + }, + }; +} + =item insert [ , OPTION => VALUE ... ] Adds this account to the database. If there is an error, returns the error, @@ -220,7 +238,11 @@ jobnum(s) (they will not run until the specific job(s) complete(s)). sub insert { my $self = shift; my %options = @_; - my $error; + + if ( $DEBUG ) { + warn "[$me] insert called on $self: ". Dumper($self). + "\nwith options: ". Dumper(%options); + } local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -233,7 +255,7 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $error = $self->check; + my $error = $self->check; return $error if $error; if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) { @@ -467,7 +489,15 @@ sub replace { { #no warnings 'numeric'; #alas, a 5.006-ism local($^W) = 0; - return "Can't change uid!" if $old->uid != $new->uid; + + foreach my $xid (qw( uid gid )) { + + return "Can't change $xid!" + if ! $conf->exists("svc_acct-edit_$xid") + && $old->$xid() != $new->$xid() + && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F' + } + } #change homdir when we change username @@ -489,8 +519,10 @@ sub replace { return $error if $error; $old->usergroup( [ $old->radius_groups ] ); - warn "old groups: ". join(' ',@{$old->usergroup}). "\n" if $DEBUG; - warn "new groups: ". join(' ',@{$new->usergroup}). "\n" if $DEBUG; + 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}; @@ -671,7 +703,7 @@ sub check { my($recref) = $self->hashref; - my $x = $self->setfixed; + my $x = $self->setfixed( $self->_fieldhandlers ); return $x unless ref($x); my $part_svc = $x; @@ -745,6 +777,28 @@ sub check { if $recref->{uid} == 0 && $recref->{username} !~ /^(root|toor|smtp)$/; + unless ( $recref->{username} eq 'sync' ) { + if ( grep $_ eq $recref->{shell}, @shells ) { + $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0]; + } else { + return "Illegal shell \`". $self->shell. "\'; ". + $conf->dir. "/shells contains: @shells"; + } + } else { + $recref->{shell} = '/bin/sync'; + } + + } else { + $recref->{gid} ne '' ? + return "Can't have gid without uid" : ( $recref->{gid}='' ); + #$recref->{dir} ne '' ? + # return "Can't have directory without uid" : ( $recref->{dir}='' ); + $recref->{shell} ne '' ? + return "Can't have shell without uid" : ( $recref->{shell}='' ); + } + + unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) { + $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ or return "Illegal directory: ". $recref->{dir}; $recref->{dir} = $1; @@ -767,24 +821,6 @@ sub check { ; } - unless ( $recref->{username} eq 'sync' ) { - if ( grep $_ eq $recref->{shell}, @shells ) { - $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0]; - } else { - return "Illegal shell \`". $self->shell. "\'; ". - $conf->dir. "/shells contains: @shells"; - } - } else { - $recref->{shell} = '/bin/sync'; - } - - } else { - $recref->{gid} ne '' ? - return "Can't have gid without uid" : ( $recref->{gid}='' ); - $recref->{dir} ne '' ? - return "Can't have directory without uid" : ( $recref->{dir}='' ); - $recref->{shell} ne '' ? - return "Can't have shell without uid" : ( $recref->{shell}='' ); } # $error = $self->ut_textn('finger'); @@ -887,6 +923,9 @@ per export and with identical I values. sub _check_duplicate { my $self = shift; + my $global_unique = $conf->config('global_unique-username') || 'none'; + return '' if $global_unique eq 'disabled'; + #this is Pg-specific. what to do for mysql etc? # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ ) warn "$me locking svc_acct table for duplicate search" if $DEBUG; @@ -899,8 +938,6 @@ sub _check_duplicate { return 'unknown svcpart '. $self->svcpart; } - my $global_unique = $conf->config('global_unique-username') || 'none'; - my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum } qsearch( 'svc_acct', { 'username' => $self->username } ); return gettext('username_in_use') @@ -1013,6 +1050,9 @@ expected to change in the future. sub radius_reply { my $self = shift; + return %{ $self->{'radius_reply'} } + if exists $self->{'radius_reply'}; + my %reply = map { /^(radius_(.*))$/; @@ -1046,6 +1086,9 @@ expected to change in the future. sub radius_check { my $self = shift; + return %{ $self->{'radius_check'} } + if exists $self->{'radius_check'}; + my %check = map { /^(rc_(.*))$/; @@ -1057,8 +1100,11 @@ sub radius_check { my $password = $self->_password; my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password; - my $cust_pkg = $self->cust_svc->cust_pkg; - if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid ) { + 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 } @@ -1066,6 +1112,41 @@ sub radius_check { } +=item snapshot + +This method instructs the object to "snapshot" or freeze RADIUS check and +reply attributes to the current values. + +=cut + +#bah, my english is too broken this morning +#Of note is the "Expiration" attribute, which, for accounts in prepaid packages, is typically defined on-the-fly as the associated packages cust_pkg.bill. (This is used by +#the FS::cust_pkg's replace method to trigger the correct export updates when +#package dates change) + +sub snapshot { + my $self = shift; + + $self->{$_} = { $self->$_() } + foreach qw( radius_reply radius_check ); + +} + +=item forget_snapshot + +This methos instructs the object to forget any previously snapshotted +RADIUS check and reply attributes. + +=cut + +sub forget_snapshot { + my $self = shift; + + delete $self->{$_} + foreach qw( radius_reply radius_check ); + +} + =item domain Returns the domain associated with this account. @@ -1208,7 +1289,7 @@ sub _op_seconds { } } - warn "$me update sucessful; committing\n" + warn "$me update successful; committing\n" if $DEBUG; $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -1286,6 +1367,67 @@ sub get_session_history { $self->cust_svc->get_session_history(@_); } +=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ] + +=cut + +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' + ) + ) + "; + + } + + qsearch( + 'select' => "$for_update *", + 'table' => 'cdr', + 'hashref' => { + #( freesidestatus IS NULL OR freesidestatus = '' ) + 'freesidestatus' => '', + }, + 'extra_sql' => $charged_or_src, + + ); + +} + =item radius_groups Returns all RADIUS groups for this account (see L). @@ -1295,6 +1437,8 @@ Returns all RADIUS groups for this account (see L). sub radius_groups { 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}; @@ -1335,7 +1479,7 @@ sub clone_kludge_unsuspend { =item check_password Checks the supplied password against the (possibly encrypted) password in the -database. Returns true for a sucessful authentication, false for no match. +database. Returns true for a successful authentication, false for no match. Currently supported encryptions are: classic DES crypt() and MD5