X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=3fb28c05469e2175c5f6be989259ffad713d6bf3;hp=6ac2b9d753d897cb0580d8a8fa67c7078ffd753a;hb=4a22a31cd586fc6cff704294b4de39841b0bc86b;hpb=5a30e3a89e4e313a526a7f03afbe94282c715bdd diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 6ac2b9d75..3fb28c054 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,121 +1,79 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin +use vars qw( @ISA $DEBUG $me $conf + $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst - $username_noperiod $username_uppercase - $shellmachine $useradd $usermod $userdel $mydomain - $cyrus_server $cyrus_admin_user $cyrus_admin_pass - $cp_server $cp_user $cp_pass $cp_workgroup + $username_noperiod $username_nounderscore $username_nodash + $username_uppercase + $welcome_template $welcome_from $welcome_subject $welcome_mimetype + $smtpmachine + $radius_password $radius_ip $dirhash - $icradius_dbh - @saltset @pw_set); - $rsync $ssh); + @saltset @pw_set ); use Carp; -use File::Path; use Fcntl qw(:flock); use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh ); 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::queue; +use FS::radius_usergroup; +use FS::export_svc; +use FS::part_export; +use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); +$DEBUG = 0; +$me = '[FS::svc_acct]'; + #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::svc_acct'} = sub { - $rsync = "rsync"; - $ssh = "ssh"; $conf = new FS::Conf; $dir_prefix = $conf->config('home'); @shells = $conf->config('shells'); - $shellmachine = $conf->config('shellmachine'); $usernamemin = $conf->config('usernamemin') || 2; $usernamemax = $conf->config('usernamemax'); $passwordmin = $conf->config('passwordmin') || 6; $passwordmax = $conf->config('passwordmax') || 8; - if ( $shellmachine ) { - if ( $conf->exists('shellmachine-useradd') ) { - $useradd = join("\n", $conf->config('shellmachine-useradd') ) - || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir'; - } else { - $useradd = 'useradd -d $dir -m -s $shell -u $uid $username'; - } - if ( $conf->exists('shellmachine-userdel') ) { - $userdel = join("\n", $conf->config('shellmachine-userdel') ) - || 'rm -rf $dir'; - } else { - $userdel = 'userdel $username'; - } - $usermod = join("\n", $conf->config('shellmachine-usermod') ) - || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '. - 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. - 'find . -depth -print | cpio -pdm $new_dir; '. - 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. - 'rm -rf $old_dir'. - ')'; - } $username_letter = $conf->exists('username-letter'); $username_letterfirst = $conf->exists('username-letterfirst'); $username_noperiod = $conf->exists('username-noperiod'); + $username_nounderscore = $conf->exists('username-nounderscore'); + $username_nodash = $conf->exists('username-nodash'); $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); - $mydomain = $conf->config('domain'); - if ( $conf->exists('cyrus') ) { - ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) = - $conf->config('cyrus'); - eval "use Cyrus::IMAP::Admin;" - } else { - $cyrus_server = ''; - $cyrus_admin_user = ''; - $cyrus_admin_pass = ''; - } - if ( $conf->exists('cp_app') ) { - ($cp_server, $cp_user, $cp_pass, $cp_workgroup) = - $conf->config('cp_app'); - eval "use Net::APP;" - } else { - $cp_server = ''; - $cp_user = ''; - $cp_pass = ''; - $cp_workgroup = ''; - } - if ( $conf->exists('icradiusmachines') ) { - if ( $conf->exists('icradius_secrets') ) { - #need some sort of late binding so it's only connected to when - # actually used, hmm - $icradius_dbh = DBI->connect($conf->config('icradius_secrets')) - or die $DBI::errstr; - } else { - $icradius_dbh = dbh; - } - } else { - $icradius_dbh = ''; - } $dirhash = $conf->config('dirhash') || 0; - $exportdir = "/usr/local/etc/freeside/export." . datasrc; - if ( $conf->exists('vpopmailmachines') ) { - my (@vpopmailmachines) = $conf->config('vpopmailmachines'); - my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); - $vpopdir = $dir; + 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 { - $vpopdir = ''; + $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' , '.' , '/' ); @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' ); -#not needed in 5.004 #srand($$|time); - sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; @@ -180,6 +138,8 @@ FS::svc_Common. The following fields are currently supported: =item _password - generated if blank +=item sec_phrase - security phrase + =item popnum - Point of presence (see L) =item uid @@ -202,8 +162,6 @@ FS::svc_Common. The following fields are currently supported: =item radius_I - I -=item domsvc - service number of svc_domain with which to associate - =back =head1 METHODS @@ -226,25 +184,13 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. -If the configuration value (see L) shellmachine exists, and the -username, uid, and dir fields are defined, the command(s) specified in -the shellmachine-useradd configuration are added to the job queue (see -L and L) to be exectued on shellmachine via ssh. -This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true. -If the shellmachine-useradd configuration file does not exist, - - useradd -d $dir -m -s $shell -u $uid $username - -is the default. If the shellmachine-useradd configuration file exists but -it empty, +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) - cp -pr /etc/skel $dir; chown -R $uid.$gid $dir +(TODOC: L and L) -is the default instead. Otherwise the contents of the file are treated as -a double-quoted perl string, with the following variables available: -$username, $uid, $gid, $dir, and $shell. - -(TODOC: cyrus config file, L and L) +(TODOC: new exports!) =cut @@ -263,274 +209,202 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; - $error = $self->check; return $error if $error; - return "Username ". $self->username. " in use" - if qsearchs( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc, - } ); + #no, duplicate checking just got a whole lot more complicated + #(perhaps keep this check with a config option to turn on?) - 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$/ - ; + #return gettext('username_in_use'). ": ". $self->username + # if qsearchs( 'svc_acct', { 'username' => $self->username, + # 'domsvc' => $self->domsvc, + # } ); - $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my( $username, $uid, $gid, $dir, $shell ) = ( - $self->username, - $self->uid, - $self->gid, - $self->dir, - $self->shell, - ); - if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") ); - if ( $error ) { + if ( $self->svcnum ) { + my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); + unless ( $cust_svc ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + return "no cust_svc record found for svcnum ". $self->svcnum; } + $self->pkgnum($cust_svc->pkgnum); + $self->svcpart($cust_svc->svcpart); } - if ( $cyrus_server ) { - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::cyrus_insert', - }; - $error = $queue->insert($self->username, $self->quota); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } + #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; } - if ( $cp_server ) { - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::cp_insert' - }; - $error = $queue->insert($self->username, $self->_password); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); + 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 ( $icradius_dbh ) { - my $radcheck_queue = - new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::icradius_rc_insert' - }; - $error = $radcheck_queue->insert( $self->username, - $self->_password, - $self->radius_check - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + if ( @dup_user || @dup_userdomain || @dup_uid ) { + my $exports = FS::part_export::export_info('svc_acct'); + my %conflict_user_svcpart; + my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); + + foreach my $part_export ( $part_svc->part_export ) { + + #this will catch to the same exact export + my @svcparts = map { $_->svcpart } + qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + + #this will catch to exports w/same exporthost+type ??? + #my @other_part_export = qsearch('part_export', { + # 'machine' => $part_export->machine, + # 'exporttype' => $part_export->exporttype, + #} ); + #foreach my $other_part_export ( @other_part_export ) { + # push @svcparts, map { $_->svcpart } + # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + #} + + #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; + } else { + $conflict_userdomain_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } } - my $radreply_queue = - new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::icradius_rr_insert' - }; - $error = $radreply_queue->insert( $self->username, - $self->_password, - $self->radius_reply - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + 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}; + } } - } - if ( $vpopdir ) { + foreach my $dup_userdomain ( @dup_userdomain ) { + my $dup_svcpart = $dup_userdomain->cust_svc->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_userdomain_svcpart{$dup_svcpart}; + } + } - my $vpopmail_queue = - new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'FS::svc_acct::vpopmail_insert' - }; - $error = $vpopmail_queue->insert( $self->username, - crypt($self->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]), - $self->domain, - $vpopdir, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + 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}; + } } } + #see? i told you it was more complicated - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -sub cyrus_insert { - my( $username, $quota ) = @_; - - warn "cyrus_insert: starting for user $username, quota $quota\n"; - - warn "cyrus_insert: connecting to $cyrus_server\n"; - my $client = Cyrus::IMAP::Admin->new($cyrus_server); - - warn "cyrus_insert: authentication as $cyrus_admin_user\n"; - $client->authenticate( - -user => $cyrus_admin_user, - -mechanism => "login", - -password => $cyrus_admin_pass - ); - - warn "cyrus_insert: creating user.$username\n"; - my $rc = $client->create("user.$username"); - my $error = $client->error; - die "cyrus_insert: error creating user.$username: $error" if $error; - - warn "cyrus_insert: setacl user.$username, $username => all\n"; - $rc = $client->setacl("user.$username", $username => 'all' ); - $error = $client->error; - die "cyrus_insert: error setacl user.$username: $error" if $error; - - if ( $quota ) { - warn "cyrus_insert: setquota user.$username, STORAGE => $quota\n"; - $rc = $client->setquota("user.$username", 'STORAGE' => $quota ); - $error = $client->error; - die "cyrus_insert: error setquota user.$username: $error" if $error; + my @jobnums; + $error = $self->SUPER::insert(\@jobnums); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - 1; -} - -sub cp_insert { - my( $username, $password ) = @_; - - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->create_mailbox( - Mailbox => $username, - Password => $password, - Workgroup => $cp_workgroup, - Domain => $mydomain, - ); - - die $app->message."\n" unless $app->ok; -} + if ( $self->usergroup ) { + foreach my $groupname ( @{$self->usergroup} ) { + my $radius_usergroup = new FS::radius_usergroup ( { + svcnum => $self->svcnum, + groupname => $groupname, + } ); + my $error = $radius_usergroup->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } -sub icradius_rc_insert { - my( $username, $password, %radcheck ) = @_; - - my $sth = $icradius_dbh->prepare( - "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ". - join(", ", map { $icradius_dbh->quote($_) } ( - '', - $username, - "Password", - $password, - ) ). " )" - ); - $sth->execute or die "can't insert into radcheck table: ". $sth->errstr; - - foreach my $attribute ( keys %radcheck ) { - my $sth = $icradius_dbh->prepare( - "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ". - join(", ", map { $icradius_dbh->quote($_) } ( - '', - $username, - $attribute, - $radcheck{$attribute}, - ) ). " )" - ); - $sth->execute or die "can't insert into radcheck table: ". $sth->errstr; + #false laziness with sub replace (and cust_main) + 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"; } - 1; -} + my $cust_pkg = $self->cust_svc->cust_pkg; -sub icradius_rr_insert { - my( $username, $password, %radreply ) = @_; - - foreach my $attribute ( keys %radreply ) { - my $sth = $icradius_dbh->prepare( - "INSERT INTO radreply ( id, UserName, Attribute, Value ) VALUES ( ". - join(", ", map { $icradius_dbh->quote($_) } ( - '', - $username, - $attribute, - $radreply{$attribute}, - ) ). " )" - ); - $sth->execute or die "can't insert into radreply table: ". $sth->errstr; - } + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; - 1; -} + 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"; + } -sub vpopmail_insert { - my( $username, $password, $domain, $vpopdir ) = @_; - - (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX|LOCK_NB) - ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd"; - print VPASSWD join(":", - $username, - $password, - '1', - '0', - $username, - "$vpopdir/domains/$domain/$username", - 'NOQUOTA', - ), "\n"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - mkdir "$exportdir/domains/$domain/$username", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir/cur", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir/new", 0700 or die "can't create Maildir"; - mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir"; - - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; - $error = $queue->insert; + foreach my $jobnum ( @jobnums ) { + my $error = $wqueue->depend_insert($jobnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error queuing welcome email job dependancy: $error"; + } + } - 1; -} + } -sub vpopmail_sync { + } - my (@vpopmailmachines) = $conf->config('vpopmailmachines'); - my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); - - chdir $exportdir; - my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$pdir/domains/") - system {$args[0]} @args; + } # if ( $cust_pkg ) + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error } =item delete @@ -540,36 +414,13 @@ error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. -If the configuration value (see L) shellmachine exists, the -command(s) specified in the shellmachine-userdel configuration file are -added to the job queue (see L and L) to be executed -on shellmachine via ssh. This behavior can be surpressed by setting -$FS::svc_acct::nossh_hack true. If the shellmachine-userdel configuration -file does not exist, - - userdel $username - -is the default. If the shellmachine-userdel configuration file exists but -is empty, - - rm -rf $dir - -is the default instead. Otherwise the contents of the file are treated as a -double-quoted perl string, with the following variables available: -$username and $dir. - -(TODOC: cyrus config file) +(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 an account which is a (svc_forward) source!" if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } ); @@ -579,7 +430,7 @@ sub delete { return "Can't delete an account with (svc_www) web service!" if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } ); - # what about records in session ? + # what about records in session ? (they should refer to history table) local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -622,196 +473,41 @@ sub delete { } } - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - my( $username, $dir ) = ( - $self->username, - $self->dir, - ); - if ( $username && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; - $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - } - - if ( $cyrus_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' }; - $error = $queue->insert($self->username); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - - if ( $cp_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_delete' }; - $error = $queue->insert($self->username); + foreach my $radius_usergroup ( + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ) + ) { + my $error = $radius_usergroup->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + return $error; } } - if ( $icradius_dbh ) { - - my $radcheck_queue = - new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; - $error = $radcheck_queue->insert( $self->username ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - - my $radreply_queue = - new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' }; - $error = $radreply_queue->insert( $self->username ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; - $error = $queue->insert( $self->username, $self->domain ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } -sub cyrus_delete { - my $username = shift; - - my $client = Cyrus::IMAP::Admin->new($cyrus_server); - $client->authenticate( - -user => $cyrus_admin_user, - -mechanism => "login", - -password => $cyrus_admin_pass - ); - - my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' ); - my $error = $client->error; - die $error if $error; - - $rc = $client->delete("user.$username"); - $error = $client->error; - die $error if $error; - - 1; -} - -sub cp_delete { - my( $username ) = @_; - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->delete_mailbox( - Mailbox => $username, - Domain => $mydomain, - ); - - die $app->message."\n" unless $app->ok; -} - -sub icradius_rc_delete { - my $username = shift; - - my $sth = $icradius_dbh->prepare( - 'DELETE FROM radcheck WHERE UserName = ?' - ); - $sth->execute($username) - or die "can't delete from radcheck table: ". $sth->errstr; - - 1; -} - -sub icradius_rr_delete { - my $username = shift; - - my $sth = $icradius_dbh->prepare( - 'DELETE FROM radreply WHERE UserName = ?' - ); - $sth->execute($username) - or die "can't delete from radreply table: ". $sth->errstr; - - 1; -} - -sub vpopmail_delete { - my( $username, $domain ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX|LOCK_NB) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while () { - my ($mailbox, $rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir";+ - 1; -} - =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. -If the configuration value (see L) shellmachine exists, and the -dir field has changed, the command(s) specified in the shellmachine-usermod -configuraiton file are added to the job queue (see L and -L) to be executed on shellmachine via ssh. This behavior can -be surpressed by setting $FS::svc-acct::nossh_hack true. If the -shellmachine-userdel configuration file does not exist or is empty, - - [ -d $old_dir ] && mv $old_dir $new_dir || ( - chmod u+t $old_dir; - mkdir $new_dir; - cd $old_dir; - find . -depth -print | cpio -pdm $new_dir; - chmod u-t $new_dir; - chown -R $uid.$gid $new_dir; - rm -rf $old_dir - ) - -is the default. This behaviour can be surpressed by setting -$FS::svc_acct::nossh_hack true. +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) =cut sub replace { my ( $new, $old ) = ( shift, shift ); my $error; + warn "$me replacing $old with $new\n" if $DEBUG; return "Username in use" if $old->username ne $new->username && @@ -824,9 +520,6 @@ sub replace { return "Can't change uid!" if $old->uid != $new->uid; } - return "can't change username using Cyrus" - if $cyrus_server && $old->username ne $new->username; - #change homdir when we change username $new->setfield('dir', '') if $old->username ne $new->username; @@ -841,204 +534,73 @@ 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; - my ( $old_dir, $new_dir, $uid, $gid ) = ( - $old->getfield('dir'), - $new->getfield('dir'), - $new->getfield('uid'), - $new->getfield('gid'), - ); - if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'Net::SSH::ssh_cmd' - }; - $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $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}; + foreach my $oldgroup ( @{$old->usergroup} ) { + if ( grep { $oldgroup eq $_ } @newgroups ) { + @newgroups = grep { $oldgroup ne $_ } @newgroups; + next; + } + my $radius_usergroup = qsearchs('radius_usergroup', { + svcnum => $old->svcnum, + groupname => $oldgroup, + } ); + my $error = $radius_usergroup->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error deleting radius_usergroup $oldgroup: $error"; + } } - } - if ( $cp_server && $old->username ne $new->username ) { - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::cp_rename' - }; - $error = $queue->insert( $old->username, $new->username ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; + foreach my $newgroup ( @newgroups ) { + my $radius_usergroup = new FS::radius_usergroup ( { + svcnum => $new->svcnum, + groupname => $newgroup, + } ); + my $error = $radius_usergroup->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error adding radius_usergroup $newgroup: $error"; + } } + } - if ( $cp_server && $old->_password ne $new->_password ) { - my $queue = new FS::queue { - 'svcnum' => $new->svcnum, - 'job' => 'FS::svc_acct::cp_change' - }; - $error = $queue->insert( $new->username, $new->_password ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } + $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error if $error; } - if ( $icradius_dbh ) { - my $queue = new FS::queue { + 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::icradius_rc_replace' + 'job' => 'FS::svc_acct::append_fuzzyfiles' }; - $error = $queue->insert( $new->username, - $new->_password, - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "queueing job (transaction rolled back): $error"; - } - } - if ( $vpopdir ) { - my $cpassword = crypt( - $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))] - ); - - if ($old->username ne $new->username || $old->domain ne $new->domain ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' }; - $error = $queue->insert( $old->username, $old->domain ); - my $queue2 = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_insert' }; - $error = $queue2->insert( $new->username, - $cpassword, - $new->domain, - $vpopdir, - ) - unless $error; - } elsif ($old->_password ne $new->_password) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_replace_password' }; - $error = $queue->insert( $new->username, $cpassword, $new->domain ); - } + $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 } -sub icradius_rc_replace { - my( $username, $new_password ) = @_; - - my $sth = $icradius_dbh->prepare( - "UPDATE radcheck SET Value = ? WHERE UserName = ? and Attribute = ?" - ); - $sth->execute($new_password, $username, 'Password' ) - or die "can't update radcheck table: ". $sth->errstr; - - 1; -} - -sub cp_rename { - my ( $old_username, $new_username ) = @_; - - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - $app->rename_mailbox( - Domain => $mydomain, - Old_Mailbox => $old_username, - New_Mailbox => $new_username, - ); - - die $app->message."\n" unless $app->ok; - -} - -sub cp_change { - my ( $username, $password ) = @_; - - my $app = new Net::APP ( $cp_server, - User => $cp_user, - Password => $cp_pass, - Domain => $mydomain, - Timeout => 60, - #Debug => 1, - ) or die "$@\n"; - - if ( $password =~ /^\*SUSPENDED\* (.*)$/ ) { - $password = $1; - $app->set_mailbox_status( - Domain => $mydomain, - Mailbox => $username, - Other => 'T', - Other_Bounce => 'T', - ); - } else { - $app->set_mailbox_status( - Domain => $mydomain, - Mailbox => $username, - Other => 'F', - Other_Bounce => 'F', - ); - } - die $app->message."\n" unless $app->ok; - - $app->change_mailbox( - Domain => $mydomain, - Mailbox => $username, - Password => $password, - ); - die $app->message."\n" unless $app->ok; - -} - -sub vpopmail_replace_password { - my( $username, $password, $domain ) = @_; - - (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") - and flock(VPASSWD,LOCK_EX|LOCK_NB) - ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - - open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") - or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; - - while () { - my ($mailbox, $pw, @rest) = split(':', $_); - print VPASSWDTMP $_ unless $username eq $mailbox; - print VPASSWDTMP join (':', ($mailbox, $password, @rest)) - if $username eq $mailbox; - } - - close(VPASSWDTMP); - - rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd" - or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!"; - - flock(VPASSWD,LOCK_UN); - close(VPASSWD); - - my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' }; - $error = $queue->insert; - - 1; -} - - =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). @@ -1052,16 +614,17 @@ sub suspend { ) { $hash{_password} = '*SUSPENDED* '.$hash{_password}; my $new = new FS::svc_acct ( \%hash ); - $new->replace($self); - } else { - ''; #no error (already suspended) + my $error = $new->replace($self); + return $error if $error; } + + $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). @@ -1073,10 +636,11 @@ sub unsuspend { if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) { $hash{_password} = $1; my $new = new FS::svc_acct ( \%hash ); - $new->replace($self); - } else { - ''; #no error (already unsuspended) + my $error = $new->replace($self); + return $error if $error; } + + $self->SUPER::unsuspend; } =item cancel @@ -1104,32 +668,45 @@ sub check { return $x unless ref($x); my $part_svc = $x; + if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) { + $self->usergroup( + [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] ); + } + 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; my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; if ( $username_uppercase ) { $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i - or return "Illegal username: ". $recref->{username}; + or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } else { $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ - or return "Illegal username: ". $recref->{username}; + or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; $recref->{username} = $1; } if ( $username_letterfirst ) { - $recref->{username} =~ /^[a-z]/ or return "Illegal username"; + $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username'); } elsif ( $username_letter ) { - $recref->{username} =~ /[a-z]/ or return "Illegal username"; + $recref->{username} =~ /[a-z]/ or return gettext('illegal_username'); } if ( $username_noperiod ) { - $recref->{username} =~ /\./ and return "Illegal username"; + $recref->{username} =~ /\./ and return gettext('illegal_username'); + } + if ( $username_nounderscore ) { + $recref->{username} =~ /_/ and return gettext('illegal_username'); + } + if ( $username_nodash ) { + $recref->{username} =~ /\-/ and return gettext('illegal_username'); } unless ( $username_ampersand ) { - $recref->{username} =~ /\&/ and return "Illegal username"; + $recref->{username} =~ /\&/ and return gettext('illegal_username'); } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; @@ -1149,17 +726,13 @@ sub check { #you can set a fixed gid in part_svc return "Only root can have uid 0" - if $recref->{uid} == 0 && $recref->{username} ne 'root'; + if $recref->{uid} == 0 + && $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 @@ -1191,29 +764,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} =~ /^(\d*)$/ 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'; } } @@ -1237,18 +815,22 @@ 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 "Illegal password: ". $recref->{_password}; + return gettext('illegal_password'). " $passwordmin-$passwordmax ". + FS::Msgcat::_gettext('illegal_password_characters'). + ": ". $recref->{_password}; } - ''; #no error + $self->SUPER::check; } =item radius @@ -1282,8 +864,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; } @@ -1293,19 +875,24 @@ sub radius_reply { Returns key/value pairs, suitable for assigning to a hash, for any RADIUS check attributes of this record. -Accessing RADIUS attributes directly is not supported and will break in the -future. +Note that this is now the preferred method for reading RADIUS attributes - +accessing the columns directly is discouraged, as the column names are +expected to change in the future. =cut sub radius_check { my $self = shift; - 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 ); + my $password = $self->_password; + my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; + ( $pw_attrib => $password, + 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 ) + ); } =item domain @@ -1316,20 +903,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 @@ -1344,6 +927,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 } ); @@ -1362,8 +947,8 @@ sub email { =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. @@ -1376,6 +961,240 @@ 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). + +=cut + +sub radius_groups { + my $self = shift; + 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 } ); + } +} + +=back + +=head1 SUBROUTINES + +=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 + +sub check_and_rebuild_fuzzyfiles { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + -e "$dir/svc_acct.username" + or &rebuild_fuzzyfiles; +} + +=item rebuild_fuzzyfiles + +=cut + +sub rebuild_fuzzyfiles { + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + #username + + open(USERNAMELOCK,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAMELOCK,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + my @all_username = map $_->getfield('username'), qsearch('svc_acct', {}); + + open (USERNAMECACHE,">$dir/svc_acct.username.tmp") + or die "can't open $dir/svc_acct.username.tmp: $!"; + print USERNAMECACHE join("\n", @all_username), "\n"; + close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!"; + + rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username"; + close USERNAMELOCK; + +} + +=item all_username + +=cut + +sub all_username { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + open(USERNAMECACHE,"<$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + my @array = map { chomp; $_; } ; + close USERNAMECACHE; + \@array; +} + +=item append_fuzzyfiles USERNAME + +=cut + +sub append_fuzzyfiles { + my $username = shift; + + &check_and_rebuild_fuzzyfiles; + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + open(USERNAME,">>$dir/svc_acct.username") + or die "can't open $dir/svc_acct.username: $!"; + flock(USERNAME,LOCK_EX) + or die "can't lock $dir/svc_acct.username: $!"; + + print USERNAME "$username\n"; + + flock(USERNAME,LOCK_UN) + or die "can't unlock $dir/svc_acct.username: $!"; + close USERNAME; + + 1; +} + + + +=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] + +=cut + +sub radius_usergroup_selector { + my $sel_groups = shift; + my %sel_groups = map { $_=>1 } @$sel_groups; + + my $selectname = shift || 'radius_usergroup'; + + my $dbh = dbh; + my $sth = $dbh->prepare( + 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname' + ) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref}; + + my $html = < + function ${selectname}_doadd(object) { + var myvalue = object.${selectname}_add.value; + var optionName = new Option(myvalue,myvalue,false,true); + var length = object.$selectname.length; + object.$selectname.options[length] = optionName; + object.${selectname}_add.value = ""; + } + + !. + qq!!; + + $html; +} + =back =head1 BUGS @@ -1386,12 +1205,15 @@ The suspend, unsuspend and cancel methods update the database, but not the current object. This is probably a bug as it's unexpected and counterintuitive. +radius_usergroup_selector? putting web ui components in here? they should +probably live somewhere else... + =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