* contrib/check_dangerous_printf.pl: Removed this file in favor of
authortwisti <none@none>
Thu, 3 May 2007 08:16:14 +0000 (08:16 +0000)
committertwisti <none@none>
Thu, 3 May 2007 08:16:14 +0000 (08:16 +0000)
pscan.

contrib/check_dangerous_printf.pl [deleted file]

diff --git a/contrib/check_dangerous_printf.pl b/contrib/check_dangerous_printf.pl
deleted file mode 100644 (file)
index 2a4d742..0000000
+++ /dev/null
@@ -1,162 +0,0 @@
-#! perl -w
-
-# This scripts finds calls of printf and printf-like functions which
-# do not use a literal string as format. Such calls are potentially
-# dangerous as they could use formats which do not match their
-# argument lists.
-
-use strict;
-use File::Find;
-no warnings 'File::Find';
-
-my @FUNCTIONS =
-    (
-     # NAME ........ name of function
-     # FORMATPOS ... index of format string argument, first is 1
-     {NAME => 'printf'     ,FORMATPOS => 1},
-     {NAME => 'sprintf'    ,FORMATPOS => 2},
-     {NAME => 'fprintf'    ,FORMATPOS => 2},
-     {NAME => 'error'      ,FORMATPOS => 1},
-     {NAME => 'dolog'      ,FORMATPOS => 1},
-     {NAME => 'dolog_plain',FORMATPOS => 1},
-    );
-
-my $rxall;
-my %tests;
-my @tests;
-my @files;
-
-prepare();
-find(\&wanted,'.');
-process();
-
-sub prepare
-{
-    for my $f (@FUNCTIONS) {
-       my $name = $f->{NAME};
-       $rxall .= "|" if $rxall;
-       $rxall .= "\\b$name\\b";
-#      push @{$tests{$f->{FORMATPOS}}},$f;
-       $tests{$f->{NAME}} = $f;
-    }
-    $rxall = qr/($rxall)/;
-    study $rxall;
-}
-
-sub wanted
-{
-    push @files, $File::Find::name if /\.[ch]$/i;
-    push @files, $File::Find::name if /\.inc$/i;
-}
-
-sub get_args
-{
-    my ($coderef,$file,$line) = @_;
-    my $arg;
-    my $level = 0;
-    my @args;
-
- ARG:
-    while (1) {
-       unless ($$coderef =~ /\G(.*?)([,()"])/g) {
-           return undef;
-       }
-       $arg .= $1;
-       my $d = $2;
-       if ($d eq ')') {
-           if ($level-- == 0) {
-               push @args,$arg;
-               return \@args;
-           }
-       }
-       elsif ($d eq ',') {
-           if ($level == 0) {
-               push @args,$arg;
-               $arg = '';
-               next ARG;
-           }
-       }
-       elsif ($d eq '(') {
-           $level++;
-       }
-       elsif ($d eq '"') {
-           unless($$coderef =~ /\G  (  ([^\\"]|\\.)*   "  )  /gx) {
-               return undef;
-           }
-           $d .= $1;
-       }
-       $arg .= $d;
-    }
-}
-
-sub process
-{
-    for my $file (@files) {
-#      print "$file\n";
-       open(FILE,"<$file") or die "Could not open $file: $!";
-       my $code;
-       my $pos = 0;
-       my @pos;
-       while (<FILE>) {
-           s/\n/ /;
-           s/[ \t]+/ /;
-           $code .= $_;
-           push @pos,$pos;
-           $pos += length;
-       }
-       close(FILE);
-
-       my $line = 1;
-    OCC:
-       while ($code =~ /$rxall/g) {
-           my $pos = pos($code);
-           my $fname = $1;
-           my $test = $tests{$fname};
-           while (pos($code) > $pos[$line]) {$line++}
-#          print "$1\n";
-           unless ($code =~ /\G\s*\(/g) {
-               print STDERR "$file:$line: warning: could not find parenthesis\n";
-               pos($code) = $pos;
-               next OCC;
-           }
-       
-           my $index = 1;
-
-           my $args = get_args(\$code,$file,$line);
-           unless ($args) {
-               print STDERR "$file:$line:warning: could not parse arguments\n";
-               pos($code) = $pos;
-               next OCC;
-           }
-
-           if (@$args < $test->{FORMATPOS}) {
-               print STDERR "$file:$line: warning: could not find format of $fname\n";
-               next OCC;
-           }
-
-           my $fmt = $args->[$test->{FORMATPOS} - 1];
-
-           if ($fmt =~ /^\s*$/) {
-               print "$file:$line: missing format: $fname(".join(',',@$args).")\n";
-               next OCC;
-           }
-
-           unless ($fmt =~ /^\s*"/) {
-               print "$file:$line: nonliteral format: $fname(".join(',',@$args).")\n";
-               next OCC;
-           }
-
-           if ($fmt =~ /^\s*"(.*)"\s*$/) {
-               my $f = $1;
-               $f =~ s/"\s+"//g;
-               my $pct = 0;
-               while ($f =~ /(%%?)/g) {$pct++ if length($1)==1};
-
-               if ($pct != @$args - $test->{FORMATPOS}) {
-               print "$file:$line: arguments?: $fname(".join(',',@$args).")\n";
-               }
-           }
-       }
-    }
-}
-