#!/usr/local/bin/perl
#
# $Id: proclint,v 1.1.1.1 1996/08/16 18:27:11 aks Exp $
#
# proclint [-[no]list] [-[no]includerc] [-procmailrc] rcfiles ...
#
# Author: Alan K. Stebbens <aks@sgi.com>
#
# By default, -noincluderc and -nolist are set.
#
# Because debugging procmailrc scripts is difficult
# I try to encode checks into this script.
#
# If -list given, list all lines of the recipe, numbered, and
# with levels and a type flag character.
#
# Current errors caught:
#
#  '{' and '}' nesting errors.
#  Missing '*' on conditions
#  Lines which aren't recipes or assignments
#  Unterminated recipes
#

($DIR,$PROG) = $0 =~ m=^(.*/)?([^/]+)$=;
$DIR =~ s=/$== || chop($DIR = `pwd`);

$| = 1;

unless ($#ARGV >= $[) {
    &usage;
}

while( $_ = shift(@ARGV) ) {
    if (!index('-list', $_)) {
       $listlines++;
    } elsif (!index('-nolist',$_)) {
       $listlines = '';
    } elsif (!index('-includerc',$_)) {
       $includerc++;
    } elsif (!index('-noincluderc',$_)) {
       $includerc = '';
    } elsif (!index('-procmailrc',$_)) {
       $HOME = $ENV{'HOME'} || (getpwuid($>))[7];
       push(@ARGV,"$HOME/.procmailrc");
    } elsif (!index('-help',$_)) {
       &usage;
    } elsif (/^-/) {
       print "Unknown option: '$_'\n";
       next;
    } else {
       &Scan($_);
    }
}

$FH_TEMPLATE = 'fh00';

sub Scan {
    local($file) = shift;
    return if $Scanned{$file};
    $Scanned{$file}++;
    local($fileLevel) = shift || 0;
    local($mainLevel) = shift || 0;
    local( $recipe, $errs, $continuation, $line );
    local( $type, $count, $conditions, $var, $val, $errs );
    local( $includefile, $depth );
    local( $level ) = $mainLevel;
    local( $_ );

    unless ($quiet) {
       print "\n" if $listlines;
       print (" " x $fileLevel);
       print "Scanning file $file:";
    }
    local($FH) = $FH_TEMPLATE++;
    open( $FH , $file ) || do {
       print "Can't open $file: $!\n";
       return;
    };
    print "\n" unless $quiet;
    $recipe = '';
    $errs = '';
    $continuation = '';
    $line = '';
    while( <$FH> ) {
       chop;
       $_ = &untab($_) if /\t/;
       if( $continuation ) {
           $line .= "\n".$_;
           $_ = $line;
           $line = '';
           $continuation = '';
       } 
       if( /\\$/ ) {           # continuation?
           $continuation = 1;
           chop;               # remove the trailing slash
           $line = $_;         # make the continuation
           next;
       }

       $type = ' ';
       if( /^\s*\#/ || /^\s*$/ ) {     # ignore comments or blank lines
           $type = ' ';
           $_ = ' ' unless length;
       }
       elsif( ! $recipe || /^\s*:/) {  # are we looking for a recipe?
           # This is a state driven scanner
           # State     Parse   Next    What
           #   0        :       1      Start recipe parse
           #   1        *       1      Parse condition
           #   1    !   0      Parse redirect
           #   1        |       0      Parse pipe
           #   1    {   0      Increment recipe level, parse sub-recipe
           #   1        <other> 0      Parse filename path
           
           if( /^\s*:\s*(\S.*)?/ ) {   # recipe start?
               $flags = $1;    # get flags
               $count = $flags =~ /^(\d+)/ ? $1 : 
                        $flags =~ /[eEaA]/ ? 0 : 1;
               $recipe = $.;   # we're in a recipe
               $conditions = 0;
               $type = 'R';    # set the type
           } elsif( /^\s*}/ ) {        # end of a nested recipe?
               $level--;
               $type = 'R';
               if ($level < 0) {
                   $errs .= "Too many close brackets!\n";
                   $level = 0;
               }
           } elsif( /^\s*(\w+)\s*=\s*(\S.*)?/ ) {      # an assignment?
               $type = '=';                    # assignment
               ($var,$val) = ($1,$2);
               if( $includerc ) {
                   $Assigns{$var} = $val;
                   if( $var eq 'INCLUDERC' ) {
                       $newfile = &Eval($val);
                       if( $newfile && -f $newfile ) {
                           $includefile = $newfile;
                       } elsif ( $newfile ) {
                           $errs .= "Included file \"$newfile\" does not exist.\n";
                       }
                   }
               }
           } elsif( /^\s*(\w+)\s*$/ ) {        # an un-assignment?
               $type = '=';                    # unassignment
           } else {
               $errs .= "Bad recipe line: \"$_\"\n";
               $type = 'E';
           }
       } else {
           if( /^\s*\*/ )  {   # a condition?
               $conditions++;
               $type = 'C';    # condition
               $count--;
           } elsif ( /^\s*!/ && $count <= 0) { # a redirection?
               $recipe = '';   # an action, we're out of the recipe
               $type = 'A';    # Action
           } elsif ( /^\s*\|/ ) {      # a pipe?
               $recipe = '';   # another action
               $type = 'A';    # Action
           } elsif ( /^\s*{/ ) {       # a subrecipe
               $level++;               # increment the level
               $recipe = '';   # and we're out of the recipe
               $type = 'A';    # Action
               $level-- if /\s+}/;     # decrement count if one-liner
           } elsif ( --$count >= 0 && !/^\s*[\|{]/) { # more conditions?
               $conditions++;
               $type = 'C';    # assume condition
           } else {            # default is path
               $type = 'F';    # folder
               if ( /^\s*[\#*(){}|!?]|^\s*\w+ \w+/ ) { # make reasonable mistake guess
                   $errs .= "Possibly bad folder name?\n";
               }
               $recipe = '';
           }
       }

      Print:
       if ($listlines || $errs) {
           @lines = split(/\n/,$_);
           $depth = $level > 0 ? sprintf("<%d>",$level) : "   ";
           while ($_ = shift(@lines)) {
               print (" " x $fileLevel);
               $_ .= "\\" if @lines;
               printf "%3d:%1s%s %s\n",$.,$type,$depth,$_;
               $type = '+';
           }
       }
       if( $errs ) {
           print $errs;
           $errs = '';
       }
       if ($includefile) {
           &Scan( $includefile, $fileLevel + 1, $level );
           unless ($quiet) {
               print "\n" if $listlines;
               print (" " x $fileLevel);
               print "Back to file $file:\n";
           }
           $includefile = '';
       }
    }
    if ($recipe) {
       print "$file: EOF: recipe at line $recipe never terminated.\n";
    }
    if ($level > $mainLevel) {
       print "$file: EOF: Unterminated nested recipies.\n";
    }
    close $FH;
}

sub Eval {
    local($val) = shift;

    while( ( $val =~ /\$(\w+)/ ) ) {
       if( defined( $Assigns{$1} ) ) {
           $val = $` . $Assigns{$1} . $';
       } elsif( defined( $ENV{$1} ) ) {
           $val = $` . $ENV{$1} . $';
       } else {
           $val = $` . $';     # omit the variable -- it's empty
       }
    }
    $val;
}

sub untab {
    local($_) = shift;
    while (($x = index($_,"\t")) >= $[) {
       substr($_,$x,1) = " " x (((($x / 8) + 1) * 8) - $x)
    }
    $_;
}

sub usage {
    print <<"EOF"; exit(1);
usage: $PROG [-options] [rcfiles ...]
Check procmail rc files for proper syntax, recipe nesting, etc.
Options (default are marked with '*'):
  -list                List lines in the procmail recipe files.
  -nolist*     Do not list lines, except for errors.
  -includerc   Scan and possibly list files included with INCLUDERC
  -noinclude*  Do not scan INCLUDERC references
  -procmailrc  Check \$HOME/.procmailrc
  -help                This message

The output consists of: 'LINE-NUMBER:FLAG:DEPTH: text'.
FLAG is one of:
    'R'                recipe
    'C'                condition
    'A'                action (redirect, '!', or pipe, '|')
    'F'                folder
    '='                assignment
    '+'                continuation
    'E'                *line may be erroneous*
DEPTH indicates the depth of the recipe nesting and is shown only
when greater than zero.
EOF
}
