update to mailserver integration

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

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index a2b7a11..79e9b25 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -17,6 +17,7 @@ use Carp;
 use Fcntl qw(:flock);
 use Date::Format;
 use Crypt::PasswdMD5 1.2;
+use Data::Dumper;
 use FS::UID qw( datasrc );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh dbdef );
@@ -187,6 +188,22 @@ Creates a new account.  To add the account to the database, see L<"insert">.
 
 sub table { 'svc_acct'; }
 
+sub _fieldhandlers {
+  {
+    #false laziness with edit/svc_acct.cgi
+    'usergroup' => sub { 
+                         my( $self, $groups ) = @_;
+                         if ( ref($groups) eq 'ARRAY' ) {
+                           $groups;
+                         } elsif ( length($groups) ) {
+                           [ split(/\s*,\s*/, $groups) ];
+                         } else {
+                           [];
+                         }
+                       },
+  };
+}
+
 =item insert [ , OPTION => VALUE ... ]
 
 Adds this account to the database.  If there is an error, returns the error,
@@ -221,7 +238,11 @@ jobnum(s) (they will not run until the specific job(s) complete(s)).
 sub insert {
   my $self = shift;
   my %options = @_;
-  my $error;
+
+  if ( $DEBUG ) {
+    warn "[$me] insert called on $self: ". Dumper($self).
+         "\nwith options: ". Dumper(%options);
+  }
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -234,7 +255,7 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  $error = $self->check;
+  my $error = $self->check;
   return $error if $error;
 
   if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
@@ -463,6 +484,11 @@ sub replace {
   my $error;
   warn "$me replacing $old with $new\n" if $DEBUG;
 
+  # We absolutely have to have an old vs. new record to make this work.
+  if (!defined($old)) {
+    $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } );
+  }
+
   return "can't modify system account" if $old->_check_system;
 
   {
@@ -682,7 +708,7 @@ sub check {
 
   my($recref) = $self->hashref;
 
-  my $x = $self->setfixed;
+  my $x = $self->setfixed( $self->_fieldhandlers );
   return $x unless ref($x);
   my $part_svc = $x;
 
@@ -902,6 +928,9 @@ per export and with identical I<svcpart> values.
 sub _check_duplicate {
   my $self = shift;
 
+  my $global_unique = $conf->config('global_unique-username') || 'none';
+  return '' if $global_unique eq 'disabled';
+
   #this is Pg-specific.  what to do for mysql etc?
   # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
   warn "$me locking svc_acct table for duplicate search" if $DEBUG;
@@ -914,8 +943,6 @@ sub _check_duplicate {
     return 'unknown svcpart '. $self->svcpart;
   }
 
-  my $global_unique = $conf->config('global_unique-username') || 'none';
-
   my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
                  qsearch( 'svc_acct', { 'username' => $self->username } );
   return gettext('username_in_use')
@@ -1267,7 +1294,7 @@ sub _op_seconds {
     }
   }
 
-  warn "$me update sucessful; committing\n"
+  warn "$me update successful; committing\n"
     if $DEBUG;
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   '';
@@ -1415,6 +1442,8 @@ Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
 sub radius_groups {
   my $self = shift;
   if ( $self->usergroup ) {
+    confess "explicitly specified usergroup not an arrayref: ". $self->usergroup
+      unless ref($self->usergroup) eq 'ARRAY';
     #when provisioning records, export callback runs in svc_Common.pm before
     #radius_usergroup records can be inserted...
     @{$self->usergroup};
@@ -1455,7 +1484,7 @@ sub clone_kludge_unsuspend {
 =item check_password 
 
 Checks the supplied password against the (possibly encrypted) password in the
-database.  Returns true for a sucessful authentication, false for no match.
+database.  Returns true for a successful authentication, false for no match.
 
 Currently supported encryptions are: classic DES crypt() and MD5
 
@@ -1522,13 +1551,63 @@ sub crypt_password {
     } elsif ( $encryption eq 'md5' ) {
       unix_md5_crypt( $self->_password );
     } elsif ( $encryption eq 'blowfish' ) {
-      die "unknown encryption method $encryption";
+      croak "unknown encryption method $encryption";
     } else {
-      die "unknown encryption method $encryption";
+      croak "unknown encryption method $encryption";
     }
   }
 }
 
+=item ldap_password [ DEFAULT_ENCRYPTION_TYPE ]
+
+Returns an encrypted password in "LDAP" format, with a curly-bracked prefix
+describing the format, for example, "{CRYPT}94pAVyK/4oIBk" or
+"{PLAIN-MD5}5426824942db4253f87a1009fd5d2d4f".
+
+The optional DEFAULT_ENCRYPTION_TYPE is not yet used, but the idea is for it
+to work the same as the B</crypt_password> method.
+
+=cut
+
+sub ldap_password {
+  my $self = shift;
+  #eventually should check a "password-encoding" field
+  if ( length($self->_password) == 13 ) { #crypt
+    return '{CRYPT}'. $self->_password;
+  } elsif ( $self->_password =~ /^\$1\$(.*)$/ && length($1) == 31 ) { #passwdMD5
+    return '{MD5}'. $1;
+  } elsif ( $self->_password =~ /^\$2a?\$(.*)$/ ) { #Blowfish
+    die "Blowfish encryption not supported in this context, svcnum ".
+        $self->svcnum. "\n";
+  } else { #plaintext
+    return '{PLAIN}'. self->_password;
+    #my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
+    #if ( $encryption eq 'crypt' ) {
+    #  return '{CRYPT}'. crypt(
+    #    $self->_password,
+    #    $saltset[int(rand(64))].$saltset[int(rand(64))]
+    #  );
+    #} elsif ( $encryption eq 'md5' ) {
+    #  unix_md5_crypt( $self->_password );
+    #} elsif ( $encryption eq 'blowfish' ) {
+    #  croak "unknown encryption method $encryption";
+    #} else {
+    #  croak "unknown encryption method $encryption";
+    #}
+  }
+}
+
+=item domain_slash_username
+
+Returns $domain/$username/
+
+=cut
+
+sub domain_slash_username {
+  my $self = shift;
+  $self->domain. '/'. $self->username. '/';
+}
+
 =item virtual_maildir
 
 Returns $domain/maildirs/$username/