contrib/scripts/sieve_vacation/update-vacation.pl

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