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