#!/usr/bin/env perl

# procmailrc checker: this script checks that a procmailrc file
# (supplied as argument or on the standard input) is "correctly"
# formatted and does not contain suspicious constructs. In case
# of failure, pmchecker returns with a non-zero exit status and
# outputs a message to the standard error. This does not mean
# that there is really an error in the file, but one needs to
# be a bit paranoid to avoid losing mail (this occurred twice
# in my case, before I wrote this script). Of course, pmchecker
# can't detect all errors, but a missing continuation backslash
# or a bad use of < or > before a regular expression should be
# detected in general.

# Usage: pmchecker [ <procmailrc> ]

# Users who manage their procmailrc files with Subversion may want
# to use this script in a pre-commit hook, e.g.
#   for i in `$SVNLOOK changed -t "$TXN" "$REPOS" | \
#             sed -n 's/.* \(.*procmailrc.*\)/\1/p'`
#   do
#     $SVNLOOK cat -t "$TXN" "$REPOS" "$i" | pmchecker || exit 1
#   done

use strict;

my ($proc) = '$Id: pmchecker 44993 2011-07-11 15:59:25Z vinc17/prunille $'
  =~ /^.Id: (\S+) \d+ / or die;

my $status = " ";
# " "... waiting for rule or end of block.
# ":"... last line was a part of a rule.
# ">"... last line was a delivery line or end of block.
# "="... last line was a part of a variable assignment.

my @indent = (0);  # Indentations.
my $comment;       # If true, line must be a comment.

while (<>)
  {
    if ($status eq "=")
      {
        /^[^"]*("?)$/ or die "$proc: bad multi-line variable assignment";
        $1 and $status = " ";
        next;
      }

    /^( *)/;
    my $spaces = length $1;

    if (/^ *\}/ && $status =~ /^[ >]$/)
      {
        $#indent
          or die "$proc: end of block doesn't match a beginning of block";
        pop @indent;
        $spaces == $indent[$#indent] or die "$proc: bad indentation";
        /^ *\}$/ or die "$proc: } must end the line";
        $status = ">";
        next;
      }

    if ($indent[$#indent] eq "" && $spaces)
      {
        $status eq " " or die "$proc: internal error";
        $spaces > $indent[$#indent - 1]
          or die "$proc: indentation must be grater than the previous one";
        $indent[$#indent] = $spaces;
      }

    /^ *\#/ and $comment = /\\$/, next;  # Ignore comment lines.
    $comment and die "$proc: expected a comment";

    if (/^$/)  # This is a blank line.
      {
        $status =~ tr/>/ /;
        $status eq " " or die "$proc: unexpected blank line";
        next;
      }

    if ($status =~ /%/ && $spaces > $indent[$#indent])
      { /\\$/ or $status =~ tr/%//d; next; }
    elsif ($status =~ /%/ || $spaces ne $indent[$#indent])
      { die "$proc: bad indentation"; }

    /^ *:0/ && $status eq " " and $status = ":", next;

    if ($status eq ":")
      {
        if (/^ *\*/)
          {
            /\\$/ and $status .= "%";
            /^ *\* *[<>] *(.*)/ && $1 !~ /^\d+$/
              and die "$proc: '* <' and '* >' must be followed by a number";
          }
        elsif (/^ *\{.*\}$/)
          {
            $status = ">";
          }
        elsif (/^ *\{/)
          {
            /^ *\{$/ or die "$proc: { must end the line";
            $status = " ";
            push @indent, "";
          }
        else
          {
            $status = ">";
            /\\$/ and $status .= "%";
          }
        next;
      }

    # Variable assignments
    if (/^ *[A-Za-z][A-Za-z0-9_]*=(.*)/)
      {
        my $value = $1;
        next if $value !~ /"/;
        $value =~ /^"[^"]*("?)$/ or die "$proc: bad variable assignment";
        $1 or $status = "=";
        next;
      }

    die "$proc: unrecognized line";
  }