X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=ce76fe51baf4118e52bd1a9dea7378809f469e0e;hp=85b4888b27c1588f877f9d1b01f64fa18d02e965;hb=8646bec77602ba7b5b9928a8d408ff5bea5b0bc1;hpb=a9ec5a5c02a137cadd9f2a522fba904d945ddbe3 diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 85b4888b2..ce76fe51b 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -1,20 +1,33 @@ package FS::svc_acct; use strict; -use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin - $usernamemax $passwordmin $username_letter $username_letterfirst - $shellmachine $useradd $usermod $userdel - @saltset @pw_set); +use vars qw( @ISA $noexport_hack $conf + $dir_prefix @shells $usernamemin + $usernamemax $passwordmin $passwordmax + $username_ampersand $username_letter $username_letterfirst + $username_noperiod $username_nounderscore $username_nodash + $username_uppercase + $mydomain + $dirhash + @saltset @pw_set ); use Carp; +use Fcntl qw(:flock); +use FS::UID qw( datasrc ); use FS::Conf; -use FS::Record qw( qsearch qsearchs fields ); +use FS::Record qw( qsearch qsearchs fields dbh ); use FS::svc_Common; -use Net::SSH qw(ssh); +use Net::SSH; 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 ); @@ -23,39 +36,36 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $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; - 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'. - ')'; - } + $passwordmax = $conf->config('passwordmax') || 8; $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'); + + $dirhash = $conf->config('dirhash') || 0; }; @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 ) = @_; + if ( $hashref->{'svc_acct_svcnum'} ) { + $self->{'_domsvc'} = FS::svc_domain->new( { + 'svcnum' => $hashref->{'domsvc'}, + 'domain' => $hashref->{'svc_acct_domain'}, + 'catchall' => $hashref->{'svc_acct_catchall'}, + } ); + } +} =head1 NAME @@ -88,6 +98,14 @@ FS::svc_acct - Object methods for svc_acct records %hash = $record->radius_check; + $domain = $record->domain; + + $svc_domain = $record->svc_domain; + + $email = $record->email; + + $seconds_since = $record->seconds_since($timestamp); + =head1 DESCRIPTION An FS::svc_acct object represents an account. FS::svc_acct inherits from @@ -101,6 +119,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 @@ -117,9 +137,11 @@ FS::svc_Common. The following fields are currently supported: =item slipip - IP address -=item radius_I - I +=item seconds - -=item domsvc - service number of svc_domain with which to associate +=item domsvc - svcnum from svc_domain + +=item radius_I - I =back @@ -143,22 +165,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 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, +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) - useradd -d $dir -m -s $shell -u $uid $username +(TODOC: L and L) -is the default. If the shellmachine-useradd configuration file exists but -it empty, - - cp -pr /etc/skel $dir; chown -R $uid.$gid $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, $uid, $gid, $dir, and $shell. +(TODOC: new exports! $noexport_hack) =cut @@ -173,36 +186,124 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $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?) + + #return gettext('username_in_use'). ": ". $self->username + # if qsearchs( 'svc_acct', { 'username' => $self->username, + # '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); + } + + #new duplicate username checking + + my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); + my @dup_userdomain = qsearchs( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc } ); + + if ( @dup_user || @dup_userdomain ) { + 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; + } + + 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'}; + if ( $nodomain =~ /^Y/i ) { + $conflict_user_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } else { + $conflict_userdomain_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } + } + + foreach my $dup_user ( @dup_user ) { + my $dup_svcpart = $dup_user->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_userdomain ( @dup_userdomain ) { + my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + return "duplicate username\@domain: conflicts with svcnum ". + $dup_userdomain->svcnum. " via exportnum ". + $conflict_user_svcpart{$dup_svcpart}; + } + } + + } + + #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->svc_acct__uid_flag ne 'F' + 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; - return $error if $error; + 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 ) { - ssh("root\@$shellmachine", eval qq("$useradd") ); + 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; + } + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -213,30 +314,17 @@ 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 -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: new exports! $noexport_hack) =cut sub delete { my $self = shift; - return "Can't delete an account which has (svc_acct_sm) mail aliases!" - if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } ); + 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 } ); @@ -247,7 +335,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'; @@ -263,6 +351,10 @@ sub delete { foreach my $cust_main_invoice ( qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } ) ) { + unless ( defined($cust_main_invoice) ) { + warn "WARNING: something's wrong with qsearch"; + next; + } my %hash = $cust_main_invoice->hash; $hash{'dest'} = $self->email; my $new = new FS::cust_main_invoice \%hash; @@ -286,6 +378,16 @@ 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 $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -293,15 +395,6 @@ sub delete { } $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - my( $username, $dir ) = ( - $self->username, - $self->dir, - ); - if ( $username && $shellmachine && ! $nossh_hack ) { - ssh("root\@$shellmachine", eval qq("$userdel") ); - } - ''; } @@ -310,24 +403,9 @@ sub delete { 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 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 executed on shellmachine via ssh. 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 @@ -337,9 +415,14 @@ sub replace { return "Username in use" if $old->username ne $new->username && - qsearchs( 'svc_acct', { 'username' => $new->username } ); - - return "Can't change uid!" if $old->uid != $new->uid; + qsearchs( 'svc_acct', { 'username' => $new->username, + 'domsvc' => $new->domsvc, + } ); + { + #no warnings 'numeric'; #alas, a 5.006-ism + local($^W) = 0; + return "Can't change uid!" if $old->uid != $new->uid; + } #change homdir when we change username $new->setfield('dir', '') if $old->username ne $new->username; @@ -351,19 +434,51 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + $error = $new->SUPER::replace($old); - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + 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"; + } + } - 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 ) { - ssh("root\@$shellmachine", eval qq("$usermod") ); } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -379,13 +494,16 @@ Called by the suspend method of FS::cust_pkg (see L). sub suspend { my $self = shift; my %hash = $self->hash; - unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) { + unless ( $hash{_password} =~ /^\*SUSPENDED\* / + || $hash{_password} eq '*' + ) { $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 @@ -403,10 +521,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 @@ -434,19 +553,44 @@ 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; my $ulen = $usernamemax || $self->dbdef_table->column('username')->length; - $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/ - or return "Illegal username"; - $recref->{username} = $1; + if ( $username_uppercase ) { + $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i + or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username}; + $recref->{username} = $1; + } else { + $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ + 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 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 gettext('illegal_username'); } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; @@ -455,7 +599,7 @@ sub check { ! $recref->{popnum} || qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } ); - unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) { + unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) { $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid"; $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1; @@ -466,17 +610,38 @@ 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'; - - $error = $self->ut_textn('finger'); - return $error if $error; - - $recref->{dir} =~ /^([\/\w\-]*)$/ + 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"; - $recref->{dir} = $1 || - $dir_prefix . '/' . $recref->{username} - #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username} + $recref->{dir} = $1; + return "Illegal directory" + if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component + return "Illegal directory" + if $recref->{dir} =~ /\&/ && ! $username_ampersand; + unless ( $recref->{dir} ) { + $recref->{dir} = $dir_prefix . '/'; + if ( $dirhash > 0 ) { + for my $h ( 1 .. $dirhash ) { + $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/'; + } + } elsif ( $dirhash < 0 ) { + for my $h ( reverse $dirhash .. -1 ) { + $recref->{dir} .= substr($recref->{username}, $h, 1). '/'; + } + } + $recref->{dir} .= $recref->{username}; ; + } unless ( $recref->{username} eq 'sync' ) { if ( grep $_ eq $recref->{shell}, @shells ) { @@ -505,7 +670,7 @@ sub check { return "Can't have quota without uid" : ( $recref->{quota}='' ); } - unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) { + unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) { unless ( $recref->{slipip} eq '0e0' ) { $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ or return "Illegal slipip". $self->slipip; @@ -526,7 +691,7 @@ sub check { unless ( $recref->{_password} ); #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) { - if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) { + if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) { $recref->{_password} = $1.$3; #uncomment this to encrypt password immediately upon entry, or run #bin/crypt_pw in cron to give new users a window during which their @@ -542,7 +707,10 @@ sub check { } elsif ( $recref->{_password} eq '!!' ) { $recref->{_password} = '!!'; } else { - return "Illegal password"; + #return "Illegal password"; + return gettext('illegal_password'). "$passwordmin-$passwordmax". + FS::Msgcat::_gettext('illegal_password_characters'). + ": ". $recref->{_password}; } ''; #no error @@ -572,12 +740,17 @@ expected to change in the future. sub radius_reply { my $self = shift; - map { - /^(radius_(.*))$/; - my($column, $attrib) = ($1, $2); - $attrib =~ s/_/\-/g; - ( $attrib, $self->getfield($column) ); - } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); + my %reply = + map { + /^(radius_(.*))$/; + my($column, $attrib) = ($1, $2); + #$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; + } + %reply; } =item radius_check @@ -585,32 +758,63 @@ 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; - ( $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 Returns the domain associated with this account. --cut +=cut sub domain { my $self = shift; - my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ) - or die "svc_acct.domsvc ". $self->domsvc." not found in svc_domain.svcnum"; - $svc_domain->domain; + 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"; + } +} + +=item svc_domain + +Returns the FS::svc_domain record for this account's domain (see +L. + +=cut + +sub svc_domain { + my $self = shift; + $self->{'_domsvc'} + ? $self->{'_domsvc'} + : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } ); +} + +=item cust_svc + +Returns the FS::cust_svc record for this account (see L). + +sub cust_svc { + my $self = shift; + qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); } =item email @@ -624,16 +828,88 @@ sub email { $self->username. '@'. $self->domain; } +=item seconds_since TIMESTAMP + +Returns the number of seconds this account has been online since TIMESTAMP. +See L + +TIMESTAMP is specified as a UNIX timestamp; see L. Also see +L and L for conversion functions. + +=cut + +#note: POD here, implementation in FS::cust_svc +sub seconds_since { + my $self = shift; + $self->cust_svc->seconds_since(@_); +} + +=item radius_groups + +Returns all RADIUS groups for this account (see L). + +=cut + +sub radius_groups { + my $self = shift; + map { $_->groupname } + qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } ); +} + =back -=head1 VERSION +=head1 SUBROUTINES -$Id: svc_acct.pm,v 1.26 2001-08-20 11:04:38 ivan Exp $ +=item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ] -=head1 BUGS +=cut + +sub radius_usergroup_selector { + my $sel_groups = shift; + my %sel_groups = map { $_=>1 } @$sel_groups; + + my $selectname = shift || 'radius_usergroup'; -The bits which ssh should fork before doing so (or maybe queue jobs for a -daemon). + 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; +} + +=head1 BUGS The $recref stuff in sub check should be cleaned up. @@ -641,10 +917,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, L, L, L, -L, L, L, L, L, +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, schema.html from the base documentation. =cut