support for radius check attributes (except importing). poorly documented.

[freeside.git] / FS / FS / svc_acct.pm

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index b2f23c9..558e383 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -1,8 +1,10 @@
 package FS::svc_acct;
 
 use strict;
-use vars qw(@ISA $nossh_hack $conf $dir_prefix @shells
-            $shellmachine @saltset @pw_set);
+use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
+             $usernamemax $passwordmin
+             $shellmachine @saltset @pw_set);
+use Carp;
 use FS::Conf;
 use FS::Record qw( qsearchs fields );
 use FS::svc_Common;
@@ -18,6 +20,9 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $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;
 };
 
 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
@@ -50,6 +55,8 @@ FS::svc_acct - Object methods for svc_acct records
 
   $error = $record->cancel;
 
+  %hash = $record->radius;
+
 =head1 DESCRIPTION
 
 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
@@ -338,13 +345,13 @@ sub check {
   return $x unless ref($x);
   my $part_svc = $x;
 
-  my $ulen =$self->dbdef_table->column('username')->length;
-  $recref->{username} =~ /^([a-z0-9_\-]{2,$ulen})$/
+  my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
+  $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
     or return "Illegal username";
   $recref->{username} = $1;
   $recref->{username} =~ /[a-z]/ or return "Illegal username";
 
-  $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum";
+  $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
   $recref->{popnum} = $1;
   return "Unkonwn popnum" unless
     ! $recref->{popnum} ||
@@ -374,9 +381,8 @@ sub check {
     ;
 
     unless ( $recref->{username} eq 'sync' ) {
-      my($shell);
-      if ( $shell = (grep $_ eq $recref->{shell}, @shells)[0] ) {
-        $recref->{shell} = $shell;
+      if ( grep $_ eq $recref->{shell}, @shells ) {
+        $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
       } else {
         return "Illegal shell \`". $self->shell. "\'; ".
                $conf->dir. "/shells contains: @shells";
@@ -422,7 +428,7 @@ sub check {
     unless ( $recref->{_password} );
 
   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
-  if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,8})$/ ) {
+  if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
     $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
@@ -431,7 +437,7 @@ sub check {
     #$recref->{password} = $1.
     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
     #;
-  } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/]{13,24})$/ ) {
+  } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
     $recref->{_password} = $1.$3;
   } elsif ( $recref->{_password} eq '*' ) {
     $recref->{_password} = '*';
@@ -442,11 +448,61 @@ sub check {
   ''; #no error
 }
 
+=item radius
+
+Depriciated, use radius_reply instead.
+
+=cut
+
+sub radius {
+  carp "FS::svc_acct::radius depriciated, use radius_reply";
+  $_[0]->radius_reply;
+}
+
+=item radius_reply
+
+Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
+reply attributes of this record.
+
+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_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 );
+}
+
+=item radius_check
+
+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.
+
 =back
 
+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 );
+}
+
 =head1 VERSION
 
-$Id: svc_acct.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $
+$Id: svc_acct.pm,v 1.9 2000-07-06 08:57:27 ivan Exp $
 
 =head1 BUGS
 
@@ -456,6 +512,10 @@ The bits which ssh should fork before doing so.
 
 The $recref stuff in sub check should be cleaned up.
 
+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.
+
 =head1 SEE ALSO
 
 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,