$usernamemax $passwordmin $passwordmax
$username_ampersand $username_letter $username_letterfirst
$username_noperiod $username_nounderscore $username_nodash
- $username_uppercase
+ $username_uppercase $username_percent
$password_noampersand $password_noexclamation
$welcome_template $welcome_from $welcome_subject $welcome_mimetype
$smtpmachine
@saltset @pw_set );
use Carp;
use Fcntl qw(:flock);
+use Date::Format;
use Crypt::PasswdMD5 1.2;
use FS::UID qw( datasrc );
use FS::Conf;
use FS::Record qw( qsearch qsearchs fields dbh dbdef );
+use FS::Msgcat qw(gettext);
use FS::svc_Common;
use FS::cust_svc;
use FS::part_svc;
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;
+use FS::cdr;
@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');
+ $username_percent = $conf->exists('username-percent');
$password_noampersand = $conf->exists('password-noexclamation');
$password_noexclamation = $conf->exists('password-noexclamation');
$dirhash = $conf->config('dirhash') || 0;
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,
- 'domsvc' => $new->domsvc,
- } );
{
#no warnings 'numeric'; #alas, a 5.006-ism
local($^W) = 0;
- return "Can't change uid!" if $old->uid != $new->uid;
+
+ foreach my $xid (qw( uid gid )) {
+
+ return "Can't change $xid!"
+ if ! $conf->exists("svc_acct-edit_$xid")
+ && $old->$xid() != $new->$xid()
+ && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F'
+ }
+
}
#change homdir when we change username
return $error if $error;
$old->usergroup( [ $old->radius_groups ] );
- warn "old groups: ". join(' ',@{$old->usergroup}). "\n" if $DEBUG;
- warn "new groups: ". join(' ',@{$new->usergroup}). "\n" if $DEBUG;
+ if ( $DEBUG ) {
+ warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
+ warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
+ }
if ( $new->usergroup ) {
#(sorta) false laziness with FS::part_export::sqlradius::_export_replace
my @newgroups = @{$new->usergroup};
my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
if ( $username_uppercase ) {
- $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
+ $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i
or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
$recref->{username} = $1;
} else {
- $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
+ $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/
or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
$recref->{username} = $1;
}
if ( $password_noexclamation ) {
$recref->{_password} =~ /\!/ and return gettext('illegal_password');
}
+ unless ( $username_percent ) {
+ $recref->{username} =~ /\%/ and return gettext('illegal_username');
+ }
$recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
$recref->{popnum} = $1;
if $recref->{uid} == 0
&& $recref->{username} !~ /^(root|toor|smtp)$/;
+ unless ( $recref->{username} eq 'sync' ) {
+ if ( grep $_ eq $recref->{shell}, @shells ) {
+ $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
+ } else {
+ return "Illegal shell \`". $self->shell. "\'; ".
+ $conf->dir. "/shells contains: @shells";
+ }
+ } else {
+ $recref->{shell} = '/bin/sync';
+ }
+
+ } else {
+ $recref->{gid} ne '' ?
+ return "Can't have gid without uid" : ( $recref->{gid}='' );
+ #$recref->{dir} ne '' ?
+ # return "Can't have directory without uid" : ( $recref->{dir}='' );
+ $recref->{shell} ne '' ?
+ return "Can't have shell without uid" : ( $recref->{shell}='' );
+ }
+
+ unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) {
+
$recref->{dir} =~ /^([\/\w\-\.\&]*)$/
or return "Illegal directory: ". $recref->{dir};
$recref->{dir} = $1;
;
}
- unless ( $recref->{username} eq 'sync' ) {
- if ( grep $_ eq $recref->{shell}, @shells ) {
- $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
- } else {
- return "Illegal shell \`". $self->shell. "\'; ".
- $conf->dir. "/shells contains: @shells";
- }
- } else {
- $recref->{shell} = '/bin/sync';
- }
-
- } else {
- $recref->{gid} ne '' ?
- return "Can't have gid without uid" : ( $recref->{gid}='' );
- $recref->{dir} ne '' ?
- return "Can't have directory without uid" : ( $recref->{dir}='' );
- $recref->{shell} ne '' ?
- return "Can't have shell without uid" : ( $recref->{shell}='' );
}
# $error = $self->ut_textn('finger');
sub radius_reply {
my $self = shift;
+
+ return %{ $self->{'radius_reply'} }
+ if exists $self->{'radius_reply'};
+
my %reply =
map {
/^(radius_(.*))$/;
#$attrib =~ s/_/\-/g;
( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
} grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
+
if ( $self->slipip && $self->slipip ne '0e0' ) {
$reply{$radius_ip} = $self->slipip;
}
+
if ( $self->seconds !~ /^$/ ) {
$reply{'Session-Timeout'} = $self->seconds;
}
+
%reply;
}
sub radius_check {
my $self = shift;
- my $password = $self->_password;
- my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';
- ( $pw_attrib => $password,
+
+ return %{ $self->{'radius_check'} }
+ if exists $self->{'radius_check'};
+
+ my %check =
map {
/^(rc_(.*))$/;
my($column, $attrib) = ($1, $2);
#$attrib =~ s/_/\-/g;
( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
- } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
- );
+ } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
+
+ my $password = $self->_password;
+ my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password;
+
+ my $cust_svc = $self->cust_svc;
+ die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
+ unless $cust_svc;
+ my $cust_pkg = $cust_svc->cust_pkg;
+ if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
+ $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
+ }
+
+ %check;
+
+}
+
+=item snapshot
+
+This method instructs the object to "snapshot" or freeze RADIUS check and
+reply attributes to the current values.
+
+=cut
+
+#bah, my english is too broken this morning
+#Of note is the "Expiration" attribute, which, for accounts in prepaid packages, is typically defined on-the-fly as the associated packages cust_pkg.bill. (This is used by
+#the FS::cust_pkg's replace method to trigger the correct export updates when
+#package dates change)
+
+sub snapshot {
+ my $self = shift;
+
+ $self->{$_} = { $self->$_() }
+ foreach qw( radius_reply radius_check );
+
+}
+
+=item forget_snapshot
+
+This methos instructs the object to forget any previously snapshotted
+RADIUS check and reply attributes.
+
+=cut
+
+sub forget_snapshot {
+ my $self = shift;
+
+ delete $self->{$_}
+ foreach qw( radius_reply radius_check );
+
}
=item domain
=cut
-sub cust_svc {
- my $self = shift;
- qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
-}
+#inherited from svc_Common
=item email
qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
}
+=item decrement_seconds SECONDS
+
+Decrements the I<seconds> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub decrement_seconds {
+ shift->_op_seconds('-', @_);
+}
+
+=item increment_seconds SECONDS
+
+Increments the I<seconds> field of this record by the given amount. If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub increment_seconds {
+ shift->_op_seconds('+', @_);
+}
+
+
+my %op2action = (
+ '-' => 'suspend',
+ '+' => 'unsuspend',
+);
+my %op2condition = (
+ '-' => sub { my($self, $seconds) = @_;
+ $self->seconds - $seconds <= 0;
+ },
+ '+' => sub { my($self, $seconds) = @_;
+ $self->seconds + $seconds > 0;
+ },
+);
+
+sub _op_seconds {
+ my( $self, $op, $seconds ) = @_;
+ warn "$me _op_seconds called for svcnum ". $self->svcnum.
+ ' ('. $self->email. "): $op $seconds\n"
+ if $DEBUG;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $sql = "UPDATE svc_acct SET seconds = ".
+ " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0
+ " $op ? WHERE svcnum = ?";
+ warn "$me $sql\n"
+ if $DEBUG;
+
+ my $sth = $dbh->prepare( $sql )
+ or die "Error preparing $sql: ". $dbh->errstr;
+ my $rv = $sth->execute($seconds, $self->svcnum);
+ die "Error executing $sql: ". $sth->errstr
+ unless defined($rv);
+ die "Can't update seconds for svcnum". $self->svcnum
+ if $rv == 0;
+
+ my $action = $op2action{$op};
+
+ if ( $conf->exists("svc_acct-usage_$action")
+ && &{$op2condition{$op}}($self, $seconds) ) {
+ #my $error = $self->$action();
+ my $error = $self->cust_svc->cust_pkg->$action();
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error ${action}ing: $error";
+ }
+ }
+
+ warn "$me update successful; committing\n"
+ if $DEBUG;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
+
=item seconds_since TIMESTAMP
Returns the number of seconds this account has been online since TIMESTAMP,
$self->cust_svc->get_session_history(@_);
}
+=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
+
+=cut
+
+sub get_cdrs {
+ my($self, $start, $end, %opt ) = @_;
+
+ my $did = $self->username; #yup
+
+ my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
+
+ my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
+
+ #SELECT $for_update * FROM cdr
+ # WHERE calldate >= $start #need a conversion
+ # AND calldate < $end #ditto
+ # AND ( charged_party = "$did"
+ # OR charged_party = "$prefix$did" #if length($prefix);
+ # OR ( ( charged_party IS NULL OR charged_party = '' )
+ # AND
+ # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
+ # )
+ # )
+ # AND ( freesidestatus IS NULL OR freesidestatus = '' )
+
+ my $charged_or_src;
+ if ( length($prefix) ) {
+ $charged_or_src =
+ " AND ( charged_party = '$did'
+ OR charged_party = '$prefix$did'
+ OR ( ( charged_party IS NULL OR charged_party = '' )
+ AND
+ ( src = '$did' OR src = '$prefix$did' )
+ )
+ )
+ ";
+ } else {
+ $charged_or_src =
+ " AND ( charged_party = '$did'
+ OR ( ( charged_party IS NULL OR charged_party = '' )
+ AND
+ src = '$did'
+ )
+ )
+ ";
+
+ }
+
+ qsearch(
+ 'select' => "$for_update *",
+ 'table' => 'cdr',
+ 'hashref' => {
+ #( freesidestatus IS NULL OR freesidestatus = '' )
+ 'freesidestatus' => '',
+ },
+ 'extra_sql' => $charged_or_src,
+
+ );
+
+}
+
=item radius_groups
Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
=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.
+database. Returns true for a successful authentication, false for no match.
Currently supported encryptions are: classic DES crypt() and MD5
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 =~ /^\$(1|2a?)\$/
+ || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
+ )
+ {
$self->_password;
} else {
- my $encryption = scalar(@_) ? shift : 'crypt';
+ my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
if ( $encryption eq 'crypt' ) {
crypt(
$self->_password,
projects / freeside.git / blobdiff