#
# Mail Notification extensions to standard TWiki Code
# Authors: Martin Fuzzey / Patrick Nomblot
#

package MailNotify;

use TWiki;
use strict;

use vars qw($debug $testonly $LDAP_available);

eval 'use Net::LDAP;';
eval 'use Net::LDAP::Entry;';
if ($@) {$LDAP_available=0;} else {$LDAP_available=1;}


sub processWeb
{
   my $web        = shift;
   $debug         = shift;
   $testonly      = shift;
   my $keepmails  = shift;

   $debug && $testonly  && print "TEST ONLY MODE : No Mail will not be sent.\n";
   $debug && $keepmails && print "KEEP MAIL COPY : mail will be stored in .mail files under TWiki data directory.\n";

   my ( $topic, $webName, $dummy, $userName, $dataDir) = &TWiki::initialize( "/$web", "nobody" );
   $dummy = "";  # to suppress warning

   $debug && print "\n","-"x80,"\n";
   $debug && print "Checking TWiki.$webName\n";

   if( ! &TWiki::Store::webExists( $webName ) ) {
     print STDERR "* ERROR: TWiki mailnotify does not find web $webName\n";
     return;
   }

   my %notifyHash = getEmailNotifyList($webName);
   my @notifylist=keys %notifyHash;

   my %globalexclude;
   my @excludeList = getEmailNotifyExclusionList("$webName");
   foreach ( @excludeList ) {
       $globalexclude{$_}=1;
   }
   $debug && print "Web $webName Global Topic Exclude list = ", join(" ", @excludeList), "\n";
   $debug && print "Web $webName notify list = ", join (" ", @notifylist) , "\n";

   unless ( scalar @notifylist ) 
   {
     $debug && print "<none>\n"; 
     return;
   }

   my $ThisNotifyDate="";

   foreach my $mailadress (@notifylist) 
   {
       $debug && print "- "x40,"\n";
       $debug && print "Looking for mailadress $mailadress in web $webName\n";

       my $emailbody = "";
       my $topiclist = "";
       my $mailnotifyTemplate="mailnotify";
       my $mailnotifyTemplateHTML="changes";


      foreach my $what ( "IN","NOT")
       {
         if ( defined ($notifyHash{$mailadress}{$what}{TEMPLATE}) )
         {
           if ( -f "${TWiki::templateDir}/mailnotify_$notifyHash{$mailadress}{$what}{TEMPLATE}.tmpl" )
           {
             $debug && print "Loading Specific Global Template : $notifyHash{$mailadress}{$what}{TEMPLATE}\n";
             $mailnotifyTemplate="mailnotify_$notifyHash{$mailadress}{$what}{TEMPLATE}";
           }
           if ( -f "${TWiki::templateDir}/changes_$notifyHash{$mailadress}{$what}{TEMPLATE}.tmpl" )
           {
             $debug && print "Loading Specific HTML Sub Template : $notifyHash{$mailadress}{$what}{TEMPLATE}\n";
             $mailnotifyTemplateHTML="changes_$notifyHash{$mailadress}{$what}{TEMPLATE}";
           }
         }
       }



       my $skin = TWiki::Prefs::getPreferencesValue( "SKIN" );
       my $text = TWiki::Store::readTemplate( $mailnotifyTemplateHTML, $skin );
       my $changes= &TWiki::Store::readFile( "$dataDir/$webName/.changes" );

       $text = &TWiki::handleCommonTags($text, $topic);
       $text =~ s/\%META{.*?}\%//go;  # remove %META{"parent"}%

       if( $TWiki::doRemoveImgInMailnotify ) 
       {
           # change images to [alt] text if there, else remove image
           $text =~ s/<img src=.*?alt=\"([^\"]+)[^>]*>/[$1]/goi;
           $text =~ s/<img src=.*?[^>]>//goi;
       }

       my $before = "";
       my $after = "";
       ( $before, $text, $after) = split( /%REPEAT%/, $text );
       $emailbody = &TWiki::Render::getRenderedVersion( $before );
       $after = &TWiki::Render::getRenderedVersion( $after );

       my $LastNotifyTime = &TWiki::Store::readFile( "$dataDir/$webName/.mailnotify" ) || "0";
       chomp($LastNotifyTime);

       $debug && print "Last notification time for $webName : " .&TWiki::formatTime($LastNotifyTime, "\$day \$mon \$year", "gmtime") . "\n";

       my $scriptSuffix = $TWiki::scriptSuffix;
       my $scriptUrlPath = $TWiki::scriptUrlPath;
       my $scriptUrl = "$TWiki::urlHost$scriptUrlPath";
       my $frev = "";

       # URL-encode web name for use of I18N topic names in plain text
       my $webNameEnc = TWiki::handleUrlEncode( $webName );


       my $currLastmodify = "";
       my $warningText1="You can specify TOPICS to exclude from mail notification for each web in $scriptUrl/view$scriptSuffix/$webNameEnc/WebNotifyExclusion";
       my $warningText2="You can specify TOPICS to exclude from their name, content or author values, see  $scriptUrl/view$scriptSuffix/TWiki/WebNotifyFilter";
       my %excludedTopics1=();
       my %excludedTopics2=();
       my %exclude=();
       foreach( reverse split( /\n/, $changes ) ) 
       {
           # Parse lines from .changes:
           # <topic>	<user>		<change time>	<revision>
           # WebHome	FredBloggs	1014591347	21

           my ($topicName, $userName, $changeTime, $revision) = split( /\t/);

           # URL-encode topic names for use of I18N topic names in plain text
           my $topicNameEnc = TWiki::handleUrlEncode( $topicName );

           $debug && print "$web.$topicName --> "; 

           if( ( %exclude ) && ( $exclude{ $topicName } ) ) 
           {
             $debug && print "KO : already done\n"; 
             next; 
           }

           unless ( TWiki::Store::topicExists( $webName, $topicName ) )
           {
             $debug && print "KO : non existing Topic\n"; 
             next; 
           }


           if( (%globalexclude) && ($globalexclude{$topicName}) ) 
           { 
              $debug && print "ejected by global exclude :$globalexclude{$topicName}\n"; 
              $excludedTopics1{"$scriptUrl/view$scriptSuffix/$webNameEnc/$topicNameEnc"}=1;
              $warningText1="Some TOPICs have been excluded via Topic : $scriptUrl/view$scriptSuffix/$webNameEnc/WebNotifyExclusion \n";
              $warningText1.="Excluded Topics : \n     " . join ("\n     ", keys (%excludedTopics1)) . "\n";
              $exclude{ $topicName } = "1";
              next; 
           }

           my( $topicMeta, $topicText ) = &TWiki::Store::readTopic( $webName, $topicName , 1);
           my %topicinfo = $topicMeta->findOne( "TOPICINFO");
           my $topicAuthor = &TWiki::userToWikiName( $topicinfo{"author"} );
#          $debug && print "AUTHOR = $topicAuthor\n";
#          $debug && print "Filter rules : ", ShowTopicIncludeExclude($notifyHash{$mailadress}), "\n";

           if ( my $r=TopicIncludeExclude(\%notifyHash, $mailadress, "$topicName", "$topicAuthor", "$topicText") )
           {
              $debug && print "TopicIncludeExclude : $r\n";
              $excludedTopics2{"$scriptUrl/view$scriptSuffix/$webNameEnc/$topicNameEnc"}=1;
              $warningText2="Some TOPICs have been excluded via extension rules defined in Topic : $scriptUrl/view$scriptSuffix/$webNameEnc/WebNotify \n";
              $warningText2.="Rules where : " . ShowTopicIncludeExclude(\%notifyHash, $mailadress) . "\n";
              $warningText2.="Excluded Topics : \n     " . join ("\n     ", keys (%excludedTopics2)) . "\n";
              $exclude{ $topicName } = "1";
              next;
           }

           if( ! $currLastmodify ) 
           {
               # this is the newest entry
               my $time = &TWiki::formatTime($LastNotifyTime, "\$day \$mon \$year", "gmtime");
               if( $LastNotifyTime eq $changeTime ) 
               {
                   # newest entry is same as at time of previous notification
                   $debug && print "KO\n- Note: No topics changed since $time\n";
                   last;
               }
               $currLastmodify = $changeTime;
           }

           if( $LastNotifyTime >= $changeTime ) 
           {
               # found item of last notification
               $debug && print "Date: found item of last notification [$LastNotifyTime] >= [$changeTime]\n";
               last;
           }

           $frev = "";
           if( $revision ) 
           {
               if( $revision > 1 ) 
               {
                   $frev = "r1.$revision";
               } 
               else 
               {
                   $frev = "<b>NEW</b>";
               }
           }

           $debug && print "OK !\n";
           # Create entry in HTML attachment
           my $newText = $text;
           $newText =~ s/%TOPICNAME%/$topicName/go;

           $newText =~ s/%LOCKED%//go;

           my $time = &TWiki::formatTime($changeTime, "\$day \$mon \$year", "gmtime");
           $newText =~ s/%TIME%/$time/go;
           $newText =~ s/%REVISION%/$frev/go;
           $newText = &TWiki::Render::getRenderedVersion( $newText );

           my $wikiuser = &TWiki::userToWikiName( $userName );
           $wikiuser =~ s/Main\.//go;
           $newText =~ s/%AUTHOR%/$wikiuser/go;

           my $head = &TWiki::Store::readFileHead( "$dataDir\/$webName\/$topicName.txt", 16 );
           $head = &TWiki::makeTopicSummary( $head, $topicName, $webName );
           $newText =~ s/%TEXTHEAD%/$head/go;

           $emailbody .= $newText;
           $exclude{ $topicName } = "1";

           # Create entry in plain-text email body
           $newText = "- $topicName  ($wikiuser)  $scriptUrl/view$scriptSuffix/$webNameEnc/$topicNameEnc\n";
           $newText =~ s/Main\.//go;
           $topiclist = "$topiclist$newText";
       } # foreach changes

       if( $topiclist eq "" ) {
           $debug && print "- Note: Topic list is empty\n";
           next;
       }

       $emailbody .= $after;

       my $from = &TWiki::Prefs::getPreferencesValue("WIKIWEBMASTER");

       my $notifylist = $mailadress;

       $text = &TWiki::Store::readTemplate( $mailnotifyTemplate, $skin );
       $text =~ s/%EMAILFROM%/$from/go;
       $text =~ s/%EMAILTO%/$notifylist/go;
       $text =~ s/%EMAILBODY%/$emailbody/go;
       $text =~ s/%TOPICLIST%/$topiclist/go;
       $text =~ s/%WARNING1%/$warningText1/go;
       $text =~ s/%WARNING2%/$warningText2/go;
       $text =~ s/%LASTDATE%/&TWiki::formatTime($LastNotifyTime, "\$day \$mon \$year", "gmtime")/geo;
       $text = &TWiki::handleCommonTags( $text, $topic );

       # change absolute addresses to relative ones & do some cleanup
       $text =~ s/(href=\")$scriptUrlPath/$1..\/../goi;
       $text =~ s/(action=\")$scriptUrlPath/$1..\/../goi;
       $text =~ s|( ?) *</*nop/*>\n?|$1|gois;


       $debug && print "+"x80,"\n";
       $debug && print "- Sending mail notification to: $notifylist\n";


       my $MailSentError = "";

       if ( $keepmails ) 
       {
           mkdir("$dataDir/.mails", 0775);
           mkdir("$dataDir/.mails/$webName", 0775);
           my $mailfilename="$dataDir/.mails/$webName/${mailadress}.mail";

           use FileHandle;
           my $FH = new FileHandle;
           open($FH, ">$mailfilename") || die "Cannot create MAIL file $mailfilename !\n";
           print $FH "$text";
           close ($FH);
           $debug && print "- Mail notification stored in file $mailfilename \n";
       }

       if ( $testonly ) 
       {
           $MailSentError = "TEST ONLY : Mail not sent, mail notify date unchanged !\n";
       }
       else
       {
           $MailSentError = &TWiki::Net::sendEmail( $text );
       }


       if( $MailSentError ) 
       {
           $debug && print STDERR "* $MailSentError";
       }
       else
       {
         $ThisNotifyDate="$currLastmodify";
       }
       $debug && print "+"x80,"\n";
   } # foreach mail address
   if ( $ThisNotifyDate ) 
   { 
     &TWiki::Store::saveFile( "$dataDir/$webName/.mailnotify", $ThisNotifyDate ); 
     $debug && print "Notification time for $webName : " .&TWiki::formatTime($ThisNotifyDate, "\$day \$mon \$year", "gmtime") . "\n";
   }
   $debug && print "End of notification for $webName\n";
   $debug && print "#"x80,"\n";
}



# =========================
# Get email list from WebNotify page - this now handles entries of the form:
#    * Main.UserName 
#    * UserName 
#    * Main.GroupName
#    * GroupName
# The 'UserName' format (i.e. no Main webname) is supported in any web, but
# is not recommended since this may make future data conversions more
# complicated, especially if used outside the Main web.  %MAINWEB% is OK
# instead of 'Main'.  The user's email address(es) are fetched from their
# user topic (home page) as long as they are listed in the '* Email:
# fred@example.com' format.  Nested groups are supported.
sub getEmailNotifyList
{
    my( $web, $topicname ) = @_;

    $topicname = $TWiki::notifyTopicname unless $topicname;
    return() unless &TWiki::Store::topicExists( $web, $topicname );

    # Allow %MAINWEB% as well as 'Main' in front of users/groups -
    # non-capturing regex.
    my %users= ();
    my $mainWebPattern = qr/(?:$TWiki::mainWebname|%MAINWEB%)/;
    my $wikiWordRegex=$TWiki::regex{wikiWordRegex};
    my $emailAddrRegex=$TWiki::regex{emailAddrRegex};

    foreach ( split ( /\n/, TWiki::Store::readWebTopic( $web, $topicname ) ) ) {

        my $line="$_";

        $debug && print "$web/$topicname ---> $line\n";

        if ( /^\s+\*\s(?:$mainWebPattern\.)?($wikiWordRegex)\s+\-\s+($emailAddrRegex)/o ) 
        {
	          # Got full form:   * Main.WikiName - email@domain
	          # (the 'Main.' part is optional, non-capturing)
            if ( $1 ne 'TWikiGuest' ) 
            {
                # Add email address to list if non-guest and non-duplicate
                SetTopicIncludeExclude (\%users, $2, $line);
            }
        } 
        elsif ( /^\s+\*\s(?:$mainWebPattern\.)?($wikiWordRegex)\s/o ) 
        { 
            # Got short form:   * Main.WikiName
            # (the 'Main.' part is optional, non-capturing)
            my $userWikiName = $1;
            foreach ( getEmailOfUser($userWikiName) ) 
            {
                # Add email address to list if it's not a duplicate
                SetTopicIncludeExclude (\%users, $_, $line);
            }
        }
    }
    ##writeDebug "list of emails: %users";
    if ($debug) 
    {
      print "\n","*"x78,"\n";
      print "USERS of $web/$topicname\n";
      use Dumpvalue;
      my $dumper = new Dumpvalue;
      $dumper->set(globPrint => 1); 
      $dumper->dumpValue(\%users);
      print "\n","*"x78,"\n";
    }

    return( %users );
}


# =========================
# Obtain list of excluded topics from given web and optional topic name
# Default topic name is WebNotifyExclusion
# This topic must contains exclusion list as wiki list (tab, space, * topic)
sub getEmailNotifyExclusionList
{
    my( $web, $topicname ) = @_;
    my @exclude=();

    if ( ! $topicname ) {
        $topicname = "WebNotifyExclusion";
    }
    my $list = "";
    my $line = "";
    my $dataDir = &TWiki::getDataDir();
    my $fileName = "$dataDir/$web/$topicname.txt";
    if ( -e $fileName ) {
        my @list = split( /\n/, &TWiki::Store::readFile( $fileName ) );
        foreach $line ( @list ) {
            # Match lines containing tab,space,* then rest and obtain rest (exclusion topics)
	     if ($line =~ /\t\* ([A-Za-z0-9]*)/) {
                @exclude = (@exclude, $1);
            }
       }
    }
    return @exclude;
}

# Get email address for a given WikiName or group, from the user's home page
sub getEmailOfUser
{
    my ($wikiName) = @_;		# WikiName without web prefix

    my @list = ();
    # Ignore guest entry and non-existent pages

    if (   $wikiName ne "TWikiGuest" 
        && TWiki::Store::topicExists( $TWiki::mainWebname, $wikiName ) ) 
    {
        if ( $wikiName =~ /Group$/ ) 
        {
            # Page is for a group, get all users in group
	    ##writeDebug "using group: $TWiki::mainWebname . $wikiName";
	    my @userList = TWiki::Access::getUsersOfGroup( $wikiName ); 
	    foreach my $user ( @userList ) 
            {
		$user =~ s/^.*\.//;	# Get rid of 'Main.' part.
		foreach my $email ( getEmailOfUser($user) ) 
                {
		    push @list, $email;
		}
	    }
        } 
        else 
        {
            # Page is for a user
            ##writeDebug "reading home page: $TWiki::mainWebname . $wikiName";

            my $HomeTopicMail="";
            foreach ( split ( /\n/, &TWiki::Store::readWebTopic($TWiki::mainWebname, $wikiName ) ) ) 
            {
              if (/^\s\*\sEmail:\s+([\w\-\.\+]+\@[\w\-\.\+]+)/) 
              {   
                # Define user email
                $HomeTopicMail="$1";
              }
            }

            # Extract mail from LDAP
            my $name=&TWiki::wikiToUserName($wikiName);
            my %result = LdapSearch ('filter' => "alias=$name", 'attrs'  => ['mail']);

            if ( defined ($result{'mail'}) )  
            {
               push @list, $result{'mail'};
            }
            else
            {
              if ( $HomeTopicMail ) 
              {
                 push @list, $HomeTopicMail;  
              } 
            }
        }
    }
    return (@list);
}


sub ShowTopicIncludeExclude
{
  my $hash=shift;
  my $user=shift;
  my $result="";

  foreach my $what  ("IN", "NOT")
  {
    foreach my $where ("TOPIC", "TEXT", "AUTHOR")
    {
      if (defined ($$hash{$user}{$what}{$where}) && ($$hash{$user}{$what}{$where} ne "") )
      {
        $result.= "$what\{$where=\"" . $$hash{$user}{$what}{$where} . "\"\} ";
      }
    }
  }
  return $result;
}



sub SetTopicIncludeExclude
{
  my $hash=shift;
  my $user=shift;
  my $line=shift;

  $$hash{$user}{LIST} = 1;
  if ( $line =~ /\s(IN|NOT)\{(.*)\}/o ) 
  {
    my $what="$1";
    my $values="$2";
    $debug && print "TOPIC EXCLUDE : options $what  = $values\n";

    foreach my $where  ("TOPIC", "TEXT", "AUTHOR", "TEMPLATE")
    {
      my $val = TWiki::extractNameValuePair($values, $where);
      if ( $val )
      { 
        $debug && print "TOPIC EXCLUDE : [$user] = [$what] [$where] [$val]\n";
        $$hash{$user}{$what}{$where} = "$val";
      }
    }
  }
}



sub TopicIncludeExclude
{
  my $hash=shift;
  my $user=shift;

  my %topicHash=();
  $topicHash{TOPIC} = shift;
  $topicHash{AUTHOR}  = shift;
  $topicHash{TEXT}  = shift;

#  print "\n","-"x78,"\n";
#  use Dumpvalue;
#  my $dumper = new Dumpvalue;
#  $dumper->set(globPrint => 1); 
#  $dumper->dumpValue($hash);
#  print "\n","-"x78,"\n";


  my $what="";

  $what="NOT";
  foreach my $where  ("TOPIC", "TEXT", "AUTHOR")
  {
    if (defined ($$hash{$user}{$what}{$where}) && ($$hash{$user}{$what}{$where} ne "") )
    {
      if ( defined($topicHash{$where}) && $topicHash{$where} =~ /$$hash{$user}{$what}{$where}/ )
      {
         return ("KO : ejected by regex $what\{$where=\"" . $$hash{$user}{$what}{$where}. "\"\}");
      }
    }
  }

  $what="IN";
  foreach my $where  ("TOPIC", "TEXT", "AUTHOR")
  {
    if (defined ($$hash{$user}{$what}{$where}) && ($$hash{$user}{$what}{$where} ne "") )
    {
      if ( defined($topicHash{$where}) && $topicHash{$where} !~ /$$hash{$user}{$what}{$where}/ )
      {
         return ("KO : ejected by regex $what\{$where=\"" . $$hash{$user}{$what}{$where}. "\"\}");
      }
    }
  }

  return(0);
}


#############################################################################
# LdapSearch
#
# A simple LDAP search for TWiki
#
#############################################################################

sub LdapSearch {
  my %attr = @_;
  my %result=();
  my $ldap="";
  
  $attr{'host'} = $attr{'host'} || $TWiki::LDAPHost;
  $attr{'base'} = $attr{'base'} || $TWiki::LDAPBase;

  if ( $LDAP_available && $attr{'host'} &&  $attr{'base'} )
  {
    $debug && print "LDAP : looking for $attr{filter} \n";
    if (($ldap = Net::LDAP->new ($attr{'host'}))) 
    {
      $debug && print("LDAP : connected to $attr{'host'} !\n");
      # LDAP lookup
      my $mesg = $ldap->search(%attr);

      my $max = $mesg->count;

      for (my $i=0 ; $i < $max ; $i++) 
      {
        my $entry = $mesg->entry($i);
        foreach (@{$attr{'attrs'}})
        {
          $result{"$_"} = $entry->get_value($_);
          $debug && print ("LDAP : $_ = " . $result{"$_"} . "\n");
        }
      }
    }
    else
    {
      # Connection failed!
      $debug && TWiki::writeDebug("LDAP connection to $attr{'host'} failed");
    }
  }
  return (%result);
}




1;