#!/usr/bin/perl -w
# 
# build/mkrules -- compile the SpamAssassin rules into installable form
#
# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at:
# 
#     http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>

# This is an implementation of
# http://wiki.apache.org/spamassassin/RulesProjPromotion 

sub usage {
  die "build/mkrules [--src srcdir] [--exit_on_no_src] [--out outputdir]\n";
}

my $RULE_DEFINE_KEYWORDS_RE = qr{
        header|rawbody|body|full|uri
        |meta|mimeheader|urirhssub|uridnsbl
    }x;

my $RULE_KEYWORDS_RE = qr{
        ${RULE_DEFINE_KEYWORDS_RE}|
        describe|tflags|reuse|score
    }x;

use strict;
use File::Find;
use File::Copy;
use File::Basename;
use Getopt::Long;

# use SpamAssassin classes directly, so we can lint rules
# as we go
use lib 'lib';
use Mail::SpamAssassin;

use vars qw(
    @opt_srcs $opt_out $opt_sandboxout $opt_manifest
    $opt_manifestskip $opt_listpromotable $opt_active
    $opt_activeout $default_file_header
    $opt_rulemetadata $opt_exit_on_no_src
);
GetOptions("src=s" => \@opt_srcs,
    "out=s",
    "sandboxout=s",
    "activeout=s",
    "active=s",
    "manifest=s",
    "manifestskip=s",
    "rulemetadata=s",
    "exit_on_no_src",
  );

if (!@opt_srcs) {
  foreach ( 'rulescode', 'rulesrc' ) {
    if (-d $_) {
      # print "using default src $_\n";
      push(@opt_srcs, $_);
    }
  }
}

if (!$opt_manifest && -f "MANIFEST") {
  $opt_manifest = "MANIFEST";
}

if (!$opt_manifestskip && -f "MANIFEST.SKIP") {
  $opt_manifestskip = "MANIFEST.SKIP";
}

if (!$opt_active && -f "rules/active.list") {
  $opt_active = "rules/active.list";
}

if ($opt_exit_on_no_src) {
  my $foundone = 0;
  foreach my $src (@opt_srcs) {
    if (-d $src) { $foundone++; last; }
  }

  if (!$foundone) {
    print "no source directory found: exiting\n";
    exit 0;
  }
}
# else
die "no src" unless (@opt_srcs >= 1);

my $promolist;

  die "no out" unless ($opt_out);
  die "unreadable out" unless (-d $opt_out);
  die "unreadable active" unless (-f $opt_active);

$opt_sandboxout  ||= "70_sandbox.cf";
$opt_activeout   ||= "72_active.cf";

# source files that need compilation, and their targets
my $needs_compile = { };
my $found_output = { };
my $current_src;
my $newest_src_mtime = 0;
my $newest_out_mtime = 0;

my $default_file_header = join('', <DATA>);
compile_utf8ify_function();

foreach my $src (@opt_srcs) {
  if (!-d $src) {
    warn "WARNING: unreadable src '$src'\n";
    next;
  }
  $current_src = $src;
  File::Find::find ({
          wanted => \&src_wanted,
          no_chdir => 1
        }, $src);
}

# get mtimes of output files; we can be sure that all
# output is under the "opt_out" dir, so recurse there
File::Find::find ({
        wanted => \&out_wanted,
        no_chdir => 1
      }, $opt_out);

# we must rebuild if a compiled .pm is missing, too
my $found_all_pm_files = 1;
foreach my $f (keys %{$needs_compile}) {
  next unless ($f =~ /\.pm$/i);
  if (!exists $found_output->{basename $f}) {
    $found_all_pm_files = 0;
  }
}

# check mtime on the active.list file, too
{
  my @st = stat $opt_active;
  if ($st[9] && $st[9] > $newest_src_mtime) {
    $newest_src_mtime = $st[9];
  }
}

# check mtimes, and also require that the two required output files
# really do exist
if ($newest_src_mtime && $newest_out_mtime
    && $newest_src_mtime < $newest_out_mtime
    && -f $opt_out.'/'.$opt_sandboxout
    && -f $opt_out.'/'.$opt_activeout
    && $found_all_pm_files)
{
  print "mkrules: no rules updated\n";
  exit 0;
}

my $rules = { };

my $file_manifest = { };
my $file_manifest_skip = [ ];
if ($opt_manifest) {
  read_manifest($opt_manifest);
}
if ($opt_manifestskip) {
  read_manifest_skip($opt_manifestskip);
}

my $active_rules = { };
read_active($opt_active);

# context for the rules compiler
my $seen_rules = { };
my $renamed_rules = { };
my $output_files = { };
my $output_file_text = { };
my $files_to_lint = { };
my $entries_for_rule_name = { };

# $COMMENTS is a "catch-all" "name", for lines that appear after the last line
# that refers to a rule by name.  Those lines are not published by themselves;
# they'll be published to all pubfiles found in the file.
#
# It's assumed they are comments, because they generally are, but could be all
# sorts of unparseable lines.
my $COMMENTS = '!comments!';

# another "fake name" for lines that should always be published.  They'll
# be published to the non-sandbox file.
my $ALWAYS_PUBLISH = '!always_publish!';

read_all_rules($needs_compile);
read_rules_from_output_dir();
compile_output_files();
lint_output_files();
write_output_files();

exit;

# ---------------------------------------------------------------------------

sub lint_output_files {
  foreach my $file (keys %{$files_to_lint}) {
    my $text = join("\n", "file start $file", $output_file_text->{$file}, "file end $file");
    if (lint_rule_text($text) != 0) {
      warn "\nERROR: LINT FAILED, suppressing output: $file\n\n";

      # don't suppress entirely, otherwise 'make distcheck'/'disttest'
      # will fail since the MANIFEST-listed output files will be 
      # empty.

      # delete $output_file_text->{$file};
      $output_file_text->{$file} = '';
    }
  }
}

sub lint_rule_text {
  my ($text) = @_;

  # ensure we turn off slow/optional stuff for linting, but keep the essentials
  my $pretext = q{
    loadplugin Mail::SpamAssassin::Plugin::Check
    loadplugin Mail::SpamAssassin::Plugin::URIDNSBL
    use_bayes 0
  };

  my $mailsa = Mail::SpamAssassin->new({
      rules_filename => "./rules",
      # debug => 1,
      local_tests_only => 1,
      dont_copy_prefs => 1,
      config_text => $pretext.$text
  });

  my $errors = 0;
  $mailsa->{lint_callback} = sub {
    my %opts = @_;

    return if ($opts{msg} =~ /
          (?:score\sset\sfor\snon-existent|description\sexists)
      /x);

    warn "lint: $opts{msg}";
    if ($opts{iserror}) {
      $errors++;
    }
  };

  $mailsa->lint_rules();
  $mailsa->finish();
  return $errors;       # 0 means good
}

sub src_wanted {
  my $path = $File::Find::name;

  # record stat times of directories, too, to catch file additions/removals
  # in the source tree
  my @st = stat $path;
  if ($st[9] && $st[9] > $newest_src_mtime) {
    $newest_src_mtime = $st[9];
  }

  # only files from now on, though
  return if (!-f $path);
  
  # limit what will be copied from sandboxes
  return if ($path =~ /\bsandbox\b/ && !/(?:\d.*\.cf|\.pm)$/i);

  # don't use generated scores; they can be out of sync with what is currently
  # in the sandboxes or the most current active.list file at any given time
  return if ($path =~ /\bscores\b/);

  # a bit of sanity please - no svn metadata ;)
  return if ($path =~ /\.svn/);

  my $dir = $path;
  $dir =~ s/^${current_src}[\/\\\:]//s;
  $dir =~ s/([^\/\\\:]+)$//;
  my $filename = $1;


  my $f = "$current_src/$dir$filename";
  my $t;
  $t = "$opt_out/$filename";

  $needs_compile->{$f} = {
          f => $f,
          t => $t,
          dir => $dir,
          filename => $filename
        };
}

sub out_wanted {
  my $path = $File::Find::name;
  return unless (-f $path);
  return if ($path =~ /\.svn/);
  return unless ($path =~ /\.(?:cf|pm)$/i);

  my @st = stat $path;
  if ($st[9] && $st[9] > $newest_out_mtime) {
    $newest_out_mtime = $st[9];
  }

  my $dir = $path;
  $dir =~ s/^${current_src}[\/\\\:]//s;
  $dir =~ s/([^\/\\\:]+)$//;
  my $filename = $1;

  if ($path =~ /\.pm$/i) {
    $found_output->{$filename} = 1;
  }
}

# compile all the source files found by the src_wanted() sub, in sorted
# order so that the order of precedence makes sense.
sub read_all_rules {
  my ($sources) = @_;

  # deal with the perl modules first, so that later linting w/ loadplugin will
  # work appropriately.
  foreach my $f (sort {
                  my ($ae) = $a =~ /\.(cf|pm)$/;
                  my ($be) = $b =~ /\.(cf|pm)$/;
                  return $be cmp $ae || $a cmp $b;
                } keys %$sources)
  {
    my $entry = $needs_compile->{$f};
    my $t = $entry->{t};

    # TODO: dependency checking optimization?
    ## my $needs_rebuild = 0;
    ## if (!-f $t || -M $t > -M $f) {
    ## # the source file is newer, or dest is not there
    ## $needs_rebuild = 1;     
    ## }

    my $needs_rebuild = 1;

    if ($entry->{filename} =~ /\.pm$/) {
      plugin_file_compile($entry);
    }
    elsif ($entry->{dir} =~ /sandbox/) {
      rule_file_compile($f, $t, $entry->{filename},
                { issandbox => 1 });
    }
    elsif ($entry->{dir} =~ /scores/) {
      rule_file_compile($f, $t, $entry->{filename},
                { issandbox => 1, isscores => 1 });
    }
    elsif ($entry->{dir} =~ /extra/) {
      # 'extra' rulesets; not built by default (TODO)
      next;
    }
    else {
      # rules in "core" and "lang" are always copied
      if ($needs_rebuild) {
        rule_file_compile($f, $t, $entry->{filename}, { });
      }
    }
  }
}

###########################################################################

# Rules are compiled from source dir to output dir.
# 
# Rules in "rules/active.list" are promoted to "72_active.cf"; rules not
# listed there are relegated to "70_sandbox.cf".  There is code to allow
# other filenames to be selected from the rulesrc .cf file, but I'm not
# sure if it works anymore ;)
# 
# Rules will be autorenamed, if there's a collision between a new rule name and
# one that's already been output by the compiler in another source file. The
# autorenaming is very simple -- portions of the current source path are
# appended to the rule name, sanitised.

sub rule_file_compile {
  my ($f, $t, $filename, $flags) = @_;
  my $issandbox = $flags->{issandbox};
  my $isscores = $flags->{isscores};

  open (IN, "<$f") or die "cannot read $f";

  # a fast parser for the config file format; don't need the
  # full deal here, and it must be fast, since it's run on every
  # "make" invocation

  my $rule_order = [ ];

  my $lastrule = $COMMENTS;

  if (!defined $rules->{$ALWAYS_PUBLISH}) {
    $rules->{$ALWAYS_PUBLISH} = rule_entry_create();
  }

  # zero or more "ifplugin" or "if" scopes
  my @current_conditionals = ();
  my $current_comments = '';

  while (<IN>) {
    my $orig = $_;

    s/#.*$//g; s/^\s+//; s/\s+$//;

    # drop comments/blank lines from output
    next if (/^$/);

    # save "lang" declarations
    my $lang = '';
    if (s/^lang\s+(\S+)\s+//) {
      $lang = $1;
    }

    if (/^(${RULE_KEYWORDS_RE})\s+(\S+)\s+(.*)$/)
    {
      # rule definitions
      my $type = $1;
      my $name = $2;
      my $val = $3;

      my $origname = $name;
      if ($issandbox) {
        $name = sandbox_rule_name_avoid_collisions($name, $f);
      }
      my $origname_w_T_prefix = $name;
      # non-sandbox rules always use the same name

      if (scalar @current_conditionals) {
        # ensure the current conditionals are used in the block name;
        # this ensures that we scope alternative (#ifdef-style) dupe
        # rule definitions in their own ifplugin scopes
        $name .= " ".join("", @current_conditionals);
        $name =~ s/\s+/ /gs; $name =~ s/ $//;
      }

      # track this as a rule-entry block for that rule name
      # (and it's T_ prefixed variant, if relevant)
      push @{$entries_for_rule_name->{$origname}}, $name;
      push @{$entries_for_rule_name->{$origname_w_T_prefix}}, $name;

      # comment "score" lines for sandbox rules (bug 5558)
      # use generated scores, though, if the rule is active
      if ($type eq 'score' && $issandbox &&
        !($isscores && $active_rules->{$name}))
      {
        $orig =~ s/^/#/g;
      }

      if (!$rules->{$name}) { $rules->{$name} = rule_entry_create(); }

      $rules->{$name}->{issandbox} = $issandbox;
      $rules->{$name}->{isscores} = $isscores;
      $rules->{$name}->{origname} = $origname;
      $rules->{$name}->{origname_w_T_prefix} = $origname_w_T_prefix;
      $rules->{$name}->{cond} = [@current_conditionals];
      $rules->{$name}->{text} .= $current_comments . $orig;
      $rules->{$name}->{plugin_dependencies} = {};

      # note if the conditional is a plugin reference, as we need to
      # ensure that "loadplugin" lines stay in the same place
      foreach my $c (@current_conditionals) {
        if ($c =~ /^ifplugin\s+(\S+)/) {
          $rules->{$name}->{plugin_dependencies}->{$1} = 1;
        } elsif ($c =~ /^if.*plugin/) {
          while ($c =~ /plugin\s*\(\s*(\S+)\s*\)/g) {
            $rules->{$name}->{plugin_dependencies}->{$1} = 1;
          }
        }
      }

      # note if we found the rule defn or not.  if we did not,
      # that means the rule was a code-tied rule, which should always
      # have its descriptions/scores/etc. published in "active".
      if ($type =~ /^${RULE_DEFINE_KEYWORDS_RE}$/x) {
        $rules->{$name}->{found_definition} = 1;
        $rules->{$name}->{srcfile} = $f;
        $rules->{$name}->{code} = $orig;
      }
      elsif ($type eq 'tflags') {
        # userconf rules are always published in "active"
        if ($val =~ /\buserconf\b/) {
          $rules->{$name}->{forceactive} = 1;
        }

        # record for rulemetadata code
        $val =~ s/\s+/ /gs;
        if ($rules->{$name}->{tflags}) {
          $rules->{$name}->{tflags} .= ' '.$val;
        } else {
          $rules->{$name}->{tflags} = $val;
        }
      }

      $current_comments = '';

      $lastrule = $name;
      push (@$rule_order, $name);
    }
    elsif (/^
        (pubfile|publish)
        \s+(\S+)\s*(.*?)$
      /x)
    {
      # preprocessor directives
      my $command = $1;
      my $name = $2;
      my $val = $3;

      my $origname = $name;

      # note: if we call sandbox_rule_name_avoid_collisions(), it'll
      # rename to 'T_RULENAME' -- which is exactly what we're trying
      # to avoid in 'publish RULENAME' lines!  so don't call it here.
      # if ($issandbox) {
      # $name = sandbox_rule_name_avoid_collisions($name, $f);
      # }

      if (!$rules->{$name}) { $rules->{$name} = rule_entry_create(); }
      $rules->{$name}->{origname} = $origname;
      $rules->{$name}->{origname_w_T_prefix} = $origname;

      if ($command eq 'publish') {
        # the 'publish' command defaults to "1", unless it explicitly
        # is set to "0".  iow: publish RULE_NAME [(0 | 1)]  [default: 1]
        if (!defined $val || $val eq '') { $val = '1'; }
      }
      elsif ($command eq 'pubfile') {
        if (!filename_in_manifest($opt_out.'/'.$val)) {
          warn "$val: WARNING: not listed in manifest file, using default\n";
          next;     # don't set 'pubfile' below
        }
      }

      $rules->{$name}->{$command} = $val;

      # if we see "publish NAMEOFRULE", that means the rule is
      # considered active
      if ($rules->{$name}->{publish}) {
        $rules->{$name}->{forceactive} = 1;
      }
    }
    elsif (/^
        (if|ifplugin)
        \s+(.*?)$
      /x)
    {
      push @current_conditionals, $orig;
    }
    elsif (/^else\b/x)
    {
      if (!scalar @current_conditionals) {
        warn "WARNING: 'else' without 'if'/'ifplugin' conditional\n";
      } else {
        my $cond = invert_conditional(pop @current_conditionals);
        push @current_conditionals, $cond;
      }
    }
    elsif (/^endif\b/x)
    {
      if (!scalar @current_conditionals) {
        warn "WARNING: 'endif' without 'if'/'ifplugin' conditional\n";
      } else {
        pop @current_conditionals;
      }
    }
    elsif (/^require_version\s*(\S+)\b/) {
      # silently ignored.  TODO?  (meh)
    }
    elsif (/^loadplugin\s*(\S+)\b/) {
      my $name = 'loadplugin_'.$1;

      unless ($rules->{$name}) {
        $rules->{$name} = rule_entry_create();
        $rules->{$name}->{origname} = $name;
        $rules->{$name}->{origname_w_T_prefix} = $name;
        $rules->{$name}->{issandbox} = $issandbox;
        $rules->{$name}->{iscommand} = 1;
      }

      if (/^loadplugin\s*\S+\s+(\S+)/) {
        my $fname = $1;
        my $fpath = dirname($f)."/".$fname;

        if (!-f $fpath) {
          warn "$f: WARNING: plugin code file '$fpath' not found, line ignored: $orig";
          next;
        }

        if ($fpath =~ /sandbox/i) {
          # Since this is a sandbox plugin, force its output to the sandbox area.
          $rules->{$name}->{sandbox_plugin} = 1;
        }

        # If a 'loadplugin' line is found, and the plugin .pm is not listed in
        # the MANIFEST file, this will mean that the .pm will not be copied
        # during "make dist".  This causes failures during "make disttest",
        # since the file does not exist.
        #
        # However, we do want to preserve these lines in the 'rules' dir, for
        # use during development -- without requiring that the .pm's be put
        # into MANIFEST -- ie. before the plugin is considered release-ready,
        # ie. sandbox plugins.
        #
        # fix: make it a "tryplugin" line instead; these are ignored if the
        # target file is nonexistent.

        if (!filename_in_manifest($opt_out.'/'.$fname)) {
          warn "$f: WARNING: '$opt_out/$fname' not listed in manifest file, making 'tryplugin': $orig";
          $orig =~ s/^\s*loadplugin\b/tryplugin/;
        }
      }

      $rules->{$name}->{text} .= $orig;
      unshift (@$rule_order, $name);
    }
    else {
      # an unhandled configuration line; "redirector_pattern",
      # "report", something like that.  This should be sent to
      # the active.cf output (or sandbox if it appeared in a sandbox
      # input file).

      # use the line itself as a key
      my $name = $_;
      /^\s*(\S+)/ and $name = $1;
      $name =~ s/\s+/ /gs;

      my $forceactive = 1;
      
      # always send 'test' lines to the sandbox files
      if (/^test\s*/) {
        $forceactive = 0;

        $name = $_;   # ensure we don't drag rules with us though!
        $name =~ s/\s+/ /gs;
      }

      if (scalar @current_conditionals) {
        $name = join("", @current_conditionals);
        $name =~ s/\s+/ /gs; $name =~ s/ $//;
      }

      if ($issandbox) {
        $name .= "_sandbox";
      }

      unless ($rules->{$name}) {
        $rules->{$name} = rule_entry_create();
        $rules->{$name}->{origname} = $name;
        $rules->{$name}->{origname_w_T_prefix} = $name;
      }
      $rules->{$name}->{cond} = [@current_conditionals];
      $rules->{$name}->{issandbox} = $issandbox;
      $rules->{$name}->{forceactive} = $forceactive;
      # $rules->{$name}->{forceactive} = 1;
      $rules->{$name}->{iscommand} = 1;

      # TODO: bug 6241: 'replace_rules' should be handled ok, but isn't

      # warn "unknown line in rules file '$f', saving to default: $orig";

      $rules->{$name}->{text} .= $orig;
      unshift (@$rule_order, $name);
    }
  }
  close IN;

  if ($current_comments) {
    $rules->{$COMMENTS}->{text} .= $current_comments;
  }

  # now append all the found text to the output file buffers
  copy_to_output_buffers($rule_order, $issandbox, $f, $filename);

  # ok; file complete.  now mark all those rules as "seen"; future
  # refs to those rule names will trigger an autorename.
  foreach my $name (@$rule_order) {
    $seen_rules->{$name} = 1;
  }
}

# this is only run if we're generating rulemetadata!
sub read_rules_from_output_dir {
  return unless ($opt_rulemetadata);

  foreach my $file (<$opt_out/*.cf>) {
    next unless ($file =~ /\d\d_\S+\.cf$/);
    next if (pubfile_is_activeout($file));
    next if (pubfile_is_sandboxout($file));
    read_output_file($file);
  }
}

sub read_output_file {
  my ($file) = @_;
  open (IN, "<$file") or warn "cannot read $file";
  while (<IN>) {
    my $orig = $_;

    s/#.*$//g; s/^\s+//; s/\s+$//;

    # drop comments/blank lines from output
    next if (/^$/);

    # save "lang" declarations
    my $lang = '';
    if (s/^lang\s+(\S+)\s+//) {
      $lang = $1;
    }

    if (/^(${RULE_KEYWORDS_RE})\s+(\S+)\s+(.*)$/) {
      # rule definitions
      my $type = $1;
      my $name = $2;
      my $val = $3;

      # note: we only want to do this if --rulemetadata is in use!
      if (!$rules->{$name}) { $rules->{$name} = rule_entry_create(); }

      if ($type eq 'tflags') {
        $val =~ s/\s+/ /gs;
        if ($rules->{$name}->{tflags}) {
          $rules->{$name}->{tflags} .= ' '.$val;
        } else {
          $rules->{$name}->{tflags} = $val;
        }
      }

      if ($type =~ /^${RULE_DEFINE_KEYWORDS_RE}$/x) {
        $rules->{$name}->{srcfile} = $file;
        $rules->{$name}->{code} = $orig;
      }
    }
  }
  close IN;
}

sub copy_to_output_buffers {
  my ($rule_order, $issandbox, $f, $filename) = @_;

  # always output these two files, even if they're empty!
  foreach my $pubfile ($opt_out.'/'.$opt_sandboxout,
                $opt_out.'/'.$opt_activeout)
  {
    $output_files->{$pubfile} = {
      header => $default_file_header
    };
  }

  my %already_done = ();
  my $copied_active = 0;
  my $copied_other = 0;
  foreach my $name (@$rule_order)
  {
    # only do each rule once, please ;)
    next if exists $already_done{$name};
    $already_done{$name} = undef;

    my $text = $rules->{$name}->{text};
    if (!$text) {
      next;     # nothing to write!
    }

    my $srcfile = $rules->{$name}->{srcfile};
    my $pubfile = pubfile_for_rule($rules, $rules->{$name}->{origname_w_T_prefix});
    my $is_active = 0;
    if (pubfile_is_activeout($pubfile)) {
      $is_active++;
    }

    my $cond = $rules->{$name}->{cond};
    if ($cond) {
      foreach my $pluginclass (keys %{$rules->{$name}->{plugin_dependencies}}) {
        my $ifplugin_text_name = "loadplugin_".($pluginclass || "");

        if ($rules->{$ifplugin_text_name}) {
          # if the plugin is a sandbox plugin, ensure it's not
          # sent to the active file
          if ($rules->{$ifplugin_text_name}->{sandbox_plugin}) {
            $pubfile = $opt_out.'/'.$opt_sandboxout;
            $is_active = 0;
          }

          # either way, ensure the "loadplugin" line, if there is one,
          # goes to the same file
          $rules->{$ifplugin_text_name}->{output_file} = $pubfile;
        }
      }

      # ensure we produce enough "endif"s to match however many
      # nested conditions there are
      my $endifs = "endif\n" x (scalar @{$cond});

      $rules->{$name}->{output_text} = "\n"
                .join("", @{$cond})
                .$text
                .$endifs;

    } else {
      $rules->{$name}->{output_text} = $text;
    }

    # note the target file
    $rules->{$name}->{output_file} = $pubfile;

    $output_files->{$pubfile} = {
      header => $default_file_header
    };

    if ($is_active) {
      $copied_active++;
    } else {
      $copied_other++;
    }
  }

  print "$f: $copied_active active rules, ".
            "$copied_other other\n";
}

sub pubfile_for_rule {
  my ($rules, $name) = @_;

  my $pubfile;
  if ($rules->{$name}->{publish}) {
    # "publish NAMEOFRULE" => send it to active
    $pubfile = $opt_out.'/'.$opt_activeout;
  }

  # default: "70_sandbox.cf" or "72_active.cf"
  if (!$pubfile) {
    if ($active_rules->{$name}      # is active
        || $rules->{$name}->{forceactive}   # or is forced to be
        || (!$rules->{$name}->{found_definition} && !$rules->{$name}->{iscommand}
            && !$rules->{$name}->{isscores}))
                # or is a rule-related setting in reference to an unknown rule
                # but isn't a generated score
    {
      $pubfile = $opt_out.'/'.$opt_activeout;
    }
    elsif ($rules->{$name}->{issandbox}) {
      $pubfile = $opt_out.'/'.$opt_sandboxout;
    }
    else {
      warn "oops? inactive rule, non-sandbox, shouldn't be possible anymore";
      $pubfile = $opt_out.'/'.$opt_sandboxout;
    }
  }
  return $pubfile;
}

sub plugin_file_compile {
  my ($entry) = @_;

  return if $opt_listpromotable;
  # just copy the raw perl module over to the new area
  # we can't really rename to avoid conflicts since the loadplugin lines
  # are going to be all screwed up in that case.
  # jm: we always want to update the output file in case the input
  # has been changed!
  if (0 && -e $entry->{t}) {
    warn "The perl module ".$entry->{t}." already exists, can't copy from ".$entry->{f}."\n";
  }
  else {
    copy($entry->{f}, $entry->{t}) || warn "Couldn't copy ".$entry->{f}.": $!";
  }
}

###########################################################################

sub compile_output_files {
  my $always = $rules->{$ALWAYS_PUBLISH}->{output_text};

  # create all known output files
  foreach my $file (keys %$output_files) {
    $output_file_text->{$file} = $output_files->{$file}->{header};

    if ($always && pubfile_is_activeout($file)) {
      $output_file_text->{$file} .= $always;
    }
  }

  # this is a horrible kluge.
  # at this point in the game, we've lost the ordered list of rules, so the
  # loadplugin lines have no guarantee that they'll be loaded before the rules
  # that require them.  so we kluge the sort to always have loadplugin lines
  # appear at the very top of the array so we know they'll be listed before
  # anything else.
  my @rulenames = sort {
    if ($a =~ /^loadplugin_/) {
      return -1;
    }
    elsif ($b =~ /^loadplugin_/) {
      return 1;
    }
    return $a cmp $b;
  } keys %$rules;
  my %seen = ();

  # go through the rules looking for meta subrules we
  # may have forgotten; this happens if a non-subrule is
  # listed in active.list, the subrules will not be!  fix them
  # to appear in the same output file as the master rule.
  foreach my $rule (@rulenames) {
    fix_up_rule_dependencies($rule);
  }

  # now repeat, just for rules in the active set; their dependencies should
  # always be likewise promoted into the active set, overriding the prev step.
  foreach my $rule (@rulenames) {
    my $pubfile = $rules->{$rule}->{output_file};
    next unless ($pubfile && pubfile_is_activeout($pubfile));
    fix_up_rule_dependencies($rule);
  }

  my $rulemd = '';

  # output the known rules that are not meta subrules.
  foreach my $rule (@rulenames) {
    $rulemd .= get_rulemetadata_string($rule);      # all metadata strings

    next if ($rule =~ /^__/);
    my $pubfile = $rules->{$rule}->{output_file};
    my $text    = $rules->{$rule}->{output_text};
    next unless defined ($text);

# DOS - bug 6297 - HACK HACK HACK HACK
# this will probably screw up meta rules that do something like '&& !$rule'

    # avoid publishing 'tflags nopublish' rules
    if (pubfile_is_activeout($pubfile) && exists $rules->{$rule}->{tflags} &&
        $rules->{$rule}->{tflags} =~ /\bnopublish\b/)
    {
      print "omitting rule $rule due to tflags nopublish (tflags $rules->{$rule}->{tflags})\n";
      next;
    }

# DOS - END HACK

    $output_file_text->{$pubfile} .= "##{ $rule\n".
                            $text.
                            "##} ".$rule."\n\n";
  }

  # now output all subrules (in a slightly more compact form)
  foreach my $rule (@rulenames) {
    next unless ($rule =~ /^__/);
    my $pubfile = $rules->{$rule}->{output_file};
    my $text    = $rules->{$rule}->{output_text};
    next unless defined ($text);

# DOS - bug 6297 - HACK HACK HACK HACK
# this will probably screw up meta rules that do something like '&& !$rule'

    # avoid publishing 'tflags nopublish' rules
    if (pubfile_is_activeout($pubfile) && exists $rules->{$rule}->{tflags} &&
        $rules->{$rule}->{tflags} =~ /\bnopublish\b/)
    {
      print "omitting rule $rule due to tflags nopublish (tflags $rules->{$rule}->{tflags})\n";
      next;
    }

# DOS - END HACK

    $output_file_text->{$pubfile} .= $text;
  }

  # finally, finish off all output files
  foreach my $file (keys %$output_files) {
    # and get them lint-checked!
    $files_to_lint->{$file} = 1;
  }

  if ($opt_rulemetadata) {
    open (RULEMD, ">".$opt_rulemetadata)
            or die "cannot write rulemd to $opt_rulemetadata";
    print RULEMD "<?xml version='1.0' encoding='UTF-8'?>\n",
                    "<rulemds>", $rulemd, "</rulemds>\n";
    close RULEMD or die "cannot close rulemd to $opt_rulemetadata";
  }
}

# conditionally build a method to UTF-8-encode a string.  this is only required
# for the rulemetadata XML output, so don't make it mandatory!
sub compile_utf8ify_function {
  if (!eval '
      sub utf8ify { use Encode; return Encode::encode("UTF-8", $_[0]); } 1;
    ')
  {
    eval '
      sub utf8ify { die "unimplemented -- Encode module required!" } 1;
    '
  }
}

sub get_rulemetadata_string {
  my ($rule) = @_;

  return '' unless ($opt_rulemetadata);

  my $mod = 0;
  my $srcfile = '';
  my $code = '';
  my $name = $rule;

  # if we found a rule definition with a T_ prefix, use that data
  if (!$rules->{$name}->{srcfile} && $rules->{"T_".$name}->{srcfile}) {
    $name = "T_".$name;
  }

  if ($rules->{$name}->{srcfile}) {
    $srcfile = $rules->{$name}->{srcfile};
    if ($srcfile) {
      my @s = stat $srcfile;
      if (@s) { $mod = $s[9]; }
    }
  }

  if ($rules->{$name}->{code}) {
    $code = $rules->{$name}->{code};
    $code =~ s/\]\]>/\](defanged by mkrules)\]>/gs;     # ensure it's CDATA-safe
    $code = utf8ify($code);
  }

  my $tf = $rules->{$name}->{tflags} || '';

  return "<rulemetadata>".
            "<name>$rule</name>".
            "<src>$srcfile</src>".
            "<srcmtime>$mod</srcmtime>".
            # don't include <code> blocks; they bloat up the XML badly (to 800KB)
            # and make it very slow to parse later
            # "<code><![CDATA[$code]]></code>".
            "<tf>$tf</tf>".
          "</rulemetadata>\n";
}

sub fix_up_rule_dependencies {
  my $rule = shift;

  my $pubfile = $rules->{$rule}->{output_file};
  my $text    = $rules->{$rule}->{output_text};
  return unless $text;
  
  while ($text =~ /^\s*meta\s+(.*)$/mg) {
    my $line = $1;
    while ($line =~ /\b([_A-Za-z0-9]+)\b/g) {
      # force that subrule (if it exists) to output in the
      # same pubfile
      my $rule2 = $1;

      # deal with rules that changed name from "FOO" to "T_FOO"
      sed_renamed_rule_names(\$rule2);

      if (!$entries_for_rule_name->{$rule2}) {
        # we may not always have a rule entry, if the rule was from a non-sandbox
        # source
        # warn "cannot find entries_for_rule_name '$rule2'";
      }

      foreach my $entryname2 (@{$entries_for_rule_name->{$rule2}}) {
        next unless ($rules->{$entryname2} && $rules->{$entryname2}->{output_file});

        # don't do this if the subrule would be moved *out* of the
        # active file!
        my $pubfile2 = $rules->{$entryname2}->{output_file};
        next if (pubfile_is_activeout($pubfile2));

        $rules->{$entryname2}->{output_file} = $pubfile;
      }
    }
  }
}

sub pubfile_is_activeout {
  return 1 if ($_[0] && $_[0] =~ /\b\Q$opt_activeout\E$/);
  return 0;
}

sub pubfile_is_sandboxout {
  return 1 if ($_[0] && $_[0] =~ /\b\Q$opt_sandboxout\E$/);
  return 0;
}

sub write_output_files {
  foreach my $pubfile (sort keys %$output_files) {
    if (-f $pubfile) {
      unlink $pubfile or die "cannot remove output file '$pubfile'";
    }

    if (!filename_in_manifest($pubfile)) {
      warn "$pubfile: WARNING: not listed in manifest file\n";
    }

    my $text = $output_file_text->{$pubfile};
    if ($text) {
      open (OUT, ">".$pubfile) or die "cannot write to output file '$pubfile'";
      sed_renamed_rule_names(\$text);
      print OUT $text;
      close OUT or die "cannot close output file '$pubfile'";
      # print "$pubfile: written\n";        # too noisy
    }
    else {
      print "$pubfile: no rules promoted\n";

      # create an empty file anyway to satisfy MANIFEST
      open (OUT, ">".$pubfile) or die "cannot write to output file '$pubfile'";
      close OUT or die "cannot close output file '$pubfile'";
    }
  }
}

###########################################################################

sub rule_entry_create {
  return {
    text => '',
    publish => 0
  };
}

###########################################################################

sub sandbox_rule_name_avoid_collisions {
  my ($rule, $path) = @_;
  my $new;
  my $newreason;
  my $dowarn = 0;

  return $rule if $opt_listpromotable;
  return $rule if $active_rules->{$rule};
  return $rule if $rules->{$rule}->{forceactive};

  if ($rule !~ /^(?:T_|__)/) {
    $new = "T_".$rule;
    $newreason = "missing T_ prefix";
  }
  elsif (!exists $seen_rules->{$rule}) {
    return $rule;
  }
  else {
    $new = $path;
    $new =~ s/[^A-Za-z0-9]+/_/gs;
    $new =~ s/_+/_/gs;
    $new =~ s/^_//;
    $new =~ s/_$//;
    $new = $rule.'_'.$new;
    $newreason = "collision with existing rule";
    $dowarn = 1;
  }

  if (!$renamed_rules->{$new}) {
    $renamed_rules->{$new} = $rule;
    if ($dowarn) {
      warn "WARNING: $rule: renamed as $new due to $newreason\n";
    }
  }

  return $new;
}

sub sed_renamed_rule_names {
  my ($textref) = @_;
  foreach my $new (keys %{$renamed_rules}) {
    my $rule = $renamed_rules->{$new};
    $$textref =~ s/\b${rule}\b/${new}/gs;
  }
}

###########################################################################

sub invert_conditional {
  my $cond = shift;
  if ($cond =~ /^ \s* ifplugin \s+(.*?)$ /x) {
    return "if !plugin($1)\n";
  } elsif ($cond =~ /^ \s* if \s+(.*?)$ /x) {
    return "if !($1)\n";
  } else {
    warn "WARNING: cannot parse '$cond' for 'else'\n";
    return 'if 0';
  }
}

###########################################################################

sub read_manifest {
  my ($fname) = @_;
  parse_line_delimited_config_file($fname, sub {
      /^\s*(.*?)\s*$/ and $file_manifest->{$1} = 1;
    });
}

sub read_manifest_skip {
  my ($fname) = @_;
  parse_line_delimited_config_file($fname, sub {
      /^\s*(.*?)\s*$/ and push (@{$file_manifest_skip}, qr/$1/);
    });
}

sub read_active {
  my ($fname) = @_;
  parse_line_delimited_config_file($fname, sub {
      /^(\S+)/ and $active_rules->{$1} = 1;
    });
}

sub filename_in_manifest {
  my ($fname) = @_;
  return 1 if ($file_manifest->{$fname});
  foreach my $skipre (@{$file_manifest_skip}) {
    return 1 if ($fname =~ $skipre);
  }
  return 0;
}

sub parse_line_delimited_config_file {
  my ($fname, $callback) = @_;
  if (!open (IN, "<$fname")) {
    warn "cannot read $fname\n";
  } else {
    while (<IN>) {
      next if /^#/;
      $callback->();
    }
    close IN;
  }
}


__DATA__
# SpamAssassin rules file
#
# Please don't modify this file as your changes will be overwritten with
# the next update. Use @@LOCAL_RULES_DIR@@/local.cf instead.
# See 'perldoc Mail::SpamAssassin::Conf' for details.
#
# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at:
# 
#     http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>
#
###########################################################################

require_version @@VERSION@@