quiet option to cancel method
[freeside.git] / 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