← Back to branch summary

~ubuntu-branches/debian/squeeze/sympa/squeeze

« back to all changes in this revision

Viewing changes to src/Ldap.pm

  • Committer: Bazaar Package Importer
  • Author(s): Stefan Hornburg (Racke)
  • Date: 2008-10-05 12:36:30 UTC
  • mfrom: (1.1.5 upstream) (6.1.3 gutsy)
  • Revision ID: james.westby@ubuntu.com-20081005123630-8ga1kt0ogrkqaizf
Tags: 5.3.4-6
http://bugs.debian.org/501154
http://bugs.debian.org/498144
http://bugs.debian.org/496520
* fix usage of $* Perl variable deprecated in Perl 5.10 
  (Closes: #501154, thanks to Micah Anderson <micah@debian.org> and
  David Moreno <david@dev.axiombox.com> for the report and patches)
* add the sympa.pl --upgrade procedure to the debian/postinst 
  to migrate existing installs (Closes: #498144, thanks to Micah
  Anderson <micah@debian.org> for the patch)
* additional patch for insecure use of /tmp (Closes: #496520)
* missing debian/compat file added

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/Ldap.pm
1
1
# Ldap.pm - This module includes most LDAP-related functions
2
 
# RCS Identication ; $Revision: 1.14 $ ; $Date: 2006/01/05 14:23:29 $ 
 
2
# RCS Identication ; $Revision: 4190 $ ; $Date: 2007-03-19 10:53:17 +0100 (lun, 19 mar 2007) $ 
3
3
#
4
4
# Sympa - SYsteme de Multi-Postage Automatique
5
5
# Copyright (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des Universites
28
28
@ISA = qw(Exporter);
29
29
@EXPORT = qw(%Ldap);
30
30
 
31
 
my @valid_options = qw(host port suffix filter scope bind_dn bind_password);
32
 
my  @required_options = qw(host port suffix filter scope);
 
31
my @valid_options = qw(host suffix filter scope bind_dn bind_password);
 
32
my  @required_options = qw(host suffix filter);
33
33
 
34
34
my %valid_options = ();
35
35
map { $valid_options{$_}++; } @valid_options;
39
39
 
40
40
my %Default_Conf =
41
41
    (   'host'=> undef,
42
 
        'port' => undef,
43
42
        'suffix' => undef,
44
43
        'filter' => undef,
45
 
        'scope' => undef,
 
44
        'scope' => 'sub',
46
45
        'bind_dn' => undef,
47
46
        'bind_password' => undef
48
47
   );
64
63
        &Log::do_log('err','Unable to open %s: %s', $config, $!);
65
64
        return undef;
66
65
    }
67
 
    while (<IN>) {
 
66
 
 
67
    my $folded_line;
 
68
    while (my $current_line = <IN>) {
68
69
        $line_num++;
69
 
        next if (/^\s*$/o || /^[\#\;]/o);
70
 
 
71
 
        if (/^(\S+)\s+(.+)$/io) {
 
70
        next if ($current_line =~ /^\s*$/o || $current_line =~ /^[\#\;]/o);
 
71
 
 
72
        ## Cope with folded line (ending with '\')
 
73
        if ($current_line =~ /\\\s*$/) {
 
74
            $current_line =~ s/\\\s*$//; ## remove trailing \
 
75
            chomp $current_line;
 
76
            $folded_line .= $current_line;
 
77
            next;
 
78
        }elsif (defined $folded_line) {
 
79
            $current_line = $folded_line.$current_line;
 
80
            $folded_line = undef;
 
81
        }
 
82
 
 
83
        if ($current_line =~ /^(\S+)\s+(.+)$/io) {
72
84
            my($keyword, $value) = ($1, $2);
73
85
            $value =~ s/\s*$//;
74
86
        
101
113
 return %Ldap;
102
114
}
103
115
 
104
 
sub export_list{
105
 
    my ($directory,$list) = @_;
106
 
 
107
 
    &Log::do_log('debug2',' Ldap::export_list(%s,%s)', $directory,$list->{'name'});
108
 
 
109
 
    my (@owner_emails,@editor_emails,@editor_names,@owner_names);
110
 
 
111
 
    ##To record owner's and editor's email and gecos
112
 
    ## !! STRUCTURE LDAP A REVOIR
113
 
    my $owners = $list->get_owners();
114
 
    foreach my $element (@{$owners}) {
115
 
        next unless (defined $element->{'email'});
116
 
        if (ref($element->{'email'})) {
117
 
            push(@owner_emails, @{$element->{'email'}});
118
 
        }else {
119
 
            push(@owner_emails,$element->{'email'});
120
 
        }
121
 
        push(@owner_names,$element->{'gecos'});
122
 
    }
123
 
 
124
 
    foreach my $element (@{$list->{'admin'}{'editor'}}){
125
 
        push(@editor_emails,$element->{'email'}) if(defined $element->{'email'}) ;
126
 
        push(@editor_names,$element->{'gecos'}) if(defined $element->{'gecos'});
127
 
    }
128
 
 
129
 
    unless (eval "require Net::LDAP") {
130
 
       &Log::do_log ('err',"Unable to use LDAP library, Net::LDAP required, install perl-ldap (CPAN) first");
131
 
       return undef;
132
 
    }
133
 
    require Net::LDAP;
134
 
    
135
 
    ##Connexion
136
 
    my $ldap = Net::LDAP->new($Conf{'ldap_export'}{$directory}{'host'});
137
 
 
138
 
    unless ($ldap) {
139
 
        &Log::do_log('err',"Ldap::export_list:Unable to bind to the directory %s", $dir);
140
 
        return undef;
141
 
    }
142
 
  
143
 
    ##Bind:To verify the password
144
 
    my $cnx = $ldap->bind(dn => "$Conf{'ldap_export'}{$directory}{'DnManager'}" , password => "$Conf{'ldap_export'}{$directory}{'password'}");
145
 
 
146
 
    unless(defined($cnx) && ($cnx->code == 0)){
147
 
        &Log::do_log('notice', 'Ldap::export_list:Incorrect password for binding with dn: %s',$Conf{'ldap_export'}{$directory}{'DnManager'});
148
 
        $ldap->unbind;
149
 
        return undef;
150
 
    }
151
 
    
152
 
    ##If the entry already exists delete it
153
 
    
154
 
    return undef
155
 
        unless &delete_list($directory, $list, $ldap);
156
 
        
157
 
    my $list_email = $list->get_list_address();
158
 
    my $dn = "cn=$list_email,$Conf{'ldap_export'}{$directory}{'suffix'}";
159
 
 
160
 
    my $total =  $list->get_total() || 0;
161
 
    my $result_add = $ldap->add( 
162
 
                                 dn => "$dn",
163
 
                                 attrs => [
164
 
                                           'cn' => "$list_email",
165
 
                                           'listName' => "$list->{'name'}",
166
 
                                           'listEmailAddress' => "$list_email",
167
 
                                           'listSubject' => "$list->{'admin'}{'subject'}" || 'unknown',
168
 
                                           'listLang' => $list->{'admin'}{'lang'},
169
 
                                           'listCreateDate' => $list->{'admin'}{'creation'}{'date'} || 'unknown',
170
 
                                           'listCreateDateepoch' => $list->{'admin'}{'creation'}{'date_epoch'} || 0,
171
 
                                           'listDescription' =>$list->get_info() || 'unknown',
172
 
                                           'listSubscribersNumber' => "$total",
173
 
                                           'robotEmail' =>  "$list->{'admin'}{'host'}",
174
 
                                           'robotType' => 'sympa',
175
 
                                           'listUrlHomePage' =>'http://'."$list->{'admin'}{'host'}".'/'.'wws',
176
 
                                           'listUrlArc' => 'http://'."$list->{'admin'}{'host'}".'/wws/arc/'."$list->{'name'}",
177
 
                                           'listUrlInfo' =>'http://'."$list->{'admin'}{'host'}".'/wws/info/'."$list->{'name'}",
178
 
                                           'listTheme' => [@{$list->{'admin'}{'topics'}}],
179
 
                                           #'listOwnerName' => [@owner_names]|| 'none' ,
180
 
                                           #'listOwnerEmail' => [@owner_emails], 
181
 
                                           #'listEditorName' => [@editor_names],
182
 
                                           #'listEditorEmail' => [@editor_emails], 
183
 
                                           'objectclass' => ['top','MailingList']
184
 
                                           ]
185
 
 
186
 
                                );
187
 
    #&Log::do_log('notice',"xxxadd ok") if($result_add->code == 0);
188
 
 
189
 
    unless (defined($result_add) && ($result_add->code == 0)){
190
 
        #my $error = $result_add->error;
191
 
        &Log::do_log('err'," Ldap::export_list: Adding Error ");
192
 
#       my $server_error = $result_add->server_error;
193
 
#       &Log::do_log('err'," Ldap::export_list: Server error=$server_error ");
194
 
#       &Log::do_log('err','Ldap::export_list:Unable to add the entry %s, in the directory %s ',$dn,$Conf{'ldap_export'}{$directory}{'host'});
195
 
        $ldap->unbind();
196
 
        return undef;
197
 
   }
198
 
 
199
 
   $ldap->unbind();
200
 
   return 1;
201
 
}
202
 
 
203
 
 
204
 
sub delete_list{
205
 
    my($directory,$list,$ldap) = @_;
206
 
    &Log::do_log('debug3', 'Ldap::delete_list(%s,%s)', $directory,$list->{'name'});
207
 
 
208
 
    my $already_binded = 1;
209
 
 
210
 
    unless (eval "require Net::LDAP") {
211
 
        &Log::do_log ('err',"Unable to use LDAP library, Net::LDAP required, install perl-ldap (CPAN) first");
212
 
        return undef;
213
 
    }
214
 
    require Net::LDAP;
215
 
 
216
 
    ## We may used delete_list independently OR from export_list()
217
 
    unless (defined $ldap) {
218
 
      $already_binded = 0;
219
 
 
220
 
      $ldap = Net::LDAP->new($Conf{'ldap_export'}{$directory}{'host'});
221
 
    
222
 
      unless ($ldap) {
223
 
          &Log::do_log('err',"Ldap::delete_list:unable to bind to the directory %s", $dir);
224
 
          return undef;
225
 
      }
226
 
    
227
 
      ##To verify the password
228
 
      my $cnx = $ldap->bind(dn => "$Conf{'ldap_export'}{$directory}{'DnManager'}" , password => "$Conf{'ldap_export'}{$directory}{'password'}");
229
 
    
230
 
      unless(defined($cnx) && ($cnx->code == 0)){
231
 
          &Log::do_log('notice', 'Ldap::delete_list:Incorrect dn %s for binding',$Conf{'ldap_export'}{$directory}{'DnManager'});
232
 
          $ldap->unbind;
233
 
          return undef;
234
 
      }
235
 
    }
236
 
    
237
 
    ##To create the dn and delete this entry
238
 
    my $list_email = $list->get_list_address();
239
 
    my $dn = "cn=$list_email,$Conf{'ldap_export'}{$directory}{'suffix'}";
240
 
    my $filter = "(listEmailAddress = $list_email)";
241
 
    
242
 
    my $result_search = $ldap->search (
243
 
                                       base => "$Conf{'ldap_export'}{$directory}{'suffix'}",
244
 
                                       filter => "$filter",
245
 
                                       scope => 'sub',
246
 
                                       );
247
 
    
248
 
    if($result_search->count > 0){
249
 
        my $result_delete = $ldap->delete("$dn");
250
 
        
251
 
        unless(defined($result_delete) && ($result_delete->code == 0)){
252
 
            my $error = $result_delete->error;
253
 
            &Log::do_log('err',"Ldap::export_list: Delete Error=$error");
254
 
            return undef;
255
 
        }
256
 
    }
257
 
    
258
 
    &Log::do_log('info',"Ldap::delete_list: Deleting the entry $dn");
259
 
       
260
 
    $ldap->unbind 
261
 
        unless $already_binded;
262
 
}
263
 
 
264
 
sub get_exported_lists{
265
 
    my $filter = shift;
266
 
    my $directory = shift;
267
 
 
268
 
    &Log::do_log('debug3','Ldap::get_exported_lists(%s)',$directory);
269
 
 
270
 
    my %lists;
271
 
    
272
 
    unless (eval "require Net::LDAP") {
273
 
        &Log::do_log ('err',"Unable to use LDAP library, Net::LDAP required, install perl-ldap (CPAN) first");
274
 
        return undef;
275
 
    }
276
 
    require Net::LDAP;
277
 
    
278
 
    my $ldap = Net::LDAP->new($Conf{'ldap_export'}{$directory}{'host'}, timeout => $Conf{'ldap_export'}{$directory}{'connection_timeout'});
279
 
    unless ($ldap) {
280
 
        &Log::do_log('err',"unable to bind to '%s' directory", $directory);
281
 
        return undef;
282
 
    }
283
 
   
284
 
    my $cnx = $ldap->bind();
285
 
        
286
 
    unless(defined($cnx) && ($cnx->code == 0)){
287
 
        &Log::do_log('err', 'Ldap::exported_lists: Bind failed on  %s',$Conf{'ldap_export'}{$directory}{'host'});
288
 
        $ldap->unbind;
289
 
        return undef;
290
 
    }
291
 
        
292
 
    my $search_filter = "(|(listEmailAddress=*$filter*)(listSubject=*$filter*))";
293
 
    my $result_search = $ldap->search (
294
 
                                       base => "$Conf{'ldap_export'}{$directory}{'suffix'}",
295
 
                                       filter => "$search_filter",
296
 
                                       scope => 'sub',
297
 
                                       );
298
 
 
299
 
    unless (defined($result_search) && ($result_search->code == 0)){
300
 
        &Log::do_log('notice',"No result for directory '%s' : %s",$directory, $result_search->error );
301
 
    }else{
302
 
        foreach my $entry ($result_search->all_entries){
303
 
            $list_name = $entry->get_value('listName');
304
 
            $list_address = $entry->get_value('listEmailAddress');
305
 
            $subject = $entry->get_value('listSubject');
306
 
            $urlinfo = $entry->get_value('listUrlInfo');
307
 
            $host = $entry->get_value('robotEmail');
308
 
            
309
 
            %lists = ("$list_name" => {'list_address' => "$list_address",
310
 
                                       'subject' => "$subject",
311
 
                                       'urlinfo' => "$urlinfo",
312
 
                                       'host' => "$host",                                   
313
 
                                   },
314
 
                      );
315
 
        }
316
 
    }
317
 
    $ldap->unbind;
318
 
    return %lists;
319
 
}
320
 
 
321
 
 
322
 
##Subroutine not used yet but may be useful later
323
 
sub get_dn_anonymous{
324
 
 
325
 
    my $datas = shift;
326
 
    $datas->{'timeout'} = 20 unless($datas->{'timeout'});
327
 
    $datas->{'scope'} = 'sub' unless($datas->{'scope'});
328
 
    
329
 
    unless (eval "require Net::LDAP") {
330
 
        &Log::do_log ('err',"Unable to use LDAP library, Net::LDAP required, install perl-ldap (CPAN) first");
331
 
        return undef;
332
 
    }
333
 
    require Net::LDAP;
334
 
 
335
 
    ##New
336
 
    my $ldap = Net::LDAP->new($datas->{'host'},timeout => $datas->{'timeout'});
337
 
    unless ($ldap) {
338
 
        &Log::do_log('err','Ldap::get_dn_anonymous :Unable to bind to the directory %s',$datas->{'host'});
339
 
        return undef;
340
 
    }
341
 
 
342
 
    ##Bind
343
 
    my $cnx = $ldap->bind();
344
 
 
345
 
    unless(defined($cnx) && ($cnx->code == 0)){
346
 
        &Log::do_log('err', 'Ldap::exported_lists: Bind failed on  %s',$datas->{'host'});
347
 
        $ldap->unbind;
348
 
        return undef;
349
 
    }
350
 
    
351
 
 
352
 
    ##Search
353
 
    my $result_search = $ldap->search (
354
 
                                       base => $datas->{'base'},
355
 
                                       filter => $datas->{'filter'},
356
 
                                       scope => $datas->{'scope'},
357
 
                                       timeout => $datas->{'timeout'},
358
 
                                       );
359
 
    unless (defined($result_search) && ($result_search->code == 0)){
360
 
        &Log::do_log('notice',"Ldap::get_dn_anonymous :No result for directory %s",$directory );
361
 
        return undef;
362
 
    }
363
 
    
364
 
    if (defined($result_search) && ($result_search->count() == 0)) {
365
 
        do_log('notice','Ldap::get_dn_anonymous : No entry in the Ldap Directory of %s',$datas->{'host'});
366
 
        $ldap->unbind;
367
 
    }
368
 
    
369
 
    my $refhash = $result_search->as_struct();
370
 
    my (@DN) = keys(%$refhash);
371
 
    $ldap->unbind;
372
 
    
373
 
    return $DN[0];
374
 
}
375
 
 
376
 
 
377
 
 
378
116
## Packages must return true.
379
117
1;
380
118