X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=8d22c21e00f8330f54ae1f50711343c9e12a05ba;hp=65a58fc9876e47b9ddced0b6878651967293321b;hb=87af741da0dd5f6a76bbb566b4d6c54cd5b15315;hpb=0dc8c09556f5e74b5a58931e40c2da06619a6be7 diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 65a58fc98..8d22c21e0 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,7 +1,8 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin +use vars qw( @ISA $nossh_hack $noexport_hack $conf + $dir_prefix @shells $usernamemin $usernamemax $passwordmin $passwordmax $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_uppercase @@ -9,9 +10,12 @@ use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin $cyrus_server $cyrus_admin_user $cyrus_admin_pass $cp_server $cp_user $cp_pass $cp_workgroup $dirhash - $icradius_dbh - @saltset @pw_set); + @saltset @pw_set + $rsync $ssh $exportdir $vpopdir); 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; @@ -23,11 +27,14 @@ use FS::cust_main_invoice; use FS::svc_domain; use FS::raddb; use FS::queue; +use FS::radius_usergroup; @ISA = qw( FS::svc_Common ); #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'); @@ -82,19 +89,16 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $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; - } + + $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; } else { - $icradius_dbh = ''; + $vpopdir = ''; } - $dirhash = $conf->config('dirhash') || 0; }; @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); @@ -188,8 +192,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 @@ -212,6 +214,10 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. +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) + 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 @@ -232,6 +238,8 @@ $username, $uid, $gid, $dir, and $shell. (TODOC: cyrus config file, L and L) +(TODOC: new exports! $noexport_hack) + =cut sub insert { @@ -249,8 +257,6 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; - $error = $self->check; return $error if $error; @@ -259,6 +265,16 @@ sub insert { 'domsvc' => $self->domsvc, } ); + if ( $self->svcnum ) { + my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); + unless ( $cust_svc ) { + $dbh->rollback if $oldAutoCommit; + return "no cust_svc record found for svcnum ". $self->svcnum; + } + $self->pkgnum($cust_svc->pkgnum); + $self->svcpart($cust_svc->svcpart); + } + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); return "Unknown svcpart" unless $part_svc; return "uid in use" @@ -273,6 +289,34 @@ sub insert { return $error; } + 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; + } + } + } + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_insert($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my( $username, $uid, $gid, $dir, $shell ) = ( $self->username, $self->uid, @@ -281,7 +325,10 @@ sub insert { $self->shell, ); if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' }; + my $queue = new FS::queue { + 'svcnum' => $self->svcnum, + 'job' => 'Net::SSH::ssh_cmd', + }; $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -290,7 +337,10 @@ sub insert { } if ( $cyrus_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_insert' }; + 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; @@ -299,7 +349,10 @@ sub insert { } if ( $cp_server ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_insert' }; + 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; @@ -307,24 +360,17 @@ sub insert { } } - if ( $icradius_dbh ) { - - my $radcheck_queue = - new FS::queue { '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"; - } - - my $radreply_queue = - new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_insert' }; - $error = $radreply_queue->insert( $self->username, - $self->_password, - $self->radius_reply + if ( $vpopdir ) { + + 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; @@ -333,6 +379,8 @@ sub insert { } + #end of old-style exports + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -381,7 +429,7 @@ sub cp_insert { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) or die "$@\n"; $app->create_mailbox( Mailbox => $username, @@ -390,56 +438,50 @@ sub cp_insert { Domain => $mydomain, ); - die $app->message unless $app->ok; + die $app->message."\n" unless $app->ok; } -sub icradius_rc_insert { - my( $username, $password, %radcheck ) = @_; +sub vpopmail_insert { + my( $username, $password, $domain, $vpopdir ) = @_; - 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; - } + (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) 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' }; + my $error = $queue->insert; + die $error if $error; 1; } -sub icradius_rr_insert { - my( $username, $password, %radreply ) = @_; +sub vpopmail_sync { + + my (@vpopmailmachines) = $conf->config('vpopmailmachines'); + my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]); - 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; - } + chdir $exportdir; + my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/"); + system {$args[0]} @args; - 1; } =item delete @@ -469,6 +511,8 @@ $username and $dir. (TODOC: cyrus config file) +(TODOC: new exports! $noexport_hack) + =cut sub delete { @@ -488,7 +532,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'; @@ -531,18 +575,44 @@ sub delete { } } + foreach my $radius_usergroup ( + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ) + ) { + my $error = $radius_usergroup->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $part_svc = $self->cust_svc->part_svc; + my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $part_svc->part_export ) { + my $error = $part_export->export_delete($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my( $username, $dir ) = ( $self->username, $self->dir, ); if ( $username && $shellmachine && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' }; + my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' }; $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -569,19 +639,9 @@ sub delete { } } - 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 ( $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"; @@ -589,6 +649,8 @@ sub delete { } + #end of old-style exports + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -622,37 +684,40 @@ sub cp_delete { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) or die "$@\n"; $app->delete_mailbox( Mailbox => $username, Domain => $mydomain, ); - die $app->message unless $app->ok; + die $app->message."\n" unless $app->ok; } -sub icradius_rc_delete { - my $username = shift; +sub vpopmail_delete { + my( $username, $domain ) = @_; - my $sth = $icradius_dbh->prepare( - 'DELETE FROM radcheck WHERE UserName = ?' - ); - $sth->execute($username) - or die "can't delete from radcheck table: ". $sth->errstr; + (open(VPASSWD, "$exportdir/domains/$domain/vpasswd") + and flock(VPASSWD,LOCK_EX) + ) or die "can't open $exportdir/domains/$domain/vpasswd: $!"; - 1; -} + open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp") + or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!"; -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; + 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; } @@ -661,6 +726,10 @@ sub icradius_rr_delete { Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +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) + 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 @@ -721,6 +790,54 @@ sub replace { return $error if $error; } + $old->usergroup( [ $old->radius_groups ] ); + 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"; + } + } + + 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"; + } + } + + } + + #new-style exports! + unless ( $noexport_hack ) { + foreach my $part_export ( $new->cust_svc->part_svc->part_export ) { + my $error = $part_export->export_replace($new,$old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "exporting to ". $part_export->exporttype. + " (transaction rolled back): $error"; + } + } + } + + #old-style exports + my ( $old_dir, $new_dir, $uid, $gid ) = ( $old->getfield('dir'), $new->getfield('dir'), @@ -728,7 +845,10 @@ sub replace { $new->getfield('gid'), ); if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' }; + 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; @@ -737,7 +857,10 @@ sub replace { } if ( $cp_server && $old->username ne $new->username ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_rename' }; + 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; @@ -746,7 +869,10 @@ sub replace { } if ( $cp_server && $old->_password ne $new->_password ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_change' }; + 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; @@ -754,35 +880,39 @@ sub replace { } } - if ( $icradius_dbh ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_replace' }; - $error = $queue->insert( $new->username, - $new->_password, - ); + 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 ); + } if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } } + #end of old-style exports + $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 ( $old_username, $new_username ) = @_; my $app = new Net::APP ( $cp_server, User => $cp_user, @@ -790,7 +920,7 @@ sub cp_rename { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) or die "$@\n"; $app->rename_mailbox( Domain => $mydomain, @@ -798,12 +928,12 @@ sub cp_rename { New_Mailbox => $new_username, ); - die $app->message unless $app->ok; + die $app->message."\n" unless $app->ok; } sub cp_change { - my ( $username, $password ); + my ( $username, $password ) = @_; my $app = new Net::APP ( $cp_server, User => $cp_user, @@ -811,18 +941,68 @@ sub cp_change { Domain => $mydomain, Timeout => 60, #Debug => 1, - ) or die $@; + ) 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) + ) 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; + } - die $app->message unless $app->ok; + 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' }; + my $error = $queue->insert; + die $error if $error; + + 1; } + =item suspend Suspends this account by prefixing *SUSPENDED* to the password. If there is an @@ -892,8 +1072,14 @@ 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_textn('sec_phrase') ; return $error if $error; @@ -1081,19 +1267,22 @@ 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 ); + ( 'Password' => $self->_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 @@ -1164,35 +1353,70 @@ sub seconds_since { $self->cust_svc->seconds_since(@_); } -=item ssh +=item radius_groups + +Returns all RADIUS groups for this account (see L). =cut -sub ssh { - my ( $host, @cmd_and_args ) = @_; +sub radius_groups { + my $self = shift; + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); +} - use IO::File; - my $reader = IO::File->new(); - my $writer = IO::File->new(); - my $error = IO::File->new(); +=back - &Net::SSH::sshopen3( $host, $reader, $writer, $error, @cmd_and_args) or die $!; +=head1 SUBROUTINES - local $/ = undef; - my $output_stream = <$writer>; - my $error_stream = <$error>; - if ( length $error_stream ) { - #warn "[FS::svc_acct::ssh] STDERR $error_stream"; - die "[FS::svc_acct::ssh] STDERR $error_stream"; - } - if ( length $output_stream ) { - warn "[FS::svc_acct::ssh] STDOUT $output_stream"; +=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!!; -=back + $html; +} =head1 BUGS @@ -1202,6 +1426,9 @@ 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,