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 'key_attrib' => { label=>'Key attribute name',
16 'attributes' => { label=>'Attributes',
20 'mail $username\@$domain',
30 'mailmessagestore $dir',
31 'userpassword $crypt_password',
34 'objectclass top,person,inetOrgPerson',
37 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', },
42 'desc' => 'Real-time export to LDAP',
43 'options' => \%options,
44 'default_svc_class' => 'Email',
46 Real-time export to arbitrary LDAP attributes. Requires installation of
47 <a href="http://search.cpan.org/dist/Net-LDAP">Net::LDAP</a> from CPAN.
51 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
53 sub rebless { shift; }
55 sub svc_context_eval {
56 # This should possibly be in svc_Common?
57 # Except the only places we use it are here and in shellcommands,
58 # and it's not even the same version.
61 ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
62 ${$_} = $svc_acct->$_() foreach qw( domain ldap_password );
63 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
65 my $cust_main = $cust_pkg->cust_main;
66 ${$_} = $cust_main->getfield($_) foreach qw(first last);
68 # DEPRECATED, probably fails for non-plain password encoding
69 $crypt_password = ''; #surpress "used only once" warnings
70 $crypt_password = '{crypt}'. crypt( $svc_acct->_password,
71 $saltset[int(rand(64))].$saltset[int(rand(64))] );
73 return map { eval(qq("$_")) } @_ ;
78 return $self->option('key_attrib') if $self->option('key_attrib');
79 # otherwise, guess that it's the one that's set to $username
80 foreach ( split("\n",$self->option('attributes')) ) {
81 /^\s*(\w+)\s+\$username\s*$/ && return $1;
83 # can't recover from that, but we can fail in a more obvious way
84 # than the old code did...
85 die "no key_attrib set in LDAP export\n";
89 # Convert the svc_acct to its LDAP attribute set.
90 my($self, $svc_acct) = (shift, shift);
91 my %attrib = map { /^\s*(\w+)\s+(.*\S)\s*$/;
93 grep { /^\s*(\w+)\s+(.*\S)\s*$/ }
94 split("\n", $self->option('attributes'));
96 my @vals = svc_context_eval($svc_acct, values(%attrib));
97 @attrib{keys(%attrib)} = @vals;
99 if ( $self->option('radius') ) {
100 foreach my $table (qw(reply check)) {
101 my $method = "radius_$table";
102 my %radius = $svc_acct->$method();
103 foreach my $radius ( keys %radius ) {
104 ( my $ldap = $radius ) =~ s/\-//g;
105 $attrib{$ldap} = $radius{$radius};
113 my($self, $svc_acct) = (shift, shift);
115 my $err_or_queue = $self->ldap_queue(
119 $self->ldap_attrib($svc_acct),
121 return $err_or_queue unless ref($err_or_queue);
126 sub _export_replace {
127 my( $self, $new, $old ) = (shift, shift, shift);
129 local $SIG{HUP} = 'IGNORE';
130 local $SIG{INT} = 'IGNORE';
131 local $SIG{QUIT} = 'IGNORE';
132 local $SIG{TERM} = 'IGNORE';
133 local $SIG{TSTP} = 'IGNORE';
134 local $SIG{PIPE} = 'IGNORE';
136 my $oldAutoCommit = $FS::UID::AutoCommit;
137 local $FS::UID::AutoCommit = 0;
142 # the Lazy way: nuke the entry and recreate it.
143 # any reason this shouldn't work? Freeside _has_ to have
144 # write access to these entries and their parent DN.
145 my $key = $self->key_attrib;
146 my %attrib = $self->ldap_attrib($old);
147 my $err_or_queue = $self->ldap_queue(
153 if( !ref($err_or_queue) ) {
154 $dbh->rollback if $oldAutoCommit;
155 return $err_or_queue;
157 $jobnum = $err_or_queue->jobnum;
158 $err_or_queue = $self->ldap_queue(
162 $self->ldap_attrib($new)
164 if( !ref($err_or_queue) ) {
165 $dbh->rollback if $oldAutoCommit;
166 return $err_or_queue;
168 $err_or_queue = $err_or_queue->depend_insert($jobnum);
169 if( $err_or_queue ) {
170 $dbh->rollback if $oldAutoCommit;
171 return $err_or_queue;
174 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
180 my( $self, $svc_acct ) = (shift, shift);
182 my $key = $self->key_attrib;
183 my ( $val ) = map { /^\s*$key\s+(.*\S)\s*$/ ? $1 : () }
184 split("\n", $self->option('attributes'));
185 ( $val ) = svc_context_eval($svc_acct, $val);
186 my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'delete',
188 ref($err_or_queue) ? '' : $err_or_queue;
192 my( $self, $svcnum, $method ) = (shift, shift, shift);
193 my $queue = new FS::queue {
195 'job' => "FS::part_export::ldap::ldap_$method",
200 $self->option('password'),
201 $self->option('userdn'),
206 sub ldap_insert { #subroutine, not method
207 my $ldap = ldap_connect(shift, shift, shift);
208 my( $userdn, $key_attrib, %attrib ) = @_;
210 $userdn = "$key_attrib=$attrib{$key_attrib}, $userdn";
211 #icky hack, but should be unsurprising to the LDAPers
212 foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) {
213 $attrib{$key} = [ split(/,/, $attrib{$key}) ];
216 my $status = $ldap->add( $userdn, attrs => [ %attrib ] );
217 die 'LDAP error: '. $status->error. "\n" if $status->is_error;
223 my $ldap = ldap_connect(shift, shift, shift);
225 my $entry = ldap_fetch($ldap, @_);
227 my $status = $ldap->delete($entry);
228 die 'LDAP error: '.$status->error."\n" if $status->is_error;
231 # should failing to find the entry be fatal?
232 # if it is, it will block unprovisioning the service, which is a pain.
236 # avoid needless duplication in delete and modify
237 my( $ldap, $userdn, %key_data ) = @_;
238 my $filter = join('', map { "($_=$key_data{$_})" } keys(%key_data));
240 my $status = $ldap->search( base => $userdn,
243 die 'LDAP error: '.$status->error."\n" if $status->is_error;
244 my ($entry) = $status->entries;
245 warn "Entry '$filter' not found in LDAP\n" if !$entry;
250 my( $machine, $dn, $password ) = @_;
252 $bind_options{password} = $password if length($password);
254 eval "use Net::LDAP";
257 my $ldap = Net::LDAP->new($machine) or die $@;
258 my $status = $ldap->bind( $dn, %bind_options );
259 die 'LDAP error: '. $status->error. "\n" if $status->is_error;