contrib/check_dangerous_printf.pl

   1 #! perl -w
   2
   3 # This scripts finds calls of printf and printf-like functions which
   4 # do not use a literal string as format. Such calls are potentially
   5 # dangerous as they could use formats which do not match their
   6 # argument lists.
   7
   8 use strict;
   9 use File::Find;
  10 no warnings 'File::Find';
  11
  12 my @FUNCTIONS =
  13     (
  14      # NAME ........ name of function
  15      # FORMATPOS ... index of format string argument, first is 1
  16      {NAME => 'printf'     ,FORMATPOS => 1},
  17      {NAME => 'sprintf'    ,FORMATPOS => 2},
  18      {NAME => 'fprintf'    ,FORMATPOS => 2},
  19      {NAME => 'error'      ,FORMATPOS => 1},
  20      {NAME => 'dolog'      ,FORMATPOS => 1},
  21      {NAME => 'dolog_plain',FORMATPOS => 1},
  22     );
  23
  24 my $rxall;
  25 my %tests;
  26 my @tests;
  27 my @files;
  28
  29 prepare();
  30 find(\&wanted,'.');
  31 process();
  32
  33 sub prepare
  34 {
  35     for my $f (@FUNCTIONS) {
  36         my $name = $f->{NAME};
  37         $rxall .= "|" if $rxall;
  38         $rxall .= "\\b$name\\b";
  39 #       push @{$tests{$f->{FORMATPOS}}},$f;
  40         $tests{$f->{NAME}} = $f;
  41     }
  42     $rxall = qr/($rxall)/;
  43     study $rxall;
  44 }
  45
  46 sub wanted
  47 {
  48     push @files, $File::Find::name if /\.[ch]$/i;
  49     push @files, $File::Find::name if /\.inc$/i;
  50 }
  51
  52 sub get_args
  53 {
  54     my ($coderef,$file,$line) = @_;
  55     my $arg;
  56     my $level = 0;
  57     my @args;
  58
  59  ARG:
  60     while (1) {
  61         unless ($$coderef =~ /\G(.*?)([,()"])/g) {
  62             return undef;
  63         }
  64         $arg .= $1;
  65         my $d = $2;
  66         if ($d eq ')') {
  67             if ($level-- == 0) {
  68                 push @args,$arg;
  69                 return \@args;
  70             }
  71         }
  72         elsif ($d eq ',') {
  73             if ($level == 0) {
  74                 push @args,$arg;
  75                 $arg = '';
  76                 next ARG;
  77             }
  78         }
  79         elsif ($d eq '(') {
  80             $level++;
  81         }
  82         elsif ($d eq '"') {
  83             unless($$coderef =~ /\G  (  ([^\\"]|\\.)*   "  )  /gx) {
  84                 return undef;
  85             }
  86             $d .= $1;
  87         }
  88         $arg .= $d;
  89     }
  90 }
  91
  92 sub process
  93 {
  94     for my $file (@files) {
  95 #       print "$file\n";
  96         open(FILE,"<$file") or die "Could not open $file: $!";
  97         my $code;
  98         my $pos = 0;
  99         my @pos;
 100         while (<FILE>) {
 101             s/\n/ /;
 102             s/[ \t]+/ /;
 103             $code .= $_;
 104             push @pos,$pos;
 105             $pos += length;
 106         }
 107         close(FILE);
 108
 109         my $line = 1;
 110     OCC:
 111         while ($code =~ /$rxall/g) {
 112             my $pos = pos($code);
 113             my $fname = $1;
 114             my $test = $tests{$fname};
 115             while (pos($code) > $pos[$line]) {$line++}
 116 #           print "$1\n";
 117             unless ($code =~ /\G\s*\(/g) {
 118                 print STDERR "$file:$line: warning: could not find parenthesis\n";
 119                 pos($code) = $pos;
 120                 next OCC;
 121             }
 122
 123             my $index = 1;
 124
 125             my $args = get_args(\$code,$file,$line);
 126             unless ($args) {
 127                 print STDERR "$file:$line:warning: could not parse arguments\n";
 128                 pos($code) = $pos;
 129                 next OCC;
 130             }
 131
 132             if (@$args < $test->{FORMATPOS}) {
 133                 print STDERR "$file:$line: warning: could not find format of $fname\n";
 134                 next OCC;
 135             }
 136
 137             my $fmt = $args->[$test->{FORMATPOS} - 1];
 138
 139             if ($fmt =~ /^\s*$/) {
 140                 print "$file:$line: missing format: $fname(".join(',',@$args).")\n";
 141                 next OCC;
 142             }
 143
 144             unless ($fmt =~ /^\s*"/) {
 145                 print "$file:$line: nonliteral format: $fname(".join(',',@$args).")\n";
 146                 next OCC;
 147             }
 148
 149             if ($fmt =~ /^\s*"(.*)"\s*$/) {
 150                 my $f = $1;
 151                 $f =~ s/"\s+"//g;
 152                 my $pct = 0;
 153                 while ($f =~ /(%%?)/g) {$pct++ if length($1)==1};
 154
 155                 if ($pct != @$args - $test->{FORMATPOS}) {
 156                 print "$file:$line: arguments?: $fname(".join(',',@$args).")\n";
 157                 }
 158             }
 159         }
 160     }
 161 }
 162