X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=0824fbe3a4922b54fc1c60bae424d9142e0fa290;hb=e8fec5a6dee7e5272715e11eaaec7e873afdbbe4;hp=fce44363454d873106cb49c6e126ee52ffefb0b9;hpb=9a6f36bb2cb5cd349be52874868553491de78f05;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index fce443634..0824fbe3a 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -7,6 +7,7 @@ use vars qw( @ISA $DEBUG $me $conf $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_nounderscore $username_nodash $username_uppercase + $mydomain $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine $radius_password $radius_ip @@ -14,13 +15,16 @@ 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 ); use FS::svc_Common; +use Net::SSH; use FS::cust_svc; use FS::part_svc; use FS::svc_acct_pop; +use FS::svc_acct_sm; use FS::cust_main_invoice; use FS::svc_domain; use FS::raddb; @@ -29,10 +33,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 +58,7 @@ $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'); + $mydomain = $conf->config('domain'); $dirhash = $conf->config('dirhash') || 0; if ( $conf->exists('welcome_email') ) { $welcome_template = new Text::Template ( @@ -176,7 +184,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,23 +193,28 @@ 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. +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'; @@ -314,8 +327,8 @@ sub insert { 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} + return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart} || $conflict_userdomain_svcpart{$dup_svcpart}; } } @@ -325,7 +338,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 +412,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 ) { @@ -427,6 +460,13 @@ The corresponding FS::cust_svc record will be deleted as well. sub delete { my $self = shift; + if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) { + return "Can't delete an account which has (svc_acct_sm) mail aliases!" + if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); + } + + 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 } ); @@ -434,7 +474,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) @@ -505,8 +545,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 @@ -515,6 +555,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, @@ -605,35 +647,30 @@ sub replace { =item suspend -Suspends this account by calling export-specific suspend hooks. If there is -an error, returns the error, otherwise returns false. +Suspends this account by prefixing *SUSPENDED* to the password. 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 by calling export-specific suspend hooks. If there -is an error, returns the error, otherwise returns false. +Unsuspends this account by removing *SUSPENDED* from the password. 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 { @@ -781,6 +818,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'); @@ -796,7 +842,7 @@ sub check { $recref->{slipip} = '0e0'; } else { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ - or return "Illegal slipip: ". $self->slipip; + or return "Illegal slipip". $self->slipip; $recref->{slipip} = $1; } @@ -836,9 +882,21 @@ sub check { ": ". $recref->{_password}; } - $self->SUPER::check; + ''; #no error +} + +=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. @@ -891,7 +949,7 @@ sub radius_check { my $self = shift; my $password = $self->_password; my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; - ( $pw_attrib => $password, + ( $pw_attrib => $self->_password, map { /^(rc_(.*))$/; my($column, $attrib) = ($1, $2); @@ -909,10 +967,14 @@ 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 - or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; - $svc_domain->domain; + if ( $self->domsvc ) { + #$self->svc_domain->domain; + my $svc_domain = $self->svc_domain + or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc; + $svc_domain->domain; + } else { + $mydomain or die "svc_acct.domsvc is null and no legacy domain config file"; + } } =item svc_domain @@ -1025,6 +1087,7 @@ 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 @@ -1055,6 +1118,71 @@ 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; + } + +} + =back =head1 SUBROUTINES @@ -1063,28 +1191,36 @@ sub radius_groups { =item send_email -This is the FS::svc_acct job-queue-able version. It still uses -FS::Misc::send_email under-the-hood. - =cut sub send_email { my %opt = @_; - eval "use FS::Misc qw(send_email)"; - die $@ if $@; + use Date::Format; + use Mail::Internet 1.44; + use Mail::Header; $opt{mimetype} ||= 'text/plain'; $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/; - my $error = send_email( - 'from' => $opt{from}, - 'to' => $opt{to}, - 'subject' => $opt{subject}, - 'content-type' => $opt{mimetype}, - 'body' => [ map "$_\n", split("\n", $opt{body}) ], + $ENV{MAILADDRESS} = $opt{from}; + my $header = new Mail::Header ( [ + "From: $opt{from}", + "To: $opt{to}", + "Sender: $opt{from}", + "Reply-To: $opt{from}", + "Date: ". time2str("%a, %d %b %Y %X %z", time), + "Subject: $opt{subject}", + "Content-Type: $opt{mimetype}", + ] ); + my $message = new Mail::Internet ( + 'Header' => $header, + 'Body' => [ map "$_\n", split("\n", $opt{body}) ], ); - die $error if $error; + $!=0; + $message->smtpsend( Host => $smtpmachine ) + or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) + or die "can't send email to $opt{to} via $smtpmachine with SMTP: $!"; } =item check_and_rebuild_fuzzyfiles @@ -1230,12 +1366,15 @@ 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, export.html from the base documentation, L, L, L, L, L, L, -L), L, +L), L, L, L, schema.html from the base documentation. =cut