X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=806e793eafd67bf06aa528a6e53459388d984858;hb=3362fbec6c7bcf31004683dc9afe4c3110acd309;hp=6ea30437ad7e17fc1b9bbc6cf282ef3e29bb1a62;hpb=9e9e7407e7e8c5a94c27609145ee65205f984ac5;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 6ea30437a..806e793ea 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 @@ -19,9 +20,11 @@ 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; @@ -55,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 ( @@ -245,7 +249,7 @@ sub insert { $self->svcpart($cust_svc->svcpart); } - #new duplicate username checking + #new duplicate username/username@domain/uid checking my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); unless ( $part_svc ) { @@ -272,8 +276,7 @@ sub insert { 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 }); + my @svcparts = map { $_->svcpart } $part_export->export_svc; #this will catch to exports w/same exporthost+type ??? #my @other_part_export = qsearch('part_export', { @@ -323,8 +326,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}; } } @@ -456,6 +459,11 @@ 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!" @@ -465,7 +473,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) @@ -638,11 +646,13 @@ 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 { @@ -653,11 +663,13 @@ sub 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 { @@ -675,35 +687,9 @@ sub unsuspend { =item cancel -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; -} +Just returns false (no error) for now. +Called by the cancel method of FS::cust_pkg (see L). =item check @@ -855,7 +841,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; } @@ -895,13 +881,13 @@ 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 $_ } @@ -909,6 +895,7 @@ sub _check_system { ); } + =item radius Depriciated, use radius_reply instead. @@ -961,7 +948,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); @@ -979,10 +966,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 @@ -1095,6 +1086,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 @@ -1190,39 +1182,6 @@ sub check_password { } -=item crypt_password - -Returns an encrypted password, either by passing through an encrypted password -in the database or by encrypting a plaintext password from 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 { - crypt( - $self->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] - ); - } -} - -=item virtual_maildir - -Returns $domain/maildirs/$username/ - -=cut - -sub virtual_maildir { - my $self = shift; - $self->domain. '/maildirs/'. $self->username. '/'; -} - =back =head1 SUBROUTINES @@ -1231,28 +1190,36 @@ sub virtual_maildir { =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 @@ -1406,7 +1373,7 @@ insertion of RADIUS group stuff in insert could be done with child_objects now 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