#!/usr/bin/perl
#
# This script checks to make sure no allocated memory is lost.
# Based on great Dan Carpenter's work.
# Enhanced by Oleg Drokin to understand missing last reference on assignments, exported stuff, equivalent variables,
#                          chained assignments, double free, free of null values, assignments/returns/comparisons of
#			   already freed values.
#
# BUGS:
#   Exporting only understands indirections, there is no way to determine static local and global variables yet.
#   If the malloc/free is done conditionally on some nontrivial expression, we do not understand it. (false memleaks)
#   It does not know about switch/case
#   if ( (a = b) == NULL) stuff is missed as a=b assignment.
#   (fixed?)No way to specify which parameter of "free" function is the pointer (disables e.g. kmem_cache_free tracing)
#   Alloc/free functions list can be bigger
#   list_add alikes should be handled as one more class.
#   (fixed?)Various list_add stuff that makes variable to not be lost is not handled yet.
#   a[i]=kmalloc() ; i++ ; a[i]=smth; produces false "memleak" warning.
#

use smatch;
use ifcond;

# Set this to 1, if your functions are not supposed to export any stuff
# on returning negative values (errors?). This produces lots of false positives,
# but it also catches some real bugs, so you probably want to try with and without this setting.
$EXPORTED_ON_EXIT_IS_BAD = 0;

# Set this to 1 to mark variables passed to other functions by address as "exported"
# (not reported as leaked later on). Set to 0 otherwise
$REFERENCE_BY_ADDRESS_IS_EXPORTED = 1;

# Enable list_funcs functions
$ENABLE_LIST_FUNCS = 1;

# These functions return pointer to newly allocated memory.
my (@alloc_funcs) = ("kmalloc","vmalloc","malloc","alloc","calloc");

# These functions take only one argument and "free" it.
my (@free_funcs) = ("kfree","vfree","free","netlink_destroy_callback", "unix_release_addr", "free_fib_info", "free_msg","c101_destroy_card","n2_destroy_card","bsd_free");

# These functions take multiple aruments, if any of tracked vars is passed to such functions,
# it is marked as "exported" (so we do not report it as leaked on function exit).
my (@list_funcs) = ("list_add","list_add_tail","dev_set_drvdata","pci_set_drvdata","setup_irq","seq_open","__sound_insert_unit","ext3_xattr_rehash","translate_table","release_stripe","submit_command","submit_queue","idetape_setup","ntfs_index_writeback","ntfs_new_attr","autofs_hash_insert","hashbin_insert","__grp_hash","awc_fid_queue_push_tail","i596_add_cmd","mtdram_init_device","acpi_os_schedule_exec","agp_add_seg_to_client","parport_register_device","n_hdlc_buf_put","add_rx_queue","add_tx_queue","notify_enqueue","DC390_queue_command","aha152x_internal_queue","ips_putq_copp_tail","ahc_alloc","i2c_attach_client","tasklet_init","initMatrox2","i2o_install_device","mpt_free_fw_memory","add_new_bus","ibmphp_hpc_fillhpslotinfo","ibmphp_add_resource");

sub error_msg{
    my $msg = shift;
    my $var = shift;
    print get_filename(), " ", get_start_line($var), " ", get_lineno(), " ", get_func_pos(), " $msg\n";
}

# These merge rules are grown from real observation on Linux kernel sources.
sub merge_pointer_states($$$){
    my ($name, $one, $two) = @_;

    if ( ($one eq "free" && $two eq "null") || ($one eq "null" && $two eq "free") ) {
	return "free";
    }
    if ( ($one eq "free" && $two eq "non_null") || ($one eq "non_null" && $two eq "free") ) {
	return "non_null";
    }
    # ??? This is uncertain.
#    if ( ($one eq "free" && $two eq "undefined") || ($one eq "undefined" && $two eq "free") ) {
#	return "free";
#    }
    if ( ($one =~ /(copy of .*)/ && $two eq "free") || ($one eq "free" && $two =~ /(copy of .*)/) ) {
	return "free";
    }
    if ( ($one =~ /(copy of .*)/ && $two eq "non_null") || ($one eq "non_null" && $two =~ /(copy of .*)/) ) {
	return $1;
    }
    if ( ($one =~ /(copy of .*)/ && $two eq "null") || ($one eq "null" && $two =~ /(copy of .*)/) ) {
	return $1;
    }
    if ( ($one =~ /(copy of .*)/ && $two eq "undefined") || ($one eq "undefined" && $two =~ /(copy of .*)/) ) {
	return $1;
    }
    if ( ($one eq "exported" && $two eq "null") || ($one eq "null" && $two eq "exported") ) {
	return "exported";
    }
    if ( ($one eq "exported" && $two eq "non_null") || ($one eq "non_null" && $two eq "exported") ) {
	return "exported";
    }
    # ??? I am not sure, but it seems that if we return "free" here, we will hit lots of false stuff
    if ( ($one eq "exported" && $two eq "free") || ($one eq "free" && $two eq "exported") ) {
	return "exported";
    }
    if ( ($one eq "exported" && $two eq "undefined") || ($one eq "undefined" && $two eq "exported") ) {
	return "exported";
    }
    if ( ($one eq "copied" && $two eq "null") || ($one eq "null" && $two eq "copied") ) {
	return "copied";
    }
    if ( ($one eq "copied" && $two eq "non_null") || ($one eq "non_null" && $two eq "copied") ) {
	return "copied";
    }
    if ( ($one eq "copied" && $two eq "free") || ($one eq "free" && $two eq "copied") ) {
	return "free";
    }
    if ( ($one eq "copied" && $two eq "underfined") || ($one eq "copied" && $two eq "underfined") ) {
	return "copied";
    }
    if ( ($one eq "exported" && $two eq "copied") || ($one eq "copied" && $two eq "exported") ) {
	return "copied";
    }
    return merge_rules($name, $one, $two);
}
sub merge_rules($$$){
    my ($name, $one, $two) = @_;

    # there are two kinds of states here.
    # ones that end in __function that store the
    # the name of the function that possibly returned null.
    #
    # we treat each type of state differently but in this 
    # case we want to treat them both the same.

    if ($one =~ /^__none$/){
	return $two;
    }
    if ($two =~ /^__none$/){
	return $one;
    }

    my $quoted_two = quotemeta $two;
    if ($one =~ /^$quoted_two$/){
	return $one;
    }

    return "undefined";
}
add_merge_function("merge_pointer_states");

sub dereference_and_get_var_value($) {
    my ($var) = $_[0];

    if ( $var =~ /copy of (.*) / ) {
	return get_state($1);
    } else {
	return get_state($var);
    }
}

# this is mostly used from if statements
sub dereference_and_set_var_value{
    my ($var) = $_[0];
    my ($new_value) = $_[1];
    my ($conditional) = $_[2];

    if ( get_state($var) =~ /copy of (.*)/ ) {
	$var = $1;
    }

    # do not loose "exported" stuff on conditions
    if ( get_state($var) eq "exported" && ($new_value eq "non_null" || $new_value eq "null") ) {
	return;
    }

    if ( get_state($var) ne "free" ) {
	if ( $conditional ) {
	    if ( $conditional eq "true") {
		set_true_path($var, $new_value);
	    }
	    if ( $conditional eq "false") {
		set_false_path($var, $new_value);
	    }
	} else {
	    set_state($var, $new_value);
	}
    }
}

sub remove_one_var_copy {
	my ($var) = $_[0];
	my ($vars);

	# See if there is nothing to keep track of.
	if ( get_state($var) =~ /copy of (.*)/) {
	    my ($temp) = $var;
	    $var = $1;
	    set_state($temp,get_state($var));
	} else {
	    return;
	}

	# if this is free already, no need to make it exported/copied.
	if ( get_state($var) eq "free" ) {
	    return
	}
	set_state($var, "undefined");
	# Ok, let's see if there any variables holding same data as this one left.
	foreach $vars (state_names()){

	    if ( get_state($vars) eq "copy of $var") {
		if ( $vars =~ /indirect_ref/ ) {
		    set_state($var, "exported");
		    return;
		} else {
		    set_state($var, "copied");
		}
	    }
	}
	return;
}

sub unchain_variable {
	my ($var) = $_[0];
	my ($vstate) = get_state($var);
	my ($vars);
	my ($replace) = "";

	# See if there is nothing to keep track of.
	if ( $vstate ne "copied" && $vstate ne "exported") {
	    return;
	}
	# Ok, let's see if there any variables holding same data as this one left.
	foreach $vars (state_names()){

	    if ( get_state($vars) eq "copy of $var") {
		if ( $replace ) {
		    set_state($vars, "copy of $replace");
		} else {
		    set_state($vars, "undefined");
		    $replace = $vars;
		}
	    }
	}
	return;
}

# Takes left and right parts of assignment
sub handle_assignment ($$){
	my($src) = $_[0];
	my ($dest) = $_[1];
	my ($sstate) = get_state($src);
	my ($dstate) = get_state($dest);

#print "$data\n";
#print "$src, $dest, $sstate, $dstate\n";
	# a = b = c = ...
	if ($src =~ /modify_expr\((.*?)\= (.*)\)/) {
	    $src = $1;
	    # Yeah, it's recursion.
	    handle_assignment( $2, $src);
	    $sstate = get_state($src);
	}

	# function call
	if ($src =~ /^call_expr\(\(addr_expr function_decl\((\w+?)\)/){
	    my ($function) = quotemeta($1);
	    my ($fn);
	    foreach $fn (@alloc_funcs) {
		if ($function eq $fn){
		    set_state ($dest, "undefined");
#		    set_state ("$dest #__function", $function);
		}
	    }
	}

	# Hm. Handle a = do_something(a); stuff. This shot down number of false positives
	if ( !($src =~ /\Q$dest\E/) ) {
	    if ( $dstate eq "undefined" || $dstate eq "non_null" ) {
		error_msg("Probably leaking memory, $dest is $dstate", $dest);
	    }
	    unchain_variable($dest);
	    remove_one_var_copy($dest);
	}

	if ($sstate){
	    if ( $sstate eq "free") {
		error_msg("Assigning freed pointer $src to $dest", $src);
	    }
	    if ( $sstate ne "null" ) {
		if ( $sstate =~ /copy of (.*)/ ) {
		    $src = $1;
		    $sstate = get_state($src);
		}
		if ( $dest =~ /indirect_ref/ || $dest =~ /array_ref/ ) {
		    set_state($src, "exported");
		} else {
		    # If we copy already exported var to local var,
		    # it is still exported ;)
		    if ( $sstate ne "exported" ) {
			set_state($src, "copied");
		    }
		}
		set_state ($dest, "copy of $src");
	    } else {
		set_state ($dest, $sstate);
	    }
	} else { if ( $src =~ /^integer_cst\((\w+)\)/ ) {
		my ($const) = $1;
		if ( $dstate ) {
		    if ( $const eq "0" ) {
			set_state ($dest, "null");
		    } else {
			reset_state ($dest);
		    }
		}
	}}

}

while ($data = get_data()){
    my $tmp;

    # if we modify something then we just going to set the start to non_null
    # temporarilly.  Then maybe later set it to undefined.
#    if ($data =~ /expr_stmt modify_expr\((.*?)\= /){
#	$variable = $1;
#	if (get_state($variable)){
#	    set_state ($variable, "non_null");
#	}
#    }

    # We need to track when pointers are passed to other variables.
    # We need to see if these are externally visible or not and so on.
    if ($data =~ /expr_stmt modify_expr\((.*?)\= (.*)\)/){
	my($src) = $2;
	my ($dest) = $1;

	handle_assignment($src,$dest);
    }

    # Var declaration with value assignment
    if ($data =~ /^var_decl\(.*?_type (.*?) = (.*)\)/ ) {
	my($src) = $2;
	my ($dest) = "var_decl($1)";

	reset_state($dest);
	handle_assignment($src,$dest);
    }

    # func (&var) and func(&var->field); case
    if ( $REFERENCE_BY_ADDRESS_IS_EXPORTED && $data =~ /call_expr\(.*function_decl\((.*?)\).*\(tree_list: (.*)/ ) {
	my ($expr) = $2;
	my ($function) = $1;
	my ($vars);

	# Special case various atomic/spinlock and so on stuff that is often
	# used with variable pointers, but does not export stuff.
	foreach $vars (state_names()){
	    # See if we pass some of tracked stuff there
	    if ( $expr =~ /addr_expr \Q$vars\E/ || $expr =~ /non_lvalue_expr \Q$vars\E/) {
		if ( get_state($vars) eq "free" ) {
		    error_msg("Possibly passing freed value to function $vars, $function","$vars");
		} else {
		    if ( !($function =~ /^(atomic_|spin_)/ ) ) {
			dereference_and_set_var_value( $vars,"exported","");
		    }
		}
	    } else {
		if ($vars =~ /component_ref\(\((.*?)\)\(/ ) {
		    my ($var) = $1;
		    if ( $expr =~ /addr_expr \Q$var\E/ || $expr =~ /non_lvalue_expr \Q$var\E/) {
			if ( get_state($vars) eq "free" ) {
			    error_msg("Possibly passing pointer freed value to function $vars","$vars");
			} else {
			    if ( !($function =~ /^(atomic_|spin_)/ ) ) {
				dereference_and_set_var_value( $vars,"exported","");
			    }
			}
		    }
		}
		if ($vars =~ /component_ref\(\(indirect_ref (.*?)\)\(/ ) {
		    my ($var) = $1;
		    if ( $expr =~ /addr_expr \Q$var\E/ || $expr =~ /non_lvalue_expr \Q$var\E/) {
			if ( get_state($vars) eq "free" ) {
			    error_msg("Possibly passing pointer to freed value (part of structure) to function $vars","$vars");
			} else {
			    if ( !($function =~ /^(atomic_|spin_)/ ) ) {
				dereference_and_set_var_value( $vars,"exported","");
			    }
			}
		    }
		}
	    }
	}

    }

    # list_add alikes
    if ( $ENABLE_LIST_FUNCS && $data =~ /call_expr\(.*function_decl\((.*?)\).*\(tree_list: (.*)\)/ ) {
	my ($func) = $1;
	my ($args) = $2;

	# See if this is call to one of matching functions
	if ( grep(/^$func$/, @list_funcs) ) {
	    my ($vars);
	    foreach $vars (state_names()){
		# See if we pass some of tracked stuff there
		if ( $args =~ /\Q$vars\E/ ) {
		    if ( get_state($vars) eq "free" ) {
			error_msg("Possibly passing freed value of $vars to function $func","$vars");
		    } else {
			dereference_and_set_var_value( $vars,"exported","");
		    }
		}
	    }
	}
    }

#    if ( $data =~ /function_decl\(list_add.*\)\)\(tree_list: (.*?),.*/ ) {
#	my ($var) = $1;
#	if ( get_state($var) ) {
#	    dereference_and_set_var_value( $var,"exported","");
#	}
#    }

    # if we see "foo = kmalloc ()" then we store foo
    # as "undefined"
    #modify_expr(var_decl(foo)= call_expr((addr_expr function_decl(.*alloc))()))
#    if ($data =~ /expr_stmt modify_expr\((.*?)\= call_expr\(\(addr_expr function_decl\((\w+?)\)/){
#	$variable = $1;
#	$function = quotemeta($2);
#	#if (`grep ^$function\$ list_null_funcs_uniq`){
#	if ($function =~/^.*alloc$/){
#	    #print get_filename(), " ", get_lineno(), " ", "$variable undefined";
#	    set_state ($variable, "undefined");
#	    set_state ("$variable __function", $function);
#	}
#    }

    # split_conds is from ifcond.pm.  It simplifies handling of compound conditions
    # for example:
    # if (!a || !b) { tells us that on the false path a is non_null
    # if (a && b) { tells us that on the true path a is non_null
    
    # it turns out that it is important to check for_statements as well.
    # a lot of code does stuff like for( ; foo = next_token(); ){

    if (($data =~ /^(if_cond|while_cond) (.*)/) || ($data =~ /^(for_stmt).*?; (.*?);/)){
	my %conds = split_conds($2);

	for my $cond (@{$conds{truepath}}){
	    if ($cond =~ /^compound_cond/){
		next;
	    }

	    if ($cond =~ /eq_expr\(\((.*)\)\(integer_cst\(0\)\)\)/){
		my $name = $1;
		if (get_state ($name)){
		    dereference_and_set_var_value($name,"null", "true");
		}
	    }elsif(($cond =~ /ne_expr\(\((.*)\)\(integer_cst\(0\)\)\)/) ||
		   ($cond =~/(.*)/)){
		my $name = $1;
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } else { if ( dereference_and_get_var_value ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name);
		    } else {
			dereference_and_set_var_value($name,"non_null","true");
		    }}
		}
	    }
	    if ( ! ($cond =~ /_expr/) ) {
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } else { if ( dereference_and_get_var_value ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name);
		    } else {
			dereference_and_set_var_value($name,"non_null","true");
		    }}
		}
	    }
	}
	for my $cond (@{$conds{falsepath}}){

	    if ($cond =~ /^compound_cond/){
		next;
	    }

	    if ($cond =~ /eq_expr\(\((.*)\)\(integer_cst\(0\)\)\)/){
		my $name = $1;
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } else { if ( dereference_and_get_var_value ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name);
		    } else {
			dereference_and_set_var_value($name,"non_null","false");
		    }}
		}
	    }elsif(($cond =~ /ne_expr\(\((.*)\)\(integer_cst\(0\)\)\)/) ||
		   ( $cond =~/(.*)/)){
		my $name = $1;
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } else { if ( get_state ($name) eq "null" ) {
			error_msg("Redundant always true comparison on $name", $name);
		    } else {
			dereference_and_set_var_value($name,"null","false");
		    }}
		}
	    }
	    if ( ! ($cond =~ /_expr/) ) {
		if (get_state ($name)) { 
		    if ( dereference_and_get_var_value ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } else { if ( get_state ($name) eq "null" ) {
			error_msg("Redundant always true comparison on $name", $name);
		    } else {
			dereference_and_set_var_value($name,"null","false");
		    }}
		}
	    }
	}
    }elsif ($data =~ /^(do_cond) (.*)/){            # check do while() for thouroughness
	$conds = split_conds($1);
	for my $cond (@{$conds{falsepath}}){
	    if ($cond =~ /^compound_cond/){
		next;
	    }

	    if ($cond =~ /eq_expr\(\((.*)\)\(integer_cst\(0\)\)\)/){
		my $name = $1;
		if (get_state ($name)) { 
		    if ( get_state ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } else { if ( get_state ($name) eq "non_null" ) {
			error_msg("Redundant always true comparison on $name", $name);
		    } else {
			dereference_and_set_var_value($name,"non_null","");
		    }}
		}
	    }elsif(($cond =~ /ne_expr\(\((.*)\)\(integer_cst\(0\)\)\)/) ||
		   ( $cond =~/(.*)/)){
		my $name = $1;
		if (get_state ($name)) { 
		    if ( get_state ($name) eq "free"){
			error_msg("Comparing value of freed $name", $name);
		    } else { if ( get_state ($name) eq "null" ) {
			error_msg("Redundant always true comparison on $name", $name);
		    } else {
			dereference_and_set_var_value($name,"null", "");
		    }}
		}
	    }
	}
	if ( ! ($cond =~ /_expr/) ) {
		if (get_state ($cond)) { 
		    if ( get_state ($cond) eq "free"){
			error_msg("Comparing value of freed $cond", $cond);
		    } else { if ( get_state ($cond) eq "null" ) {
			error_msg("Redundant always true comparison on $cond", $cond);
		    } else {
			dereference_and_set_var_value($cond,"null","");
		    }}
		}
	}
    }
    
    if ($data =~ /call_expr\(\(addr_expr function_decl\((\w+?)\)\)\(tree_list: (.*)\)\)/){
	my ($fn);
	my ($function) = $1;
	my $var = $2;
	foreach $fn (@free_funcs) {
	    if ( $function eq $fn) {
		my $state = get_state($var);
		if ( $state eq "null" ) {
		    error_msg("Freeing null pointer $var", $var);
		}
		if ( $state eq "free" ) {
		    error_msg("Freeing already freed $var", $var);
		}
		# We are supposed to catch this case on return now
		#if ( $state eq "exported" ) {
		#    error_msg("Freeing externally visible $var", $var);
		#}
		if ($state){
		    set_state($var, "free");
		    # Also free all the vars that refer to same place
		    if ( $state eq "copied" || $state eq "exported") {
			my ($vars);
			foreach $vars (state_names()){
			    if ( get_state($vars) eq "copy of $var") {
				set_state($vars, "free");
			    }
			}
		    }
		    if ( $state =~ /copy of (.*)/) {
			my ($ref) = $1;
			my ($vars);
			set_state($ref, "free");
			foreach $vars (state_names()){
			    if ( get_state($vars) eq "copy of $ref") {
				set_state($vars, "free");
			    }
			}
		    }
		}
	    }
	}
    }

    if ( $data =~ /^return_stmt modify_expr\(result_decl (.*)/ || $data eq "end_func" ) {
	my ($retval) = $1;
	my ($var);
	# cast return value to something case
	if ( $retval =~ /^.*_type = (.*)\)$/ ) {
	    $retval = $1;
	}
	foreach $var (state_names()){
	    my $state = get_state($var);
	    if ( $state =~ /^(non_null|undefined|copied)/ && !($var =~ /indirect_ref/) ) {
		# If we do not return this, then we leak it.
		if ( ! ($retval =~ /\Q$var\E/) && ! (get_state($retval) eq "copy of $var" )) {
		    my $msg = "Probably leaking memory: $var" . " unfreed " . $state;
		    error_msg($msg, $var);
		}
	    }
	    # See if we exporting anything freed outside
	    if ( $state =~ /copy of (.*)/ && $var =~ /indirect_ref/ ) {
		my ($ref) = $1;
		if ( get_state($ref) eq "free" ) {
		    error_msg("Freed pointer is visible from outside $var", $ref);
		}
	    }
		
	    if ( $retval =~ /\Q$var\E/ ) {
		if ($state eq "free" ){
		    error_msg("Returning with freed result $var",$var);
		}
	    }

	}
    }

    # if it returns a negative constant or a NULL then it is an error path which need some special threatment
if ( $EXPORTED_ON_EXIT_IS_BAD ) {
    if (($data =~ /^return_stmt modify_expr\(result_decl integer_type = integer_cst\(-\d+\)\)/)
	or ($data =~ /^return_stmt modify_expr\(result_decl pointer_type = integer_cst\(0\)\)/)){
	my $state;
	foreach $state (state_names()){
	    my $state_state = get_state($state);
	    if ($state_state =~ /^(non_null|undefined|exported|copied)/){
		my $msg = $state . " unfreed " . $state_state;
		error_msg($msg, $state);
	    }
	}
    }
}
}

