FS/FS/part_export/ldap.pm

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