diff options
Diffstat (limited to 'FS/FS/svc_acct.pm')
| -rw-r--r-- | FS/FS/svc_acct.pm | 83 | 
1 files changed, 55 insertions, 28 deletions
| diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 9d8566d77..8c99c9e48 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 @@ -18,9 +19,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; @@ -51,6 +54,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 ( @@ -314,8 +318,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};        }      } @@ -427,6 +431,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!" @@ -609,11 +618,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<FS::cust_pkg>). +Calls any export-specific suspend hooks. +  =cut  sub suspend { @@ -624,11 +635,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<FS::cust_pkg>). +Calls any export-specific unsuspend hooks. +  =cut  sub unsuspend { @@ -791,7 +804,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;      } @@ -831,13 +844,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 $_ } @@ -845,6 +858,7 @@ sub _check_system {          );  } +  =item radius  Depriciated, use radius_reply instead. @@ -897,7 +911,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); @@ -915,10 +929,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 @@ -1031,6 +1049,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 @@ -1069,28 +1088,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 @@ -1241,7 +1268,7 @@ probably live somewhere else...  L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,  export.html from the base documentation, L<FS::Record>, L<FS::Conf>,  L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, -L<freeside-queued>), L<FS::svc_acct_pop>, +L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,  schema.html from the base documentation.  =cut | 
