RT# 81961 Repair broken links in POD documentation
[freeside.git] / FS / FS / svc_acct.pm
index ab86915..efe6c73 100644 (file)
@@ -7,7 +7,11 @@ use base qw( FS::svc_Domain_Mixin
              FS::svc_Radius_Mixin
              FS::svc_Tower_Mixin
              FS::svc_IP_Mixin
-             FS::svc_Common );
+             FS::Password_Mixin
+             FS::svc_Common
+           );
+
+use strict;
 use vars qw( $DEBUG $me $conf $skip_fuzzyfiles
              $dir_prefix @shells $usernamemin
              $usernamemax $passwordmin $passwordmax
@@ -110,12 +114,11 @@ FS::UID->install_callback( sub {
   $smtpmachine = $conf->config('smtpmachine');
   $radius_password = $conf->config('radius-password') || 'Password';
   $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
-  @pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps');
+  @pw_set = FS::svc_acct->pw_set;
 }
 );
 
 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
-@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '.', ',' );
 
 sub _cache {
   my $self = shift;
@@ -261,6 +264,7 @@ sub table_info {
     'display_weight' => 10,
     'cancel_weight'  => 50, 
     'ip_field' => 'slipip',
+    'manual_require' => 1,
     'fields' => {
         'dir'       => 'Home directory',
         'uid'       => {
@@ -284,6 +288,7 @@ sub table_info {
                          disable_default => 1,
                          disable_fixed => 1,
                          disable_select => 1,
+                         required => 1,
                        },
         'password_selfchange' => { label => 'Password modification',
                                    type  => 'checkbox',
@@ -295,27 +300,25 @@ sub table_info {
                          label => 'Quota', #Mail storage limit
                          type => 'text',
                          disable_inventory => 1,
-                         disable_select => 1,
                        },
         'file_quota'=> { 
                          label => 'File storage limit',
                          type => 'text',
                          disable_inventory => 1,
-                         disable_select => 1,
                        },
         'file_maxnum'=> { 
                          label => 'Number of files limit',
                          type => 'text',
                          disable_inventory => 1,
-                         disable_select => 1,
                        },
         'file_maxsize'=> { 
                          label => 'File size limit',
                          type => 'text',
                          disable_inventory => 1,
-                         disable_select => 1,
                        },
-        '_password' => 'Password',
+        '_password' => { label => 'Password',
+          #required => 1
+                       },
         'gid'       => {
                          label    => 'GID',
                         def_info => 'when blank, defaults to UID',
@@ -334,10 +337,12 @@ sub table_info {
         'domsvc'    => {
                          label     => 'Domain',
                          type      => 'select',
+                         select_svc => 1,
                          select_table => 'svc_domain',
                          select_key   => 'svcnum',
                          select_label => 'domain',
                          disable_inventory => 1,
+                         required => 1,
                        },
         'pbxsvc'    => { label => 'PBX',
                          type  => 'select-svc_pbx.html',
@@ -345,6 +350,15 @@ sub table_info {
                          disable_select => 1, #UI wonky, pry works otherwise
                        },
         'sectornum' => 'Tower sector',
+        'routernum' => 'Router/block',
+        'blocknum'  => {
+                         'label' => 'Address block',
+                         'type'  => 'select',
+                         'select_table' => 'addr_block',
+                          'select_key'   => 'blocknum',
+                         'select_label' => 'cidr',
+                         'disable_inventory' => 1,
+                       },
         'usergroup' => {
                          label => 'RADIUS groups',
                          type  => 'select-radius_group.html',
@@ -700,6 +714,9 @@ sub insert {
     'child_objects' => $self->child_objects,
     %options,
   );
+
+  $error ||= $self->insert_password_history;
+
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -730,7 +747,7 @@ sub insert {
 
     #welcome email
     my @welcome_exclude_svcparts = $conf->config('svc_acct_welcome_exclude');
-    unless ( grep { $_ eq $self->svcpart } @welcome_exclude_svcparts ) {
+    unless ($FS::svc_Common::noexport_hack or ( grep { $_ eq $self->svcpart } @welcome_exclude_svcparts )) {
         my $error = '';
         my $msgnum = $conf->config('welcome_msgnum', $agentnum);
         if ( $msgnum ) {
@@ -917,7 +934,19 @@ sub delete {
     }
   }
 
-  my $error = $self->SUPER::delete; # usergroup here
+  foreach my $svc_phone (
+    qsearch( 'svc_phone', { 'forward_svcnum' => $self->svcnum })
+  ) {
+    $svc_phone->set('forward_svcnum', '');
+    my $error = $svc_phone->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  my $error = $self->delete_password_history
+           || $self->SUPER::delete; # usergroup here
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -984,6 +1013,12 @@ sub replace {
   my $dbh = dbh;
 
   $error = $new->SUPER::replace($old, @_); # usergroup here
+
+  # don't need to record this unless the password was changed
+  if ( $old->_password ne $new->_password ) {
+    $error ||= $new->insert_password_history;
+  }
+
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error if $error;
@@ -1387,8 +1422,7 @@ sub check {
       $recref->{_password} = $1;
     } else {
       return gettext('illegal_password'). " $passwordmin-$passwordmax ".
-             FS::Msgcat::_gettext('illegal_password_characters').
-             ": ". $recref->{_password};
+             FS::Msgcat::_gettext('illegal_password_characters');
     }
 
     if ( $password_noampersand ) {
@@ -2069,14 +2103,16 @@ sub _op_usage {
   die "Can't update $column for svcnum". $self->svcnum
     if $rv == 0;
 
-  #$self->snapshot; #not necessary, we retain the old values
-  #create an object with the updated usage values
-  my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
-  #call exports
-  my $error = $new->replace($self);
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return "Error replacing: $error";
+  if ( $conf->exists('radius-chillispot-max') ) {
+    #$self->snapshot; #not necessary, we retain the old values
+    #create an object with the updated usage values
+    my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+    #call exports
+    my $error = $new->replace($self);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error replacing: $error";
+    }
   }
 
   #overlimit_action eq 'cancel' handling
@@ -2272,15 +2308,17 @@ sub set_usage {
     die "Can't update usage for svcnum ". $self->svcnum
       if $rv == 0;
   }
-
-  #$self->snapshot; #not necessary, we retain the old values
-  #create an object with the updated usage values
-  my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
-  local($FS::Record::nowarn_identical) = 1;
-  my $error = $new->replace($self); #call exports
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return "Error replacing: $error";
+  
+  if ( $conf->exists('radius-chillispot-max') ) {
+    #$self->snapshot; #not necessary, we retain the old values
+    #create an object with the updated usage values
+    my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+    local($FS::Record::nowarn_identical) = 1;
+    my $error = $new->replace($self); #call exports
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error replacing: $error";
+    }
   }
 
   if ( $reset ) {
@@ -2357,7 +2395,7 @@ sub is_rechargable {
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds this account has been online since TIMESTAMP,
-according to the session monitor (see L<FS::Session>).
+according to the session monitor (see L<FS::session>).
 
 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
 L<Time::Local> and L<Date::Parse> for conversion functions.
@@ -2385,8 +2423,8 @@ sub last_login_text {
 
 Returns a paged search (L<FS::PagedSearch>) for Call Detail Records
 associated with this service. For svc_acct, "associated with" means that
-either the "src" or the "charged_party" field of the CDR matches the
-"username" field of the service.
+either the "src" or the "charged_party" field of the CDR matches either
+the "username" field of the service or the username@domain label.
 
 =cut
 
@@ -2397,6 +2435,7 @@ sub psearch_cdrs {
   my @where;
 
   my $did = dbh->quote($self->username);
+  my $diddomain = dbh->quote($self->label);
 
   my $prefix = $options{'default_prefix'} || ''; #convergent.au '+61'
   my $prefixdid = dbh->quote($prefix . $self->username);
@@ -2412,12 +2451,16 @@ sub psearch_cdrs {
   if (!$options{'disable_charged_party'}) {
     push @orwhere,
       "charged_party = $did",
-      "charged_party = $prefixdid";
+      "charged_party = $prefixdid",
+      "charged_party = $diddomain"
+      ;
   }
   if (!$options{'disable_src'}) {
     push @orwhere,
       "src = $did AND charged_party IS NULL",
-      "src = $prefixdid AND charged_party IS NULL";
+      "src = $prefixdid AND charged_party IS NULL",
+      "src = $diddomain AND charged_party IS NULL"
+      ;
   }
   push @where, '(' . join(' OR ', @orwhere) . ')';
 
@@ -2761,6 +2804,25 @@ sub virtual_maildir {
   $self->domain. '/maildirs/'. $self->username. '/';
 }
 
+=item password_svc_check
+
+Override, for L<FS::Password_Mixin>.  Not really intended for other use.
+
+=cut
+
+sub password_svc_check {
+  my ($self, $password) = @_;
+  foreach my $field ( qw(username finger) ) {
+    foreach my $word (split(/\W+/,$self->get($field))) {
+      next unless length($word) > 2;
+      if ($password =~ /$word/i) {
+        return qq(Password contains account information '$word');
+      }
+    }
+  }
+  return '';
+}
+
 =back
 
 =head1 CLASS METHODS