FS/FS/part_export/ldap.pm

   1 package FS::part_export::ldap;
   2
   3 use vars qw(@ISA);
   4 use FS::Record qw( dbh );
   5 use FS::part_export;
   6
   7 @ISA = qw(FS::part_export);
   8
   9 sub rebless { shift; }
  10
  11 sub _export_insert {
  12   my($self, $svc_acct) = (shift, shift);
  13
  14   #false laziness w/shellcommands.pm
  15   {
  16     no strict 'refs';
  17     ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
  18     ${$_} = $svc_acct->$_() foreach qw( domain );
  19     my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
  20     if ( $cust_pkg ) {
  21       my $cust_main = $cust_pkg->cust_main;
  22       ${$_} = $cust_main->getfield($_) foreach qw(first last);
  23     }
  24   }
  25   $crypt_password = ''; #surpress "used only once" warnings
  26   $crypt_password = crypt( $svc_acct->_password,
  27                              $saltset[int(rand(64))].$saltset[int(rand(64))] );
  28
  29
  30   my %attrib = map    { /^\s*(\w+)\s+(.*\S)\s*$/; ( $1 => eval(qq("$2")) ); }
  31                  grep { /^\s*(\w+)\s+(.*\S)\s*$/ }
  32                    split("\n", $self->option('attributes'));
  33
  34   if ( $self->option('radius') {
  35     foreach my $table (qw(reply check)) {
  36       my $method = "radius_$table";
  37       my %radius = $svc_acct->$method();
  38       foreach my $radius ( keys %radius ) {
  39         ( my $ldap = $radius ) =~ s/\-//g;
  40         $attrib{$ldap} = $radius{$radius};
  41       }
  42     }
  43   }
  44
  45   my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert',
  46     #$svc_acct->username,
  47     %attrib );
  48   return $err_or_queue unless ref($err_or_queue);
  49
  50   #groups with LDAP?
  51   #my @groups = $svc_acct->radius_groups;
  52   #if ( @groups ) {
  53   #  my $err_or_queue = $self->ldap_queue(
  54   #    $svc_acct->svcnum, 'usergroup_insert',
  55   #    $svc_acct->username, @groups );
  56   #  return $err_or_queue unless ref($err_or_queue);
  57   #}
  58
  59   '';
  60 }
  61
  62 sub _export_replace {
  63   my( $self, $new, $old ) = (shift, shift, shift);
  64
  65   local $SIG{HUP} = 'IGNORE';
  66   local $SIG{INT} = 'IGNORE';
  67   local $SIG{QUIT} = 'IGNORE';
  68   local $SIG{TERM} = 'IGNORE';
  69   local $SIG{TSTP} = 'IGNORE';
  70   local $SIG{PIPE} = 'IGNORE';
  71
  72   return "can't (yet?) change username with ldap"
  73     if $old->username ne $new->username;
  74
  75   return "ldap replace unimplemented";
  76
  77   my $oldAutoCommit = $FS::UID::AutoCommit;
  78   local $FS::UID::AutoCommit = 0;
  79   my $dbh = dbh;
  80
  81   my $jobnum = '';
  82   #if ( $old->username ne $new->username ) {
  83   #  my $err_or_queue = $self->ldap_queue( $new->svcnum, 'rename',
  84   #    $new->username, $old->username );
  85   #  unless ( ref($err_or_queue) ) {
  86   #    $dbh->rollback if $oldAutoCommit;
  87   #    return $err_or_queue;
  88   #  }
  89   #  $jobnum = $err_or_queue->jobnum;
  90   #}
  91
  92   foreach my $table (qw(reply check)) {
  93     my $method = "radius_$table";
  94     my %new = $new->$method();
  95     my %old = $old->$method();
  96     if ( grep { !exists $old{$_} #new attributes
  97                 || $new{$_} ne $old{$_} #changed
  98               } keys %new
  99     ) {
 100       my $err_or_queue = $self->ldap_queue( $new->svcnum, 'insert',
 101         $table, $new->username, %new );
 102       unless ( ref($err_or_queue) ) {
 103         $dbh->rollback if $oldAutoCommit;
 104         return $err_or_queue;
 105       }
 106       if ( $jobnum ) {
 107         my $error = $err_or_queue->depend_insert( $jobnum );
 108         if ( $error ) {
 109           $dbh->rollback if $oldAutoCommit;
 110           return $error;
 111         }
 112       }
 113     }
 114
 115     my @del = grep { !exists $new{$_} } keys %old;
 116     if ( @del ) {
 117       my $err_or_queue = $self->ldap_queue( $new->svcnum, 'attrib_delete',
 118         $table, $new->username, @del );
 119       unless ( ref($err_or_queue) ) {
 120         $dbh->rollback if $oldAutoCommit;
 121         return $err_or_queue;
 122       }
 123       if ( $jobnum ) {
 124         my $error = $err_or_queue->depend_insert( $jobnum );
 125         if ( $error ) {
 126           $dbh->rollback if $oldAutoCommit;
 127           return $error;
 128         }
 129       }
 130     }
 131   }
 132
 133   # (sorta) false laziness with FS::svc_acct::replace
 134   my @oldgroups = @{$old->usergroup}; #uuuh
 135   my @newgroups = $new->radius_groups;
 136   my @delgroups = ();
 137   foreach my $oldgroup ( @oldgroups ) {
 138     if ( grep { $oldgroup eq $_ } @newgroups ) {
 139       @newgroups = grep { $oldgroup ne $_ } @newgroups;
 140       next;
 141     }
 142     push @delgroups, $oldgroup;
 143   }
 144
 145   if ( @delgroups ) {
 146     my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_delete',
 147       $new->username, @delgroups );
 148     unless ( ref($err_or_queue) ) {
 149       $dbh->rollback if $oldAutoCommit;
 150       return $err_or_queue;
 151     }
 152     if ( $jobnum ) {
 153       my $error = $err_or_queue->depend_insert( $jobnum );
 154       if ( $error ) {
 155         $dbh->rollback if $oldAutoCommit;
 156         return $error;
 157       }
 158     }
 159   }
 160
 161   if ( @newgroups ) {
 162     my $err_or_queue = $self->ldap_queue( $new->svcnum, 'usergroup_insert',
 163       $new->username, @newgroups );
 164     unless ( ref($err_or_queue) ) {
 165       $dbh->rollback if $oldAutoCommit;
 166       return $err_or_queue;
 167     }
 168     if ( $jobnum ) {
 169       my $error = $err_or_queue->depend_insert( $jobnum );
 170       if ( $error ) {
 171         $dbh->rollback if $oldAutoCommit;
 172         return $error;
 173       }
 174     }
 175   }
 176
 177   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 178
 179   '';
 180 }
 181
 182 sub _export_delete {
 183   my( $self, $svc_acct ) = (shift, shift);
 184   return "ldap delete unimplemented";
 185   my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete',
 186     $svc_acct->username );
 187   ref($err_or_queue) ? '' : $err_or_queue;
 188 }
 189
 190 sub ldap_queue {
 191   my( $self, $svcnum, $method ) = (shift, shift, shift);
 192   my $queue = new FS::queue {
 193     'svcnum' => $svcnum,
 194     'job'    => "FS::part_export::ldap::ldap_$method",
 195   };
 196   $queue->insert(
 197     $self->machine,
 198     $self->option('dn'),
 199     $self->option('password'),
 200     @_,
 201   ) or $queue;
 202 }
 203
 204 sub ldap_insert { #subroutine, not method
 205   my $dn = ldap_connect(shift, shift, shift);
 206   my %attrib = @_;
 207
 208   my $status = $ldap->add( $dn, attrs => [ %attrib ] );
 209   die $status->error if $status->is_error;
 210
 211   $ldap->unbind;
 212 }
 213
 214 #sub ldap_delete { #subroutine, not method
 215 #  my $dbh = ldap_connect(shift, shift, shift);
 216 #  my $username = shift;
 217 #
 218 #  foreach my $table (qw( radcheck radreply usergroup )) {
 219 #    my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" );
 220 #    $sth->execute($username)
 221 #      or die "can't delete from $table table: ". $sth->errstr;
 222 #  }
 223 #  $dbh->disconnect;
 224 #}
 225
 226 sub ldap_connect {
 227   my( $machine, $dn, $password ) = @_;
 228
 229   eval "use Net::LDAP";
 230   die $@ if $@;
 231
 232   my $ldap = Net::LDAP->net($machine) or die $@;
 233   my $status = $ldap->bind( $dn, password=>$password );
 234   die $status->error if $status->is_error;
 235
 236   $dn;
 237 }
 238