X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=991cedd21da025697bc2cf0a5a8875709a296bc1;hp=aa089d06532db346578c0bb3f8b9d869c1761660;hb=72a65ceaa28155e8c1c3c1328dd76587b35e089a;hpb=13f822a442f093f5658e5571c3d236b80be0113f diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index aa089d065..991cedd21 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,25 +1,27 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $noexport_hack $conf +use vars qw( @ISA $DEBUG $me $conf $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $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 $dirhash @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; @@ -31,6 +33,10 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); +$DEBUG = 0; +#$DEBUG = 1; +$me = '[FS::svc_acct]'; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { $conf = new FS::Conf; @@ -47,9 +53,24 @@ $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 ( + 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_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain'; + } else { + $welcome_template = ''; + $welcome_from = ''; + $welcome_subject = ''; + $welcome_mimetype = ''; + } + $smtpmachine = $conf->config('smtpmachine'); + $radius_password = $conf->config('radius-password') || 'Password'; + $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address'; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -157,7 +178,7 @@ Creates a new account. To add the account to the database, see L<"insert">. 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. @@ -169,14 +190,26 @@ The additional field I can optionally be defined; if so it should contain an arrayref of group names. See L. (used in sqlradius export only) +The additional field I 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 + +If I 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 and L) -(TODOC: new exports! $noexport_hack) +(TODOC: new exports!) =cut sub insert { my $self = shift; + my %options = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -201,7 +234,7 @@ sub insert { # '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; @@ -213,19 +246,27 @@ sub insert { #new duplicate username checking + my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); + unless ( $part_svc ) { + $dbh->rollback if $oldAutoCommit; + return 'unknown svcpart '. $self->svcpart; + } + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); - my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc } ); + my @dup_userdomain = qsearch( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc } ); + my @dup_uid; + if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' + && $self->username !~ /^(toor|(hyla)?fax)$/ ) { + @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } ); + } else { + @dup_uid = (); + } - if ( @dup_user || @dup_userdomain ) { + if ( @dup_user || @dup_userdomain || @dup_uid ) { my $exports = FS::part_export::export_info('svc_acct'); - my( %conflict_user_svcpart, %conflict_userdomain_svcpart ); - - my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); - unless ( $part_svc ) { - $dbh->rollback if $oldAutoCommit; - return 'unknown svcpart '. $self->svcpart; - } + my %conflict_user_svcpart; + my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); foreach my $part_export ( $part_svc->part_export ) { @@ -243,7 +284,11 @@ sub insert { # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); #} - my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #silly kludge to avoid uninitialized value errors + my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) + ? $exports->{$part_export->exporttype}{'nodomain'} + : ''; if ( $nodomain =~ /^Y/i ) { $conflict_user_svcpart{$_} = $part_export->exportnum foreach @svcparts; @@ -256,6 +301,7 @@ sub insert { foreach my $dup_user ( @dup_user ) { my $dup_svcpart = $dup_user->cust_svc->svcpart; if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + $dbh->rollback if $oldAutoCommit; return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; } @@ -263,10 +309,22 @@ sub insert { foreach my $dup_userdomain ( @dup_userdomain ) { my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + $dbh->rollback if $oldAutoCommit; return "duplicate username\@domain: conflicts with svcnum ". $dup_userdomain->svcnum. " via exportnum ". - $conflict_user_svcpart{$dup_svcpart}; + $conflict_userdomain_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_uid ( @dup_uid ) { + my $dup_svcpart = $dup_uid->cust_svc->svcpart; + 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} + || $conflict_userdomain_svcpart{$dup_svcpart}; } } @@ -274,16 +332,12 @@ sub insert { #see? i told you it was more complicated - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); - return "Unknown svcpart" unless $part_svc; - return "uid in use" - if $part_svc->part_svc_column('uid')->columnflag ne 'F' - && qsearchs( 'svc_acct', { 'uid' => $self->uid } ) - && $self->username !~ /^(hyla)?fax$/ - && $self->username !~ /^toor$/ #FreeBSD - ; - - $error = $self->SUPER::insert; + my @jobnums; + $error = $self->SUPER::insert( + 'jobnums' => \@jobnums, + 'child_objects' => $self->child_objects, + %options, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -304,13 +358,85 @@ sub insert { } #false laziness with sub replace (and cust_main) - my $queue = new FS::queue { 'job' => 'FS::svc_acct::append_fuzzyfiles' }; + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; $error = $queue->insert($self->username); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } + my $cust_pkg = $self->cust_svc->cust_pkg; + + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + + if ( $conf->exists('emailinvoiceauto') ) { + my @invoicing_list = $cust_main->invoicing_list; + push @invoicing_list, $self->email; + $cust_main->invoicing_list(\@invoicing_list); + } + + #welcome email + my $to = ''; + if ( $welcome_template && $cust_pkg ) { + my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list ); + if ( $to ) { + my $wqueue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'FS::svc_acct::send_email' + }; + my $error = $wqueue->insert( + 'to' => $to, + 'from' => $welcome_from, + 'subject' => $welcome_subject, + 'mimetype' => $welcome_mimetype, + 'body' => $welcome_template->fill_in( HASH => { + 'custnum' => $self->custnum, + 'username' => $self->username, + 'password' => $self->_password, + 'first' => $cust_main->first, + 'last' => $cust_main->getfield('last'), + 'pkg' => $cust_pkg->part_pkg->pkg, + } ), + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + 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 ) { + $dbh->rollback if $oldAutoCommit; + return "error queuing welcome email job dependancy: $error"; + } + } + + } + + } + + } # if ( $cust_pkg ) + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -322,17 +448,14 @@ error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. -(TODOC: new exports! $noexport_hack) +(TODOC: new exports!) =cut 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 } ); @@ -420,6 +543,9 @@ sqlradius export only) sub replace { my ( $new, $old ) = ( shift, shift ); 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 && @@ -446,13 +572,13 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - $error = $new->SUPER::replace($old); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error if $error; - } + # redundant, but so $new->usergroup gets set + $error = $new->check; + 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 ( $new->usergroup ) { #(sorta) false laziness with FS::part_export::sqlradius::_export_replace my @newgroups = @{$new->usergroup}; @@ -486,14 +612,24 @@ sub replace { } - #false laziness with sub insert (and cust_main) - my $queue = new FS::queue { 'job' => 'FS::svc_acct::append_fuzzyfiles' }; - $error = $queue->insert($new->username); + $error = $new->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + return $error if $error; } + if ( $new->username ne $old->username ) { + #false laziness with sub insert (and cust_main) + my $queue = new FS::queue { + 'svcnum' => $new->svcnum, + 'job' => 'FS::svc_acct::append_fuzzyfiles' + }; + $error = $queue->insert($new->username); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error @@ -501,8 +637,8 @@ sub replace { =item suspend -Suspends this account by prefixing *SUSPENDED* to the password. If there is an -error, returns the error, otherwise returns false. +Suspends this account by calling export-specific suspend hooks. If there is +an error, returns the error, otherwise returns false. Called by the suspend method of FS::cust_pkg (see L). @@ -510,23 +646,14 @@ Called by the suspend method of FS::cust_pkg (see L). 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; } =item unsuspend -Unsuspends this account by removing *SUSPENDED* from the password. If there is -an error, returns the error, otherwise returns false. +Unsuspends this account by by calling export-specific suspend hooks. If there +is an error, returns the error, otherwise returns false. Called by the unsuspend method of FS::cust_pkg (see L). @@ -576,7 +703,8 @@ sub check { } my $error = $self->ut_numbern('svcnum') - || $self->ut_number('domsvc') + #|| $self->ut_number('domsvc') + || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' ) || $self->ut_textn('sec_phrase') ; return $error if $error; @@ -631,15 +759,9 @@ sub check { && $recref->{username} ne 'root' && $recref->{username} ne 'toor'; -# $error = $self->ut_textn('finger'); -# return $error if $error; - $self->getfield('finger') =~ - /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/ - or return "Illegal finger: ". $self->getfield('finger'); - $self->setfield('finger', $1); $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ - or return "Illegal directory"; + or return "Illegal directory: ". $recref->{dir}; $recref->{dir} = $1; return "Illegal directory" if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component @@ -671,29 +793,34 @@ sub check { $recref->{shell} = '/bin/sync'; } - $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)"; - $recref->{quota} = $1; - } else { $recref->{gid} ne '' ? return "Can't have gid without uid" : ( $recref->{gid}='' ); - $recref->{finger} ne '' ? - return "Can't have finger-name without uid" : ( $recref->{finger}='' ); $recref->{dir} ne '' ? return "Can't have directory without uid" : ( $recref->{dir}='' ); $recref->{shell} ne '' ? return "Can't have shell without uid" : ( $recref->{shell}='' ); - $recref->{quota} ne '' ? - return "Can't have quota without uid" : ( $recref->{quota}='' ); } + # $error = $self->ut_textn('finger'); + # return $error if $error; + $self->getfield('finger') =~ + /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/ + or return "Illegal finger: ". $self->getfield('finger'); + $self->setfield('finger', $1); + + $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota"; + $recref->{quota} = $1; + unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { - unless ( $recref->{slipip} eq '0e0' ) { + if ( $recref->{slipip} eq '' ) { + $recref->{slipip} = ''; + } elsif ( $recref->{slipip} eq '0e0' ) { + $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; - } else { - $recref->{slipip} = '0e0'; } } @@ -717,20 +844,33 @@ sub check { #$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 { #return "Illegal password"; - return gettext('illegal_password'). "$passwordmin-$passwordmax". + return gettext('illegal_password'). " $passwordmin-$passwordmax ". FS::Msgcat::_gettext('illegal_password_characters'). ": ". $recref->{_password}; } - ''; #no error + $self->SUPER::check; +} + +=item _check_system + +=cut + +sub _check_system { + my $self = shift; + scalar( grep { $self->username eq $_ || $self->email eq $_ } + $conf->config('system_usernames') + ); } =item radius @@ -764,8 +904,8 @@ sub radius_reply { #$attrib =~ s/_/\-/g; ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); - if ( $self->ip && $self->ip ne '0e0' ) { - $reply{'Framed-IP-Address'} = $self->ip; + if ( $self->slipip && $self->slipip ne '0e0' ) { + $reply{$radius_ip} = $self->slipip; } %reply; } @@ -783,7 +923,9 @@ expected to change in the future. sub radius_check { my $self = shift; - ( 'Password' => $self->_password, + my $password = $self->_password; + my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; + ( $pw_attrib => $password, map { /^(rc_(.*))$/; my($column, $attrib) = ($1, $2); @@ -801,20 +943,16 @@ Returns the domain associated with this account. sub domain { my $self = shift; - 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"; - } + 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; } =item svc_domain Returns the FS::svc_domain record for this account's domain (see -L. +L). =cut @@ -829,6 +967,8 @@ sub svc_domain { Returns the FS::cust_svc record for this account (see L). +=cut + sub cust_svc { my $self = shift; qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); @@ -845,10 +985,26 @@ sub email { $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. -See L +Returns the number of seconds this account has been online since TIMESTAMP, +according to the session monitor (see L). TIMESTAMP is specified as a UNIX timestamp; see L. Also see L and L for conversion functions. @@ -861,6 +1017,60 @@ sub seconds_since { $self->cust_svc->seconds_since(@_); } +=item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END + +Returns the numbers of seconds this account has been online between +TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an +external SQL radacct table, specified via sqlradius export. Sessions which +started in the specified range but are still open are counted from session +start to the end of the range (unless they are over 1 day old, in which case +they are presumed missing their stop record and not counted). Also, sessions +which end in the range but started earlier are counted from the start of the +range to session end. Finally, sessions which start before the range but end +after are counted for the entire range. + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L for conversion +functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub seconds_since_sqlradacct { + my $self = shift; + $self->cust_svc->seconds_since_sqlradacct(@_); +} + +=item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE + +Returns the sum of the given attribute for all accounts (see L) +in this package for sessions ending between TIMESTAMP_START (inclusive) and +TIMESTAMP_END (exclusive). + +TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see +L. Also see L and L for conversion +functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub attribute_since_sqlradacct { + my $self = shift; + $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). @@ -869,8 +1079,72 @@ Returns all RADIUS groups for this account (see L). sub radius_groups { my $self = shift; - map { $_->groupname } - qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + if ( $self->usergroup ) { + #when provisioning records, export callback runs in svc_Common.pm before + #radius_usergroup records can be inserted... + @{$self->usergroup}; + } else { + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); + } +} + +=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) = @_; + #eventually should check a "password-encoding" field + if ( length($self->_password) < 13 ) { #plaintext + $check_password eq $self->_password; + } elsif ( length($self->_password) == 13 ) { #traditional DES crypt + crypt($check_password, $self->_password) eq $self->_password; + } elsif ( $self->_password =~ /^\$1\$/ ) { #MD5 crypt + unix_md5_crypt($check_password, $self->_password) eq $self->_password; + } elsif ( $self->_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 @@ -879,6 +1153,32 @@ sub radius_groups { =over 4 +=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 $@; + + $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}) ], + ); + die $error if $error; +} + =item check_and_rebuild_fuzzyfiles =cut @@ -1022,12 +1322,15 @@ counterintuitive. 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, 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