1 #!/usr/bin/perl -w -I/usr/local/lib/perl
2 #
3 # This code is part of GOsa (https://gosa.gonicus.de)
4 # Copyright (C) 2007 Frank Moeller
5 #
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 use strict;
21 use IMAP::Sieve;
22 use XML::Simple;
23 use Data::Dumper;
24 use Net::LDAP;
25 use URI;
26 use utf8;
27 use Getopt::Std;
28 use Date::Format;
29 use vars qw/ %opt /;
31 #
32 # Definitions
33 #
34 my $gosa_config = "/etc/gosa/gosa.conf";
35 my $opt_string = 'l:hs';
36 my $location = "";
37 my $today_gmt = time ();
38 my $today = $today_gmt + 3600;
39 my $server_attribute = "";
40 my $alternate_address_attribute = "";
41 my $gosa_sieve_script_name = "gosa";
42 my $simple_bind_dn = "";
43 my $simple_bind_dn_pwd = "";
44 my $gosa_sieve_script_status = "FALSE";
45 my $gosa_sieve_spam_header = "Sort mails with higher spam level";
46 my ($ss,$mm,$hh,$day,$month,$year,$zone);
48 #
49 # Templates
50 #
51 my $gosa_sieve_header = "\#\#\#GOSA\nrequire\ \[\"fileinto\",\ \"reject\",\ \"vacation\"\]\;\n\n";
52 my $vacation_header_template = "\# Begin vacation message";
53 my $vacation_footer_template = "\# End vacation message";
55 #
56 # Placeholder
57 #
58 my $start_date_ph = "##STARTDATE##";
59 my $stop_date_ph = "##STOPDATE##";
61 #
62 # Usage
63 #
64 sub usage {
65 die "Usage:\nperl $0 [option]\n
66 \twithout any option $0 uses the default location\n
67 \tOptions:
68 \t\t-l <\"location name\">\tuse special location
69 \t\t-s\t\t\tshow all locations
70 \t\t-h\t\t\tthis help \n";
71 }
73 #
74 # Config import
75 #
76 sub read_config {
77 my $input = shift || die "need config file: $!";
78 my $stream = "";
79 open ( FILE, "< $input" ) or die "Error opening file $input: $! \n";
80 {
81 local $/ = undef;
82 $stream = <FILE>;
83 }
84 close ( FILE );
85 return $stream;
86 }
88 #
89 # XML parser
90 #
91 sub parseconfig {
92 my $c_location = shift;
93 my $xmldata = shift;
94 chomp $c_location;
95 chomp $xmldata;
96 my $data = $xmldata;
97 my $xml = new XML::Simple ();
98 my $c_data = $xml -> XMLin( $xmldata);
99 my $config = {};
100 my $config_base;
101 my $ldap_admin;
102 my $ldap_admin_pwd;
103 my $url;
104 my $mailMethod;
105 #print Dumper ($c_data->{main}->{location}->{config});
106 if ( $c_data->{main}->{location}->{config} ) {
107 #print "IF\n";
108 $config_base = $c_data->{main}->{location}->{config};
109 $url = $c_data->{main}->{location}->{referral}->{url};
110 $ldap_admin = $c_data->{main}->{location}->{referral}->{admin};
111 $ldap_admin_pwd = $c_data->{main}->{location}->{referral}->{password};
112 $mailMethod = $c_data->{main}->{location}->{mailMethod};
113 } else {
114 #print "ELSE\n";
115 $config_base = $c_data->{main}->{location}->{$c_location}->{config};
116 $url = $c_data->{main}->{location}->{$c_location}->{referral}->{url};
117 $ldap_admin = $c_data->{main}->{location}->{$c_location}->{referral}->{admin};
118 $ldap_admin_pwd = $c_data->{main}->{location}->{$c_location}->{referral}->{password};
119 $mailMethod = $c_data->{main}->{location}->{$c_location}->{mailMethod};
120 }
121 print "$config_base -- $url -- $ldap_admin -- $ldap_admin_pwd -- $mailMethod\n";
122 $config->{config_base} = $config_base;
123 $config->{url} = $url;
124 $config->{mailMethod} = $mailMethod;
125 $config->{ldap_admin} = $ldap_admin;
126 $config->{ldap_admin_pwd} = $ldap_admin_pwd;
128 return $config;
129 }
131 #
132 # Get default location
133 #
134 sub get_default_location {
135 my $xmldata = shift;
136 my $xml = new XML::Simple ( RootName=>'conf' );
137 my $c_data = $xml -> XMLin( $xmldata );
138 my $default = $c_data->{main}->{default};
140 return $default;
141 }
143 #
144 # List all location
145 #
146 sub list_locations {
147 my $xmldata = shift;
148 my $xml = new XML::Simple ( RootName=>'conf' );
149 my $c_data = $xml -> XMLin( $xmldata );
150 my $default = get_default_location ( $xmldata );
151 $default = $default . " (default)";
152 my @locations = ( $default );
153 my $data_ref = $c_data->{main}->{location};
154 my @keys = keys ( %{$data_ref} );
155 @locations = (@locations, @keys);
157 return @locations;
158 }
160 #
161 # LDAP error handling
162 #
163 sub ldap_error {
164 my ($from, $mesg) = @_;
165 print "Return code: ", $mesg->code;
166 print "\tMessage: ", $mesg->error_name;
167 print " :", $mesg->error_text;
168 print "MessageID: ", $mesg->mesg_id;
169 print "\tDN: ", $mesg->dn;
170 }
173 #
174 # LDAP search
175 #
176 sub ldap_search {
177 my $url = shift;
178 my $searchString = shift;
179 my $scope = shift;
180 my $base = shift;
181 my $attrs = shift;
182 my $bind_dn = shift;
183 my $bind_dn_pwd = shift;
185 if ( $base eq "NULL" ) {
186 $base = "";
187 }
188 my $ldap = Net::LDAP->new( $url ) or die "$@";
189 if ( ( ! ( $bind_dn ) ) || ( ! ( $bind_dn_pwd ) ) ) {
190 $ldap->bind;
191 } else {
192 $ldap->bind ( $bind_dn, password => $bind_dn_pwd );
193 }
195 my $result = $ldap->search ( base => "$base",
196 scope => "$scope",
197 filter => "$searchString",
198 attrs => $attrs
199 );
200 if ( $result->code ) {
201 ldap_error ( "Searching", $result );
202 }
204 $ldap->unbind;
206 return $result;
207 }
209 #
210 # Retrieve LDAP server
211 #
212 sub get_ldap_server {
213 my $url = shift;
215 my $uri = URI->new($url);
217 my $scheme = $uri->scheme;
218 my $host = $uri->host;
219 my $port = $uri->port;
220 #print "$scheme - $host - $port\n";
221 my $server = $scheme . "://" . $host . ":" . $port;
223 return $server;
224 }
226 #
227 # Retrieve LDAP base
228 #
229 sub get_ldap_base {
230 my $url = shift;
231 my $config_base = shift;
232 my $bind_dn = shift;
233 my $bind_dn_pwd = shift;
234 my $filter = "(objectClass=*)";
235 my $init_base = "NULL";
236 my $scope = "base";
237 my $attributes = [ 'namingcontexts' ];
238 my $entry = {};
239 my $base = "";
241 $config_base =~ s/\,\ +/\,/g;
242 #print $url."\n";
243 #print $config_base."\n";
244 my $result = ldap_search ( $url, $filter, $scope, $init_base, $attributes, $bind_dn, $bind_dn_pwd );
245 my @entries = $result->entries;
246 my $noe = @entries;
247 #print $noe."\n";
248 foreach $entry ( @entries ) {
249 my $tmp = $entry->get_value ( 'namingcontexts' );
250 #print $tmp."\n";
251 $tmp =~ s/\,\ +/\,/g;
252 if ( $config_base =~ m/$tmp/ ) {
253 $base = $entry->get_value ( 'namingcontexts' );
254 }
255 }
257 return $base;
258 }
260 #
261 # SIEVE functions
262 #
263 sub opensieve {
264 my $admin = shift;
265 my $pass = shift;
266 my $user = shift;
267 my $server = shift;
268 my $port = shift;
270 #print ( "##### Proxy => $user, Server => $server, Login => $admin, Password => $pass, Port => $port ####\n" );
272 my $sieve = IMAP::Sieve->new ( 'Proxy' => $user, 'Server' => $server, 'Login' => $admin, 'Password' => $pass, 'Port' => $port );
273 return $sieve;
274 }
276 sub closesieve {
277 my $sieve = shift;
279 if ($sieve) {$sieve->close};
280 }
282 sub listscripts {
283 my $sieve = shift;
285 my @scripts = $sieve->listscripts;
286 my $script_list = join("\n",@scripts)."\n";
287 #print $script_list;
288 return $script_list;
289 }
291 sub getscript {
292 my $sieve = shift;
293 my $script = shift;
294 my $scriptfile;
295 chomp $script;
296 #print "$sieve\n";
297 #print "$script\n";
299 $scriptfile = $sieve->getscript($script);
300 return $scriptfile;
301 }
303 sub putscript {
304 my $sieve = shift;
305 my $scriptname = shift;
306 my $script = shift;
307 #print "$sieve\n";
308 #print "$scriptname\n";
309 #print "$script\n";
311 my $res=$sieve->putscript($scriptname,$script);
312 if ($res) {print $sieve->{'Error'}}
313 return;
314 }
316 sub setactive {
317 my $sieve = shift;
318 my $script = shift;
320 my $res=$sieve->setactive($script);
321 if ($res) { print $sieve->{'Error'};}
322 return;
323 }
325 #
326 # main ()
327 #
328 # read options
329 getopts( "$opt_string", \%opt );
331 # read GOsa config
332 my $input_stream = read_config ( $gosa_config );
334 # get location
335 if ( $opt{l} ) {
336 $location = $opt{l};
337 } elsif ( $opt{h} ) {
338 usage ();
339 exit (0);
340 } elsif ( $opt{s} ) {
341 my $loc;
342 my $counter = 1;
343 my @locations = list_locations ( $input_stream );
344 print "\nConfigured Locations: \n";
345 print "---------------------\n";
346 foreach $loc ( @locations ) {
347 print $counter . ". " . $loc . "\n";
348 $counter++;
349 }
350 print "\n\n";
351 exit (0);
352 } else {
353 $location = get_default_location ( $input_stream );
354 }
356 # parse config
357 my $config = parseconfig ( $location, $input_stream );
358 my $ldap_url = get_ldap_server ( $config->{url} );
359 my $gosa_config_base = $config->{config_base};
360 my $bind_dn = $config->{ldap_admin};
361 my $bind_dn_pwd = $config->{ldap_admin_pwd};
362 my $mailMethod = $config->{mailMethod};
363 utf8::encode($ldap_url);
364 utf8::encode($gosa_config_base);
365 utf8::encode($mailMethod);
367 # default mailMethod = kolab
368 if ( $mailMethod =~ m/kolab/i ) {
369 $server_attribute = "kolabHomeServer";
370 $alternate_address_attribute = "alias";
371 } elsif ( $mailMethod =~ m/cyrus/i ) {
372 $server_attribute = "gosaMailServer";
373 $alternate_address_attribute = "gosaMailAlternateAddress";
374 } else {
375 exit (0);
376 }
378 # determine LDAP base
379 my $ldap_base = get_ldap_base ( $ldap_url, $gosa_config_base, $simple_bind_dn, $simple_bind_dn_pwd );
381 # retrieve user informations with activated vacation feature
382 my $filter = "(&(objectClass=gosaMailAccount)(gosaMailDeliveryMode=*V*)(!(gosaMailDeliveryMode=*C*)))";
383 my $list_of_attributes = [ 'uid', 'mail', $alternate_address_attribute, 'gosaVacationMessage', 'gosaVacationStart', 'gosaVacationStop', $server_attribute ];
384 my $search_scope = "sub";
385 my $result = ldap_search ( $ldap_url, $filter, $search_scope, $ldap_base, $list_of_attributes, $simple_bind_dn, $simple_bind_dn_pwd );
387 my @entries = $result->entries;
388 my $noe = @entries;
389 #print "NOE = $noe\n";
390 my $entry = {};
391 foreach $entry ( @entries ) {
392 # INITIALISATIONS
393 $gosa_sieve_script_status = "FALSE";
394 my @sieve_scripts = "";
395 my $script_name = "";
396 my $sieve_script = "";
397 my $sieve_vacation = "";
398 # END INITIALISATIONS
399 my $uid_v = $entry->get_value ( 'uid' );
400 #print "$uid_v\n";
401 my $mail_v = $entry->get_value ( 'mail' );
402 my @mailalternate = $entry->get_value ( $alternate_address_attribute );
403 my $vacation = $entry->get_value ( 'gosaVacationMessage' );
404 my $start_v = $entry->get_value ( 'gosaVacationStart' );
405 my $stop_v = $entry->get_value ( 'gosaVacationStop' );
406 my $server_v = $entry->get_value ( $server_attribute );
408 # temp. hack to compensate old gosa server name style
409 #if ( $server_v =~ m/^imap\:\/\//i ) {
410 # $server_v =~ s/^imap\:\/\///;
411 #}
412 if ( ! ( $uid_v ) ) {
413 $uid_v = "";
414 }
415 if ( ! ( $mail_v ) ) {
416 $mail_v = "";
417 }
418 my @mailAddress = ($mail_v);
419 my $alias = "";
420 foreach $alias ( @mailalternate ) {
421 push @mailAddress, $alias;
422 }
423 my $addresses = "";
424 foreach $alias ( @mailAddress ) {
425 $addresses .= "\"" . $alias . "\", ";
426 }
427 $addresses =~ s/\ *$//;
428 $addresses =~ s/\,$//;
429 if ( ! ( $vacation ) ) {
430 $vacation = "";
431 }
433 if ( ! ( $start_v ) ) {
434 $start_v = 0;
435 next;
436 }
437 #print time2str("%d.%m.%Y", $start_v)."\n";
438 my $start_date_string = time2str("%d.%m.%Y", $start_v)."\n";
440 if ( ! ( $stop_v ) ) {
441 $stop_v = 0;
442 next;
443 }
444 #print time2str("%d.%m.%Y", $stop_v)."\n";
445 my $stop_date_string = time2str("%d.%m.%Y", $stop_v)."\n";
447 chomp $start_date_string;
448 chomp $stop_date_string;
449 $vacation =~ s/$start_date_ph/$start_date_string/g;
450 $vacation =~ s/$stop_date_ph/$stop_date_string/g;
452 if ( ! ( $server_v ) ) {
453 $server_v = "";
454 next;
455 }
456 #print $uid_v . " | " .
457 # $addresses . " | " .
458 # "\n";
460 my ($sieve_user, $tmp) = split ( /\@/, $mail_v );
462 print "today = $today\nstart = $start_v\nstop = $stop_v\n";
463 my $real_stop = $stop_v + 86400;
464 if ( ( $today >= $start_v ) && ( $today < $real_stop ) ) {
465 print "activating vacation for user $uid_v\n";
467 my $srv_filter = "(&(goImapName=$server_v)(objectClass=goImapServer))";
468 my $srv_list_of_attributes = [ 'goImapSieveServer', 'goImapSievePort', 'goImapAdmin', 'goImapPassword' ];
469 my $srv_result = ldap_search ( $ldap_url, $srv_filter, $search_scope, $ldap_base, $srv_list_of_attributes, $bind_dn, $bind_dn_pwd );
470 my @srv_entries = $srv_result->entries;
471 my $srv_entry = {};
472 my $noe = @srv_entries;
473 if ( $noe == 0 ) {
474 printf STDERR "Error: no $server_attribute defined! Aboarting...";
475 } elsif ( $noe > 1 ) {
476 printf STDERR "Error: multiple $server_attribute defined! Aboarting...";
477 } else {
478 my $goImapSieveServer = $srv_entries[0]->get_value ( 'goImapSieveServer' );
479 my $goImapSievePort = $srv_entries[0]->get_value ( 'goImapSievePort' );
480 my $goImapAdmin = $srv_entries[0]->get_value ( 'goImapAdmin' );
481 my $goImapPassword = $srv_entries[0]->get_value ( 'goImapPassword' );
482 if ( ( $goImapSieveServer ) && ( $goImapSievePort ) && ( $goImapAdmin ) && ( $goImapPassword ) ) {
483 # if ( ! ( $sieve_user = $uid_v ) ) {
484 # $sieve_user = $uid_v;
485 # }
486 #my $sieve = opensieve ( $goImapAdmin, $goImapPassword, $sieve_user, $goImapSieveServer, $goImapSievePort);
487 my $sieve = opensieve ( $goImapAdmin, $goImapPassword, $uid_v, $goImapSieveServer, $goImapSievePort);
488 @sieve_scripts = listscripts ( $sieve );
489 #print Dumper (@sieve_scripts);
490 $script_name = "";
491 if ( @sieve_scripts ) {
492 foreach $script_name ( @sieve_scripts ) {
493 if ( $script_name =~ m/$gosa_sieve_script_name/ ) {
494 $gosa_sieve_script_status = "TRUE";
495 }
496 }
497 if ( $gosa_sieve_script_status eq "TRUE" ) {
498 print "retrieving and modifying gosa sieve script for user $uid_v\n";
499 # requirements
500 $sieve_script = getscript( $sieve, $gosa_sieve_script_name );
501 #print "$sieve_script\n";
502 if ( ! ( $sieve_script ) ) {
503 print "No Sieve Script! Creating New One!\n";
504 $sieve_script = $gosa_sieve_header;
505 }
506 if ( $sieve_script =~ m/require.*\[.*["|'] *vacation *["|'].*\]/ ) {
507 print "require vacation ok\n";
508 } else {
509 print "require vacation not ok\n";
510 print "modifying require statement\n";
511 $sieve_script =~ s/require(.*\[.*)\]/require$1\, "vacation"\]/;
512 }
513 if ( ! ( $sieve_script =~ m/$vacation_header_template/ ) ) {
514 print "no match header template\n";
515 $sieve_vacation = $vacation_header_template .
516 "\n" .
517 "vacation :addresses [$addresses]\n" .
518 "\"" .
519 $vacation .
520 "\n\"\;" .
521 "\n" .
522 $vacation_footer_template .
523 "\n\n";
524 }
525 #print ( "$sieve_vacation\n" );
526 #print ( "$sieve_script\n" );
527 # including vacation message
528 if ( $sieve_script =~ m/$gosa_sieve_spam_header/ ) {
529 #print "MATCH\n";
530 $sieve_script =~ s/($gosa_sieve_spam_header[^{}]*{[^{}]*})/$1\n\n$sieve_vacation/;
531 } else {
532 $sieve_script =~ s/require(.*\[.*\]\;)/require$1\n\n$sieve_vacation/;
533 }
534 #print ( "START SIEVE $sieve_script\nSTOP SIEVE" );
535 # uploading new sieve script
536 putscript( $sieve, $gosa_sieve_script_name, $sieve_script );
537 # activating new sieve script
538 setactive( $sieve, $gosa_sieve_script_name );
539 } else {
540 print "no gosa script available for user $uid_v, creating new one";
541 $sieve_script = $gosa_sieve_header . "\n\n" . $sieve_vacation;
542 # uploading new sieve script
543 putscript( $sieve, $gosa_sieve_script_name, $sieve_script );
544 # activating new sieve script
545 setactive( $sieve, $gosa_sieve_script_name );
546 }
547 }
548 closesieve ( $sieve );
549 }
550 }
551 } elsif ( $today >= $real_stop ) {
552 print "deactivating vacation for user $uid_v\n";
554 my $srv_filter = "(&(goImapName=$server_v)(objectClass=goImapServer))";
555 my $srv_list_of_attributes = [ 'goImapSieveServer', 'goImapSievePort', 'goImapAdmin', 'goImapPassword' ];
556 my $srv_result = ldap_search ( $ldap_url, $srv_filter, $search_scope, $ldap_base, $srv_list_of_attributes, $bind_dn, $bind_dn_pwd );
557 my @srv_entries = $srv_result->entries;
558 my $srv_entry = {};
559 my $noe = @srv_entries;
560 if ( $noe == 0 ) {
561 printf STDERR "Error: no $server_attribute defined! Aboarting...";
562 } elsif ( $noe > 1 ) {
563 printf STDERR "Error: multiple $server_attribute defined! Aboarting...";
564 } else {
565 my $goImapSieveServer = $srv_entries[0]->get_value ( 'goImapSieveServer' );
566 my $goImapSievePort = $srv_entries[0]->get_value ( 'goImapSievePort' );
567 my $goImapAdmin = $srv_entries[0]->get_value ( 'goImapAdmin' );
568 my $goImapPassword = $srv_entries[0]->get_value ( 'goImapPassword' );
569 if ( ( $goImapSieveServer ) && ( $goImapSievePort ) && ( $goImapAdmin ) && ( $goImapPassword ) ) {
570 #my $sieve = opensieve ( $goImapAdmin, $goImapPassword, $sieve_user, $goImapSieveServer, $goImapSievePort);
571 my $sieve = opensieve ( $goImapAdmin, $goImapPassword, $uid_v, $goImapSieveServer, $goImapSievePort);
572 @sieve_scripts = listscripts ( $sieve );
573 $script_name = "";
574 if ( @sieve_scripts ) {
575 foreach $script_name ( @sieve_scripts ) {
576 if ( $script_name =~ m/$gosa_sieve_script_name/ ) {
577 $gosa_sieve_script_status = "TRUE";
578 }
579 }
580 if ( $gosa_sieve_script_status eq "TRUE" ) {
581 # removing vacation part
582 $sieve_script = getscript( $sieve, $gosa_sieve_script_name );
583 if ( $sieve_script ) {
584 #print "OLD SIEVE SCRIPT:\n$sieve_script\n\n";
585 $sieve_script =~ s/$vacation_header_template[^#]*$vacation_footer_template//;
586 #print "NEW SIEVE SCRIPT:\n$sieve_script\n\n";
587 # uploading new sieve script
588 putscript( $sieve, $gosa_sieve_script_name, $sieve_script );
589 # activating new sieve script
590 setactive( $sieve, $gosa_sieve_script_name );
591 }
592 }
593 }
594 closesieve ( $sieve );
595 }
596 }
597 } else {
598 print "no vacation process necessary for user $uid_v\n";
599 }
600 }