X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fldap.pm;h=823d99dbf1ad57d065fd760d2bc1f5a7f52d85a6;hb=7b125e587a4d1ee0aca692e23ea7897f671855ae;hp=83853202142b4601037b7ef76bbb852fd06e1983;hpb=995a145c931164347683071c95c6754379d36604;p=freeside.git

diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm
index 838532021..823d99dbf 100644
--- a/FS/FS/part_export/ldap.pm
+++ b/FS/FS/part_export/ldap.pm
@@ -11,8 +11,6 @@ tie my %options, 'Tie::IxHash',
   'dn'         => { label=>'Root DN' },
   'password'   => { label=>'Root DN password' },
   'userdn'     => { label=>'User DN' },
-  'key_attrib' => { label=>'Key attribute name',
-                    default=>'uid' },
   'attributes' => { label=>'Attributes',
                     type=>'textarea',
                     default=>join("\n",
@@ -51,50 +49,31 @@ END
 
 sub rebless { shift; }
 
-sub svc_context_eval {
-  # This should possibly be in svc_Common?
-  # Except the only places we use it are here and in shellcommands,
-  # and it's not even the same version.
-  my $svc_acct = shift;
-  no strict 'refs';
-  ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
-  ${$_} = $svc_acct->$_() foreach qw( domain ldap_password );
-  my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
-  if ( $cust_pkg ) {
-    my $cust_main = $cust_pkg->cust_main;
-    ${$_} = $cust_main->getfield($_) foreach qw(first last);
+sub _export_insert {
+  my($self, $svc_acct) = (shift, shift);
+
+  #false laziness w/shellcommands.pm
+  {
+    no strict 'refs';
+    ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
+    ${$_} = $svc_acct->$_() foreach qw( domain );
+    my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
+    if ( $cust_pkg ) {
+      my $cust_main = $cust_pkg->cust_main;
+      ${$_} = $cust_main->getfield($_) foreach qw(first last);
+    }
   }
-  # DEPRECATED, probably fails for non-plain password encoding
   $crypt_password = ''; #surpress "used only once" warnings
   $crypt_password = '{crypt}'. crypt( $svc_acct->_password,
                              $saltset[int(rand(64))].$saltset[int(rand(64))] );
 
-  return map { eval(qq("$_")) } @_ ;
-}
-
-sub key_attrib {
-  my $self = shift;
-  return $self->option('key_attrib') if $self->option('key_attrib');
-  # otherwise, guess that it's the one that's set to $username
-  foreach ( split("\n",$self->option('attributes')) ) {
-    /^\s*(\w+)\s+\$username\s*$/ && return $1;
-  }
-  # can't recover from that, but we can fail in a more obvious way 
-  # than the old code did...
-  die "no key_attrib set in LDAP export\n";
-}
-
-sub ldap_attrib {
-  # Convert the svc_acct to its LDAP attribute set.
-  my($self, $svc_acct) = (shift, shift);
+  my $username_attrib;
   my %attrib = map    { /^\s*(\w+)\s+(.*\S)\s*$/;
-                        ( $1 => $2 ); }
+                        $username_attrib = $1 if $2 eq '$username';
+                        ( $1 => eval(qq("$2")) );                   }
                  grep { /^\s*(\w+)\s+(.*\S)\s*$/ }
                    split("\n", $self->option('attributes'));
 
-  my @vals = svc_context_eval($svc_acct, values(%attrib));
-  @attrib{keys(%attrib)} = @vals;
-
   if ( $self->option('radius') ) {
     foreach my $table (qw(reply check)) {
       my $method = "radius_$table";
@@ -105,20 +84,22 @@ sub ldap_attrib {
       }
     }
   }
-  return %attrib;
-}
-
-sub _export_insert {
-  my($self, $svc_acct) = (shift, shift);
 
-  my $err_or_queue = $self->ldap_queue( 
-    $svc_acct->svcnum, 
-    'insert',
-    $self->key_attrib,
-    $self->ldap_attrib($svc_acct),
-  );
+  my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert',
+    #$svc_acct->username,
+    $username_attrib,
+    %attrib );
   return $err_or_queue unless ref($err_or_queue);
 
+  #groups with LDAP?
+  #my @groups = $svc_acct->radius_groups;
+  #if ( @groups ) {
+  #  my $err_or_queue = $self->ldap_queue(
+  #    $svc_acct->svcnum, 'usergroup_insert',
+  #    $svc_acct->username, @groups );
+  #  return $err_or_queue unless ref($err_or_queue);
+  #}
+
   '';
 }
 
@@ -132,42 +113,109 @@ sub _export_replace {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
+  return "can't (yet?) change username with ldap"
+    if $old->username ne $new->username;
+
+  return "ldap replace unimplemented";
+
   my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
   my $jobnum = '';
+  #if ( $old->username ne $new->username ) {
+  #  my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename',
+  #    $new->username, $old->username );
+  #  unless ( ref($err_or_queue) ) {
+  #    $dbh->rollback if $oldAutoCommit;
+  #    return $err_or_queue;
+  #  }
+  #  $jobnum = $err_or_queue->jobnum;
+  #}
+
+  foreach my $table (qw(reply check)) {
+    my $method = "radius_$table";
+    my %new = $new->$method();
+    my %old = $old->$method();
+    if ( grep { !exists $old{$_} #new attributes
+                || $new{$_} ne $old{$_} #changed
+              } keys %new
+    ) {
+      my $err_or_queue = $self->ldap_queue( $new->svcnum, 'insert',
+        $table, $new->username, %new );
+      unless ( ref($err_or_queue) ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $err_or_queue;
+      }
+      if ( $jobnum ) {
+        my $error = $err_or_queue->depend_insert( $jobnum );
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
+      }
+    }
 
-  # the Lazy way: nuke the entry and recreate it.
-  # any reason this shouldn't work?  Freeside _has_ to have 
-  # write access to these entries and their parent DN.
-  my $key = $self->key_attrib;
-  my %attrib = $self->ldap_attrib($old);
-  my $err_or_queue = $self->ldap_queue( 
-    $old->svcnum,
-    'delete', 
-    $key,
-    $attrib{$key}
-  );
-  if( !ref($err_or_queue) ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $err_or_queue;
+    my @del = grep { !exists $new{$_} } keys %old;
+    if ( @del ) {
+      my $err_or_queue = $self->ldap_queue( $new->svcnum, 'attrib_delete',
+        $table, $new->username, @del );
+      unless ( ref($err_or_queue) ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $err_or_queue;
+      }
+      if ( $jobnum ) {
+        my $error = $err_or_queue->depend_insert( $jobnum );
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return $error;
+        }
+      }
+    }
   }
-  $jobnum = $err_or_queue->jobnum;
-  $err_or_queue = $self->ldap_queue( 
-    $new->svcnum, 
-    'insert',
-    $key,
-    $self->ldap_attrib($new)
-  );
-  if( !ref($err_or_queue) ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $err_or_queue;
+
+  # (sorta) false laziness with FS::svc_acct::replace
+  my @oldgroups = @{$old->usergroup}; #uuuh
+  my @newgroups = $new->radius_groups;
+  my @delgroups = ();
+  foreach my $oldgroup ( @oldgroups ) {
+    if ( grep { $oldgroup eq $_ } @newgroups ) {
+      @newgroups = grep { $oldgroup ne $_ } @newgroups;
+      next;
+    }
+    push @delgroups, $oldgroup;
   }
-  $err_or_queue = $err_or_queue->depend_insert($jobnum);
-  if( $err_or_queue ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $err_or_queue;
+
+  if ( @delgroups ) {
+    my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete',
+      $new->username, @delgroups );
+    unless ( ref($err_or_queue) ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $err_or_queue;
+    }
+    if ( $jobnum ) {
+      my $error = $err_or_queue->depend_insert( $jobnum );
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
+  }
+
+  if ( @newgroups ) {
+    my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert',
+      $new->username, @newgroups );
+    unless ( ref($err_or_queue) ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $err_or_queue;
+    }
+    if ( $jobnum ) {
+      my $error = $err_or_queue->depend_insert( $jobnum );
+      if ( $error ) {
+        $dbh->rollback if $oldAutoCommit;
+        return $error;
+      }
+    }
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -177,13 +225,9 @@ sub _export_replace {
 
 sub _export_delete {
   my( $self, $svc_acct ) = (shift, shift);
-
-  my $key = $self->key_attrib;
-  my ( $val ) = map { /^\s*$key\s+(.*\S)\s*$/ ? $1 : () }
-                    split("\n", $self->option('attributes'));
-  ( $val ) = svc_context_eval($svc_acct, $val);
+  return "ldap delete unimplemented";
   my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete',
-    $key, $val );
+    $svc_acct->username );
   ref($err_or_queue) ? '' : $err_or_queue;
 }
 
@@ -204,9 +248,10 @@ sub ldap_queue {
 
 sub ldap_insert { #subroutine, not method
   my $ldap = ldap_connect(shift, shift, shift);
-  my( $userdn, $key_attrib, %attrib ) = @_;
+  my( $userdn, $username_attrib, %attrib ) = @_;
 
-  $userdn = "$key_attrib=$attrib{$key_attrib}, $userdn";
+  $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn"
+    if $username_attrib;
   #icky hack, but should be unsurprising to the LDAPers
   foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) {
     $attrib{$key} = [ split(/,/, $attrib{$key}) ]; 
@@ -218,32 +263,17 @@ sub ldap_insert { #subroutine, not method
   $ldap->unbind;
 }
 
-sub ldap_delete {
-  my $ldap = ldap_connect(shift, shift, shift);
-
-  my $entry = ldap_fetch($ldap, @_);
-  if($entry) {
-    my $status = $ldap->delete($entry);
-    die 'LDAP error: '.$status->error."\n" if $status->is_error;
-  }
-  $ldap->unbind;
-  # should failing to find the entry be fatal?
-  # if it is, it will block unprovisioning the service, which is a pain.
-}
-
-sub ldap_fetch {
-  # avoid needless duplication in delete and modify
-  my( $ldap, $userdn, %key_data ) = @_;
-  my $filter = join('', map { "($_=$key_data{$_})" } keys(%key_data));
-
-  my $status = $ldap->search( base => $userdn,
-                              scope => 'one', 
-                              filter => $filter );
-  die 'LDAP error: '.$status->error."\n" if $status->is_error;
-  my ($entry) = $status->entries;
-  warn "Entry '$filter' not found in LDAP\n" if !$entry;
-  return $entry;
-}
+#sub ldap_delete { #subroutine, not method
+#  my $dbh = ldap_connect(shift, shift, shift);
+#  my $username = shift;
+#
+#  foreach my $table (qw( radcheck radreply usergroup )) {
+#    my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
+#    $sth->execute($username)
+#      or die "can't delete from $table table: ". $sth->errstr;
+#  }
+#  $dbh->disconnect;
+#}
 
 sub ldap_connect {
   my( $machine, $dn, $password ) = @_;