#!/usr/bin/perl
#
# Author: Peter Keel, 14.01.2003
#
# License: GPL (GNU Public License)
# 
# Check http.config and its includes for ScriptAlias-paths, and report
# all CGIs in the paths. Also tries to identify some of the 
#
# 

use File::Basename;
use Digest::MD5;

$homedir = "/home/";

if (!$ARGV[0]) {
    $httpdconfig="/etc/httpd/httpd.conf";
} else { 
    $httpdconfig=$ARGV[0]; 
}

format STDOUT_TOP =
  Name                Login    Office   Uid   Gid Home
------------------------------------------------------------------
.
format STDOUT =
@<<<<<<<<<<<<<<<<<< @||||||| @<<<<<<@>>>> @>>>> @<<<<<<<<<<<<<<<<<
$filepath,              $login,  $office,$uid,$gid, $home
.


&getconfigfiles($httpdconfig);
#&printconfigfiles();
&gethomedirs($homedir);
#&printhomedirs();
&getdocroots();
#&printdocroots();
&comparedirs();

sub getconfigfiles() { 
    open(IN_FILE,"<@_") || die "Cannot open Apache-configfile @_ for input\n";
	@includes = grep{ s/^\s*include\s+//} <IN_FILE>;
    close IN_FILE;
    chomp @includes;
    foreach $line (@includes) {
	$configfiles[$i] = $line;
    $i ++;
    }
$configfiles[$i] = "$httpdconfig";
}

sub printconfigfiles() {
    foreach $a ( @configfiles ) {
	print "$a\n";
    }
	print "\n";
}

sub gethomedirs($homedir) {
	opendir(IMD, $homedir) || print(STDERR "$! $homedir\n");
        @homedirs= readdir(IMD);
        closedir(IMD);
        foreach $filename (@homedirs) {
	    chomp $filename;
	    if (($filename ne ".") && ($filename ne "..") && ($filename ne "lost+found"))  {
		if (-d "$homedir$filename") {
		$dirnames[$fnasize] = "$homedir$filename/";
		$fnasize ++;
		} 
	    } 
	}
}

sub printhomedirs() {
    foreach $b (@dirnames) {
	print "$b\n";
    }
	print "\n";
} 

sub getdocroots() { 
    foreach $lines (@configfiles) {
	open(IN_FILE,"<$lines") || die "Cannot open Apache-configfile @configfiles for input\n";
	    @docroots = grep{ s/^\s*DocumentRoot\s+//} <IN_FILE>;
	close IN_FILE;
	chomp @docroots;
        foreach $line (@docroots) {
	    $line =~ (s/\"//g);		# No quotation-marks
	    $line =~ (s/\/\//\//g);	# No double slashes
	    $line =~ (s/\s+//g);	# No spaces
	    $drsize = $#documentroots + 1;
	    $documentroots[$drsize+1] = $line;
	}
    }
    @documentroots = uniq(@documentroots);
    @documentroots = sort @documentroots;
    splice(@documentroots,0,1);		# remove prepending space
} 

sub printdocroots() {
    foreach $b (@documentroots) {
	print "$b\n";
    }
	print "\n";
} 

sub comparedirs() { 
    foreach $dir (@dirnames) {
	  if (!(grep /$dir/, @documentroots)) {
		print "$dir\n";
	  }
    }
}

sub uniq {
    my %hash = map { ($_,0 ) } @_;
    return keys %hash;
}