bird.pl

#!/usr/bin/perl -w

####################################################################################
#
# Copyright (C) 2000 Zorgon <This email address is being protected from spambots. You need JavaScript enabled to view it.>
#
# This program bird.pl

#!/usr/bin/perl -w

####################################################################################
#
# Copyright (C) 2000 Zorgon <This email address is being protected from spambots. You need JavaScript enabled to view it.>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
#
####################################################################################

use strict;
use locale;
use Getopt::Std;

use vars qw($opt_c $opt_p $opt_r $opt_f $name @files @fctc @fctpl);

&usage unless getopts('cpr:f:');
&usage unless(defined $opt_c || defined $opt_p);
&usage if(defined $opt_c && defined $opt_p);
&usage unless(defined $opt_r || defined $opt_f);
&usage if(defined $opt_r && defined $opt_f);

initialisation();

##### Functions ######
@fctc = ("fprintf\\\([^\\\"\\\%]+\\\;",
"sprintf\\\([^\\\"\\\%]+\\\;",
"sprintf\\\(sprintf\\\([^\\\"\\\%]+\\\)\\\;",
"snprintf\\\([^\\\"\\\%]+\\\;",
"printf\\\(\\\(.*\\\)\\\;",
"system\\\([^/]+\\\;",
"execvp\\\([^/]+\\\;",
"execlp\\\([^/]+\\\;",
"popen\\\([^/]+\\\;",
"strcpy",
"gets",
"strcat",
"realpath",
"strlen");

@fctpl = ("system.*\\\$.*.*\\\;",
"system.*\\\$.*\\\".*\\\;",
"umask.*\\\$.*\\\;",
"unlink.*\\\$.*\\\;",
"open\\\(.*\\\|.*\\\$.*\\\;",
"open\\\(.*\\\$.*\\\|.*\\\;",
"\\\`.*\\\$.*\\\`\\\;",
"exec.*\\\$.*\\\".*\\\;",
"unless .. open");

######################

print "(bird.pl) - (c) Zorgon (zorgon\@linuxstart.com) 2000. \n\n";
list_folder();

foreach $name (@files){
print "### Fichiers $name \n";
checkfct(@fctc,$name) if(defined $opt_c);
checkfct(@fctpl,$name) if(defined $opt_p);
print "\n";
}

####################################################################################
sub initialisation {
system("clear");
$| = 1;
@fctc = ();
@fctpl = ();

}

####################################################################################
sub list_folder {
my($name,$ext);

if(defined $opt_r){
opendir(DIR,$opt_r) || die "Can't open dir $opt_r: $!";
for(readdir(DIR)){
next if($_ eq ".");
next if($_ eq "..");
next if((-d $_) || (-l $_));
($name,$ext) = split(/\./);
next if(!defined($ext));
push(@files,"$opt_r/$_") if((defined $opt_c && $ext eq "c")
|| (defined $opt_p && $ext eq "pl"));
}
closedir(DIR);
}
else {
push(@files,$opt_f) if(defined $opt_f);
}
}

####################################################################################
sub checkfct {
my @listfct = @_;
my $cpt = 1;
my ($save,$key);

open(SRC,"$name") || die "Can't open $name : $!";
while(<SRC>){
$save = $_;
chop($save);
foreach $key (@listfct){
do{
eval { "" =~ /$key/ };
warn "Incorrect expr. $@" if $@;
} while $@;

if(/$key/){
print "L.$cpt : $save\n";
last;
}
}
$cpt ++;
}
close(SRC);
}

####################################################################################
sub usage {
print "(c) Zorgon (zorgon\@linuxstart.com) 2000. \n\n";
print "Usage: bird.pl [-pc] [-rf files...]\n";
print "Script analysant les sources pour trouver d'eventuelles failles.\n";
print " -p Source avec extension .pl\n";
print " -c Source avec extension .c\n";
print " -r Nom de repertoire fourni\n";
print " -f Nom de fichier fourni\n";
exit(1);
}

exit 0;