X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=6f110514894aa42422c455fd2550e5754d942931;hb=babea860aa5a25688ade87414c5cc70d66ffd0fa;hp=fc950fafa2732c973218a467036e02601d7b2cf5;hpb=9509e5bfb7f9331303153cac24d7bfecbe2ea9f1;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index fc950fafa..6f1105148 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -14,13 +14,14 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles $radius_password $radius_ip $dirhash @saltset @pw_set ); +use Scalar::Util qw( blessed ); use Carp; use Fcntl qw(:flock); use Date::Format; use Crypt::PasswdMD5 1.2; use Data::Dumper; use Authen::Passphrase; -use FS::UID qw( datasrc ); +use FS::UID qw( datasrc driver_name ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); use FS::Msgcat qw(gettext); @@ -46,7 +47,7 @@ $DEBUG = 0; $me = '[FS::svc_acct]'; #ask FS::UID to run this stuff for us later -$FS::UID::callback{'FS::svc_acct'} = sub { +FS::UID->install_callback( sub { $conf = new FS::Conf; $dir_prefix = $conf->config('home'); @shells = $conf->config('shells'); @@ -85,7 +86,8 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $radius_password = $conf->config('radius-password') || 'Password'; $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address'; @pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps'); -}; +} +); @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); @@ -204,7 +206,7 @@ sub table_info { { 'name' => 'Account', 'longname_plural' => 'Access accounts and mailboxes', - 'sorts' => [ 'username', 'uid', ], + 'sorts' => [ 'username', 'uid', 'seconds', 'last_login' ], 'display_weight' => 10, 'cancel_weight' => 50, 'fields' => { @@ -248,7 +250,8 @@ sub table_info { label => 'Shell', def_label=> 'Shell (set to blank for no shell tracking)', type =>'select', - select_list => [ $conf->config('shells') ], + #select_list => [ $conf->config('shells') ], + select_list => [ $conf ? $conf->config('shells') : () ], disable_inventory => 1, disable_select => 1, }, @@ -270,6 +273,7 @@ sub table_info { disable_select => 1, }, 'seconds' => { label => 'Seconds', + label_sort => 'with Time Remaining', type => 'text', disable_inventory => 1, disable_select => 1, @@ -295,38 +299,48 @@ sub table_info { 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, }, - 'seconds_threshold' => { label => 'Seconds', + 'seconds_threshold' => { label => 'Seconds threshold', type => 'text', disable_inventory => 1, disable_select => 1, }, - 'upbytes_threshold' => { label => 'Upload', + 'upbytes_threshold' => { label => 'Upload threshold', type => 'text', disable_inventory => 1, disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, }, - 'downbytes_threshold' => { label => 'Download', + 'downbytes_threshold' => { label => 'Download threshold', type => 'text', disable_inventory => 1, disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, }, - 'totalbytes_threshold'=> { label => 'Total up and download', + 'totalbytes_threshold'=> { label => 'Total up and download threshold', type => 'text', disable_inventory => 1, disable_select => 1, 'format' => \&FS::UI::bytecount::display_bytecount, 'parse' => \&FS::UI::bytecount::parse_bytecount, }, + 'last_login'=> { + label => 'Last login', + type => 'disabled', + }, + 'last_logout'=> { + label => 'Last logout', + type => 'disabled', + }, }, }; } sub table { 'svc_acct'; } +sub table_dupcheck_fields { ( 'username', 'domsvc' ); } + sub _fieldhandlers { { #false laziness with edit/svc_acct.cgi @@ -343,6 +357,42 @@ sub _fieldhandlers { }; } +sub last_login { + shift->_lastlog('in', @_); +} + +sub last_logout { + shift->_lastlog('out', @_); +} + +sub _lastlog { + my( $self, $op, $time ) = @_; + + if ( defined($time) ) { + warn "$me last_log$op called on svcnum ". $self->svcnum. + ' ('. $self->email. "): $time\n" + if $DEBUG; + + my $dbh = dbh; + + my $sql = "UPDATE svc_acct SET last_log$op = ? WHERE svcnum = ?"; + warn "$me $sql\n" + if $DEBUG; + + my $sth = $dbh->prepare( $sql ) + or die "Error preparing $sql: ". $dbh->errstr; + my $rv = $sth->execute($time, $self->svcnum); + die "Error executing $sql: ". $sth->errstr + unless defined($rv); + die "Can't update last_log$op for svcnum". $self->svcnum + if $rv == 0; + + $self->{'Hash'}->{"last_log$op"} = $time; + }else{ + $self->getfield("last_log$op"); + } +} + =item search_sql STRING Class method which returns an SQL fragment to search for the given string. @@ -453,12 +503,6 @@ sub insert { $self->svcpart($cust_svc->svcpart); } - $error = $self->_check_duplicate; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - my @jobnums; $error = $self->SUPER::insert( 'jobnums' => \@jobnums, @@ -689,14 +733,15 @@ contain an arrayref of group names. See L. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + warn "$me replacing $old with $new\n" if $DEBUG; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } ); - } + my $error; return "can't modify system account" if $old->_check_system; @@ -770,15 +815,6 @@ sub replace { } - if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) { - $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart; - $error = $new->_check_duplicate; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - $error = $new->SUPER::replace($old, @_); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -1087,13 +1123,13 @@ sub check { if ( $recref->{_password} =~ #/^(\$\w+\$.*|[\w\+\/]{13}|_[\w\+\/]{19}|\*)$/ - /^(!!?)?(\$\w+\$.*|[\w\+\/]{13}|_[\w\+\/]{19}|\*)$/ + /^(!!?)?(\$\w+\$.*|[\w\+\/\.]{13}|_[\w\+\/\.]{19}|\*)$/ ) { - $recref->{_password} = $1.$2; + $recref->{_password} = ( defined($1) ? $1 : '' ). $2; } else { - return 'Illegal (crypt-encoded) password'; + return 'Illegal (crypt-encoded) password: '. $recref->{_password}; } } elsif ( $recref->{_password_encoding} eq 'plain' ) { @@ -1180,7 +1216,7 @@ sub _check_system { =item _check_duplicate -Internal function to check for duplicates usernames, username@domain pairs and +Internal method to check for duplicates usernames, username@domain pairs and uids. If the I configuration value is set to B or @@ -1197,12 +1233,7 @@ sub _check_duplicate { 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; - dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE") - or die dbh->errstr; - warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG; + $self->lock_table; my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); unless ( $part_svc ) { @@ -1266,7 +1297,8 @@ sub _check_duplicate { foreach my $dup_user ( @dup_user ) { my $dup_svcpart = $dup_user->cust_svc->svcpart; if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { - return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. + return "duplicate username ". $self->username. + ": conflicts with svcnum ". $dup_user->svcnum. " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; } } @@ -1274,9 +1306,9 @@ sub _check_duplicate { foreach my $dup_userdomain ( @dup_userdomain ) { my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - return "duplicate username\@domain: conflicts with svcnum ". - $dup_userdomain->svcnum. " via exportnum ". - $conflict_userdomain_svcpart{$dup_svcpart}; + return "duplicate username\@domain ". $self->email. + ": conflicts with svcnum ". $dup_userdomain->svcnum. + " via exportnum ". $conflict_userdomain_svcpart{$dup_svcpart}; } } @@ -1284,9 +1316,11 @@ sub _check_duplicate { my $dup_svcpart = $dup_uid->cust_svc->svcpart; if ( exists($conflict_user_svcpart{$dup_svcpart}) || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart} - || $conflict_userdomain_svcpart{$dup_svcpart}; + return "duplicate uid ". $self->uid. + ": conflicts with svcnum ". $dup_uid->svcnum. + " via exportnum ". + ( $conflict_user_svcpart{$dup_svcpart} + || $conflict_userdomain_svcpart{$dup_svcpart} ); } } @@ -1368,8 +1402,9 @@ sub radius_check { ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); - my $password = $self->_password; - my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password; + + my($pw_attrib, $password) = $self->radius_password; + $check{$pw_attrib} = $password; my $cust_svc = $self->cust_svc; die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n" @@ -1383,6 +1418,43 @@ sub radius_check { } +=item radius_password + +Returns a key/value pair containing the RADIUS attribute name and value +for the password. + +=cut + +sub radius_password { + my $self = shift; + + my($pw_attrib, $password); + 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; + + } else { + + $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; + $password = $self->_password; + + } + + ($pw_attrib, $password); + +} + =item snapshot This method instructs the object to "snapshot" or freeze RADIUS check and @@ -1909,6 +1981,17 @@ sub get_session_history { $self->cust_svc->get_session_history(@_); } +=item last_login_text + +Returns text describing the time of last login. + +=cut + +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 @@ -2540,5 +2623,61 @@ 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;