mcu/tools/ck_L6220E.pl

#!/usr/bin/perl
#
#  Copyright Statement:
#  --------------------
#  This software is protected by Copyright and the information contained
#  herein is confidential. The software may not be copied and the information
#  contained herein may not be used or disclosed except with the written
#  permission of MediaTek Inc. (C) 2006
#
#  BY OPENING THIS FILE, BUYER HEREBY UNEQUIVOCALLY ACKNOWLEDGES AND AGREES
#  THAT THE SOFTWARE/FIRMWARE AND ITS DOCUMENTATIONS ("MEDIATEK SOFTWARE")
#  RECEIVED FROM MEDIATEK AND/OR ITS REPRESENTATIVES ARE PROVIDED TO BUYER ON
#  AN "AS-IS" BASIS ONLY. MEDIATEK EXPRESSLY DISCLAIMS ANY AND ALL WARRANTIES,
#  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
#  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT.
#  NEITHER DOES MEDIATEK PROVIDE ANY WARRANTY WHATSOEVER WITH RESPECT TO THE
#  SOFTWARE OF ANY THIRD PARTY WHICH MAY BE USED BY, INCORPORATED IN, OR
#  SUPPLIED WITH THE MEDIATEK SOFTWARE, AND BUYER AGREES TO LOOK ONLY TO SUCH
#  THIRD PARTY FOR ANY WARRANTY CLAIM RELATING THERETO. MEDIATEK SHALL ALSO
#  NOT BE RESPONSIBLE FOR ANY MEDIATEK SOFTWARE RELEASES MADE TO BUYER'S
#  SPECIFICATION OR TO CONFORM TO A PARTICULAR STANDARD OR OPEN FORUM.
#
#  BUYER'S SOLE AND EXCLUSIVE REMEDY AND MEDIATEK'S ENTIRE AND CUMULATIVE
#  LIABILITY WITH RESPECT TO THE MEDIATEK SOFTWARE RELEASED HEREUNDER WILL BE,
#  AT MEDIATEK'S OPTION, TO REVISE OR REPLACE THE MEDIATEK SOFTWARE AT ISSUE,
#  OR REFUND ANY SOFTWARE LICENSE FEES OR SERVICE CHARGE PAID BY BUYER TO
#  MEDIATEK FOR SUCH MEDIATEK SOFTWARE AT ISSUE.
#
#  THE TRANSACTION CONTEMPLATED HEREUNDER SHALL BE CONSTRUED IN ACCORDANCE
#  WITH THE LAWS OF THE STATE OF CALIFORNIA, USA, EXCLUDING ITS CONFLICT OF
#  LAWS PRINCIPLES.  ANY DISPUTES, CONTROVERSIES OR CLAIMS ARISING THEREOF AND
#  RELATED THERETO SHALL BE SETTLED BY ARBITRATION IN SAN FRANCISCO, CA, UNDER
#  THE RULES OF THE INTERNATIONAL CHAMBER OF COMMERCE (ICC).
#
#*****************************************************************************
#*
#* Filename:
#* ---------
#*   ck_L6220E.pl
#*
#* Project:
#* --------
#*   MAUI
#*
#* Description:
#* ------------
#*   This script will search unsafe C standard API usage from .lis generated by
#*     ARMLINK
#*
#*     find all such referenc in .lis file
#*       date.obj(i.localtimeOffset) refers to armlibc_rvct.obj(SHOULD_NOT_USED_FUNCTION) for localtime
#*     report:
#*       object filename, function name, used symbol, possible file path
#*
#*     perl ck_L6220E.pl {.lis file path}+
#*     this script will try to detect .lis file path if no argument
#*
#* Author:
#* -------
#*   Shuguang Wen (mtk80458)
#*
#*============================================================================
#*             HISTORY
#* Below this line, this part is controlled by PVCS VM. DO NOT MODIFY!!
#*------------------------------------------------------------------------------
#* $Revision$
#* $Modtime$
#* $Log$
#* 
#* 08 16 2012 ying.xin
#* [MOLY00002197] [gcc]newlib tailoring and performance optimization check in
#* .
#*
#*
#*------------------------------------------------------------------------------
#* Upper this line, this part is controlled by PVCS VM. DO NOT MODIFY!!
#*============================================================================
#****************************************************************************/
#

use strict;
use warnings;

my @unsafe_callers;

sub trim {
    my ($s) = @_;
    
    $s =~ s/^\s+//;
    $s =~ s/\s+$//;
    
    return $s;
}

sub strcmp_nocase {
    my ($a, $b) = @_;
    
    return lc $a eq lc $b;
}

sub has_unsafe {
    my ($line) = @_;
    my ($myobj, $mysec, $symname, $myfunc);
    
    $line = trim $line;
    
    if ($line =~ /(.+)\((.+)\) refers to .+\(SHOULD_NOT_USED_FUNCTION\) for (.+)/
        or $line =~ /(.+)\((.+)\) refers \(Special\) to .+\(SHOULD_NOT_USED_FUNCTION\) for (.+)/
        or $line =~ /(.+)\((.+)\) refers \(Weak\) to .+\(SHOULD_NOT_USED_FUNCTION\) for (.+)/) {
        $myobj = $1;
        $mysec = $2;
        $symname = $3;
    }
    else {
        return 0;
    }
    
    if ($mysec =~ /i\.(.+)/) {
        $myfunc = $1;
    }
    else {
        $myfunc = "";
    }
    
    push @unsafe_callers, { objfile => $myobj, sectname => $mysec, function => $myfunc, used_symbol => $symname, path => []};
    1;
}

sub add_path_nodup {
    my ($arr_ref, $path) = @_;
    
    foreach (@{$arr_ref}) {
        if (strcmp_nocase($_, $path)) {
            return 0;
        }
    }
    
    push (@{$arr_ref}, $path);
    1;
}

sub find_object_filename {
    my ($line) = @_;
    my ($path, $objfile);
    
    $line = trim $line;
    
    if ($line =~ /([^\s]+)\s+0x00000000\s+Number\s+0\s+([^\s]+)\s+ABSOLUTE/) {
        $path = $1; 
        $objfile = $2;
    }
    else {
        return;
    }
    
    foreach my $c (@unsafe_callers) {
        if (strcmp_nocase($objfile, $c->{objfile})) {
            add_path_nodup($c->{path}, $path);
        }
    }
}

sub print_result {
    if ($#unsafe_callers == -1) {
        print " ... NO\n";
        return;
    }
    print "\n";
    
    print sprintf("%-16s %-20s %-12s  path(s)\n", "object", "function", "unsafe api");
    print "=" x 79, "\n";
    foreach my $c (@unsafe_callers) {
        print sprintf("%-16s %-20s %-12s  %s\n", $c->{objfile}, $c->{function}, $c->{used_symbol}, 
                        $#{$c->{path}} >= 0 ? @{$c->{path}}[0] : "");
        for (my $i = 1; $i <= $#{$c->{path}}; $i++) {
            print sprintf("%-16s %-20s %-12s  |-%s\n", "", "", "", @{$c->{path}}[$i]);
        }
    }
    print "\n";
}

sub find_in_lis {
    foreach my $f (@_) {
        open F, "<", $f or next;
        print "[I] unsafe API callers found from $f";
        @unsafe_callers = ();
        while (<F>) {
            has_unsafe $_;
            find_object_filename $_;
        }
        &print_result($f);
        close F;
    }
}

sub expand_lis {
    my @ss = ();
    my $show_err = shift;
    
    for my $name (@_) {
        if (-f $name && -r $name) {
            push @ss, $name;
        }
        elsif (-d $name && -x $name) {
            my @all_files = glob "$name/*.lis";
            for my $subname (@all_files) {
                push @ss, $subname if -f $subname && -r $subname;
            }
        }
        elsif ($show_err) {
            print "[E] ignore not readable file/dir: $name\n";
        }
    }
    
    return @ss;
}

my $quiet_mode = 0;
sub main {
    my @non_option_args = ();
    my @lis_list = ();
    my $maui_root = undef;
    
    foreach (@ARGV) {
        if ($_ eq "-q") {
            $quiet_mode = 1;
        }
        else {
            push @non_option_args, $_;
        }
    }
    
    if ($#non_option_args >= 0) {
        foreach (@non_option_args) {
            push @lis_list, expand_lis(1, $_);
        }
    }
    # detect in root directory
    elsif (-d "build" && -d "make" && -d "tools") {
        $maui_root = ".";
    }
    elsif (-d "../build" && -d "../make" && -d "../tools") {
        $maui_root = "..";
    }
    
    if ($maui_root) {
        print "[I] MAUI root directory mcu/ detected($maui_root), search lis inside build/\n";
        my @dirs_in_build = glob "$maui_root/build/*";
        foreach (@dirs_in_build) {
            push @lis_list, expand_lis(0, $_);
        }
    }
    
    if ($#lis_list == -1) {
        print "[E] no lis file found, please run it inside mcu/ directory or pass lis file path(s)\n";
    }
    
    find_in_lis @lis_list;
    
    print "\n\nfor RD: please refer to http://teams.mediatek.inc/sites/WCP/WCPSW/SystemService/Lists/System_Service_nnouncement/DispForm.aspx?ID=75&Source=http%3A%2F%2Fteams%2Emediatek%2Einc%2Fsites%2FWCP%2FWCPSW%2FSystemService%2FLists%2FSystem%5FService%5FAnnouncement%2FAllItems%2Easpx\n\n";
}

$| = 1;
&main;
if (not $quiet_mode) {
    system("pause");
}