X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=100af6cb644fd6a099cfb8b6528cac1cfee43508;hp=32d87202eba7024c910fb028f6ccd896236acc77;hb=6af03ca1ad3c06aa1e7affb634bb0640b139dd6d;hpb=b5fa7c0c1953139f1fbe0dabf3930871646016b8 diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 32d87202e..100af6cb6 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -14,6 +14,7 @@ use vars qw( @ISA $DEBUG $me $conf @saltset @pw_set ); use Carp; use Fcntl qw(:flock); +use Crypt::PasswdMD5; use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); @@ -33,6 +34,7 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); $DEBUG = 0; +#$DEBUG = 1; $me = '[FS::svc_acct]'; #ask FS::UID to run this stuff for us later @@ -176,7 +178,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. @@ -193,15 +195,21 @@ 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. +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) (TODOC: new exports!) - =cut sub insert { my $self = shift; + my %options = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -325,7 +333,11 @@ sub insert { #see? i told you it was more complicated my @jobnums; - $error = $self->SUPER::insert(\@jobnums, $self->child_objects || [] ); + $error = $self->SUPER::insert( + 'jobnums' => \@jobnums, + 'child_objects' => $self->child_objects, + %options, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -395,6 +407,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 ) { @@ -646,10 +674,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, @@ -1089,6 +1143,43 @@ sub clone_kludge_unsuspend { 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; + } + +} + =back =head1 SUBROUTINES @@ -1264,6 +1355,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,