X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=1daf83a32858c024324347540f5105098f8e9455;hp=28ef949860e488c6b73a8e38c8f301bd7b248a3c;hb=beba6672fb9c9c5769c81f8029bb88cd2bc910e9;hpb=5fc8c5edf574ab024d4646914b6432d458e2ffbd diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 28ef94986..1daf83a32 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,12 +1,13 @@ 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 + $password_noampersand $password_noexclamation $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine $radius_password $radius_ip @@ -14,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 ); @@ -55,6 +56,8 @@ $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'); + $password_noampersand = $conf->exists('password-noexclamation'); + $password_noexclamation = $conf->exists('password-noexclamation'); $dirhash = $conf->config('dirhash') || 0; if ( $conf->exists('welcome_email') ) { $welcome_template = new Text::Template ( @@ -164,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 @@ -194,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 @@ -268,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; @@ -293,7 +298,7 @@ sub insert { #welcome email my $to = ''; if ( $welcome_template && $cust_pkg ) { - my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); + my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list ); if ( $to ) { my $wqueue = new FS::queue { 'svcnum' => $self->svcnum, @@ -538,16 +543,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"; } } @@ -555,6 +555,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 @@ -683,6 +719,12 @@ sub check { unless ( $username_ampersand ) { $recref->{username} =~ /\&/ and return gettext('illegal_username'); } + if ( $password_noampersand ) { + $recref->{_password} =~ /\&/ and return gettext('illegal_password'); + } + if ( $password_noexclamation ) { + $recref->{_password} =~ /\!/ and return gettext('illegal_password'); + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; @@ -702,9 +744,7 @@ sub check { return "Only root can have uid 0" if $recref->{uid} == 0 - && $recref->{username} ne 'root' - && $recref->{username} ne 'toor'; - + && $recref->{username} !~ /^(root|toor|smtp)$/; $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ or return "Illegal directory: ". $recref->{dir}; @@ -855,13 +895,12 @@ sub _check_duplicate { or die dbh->errstr; warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG; - my $svcpart = $self->svcpart; - my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } ); + my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); unless ( $part_svc ) { 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 } ); @@ -877,7 +916,7 @@ sub _check_duplicate { my @dup_uid; if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' && $self->username !~ /^(toor|(hyla)?fax)$/ ) { - @dup_uid = grep { $svcpart != $_->svcpart } + @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum } qsearch( 'svc_acct', { 'uid' => $self->uid } ); } else { @dup_uid = (); @@ -938,8 +977,8 @@ 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} + return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart} || $conflict_userdomain_svcpart{$dup_svcpart}; } } @@ -984,6 +1023,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; } @@ -1021,7 +1063,7 @@ Returns the domain associated with this account. sub domain { my $self = shift; die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc; - my $svc_domain = $self->svc_domain + my $svc_domain = $self->svc_domain(@_) or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; $svc_domain->domain; } @@ -1059,7 +1101,7 @@ Returns an email address associated with the account. sub email { my $self = shift; - $self->username. '@'. $self->domain; + $self->username. '@'. $self->domain(@_); } =item acct_snarf @@ -1078,6 +1120,41 @@ sub acct_snarf { qsearch('acct_snarf', { 'svcnum' => $self->svcnum } ); } +=item decrement_seconds SECONDS + +Decrements the I field of this record by the given amount. + +=cut + +sub decrement_seconds { + my( $self, $seconds ) = @_; + + 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 $sth = dbh->prepare( + 'UPDATE svc_acct SET seconds = seconds - ? WHERE svcnum = ?' + ) or die dbh->errstr;; + $sth->execute($seconds, $self->svcnum) or die $sth->errstr; + if ( $conf->exists('svc_acct-usage_suspend') + && $self->seconds - $seconds <= 0 ) { + #my $error = $self->suspend; + my $error = $self->cust_svc->cust_pkg->suspend; + die $error if $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + +} + =item seconds_since TIMESTAMP Returns the number of seconds this account has been online since TIMESTAMP, @@ -1136,16 +1213,16 @@ sub attribute_since_sqlradacct { $self->cust_svc->attribute_since_sqlradacct(@_); } -=item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END +=item get_session_history TIMESTAMP_START TIMESTAMP_END Returns an array of hash references of this customers login history for the given time range. (document this better) =cut -sub get_session_history_sqlradacct { +sub get_session_history { my $self = shift; - $self->cust_svc->get_session_history_sqlradacct(@_); + $self->cust_svc->get_session_history(@_); } =item radius_groups @@ -1231,11 +1308,18 @@ 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 { @@ -1246,10 +1330,19 @@ sub crypt_password { || $self->_password =~ /^\$(1|2a?)\$/ ) { $self->_password; } else { - crypt( - $self->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] - ); + my $encryption = scalar(@_) ? 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"; + } } } @@ -1408,7 +1501,7 @@ sub radius_usergroup_selector { END foreach my $group ( @all_groups ) { - $html .= '$group\n); }; $html .= '';