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