X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=28c0f57a43f1741da6901c43d36539a2a7f94dce;hb=be58a1538ce963c4d3b6319c163960513703108d;hp=46208aa227778c5aac475f3aa22dd9a069924060;hpb=310a027b9b72cf7d98c7f3e05b3bd1164077f2ab;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 46208aa22..28c0f57a4 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -2,8 +2,9 @@ package FS::svc_acct; use strict; use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin - $usernamemax $passwordmin $username_letter $username_letterfirst - $username_noperiod + $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 $dirhash @@ -33,6 +34,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $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') ) @@ -57,6 +59,8 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_letter = $conf->exists('username-letter'); $username_letterfirst = $conf->exists('username-letterfirst'); $username_noperiod = $conf->exists('username-noperiod'); + $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) = @@ -67,9 +71,15 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $cyrus_admin_user = ''; $cyrus_admin_pass = ''; } - if ( $conf->exists('icradius_secrets') ) { - $icradius_dbh = DBI->connect($conf->config('icradius_secrets')) - or die $DBI::errstr; + 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 = ''; } @@ -81,6 +91,18 @@ $FS::UID::callback{'FS::svc_acct'} = sub { #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 FS::svc_acct - Object methods for svc_acct records @@ -257,15 +279,29 @@ sub insert { } } if ( $icradius_dbh ) { - my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' }; - $error = $queue->insert( $self->username, - $self->_password, - $self->radius_check - ); + + 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 ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -337,6 +373,25 @@ sub icradius_rc_insert { 1; } +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; + } + + 1; +} + =item delete Deletes this account from the database. If there is an error, returns the @@ -399,9 +454,10 @@ sub delete { foreach my $cust_main_invoice ( qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } ) ) { - #next unless defined; #wtf is up with qsearch? - warn $cust_main_invoice; - next unless defined $cust_main_invoice; + 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; @@ -454,12 +510,21 @@ sub delete { } } if ( $icradius_dbh ) { + my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' }; $error = $queue->insert( $self->username ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } + + my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' }; + $error = $queue->insert( $self->username ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -499,6 +564,18 @@ sub icradius_rc_delete { 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; +} + =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, @@ -532,9 +609,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; + } return "can't change username using Cyrus" if $cyrus_server && $old->username ne $new->username; @@ -613,7 +695,9 @@ 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); @@ -674,9 +758,16 @@ sub check { 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 "Illegal username: ". $recref->{username}; + $recref->{username} = $1; + } else { + $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/ + or return "Illegal username: ". $recref->{username}; + $recref->{username} = $1; + } + if ( $username_letterfirst ) { $recref->{username} =~ /^[a-z]/ or return "Illegal username"; } elsif ( $username_letter ) { @@ -685,6 +776,9 @@ sub check { if ( $username_noperiod ) { $recref->{username} =~ /\./ and return "Illegal username"; } + unless ( $username_ampersand ) { + $recref->{username} =~ /\&/ and return "Illegal username"; + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; @@ -705,12 +799,20 @@ sub check { return "Only root can have uid 0" if $recref->{uid} == 0 && $recref->{username} ne 'root'; - $error = $self->ut_textn('finger'); - return $error if $error; +# $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\-]*)$/ + $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ or return "Illegal directory"; $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 ) { @@ -774,7 +876,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 @@ -790,7 +892,8 @@ sub check { } elsif ( $recref->{_password} eq '!!' ) { $recref->{_password} = '!!'; } else { - return "Illegal password"; + #return "Illegal password"; + return "Illegal password: ". $recref->{_password}; } ''; #no error @@ -820,12 +923,17 @@ expected to change in the future. sub radius_reply { my $self = shift; - 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 ); + 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 @@ -857,7 +965,8 @@ Returns the domain associated with this account. sub domain { my $self = shift; if ( $self->domsvc ) { - my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $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 { @@ -865,6 +974,20 @@ sub domain { } } +=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 email Returns an email address associated with the account. @@ -908,7 +1031,7 @@ sub ssh { =head1 VERSION -$Id: svc_acct.pm,v 1.46 2001-09-19 21:06:17 ivan Exp $ +$Id: svc_acct.pm,v 1.61 2002-01-14 20:28:17 ivan Exp $ =head1 BUGS