$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
@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 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;
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
$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 (
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.
defined. An FS::cust_svc record will be created and inserted.
The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
-sqlradius export only)
+contain an arrayref of group names. See L<FS::radius_usergroup>.
+
+The additional field I<child_objects> 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<depend_jobnum>
+
+If I<depend_jobnum> 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<FS::queue> and L<freeside-queued>)
sub insert {
my $self = shift;
+ my %options = @_;
my $error;
local $SIG{HUP} = 'IGNORE';
# '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;
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};
}
}
#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;
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 ) {
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 } );
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)
returns the error, otherwise returns false.
The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names. See L<FS::radius_usergroup>. (used in
-sqlradius export only)
+contain an arrayref of group names. See L<FS::radius_usergroup>.
+
=cut
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,
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;
}
# $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');
$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' ) {
$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;
}
#$recref->{password} = $1.
# crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
#;
- } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,34})$/ ) {
+ } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,60})$/ ) {
$recref->{_password} = $1.$3;
} elsif ( $recref->{_password} eq '*' ) {
$recref->{_password} = '*';
+ } elsif ( $recref->{_password} eq '!' ) {
+ $recref->{_password} = '!';
} elsif ( $recref->{_password} eq '!!' ) {
$recref->{_password} = '!!';
} else {
": ". $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.
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);
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
$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,
$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<FS::radius_usergroup>).
}
}
+=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
=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
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<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
projects / freeside.git / blobdiff