X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=1daf83a32858c024324347540f5105098f8e9455;hb=e96a3fd1c8ee8c711a7e119c0937da6866bbd4f0;hp=3fb28c05469e2175c5f6be989259ffad713d6bf3;hpb=4a22a31cd586fc6cff704294b4de39841b0bc86b;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3fb28c054..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,9 +15,10 @@ use vars qw( @ISA $DEBUG $me $conf @saltset @pw_set ); use Carp; use Fcntl qw(:flock); +use Crypt::PasswdMD5 1.2; use FS::UID qw( datasrc ); use FS::Conf; -use FS::Record qw( qsearch qsearchs fields dbh ); +use FS::Record qw( qsearch qsearchs fields dbh dbdef ); use FS::svc_Common; use FS::cust_svc; use FS::part_svc; @@ -29,10 +31,13 @@ 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; @ISA = qw( FS::svc_Common ); $DEBUG = 0; +#$DEBUG = 1; $me = '[FS::svc_acct]'; #ask FS::UID to run this stuff for us later @@ -51,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 ( @@ -160,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 @@ -176,7 +185,7 @@ Creates a new account. To add the account to the database, see L<"insert">. sub table { 'svc_acct'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this account to the database. If there is an error, returns the error, otherwise returns false. @@ -185,8 +194,21 @@ The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. The additional field I can optionally be defined; if so it should -contain an arrayref of group names. See L. (used in -sqlradius export only) +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. 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 + +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). (TODOC: L and L) @@ -196,6 +218,7 @@ sqlradius export only) sub insert { my $self = shift; + my %options = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -212,15 +235,7 @@ sub insert { $error = $self->check; return $error if $error; - #no, duplicate checking just got a whole lot more complicated - #(perhaps keep this check with a config option to turn on?) - - #return gettext('username_in_use'). ": ". $self->username - # if qsearchs( 'svc_acct', { 'username' => $self->username, - # 'domsvc' => $self->domsvc, - # } ); - - if ( $self->svcnum ) { + 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; @@ -230,96 +245,18 @@ sub insert { $self->svcpart($cust_svc->svcpart); } - #new duplicate username checking - - my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); - unless ( $part_svc ) { + $error = $self->_check_duplicate; + if ( $error ) { $dbh->rollback if $oldAutoCommit; - return 'unknown svcpart '. $self->svcpart; - } - - my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); - my @dup_userdomain = qsearch( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc } ); - my @dup_uid; - if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' - && $self->username !~ /^(toor|(hyla)?fax)$/ ) { - @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } ); - } else { - @dup_uid = (); - } - - if ( @dup_user || @dup_userdomain || @dup_uid ) { - my $exports = FS::part_export::export_info('svc_acct'); - my %conflict_user_svcpart; - my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); - - foreach my $part_export ( $part_svc->part_export ) { - - #this will catch to the same exact export - my @svcparts = map { $_->svcpart } - qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - - #this will catch to exports w/same exporthost+type ??? - #my @other_part_export = qsearch('part_export', { - # 'machine' => $part_export->machine, - # 'exporttype' => $part_export->exporttype, - #} ); - #foreach my $other_part_export ( @other_part_export ) { - # push @svcparts, map { $_->svcpart } - # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - #} - - #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; - #silly kludge to avoid uninitialized value errors - my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) - ? $exports->{$part_export->exporttype}{'nodomain'} - : ''; - if ( $nodomain =~ /^Y/i ) { - $conflict_user_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } else { - $conflict_userdomain_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } - } - - foreach my $dup_user ( @dup_user ) { - my $dup_svcpart = $dup_user->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; - } - } - - foreach my $dup_userdomain ( @dup_userdomain ) { - my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; - if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate username\@domain: conflicts with svcnum ". - $dup_userdomain->svcnum. " via exportnum ". - $conflict_userdomain_svcpart{$dup_svcpart}; - } - } - - foreach my $dup_uid ( @dup_uid ) { - my $dup_svcpart = $dup_uid->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) - || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate uid: conflicts with svcnum". $dup_uid->svcnum. - "via exportnum ". $conflict_user_svcpart{$dup_svcpart} - || $conflict_userdomain_svcpart{$dup_svcpart}; - } - } - + return $error; } - #see? i told you it was more complicated - my @jobnums; - $error = $self->SUPER::insert(\@jobnums); + $error = $self->SUPER::insert( + 'jobnums' => \@jobnums, + 'child_objects' => $self->child_objects, + %options, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -339,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; @@ -364,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, @@ -389,6 +323,22 @@ sub insert { 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 ) { @@ -421,6 +371,8 @@ The corresponding FS::cust_svc record will be deleted as well. sub delete { my $self = shift; + return "can't delete system account" if $self->_check_system; + return "Can't delete an account which is a (svc_forward) source!" if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } ); @@ -428,7 +380,7 @@ sub delete { if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } ); return "Can't delete an account with (svc_www) web service!" - if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } ); + if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } ); # what about records in session ? (they should refer to history table) @@ -499,8 +451,8 @@ Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. The additional field I can optionally be defined; if so it should -contain an arrayref of group names. See L. (used in -sqlradius export only) +contain an arrayref of group names. See L. + =cut @@ -509,6 +461,8 @@ sub replace { my $error; warn "$me replacing $old with $new\n" if $DEBUG; + 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, @@ -574,22 +528,26 @@ 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; 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"; } } @@ -597,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 @@ -608,16 +602,7 @@ Called by the suspend method of FS::cust_pkg (see L). sub suspend { my $self = shift; - my %hash = $self->hash; - unless ( $hash{_password} =~ /^\*SUSPENDED\* / - || $hash{_password} eq '*' - ) { - $hash{_password} = '*SUSPENDED* '.$hash{_password}; - my $new = new FS::svc_acct ( \%hash ); - my $error = $new->replace($self); - return $error if $error; - } - + return "can't suspend system account" if $self->_check_system; $self->SUPER::suspend; } @@ -645,10 +630,36 @@ sub unsuspend { =item cancel -Just returns false (no error) for now. - Called by the cancel method of FS::cust_pkg (see L). +If the B configuration option is set, this method will +automatically remove any references to the canceled service in the catchall +field of svc_domain. This allows packages that contain both a svc_domain and +its catchall svc_acct to be canceled in one step. + +=cut + +sub cancel { + # Only one thing to do at this level + my $self = shift; + foreach my $svc_domain ( + qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) { + if($conf->exists('auto_unset_catchall')) { + my %hash = $svc_domain->hash; + $hash{catchall} = ''; + my $new = new FS::svc_domain ( \%hash ); + my $error = $new->replace($svc_domain); + return $error if $error; + } else { + return "cannot unprovision svc_acct #".$self->svcnum. + " while assigned as catchall for svc_domain #".$svc_domain->svcnum; + } + } + + $self->SUPER::cancel; +} + + =item check Checks all fields to make sure this is a valid service. If there is an error, @@ -708,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; @@ -727,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}; @@ -775,12 +790,21 @@ 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 + : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } ); + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') ); + } + } $self->getfield('finger') =~ /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/ or return "Illegal finger: ". $self->getfield('finger'); $self->setfield('finger', $1); - $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota"; + $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota"; $recref->{quota} = $1; unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { @@ -833,6 +857,138 @@ sub check { $self->SUPER::check; } +=item _check_system + +Internal function to check the username against the list of system usernames +from the I configuration value. Returns true if the username +is listed on the system username list. + +=cut + +sub _check_system { + my $self = shift; + scalar( grep { $self->username eq $_ || $self->email eq $_ } + $conf->config('system_usernames') + ); +} + +=item _check_duplicate + +Internal function to check for duplicates usernames, username@domain pairs and +uids. + +If the I configuration value is set to B or +B, enforces global username or username@domain uniqueness. + +In all cases, check for duplicate uids and usernames or username@domain pairs +per export and with identical I values. + +=cut + +sub _check_duplicate { + my $self = shift; + + #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; + + 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') || 'none'; + + my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum } + qsearch( 'svc_acct', { 'username' => $self->username } ); + return gettext('username_in_use') + if $global_unique eq 'username' && @dup_user; + + my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum } + qsearch( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc } ); + return gettext('username_in_use') + if $global_unique eq 'username@domain' && @dup_userdomain; + + my @dup_uid; + if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' + && $self->username !~ /^(toor|(hyla)?fax)$/ ) { + @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum } + qsearch( 'svc_acct', { 'uid' => $self->uid } ); + } else { + @dup_uid = (); + } + + if ( @dup_user || @dup_userdomain || @dup_uid ) { + my $exports = FS::part_export::export_info('svc_acct'); + my %conflict_user_svcpart; + my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); + + foreach my $part_export ( $part_svc->part_export ) { + + #this will catch to the same exact export + my @svcparts = map { $_->svcpart } $part_export->export_svc; + + #this will catch to exports w/same exporthost+type ??? + #my @other_part_export = qsearch('part_export', { + # 'machine' => $part_export->machine, + # 'exporttype' => $part_export->exporttype, + #} ); + #foreach my $other_part_export ( @other_part_export ) { + # push @svcparts, map { $_->svcpart } + # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + #} + + #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #silly kludge to avoid uninitialized value errors + my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) + ? $exports->{$part_export->exporttype}{'nodomain'} + : ''; + if ( $nodomain =~ /^Y/i ) { + $conflict_user_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } else { + $conflict_userdomain_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } + } + + 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. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; + } + } + + 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}; + } + } + + foreach my $dup_uid ( @dup_uid ) { + 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 ''; + +} + =item radius Depriciated, use radius_reply instead. @@ -867,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; } @@ -904,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; } @@ -942,7 +1101,58 @@ Returns an email address associated with the account. sub email { my $self = shift; - $self->username. '@'. $self->domain; + $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 + +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 } ); +} + +=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 @@ -1003,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 @@ -1033,6 +1243,120 @@ sub radius_groups { } } +=item clone_suspended + +Constructor used by FS::part_export::_export_suspend fallback. Document +better. + +=cut + +sub clone_suspended { + my $self = shift; + my %hash = $self->hash; + $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); + new FS::svc_acct \%hash; +} + +=item clone_kludge_unsuspend + +Constructor used by FS::part_export::_export_unsuspend fallback. Document +better. + +=cut + +sub clone_kludge_unsuspend { + my $self = shift; + my %hash = $self->hash; + $hash{_password} = ''; + new FS::svc_acct \%hash; +} + +=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. + +Currently supported encryptions are: classic DES crypt() and MD5 + +=cut + +sub check_password { + my($self, $check_password) = @_; + + #remove old-style SUSPENDED kludge, they should be allowed to login to + #self-service and pay up + ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //; + + #eventually should check a "password-encoding" field + if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login + return 0; + } elsif ( length($password) < 13 ) { #plaintext + $check_password eq $password; + } elsif ( length($password) == 13 ) { #traditional DES crypt + crypt($check_password, $password) eq $password; + } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt + unix_md5_crypt($check_password, $password) eq $password; + } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish + warn "Can't check password: Blowfish encryption not yet supported, svcnum". + $self->svcnum. "\n"; + 0; + } else { + warn "Can't check password: Unrecognized encryption for svcnum ". + $self->svcnum. "\n"; + 0; + } + +} + +=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; + } else { + 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"; + } + } +} + +=item virtual_maildir + +Returns $domain/maildirs/$username/ + +=cut + +sub virtual_maildir { + my $self = shift; + $self->domain. '/maildirs/'. $self->username. '/'; +} + =back =head1 SUBROUTINES @@ -1177,7 +1501,7 @@ sub radius_usergroup_selector { END foreach my $group ( @all_groups ) { - $html .= '$group\n); }; $html .= ''; @@ -1208,6 +1532,9 @@ 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) + =head1 SEE ALSO L, edit/part_svc.cgi from an installed web interface,