RT#29354: Password Security in Email [v3 merge]
[freeside.git] / FS / FS / svc_acct.pm
index 354dd3a..203150f 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
@@ -40,6 +44,7 @@ use FS::Record qw( qsearch qsearchs fields dbh dbdef );
 use FS::Msgcat qw(gettext);
 use FS::UI::bytecount;
 use FS::UI::Web;
+use FS::PagedSearch qw( psearch ); # XXX in v4, replace with FS::Cursor
 use FS::part_pkg;
 use FS::part_svc;
 use FS::svc_acct_pop;
@@ -260,6 +265,7 @@ sub table_info {
     'display_weight' => 10,
     'cancel_weight'  => 50, 
     'ip_field' => 'slipip',
+    'manual_require' => 1,
     'fields' => {
         'dir'       => 'Home directory',
         'uid'       => {
@@ -283,6 +289,7 @@ sub table_info {
                          disable_default => 1,
                          disable_fixed => 1,
                          disable_select => 1,
+                         required => 1,
                        },
         'password_selfchange' => { label => 'Password modification',
                                    type  => 'checkbox',
@@ -294,27 +301,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',
@@ -337,6 +342,7 @@ sub table_info {
                          select_key   => 'svcnum',
                          select_label => 'domain',
                          disable_inventory => 1,
+                         required => 1,
                        },
         'pbxsvc'    => { label => 'PBX',
                          type  => 'select-svc_pbx.html',
@@ -699,6 +705,9 @@ sub insert {
     'child_objects' => $self->child_objects,
     %options,
   );
+
+  $error ||= $self->insert_password_history;
+
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -983,6 +992,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;
@@ -2380,65 +2395,94 @@ sub last_login_text {
   $self->last_login ? ctime($self->last_login) : 'unknown';
 }
 
-=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
+=item psearch_cdrs OPTIONS
+
+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.
 
 =cut
 
-sub get_cdrs {
-  my($self, $start, $end, %opt ) = @_;
-
-  my $did = $self->username; #yup
-
-  my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
-
-  my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
-
-  #SELECT $for_update * FROM cdr
-  #  WHERE calldate >= $start #need a conversion
-  #    AND calldate <  $end   #ditto
-  #    AND (    charged_party = "$did"
-  #          OR charged_party = "$prefix$did" #if length($prefix);
-  #          OR ( ( charged_party IS NULL OR charged_party = '' )
-  #               AND
-  #               ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
-  #             )
-  #        )
-  #    AND ( freesidestatus IS NULL OR freesidestatus = '' )
-
-  my $charged_or_src;
-  if ( length($prefix) ) {
-    $charged_or_src =
-      " AND (    charged_party = '$did' 
-              OR charged_party = '$prefix$did'
-              OR ( ( charged_party IS NULL OR charged_party = '' )
-                   AND
-                   ( src = '$did' OR src = '$prefix$did' )
-                 )
-            )
-      ";
-  } else {
-    $charged_or_src = 
-      " AND (    charged_party = '$did' 
-              OR ( ( charged_party IS NULL OR charged_party = '' )
-                   AND
-                   src = '$did'
-                 )
-            )
-      ";
+sub psearch_cdrs {
+  my($self, %options) = @_;
+  my @fields;
+  my %hash;
+  my @where;
+
+  my $did = dbh->quote($self->username);
+
+  my $prefix = $options{'default_prefix'} || ''; #convergent.au '+61'
+  my $prefixdid = dbh->quote($prefix . $self->username);
+
+  my $for_update = $options{'for_update'} ? 'FOR UPDATE' : '';
+
+  if ( $options{inbound} ) {
+    # these will be selected under their DIDs
+    push @where, "FALSE";
+  }
+
+  my @orwhere;
+  if (!$options{'disable_charged_party'}) {
+    push @orwhere,
+      "charged_party = $did",
+      "charged_party = $prefixdid";
+  }
+  if (!$options{'disable_src'}) {
+    push @orwhere,
+      "src = $did AND charged_party IS NULL",
+      "src = $prefixdid AND charged_party IS NULL";
+  }
+  push @where, '(' . join(' OR ', @orwhere) . ')';
 
+  # $options{'status'} = '' is meaningful; for the rest of them it's not
+  if ( exists $options{'status'} ) {
+    $hash{'freesidestatus'} = $options{'status'};
   }
+  if ( $options{'cdrtypenum'} ) {
+    $hash{'cdrtypenum'} = $options{'cdrtypenum'};
+  }
+  if ( $options{'calltypenum'} ) {
+    $hash{'calltypenum'} = $options{'calltypenum'};
+  }
+  if ( $options{'begin'} ) {
+    push @where, 'startdate >= '. $options{'begin'};
+  } 
+  if ( $options{'end'} ) {
+    push @where, 'startdate < '.  $options{'end'};
+  } 
+  if ( $options{'nonzero'} ) {
+    push @where, 'duration > 0';
+  } 
 
-  qsearch(
-    'select'    => "$for_update *",
+  my $extra_sql = join(' AND ', @where);
+  if ($extra_sql) {
+    if (keys %hash) {
+      $extra_sql = " AND ".$extra_sql;
+    } else {
+      $extra_sql = " WHERE ".$extra_sql;
+    }
+  }
+  return psearch({
+    'select'    => '*',
     'table'     => 'cdr',
-    'hashref'   => {
-                     #( freesidestatus IS NULL OR freesidestatus = '' )
-                     'freesidestatus' => '',
-                   },
-    'extra_sql' => $charged_or_src,
+    'hashref'   => \%hash,
+    'extra_sql' => $extra_sql,
+    'order_by'  => "ORDER BY startdate $for_update",
+  });
+}
 
-  );
+=item get_cdrs (DEPRECATED)
+
+Like psearch_cdrs, but returns all the L<FS::cdr> objects at once, in a 
+single list. Arguments are the same as for psearch_cdrs.
 
+=cut
+
+sub get_cdrs {
+  my $self = shift;
+  my $psearch = $self->psearch_cdrs(@_);
+  qsearch ( $psearch->{query} )
 }
 
 # sub radius_groups has moved to svc_Radius_Mixin
@@ -2731,6 +2775,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