#!/usr/bin/perl
#
# Usage: file_handles.pl < $file.sm
#
#  Checks for comparision of file handles with 0 instead of
#  INVALID_HANDLE_VALUE.
#
#  This software may be used and distributed according to the terms
#  of the GNU General Public License, incorporated herein by reference.
#
#  Copyright 2006-2007 Michael Stefaniuc

use strict;
use smatch;

# Variables
############
# Names of variables that hold a file handle.
my %handles = ();
# Regexp with functions that return file handles
my $funcs = "(?:CreateFile|CreateMailslot|CreateNamedPipe|FindFirstFile(?:Ex)?|OpenConsole|SetupOpenInfFile|socket)[AW]?";

# Functions
############
sub error_msg ($) {
    my $handle = shift;
    $handle =~ s/^var_decl\((.*)\)$/$1/;
    my $msg = "Comparision of file handle '$handle' with 0";
    print get_filename(), " ", get_lineno(), " ", get_func_pos(), " $msg\n";
}

# This function searches for the first unbalanced ')' in a string and
# returns the string up to the ')' (not included).
sub get_str_close_bracket($) {
    my $str = shift;
    my $count = 1; # We are searching for the first unbalanced ')'

    while ($str =~ m/[^()]*(\(|\))/g) {
	if ($1 eq ')') {
	    $count--;
	    if ($count == 0) {
		last;
	    }
	} else {
	    $count++;
	}
    }
    return substr($str, 0, pos($str) - 1);
}

# Main
#######
my $data;

while($data = get_data()){
    # begin of a function
    $data =~ /^function_decl / and do {
	%handles = ();
	next;
    };
    # handle = CreateFile()
    $data =~ /(modify_expr\(((?:var_decl|component_ref)\(.+?\))= call_expr\(\(addr_expr function_decl\(($funcs)\)\)\(tree_list: .*)/ and do {
	my $match = $1;
	my $handle = $2;
	my $func = $3;
	$handles{$handle} = $func;
	if ($data =~ /if_cond/) {
	    # We have an "if" check in the same line with the call to
	    # the function returning a file handle. Replace the call
	    # with the variable name so we can handle it below.
	    my $replace = quotemeta(get_str_close_bracket($match));
	    $data =~ s/$replace/$handle/;
	}

    };
    # if (handle)
    if ($data =~ s/^if_cond //) {
	my @vars = ();
	if ($data !~ /_expr/) {
	    # the smatch gcc generates for "if (bla) blubb;" a
	    # "if_expr bla" smatch code line and not ne_expr with 0
	    push(@vars, $data);
	} else {
	    # ubercool regexp to make the simple ".*?" not swallow an
	    # eq_expr or ne_expr
	    while ($data =~ /(?:eq|ne)_expr\(\(((?:.(?!(?:eq|ne)_expr))*?)\)\(integer_cst\(0\)\)\)/g) {
		# Save all variables that were compared to 0
		push(@vars, $1);
	    }
	}
	foreach my $h (@vars) {
	    if (exists($handles{$h})) {
		error_msg($h);
	    }
	}
    }
}