alas, a 5.6-ism

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

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 3530001..139303b 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -2,7 +2,8 @@ package FS::svc_acct;
 
 use strict;
 use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
-             $usernamemax $passwordmin $username_letter $username_letterfirst
+             $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
@@ -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') )
@@ -58,6 +60,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $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) =
@@ -82,6 +85,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
@@ -400,9 +415,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;
@@ -533,9 +549,13 @@ 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
+    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;
@@ -676,13 +696,14 @@ sub check {
 
   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} =~ /^([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} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
+      or return "Illegal username: ". $recref->{username};
+    $recref->{username} = $1;
   }
-  $recref->{username} = $1;
 
   if ( $username_letterfirst ) {
     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
@@ -692,6 +713,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;
@@ -715,13 +739,17 @@ sub check {
 #    $error = $self->ut_textn('finger');
 #    return $error if $error;
     $self->getfield('finger') =~
-      /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*]*)$/
+      /^([\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 ) {
@@ -785,7 +813,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
@@ -801,7 +829,8 @@ sub check {
   } elsif ( $recref->{_password} eq '!!' ) {
     $recref->{_password} = '!!';
   } else {
-    return "Illegal password";
+    #return "Illegal password";
+    return "Illegal password: ". $recref->{_password};
   }
 
   ''; #no error
@@ -868,7 +897,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 {
@@ -876,6 +906,20 @@ sub domain {
   }
 }
 
+=item svc_domain
+
+Returns the FS::svc_domain record for this account's domain (see
+L<FS::svc_domain>.
+
+=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.
@@ -919,7 +963,7 @@ sub ssh {
 
 =head1 VERSION
 
-$Id: svc_acct.pm,v 1.47 2001-09-30 20:30:09 ivan Exp $
+$Id: svc_acct.pm,v 1.58 2001-12-19 14:33:48 ivan Exp $
 
 =head1 BUGS