1 #!/usr/bin/perl -w -I.
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 utf8;
26 use Getopt::Std;
27 use vars qw/ %opt /;
29 #
30 # Definitions
31 #
32 my $gosa_config = "/etc/gosa/gosa.conf";
33 my $opt_string = 'l:h';
34 my $location = "";
35 my $today = time ();
36 # default mailMethod = kolab
37 my $server_attribute = "kolabHomeServer";
38 my $alternate_address_attribute = "alias";
39 my $gosa_sieve_script_name = "gosa";
40 my $simple_bind_dn = "";
41 my $simple_bind_dn_pwd = "";
42 my $gosa_sieve_script_status = "FALSE";
43 my $sieve_vacation = "";
44 my $gosa_sieve_spam_header = "Sort mails with higher spam level";
46 #
47 # Templates
48 #
49 my $gosa_sieve_header = "\#\#\#GOSA\nrequire\ \[\"fileinto\",\ \"reject\",\ \"vacation\"\]\;\n\n";
50 my $vacation_header_template = "\# Begin vacation message";
51 my $vacation_footer_template = "\# End vacation message";
53 #
54 # Usage
55 #
56 sub usage {
57 die "Usage:\nperl $0 [option]\n\n\tOptions:\n\t\t-l <\"location name\">\tuse special location\n\t\t-h\t\t\tthis help \n";
58 }
60 #
61 # Config import
62 #
63 sub read_config {
64 my $input = shift || die "need config file: $!";
65 my $stream = "";
66 open ( FILE, "< $input" ) or die "Error opening file $input: $! \n";
67 {
68 local $/ = undef;
69 $stream = <FILE>;
70 }
71 close ( FILE );
72 return $stream;
73 }
75 #
76 # XML parser
77 #
78 sub parseconfig {
79 my $c_location = shift;
80 my $xmldata = shift;
81 my $xml = new XML::Simple ();
82 my $c_data = $xml -> XMLin( $xmldata );
83 my $config = {};
84 my $server = $c_data->{main}->{location}->{$c_location}->{server};
85 my $config_base = $c_data->{main}->{location}->{$c_location}->{config};
86 my $ldap_admin = $c_data->{main}->{location}->{$c_location}->{referral}->{admin};
87 my $ldap_admin_pwd = $c_data->{main}->{location}->{$c_location}->{referral}->{password};
88 my $mailMethod = $c_data->{main}->{location}->{$c_location}->{mailMethod};
89 $config->{server} = $server;
90 $config->{config_base} = $config_base;
91 $config->{mailMethod} = $mailMethod;
92 $config->{ldap_admin} = $ldap_admin;
93 $config->{ldap_admin_pwd} = $ldap_admin_pwd;
95 return $config;
96 }
98 #
99 # Get default location
100 #
101 sub get_default_location {
102 my $xmldata = shift;
103 my $xml = new XML::Simple ( RootName=>'conf' );
104 my $c_data = $xml -> XMLin( $xmldata );
105 my $default = $c_data->{main}->{default};
107 return $default;
108 }
110 #
111 # LDAP error handling
112 #
113 sub ldap_error {
114 my ($from, $mesg) = @_;
115 print "Return code: ", $mesg->code;
116 print "\tMessage: ", $mesg->error_name;
117 print " :", $mesg->error_text;
118 print "MessageID: ", $mesg->mesg_id;
119 print "\tDN: ", $mesg->dn;
120 }
123 #
124 # LDAP search
125 #
126 sub ldap_search {
127 my $url = shift;
128 my $searchString = shift;
129 my $scope = shift;
130 my $base = shift;
131 my $attrs = shift;
132 my $bind_dn = shift;
133 my $bind_dn_pwd = shift;
135 if ( $base eq "NULL" ) {
136 $base = "";
137 }
138 my $ldap = Net::LDAP->new( $url ) or die "$@";
139 if ( ( ! ( $bind_dn ) ) || ( ! ( $bind_dn_pwd ) ) ) {
140 $ldap->bind;
141 } else {
142 $ldap->bind ( $bind_dn, password => $bind_dn_pwd );
143 }
145 my $result = $ldap->search ( base => "$base",
146 scope => "$scope",
147 filter => "$searchString",
148 attrs => $attrs
149 );
150 if ( $result->code ) {
151 ldap_error ( "Searching", $result );
152 }
154 $ldap->unbind;
156 return $result;
157 }
159 #
160 # Retrieve LDAP base
161 #
162 sub get_ldap_base {
163 my $url = shift;
164 my $config_base = shift;
165 my $bind_dn = shift;
166 my $bind_dn_pwd = shift;
167 my $filter = "(objectClass=*)";
168 my $init_base = "NULL";
169 my $scope = "base";
170 my $attributes = [ 'namingcontexts' ];
171 my $entry = {};
172 my $base = "";
174 $config_base =~ s/\,\ +/\,/g;
175 print $url."\n";
176 print $config_base."\n";
177 my $result = ldap_search ( $url, $filter, $scope, $init_base, $attributes, $bind_dn, $bind_dn_pwd );
178 my @entries = $result->entries;
179 my $noe = @entries;
180 print $noe."\n";
181 foreach $entry ( @entries ) {
182 my $tmp = $entry->get_value ( 'namingcontexts' );
183 print $tmp."\n";
184 $tmp =~ s/\,\ +/\,/g;
185 if ( $config_base =~ m/$tmp/ ) {
186 $base = $entry->get_value ( 'namingcontexts' );
187 }
188 }
190 return $base;
191 }
193 #
194 # SIEVE functions
195 #
196 sub opensieve {
197 my $admin = shift;
198 my $pass = shift;
199 my $user = shift;
200 my $server = shift;
201 my $port = shift;
203 print ( "##### Proxy => $user, Server => $server, Login => $admin, Password => $pass, Port => $port ####\n" );
205 my $sieve = IMAP::Sieve->new ( 'Proxy' => $user, 'Server' => $server, 'Login' => $admin, 'Password' => $pass, 'Port' => $port );
206 return $sieve;
207 }
209 sub closesieve {
210 my $sieve = shift;
212 if ($sieve) {$sieve->close};
213 }
215 sub listscripts {
216 my $sieve = shift;
218 my @scripts = $sieve->listscripts;
219 my $script_list = join("\n",@scripts)."\n";
220 return $script_list;
221 }
223 sub getscript {
224 my $sieve = shift;
225 my $script = shift;
226 my $scriptfile;
227 chomp $script;
228 #print "$sieve\n";
229 #print "$script\n";
231 $scriptfile = $sieve->getscript($script);
232 return $scriptfile;
233 }
235 sub putscript {
236 my $sieve = shift;
237 my $scriptname = shift;
238 my $script = shift;
239 print "$sieve\n";
240 print "$scriptname\n";
241 print "$script\n";
243 my $res=$sieve->putscript($scriptname,$script);
244 if ($res) {print $sieve->{'Error'}}
245 return;
246 }
248 sub setactive {
249 my $sieve = shift;
250 my $script = shift;
252 my $res=$sieve->setactive($script);
253 if ($res) { print $sieve->{'Error'};}
254 return;
255 }
257 #
258 # main ()
259 #
260 # read options
261 getopts( "$opt_string", \%opt );
263 # read GOsa config
264 my $input_stream = read_config ( $gosa_config );
266 # get location
267 if ( $opt{l} ) {
268 $location = $opt{l};
269 } elsif ( $opt{h} ) {
270 usage ();
271 exit (0);
272 } else {
273 $location = get_default_location ( $input_stream );
274 }
275 print "$location\n";
277 # parse config
278 my $config = parseconfig ( $location, $input_stream );
279 my $ldap_url = $config->{server};
280 my $gosa_config_base = $config->{config_base};
281 my $bind_dn = $config->{ldap_admin};
282 my $bind_dn_pwd = $config->{ldap_admin_pwd};
283 my $mailMethod = $config->{mailMethod};
284 utf8::encode($ldap_url);
285 utf8::encode($gosa_config_base);
286 utf8::encode($mailMethod);
288 if ( $mailMethod =~ m/cyrus/i ) {
289 my $server_attribute = "gosaMailServer";
290 my $alternate_address_attribute = "gosaMailAlternateAddress";
291 }
293 # determine LDAP base
294 my $ldap_base = get_ldap_base ( $ldap_url, $gosa_config_base, $simple_bind_dn, $simple_bind_dn_pwd );
296 # retrieve user informations with activated vacation feature
297 my $filter = "(&(objectClass=gosaMailAccount)(gosaMailDeliveryMode=*V*)(!(gosaMailDeliveryMode=*C*)))";
298 my $list_of_attributes = [ 'uid', 'mail', $alternate_address_attribute, 'gosaVacationMessage', 'gosaVacationStart', 'gosaVacationStop', $server_attribute ];
299 my $search_scope = "sub";
300 my $result = ldap_search ( $ldap_url, $filter, $search_scope, $ldap_base, $list_of_attributes, $simple_bind_dn, $simple_bind_dn_pwd );
302 my @entries = $result->entries;
303 my $entry = {};
304 foreach $entry ( @entries ) {
305 my $uid_v = $entry->get_value ( 'uid' );
306 my $mail_v = $entry->get_value ( 'mail' );
307 my @mailalternate = $entry->get_value ( $alternate_address_attribute );
308 my $vacation = $entry->get_value ( 'gosaVacationMessage' );
309 my $start_v = $entry->get_value ( 'gosaVacationStart' );
310 my $stop_v = $entry->get_value ( 'gosaVacationStop' );
311 my $server_v = $entry->get_value ( $server_attribute );
312 if ( ! ( $uid_v ) ) {
313 $uid_v = "";
314 }
315 if ( ! ( $mail_v ) ) {
316 $mail_v = "";
317 }
318 my @mailAddress = ($mail_v);
319 my $alias = "";
320 foreach $alias ( @mailalternate ) {
321 push @mailAddress, $alias;
322 }
323 my $addresses = "";
324 foreach $alias ( @mailAddress ) {
325 $addresses .= "\"" . $alias . "\", ";
326 }
327 $addresses =~ s/\ *$//;
328 $addresses =~ s/\,$//;
329 if ( ! ( $vacation ) ) {
330 $vacation = "";
331 }
332 if ( ! ( $start_v ) ) {
333 $start_v = 0;
334 }
335 if ( ! ( $stop_v ) ) {
336 $stop_v = 0;
337 }
338 if ( ! ( $server_v ) ) {
339 $server_v = "";
340 next;
341 }
342 print $uid_v . " | " .
343 $addresses . " | " .
344 "\n";
346 my ($sieve_user, $tmp) = split ( /\@/, $mail_v );
348 if ( ( $today >= $start_v ) && ( $today < $stop_v ) ) {
349 print "activating vacation for user $uid_v\n";
351 my $srv_filter = "(&(goImapName=$server_v)(objectClass=goImapServer))";
352 my $srv_list_of_attributes = [ 'goImapSieveServer', 'goImapSievePort', 'goImapAdmin', 'goImapPassword' ];
353 my $srv_result = ldap_search ( $ldap_url, $srv_filter, $search_scope, $ldap_base, $srv_list_of_attributes, $bind_dn, $bind_dn_pwd );
354 my @srv_entries = $srv_result->entries;
355 my $srv_entry = {};
356 my $noe = @srv_entries;
357 if ( $noe == 0 ) {
358 printf STDERR "Error: no $server_attribute defined! Aboarting...";
359 } elsif ( $noe > 1 ) {
360 printf STDERR "Error: multiple $server_attribute defined! Aboarting...";
361 } else {
362 my $goImapSieveServer = $srv_entries[0]->get_value ( 'goImapSieveServer' );
363 my $goImapSievePort = $srv_entries[0]->get_value ( 'goImapSievePort' );
364 my $goImapAdmin = $srv_entries[0]->get_value ( 'goImapAdmin' );
365 my $goImapPassword = $srv_entries[0]->get_value ( 'goImapPassword' );
366 if ( ( $goImapSieveServer ) && ( $goImapSievePort ) && ( $goImapAdmin ) && ( $goImapPassword ) ) {
367 my $sieve = opensieve ( $goImapAdmin, $goImapPassword, $sieve_user, $goImapSieveServer, $goImapSievePort);
368 my @sieve_scripts = listscripts ( $sieve );
369 my $script_name = "";
370 if ( @sieve_scripts ) {
371 foreach $script_name ( @sieve_scripts ) {
372 if ( $script_name =~ m/$gosa_sieve_script_name/ ) {
373 $gosa_sieve_script_status = "TRUE";
374 }
375 }
376 if ( $gosa_sieve_script_status eq "TRUE" ) {
377 print "retrieving and modifying gosa sieve script\n";
378 # requirements
379 my $sieve_script = getscript( $sieve, $gosa_sieve_script_name );
380 #print "$sieve_script\n";
381 if ( ! ( $sieve_script ) ) {
382 print "No Sieve Script! Creating New One!\n";
383 $sieve_script = $gosa_sieve_header;
384 }
385 if ( $sieve_script =~ m/require.*\[.*["|'] *vacation *["|'].*\]/ ) {
386 print "require vacation ok\n";
387 } else {
388 print "require vacation not ok\n";
389 print "modifying require statement\n";
390 $sieve_script =~ s/require(.*\[.*)\]/require$1\, "vacation"\]/;
391 }
392 if ( ! ( $sieve_script =~ m/$vacation_header_template/ ) ) {
393 print "no match header template\n";
394 $sieve_vacation = $vacation_header_template .
395 "\n" .
396 "vacation :addresses [$addresses]\n" .
397 "\"" .
398 $vacation .
399 "\n\"\;" .
400 "\n" .
401 $vacation_footer_template .
402 "\n\n";
403 }
404 #print ( "$sieve_vacation\n" );
405 #print ( "$sieve_script\n" );
406 # including vacation message
407 if ( $sieve_script =~ m/$gosa_sieve_spam_header/ ) {
408 print "MATCH\n";
409 $sieve_script =~ s/($gosa_sieve_spam_header[^{}]*{[^{}]*})/$1\n\n$sieve_vacation/;
410 } else {
411 $sieve_script =~ s/require(.*\[.*\])/require$1\n\n$sieve_vacation/;
412 }
413 print ( "START SIEVE $sieve_script\nSTOP SIEVE" );
414 # uploading new sieve script
415 putscript( $sieve, $gosa_sieve_script_name, $sieve_script );
416 # activating new sieve script
417 setactive( $sieve, $gosa_sieve_script_name );
418 } else {
419 print "no gosa script available, creating new one";
420 my $sieve_script = $gosa_sieve_header . "\n\n" . $sieve_vacation;
421 # uploading new sieve script
422 putscript( $sieve, $gosa_sieve_script_name, $sieve_script );
423 # activating new sieve script
424 setactive( $sieve, $gosa_sieve_script_name );
425 }
426 }
427 }
428 }
429 } elsif ( $today >= $stop_v ) {
430 print "deactivating vacation for user $uid_v\n";
432 my $srv_filter = "(&(goImapName=$server_v)(objectClass=goImapServer))";
433 my $srv_list_of_attributes = [ 'goImapSieveServer', 'goImapSievePort', 'goImapAdmin', 'goImapPassword' ];
434 my $srv_result = ldap_search ( $ldap_url, $srv_filter, $search_scope, $ldap_base, $srv_list_of_attributes, $bind_dn, $bind_dn_pwd );
435 my @srv_entries = $srv_result->entries;
436 my $srv_entry = {};
437 my $noe = @srv_entries;
438 if ( $noe == 0 ) {
439 printf STDERR "Error: no $server_attribute defined! Aboarting...";
440 } elsif ( $noe > 1 ) {
441 printf STDERR "Error: multiple $server_attribute defined! Aboarting...";
442 } else {
443 my $goImapSieveServer = $srv_entries[0]->get_value ( 'goImapSieveServer' );
444 my $goImapSievePort = $srv_entries[0]->get_value ( 'goImapSievePort' );
445 my $goImapAdmin = $srv_entries[0]->get_value ( 'goImapAdmin' );
446 my $goImapPassword = $srv_entries[0]->get_value ( 'goImapPassword' );
447 if ( ( $goImapSieveServer ) && ( $goImapSievePort ) && ( $goImapAdmin ) && ( $goImapPassword ) ) {
448 my $sieve = opensieve ( $goImapAdmin, $goImapPassword, $sieve_user, $goImapSieveServer, $goImapSievePort);
449 my @sieve_scripts = listscripts ( $sieve );
450 my $script_name = "";
451 if ( @sieve_scripts ) {
452 foreach $script_name ( @sieve_scripts ) {
453 if ( $script_name =~ m/$gosa_sieve_script_name/ ) {
454 $gosa_sieve_script_status = "TRUE";
455 }
456 }
457 if ( $gosa_sieve_script_status eq "TRUE" ) {
458 # removing vacation part
459 my $sieve_script = getscript( $sieve, $gosa_sieve_script_name );
460 if ( $sieve_script ) {
461 print "OLD SIEVE SCRIPT:\n$sieve_script\n\n";
462 #$sieve_script =~ s/$vacation_header_template[^#]Yp.*$vacation_footer_template//;
463 $sieve_script =~ s/$vacation_header_template[^#]*$vacation_footer_template//;
464 print "NEW SIEVE SCRIPT:\n$sieve_script\n\n";
465 # uploading new sieve script
466 putscript( $sieve, $gosa_sieve_script_name, $sieve_script );
467 # activating new sieve script
468 setactive( $sieve, $gosa_sieve_script_name );
469 }
470 }
471 }
472 }
473 }
474 } else {
475 print "no vacation process necessary\n";
476 }
477 }