X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=991cedd21da025697bc2cf0a5a8875709a296bc1;hp=f8495569ec08a7a85ad4ebdc90f379165d0f7caa;hb=72a65ceaa28155e8c1c3c1328dd76587b35e089a;hpb=fde47ced3934644dc4722d9547e9c4b34a2a2ea0 diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index f8495569e..991cedd21 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -14,9 +14,10 @@ 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 ); +use FS::Record qw( qsearch qsearchs fields dbh dbdef ); use FS::svc_Common; use FS::cust_svc; use FS::part_svc; @@ -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. @@ -188,6 +190,17 @@ 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) +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. + +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!) @@ -196,6 +209,7 @@ sqlradius export only) sub insert { my $self = shift; + my %options = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -220,7 +234,7 @@ sub insert { # '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; @@ -319,7 +333,11 @@ sub insert { #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; @@ -389,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 ) { @@ -421,6 +455,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 } ); @@ -509,6 +545,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, @@ -599,39 +637,26 @@ sub replace { =item suspend -Suspends this account by prefixing *SUSPENDED* to the password. If there is an -error, returns the error, otherwise returns false. +Suspends this account by calling export-specific suspend hooks. If there is +an error, returns the error, otherwise returns false. Called by the suspend method of FS::cust_pkg (see L). -Calls any export-specific suspend hooks. - =cut 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; } =item unsuspend -Unsuspends this account by removing *SUSPENDED* from the password. If there is -an error, returns the error, otherwise returns false. +Unsuspends this account by by calling export-specific suspend hooks. If there +is an error, returns the error, otherwise returns false. Called by the unsuspend method of FS::cust_pkg (see L). -Calls any export-specific unsuspend hooks. - =cut sub unsuspend { @@ -784,7 +809,7 @@ sub check { 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' ) { @@ -823,6 +848,8 @@ sub check { $recref->{_password} = $1.$3; } elsif ( $recref->{_password} eq '*' ) { $recref->{_password} = '*'; + } elsif ( $recref->{_password} eq '!' ) { + $recref->{_password} = '!'; } elsif ( $recref->{_password} eq '!!' ) { $recref->{_password} = '!!'; } else { @@ -835,6 +862,17 @@ sub check { $self->SUPER::check; } +=item _check_system + +=cut + +sub _check_system { + my $self = shift; + scalar( grep { $self->username eq $_ || $self->email eq $_ } + $conf->config('system_usernames') + ); +} + =item radius Depriciated, use radius_reply instead. @@ -947,6 +985,22 @@ sub email { $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 seconds_since TIMESTAMP Returns the number of seconds this account has been online since TIMESTAMP, @@ -1005,6 +1059,18 @@ sub attribute_since_sqlradacct { $self->cust_svc->attribute_since_sqlradacct(@_); } +=item get_session_history_sqlradacct 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 { + my $self = shift; + $self->cust_svc->get_session_history_sqlradacct(@_); +} + =item radius_groups Returns all RADIUS groups for this account (see L). @@ -1023,6 +1089,64 @@ 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) = @_; + #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 + 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 @@ -1198,6 +1322,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,