X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=1ec5429e97d4dcba2e7fa6d7cfa7abd1cf789305;hb=26115b9232d9c231e0754e7efc47f6bce767c12a;hp=109ea1d451ae111a021688a3800ba32be65d7bc7;hpb=18c025613fa052cf4ba8d484f1296cc2a1719a24;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 109ea1d45..1ec5429e9 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,12 +1,12 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $DEBUG $me $conf +use vars qw( @ISA $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_uppercase $username_percent $password_noampersand $password_noexclamation $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine @@ -15,7 +15,7 @@ use vars qw( @ISA $DEBUG $me $conf @saltset @pw_set ); use Carp; use Fcntl qw(:flock); -use Crypt::PasswdMD5; +use Crypt::PasswdMD5 1.2; use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); @@ -37,7 +37,6 @@ use FS::svc_www; @ISA = qw( FS::svc_Common ); $DEBUG = 0; -#$DEBUG = 1; $me = '[FS::svc_acct]'; #ask FS::UID to run this stuff for us later @@ -56,6 +55,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_nodash = $conf->exists('username-nodash'); $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); + $username_percent = $conf->exists('username-percent'); $password_noampersand = $conf->exists('password-noexclamation'); $password_noexclamation = $conf->exists('password-noexclamation'); $dirhash = $conf->config('dirhash') || 0; @@ -167,7 +167,9 @@ FS::svc_Common. The following fields are currently supported: =item domsvc - svcnum from svc_domain -=item radius_I - I +=item radius_I - I (reply) + +=item rc_I - I (check) =back @@ -197,7 +199,10 @@ contain an arrayref of group names. See L. The additional field I can optionally be defined; if so it should contain an arrayref of FS::tablename objects. They will have their svcnum fields set and will be inserted after this record, but before any -exports are run. +exports are run. Each element of the array can also optionally be a +two-element array reference containing the child object and the name of an +alternate field to be filled in with the newly-inserted svcnum, for example +C<[ $svc_forward, 'srcsvc' ]> Currently available options are: I @@ -271,15 +276,12 @@ sub insert { } } - #false laziness with sub replace (and cust_main) - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::append_fuzzyfiles' - }; - $error = $queue->insert($self->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + unless ( $skip_fuzzyfiles ) { + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; + } } my $cust_pkg = $self->cust_svc->cust_pkg; @@ -461,11 +463,6 @@ sub replace { return "can't modify system account" if $old->_check_system; - return "Username in use" - if $old->username ne $new->username && - qsearchs( 'svc_acct', { 'username' => $new->username, - 'domsvc' => $new->domsvc, - } ); { #no warnings 'numeric'; #alas, a 5.006-ism local($^W) = 0; @@ -541,16 +538,11 @@ sub replace { return $error if $error; } - if ( $new->username ne $old->username ) { - #false laziness with sub insert (and cust_main) - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::append_fuzzyfiles' - }; - $error = $queue->insert($new->username); + if ( $new->username ne $old->username && ! $skip_fuzzyfiles ) { + $error = $new->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + return "updating fuzzy search cache: $error"; } } @@ -558,6 +550,42 @@ sub replace { ''; #no error } +=item queue_fuzzyfiles_update + +Used by insert & replace to update the fuzzy search cache + +=cut + +sub queue_fuzzyfiles_update { + my $self = shift; + + 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 $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; + my $error = $queue->insert($self->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + + =item suspend Suspends this account by calling export-specific suspend hooks. If there is @@ -660,11 +688,11 @@ sub check { my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; if ( $username_uppercase ) { - $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i + $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } else { - $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ + $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/ or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } @@ -692,6 +720,9 @@ sub check { if ( $password_noexclamation ) { $recref->{_password} =~ /\!/ and return gettext('illegal_password'); } + unless ( $username_percent ) { + $recref->{username} =~ /\%/ and return gettext('illegal_username'); + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; @@ -867,7 +898,7 @@ sub _check_duplicate { return 'unknown svcpart '. $self->svcpart; } - my $global_unique = $conf->config('global_unique-username'); + my $global_unique = $conf->config('global_unique-username') || 'none'; my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum } qsearch( 'svc_acct', { 'username' => $self->username } ); @@ -990,6 +1021,9 @@ sub radius_reply { if ( $self->slipip && $self->slipip ne '0e0' ) { $reply{$radius_ip} = $self->slipip; } + if ( $self->seconds !~ /^$/ ) { + $reply{'Session-Timeout'} = $self->seconds; + } %reply; } @@ -1084,6 +1118,93 @@ sub acct_snarf { qsearch('acct_snarf', { 'svcnum' => $self->svcnum } ); } +=item decrement_seconds SECONDS + +Decrements the I field of this record by the given amount. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub decrement_seconds { + shift->_op_seconds('-', @_); +} + +=item increment_seconds SECONDS + +Increments the I field of this record by the given amount. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub increment_seconds { + shift->_op_seconds('+', @_); +} + + +my %op2action = ( + '-' => 'suspend', + '+' => 'unsuspend', +); +my %op2condition = ( + '-' => sub { my($self, $seconds) = @_; + $self->seconds - $seconds <= 0; + }, + '+' => sub { my($self, $seconds) = @_; + $self->seconds + $seconds > 0; + }, +); + +sub _op_seconds { + my( $self, $op, $seconds ) = @_; + warn "$me _op_seconds called for svcnum ". $self->svcnum. + ' ('. $self->email. "): $op $seconds\n" + if $DEBUG; + + 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 $sql = "UPDATE svc_acct SET seconds = ". + " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0 + " $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($seconds, $self->svcnum); + die "Error executing $sql: ". $sth->errstr + unless defined($rv); + die "Can't update seconds for svcnum". $self->svcnum + if $rv == 0; + + my $action = $op2action{$op}; + + if ( $conf->exists("svc_acct-usage_$action") + && &{$op2condition{$op}}($self, $seconds) ) { + #my $error = $self->$action(); + my $error = $self->cust_svc->cust_pkg->$action(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error ${action}ing: $error"; + } + } + + warn "$me update sucessful; committing\n" + if $DEBUG; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + + =item seconds_since TIMESTAMP Returns the number of seconds this account has been online since TIMESTAMP, @@ -1237,25 +1358,43 @@ sub check_password { } -=item crypt_password +=item crypt_password [ DEFAULT_ENCRYPTION_TYPE ] Returns an encrypted password, either by passing through an encrypted password in the database or by encrypting a plaintext password from the database. +The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I (classic +UNIX DES crypt), I (md5 crypt supported by most modern Linux and BSD +distrubtions), or (eventually) I (blowfish hashing supported by +OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.). The default +encryption type is only used if the password is not already encrypted in the +database. + =cut sub crypt_password { my $self = shift; - #false laziness w/shellcommands.pm #eventually should check a "password-encoding" field if ( length($self->_password) == 13 - || $self->_password =~ /^\$(1|2a?)\$/ ) { + || $self->_password =~ /^\$(1|2a?)\$/ + || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/ + ) + { $self->_password; } else { - crypt( - $self->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] - ); + my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt'; + if ( $encryption eq 'crypt' ) { + crypt( + $self->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + } elsif ( $encryption eq 'md5' ) { + unix_md5_crypt( $self->_password ); + } elsif ( $encryption eq 'blowfish' ) { + die "unknown encryption method $encryption"; + } else { + die "unknown encryption method $encryption"; + } } }