#! /usr/bin/perl
#
#  This script builds a Tripwire policy file from a live system by
#  expanding variables in a 'base' file.
#
#  If you want to refine the tripwire policies for your systems you can
#  do one of the following:
#
#     (1) Add rules to CFengine
#     (2) Write a callback script called twsite.pl which is included by
#         this script - the frame comes with this script
#     (3) Modify the base file and send a patch to me.
#
#  Only modify the base file when you feel it is a common requirement
#  for all ROCK users.
#
#  The latest version is available at 
#
#     http://www.rocklinux.org/people/pjotr/package/tools/tripwire/
#
#  See also the README file.
#
#  Enjoy!
#
#  Pjotr Prins
#
#  20011015  Added /etc/opt/tripwire configuration
#  20010515  Added variables for tripwire itself, prefix option
#  20010507  Fixed lfn bug
#  20010506  Initial version
#
#  $Id: mktrippol.pl,v 1.7 2001/10/15 12:41:23 wrk Exp $
#
#  Remarks:
#
#    Add all libraries/modules
#    Split base/ext

# require 'dumpvar.pl';
use strict;
use Getopt::Std;
require "twsite.pl";
require "rockadm.pl";

my $version = "mktrippol 0.62 by Pjotr Prins GPL (c) 2001";

my $usage="

  Usage: perl mktrippol.pl [-t type] [-f filename] [-o policy] [-p prefix]

    -t [normal,server,paranoid]     : Set the security level
    -f filename                     : Input base file name
    -o filename                     : Output policy file name
    -p prefix                       : Installation --prefix
    -h                              : Help

";

# ---- Standard settings ---------------------------------------------

my $security = 'normal';
my $basefn   = 'rockbasepolicy.txt';
my $twetc    = '/etc/tripwire';
if (-d '/etc/opt/tripwire') 
{
    $twetc = '/etc/opt/tripwire';
}
my $twsbin   = '/usr/sbin';
$twsbin      = '/opt/tripwire/sbin' if ( -d '/opt/tripwire' );
my $twvar    = '/var/lib/tripwire';
$twvar       = '/opt/tripwire/var' if ( -d '/opt/tripwire' );
  
my $policyfn = "$twetc/twpol.txt";
my $prefix   = undef;

# ---- Parse command line --------------------------------------------

print "\n$version\n\n";

getopts('ht:f:o:p:');

use vars qw/ $opt_t $opt_h $opt_f $opt_o $opt_p /;

if ($opt_h)
{
    print $usage;
    exit 0;
}

($opt_t) && ($security = $opt_t);   # Get type of security
($opt_f) && ($basefn   = $opt_f);   # Get base filename
($opt_o) && ($policyfn = $opt_o);   # Get policy filename
($opt_p) && ($prefix   = $opt_p);   # Installation prefix

print "[$basefn,$policyfn,$security,$prefix]\n\n";

# ---- Start parsing -------------------------------------------------

open(READ,$basefn) || die "Error: Can not open $basefn!";
open(WRITE,">$policyfn") || die "Error: Can not open $policyfn!";

my %rule_list;

while(<READ>)
{
   my @items = split /\$\$/;
   foreach my $item (@items)
   {
       # print "---> $item\n";
       $_ = $item;
       if (/^([\w_]+)/)
       {
           my $var  = $1;
           my $rest = $';       # '
           if ($var =~ /^list_/)
	   {
               # ---- List as return value
               my @list = eval($var);
               # my @list = list_opt_bin();
               $rest =~ s/^\s+//;
               print WRITE "# Generated list! Do not edit by hand!\n";
               foreach my $line (@list)
	       {
                 if ($line =~ /\w+/ && !$rule_list{$line})
		 {
	           print WRITE "\t",rpad($line,40),$rest;
		 }
                 $rule_list{$line} = 1;
	       }
           }
           else
	   {
               # ---- String as return value
               my $result = eval($var);
               ($result) || ($result=$var);
               print WRITE "$result$rest";
           }
       }
       else
       {
           print WRITE $item;
       }
   }
}
print "Wrote $policyfn!\n";

sub progn
{
  $version;
}

sub date
{
  my $date = localtime;
}

sub security
{
  $security;
}

sub twdocs
{
  "/opt/tripwire/share";
}

sub twbin
{
  ($prefix) && return "$prefix/sbin";
  $twsbin;
}

sub twetc
{
  ($prefix) && return "$prefix/etc";
  $twetc;
}

sub twdb
{
  ($prefix) && return "$prefix/var";
  $twvar;
}

sub twreport
{
  ($prefix) && return "$prefix/var/report";
  $twvar;
}


# ---- Lists ---------------------------------------------------------

my @sbin_listed;

sub list_tripwire
{
  my $twbin=twbin;
  return ( "$twbin/siggen", "$twbin/tripwire", "$twbin/twadmin",
           "$twbin/twprint" )
}

sub list_filesysadmin
{
  # ---- Return a list of all file related commands
  my @filesys = filelist('/sbin',
    'fs|e2|dump|disk|ftl|pv|vg|lv|hd|mk|quot|raid|store|tape|block|mount|rm|ch|cp|swap');
  push @sbin_listed,@filesys;
  return @filesys;
}

sub list_kerneladmin
{
  # ---- Return a list of all network related commands
  my @kernel = filelist('/sbin',
    'mod|log|adm');
  @kernel = difference(\@kernel,\@sbin_listed);
  push @sbin_listed,@kernel;
  return @kernel;
}

sub list_networkadmin
{
  # ---- Return a list of all network related commands
  my @network = filelist('/sbin',
    'ppp|^if|^ip|route|net|arp|isdn|mon|plip|slip|ifconfig|dhc');
  @network = difference(\@network,\@sbin_listed);
  push @sbin_listed,@network;

  return @network;
}

sub list_deviceadmin
{
  # ---- Return a list of all network related commands
  my @dev = filelist('/sbin',
    'pci|card|clock|kbd|pnp|pump|shape|ide|scsi|sax');
  @dev = difference(\@dev,\@sbin_listed);
  push @sbin_listed,@dev;

  return @dev;
}

sub list_sbin_other
{
  # ---- List all the other administrative commands
  my @sbin = filelist('/sbin');
  @sbin = difference(\@sbin,\@sbin_listed);
  return @sbin;
}

# --------------------------------------------------------------------

sub list_bin
{
  return filelist('/bin');
}

sub list_tmp
{
  my @dirs = ('/tmp','/usr/tmp','/var/tmp');
  return dirvalid(\@dirs);
}

sub list_boot
{
  return filelist('/boot');
}

sub list_usr
{
  return dirvalid('/usr/local/bin','/usr/local/sbin','/usr/bin',
                  '/usr/sbin','/usr/X11/bin');
}

sub list_config
{
  my @list = filelist('/etc');
  push @list,filelist('/etc/conf');
  push @list,filelist('/etc/mail');
  push @list,filelist('/etc/init.d');
  push @list,filelist('/etc/setup.d');
  return @list;
}

sub list_important
{
  my @important;
  push @important,which('sh');
  push @important,which('bash');
  push @important,which('bash2');
  push @important,which('ksh');
  push @important,which('csh');
  push @important,which('tsh');
  push @important,which('tcsh');
  push @important,which('psh');
  push @important,which('rsh');
  push @important,which('perl');
  push @important,which('python');
  push @important,which('ruby');
  return @important;
}

sub list_suid
{
  my @suid;
  push @suid,which('suidperl');
  push @suid,which('shell');
  push @suid,suidlist('/sbin');
  push @suid,suidlist('/bin');
  push @suid,suidlist('/usr/bin');
  push @suid,suidlist('/usr/sbin');
  push @suid,suidlist('/usr/local/sbin');
  push @suid,suidlist('/usr/local/bin');
  push @suid,suidlist('/usr/X11/bin');
  return @suid;
}

sub list_root
{
  my @root = filelist('/root');
  (-d '/root/mail') && push @root,'/root/mail';
  return @root;
}

sub list_proc
{
  return filelist('/proc');
}

sub list_opt_bin
{
  my @opt_binlist;

  my @optlist = dirlist('/opt');
  foreach my $opt (@optlist)
  {
    (-d "$opt/bin") && push @opt_binlist,filelist("$opt/bin");
    (-d "$opt/sbin") && push @opt_binlist,filelist("$opt/sbin");
  }
  return @opt_binlist;
}

sub list_opt_lib
{
  my @opt_liblist;

  my @optlist = dirlist('/opt');
  foreach my $opt (@optlist)
  {
    (-d "$opt/lib") && push @opt_liblist,filelist("$opt/lib");
  }
  return @opt_liblist;
}

sub list_opt_etc
{
  my @opt_etclist;

  my @optlist = dirlist('/opt');
  foreach my $opt (@optlist)
  {
    (-d "$opt/etc") && push @opt_etclist,filelist("$opt/etc");
  }
  return @opt_etclist;
}

sub list_significant_bin
{
  my @retlist;

  my @list = ( '/opt/oracle', '/var/spool/cron' );
  foreach my $item (@list)
  {
    (-d $item || -e $item) && push @retlist,$item;
  }
  return @retlist;
}

sub list_significant_log
{
  my @retlist;

  my @list = ( '/var/adm', '/var/cron', '/var/log', '/var/lib' );
  foreach my $item (@list)
  {
    (-d $item || -e $item) && push @retlist,$item;
  }
  return @retlist;
}

# ---- Helper functions ----------------------------------------------

sub dirlist
{
   my ($dir,$regex) = @_;

   opendir(DIR,$dir) || die "ERROR: $dir not a directory!";
   my @dirlist = grep(!/^\.\.?$/,readdir(DIR));
   closedir(DIR);
   my @fulldirlist;
   foreach my $entry (@dirlist)
   {
     my $path = "$dir/$entry";
     (-d $path) && push @fulldirlist,$path;
   }
   (!$regex) && ($regex = '.+');
   return grep(/$regex/,@fulldirlist);
}

sub filelist
{
   my ($dir,$regex) = @_;

   opendir(DIR,$dir) || die "ERROR: $dir not a directory!";
   my @filelist = grep(!/^\.\.?$/,readdir(DIR));
   closedir(DIR);
   my @fullfilelist;
   foreach my $entry (@filelist)
   {
     my $path = "$dir/$entry";
     (!-d $path) && push @fullfilelist,$path;
   }
   (!$regex) && ($regex = '.+');
   return grep(/$regex/,@fullfilelist);
}

sub suidlist
{
   my ($dir,$regex) = @_;

   opendir(DIR,$dir) || die "ERROR: $dir not a directory!";
   my @filelist = grep(!/^\.\.?$/,readdir(DIR));
   closedir(DIR);
   my @fullfilelist;
   foreach my $entry (@filelist)
   {
     my $path = "$dir/$entry";
     (-u $path || -g $path) && push @fullfilelist,$path;
   }
   (!$regex) && ($regex = '.+');
   return grep(/$regex/,@fullfilelist);
}

sub dirvalid
{
  my ($listp) = @_;
  my @list;
  foreach my $dir (@{$listp})
  {
    (-d $dir) && push @list,$dir
  }
  return @list;
}

sub which
{
  my ($fn) = @_;
  (-e "/sbin/$fn") && return "/sbin/$fn";
  (-e "/bin/$fn") && return "/bin/$fn";
  (-e "/usr/sbin/$fn") && return "/usr/sbin/$fn";
  (-e "/usr/bin/$fn") && return "/usr/bin/$fn";
  (-e "/usr/local/sbin/$fn") && return "/usr/local/sbin/$fn";
  (-e "/usr/local/bin/$fn") && return "/usr/local/bin/$fn";
  return '';
}

sub rpad
{
    my ($str, $size, $char) = @_;
    my $currentsize = length $str;
    my $spaces = $size - $currentsize;
    # eval("$tmp =~ s/.*$/ {$spaces}/;");

    if ($spaces>0)
    {
        (!$char) && ($char = ' ');
        while ($spaces > 0)
        {
            $str .= $char;
            $spaces--;
        }
    }
    else
    {
        # return substr($str, 0, $size);
		return "$str ";
    }
    return $str;
}

sub difference
{
   # ---- Ugly way of finding the difference between lists - using
   #      a hash would do a lot better

   my ($listp,$coveredp) = @_;
   my @difference;

   foreach my $item (@{$listp})
   {
     my $found;
     foreach my $item2 (@{$coveredp})
     {
       if ($item eq $item2)
       {
         $found = 1;
       }
     }
     ($found) || push @difference,$item;
   }
   return @difference;
}

