X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=355573b000e03721bf08d3b51994ae0d9476f01c;hp=991cedd21da025697bc2cf0a5a8875709a296bc1;hb=a176034d4fa386de180b893e00bda36b04251778;hpb=72a65ceaa28155e8c1c3c1328dd76587b35e089a diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 991cedd21..355573b00 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -30,6 +30,8 @@ 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 ); @@ -187,8 +189,7 @@ 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 @@ -535,8 +536,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 @@ -674,10 +675,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, @@ -804,6 +831,15 @@ 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'); @@ -1128,14 +1164,21 @@ Currently supported encryptions are: classic DES crypt() and MD5 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 ( length($self->_password) < 13 ) { #plaintext - $check_password eq $self->_password; - } elsif ( length($self->_password) == 13 ) { #traditional DES crypt - crypt($check_password, $self->_password) eq $self->_password; - } elsif ( $self->_password =~ /^\$1\$/ ) { #MD5 crypt - unix_md5_crypt($check_password, $self->_password) eq $self->_password; - } elsif ( $self->_password =~ /^\$2a?\$/ ) { #Blowfish + 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;