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
10 no warnings 'File::Find';
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},
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;
42 $rxall = qr/($rxall)/;
48 push @files, $File::Find::name if /\.[ch]$/i;
49 push @files, $File::Find::name if /\.inc$/i;
54 my ($coderef,$file,$line) = @_;
61 unless ($$coderef =~ /\G(.*?)([,()"])/g) {
83 unless($$coderef =~ /\G ( ([^\\"]|\\.)* " ) /gx) {
94 for my $file (@files) {
96 open(FILE,"<$file") or die "Could not open $file: $!";
111 while ($code =~ /$rxall/g) {
112 my $pos = pos($code);
114 my $test = $tests{$fname};
115 while (pos($code) > $pos[$line]) {$line++}
117 unless ($code =~ /\G\s*\(/g) {
118 print STDERR "$file:$line: warning: could not find parenthesis\n";
125 my $args = get_args(\$code,$file,$line);
127 print STDERR "$file:$line:warning: could not parse arguments\n";
132 if (@$args < $test->{FORMATPOS}) {
133 print STDERR "$file:$line: warning: could not find format of $fname\n";
137 my $fmt = $args->[$test->{FORMATPOS} - 1];
139 if ($fmt =~ /^\s*$/) {
140 print "$file:$line: missing format: $fname(".join(',',@$args).")\n";
144 unless ($fmt =~ /^\s*"/) {
145 print "$file:$line: nonliteral format: $fname(".join(',',@$args).")\n";
149 if ($fmt =~ /^\s*"(.*)"\s*$/) {
153 while ($f =~ /(%%?)/g) {$pct++ if length($1)==1};
155 if ($pct != @$args - $test->{FORMATPOS}) {
156 print "$file:$line: arguments?: $fname(".join(',',@$args).")\n";