1 package FS::part_export::ldap;
3 use vars qw(@ISA @saltset);
4 use FS::Record qw( dbh );
7 @ISA = qw(FS::part_export);
9 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
11 sub rebless { shift; }
14 my($self, $svc_acct) = (shift, shift);
16 #false laziness w/shellcommands.pm
19 ${$_} = $svc_acct->getfield($_) foreach $svc_acct->fields;
20 ${$_} = $svc_acct->$_() foreach qw( domain );
21 my $cust_pkg = $svc_acct->cust_svc->cust_pkg;
23 my $cust_main = $cust_pkg->cust_main;
24 ${$_} = $cust_main->getfield($_) foreach qw(first last);
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))] );
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'));
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};
49 my $err_or_queue = $self->ldap_queue( $svc_acct->svcnum, 'insert',
53 return $err_or_queue unless ref($err_or_queue);
56 #my @groups = $svc_acct->radius_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);
68 my( $self, $new, $old ) = (shift, shift, shift);
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';
77 return "can't (yet?) change username with ldap"
78 if $old->username ne $new->username;
80 return "ldap replace unimplemented";
82 my $oldAutoCommit = $FS::UID::AutoCommit;
83 local $FS::UID::AutoCommit = 0;
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;
94 # $jobnum = $err_or_queue->jobnum;
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
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;
112 my $error = $err_or_queue->depend_insert( $jobnum );
114 $dbh->rollback if $oldAutoCommit;
120 my @del = grep { !exists $new{$_} } keys %old;
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;
129 my $error = $err_or_queue->depend_insert( $jobnum );
131 $dbh->rollback if $oldAutoCommit;
138 # (sorta) false laziness with FS::svc_acct::replace
139 my @oldgroups = @{$old->usergroup}; #uuuh
140 my @newgroups = $new->radius_groups;
142 foreach my $oldgroup ( @oldgroups ) {
143 if ( grep { $oldgroup eq $_ } @newgroups ) {
144 @newgroups = grep { $oldgroup ne $_ } @newgroups;
147 push @delgroups, $oldgroup;
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;
158 my $error = $err_or_queue->depend_insert( $jobnum );
160 $dbh->rollback if $oldAutoCommit;
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;
174 my $error = $err_or_queue->depend_insert( $jobnum );
176 $dbh->rollback if $oldAutoCommit;
182 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
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;
196 my( $self, $svcnum, $method ) = (shift, shift, shift);
197 my $queue = new FS::queue {
199 'job' => "FS::part_export::ldap::ldap_$method",
204 $self->option('password'),
205 $self->option('userdn'),
210 sub ldap_insert { #subroutine, not method
211 my $ldap = ldap_connect(shift, shift, shift);
212 my( $userdn, $username_attrib, %attrib ) = @_;
214 $userdn = "$username_attrib=$attrib{$username_attrib}, $userdn"
216 #icky hack, but should be unsurprising to the LDAPers
217 foreach my $key ( grep { $attrib{$_} =~ /,/ } keys %attrib ) {
218 $attrib{$key} = [ split(/,/, $attrib{$key}) ];
221 my $status = $ldap->add( $userdn, attrs => [ %attrib ] );
222 die 'LDAP error: '. $status->error. "\n" if $status->is_error;
227 #sub ldap_delete { #subroutine, not method
228 # my $dbh = ldap_connect(shift, shift, shift);
229 # my $username = shift;
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;
240 my( $machine, $dn, $password ) = @_;
242 $bind_options{password} = $password if length($password);
244 eval "use Net::LDAP";
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;