FS/FS/part_export/ldap.pm

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