$usernamemax $passwordmin $passwordmax
$username_ampersand $username_letter $username_letterfirst
$username_noperiod $username_nounderscore $username_nodash
- $username_uppercase $username_percent
+ $username_uppercase $username_percent $username_colon
$password_noampersand $password_noexclamation
+ $welcome_template $welcome_from
+ $welcome_subject $welcome_subject_template $welcome_mimetype
$warning_template $warning_from $warning_subject $warning_mimetype
$warning_cc
$smtpmachine
$radius_password $radius_ip
$dirhash
@saltset @pw_set );
+use Math::BigInt;
use Carp;
use Fcntl qw(:flock);
use Date::Format;
use Crypt::PasswdMD5 1.2;
use Data::Dumper;
-use Authen::Passphrase;
-use FS::UID qw( datasrc );
+use Text::Template;
+use FS::UID qw( datasrc driver_name );
use FS::Conf;
use FS::Record qw( qsearch qsearchs fields dbh dbdef );
use FS::Msgcat qw(gettext);
+use FS::UI::bytecount;
+use FS::part_pkg;
use FS::svc_Common;
use FS::cust_svc;
use FS::part_svc;
@ISA = qw( FS::svc_Common );
-$DEBUG = 1;
+$DEBUG = 0;
$me = '[FS::svc_acct]';
#ask FS::UID to run this stuff for us later
$username_uppercase = $conf->exists('username-uppercase');
$username_ampersand = $conf->exists('username-ampersand');
$username_percent = $conf->exists('username-percent');
+ $username_colon = $conf->exists('username-colon');
$password_noampersand = $conf->exists('password-noexclamation');
$password_noexclamation = $conf->exists('password-noexclamation');
$dirhash = $conf->config('dirhash') || 0;
+ if ( $conf->exists('welcome_email') ) {
+ $welcome_template = new Text::Template (
+ TYPE => 'ARRAY',
+ SOURCE => [ map "$_\n", $conf->config('welcome_email') ]
+ ) or warn "can't create welcome email template: $Text::Template::ERROR";
+ $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum'
+ $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome';
+ $welcome_subject_template = new Text::Template (
+ TYPE => 'STRING',
+ SOURCE => $welcome_subject,
+ ) or warn "can't create welcome email subject template: $Text::Template::ERROR";
+ $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain';
+ } else {
+ $welcome_template = '';
+ $welcome_from = '';
+ $welcome_subject = '';
+ $welcome_mimetype = '';
+ }
if ( $conf->exists('warning_email') ) {
$warning_template = new Text::Template (
TYPE => 'ARRAY',
$smtpmachine = $conf->config('smtpmachine');
$radius_password = $conf->config('radius-password') || 'Password';
$radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
+ @pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps');
};
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
=item _password - generated if blank
-=item _password_encoding - plain, crypt, ldap (or empty for autodetection)
-
=item sec_phrase - security phrase
=item popnum - Point of presence (see L<FS::svc_acct_pop>)
{
'name' => 'Account',
'longname_plural' => 'Access accounts and mailboxes',
- 'sorts' => [ 'username', 'uid', ],
+ 'sorts' => [ 'username', 'uid', 'last_login', ],
'display_weight' => 10,
'cancel_weight' => 50,
'fields' => {
disable_inventory => 1,
disable_select => 1,
},
- 'finger' => 'Real name (GECOS)',
+ 'finger' => 'Real name', # (GECOS)',
'domsvc' => {
label => 'Domain',
#def_label => 'svcnum from svc_domain',
type => 'text',
disable_inventory => 1,
disable_select => 1,
+ disable_part_svc_column => 1,
+ },
+ 'upbytes' => { label => 'Upload',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ 'format' => \&FS::UI::bytecount::display_bytecount,
+ 'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
},
+ 'downbytes' => { label => 'Download',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ 'format' => \&FS::UI::bytecount::display_bytecount,
+ 'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
+ },
+ 'totalbytes'=> { label => 'Total up and download',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ 'format' => \&FS::UI::bytecount::display_bytecount,
+ 'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
+ },
+ 'seconds_threshold' => { label => 'Seconds threshold',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ disable_part_svc_column => 1,
+ },
+ 'upbytes_threshold' => { label => 'Upload threshold',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ 'format' => \&FS::UI::bytecount::display_bytecount,
+ 'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
+ },
+ 'downbytes_threshold' => { label => 'Download threshold',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ 'format' => \&FS::UI::bytecount::display_bytecount,
+ 'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
+ },
+ 'totalbytes_threshold'=> { label => 'Total up and download threshold',
+ type => 'text',
+ disable_inventory => 1,
+ disable_select => 1,
+ 'format' => \&FS::UI::bytecount::display_bytecount,
+ 'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
+ },
+ 'last_login'=> {
+ label => 'Last login',
+ type => 'disabled',
+ },
+ 'last_logout'=> {
+ label => 'Last logout',
+ type => 'disabled',
+ },
},
};
}
};
}
+sub last_login {
+ shift->_lastlog('in', @_);
+}
+
+sub last_logout {
+ shift->_lastlog('out', @_);
+}
+
+sub _lastlog {
+ my( $self, $op, $time ) = @_;
+
+ if ( defined($time) ) {
+ warn "$me last_log$op called on svcnum ". $self->svcnum.
+ ' ('. $self->email. "): $time\n"
+ if $DEBUG;
+
+ my $dbh = dbh;
+
+ my $sql = "UPDATE svc_acct SET last_log$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($time, $self->svcnum);
+ die "Error executing $sql: ". $sth->errstr
+ unless defined($rv);
+ die "Can't update last_log$op for svcnum". $self->svcnum
+ if $rv == 0;
+
+ $self->{'Hash'}->{"last_log$op"} = $time;
+ }else{
+ $self->getfield("last_log$op");
+ }
+}
+
=item search_sql STRING
Class method which returns an SQL fragment to search for the given string.
$self->email(@_);
}
+=item label_long [ END_TIMESTAMP [ START_TIMESTAMP ] ]
+
+Returns a longer string label for this acccount ("Real Name <username@domain>"
+if available, or "username@domain").
+
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
=cut
+sub label_long {
+ my $self = shift;
+ my $label = $self->label(@_);
+ my $finger = $self->finger;
+ return $label unless $finger =~ /\S/;
+ my $maxlen = 40 - length($label) - length($self->cust_svc->part_svc->svc);
+ $finger = substr($finger, 0, $maxlen-3).'...' if length($finger) > $maxlen;
+ "$finger <$label>";
+}
+
=item insert [ , OPTION => VALUE ... ]
Adds this account to the database. If there is an error, returns the error,
return $error;
}
+ # set usage fields and thresholds if unset but set in a package def
+ if ( $self->pkgnum ) {
+ my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+ my $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
+ if ( $part_pkg && $part_pkg->can('usage_valuehash') ) {
+
+ my %values = $part_pkg->usage_valuehash;
+ my $multiplier = $conf->exists('svc_acct-usage_threshold')
+ ? 1 - $conf->config('svc_acct-usage_threshold')/100
+ : 0.20; #doesn't matter
+
+ foreach ( keys %values ) {
+ next if $self->getfield($_);
+ $self->setfield( $_, $values{$_} );
+ $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) )
+ if $conf->exists('svc_acct-usage_threshold');
+ }
+
+ }
+ }
+
my @jobnums;
$error = $self->SUPER::insert(
'jobnums' => \@jobnums,
if ( $cust_pkg ) {
my $cust_main = $cust_pkg->cust_main;
- my $agentnum = $cust_main->agentnum;
if ( $conf->exists('emailinvoiceautoalways')
|| $conf->exists('emailinvoiceauto')
}
#welcome email
- my ($to,$welcome_template,$welcome_from,$welcome_subject,$welcome_subject_template,$welcome_mimetype)
- = ('','','','','','');
-
- if ( $conf->exists('welcome_email', $agentnum) ) {
- $welcome_template = new Text::Template (
- TYPE => 'ARRAY',
- SOURCE => [ map "$_\n", $conf->config('welcome_email', $agentnum) ]
- ) or warn "can't create welcome email template: $Text::Template::ERROR";
- $welcome_from = $conf->config('welcome_email-from', $agentnum);
- # || 'your-isp-is-dum'
- $welcome_subject = $conf->config('welcome_email-subject', $agentnum)
- || 'Welcome';
- $welcome_subject_template = new Text::Template (
- TYPE => 'STRING',
- SOURCE => $welcome_subject,
- ) or warn "can't create welcome email subject template: $Text::Template::ERROR";
- $welcome_mimetype = $conf->config('welcome_email-mimetype', $agentnum)
- || 'text/plain';
- }
+ my $to = '';
if ( $welcome_template && $cust_pkg ) {
my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
if ( $to ) {
}
}
+ my $error = $self->SUPER::delete;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
foreach my $radius_usergroup (
qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
) {
}
}
- my $error = $self->SUPER::delete;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
-
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
}
|| $self->ut_snumbern('upbytes')
|| $self->ut_snumbern('downbytes')
|| $self->ut_snumbern('totalbytes')
- || $self->ut_enum( '_password_encoding',
- [ '', qw( plain crypt ldap ) ]
- )
;
return $error if $error;
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;
}
unless ( $username_ampersand ) {
$recref->{username} =~ /\&/ and return gettext('illegal_username');
}
+ if ( $password_noampersand ) {
+ $recref->{_password} =~ /\&/ and return gettext('illegal_password');
+ }
+ if ( $password_noexclamation ) {
+ $recref->{_password} =~ /\!/ and return gettext('illegal_password');
+ }
unless ( $username_percent ) {
$recref->{username} =~ /\%/ and return gettext('illegal_username');
}
+ unless ( $username_colon ) {
+ $recref->{username} =~ /\:/ and return gettext('illegal_username');
+ }
$recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
$recref->{popnum} = $1;
$recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
} else {
return "Illegal shell \`". $self->shell. "\'; ".
- "shells configuration value contains: @shells";
+ $conf->dir. "/shells contains: @shells";
}
} else {
$recref->{shell} = '/bin/sync';
$self->ut_textn($_);
}
- if ( $recref->{_password_encoding} eq 'ldap' ) {
-
- if ( $recref->{_password} =~ /^(\{[\w\-]+\})(!?.{0,64})$/ ) {
- $recref->{_password} = uc($1).$2;
- } else {
- return 'Illegal (ldap-encoded) password: '. $recref->{_password};
- }
-
- } elsif ( $recref->{_password_encoding} eq 'crypt' ) {
-
- if ( $recref->{_password} =~
- #/^(\$\w+\$.*|[\w\+\/]{13}|_[\w\+\/]{19}|\*)$/
- /^(!!?)?(\$\w+\$.*|[\w\+\/]{13}|_[\w\+\/]{19}|\*)$/
- ) {
-
- $recref->{_password} = $1.$2;
-
- } else {
- return 'Illegal (crypt-encoded) password';
- }
-
- } elsif ( $recref->{_password_encoding} eq 'plain' ) {
-
- #generate a password if it is blank
- $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
- unless length( $recref->{_password} );
-
- if ( $recref->{_password} =~ /^([^\t\n]{$passwordmin,$passwordmax})$/ ) {
- $recref->{_password} = $1;
- } else {
- return gettext('illegal_password'). " $passwordmin-$passwordmax ".
- FS::Msgcat::_gettext('illegal_password_characters').
- ": ". $recref->{_password};
- }
-
- if ( $password_noampersand ) {
- $recref->{_password} =~ /\&/ and return gettext('illegal_password');
- }
- if ( $password_noexclamation ) {
- $recref->{_password} =~ /\!/ and return gettext('illegal_password');
- }
-
+ #generate a password if it is blank
+ $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
+ unless ( $recref->{_password} );
+
+ #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
+ if ( $recref->{_password} =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
+ $recref->{_password} = $1.$3;
+ #uncomment this to encrypt password immediately upon entry, or run
+ #bin/crypt_pw in cron to give new users a window during which their
+ #password is available to techs, for faxing, etc. (also be aware of
+ #radius issues!)
+ #$recref->{password} = $1.
+ # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
+ #;
+ } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/ ) {
+ $recref->{_password} = $1.$3;
+ } elsif ( $recref->{_password} eq '*' ) {
+ $recref->{_password} = '*';
+ } elsif ( $recref->{_password} eq '!' ) {
+ $recref->{_password} = '!';
+ } elsif ( $recref->{_password} eq '!!' ) {
+ $recref->{_password} = '!!';
} else {
-
- #carp "warning: _password_encoding unspecified\n";
-
- #generate a password if it is blank
- unless ( length( $recref->{_password} ) ) {
-
- $recref->{_password} =
- join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
- $recref->{_password_encoding} = 'plain';
-
- } else {
-
- #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
- if ( $recref->{_password} =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
- $recref->{_password} = $1.$3;
- $recref->{_password_encoding} = 'plain';
- } elsif ( $recref->{_password} =~
- /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/
- ) {
- $recref->{_password} = $1.$3;
- $recref->{_password_encoding} = 'crypt';
- } elsif ( $recref->{_password} eq '*' ) {
- $recref->{_password} = '*';
- $recref->{_password_encoding} = 'crypt';
- } elsif ( $recref->{_password} eq '!' ) {
- $recref->{_password_encoding} = 'crypt';
- $recref->{_password} = '!';
- } elsif ( $recref->{_password} eq '!!' ) {
- $recref->{_password} = '!!';
- $recref->{_password_encoding} = 'crypt';
- } else {
- #return "Illegal password";
- return gettext('illegal_password'). " $passwordmin-$passwordmax ".
- FS::Msgcat::_gettext('illegal_password_characters').
- ": ". $recref->{_password};
- }
-
- }
-
+ #return "Illegal password";
+ return gettext('illegal_password'). " $passwordmin-$passwordmax ".
+ FS::Msgcat::_gettext('illegal_password_characters').
+ ": ". $recref->{_password};
}
$self->SUPER::check;
-
}
=item _check_system
my $global_unique = $conf->config('global_unique-username') || 'none';
return '' if $global_unique eq 'disabled';
- #this is Pg-specific. what to do for mysql etc?
- # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
warn "$me locking svc_acct table for duplicate search" if $DEBUG;
- dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
- or die dbh->errstr;
+ if ( driver_name =~ /^Pg/i ) {
+ dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
+ or die dbh->errstr;
+ } elsif ( driver_name =~ /^mysql/i ) {
+ dbh->do("SELECT * FROM duplicate_lock
+ WHERE lockname = 'svc_acct'
+ FOR UPDATE"
+ ) or die dbh->errstr;
+ } else {
+ die "unknown database ". driver_name.
+ "; don't know how to lock for duplicate search";
+ }
warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
foreach my $dup_user ( @dup_user ) {
my $dup_svcpart = $dup_user->cust_svc->svcpart;
if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
- return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
+ return "duplicate username ". $self->username.
+ ": conflicts with svcnum ". $dup_user->svcnum.
" via exportnum ". $conflict_user_svcpart{$dup_svcpart};
}
}
foreach my $dup_userdomain ( @dup_userdomain ) {
my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- return "duplicate username\@domain: conflicts with svcnum ".
- $dup_userdomain->svcnum. " via exportnum ".
- $conflict_userdomain_svcpart{$dup_svcpart};
+ return "duplicate username\@domain ". $self->email.
+ ": conflicts with svcnum ". $dup_userdomain->svcnum.
+ " via exportnum ". $conflict_userdomain_svcpart{$dup_svcpart};
}
}
my $dup_svcpart = $dup_uid->cust_svc->svcpart;
if ( exists($conflict_user_svcpart{$dup_svcpart})
|| exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
- " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
- || $conflict_userdomain_svcpart{$dup_svcpart};
+ return "duplicate uid ". $self->uid.
+ ": conflicts with svcnum ". $dup_uid->svcnum.
+ " via exportnum ".
+ ( $conflict_user_svcpart{$dup_svcpart}
+ || $conflict_userdomain_svcpart{$dup_svcpart} );
}
}
$reply{'Session-Timeout'} = $self->seconds;
}
+ if ( $conf->exists('radius-chillispot-max') ) {
+ #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot
+
+ #hmm. just because sqlradius.pm says so?
+ my %whatis = (
+ 'input' => 'up',
+ 'output' => 'down',
+ 'total' => 'total',
+ );
+
+ foreach my $what (qw( input output total )) {
+ my $is = $whatis{$what}.'bytes';
+ if ( $self->$is() =~ /\d/ ) {
+ my $big = new Math::BigInt $self->$is();
+ $big = new Math::BigInto '0' if $big->is_neg();
+ my $att = "Chillispot-Max-\u$what";
+ $reply{"$att-Octets"} = $big->copy->band(0xffffffff)->bstr;
+ $reply{"$att-Gigawords"} = $big->copy->brsft(32)->bstr;
+ }
+ }
+
+ }
+
%reply;
}
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
+ if ( $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
+ }
+ } else {
+ warn "WARNING: no cust_svc record for svc_acct.svcnum ". $self->svcnum.
+ "; can't set Expiration\n"
+ unless $cust_svc;
}
%check;
$self->$column - $amount <= 0;
},
'+' => sub { my($self, $column, $amount) = @_;
- $self->$column + $amount > 0;
+ ($self->$column || 0) + $amount > 0;
},
);
my %op2warncondition = (
$self->$column - $amount <= $self->$threshold + 0;
},
'+' => sub { my($self, $column, $amount) = @_;
- $self->$column + $amount > 0;
+ ($self->$column || 0) + $amount > 0;
},
);
die "Can't update $column for svcnum". $self->svcnum
if $rv == 0;
+ #$self->snapshot; #not necessary, we retain the old values
+ #create an object with the updated usage values
+ my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+ #call exports
+ my $error = $new->replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing: $error";
+ }
+
+ #overlimit_action eq 'cancel' handling
+ my $cust_pkg = $self->cust_svc->cust_pkg;
+ if ( $cust_pkg
+ && $cust_pkg->part_pkg->option('overlimit_action', 1) eq 'cancel'
+ && $op eq '-' && &{$op2condition{$op}}($self, $column, $amount)
+ )
+ {
+
+ my $error = $cust_pkg->cancel; #XXX should have a reason
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling: $error";
+ }
+
+ #nothing else is relevant if we're cancelling, so commit & return success
+ warn "$me update successful; committing\n"
+ if $DEBUG;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+
+ }
+
my $action = $op2action{$op};
- if ( &{$op2condition{$op}}($self, $column, $amount) ) {
+ if ( &{$op2condition{$op}}($self, $column, $amount) &&
+ ( $action eq 'suspend' && !$self->overlimit
+ || $action eq 'unsuspend' && $self->overlimit )
+ ) {
foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
if ($part_export->option('overlimit_groups')) {
my ($new,$old);
$new = $self; $old = $other;
}
my $error = $part_export->export_replace($new, $old);
+ $error ||= $self->overlimit($action);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "Error replacing radius groups in export, ${op}: $error";
&& &{$op2condition{$op}}($self, $column, $amount) ) {
#my $error = $self->$action();
my $error = $self->cust_svc->cust_pkg->$action();
+ # $error ||= $self->overlimit($action);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "Error ${action}ing: $error";
}
sub set_usage {
- my( $self, $valueref ) = @_;
+ my( $self, $valueref, %options ) = @_;
warn "$me set_usage called for svcnum ". $self->svcnum.
' ('. $self->email. "): ".
my $reset = 0;
my %handyhash = ();
+ if ( $options{null} ) {
+ %handyhash = ( map { ( $_ => 'NULL', $_."_threshold" => 'NULL' ) }
+ qw( seconds upbytes downbytes totalbytes )
+ );
+ }
foreach my $field (keys %$valueref){
$reset = 1 if $valueref->{$field};
$self->setfield($field, $valueref->{$field});
#die $error if $error; #services not explicity changed via the UI
my $sql = "UPDATE svc_acct SET " .
- join (',', map { "$_ = ?" } (keys %handyhash) ).
- " WHERE svcnum = ?";
+ join (',', map { "$_ = $handyhash{$_}" } (keys %handyhash) ).
+ " WHERE svcnum = ". $self->svcnum;
warn "$me $sql\n"
if $DEBUG;
if (scalar(keys %handyhash)) {
my $sth = $dbh->prepare( $sql )
or die "Error preparing $sql: ". $dbh->errstr;
- my $rv = $sth->execute((grep{$_} values %handyhash), $self->svcnum);
+ my $rv = $sth->execute();
die "Error executing $sql: ". $sth->errstr
unless defined($rv);
die "Can't update usage for svcnum ". $self->svcnum
if $rv == 0;
}
- if ( $conf->exists("svc_acct-usage_unsuspend") && $reset ) {
- my $error = $self->cust_svc->cust_pkg->unsuspend;
+ #$self->snapshot; #not necessary, we retain the old values
+ #create an object with the updated usage values
+ my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+ #call exports
+ my $error = $new->replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing: $error";
+ }
+
+ if ( $reset ) {
+ my $error;
+
+ if ($self->overlimit) {
+ $error = $self->overlimit('unsuspend');
+ foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
+ if ($part_export->option('overlimit_groups')) {
+ my $old = new FS::svc_acct $self->hashref;
+ my $groups = &{ $self->_fieldhandlers->{'usergroup'} }
+ ($self, $part_export->option('overlimit_groups'));
+ $old->usergroup( $groups );
+ $error ||= $part_export->export_replace($self, $old);
+ }
+ }
+ }
+
+ if ( $conf->exists("svc_acct-usage_unsuspend")) {
+ $error ||= $self->cust_svc->cust_pkg->unsuspend;
+ }
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "Error unsuspending: $error";
$self->cust_svc->get_session_history(@_);
}
+=item last_login_text
+
+Returns text describing the time of last login.
+
+=cut
+
+sub last_login_text {
+ my $self = shift;
+ $self->last_login ? ctime($self->last_login) : 'unknown';
+}
+
=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
=cut
#self-service and pay up
( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
- if ( $self->_password_encoding eq 'ldap' ) {
-
- my $auth = from_rfc2307 Authen::Passphrase $self->_password;
- return $auth->match($check_password);
-
- } elsif ( $self->_password_encoding eq 'crypt' ) {
-
- my $auth = from_crypt Authen::Passphrase $self->_password;
- return $auth->match($check_password);
-
- } elsif ( $self->_password_encoding eq 'plain' ) {
-
- return $check_password eq $password;
-
+ #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 {
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
- 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;
- }
-
+ warn "Can't check password: Unrecognized encryption for svcnum ".
+ $self->svcnum. "\n";
+ 0;
}
}
sub crypt_password {
my $self = shift;
-
- if ( $self->_password_encoding eq 'ldap' ) {
-
- if ( $self->_password =~ /^\{(PLAIN|CLEARTEXT)\}(.+)$/ ) {
- my $plain = $2;
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
- my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
- if ( $encryption eq 'crypt' ) {
- crypt(
- $self->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
- } elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
- } elsif ( $encryption eq 'blowfish' ) {
- croak "unknown encryption method $encryption";
- } else {
- croak "unknown encryption method $encryption";
- }
-
- } elsif ( $self->_password =~ /^\{CRYPT\}(.+)$/ ) {
- $1;
- }
-
- } elsif ( $self->_password_encoding eq 'crypt' ) {
-
- return $self->_password;
-
- } elsif ( $self->_password_encoding eq 'plain' ) {
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
+ #eventually should check a "password-encoding" field
+ if ( length($self->_password) == 13
+ || $self->_password =~ /^\$(1|2a?)\$/
+ || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
+ )
+ {
+ $self->_password;
+ } else {
my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
if ( $encryption eq 'crypt' ) {
crypt(
} else {
croak "unknown encryption method $encryption";
}
-
- } else {
-
- if ( length($self->_password) == 13
- || $self->_password =~ /^\$(1|2a?)\$/
- || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
- )
- {
- $self->_password;
- } else {
-
- #XXX this could be replaced with Authen::Passphrase stuff
-
- my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
- if ( $encryption eq 'crypt' ) {
- crypt(
- $self->_password,
- $saltset[int(rand(64))].$saltset[int(rand(64))]
- );
- } elsif ( $encryption eq 'md5' ) {
- unix_md5_crypt( $self->_password );
- } elsif ( $encryption eq 'blowfish' ) {
- croak "unknown encryption method $encryption";
- } else {
- croak "unknown encryption method $encryption";
- }
-
- }
-
}
-
}
=item ldap_password [ DEFAULT_ENCRYPTION_TYPE ]
Returns an encrypted password in "LDAP" format, with a curly-bracked prefix
-describing the format, for example, "{PLAIN}himom", "{CRYPT}94pAVyK/4oIBk" or
-"{MD5}5426824942db4253f87a1009fd5d2d4".
+describing the format, for example, "{CRYPT}94pAVyK/4oIBk" or
+"{PLAIN-MD5}5426824942db4253f87a1009fd5d2d4f".
The optional DEFAULT_ENCRYPTION_TYPE is not yet used, but the idea is for it
to work the same as the B</crypt_password> method.
sub ldap_password {
my $self = shift;
#eventually should check a "password-encoding" field
-
- if ( $self->_password_encoding eq 'ldap' ) {
-
- return $self->_password;
-
- } elsif ( $self->_password_encoding eq 'crypt' ) {
-
- if ( length($self->_password) == 13 ) { #crypt
- return '{CRYPT}'. $self->_password;
- } elsif ( $self->_password =~ /^\$1\$(.*)$/ && length($1) == 31 ) { #passwdMD5
- return '{MD5}'. $1;
- #} elsif ( $self->_password =~ /^\$2a?\$(.*)$/ ) { #Blowfish
- # die "Blowfish encryption not supported in this context, svcnum ".
- # $self->svcnum. "\n";
- } else {
- warn "encryption method not (yet?) supported in LDAP context";
- return '{CRYPT}*'; #unsupported, should not auth
- }
-
- } elsif ( $self->_password_encoding eq 'plain' ) {
-
+ if ( length($self->_password) == 13 ) { #crypt
+ return '{CRYPT}'. $self->_password;
+ } elsif ( $self->_password =~ /^\$1\$(.*)$/ && length($1) == 31 ) { #passwdMD5
+ return '{MD5}'. $1;
+ } elsif ( $self->_password =~ /^\$2a?\$(.*)$/ ) { #Blowfish
+ warn "Blowfish encryption not supported in this context, svcnum ".
+ $self->svcnum. "\n";
+ return '{CRYPT}*'; #unsupported, should not auth
+ } elsif ( $self->_password =~ /^(\w{48})$/ ) { #LDAP SSHA
+ return '{SSHA}'. $1;
+ } elsif ( $self->_password =~ /^(\w{64})$/ ) { #LDAP NS-MTA-MD5
+ return '{NS-MTA-MD5}'. $1;
+ } else { #plaintext
return '{PLAIN}'. $self->_password;
-
- #return '{CLEARTEXT}'. $self->_password; #?
-
- } else {
-
- if ( length($self->_password) == 13 ) { #crypt
- return '{CRYPT}'. $self->_password;
- } elsif ( $self->_password =~ /^\$1\$(.*)$/ && length($1) == 31 ) { #passwdMD5
- return '{MD5}'. $1;
- } elsif ( $self->_password =~ /^\$2a?\$(.*)$/ ) { #Blowfish
- warn "Blowfish encryption not supported in this context, svcnum ".
- $self->svcnum. "\n";
- return '{CRYPT}*';
-
- #are these two necessary anymore?
- } elsif ( $self->_password =~ /^(\w{48})$/ ) { #LDAP SSHA
- return '{SSHA}'. $1;
- } elsif ( $self->_password =~ /^(\w{64})$/ ) { #LDAP NS-MTA-MD5
- return '{NS-MTA-MD5}'. $1;
-
- } else { #plaintext
- return '{PLAIN}'. $self->_password;
-
- #return '{CLEARTEXT}'. $self->_password; #?
-
- #XXX this could be replaced with Authen::Passphrase stuff if it gets used
- #my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
- #if ( $encryption eq 'crypt' ) {
- # return '{CRYPT}'. crypt(
- # $self->_password,
- # $saltset[int(rand(64))].$saltset[int(rand(64))]
- # );
- #} elsif ( $encryption eq 'md5' ) {
- # unix_md5_crypt( $self->_password );
- #} elsif ( $encryption eq 'blowfish' ) {
- # croak "unknown encryption method $encryption";
- #} else {
- # croak "unknown encryption method $encryption";
- #}
- }
-
+ #my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
+ #if ( $encryption eq 'crypt' ) {
+ # return '{CRYPT}'. crypt(
+ # $self->_password,
+ # $saltset[int(rand(64))].$saltset[int(rand(64))]
+ # );
+ #} elsif ( $encryption eq 'md5' ) {
+ # unix_md5_crypt( $self->_password );
+ #} elsif ( $encryption eq 'blowfish' ) {
+ # croak "unknown encryption method $encryption";
+ #} else {
+ # croak "unknown encryption method $encryption";
+ #}
}
-
}
=item domain_slash_username
my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ }
$cust_main->invoicing_list,
- $svc_acct->email,
($opt{'to'} ? $opt{'to'} : ())
);
'last' => $cust_main->getfield('last'),
'pkg' => $cust_pkg->part_pkg->pkg,
'column' => $opt{'column'},
- 'amount' => $svc_acct->getfield($opt{'column'}),
- 'threshold' => $threshold,
+ 'amount' => $opt{'column'} =~/bytes/
+ ? FS::UI::bytecount::display_bytecount($svc_acct->getfield($opt{'column'}))
+ : $svc_acct->getfield($opt{'column'}),
+ 'threshold' => $opt{'column'} =~/bytes/
+ ? FS::UI::bytecount::display_bytecount($threshold)
+ : $threshold,
} );
insertion of RADIUS group stuff in insert could be done with child_objects now
(would probably clean up export of them too)
+_op_usage and set_usage bypass the history... maybe they shouldn't
+
=head1 SEE ALSO
L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
=cut
+=item domain_select_hash %OPTIONS
+
+Returns a hash SVCNUM => DOMAIN ... representing the domains this customer
+may at present purchase.
+
+Currently available options are: I<pkgnum> I<svcpart>
+
+=cut
+
+sub domain_select_hash {
+ my ($self, %options) = @_;
+ my %domains = ();
+ my $part_svc;
+ my $cust_pkg;
+
+ if (ref($self)) {
+ $part_svc = $self->part_svc;
+ $cust_pkg = $self->cust_svc->cust_pkg
+ if $self->cust_svc;
+ }
+
+ $part_svc = qsearchs('part_svc', { 'svcpart' => $options{svcpart} })
+ if $options{'svcpart'};
+
+ $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $options{pkgnum} })
+ if $options{'pkgnum'};
+
+ if ($part_svc && ( $part_svc->part_svc_column('domsvc')->columnflag eq 'S'
+ || $part_svc->part_svc_column('domsvc')->columnflag eq 'F')) {
+ %domains = map { $_->svcnum => $_->domain }
+ map { qsearchs('svc_domain', { 'svcnum' => $_ }) }
+ split(',', $part_svc->part_svc_column('domsvc')->columnvalue);
+ }elsif ($cust_pkg && !$conf->exists('svc_acct-alldomains') ) {
+ %domains = map { $_->svcnum => $_->domain }
+ map { qsearchs('svc_domain', { 'svcnum' => $_->svcnum }) }
+ map { qsearch('cust_svc', { 'pkgnum' => $_->pkgnum } ) }
+ qsearch('cust_pkg', { 'custnum' => $cust_pkg->custnum });
+ }else{
+ %domains = map { $_->svcnum => $_->domain } qsearch('svc_domain', {} );
+ }
+
+ if ($part_svc && $part_svc->part_svc_column('domsvc')->columnflag eq 'D') {
+ my $svc_domain = qsearchs('svc_domain',
+ { 'svcnum' => $part_svc->part_svc_column('domsvc')->columnvalue } );
+ if ( $svc_domain ) {
+ $domains{$svc_domain->svcnum} = $svc_domain->domain;
+ }else{
+ warn "unknown svc_domain.svcnum for part_svc_column domsvc: ".
+ $part_svc->part_svc_column('domsvc')->columnvalue;
+
+ }
+ }
+
+ (%domains);
+}
+
1;
projects / freeside.git / blobdiff