#!/usr/bin/perl 

# Copyright 2004  Mark Tucker (mark@tucker.net)
# All rights reserved.
#
# Redistribution and use of this script, with or without modification, is
# permitted provided that the following conditions are met:
#
# 1. Redistributions of this script must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
#  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
#  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO
#  EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
#  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
#  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
#  OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
#  WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
#  OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
#  ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# pkgcheck.pl
#
#
# VERSION 0.0.1
#
# Script adapted from slackware's pkgcheck.pl (by Mark Tucker)
# to check a zenwalk package for common (and, hopefully, uncommmon
# errors. The following checks are made:
#  - package naming.
#  - existance of md5 and its validity (or ty to create it)
#  - set UID files
#  - "./" directory exists in package
#  - the "install" dir exists
#  - slack-desc file exists.
#  - contents of slack-desc file (checks that there is something there)
#  - zenbuild file exists.
#  - contents of zenbuild file (author, source location, ...)
#  - non-root owned files
#  - bin directories and files are group "root" and good dirctories
#  - bin files are executable
#  - bin are stripped
#  - zero length files
#  - non-readable files
#  - non-readable directories
#  - existance of doc directory (and that it matches the package name)
#  - documentation directory at /usr/share/doc
#  - empty documentation directory
#  - man directory in /usr/share/man
#  - non-compressed man pages
#  - non-compressed info pages
#  - existance of info dir or dir.gz file
#  - existance of /usr/etc directory
#  - existance of /usr/local directory
#  - abnormally large files

#  Comments, problems or suggestions can be sent to mark@tucker.net
#

#  CHANGES:
#     Jul 23, 2004 - initial creation
#     Sep 8, 2004  - added "noarch" as a valid arch type
#                  - added check for /usr/share/man
#                  - added check for /usr/share/doc
#     Jun 3, 2006  - add Zenwalk specific stuffs (zenbuild, .desktop, ...)
#     Jun 9, 2006  - add md5 check and creation
#     Nov 20, 2006 - changes due to new RELEASE.BUILD packages name
#     Feb 8, 2007  - RELEASE.BUILD error is now warning(kernel version allowed)
#============================================================================
# set vars and paths
@bindirs = ('usr/bin/', 'bin/', 'sbin/', 'usr/sbin/', 'usr/X11R6/bin/');

$debug = 0;

# parse arguments (if any)
if(! defined @ARGV) {
    print "You must provide the name of a package to test\n";
    print "\nUsage:\n\t$0 pkg_name-ver-arch-rel.tgz\n\n";
    exit;
}else{
    chomp($PKG = $ARGV[0]);
}




###################################################
# check package naming
###################################################
chomp($filename = `basename $PKG`);
print "Checking package: $filename\n";
@pkg_nam = split(/-/, $filename);

$softname_and_ver = join('-', @pkg_nam[0..($#pkg_nam - 2)]);

#----------------
# ends w/ .tgz
#----------------
print "Checking file name extention (.tgz)... ";
if($filename !~ /\.tgz$/) {
    print "\n\nERROR: package is not a compressed tar archive or is not "
	."properly named.  Exiting...\n";
    exit;
}else{
    print "OK\n";
}

#----------------
# has #xxx release name
#----------------
print "Checking package name release... ";
# softname-$softversion-$arch-$packageversion
$testok = 1;
($pkg_rel, $junk) = split(/\./, $pkg_nam[$#pkg_nam]);
if($pkg_rel !~ /^[0-9]/) {
    print "\nERROR: package release must indicate a number value.\n";
    print "$pkg_rel" if ($debug);
    $testok = 0;
}
# print "pkg rel : [$pkg_rel]";
# print "\n a-z [".$pkg_rel !~ /[a-zA-Z]$/."]";
if($pkg_rel !~ /[0-9]/ ) {
    print "\nERROR: package release must contain only numbers.\n";
    print "$pkg_rel" if ($debug);
    $testok = 0;
}

if(!defined($junk) || $junk !~ /[0-9]/ ) {
    &err_warn("\nERROR: package build must exists and be a number.");
    print "$pkg_rel" if ($debug);
    $testok = 2;
}

if($testok == 0) {
    exit;
}else{
    print "$pkg_rel\n";
}

#----------------
# check for valid arch (i386 -> i686)
#----------------
print "Checking package arch... ";
$pkg_arch = $pkg_nam[($#pkg_nam - 1)];
if($pkg_arch =~ /(i[3456]86)|noarch/) {
    print "$pkg_arch\n";
}else{
    &err_fatal("\nERROR: package arch, $pkg_arch, is not a valid value.");
}

#----------------
# store version field
#----------------
print "Checking package version... ";
$pkg_ver = $pkg_nam[($#pkg_nam - 2)];
print "$pkg_ver\n";

#----------------
# store package name
#----------------
print "Checking package name... ";
if($#pkg_nam > 3) {
    $pkg_name = join('-', @pkg_nam[0..($#pkg_nam - 3)]);
}else{
    $pkg_name = $pkg_nam[0];
}
print "$pkg_name\n";

#----------------
# store package-ver name
#----------------
$pkg_name_ver = "$pkg_name-$pkg_ver";


#----------------
# check the md5 file (or create it)
#----------------
$testok = 1;
print "Checking md5 file... ";
$md5_file= $filename;
$md5_file=~ s/\.tgz$/\.md5/;
$cheksum_calc=`md5sum $filename`;

if (-r $md5_file)
{
    $cheksum_file=`cat $md5_file`;
    if ($cheksum_calc ne $cheksum_file)
    {
	&err_warn("\nERROR: Wrong md5 : $cheksum_file != $cheksum_calc");
	$testok = 0;
    }
}else{
    print "md5 not readable, script is trying to create it ...";
    `md5sum $filename > $md5_file`;
    if (! -r $md5_file)
    {
	&err_warn("\nERROR: Can't create md5 file");
	$testok = 0;
    }
}

print "OK\n" if ($testok == 1);


###################################################
# read the contents of the package
###################################################
print "Reading the contents of the package... \n";
chomp(@package = `tar -tzvf $PKG`);

#--------------------------------------------------
# create hashes for each line element
#--------------------------------------------------
foreach $k (@package) {
#    print "$k\n";
    my @line = split(/\s+/, $k);
    $name = $line[$#line];
    push(@all_names, $name);

    # create arrays by file type
    if ($k =~ /^d/) {push(@dirs, $name);}
    elsif ($k =~ /^-/) {push(@files, $name);}
    elsif ($k =~ /^l/) {push(@links, $name);}
    else {next}

    # store permissions by name
    $perms{$name} = $line[0];
    $filetype = substr($perms{$name}, 0, 1);
    $perms_owner{$name} = substr($perms{$name}, 1, 3);
    $perms_group{$name} = substr($perms{$name}, 4, 3);
    $perms_other{$name} = substr($perms{$name}, 7, 3);
   
    # store owner,group by name
    ($owner{$name},$group{$name}) = split(/\//, $line[1]);

    # store file/dir size by name
    $size{$name} = $line[2];
}


###################################################
# specific checks....
###################################################
#--------------------------------------------------
# check for suid files
#--------------------------------------------------
print "Checking setuid files... ";
$testok = 1;
foreach $k (@files) {
    if($perms_owner{$k} =~ /s$/) {
	&err_fatal("Permissions for $k are SUID");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check for "./" dir
#--------------------------------------------------
print "Checking for proper root directory... ";
$testok = 0;
foreach $k (@dirs) {
    if($k eq './') {
	print "OK\n";
	$testok = 1;
	last;
    }
}
if($testok == 0) {
    print "Error\n";
    &err_fatal("'./' directory entry missing from package.");
}


#--------------------------------------------------
# check for ./install dir
#--------------------------------------------------
print "Checking for './install' directory... ";
$testok = 0;
foreach $k (@dirs) {
    if($k eq 'install/') {
	print "OK\n";
	$testok = 1;
	last;
    }
}
if($testok == 0) {
    &err_fatal("'install/' directory entry missing from package.");
}


#--------------------------------------------------
# check for slack-desc file
#--------------------------------------------------
print "Checking for slack-desc file... ";
$testok = 0;
foreach $k (@files) {
    if($k eq 'install/slack-desc') {
	print "OK\n";
	$testok = 1;
    }
}
if($testok == 0) {
    &err_fatal("'slack-desc' file is missing from package.");
}else{
#--------------------------------------------------
# check slack-desc file contents
#--------------------------------------------------
    print "Checking contents of slack-desc file... ";
    $testok = 0;

    #  dump contents to array
    chomp(@slkdsc = `tar -xzOf $PKG install/slack-desc`);

    #--------------------
    # check for pkg_name in file
    # There should be more than 1 line starting with the package name.
    #--------------------
    foreach $j (@slkdsc) {
	if($j =~ /^$pkg_name:/) {
	    print "$j" if ($debug);
	    $count++;
	}
    }
    if($count != 0) {
	$testok = 1;
    }else{
	&err_warn("No lines in slack-desc match the package name, $pkg_name");
    }
    #--------------------
    # check for description lines
    # This just checks that there are at least 2 lines of description which
    # are more than 5 characters in lenght.
    #--------------------
    $count = 0;
    foreach $j (@slkdsc) {
	print "$j" if ($debug);
	next if($j !~ /^$pkg_name:/);
	$descr = substr($j, (length($pkg_name) + 2));
	$count++ if(length($descr) > 5);
    }
    if($count > 2) {
	$testok = 1;
    }else{
	&err_warn("slack-desc file seems to be a bit sparse, $count lines.");
    }


    print "OK\n" if($testok == 1);
}

#--------------------------------------------------
# check for zenbuild file
#--------------------------------------------------
print "Checking for zenbuild file... ";
$testok = 0;
foreach $k (@files) {
    if($k eq "usr/src/$softname_and_ver/build-$pkg_name.sh") {
	print "OK\n";
	$testok = 1;
    }
}
if($testok == 0) {
    &err_fatal("'build-$pkg_name.sh' file is missing from package.");
}else{
#--------------------------------------------------
# check zenbuild file contents
#--------------------------------------------------
    $count = 0;
    print "Checking contents of zenbuild file... ";
    $testok = 0;

    #  dump contents to array
    chomp(@zbuild = `tar -xzOf $PKG usr/src/$softname_and_ver/build-$pkg_name.sh`);

    #--------------------
    # check for "source location" in file
    #--------------------
    foreach $j (@zbuild) {
	if($j =~ /source location|source|SRCURL|URL\s*:\s+http:\/\//i) {
	    print "$j" if ($debug);
	    $count++;
	    last
	}
    }
    if($count != 0) {
	$testok = 1;
    }else{
	&err_warn("No lines in build-$pkg_name.sh have 'source location:'");
    }
    #--------------------
    # check for author line
    #--------------------
    $count = 0;
    foreach $j (@zbuild) {
	if($j =~ /author|creator|maintainer\s*:\s.+/i) {
	    print "$j" if ($debug);
	    $count++;
	    last
	}
    }
    if($count != 0) {
	$testok = 1;
    }else{
	&err_warn("build-$pkg_name.sh file seems to be created by nobody.");
    }

    #--------------------
    # check for revision line
    #--------------------
#     $count = 0;
#     foreach $j (@zbuild) {
# 	if($j =~ /last revised|revision date|latest update|last update\s*:\s.*[0-9]+/i) {
# 	    print "$j" if ($debug);
# 	    $count++;
# 	    last
# 	}
#     }
#     if($count != 0) {
# 	$testok = 1;
#     }else{
# 	&err_warn("build-$pkg_name.sh file seems to haven't been revised.");
#     }

#     print "OK\n" if($testok == 1);
}


#--------------------------------------------------
# check for .desktop file
#--------------------------------------------------
print "Checking for .desktop file... ";
$testok = 0;
$desktop_name="";
foreach $k (@files) {
    if(lc($k) =~ /usr\/share\/applications\/$pkg_name.desktop|usr\/share\/applications\/.+\/$pkg_name.desktop/) {
	print "OK\n";
	$testok = 1;
	$desktop_name=$k;
	last;
    }
}
if($testok == 0) {
    &err_warn("'$pkg_name.desktop' file is missing from package.");
}else {
#--------------------------------------------------
# check .desktop file contents
#--------------------------------------------------
    print "Checking contents of $pkg_name.desktop file... ";
    $testok = 0;
    $count = 0;

    #  dump contents to array
    chomp(@dtop = `tar -xzOf $PKG $desktop_name`);

    #--------------------
    # check for [Desktop Entry] in file
    #--------------------
    if ($dtop[0] =~ /\[Desktop Entry\]/) {
	$testok = 1;
    }else{
	&err_fatal("[Desktop Entry] isn't $pkg_name.desktop's first line");
    }

    foreach $j (@dtop) {
	if(lc($j) =~ /^icon=\/[:alpha:]\/[:alpha:]/) {
	    print "$j" if ($debug);
	    $count++;
	    last;
	}
    }
    if($count == 0) {
	$testok = 1;
    }else{
	&err_warn("$pkg_name.desktop icon is abolute path");
    }
    print "OK\n" if($testok == 1);
}


#--------------------------------------------------  
# check for non-root owned files or dirs (report error)
#--------------------------------------------------
print "Checking for non-root owned files and dirs... ";
$testok = 1;
foreach $k (@all_names) {
    if($owner{$k} ne 'root') {
	&err_fatal("$k not owned by the root user");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);
#--------------------------------------------------
# group=bin for /usr/bin, /bin, /sbin, /usr/sbin, and /usr/X11R6/bin 
#--------------------------------------------------
print "Checking group for bin directories... ";
$testok = 1;
foreach $k (@all_names) {
    foreach $j (@bindirs) {
	if(($k =~ /^$j/) && ($group{$k} ne 'root')) {
	    $testok = 0;
	    &err_warn("$k should have a group of 'root'");
	}
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check bin dirs for non-executable files
#--------------------------------------------------
print "Checking bin files for execute permissions ... ";
$testok = 1;

foreach $k (@files) {
    foreach $j (@bindirs) {
	if($k =~ /^$j/) {
	    $count = 0;
	    $count++ if($perms_owner{$k} =~ /x$/);
	    $count++ if($perms_group{$k} =~ /x$/);
	    $count++ if($perms_other{$k} =~ /x$/);
	    if($count == 0) {
		&err_warn("No execute permissions for $k");
		$testok = 0;
	    }
	}
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check for zero length files
#--------------------------------------------------
print "Checking zero length files... ";
$testok = 1;
foreach $k (@files) {
    if($size{$k} == 0) {
	if($k =~ /^install\//) {
	    &err_warn("file $k has zero length, using checkinstall, eh?");
	}else{
	    &err_suggest("file $k has zero length, this could be a problem.");
	}
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);
	
#--------------------------------------------------
# check for non-readable files
#--------------------------------------------------
print "Checking non readable files... ";
$testok = 1;
foreach $k (@files) {
    $count = 0;
    $count++ if($perms_owner{$k} !~ /^r/);
    $count++ if($perms_group{$k} !~ /^r/);
    $count++ if($perms_other{$k} !~ /^r/);
    if($count != 0) {
	&err_suggest("File $k has no read permssions");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);


#--------------------------------------------------
# check for non-readable directories
#--------------------------------------------------
print "Checking non readable directories... ";
$testok = 1;
foreach $k (@dirs) {
    $count = 0;
    $count++ if($perms_owner{$k} !~ /^r.x$/);
    $count++ if($perms_group{$k} !~ /^r.x$/);
    $count++ if($perms_other{$k} !~ /^r.x$/);
    if($count != 0) {
	&err_suggest("Directory $k has no read permssions");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check for usr/doc/pkg_ver 
#--------------------------------------------------
print "Checking for documentation directory... ";
$testok = 0;
foreach $k (@dirs) {
    if(($k =~ /usr\/doc\/$pkg_name_ver/) ||
	($k =~ /usr\/share\/doc\/$pkg_name_ver/)) {
	$testok = 1;
    }
}
if($testok == 0) {
    &err_fatal("Missing documentation directory /usr/doc/$pkg_name_ver");
}else{
    print "OK\n";
}

#--------------------------------------------------
# check for usr/doc/pkg_ver or usr/share/doc/pkg_ver
#--------------------------------------------------
print "Checking for documentation directory in /usr/share... ";
$testok = 1;
foreach $k (@dirs) {
    if($k =~ /usr\/share\/doc\/$pkg_name_ver/) {
	$testok = 0;
    }
}
if($testok == 0) {
    &err_warn("Found documentation directory /usr/share/doc/, should be /usr/doc/");
}else{
    print "OK\n";
}


#--------------------------------------------------
# check for files in usr/doc/pkg_ver or usr/share/doc/pkg_ver
#--------------------------------------------------
print "Checking for empty documentation directory... ";
$testok = 0;
$count = 0;
foreach $k (@files) {
    $count++ if($k =~ /usr\/doc\/$pkg_name_ver/);
    $count++ if($k =~ /usr\/share\/doc\/$pkg_name_ver/);
}
if($count == 0) {
    &err_fatal("There are no files in usr/doc/$pkg_name_ver");
}else{
    print "OK\n";
}

#--------------------------------------------------
# check for usr/share/man directory
#--------------------------------------------------
print "Checking for /usr/share/man... ";
$testok = 1;
foreach $k (@dirs) {
    if($k =~ /usr\/share\/man/) {
	$testok = 0;
    }
}
if($testok == 0) {
    &err_warn("Man directory found in /usr/share/man - Would be better as /usr/man");
}else{
    print "OK, not found.\n";
}


#--------------------------------------------------
# check for gzipped man pages
#--------------------------------------------------
print "Checking non-compressed man pages... ";
$testok = 1;
foreach $k (@files) {
    if($k =~ /\/man\/man.*[1-9]$/) {
	&err_warn("man page $k should be compressed");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check for gzipped info pages
#--------------------------------------------------
print "Checking non-compressed info pages... ";
$testok = 1;
foreach $k (@files) {
    if(($k =~ /usr\/info\//) && ($k !~ /gz$/) &&
	($k !~ /dir/)) {
	&err_warn("info page $k should be compressed");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check for  info dir or dir.gz file (report error)
#--------------------------------------------------
print "Checking for info dir or dir.gz... ";
$testok = 1;
foreach $k (@files) {
    if($k =~ /info\/dir/) {
	&err_suggest("File $k will overwrite the user's info dir file.");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);
    
#--------------------------------------------------
# check for /usr/etc dir and files (report error)
#--------------------------------------------------
print "Checking for usr/etc/ directory... ";
$testok = 1;
foreach $k (@dirs) {
    if($k =~ /^usr\/etc\//) {
	&err_fatal("Directory $k should not exist, use /etc.");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check for /usr/local/ dir (report error)
#--------------------------------------------------
print "Checking for usr/local/ directory... ";
$testok = 1;
foreach $k (@dirs) {
    if($k =~ /^usr\/local\//) {
	&err_fatal("Directory $k should not exist.");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# check for unusually large files..
#--------------------------------------------------
print "Checking for abnormally large files... ";
$testok = 1;
foreach $k (@files) {
    if($size{$k} > 10000000) {
	&err_suggest("File $k has a size of $size{$k}, you may want to run the 'strip' utility on it.");
	$testok = 0;
    }
}
print "OK\n" if($testok == 1);

#--------------------------------------------------
# stripping binaries
#--------------------------------------------------
print "Checking for unstripped bin... ";
$testok = 1;
foreach $k (@files) {
    if($k =~ /usr\/bin|usr\/sbin/)
    {
	`tar -xzOf $PKG $k > bin_strip`;
	print "check file:[" .$k ."]\n" if ($debug != 0);
	if (`file bin_strip` !~ /script/)
	{
	    `strip -s bin_strip`;
	    $m=`ls -la bin_strip`;
	    `rm bin_strip`;
	    my @stripped = split(/\s+/, $m);
	    print "   size  : ". $size{$k}. "\n" if ($debug != 0);
	    print "   strip : ". $stripped[4]. "\n\n" if ($debug != 0);
	    if($size{$k} != $stripped[4]) {
		&err_warn("File $k hasn't been stripped.");
		$testok = 0;
	    }
	}
    }
}
print "OK\n" if($testok == 1);

###################################################
# report errors
###################################################
print "-" x 60 ."\n";

# print fatal errors
print "\nFATAL ERRORS:\n";
foreach $i (@fatal_errors) {
    print "\t$i\n";
}
    
# print warnings
print "\nWARNINGS:\n";
foreach $i (@warnings) {
    print "\t$i\n";
}

# print suggestions
print "\nSUGGESTIONS:\n";
foreach $i (@suggestions) {
    print "\t$i\n";
}

# print summary
print "-" x 60 ."\n";
print "SUMMARY for $filename:";
print "\n".($#fatal_errors + 1).
    " fatal errors.\n".($#warnings + 1)." warnings.\n".
    ($#suggestions + 1)." suggestions\n";
print "-" x 60 ."\n";
exit;
###################################################
# sub routines
###################################################
#==================================================
sub err_fatal {
    print "  Error.\n";
    push(@fatal_errors, $_[0]);
}
#==================================================
sub err_warn {
    print "  Warning.\n";
    push(@warnings, $_[0]);
}
#==================================================
sub err_suggest {
    print "OK.\n";
    push(@suggestions, $_[0]);
}