--- TFmail-1.38.pl	2006-02-09 16:40:27.000000000 -0500
+++ TFmail.pl	2024-06-27 20:37:21.624126869 -0400
@@ -2,6 +2,7 @@
 use strict;
 #
 # $Id: TFmail.pl,v 1.38 2006/02/09 21:40:27 gellyfish Exp $
+# Modifications by bscott, release 2, 2024 June 27
 #
 # USER CONFIGURATION SECTION
 # --------------------------
@@ -23,7 +24,7 @@
 use constant LOGFILE_EXT    => '.log';
 use constant HTMLFILE_ROOT  => '';
 use constant HTMLFILE_EXT   => '.html';
-use constant CHARSET        => 'iso-8859-1';
+use constant CHARSET        => 'utf-8';
 
 # USER CONFIGURATION << END >>
 # ----------------------------
@@ -52,6 +53,8 @@
 use lib LIBDIR;
 use NMStreq;
 use NMSCharset;
+use POSIX qw(strftime); # spam_log generates its own datestamps
+
 BEGIN
 {
    if (MIME_LITE)
@@ -71,6 +74,7 @@
 
    use vars qw($VERSION);
    $VERSION = substr q$Revision: 1.38 $, 10, -1;
+   $VERSION .= '-bscott2';
 }
 
 delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
@@ -168,25 +172,33 @@
 
       if ( check_required_fields($treq) )
       {
-         setup_input_fields($treq);
-         my $confto = send_main_email($treq, $recipients);
-         if ( HTMLFILE_ROOT ne '' )
-         {
-            insert_into_html_files($treq);
-         }
-         if ( LOGFILE_ROOT ne '' )
-         {
-            log_to_file($treq);
-         }
-         send_confirmation_email($treq, $confto);
-         if ( $treq->config('no_content',0))
+         if ( check_spam_content($treq) )
          {
-            print $treq->cgi()->header(-status => 204 );
-            exit;
+            setup_input_fields($treq);
+            my $confto = send_main_email($treq, $recipients);
+            if ( HTMLFILE_ROOT ne '' )
+            {
+               insert_into_html_files($treq);
+            }
+            if ( LOGFILE_ROOT ne '' )
+            {
+               log_to_file($treq);
+            }
+            send_confirmation_email($treq, $confto);
+            if ( $treq->config('no_content',0))
+            {
+               print $treq->cgi()->header(-status => 204 );
+               exit;
+            }
+            else
+            {
+               return_html($treq);
+            }
          }
          else
          {
-            return_html($treq);
+            spam_html($treq);
+            spam_log($treq) if (LOGFILE_ROOT ne '');
          }
       }
       else
@@ -529,6 +541,63 @@
    }
 }
 
+=item check_spam_content ( TREQ )
+
+Returns false if any fields contain apparent spam,
+true otherwise.
+
+=cut
+
+sub check_spam_content
+{
+   my ($treq) = @_;
+
+   my @has_spam = (); # fields found to have spam
+
+   # check fields configured to prohibit HTML
+   my @reject_html = split /\s*,\s*/, $treq->config('reject_html', '');
+   foreach my $r (@reject_html)
+   {
+      # this is VERY basic at this point. we are only looking for </a>,
+      # something common in almost all spam messages that come through and
+      # very unlikely to be entered by a legitimate user.
+      push @has_spam, $r if $treq->param($r) =~ m{<\s*/a\s*>}i;
+   }
+
+   # check fields
+   my $reject_regex = $treq->config('reject_regex', '');
+   if ($reject_regex)
+   {
+      my @reject_regex_fields = split /\s*,\s*/, $treq->config('reject_regex_fields', '');
+      foreach my $r (@reject_regex_fields)
+      {
+         push @has_spam, $r if $treq->param($r) =~ m{$reject_regex}i;
+      }
+   }
+
+   my @trapfield = split /\s*,\s*/, $treq->config('trapfield', '');
+   foreach my $r (@trapfield)
+   {
+      # if a trapfield has any non-whitespace content, it is spam
+      push @has_spam, $r if $treq->param($r) =~ m{\S+}i;
+   }
+   
+   # if any fields had spam, we reject the submission, after installing field
+   # handlers
+   if (scalar @has_spam)
+   {
+      $treq->install_foreach(
+         'spam_field', 
+         [map { {name => $_, value => $treq->param($_)} } @has_spam]
+      );
+      return 0; # has spam
+   }
+   else
+   {
+      return 1; # no spam detected
+   }
+}
+
 =item setup_input_fields ( TREQ )
 
 Installs a FOREACH directive in the TREQ object to
@@ -713,7 +782,10 @@
       $save = clean_template($treq);
    }
 
-   $msg->{body} = $treq->process_template($template, 'email', undef);
+   my $body;
+   $body = $treq->process_template($template, 'email', undef);
+   $body =~ s{&#13;&#10;}{\n}g;	# convert any &#13;&#10; sequences to newlines
+   $msg->{body} = $body;
 
    if ( dangerous_recipient($treq))
    {
@@ -857,7 +929,7 @@
    my ($treq, $msg) = @_;
 
    my $remote_addr = $ENV{REMOTE_ADDR};
-   $remote_addr =~ /^[\d\.]+$/ or die "weird remote_addr [$remote_addr]";
+   $remote_addr =~ /^[\da-fA-F\.:]+$/ or die "weird remote_addr [$remote_addr]";
 
    my $x_remote = "[$remote_addr]";
    my $x_gen_by = "NMS TFmail v$VERSION (NMStreq $NMStreq::VERSION)";
@@ -1043,8 +1115,9 @@
    my ($treq) = @_;
 
    my $file = $treq->config('logfile', '');
+   return unless $file; # no logging if config didn't request it
    $file = $treq->process_template("\%$file",'email', undef);
-   return unless $file;
+   return unless $file; # no logging if that left us nothing
    $file =~ m#^([\/\-\w]{1,100})$# or die "bad logfile name [$file]";
    $file = $1;
 
@@ -1177,6 +1250,87 @@
    }
 }
 
+=item spam_html ( TREQ )
+
+Generates the output page in the case where submission
+failed anti-spam checks.
+
+=cut
+
+sub spam_html
+{
+   my ($treq) = @_;
+   
+   my $redirect = $treq->config('spam_redirect');
+   if ( $redirect )
+   {
+      print "Location: $redirect\n\n";
+   }
+   else
+   {
+      html_page($treq, $treq->config('spam_template','spam'));
+   }
+}
+
+=item spam_log ( TREQ )
+
+Logs submissions rejected as spam, if so configured.
+
+=cut
+
+sub spam_log
+{
+
+   my ($treq) = @_;
+
+   # get requested log file name from config
+   my $spamlog = $treq->config('spamlog', '');
+   return unless $spamlog; # no logging if config didn't request it
+
+   # make sure log file contains only word characters, dir separator (/), or dash (-)
+   $spamlog =~ m#^([\/\-\w]{1,100})$# or die "bad spam log file name [$spamlog]";
+   $spamlog = $1; # de-taint
+
+   # build full path name of log file
+   $spamlog = LOGFILE_ROOT . '/' . $spamlog . LOGFILE_EXT;
+   
+   # build log message
+   my $logtrt =
+      '%' .
+      strftime ('%Y-%m-%d %H:%M:%S ', localtime) .
+      '{= env.REMOTE_ADDR =} ' .
+      '(' .
+      'via=<{= env.HTTP_VIA =}> ' .
+      'UA=<{= env.HTTP_USER_AGENT =}>' .
+      '): ' .
+      '{= FOREACH spam_field =}<{= name =}>=<{= value =}> {= END =}'
+   ;
+
+   open SPAMLOG,"+>>$spamlog" or die "$spamlog: open: $!";
+
+   # get lock for writing, or about
+   if (!(flock SPAMLOG, LOCK_EX))
+   {
+      warn "$spamlog: flock: $!";
+      close SPAMLOG or die "$spamlog: close: $1";
+      return;
+   }
+
+   # seek to end for append
+   seek SPAMLOG, 0, 2 or die "$spamlog: seek: $!";
+   
+   # record the log entry
+   $treq->process_template(
+      $logtrt,
+      'email',
+      \*SPAMLOG
+   );
+   
+   # finish up
+   close SPAMLOG or die "$spamlog: close: $1";
+
+} # spam_log
+
 =item return_html ( TREQ )
 
 Generates the output page in the case where the email has been