1 package FS::part_export::ldap;
3 use vars qw(@ISA %info @saltset);
5 use FS::Record qw( dbh );
8 @ISA = qw(FS::part_export);
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',
18 'mail $username\@$domain',
28 'mailmessagestore $dir',
29 'userpassword $crypt_password',
32 'objectclass top,person,inetOrgPerson',
35 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', },
40 'desc' => 'Real-time export to LDAP',
41 'options' => \%options,
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.
48 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
50 sub rebless { shift; }
53 my($self, $svc_acct) = (shift, shift);
55 #false laziness w/shellcommands.pm
58 ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
59 ${$_} = $svc_acct->$_() foreach qw( domain );
60 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
62 my $cust_main = $cust_pkg->cust_main;
63 ${$_} = $cust_main->getfield($_) foreach qw(first last);
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))] );
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'));
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};
88 my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert',
92 return $err_or_queue unless ref($err_or_queue);
95 #my @groups = $svc_acct->radius_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);
106 sub _export_replace {
107 my( $self, $new, $old ) = (shift, shift, shift);
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';
116 return "can't (yet?) change username with ldap"
117 if $old->username ne $new->username;
119 return "ldap replace unimplemented";
121 my $oldAutoCommit = $FS::UID::AutoCommit;
122 local $FS::UID::AutoCommit = 0;
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;
133 # $jobnum = $err_or_queue->jobnum;
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
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;
151 my $error = $err_or_queue->depend_insert( $jobnum );
153 $dbh->rollback if $oldAutoCommit;
159 my @del = grep { !exists $new{$_} } keys %old;
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;
168 my $error = $err_or_queue->depend_insert( $jobnum );
170 $dbh->rollback if $oldAutoCommit;
177 # (sorta) false laziness with FS::svc_acct::replace
178 my @oldgroups = @{$old->usergroup}; #uuuh
179 my @newgroups = $new->radius_groups;
181 foreach my $oldgroup ( @oldgroups ) {
182 if ( grep { $oldgroup eq $_ } @newgroups ) {
183 @newgroups = grep { $oldgroup ne $_ } @newgroups;
186 push @delgroups, $oldgroup;
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;
197 my $error = $err_or_queue->depend_insert( $jobnum );
199 $dbh->rollback if $oldAutoCommit;
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;
213 my $error = $err_or_queue->depend_insert( $jobnum );
215 $dbh->rollback if $oldAutoCommit;
221 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
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;
235 my( $self, $svcnum, $method ) = (shift, shift, shift);
236 my $queue = new FS::queue {
238 'job' => "FS::part_export::ldap::ldap_$method",
243 $self->option('password'),
244 $self->option('userdn'),
249 sub ldap_insert { #subroutine, not method
250 my $ldap = ldap_connect(shift, shift, shift);
251 my( $userdn, $username_attrib, %attrib ) = @_;
253 $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn"
255 #icky hack, but should be unsurprising to the LDAPers
256 foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) {
257 $attrib{$key} = [ split(/,/, $attrib{$key}) ];
260 my $status = $ldap->add( $userdn, attrs => [ %attrib ] );
261 die 'LDAP error: '. $status->error. "\n" if $status->is_error;
266 #sub ldap_delete { #subroutine, not method
267 # my $dbh = ldap_connect(shift, shift, shift);
268 # my $username = shift;
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;
279 my( $machine, $dn, $password ) = @_;
281 $bind_options{password} = $password if length($password);
283 eval "use Net::LDAP";
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;