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         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;
  94
  95         return $config;
  96 }
  97
  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};
 106
 107         return $default;
 108 }
 109
 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 }
 121
 122
 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;
 134
 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         }
 144
 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         }
 153
 154         $ldap->unbind;
 155
 156         return $result;
 157 }
 158
 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 = "";
 173
 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         }
 189
 190         return $base;
 191 }
 192
 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;
 202
 203         print ( "##### Proxy => $user, Server => $server, Login => $admin, Password => $pass, Port => $port ####\n" );
 204
 205         my $sieve = IMAP::Sieve->new ( 'Proxy' => $user, 'Server' => $server, 'Login' => $admin, 'Password' => $pass, 'Port' => $port );
 206         return $sieve;
 207 }
 208
 209 sub closesieve {
 210         my $sieve = shift;
 211
 212         if ($sieve) {$sieve->close};
 213 }
 214
 215 sub listscripts {
 216         my $sieve = shift;
 217
 218         my @scripts = $sieve->listscripts;
 219         my $script_list = join("\n",@scripts)."\n";
 220         return $script_list;
 221 }
 222
 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";
 230
 231         $scriptfile = $sieve->getscript($script);
 232         return $scriptfile;
 233 }
 234
 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";
 242
 243         my $res=$sieve->putscript($scriptname,$script);
 244         if ($res) {print $sieve->{'Error'}}
 245         return;
 246 }
 247
 248 sub setactive {
 249         my $sieve = shift;
 250         my $script = shift;
 251
 252         my $res=$sieve->setactive($script);
 253         if ($res) { print $sieve->{'Error'};}
 254         return;
 255 }
 256
 257 #
 258 # main ()
 259 #
 260 # read options
 261 getopts( "$opt_string", \%opt );
 262
 263 # read GOsa config
 264 my $input_stream = read_config ( $gosa_config );
 265
 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";
 276
 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);
 287
 288 if ( $mailMethod =~ m/cyrus/i ) {
 289         my $server_attribute = "gosaMailServer";
 290         my $alternate_address_attribute = "gosaMailAlternateAddress";
 291 }
 292
 293 # determine LDAP base
 294 my $ldap_base = get_ldap_base ( $ldap_url, $gosa_config_base, $simple_bind_dn, $simple_bind_dn_pwd );
 295
 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 );
 301
 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";
 345
 346         my ($sieve_user, $tmp) = split ( /\@/, $mail_v );
 347
 348         if ( ( $today >= $start_v ) && ( $today < $stop_v ) ) {
 349                 print "activating vacation for user $uid_v\n";
 350
 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";
 431
 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 }